Info

Objective

The purpose of writing graded lab reports is to help students to stay on track and to provide summative feedback. Each lab report is just 1% of the total course mark. Please do not cheat - it is not worth it!

Your task

Solve the practical questions, knit your document into a PDF and submit to NTULearn before the deadline. The deadline is very tight because the task is simple. We are sure that everyone is capable to do it by themselves and we want to discourage taking someone else’s report and writing it with your own words.

Deadline

19 Oct 2026, midnight

Libraries

We will work with a dataset of New Year resolutions posted on twitter.

Source: https://data.world/crowdflower/2015-new-years-resolutions

Here, we load libraries, data and set the random seed. Replace the number “1729” with the numeric part of your matric no

library(tidyverse) # for manipulation with data
library(janitor) # for some helper functions
library(broom) # for tidying data
library(text2vec) # for GloVe
library(tm) # for text processing

## Warning: package 'NLP' was built under R version 4.6.1

library(ggwordcloud) # for visualizations
library(caret) # for training maching learning models
library(gt)

N <- read.csv("new_years_resolutions.csv")
set.seed(8192) # replace the number '1729' with your matric no

We will first do some very basic cleaning by changing all characters to lower case and replacing everything except for alphabet and numerals with a space.

clean_tweets <- function(x) {
  x %>%
      str_replace_all("[^A-Za-z@#]", " ") %>%
      str_squish() %>%
      str_to_lower()
}

N <- N %>%
  mutate(clean_text = clean_tweets(text))

N %>%
  select(text, clean_text) %>%
  sample_n(10) %>%
  gt()

text	clean_text
My #NewYearsResolution is to be more organized. What apps help you stay organized? #crowdsource	my #newyearsresolution is to be more organized what apps help you stay organized #crowdsource
my New Years resolution is to get to know someone before I judge them, I've become so close to people I would have never imagined	my new years resolution is to get to know someone before i judge them i ve become so close to people i would have never imagined
#NewYearsResolution Stop leaving my stuff in hotel rooms post checkout!! #vagabondprobs	#newyearsresolution stop leaving my stuff in hotel rooms post checkout #vagabondprobs
My New Year's resolution is to be a mistake free in 2105. #NewYearsResolution #HappyNewYear	my new year s resolution is to be a mistake free in #newyearsresolution #happynewyear
@MLBPAClubhouse #NewYearsResolution to die tad get off the coach and play outside with my son more	@mlbpaclubhouse #newyearsresolution to die tad get off the coach and play outside with my son more
#NewYearsResolution , Hopefully we will be in our new place by the first of Feb _�ԍ_�ԍ	#newyearsresolution hopefully we will be in our new place by the first of feb
My #NewYearsResolution ? A reading challenge that has old and new! #R2DChallenge http://t.co/f9ABPTAZIg http://t.co/8LK4oBTx5r	my #newyearsresolution a reading challenge that has old and new #r dchallenge http t co f abptazig http t co lk obtx r
My New Years resolution is to figure out what the word 'resolution' means	my new years resolution is to figure out what the word resolution means
My New Years resolution was always to get ripped and it never happened so this year it's to get fat af...#letsseewhathappens	my new years resolution was always to get ripped and it never happened so this year it s to get fat af #letsseewhathappens
I will only indulge on food if its a new place ive never been or a new dish ive never had. No more fastfood, again! #NewYearsResolution	i will only indulge on food if its a new place ive never been or a new dish ive never had no more fastfood again #newyearsresolution

Here is the table of resolution categories:

N %>% tabyl(Resolution_Category)

In this lab, we will be particularly interested with the following words:

words_of_interest <- c("find", "girlfriend", "quit", "beer", "cigarettes",
                     "smoking", "lose", "weight", "healthy", "food") %>% sort
words_of_interest

##  [1] "beer"       "cigarettes" "find"       "food"       "girlfriend"
##  [6] "healthy"    "lose"       "quit"       "smoking"    "weight"

Question 1

Compute the term co-occurrence matrix with the vocabulary pruned to 3, i.e., only include words that appear at least 3 times into the vocabulary. Use the default settings compute the TCM (the window size is 5 and the weights are \(1, 1/2, 1/3, 1/4, 1/5\), but you don’t need to specify them).

Print dimensions of the TCM and print the \(10\times 10\) submatrix corresponding to words_of_interest, i.e., print co-occurrence numbers between words listed above.

tokens <- space_tokenizer(N$clean_text)
it = itoken(tokens, progressbar = FALSE)
vocab <- create_vocabulary(it) %>%
  prune_vocabulary(3)

vectorizer <- vocab_vectorizer(vocab) 
  
tcm <- create_tcm(it, vectorizer)

cat("TCM dimensions are", dim(tcm),"\n")
cat("TCM sumbatrix is\n")
as.matrix(tcm)[words_of_interest, words_of_interest] %>% 
  round(2) %>%
  as.data.frame() %>%
  rownames_to_column() %>%
  gt()

## TCM dimensions are 1953 1953 
## TCM sumbatrix is

	cigarettes	find	food	healthy	lose	smoking	weight
beer	0.0	0.00	0.00	0.0	0.33	0.00	0.00
cigarettes	0.0	0.00	0.00	0.0	0.00	39.00	0.00
find	0.0	0.00	0.00	0.0	0.00	0.00	0.00
food	0.0	0.00	0.33	3.5	0.00	0.00	0.00
girlfriend	0.0	0.33	0.00	0.0	0.00	0.00	0.00
healthy	0.0	0.00	0.00	0.0	0.00	0.00	0.20
lose	0.0	0.00	0.00	0.0	0.00	0.00	32.25
quit	1.5	0.33	0.00	0.0	0.00	10.33	0.00
smoking	0.0	0.00	0.00	0.0	0.00	0.00	0.25
weight	0.0	0.00	0.00	0.0	0.00	0.00	0.33

Question 2

Train GloVe 2-dimensional embeddings. Print dimensions of the word vector matrix.

Further, plot word vectors corresponding to words_of_interest as a scatterplot whose points are labelled with the words. You will need to explore the functions geom_text and geom_label.

dim_word_emb <- 2

# Stage 2 - training GloVe itself
glove = GlobalVectors$new(rank = dim_word_emb, x_max = 10)

wv_main = glove$fit_transform(tcm, n_iter = 50, convergence_tol = 0.001)

wv_context = glove$components
word_vectors = wv_main + t(wv_context)

cat("Dim of word vector matrix =", dim(word_vectors))

## Dim of word vector matrix = 1953 2

And here is the plot:

word_vectors %>%
  as.data.frame() %>%
  rownames_to_column("word") %>%
  filter(word %in% words_of_interest) %>%
  ggplot(aes(x = V1, y = V2, label = word)) +
  geom_point() + geom_label() + theme_minimal()

Question 3

Retrain GloVe to construct 50-dimensional embeddings. Then print 10 words that have the highest cosine similarity with the word “quit”.

dim_word_emb <- 50

# Stage 2 - training GloVe itself
glove = GlobalVectors$new(rank = dim_word_emb, x_max = 10)

wv_main = glove$fit_transform(tcm, n_iter = 50, convergence_tol = 0.001)

wv_context = glove$components
word_vectors = wv_main + t(wv_context)

cat("Dim of word vector matrix =", dim(word_vectors))

## Dim of word vector matrix = 1953 50

Here are words most similar to “quit”:

squared_norms <- rowSums(word_vectors^2)
d_quit <- word_vectors["quit" , ] %*% t(word_vectors)
cosines <- d_quit[1 , ] / sqrt(squared_norms["quit"] * squared_norms)
cosines %>%
  enframe(name = "word", value = "similarity_with_quit") %>%
  arrange(desc(similarity_with_quit)) %>%
  head(10) %>%
  gt()

word	similarity_with_quit
quit	1.0000000
smoking	0.6225229
sleep	0.5249134
stop	0.5227305
resolve	0.4490182
our	0.4366371
true	0.4276236
continue	0.4253956
drinking	0.4246999
become	0.4216525

Question 4

Use \(K\)-means clustering to split the tweets into 10 clusters. Print the contingency table with resolution category. Is there a cluster that is well-arranged with the resolution category? If there is, what does it contain? Why do you think most clusters are so poorly arranged with the resolution category?

Below we generate clusters and print the contingency table with the resolution category.

dtm <- create_dtm(it, vectorizer)
glove_data <- as.matrix(dtm %*% word_vectors) 

resol_tw_clust <-
  kmeans(glove_data, 10)

resol_tw_clust %>%
  augment(N) %>%
  tabyl(Resolution_Category, .cluster) %>%
  gt()

Resolution_Category	1	2	3	4	5	6	7	8	9	10
Career	0	24	7	6	13	24	1	9	12	30
Education/Training	0	14	7	4	13	18	0	6	8	19
Family/Friends/Relationships	0	70	26	22	23	68	0	36	40	66
Finance	0	15	19	4	11	25	51	4	24	23
Health & Fitness	38	111	73	37	112	176	0	66	73	154
Humor	0	116	140	39	91	234	0	65	106	219
Personal Growth	1	279	196	96	180	346	1	180	142	360
Philanthropic	0	10	3	4	23	13	0	10	3	18
Recreation & Leisure	0	62	47	14	52	105	0	30	41	116
Time Management/Organization	0	13	5	1	7	16	0	7	6	32

Depending on random seed there may occur small clusters with fewer than 60 data points. In that case, these clusters will contain very similar tweets and therefore have the same category.

Below we print clusters that are well-aligned with resolution categories in the sense that more than half of tweets belong to the same category:

resol_tw_clust %>%
  augment(N) %>%
  tabyl(Resolution_Category, .cluster) %>%
  adorn_percentages("col") %>%
  as.data.frame() %>%
  pivot_longer(cols = -Resolution_Category, 
               names_to = "cluster",
               values_to = "fraction") %>%
  relocate(cluster, fraction) %>%
  filter(fraction > 0.5)

But most of the time, this method does not produce clusters that are well-aligned with the resolution category. Possible reasons for this are

Euclidean distance is used for \(K\)-means clustering but cosine dissimilarity is used to measure how dissimilar words or tweets are.
The number of tweets that we have is just small. If we trained GloVe on a bigger set of tweets, we would probably be able to construct better models.
Twitter data are dirty (poor grammar etc.)

Declaration of Generative AI usage

I did not use generative AI to produce these model answers`.

Type your name to confirm: Fedor Duzhin

Lab 9 — graded report.

Fedor Duzhin