Introduction to text analysis using R and quanteda

# install packages
# install.packages("quanteda")
# install.packages("quanteda.textstats")
# install.packages("quanteda.textplots")
# install.packages("rvest")
# install.packages("stringr")
# install.packages("devtools")
# devtools::install_github("quanteda/quanteda.tidy")
#United States Presidential State of the Union Addresses package sotu
#install.packages("sotu")

# load packages
library("quanteda")
library("rvest")
library("stringr")
library("quanteda.textstats")
library("quanteda.textplots")
library("quanteda.tidy")
library(sotu)
library(dplyr)

meta <- sotu_meta 
glimpse(meta)

## Rows: 240
## Columns: 6
## $ X            <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17…
## $ president    <chr> "George Washington", "George Washington", "George Washing…
## $ year         <int> 1790, 1790, 1791, 1792, 1793, 1794, 1795, 1796, 1797, 179…
## $ years_active <chr> "1789-1793", "1789-1793", "1789-1793", "1789-1793", "1793…
## $ party        <chr> "Nonpartisan", "Nonpartisan", "Nonpartisan", "Nonpartisan…
## $ sotu_type    <chr> "speech", "speech", "speech", "speech", "speech", "speech…

text <- sotu_text
glimpse(text)

##  chr [1:240] "Fellow-Citizens of the Senate and House of Representatives: \n\nI embrace with great satisfaction the opportuni"| __truncated__ ...

state_of_union <- cbind(meta, text)
glimpse(state_of_union)

## Rows: 240
## Columns: 7
## $ X            <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17…
## $ president    <chr> "George Washington", "George Washington", "George Washing…
## $ year         <int> 1790, 1790, 1791, 1792, 1793, 1794, 1795, 1796, 1797, 179…
## $ years_active <chr> "1789-1793", "1789-1793", "1789-1793", "1789-1793", "1793…
## $ party        <chr> "Nonpartisan", "Nonpartisan", "Nonpartisan", "Nonpartisan…
## $ sotu_type    <chr> "speech", "speech", "speech", "speech", "speech", "speech…
## $ text         <chr> "Fellow-Citizens of the Senate and House of Representativ…

#Keep texts from Barak Obama and Donald Trump
data_sotu <- state_of_union %>%
  filter(president == "Barack Obama" | president =="Donald Trump")

glimpse(data_sotu)

## Rows: 12
## Columns: 7
## $ X            <int> 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240
## $ president    <chr> "Barack Obama", "Barack Obama", "Barack Obama", "Barack O…
## $ year         <int> 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 201…
## $ years_active <chr> "2009-2013", "2009-2013", "2009-2013", "2009-2013", "2013…
## $ party        <chr> "Democratic", "Democratic", "Democratic", "Democratic", "…
## $ sotu_type    <chr> "speech", "speech", "speech", "speech", "speech", "speech…
## $ text         <chr> "Madam Speaker, Mr. Vice President, Members of Congress, …

data_sotu$president

##  [1] "Barack Obama" "Barack Obama" "Barack Obama" "Barack Obama" "Barack Obama"
##  [6] "Barack Obama" "Barack Obama" "Barack Obama" "Donald Trump" "Donald Trump"
## [11] "Donald Trump" "Donald Trump"

data_corpus <- corpus(data_sotu)

# check the number of documents included in the text corpus
ndoc(data_corpus)

## [1] 12

toks_sotu <- tokens(data_corpus)

# let's inspect the first six tokens of the first four documents
print(toks_sotu, max_ndoc = 4, max_ntoken = 6)

## Tokens consisting of 12 documents and 6 docvars.
## text1 :
## [1] "Madam"   "Speaker" ","       "Mr"      "."       "Vice"   
## [ ... and 6,737 more ]
## 
## text2 :
## [1] "Madam"     "Speaker"   ","         "Vice"      "President" "Biden"    
## [ ... and 8,145 more ]
## 
## text3 :
## [1] "Mr"      "."       "Speaker" ","       "Mr"      "."      
## [ ... and 7,735 more ]
## 
## text4 :
## [1] "Mr"      "."       "Speaker" ","       "Mr"      "."      
## [ ... and 7,830 more ]
## 
## [ reached max_ndoc ... 8 more documents ]

tokens(data_corpus)

## Tokens consisting of 12 documents and 6 docvars.
## text1 :
##  [1] "Madam"     "Speaker"   ","         "Mr"        "."         "Vice"     
##  [7] "President" ","         "Members"   "of"        "Congress"  ","        
## [ ... and 6,731 more ]
## 
## text2 :
##  [1] "Madam"         "Speaker"       ","             "Vice"         
##  [5] "President"     "Biden"         ","             "Members"      
##  [9] "of"            "Congress"      ","             "distinguished"
## [ ... and 8,139 more ]
## 
## text3 :
##  [1] "Mr"        "."         "Speaker"   ","         "Mr"        "."        
##  [7] "Vice"      "President" ","         "Members"   "of"        "Congress" 
## [ ... and 7,729 more ]
## 
## text4 :
##  [1] "Mr"        "."         "Speaker"   ","         "Mr"        "."        
##  [7] "Vice"      "President" ","         "Members"   "of"        "Congress" 
## [ ... and 7,824 more ]
## 
## text5 :
##  [1] "Please"    ","         "everybody" ","         "have"      "a"        
##  [7] "seat"      "."         "Mr"        "."         "Speaker"   ","        
## [ ... and 7,568 more ]
## 
## text6 :
##  [1] "The"       "President" "."         "Mr"        "."         "Speaker"  
##  [7] ","         "Mr"        "."         "Vice"      "President" ","        
## [ ... and 7,896 more ]
## 
## [ reached max_ndoc ... 6 more documents ]

# check number of tokens and types
toks_sotu %>%
    ntoken() %>%
    sum()

## [1] 86965

toks_sotu %>% 
    ntype() %>% 
    sum()

## [1] 21696

toks_sotu_pros <- toks_sotu %>% 
    tokens(remove_punct = TRUE) %>%
    tokens_tolower()

# check number of tokens and types
toks_sotu_pros %>% 
    ntoken() %>%
    sum()

## [1] 76779

toks_sotu_pros %>%
    ntype() %>%
    sum()

## [1] 20299

kw_america <- kwic(toks_sotu, 
                   pattern = c("america"),
                   window = 2)

# number of mentions
nrow(kw_america)

## [1] 291

# print first 6 mentions of America and the context of ±2 words
head(kw_america, n = 6)

## Keyword-in-context with 6 matches.                                                     
##   [text1, 255]     States of | America | will emerge 
##   [text1, 325]     have made | America | the greatest
##  [text1, 1067] households in | America | will receive
##  [text1, 2698]    vision for | America | , as        
##  [text1, 3164]      time for | America | to lead     
##  [text1, 3339]     energy in | America | . That's

toks_sotu_pros <- data_corpus %>% 
    tokens(remove_punct = TRUE) %>% 
    tokens_remove(pattern = stopwords("en")) %>% 
    tokens_tolower()

kw_america_pros <- kwic(toks_sotu_pros, 
                             pattern = c("america"),
                             window = 2)

# print first 6 mentions of America and the context of ±2 words
head(kw_america_pros, n = 6)

## Keyword-in-context with 6 matches.                                                              
##   [text1, 109]      united states | america | emerge stronger 
##   [text1, 136]     qualities made | america | greatest force  
##   [text1, 458] working households | america | receive tax     
##  [text1, 1184]         see vision | america | blueprint future
##  [text1, 1404]        either time | america | lead thanks     
##  [text1, 1494]   renewable energy | america | need support

# test: print as table+
library(kableExtra)

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

kw_america_pros |> data.frame() %>%
  dplyr::select(Pre = pre, Keyword = keyword, Post = post, Pattern = pattern) %>%  
  kbl(booktabs = T) %>%
  kable_styling(latex_options = c("striped", "scale_down"), html_font = "Source Sans Pro", full_width = F)

tstat_coll <- data_corpus %>% 
    tokens(remove_punct = TRUE) %>%
    tokens_remove(pattern = stopwords("en"), padding = TRUE) %>% 
    textstat_collocations(size = 2:3, min_count = 5)

#  select the first 20 collocations
head(tstat_coll, 20)

##           collocation count count_nested length   lambda        z
## 1         health care    55           44      2 8.096432 29.84438
## 2       united states    87           17      2 9.290649 29.57031
## 3           last year    46           36      2 5.714933 28.44516
## 4     american people    55           22      2 4.318872 26.54055
## 5           right now    41           29      2 4.946390 25.08424
## 6         high school    24           19      2 8.175795 22.86750
## 7           years ago    31           29      2 6.007038 22.75534
## 8           make sure    35           14      2 7.225183 22.35350
## 9        middle class    35           24      2 9.703782 22.22763
## 10         first time    27            6      2 5.187307 22.01583
## 11       clean energy    28           18      2 7.747080 21.62456
## 12           new jobs    36           24      2 4.073386 21.24003
## 13        took office    17            5      2 8.221849 20.39640
## 14   health insurance    19           16      2 7.193143 19.98062
## 15   small businesses    17           11      2 7.005867 19.52964
## 16           tax cuts    17           13      2 6.561422 19.20325
## 17          every day    18           16      2 5.335121 18.33243
## 18   working families    15            8      2 5.458811 17.86163
## 19     every american    27           17      2 3.837339 17.85800
## 20 immigration system    12            9      2 6.652498 17.73959

dfmat <- quanteda::dfm(toks_sotu_pros)

# most frequent features
topfeatures(dfmat, n = 10)

##  american       new   america       can       now    people        us     years 
##       310       301       291       280       279       275       246       225 
## americans      jobs 
##       220       214

# most frequent features by speaker

topfeatures(dfmat, groups = president, n = 10)

## $`Barack Obama`
##      can      new      now  america   people       us     jobs american 
##      222      217      214      203      196      184      179      177 
##    years     work 
##      161      155 
## 
## $`Donald Trump`
##  american  applause     thank   america       new    people       one   country 
##       133       117        92        88        84        79        78        77 
## americans   tonight 
##        76        73

tstat_key <- dfmat %>%
    quanteda::dfm_group(groups = president) %>%
    quanteda.textstats::textstat_keyness(target = "Donald Trump")

textplot_keyness(tstat_key)

library(quanteda.textmodels) 
library(quanteda.textplots)
 tmod_wf <- textmodel_wordfish(dfmat, dir = c(2, 1))

 # plot the Wordfish estimates by president
    textplot_scale1d(tmod_wf, groups = docvars(dfmat, "president"))

library(topicmodels)

dfmat_obama <- dfmat %>%
  quanteda::dfm_subset(president %in% c("Barack Obama"))
dfmat_trump <- dfmat %>%
  quanteda::dfm_subset(president  %in% c("Donald Trump"))
                                   
tmod_lda_obama <- LDA(dfmat_obama, k = 10, method="Gibbs", control=list(seed=1948))  
terms(tmod_lda_obama, 10)

##       Topic 1       Topic 2          Topic 3       Topic 4        Topic 5     
##  [1,] "ones"        "plan"           "pay"         "unemployment" "going"     
##  [2,] "skills"      "budget"         "control"     "important"    "lot"       
##  [3,] "students"    "health"         "built"       "cory"         "political" 
##  [4,] "development" "banks"          "regulations" "workforce"    "love"      
##  [5,] "prepare"     "cost"           "higher"      "u.s.a"        "democracy" 
##  [6,] "doubt"       "care"           "receive"     "son"          "especially"
##  [7,] "poverty"     "recovery"       "return"      "depend"       "alone"     
##  [8,] "efforts"     "responsibility" "gas"         "ask"          "isil"      
##  [9,] "others"      "crisis"         "brought"     "worker"       "gives"     
## [10,] "process"     "largest"        "dignity"     "iran's"       "planet"    
##       Topic 6         Topic 7    Topic 8    Topic 9      Topic 10   
##  [1,] "wage"          "spending" "can"      "none"       "past"     
##  [2,] "opportunities" "race"     "new"      "week"       "want"     
##  [3,] "achieve"       "goal"     "now"      "incentives" "sick"     
##  [4,] "5"             "come"     "america"  "trillion"   "rate"     
##  [5,] "need"          "level"    "people"   "exports"    "diplomacy"
##  [6,] "15"            "dream"    "us"       "human"      "issues"   
##  [7,] "lower"         "remember" "jobs"     "wall"       "networks" 
##  [8,] "rising"        "nation"   "american" "union"      "earth"    
##  [9,] "changing"      "internet" "years"    "income"     "forces"   
## [10,] "skills"        "willing"  "work"     "hundred"    "childcare"

tmod_lda_trump <- LDA(dfmat_trump, k = 10, method="Gibbs", control=list(seed=1948))  
terms(tmod_lda_trump,10)

##       Topic 1       Topic 2      Topic 3   Topic 4    Topic 5     Topic 6     
##  [1,] "learn"       "vice"       "space"   "applause" "days"      "national"  
##  [2,] "honor"       "soon"       "deliver" "usa"      "sanctuary" "foreign"   
##  [3,] "rebecca"     "countries"  "got"     "put"      "3"         "obamacare" 
##  [4,] "greatest"    "republican" "may"     "secure"   "reached"   "department"
##  [5,] "well"        "signed"     "lead"    "wall"     "aliens"    "insurance" 
##  [6,] "credit"      "crime"      "making"  "confront" "thanks"    "allow"     
##  [7,] "perhaps"     "continue"   "poverty" "whether"  "best"      "truly"     
##  [8,] "legislation" "outdated"   "york"    "century"  "lowest"    "community" 
##  [9,] "senator"     "steps"      "tariffs" "prison"   "u.s"       "ryan"      
## [10,] "increases"   "change"     "culture" "grace"    "take"      "us"        
##       Topic 7     Topic 8     Topic 9    Topic 10   
##  [1,] "american"  "invest"    "building" "look"     
##  [2,] "thank"     "crossings" "ryan"     "taking"   
##  [3,] "america"   "restoring" "veterans" "longer"   
##  [4,] "new"       "israel"    "job"      "walls"    
##  [5,] "country"   "heroic"    "serve"    "something"
##  [6,] "one"       "250th"     "kind"     "liberty"  
##  [7,] "tonight"   "women"     "stands"   "capitol"  
##  [8,] "people"    "energy"    "ms-13"    "happen"   
##  [9,] "americans" "helping"   "live"     "childhood"
## [10,] "now"       "thrive"    "strength" "black"

library(tidytext)
obama_topics <- tidy(tmod_lda_obama, matrix = "beta")
library(ggplot2)
library(dplyr)
terms_per_topic <- 10
obama_top_terms <- obama_topics %>%
#    filter(topic==6 | topic==8) %>%
    group_by(topic) %>%
    top_n(terms_per_topic, beta) %>%
    ungroup() %>%
    arrange(topic, -beta)
# top_n() doesn't handle ties -__- so just take top 10 manually
obama_top_terms <- obama_top_terms %>%
    group_by(topic) %>%
    slice(1:terms_per_topic) %>%
    ungroup()

obama_top_terms$topic <- factor(obama_top_terms$topic)

obama_top_terms %>%
  mutate(term = reorder(term, beta)) %>%
  ggplot(aes(term, beta)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ topic, scales = "free") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  coord_flip()