class: center, middle, inverse, title-slide .title[ # Clustering ] .subtitle[ ## Part 2b ] .author[ ### Prof. Weldzius ] .institute[ ### Villanova University ] --- <style type="text/css"> .small .remark-code { /*Change made here*/ font-size: 85% !important; } .tiny .remark-code { /*Change made here*/ font-size: 50% !important; } </style> # Agenda 1. Tweets as data 2. Words &rarr; topics 3. Application ``` r require(tidyverse) require(scales) tweet_words <- read_rds(file="../Data/Trump_tweet_words.Rds") ``` --- # NLP Definitions - Before we dig in, some important definitions -- 1. **Word / Term:** The core unit of interest -- - Often pre-processed to remove "stop words" and to "stem" the words - "Stop word": an uninteresting, commonly used word - "Stem / Lemmatize": the core component of a word that contains its meaning (eat, ate, eaten &rarr; eat) -- 2. **Document:** A collection of words with a single purpose / idea (i.e., a tweet, an essay) -- 3. **Corpus:** A collection of documents -- 4. **BOW:** Bag-of-words. Convert a **document** into a count of how many times **words** appear -- 5. **DTM:** Document-term matrix. A dataset where rows are **documents**, columns are **words**, and the values are the counts from **BOW** --- # What does Trump tweet about? - Core idea: word frequencies can help: -- - Help us understand **documents** -- - Which help us understand **authors** ``` r counts <- tweet_words %>% count(word) %>% arrange(-n) ``` --- # What does Trump tweet about? ``` r counts ``` ``` ## # A tibble: 45,221 × 2 ## word n ## <chr> <int> ## 1 trump 6269 ## 2 president 4637 ## 3 amp 4306 ## 4 people 3475 ## 5 country 2302 ## 6 america 2211 ## 7 time 1913 ## 8 donald 1891 ## 9 news 1842 ## 10 democrats 1824 ## # ℹ 45,211 more rows ``` --- # What does Trump tweet about? ``` r p <- tweet_words %>% count(word, sort = TRUE) %>% # New ways of doing old things head(20) %>% ggplot(aes(x = n,y = reorder(word, n))) + geom_bar(stat = "identity") + ylab("Occurrences") + scale_x_continuous(label=comma) ``` --- # What does Trump tweet about? ``` r p ``` <img src="15b_ClusteringPart2_files/figure-html/unnamed-chunk-7-1.png" style="display: block; margin: auto;" /> --- # Effect of becoming president - Did his focus change when he became president? ``` r tweet_words <- tweet_words %>% mutate(PostPresident = Tweeting.date > as.Date("2016-11-03")) ``` -- ``` r p <- tweet_words %>% count(PostPresident,word) %>% group_by(PostPresident) %>% arrange(-n) %>% slice(1:10) %>% ggplot(aes(x = n,y = reorder(word, n), fill = PostPresident)) + geom_bar(stat = "identity") + ylab("Occurrences") + scale_x_continuous(label=comma) ``` --- # Effect of becoming president ``` r p ``` <img src="15b_ClusteringPart2_files/figure-html/unnamed-chunk-10-1.png" style="display: block; margin: auto;" /> --- # Document Term Matrix - "DTM" counts all the words in each document -- - In this case, a "document" is a tweet ``` r dtm <- tweet_words %>% count(document,word) glimpse(dtm) ``` ``` ## Rows: 433,271 ## Columns: 3 ## $ document <dbl> 1698308935, 1698308935, 1698308935, 16983… ## $ word <chr> "david", "donald", "late", "letterman", "… ## $ n <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,… ``` --- # Document Term Matrix - However, each tweet is very short -- - Let's consider the `Tweeting.date` the document -- - Concept: What is Trump tweeting about on a given day? ``` r dtm <- tweet_words %>% count(Tweeting.date,word) %>% group_by(word) %>% mutate(tot_n = sum(n)) %>% # Also calculate TOTAL number of times a word appears ungroup() ``` --- # Wrangle - Extremely rare words should be dropped (typos, etc.) ``` r dtm %>% arrange(tot_n) %>% head() # Trump tweeted "barnesandnoblecom" only once in his life ``` ``` ## # A tibble: 6 × 4 ## Tweeting.date word n tot_n ## <date> <chr> <int> <int> ## 1 2009-05-08 httptinyurlcomooafwn 1 1 ## 2 2009-05-08 httptinyurlcomqluxe 1 1 ## 3 2009-05-12 cling 1 1 ## 4 2009-05-12 wallflower 1 1 ## 5 2009-05-13 httptinyurlcomqsvl 1 1 ## 6 2009-05-15 contesthttpwwwtrumpthinklikeach… 1 1 ``` ``` r dtm <- dtm %>% filter(tot_n > 20) # Drop these rarely occurring words ``` --- # Analyzing BOW - Some words are frequently found in many documents -- - We want to find words that are **uniquely** used -- - "Unique" &rarr; used frequently in one document but not in any others -- - "TF-IDF": Term frequency-inverse document frequency -- - "TF": `\(\frac{\text{word count}}{\text{total words}}\)` - "DF": `\(\frac{\text{documents with word}}{\text{total documents}}\)` -- - "IDF": Just invert it `\(\frac{\text{total documents}}{\text{documents with word}}\)` $$tf-idf(w,d) = tf(w,d) \times log \left( \frac{N}{df(w)}\right) $$ --- # TF-IDF ``` r require(tidytext) # Required to calculate TF-IDF # install.packages("tm", repos="http://R-Forge.R-project.org") # may need to run this if the next chunk produces an error "there is no package called 'tm'" require(tm) dtm.tfidf <- bind_tf_idf(tbl = dtm, term = word, document = Tweeting.date, n = n) # Calculate TF-IDF dtm.tfidf %>% select(word,tf_idf) %>% distinct() %>% arrange(-tf_idf) %>% slice(1:10) ``` ``` ## # A tibble: 10 × 2 ## word tf_idf ## <chr> <dbl> ## 1 gma 5.21 ## 2 generation 4.90 ## 3 dead 3.19 ## 4 apprentice 2.58 ## 5 weekly 2.40 ## 6 appearance 2.26 ## 7 answers 2.11 ## 8 sounds 2.10 ## 9 football 2.01 ## 10 defeat 1.90 ``` --- # `\(K\)`-means - How to summarize this? `\(k\)`-means clustering! -- - Recall that `kmeans()` function clusters over every column in a data frame -- - `dtm.tfidf` is organized "long" (i.e., each row is a word-by-document) -- - Want to convert to "wide" (i.e., rows are documents, columns are words) -- - Previously used `spread()`, but for *k*-means with text: `cast_dtm()` -- ``` r castdtm <- tidytext::cast_dtm(data = dtm.tfidf, document = Tweeting.date, term = word, value = tf_idf) ``` -- - Now let's calculate `kmeans()` (this will take a few seconds) ``` r set.seed(42) km_out <- kmeans(castdtm, centers = 50, # Number of "topics" nstart = 5) ``` --- # Looking at Clusters - Some quick wrangling ``` r require(tidymodels) km_out_tidy <- tidy(km_out) %>% gather(word,mean_tfidf,-size,-cluster,-withinss) %>% # Convert to long data mutate(mean_tfidf = as.numeric(mean_tfidf)) # Calculate average TF-IDF km_out_tidy ``` ``` ## # A tibble: 158,850 × 5 ## size withinss cluster word mean_tfidf ## <int> <dbl> <fct> <chr> <dbl> ## 1 12 12.6 1 david 0 ## 2 1 0 2 david 0 ## 3 1 0 3 david 0 ## 4 4 7.12 4 david 0 ## 5 16 12.4 5 david 0 ## 6 36 43.0 6 david 0 ## 7 156 54.5 7 david 0.000647 ## 8 1 0 8 david 0 ## 9 1 0 9 david 0 ## 10 9 9.95 10 david 0 ## # ℹ 158,840 more rows ``` --- # Looking at Clusters - And can plot! (Just look at first 10 "topics") ``` r p <- km_out_tidy %>% filter(cluster %in% 1:9) %>% group_by(cluster) %>% arrange(-mean_tfidf) %>% slice(1:10) %>% ggplot(aes(x = mean_tfidf,y = reorder(word,mean_tfidf), fill = factor(cluster))) + geom_bar(stat = 'identity') + facet_wrap(~cluster,scales = 'free') + labs(title = 'k-means Clusters', subtitle = 'Clustered by TF-IDF', x = 'Centroid', y = NULL, fill = 'Cluster ID') ``` --- # Looking at Clusters ``` r p ``` <img src="15b_ClusteringPart2_files/figure-html/unnamed-chunk-19-1.png" style="display: block; margin: auto;" /> --- # Looking at clusters - What are these clusters? -- - Let's look at the most popular topics ``` r (tops <- km_out_tidy %>% select(size,withinss,cluster) %>% distinct() %>% arrange(desc(size)) %>% slice(1:5)) ``` ``` ## # A tibble: 5 × 3 ## size withinss cluster ## <int> <dbl> <fct> ## 1 3066 720. 13 ## 2 156 54.5 7 ## 3 36 43.0 6 ## 4 34 28.1 12 ## 5 17 13.9 44 ``` --- # Looking at clusters - What are these clusters? - Let's look at the most popular topics ``` r p <- km_out_tidy %>% filter(cluster %in% tops$cluster) %>% group_by(cluster) %>% arrange(-mean_tfidf) %>% slice(1:10) %>% ggplot(aes(x = mean_tfidf,y = reorder(word,mean_tfidf), fill = factor(cluster))) + geom_bar(stat = 'identity') + facet_wrap(~cluster,scales = 'free') + labs(title = 'k-means Clusters', subtitle = 'Clustered by TF-IDF', x = 'Centroid', y = NULL, fill = 'Cluster ID') ``` --- # Looking at clusters ``` r p ``` <img src="15b_ClusteringPart2_files/figure-html/unnamed-chunk-22-1.png" style="display: block; margin: auto;" /> --- # Optimal number of clusters? - We know how to do this already! Elbow plot! ``` r set.seed(42) totWSS <- NULL for(k in c(1,10,50,100,250,500,1000)) { km_out <- kmeans(castdtm, centers = k, nstart = 5) totWSS <- data.frame(totWSS = km_out$tot.withinss, k = k) %>% bind_rows(totWSS) } p <- totWSS %>% ggplot(aes(x = k,y = totWSS)) + geom_point() + geom_line() ``` --- # Optimal number of clusters? ``` r p ``` <img src="15b_ClusteringPart2_files/figure-html/unnamed-chunk-24-1.png" style="display: block; margin: auto;" /> --- # Conclusion - `\(k\)`-means clustering on text &rarr; **topics** -- - As always, this is a deep area of study -- - Superior methods are out there (Latent Dirichlet Allocation, Structural Topic Modeling, etc.) -- - NOTE: even with text, always start with simple descriptives -- - **Looking** at your data is the heart of data science