Info

Association rules and Apriori Algorithm were originally motivated by market basket analysis. However, association analysis is not restricted to sales data and it could be used to any kind of data represented as a sparse matrix.

In this lab, we will apply association analysis to text mining. Specifically, we will extract association rules from the document-term matrix of Donald Trump’s twitter. By doing it, we will see which combinations of words Trump often mentions in the same tweet.

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

27 Oct 2025, midnight

Libraries

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

library(tidyverse) # for manipulation with data

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidytext)

library(janitor)

## 
## Attaching package: 'janitor'
## 
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

library(gt)
library(arules)

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

## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## 
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack
## 
## 
## Attaching package: 'arules'
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## The following objects are masked from 'package:base':
## 
##     abbreviate, write

library(arulesViz)
library(RColorBrewer)

set.seed(1729) # replace the number '1729' with your matric no

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

}


# trump_tweets <- read_csv("trump_twitter.csv") %>%
#   as_tibble %>%
#   filter(nchar(text) <= 280) %>%
#   filter(!is_retweet == "true") %>%
#   select(-is_retweet) %>%
#   mutate(favorite_count = as.numeric(favorite_count)) %>%
#   filter(!is.na(favorite_count)) %>%
#   mutate(clean_text = clean_tweets(text)) %>%
#   select(id_str, created_at, clean_text, retweet_count)

trump_tweets <- read_csv("trump_twitter.csv") %>%
  as_tibble %>%
  filter(nchar(text) <= 280) %>%
  filter(!is_retweet == "true") %>%
  select(-is_retweet) %>%
  mutate(cleaned_text = clean_tweets(text))

## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
##   dat <- vroom(...)
##   problems(dat)

## Rows: 31309 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): source, text, created_at
## dbl (3): retweet_count, favorite_count, id_str
## lgl (1): is_retweet
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

remove_from_wc <- c(stop_words$word,
                    "twacc", "htag", "year", "http", "https")

trump_tweets %>%
  sample_n(10) %>%
  gt()

source	text	created_at	retweet_count	favorite_count	id_str	cleaned_text
Twitter for iPhone	RT @toddstarnes: Franklin Graham Calls for National Day of Prayer for President Trump - https://t.co/WS2nRB1oME https://t.co/Smu9eC9YAG	06-01-2019 23:18:33	5878	0	1.134962e+18	rt twacc toddstarnes franklin graham calls for national day of prayer for president trump https t co ws nrb ome https t co smu ec yag
Twitter Web Client	I'm on @foxandfriends every Monday morning at 7:30...	02-24-2012 17:01:34	14	2	1.730902e+17	i m on twacc foxandfriends every monday morning at
Twitter for iPhone	After a ten year search the so-called “mastermind” of the Mumbai Terror attacks has been arrested in Pakistan. Great pressure has been exerted over the last two years to find him!	07-17-2019 14:16:05	34734	162766	1.151496e+18	after a ten year search the so called mastermind of the mumbai terror attacks has been arrested in pakistan great pressure has been exerted over the last two years to find him
Twitter Web Client	@MGSeneca He was a great friend of mine--loyal guy.	07-19-2013 17:47:51	0	2	3.582820e+17	twacc mgseneca he was a great friend of mine loyal guy
Twitter for Android	@CunninghamNY: . @realDonaldTrump clearly needs to run for president! Don't think anyone else can get us on the right track but him!	05-12-2013 22:04:23	30	35	3.337042e+17	twacc cunninghamny twacc realdonaldtrump clearly needs to run for president don t think anyone else can get us on the right track but him
Twitter Web Client	@DonnyDeutsch tries so hard to be a star. But he just doesn't have what it takes...and he never will.	10-27-2012 11:09:42	12	5	2.621491e+17	twacc donnydeutsch tries so hard to be a star but he just doesn t have what it takes and he never will
Twitter for iPhone	RT @RepMattGaetz: The Democrat attacks on the President fall into one of three categories: 1. Hearsay2. Conjecture3. Substantive policy…	12-12-2019 12:44:01	7378	0	1.205106e+18	rt twacc repmattgaetz the democrat attacks on the president fall into one of three categories hearsay conjecture substantive policy
Twitter for iPhone	Mexico has the absolute power not to let these large “Caravans” of people enter their country. They must stop them at their Northern Border which they can do because their border laws work not allow them to pass through into our country which has no effective border laws.....	04-02-2018 11:02:30	19753	76422	9.807624e+17	mexico has the absolute power not to let these large caravans of people enter their country they must stop them at their northern border which they can do because their border laws work not allow them to pass through into our country which has no effective border laws
Twitter for Android	@Meaghan08: @realDonaldTrump Ate the best steak of my life at your Trump Hotel in Waikiki Hawaii. Tremendous service and menu! Mahalo!	07-28-2013 23:28:45	11	11	3.616293e+17	twacc meaghan twacc realdonaldtrump ate the best steak of my life at your trump hotel in waikiki hawaii tremendous service and menu mahalo
Twitter for iPhone	RT @HouseGOP: It’s simple. The American people deserve transparency yet House Democrats continue to ram through their impeachment investig…	10-23-2019 17:46:48	7378	0	1.187063e+18	rt twacc housegop it s simple the american people deserve transparency yet house democrats continue to ram through their impeachment investig

Question 1

Compute the document-term matrix (DTM) of cleaned Donald Trump’s twitter. When you do it, please

Prune the vocabulary to terms that appear at least 20 times in the corpus
Remove stopwords

Report dimensions of the DTM.

Then convert the DTM to itemMatrix for association analysis and produce the item frequency plot. What is its interpretation for text analysis?

Answer First, we create the DTM and report its dimensions (note that, strictly speaking, the number of columns should be one less than the reported number because the reported number includes the document ID):

trump_DTM <- trump_tweets %>%
  mutate(doc_id = row_number()) %>%
  select(doc_id, cleaned_text) %>%
  unnest_tokens(word, cleaned_text) %>%
  filter(!word %in% remove_from_wc) %>%
  count(doc_id, word, sort = FALSE) %>%
  group_by(word) %>%
  mutate(word_count = sum(n)) %>%
  filter(word_count >= 20) %>%
  pivot_wider(id_cols = "doc_id",
              names_from = "word",
              values_from = n,
              values_fill = 0)

cat("dim(DTM) =", dim(trump_DTM), "\n")

## dim(DTM) = 28547 2222

Now we will convert it to itemMatrix and plot item frequencies:

trump_item_matrix <- trump_DTM %>%
  select(-doc_id) %>%
  as.matrix() %>%
  as("itemMatrix")

## Warning in asMethod(object): matrix contains values other than 0 and 1! Setting
## all entries != 0 to 1.

trump_item_matrix %>% itemFrequencyPlot(topN = 20, type="relative",
                  col = brewer.pal(8, 'Accent'),
                  main = "Support of most common items")

The height of every bar here is the fraction of documents containing the respective word or a token. Note that these are not word frequencies. For example, we see that about 5% of all tweets mention Obama and about 3% of tweets mention fake media etc.

Question 2

Extract association rules with minimum support 0.005, minimum confidence 0.5, and maximum length 5. Plot this set of rules as a scatterplot.

tidy_rules <- function(rules_object) {
  tibble(
    LHS = labels(lhs(rules_object)),
    RHS = labels(rhs(rules_object)),
    length = size(rules_object),
    quality(rules_object)
  )
}

rules_0005_05_5 <- trump_item_matrix %>%
  apriori(parameter = list(supp = 0.005, conf = 0.5, maxlen = 5))

## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.5    0.1    1 none FALSE            TRUE       5   0.005      1
##  maxlen target  ext
##       5  rules TRUE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 142 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2221 item(s), 28547 transaction(s)] done [0.01s].
## sorting and recoding items ... [268 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [16 rule(s)] done [0.00s].
## creating S4 object  ... done [0.00s].

rules_0005_05_5 %>%
  tidy_rules() %>%
    ggplot(aes(x = support, y = confidence,
             color = lift, size = length)) +
  geom_point(alpha = 1) +
  theme_minimal(base_size = 13) +
  scale_color_gradientn(colors = brewer.pal(9 ,"Reds")) +
  scale_size_continuous(
    breaks = 2:3,       # legend shows only these
    range = c(2, 3),           # visual size range
    limits = c(2, 3)           # optional: clamp to valid values
  ) +
  labs(
    title = paste(length(rules_0005_05_5), "rules"),
    x = "Support",
    y = "Confidence",
    color = "Lift",
    size = "Rule length"
  )

Question 3

Now extract rules with the lift of at least 10 and plot them as a graph. What kind of topics discussed in Trump’s tweets can you see on this graph?

rules_0005_05_5 %>%
  subset(lift >= 10) %>%
  plot(method = "graph",
       engine = "htmlwidget")

Recurring topics discussed in Trumps tweets seem to be about a border wall (probably, between Mexico and the USA), how Hillary Clinton is crooked, and fake news.

Question 4

Now extract rules with the lift at least 40 and print them in the order of decreasing lift. Note that, by definition, the lift \(l\) is symmetric, i.e., \[ l(X\to Y)=l(Y\to X) \]

Explain why the list of rules that you printed does not appear to reflect this symmetry. For example, the rule {crooked} -> {hillary} is there, but the rule {hillary} -> {crooked} is not.

rules_0005_05_5 %>%
  tidy_rules() %>%
  filter(lift >= 40) %>%
  arrange(desc(lift)) %>%
  gt()

LHS	RHS	length	support	confidence	coverage	lift	count
{hunt}	{witch}	2	0.009983536	0.9895833	0.010088626	97.41254	285
{witch}	{hunt}	2	0.009983536	0.9827586	0.010158686	97.41254	285
{white}	{house}	2	0.009282937	0.9363958	0.009913476	45.93005	265
{crooked}	{hillary}	2	0.007496409	0.8199234	0.009142817	43.91436	214

Note that while lift and support are symmetric, confidence is not, i.e., while the rule {crooked} -> {hillary} is here because its confidence is above the threshold of \(0.5\), the rule {hillary} -> {crooked} is not here because, although it has the same lift as {crooked} -> {hillary}, its confidence is below the threshold of \(0.5\).

Indeed, we can check it by lowering the confidence threshold to \(0.4\):

trump_item_matrix %>%
  apriori(parameter = list(supp = 0.005, conf = 0.4, maxlen = 5)) %>%
  tidy_rules() %>%
  filter(lift > 40) %>%
  arrange(-lift) %>%
  gt()

## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.4    0.1    1 none FALSE            TRUE       5   0.005      1
##  maxlen target  ext
##       5  rules TRUE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 142 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2221 item(s), 28547 transaction(s)] done [0.01s].
## sorting and recoding items ... [268 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [22 rule(s)] done [0.00s].
## creating S4 object  ... done [0.00s].

LHS	RHS	length	support	confidence	coverage	lift	count
{hunt}	{witch}	2	0.009983536	0.9895833	0.010088626	97.41254	285
{witch}	{hunt}	2	0.009983536	0.9827586	0.010158686	97.41254	285
{white}	{house}	2	0.009282937	0.9363958	0.009913476	45.93005	265
{house}	{white}	2	0.009282937	0.4553265	0.020387431	45.93005	265
{crooked}	{hillary}	2	0.007496409	0.8199234	0.009142817	43.91436	214
{hillary}	{crooked}	2	0.007496409	0.4015009	0.018670964	43.91436	214

Basically, we see that if Hillary is mentioned in a tweet, then usually she is claimed to be crooked (in 80% of such tweets). But if someone crooked is mentioned, it might be Hillary, but often it is someone else - Hillary appears in only 40% of such tweets.

Lab 10 — graded report.