text_analysis

ACTUAL ASSIGNMENT STARTS

library(tidyverse)

Warning: package 'tidyverse' was built under R version 4.3.2

Warning: package 'lubridate' was built under R version 4.3.2

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.2     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.4.2     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.1     
── 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)        # package for text analysis

Warning: package 'tidytext' was built under R version 4.3.3

library(readxl)          # reads excel files, the format I used for the data

manifestos <- read_excel("manifestos.xlsx")

manifesto_words <- manifestos |>
  unnest_tokens(word, text)

This is me setting up the data.

manifesto_words |> 
  group_by(author) |> 
  summarize(num_words = n(), 
            lex_diversity = n_distinct(word),
            lex_density = lex_diversity/num_words)

# A tibble: 6 × 4
  author       num_words lex_diversity lex_density
  <chr>            <int>         <int>       <dbl>
1 Auvinen           1750           624       0.357
2 Breivik           5186          1457       0.281
3 Cho               1971           608       0.308
4 HarperMercer      1589           580       0.365
5 Rodger            6216          1310       0.211
6 Unabomber         5100          1300       0.255

This is each author separated by the number of words in their manifesto, how many different words there were in their manifesto, and the lexical density of their manifesto (i.e., how many different words they used divided by the total number of words in the manifesto).

manifesto_words |>
  mutate(word_length = nchar(word)) |> 
  distinct(word, word_length, author) |> 
  arrange(-word_length)

# A tibble: 5,879 × 3
   word                word_length author   
   <chr>                     <int> <chr>    
 1 deindividualization          19 Auvinen  
 2 disproportionately           18 Breivik  
 3 oversocialization            17 Unabomber
 4 naturalselector89            17 Auvinen  
 5 hypersensitivity             16 Unabomber
 6 enthusiastically             16 Unabomber
 7 responsibilities             16 Cho      
 8 multiculturalism             16 Breivik  
 9 anthropologists              15 Unabomber
10 individualistic              15 Unabomber
# ℹ 5,869 more rows

This is a list of each author’s longest words.

manifesto_words |>
  group_by(author) |> 
  mutate(word_length = nchar(word)) |> 
  summarize(mean_word_length = mean(word_length)) |> 
  arrange(-mean_word_length)

# A tibble: 6 × 2
  author       mean_word_length
  <chr>                   <dbl>
1 Breivik                  5.15
2 Unabomber                4.91
3 Auvinen                  4.85
4 Cho                      4.25
5 Rodger                   4.15
6 HarperMercer             4.11

This is the average word length of each author.

manifesto_words |>
  mutate(word_length = nchar(word)) |> 
  ggplot(aes(word_length)) +
  facet_wrap(vars(author), scales = "free_y") +
  geom_histogram() +
  labs(title = "Distribution of Word Length for Each Manifesto")

`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

This is the distribution of the word lengths in each author’s manifesto.

manifesto_words |> 
  group_by(author) |>
  count(word, sort = T) |>
 top_n(5) |>
  ungroup() |> 
  mutate(word = reorder(word, n)) |>
  ggplot(aes(word, n, fill = author)) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  facet_wrap(~author, scales = "free") +           
  scale_fill_viridis_d() +                         
  theme_minimal() +                                
  labs(x = NULL, y = "Most common words")

Selecting by n

These are the most common words each author used.

stop_words |> 
  filter(lexicon == "snowball") -> snowball

manifesto_words |>
  anti_join(snowball) |>
  group_by(author) |>
count(word, sort = T)|>
  top_n(5) |> 
  ungroup() |> 
  mutate(word = reorder(word, n)) |>
  ggplot(aes(word, n, fill = author)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "Most common words") +
  facet_wrap(vars(author), scales = "free") +
  scale_fill_viridis_d() +
  theme_minimal() +
  coord_flip()

Joining with `by = join_by(word)`
Selecting by n

These are each author’s most common words with the filler/stop words removed.

manifesto_word_counts <- manifestos |>             
  unnest_tokens(word, text) |>
  count(author, word, sort = TRUE) 

total_words <- manifesto_word_counts |>               
  group_by(author) |> 
  summarize(total = sum(n))

manifesto_word_counts <- left_join(manifesto_word_counts, total_words)    

Joining with `by = join_by(author)`

manifesto_tf_idf <- manifesto_word_counts |>             
  bind_tf_idf(word, author, n)

manifesto_tf_idf |>                                   
  arrange(-tf_idf)      

# A tibble: 5,879 × 7
   author    word            n total      tf   idf  tf_idf
   <chr>     <chr>       <int> <int>   <dbl> <dbl>   <dbl>
 1 Cho       you           130  1971 0.0660  0.405 0.0267 
 2 Cho       your           34  1971 0.0173  1.10  0.0190 
 3 Cho       fuck           19  1971 0.00964 1.79  0.0173 
 4 Breivik   cultural       42  5186 0.00810 1.79  0.0145 
 5 Breivik   marxism        37  5186 0.00713 1.79  0.0128 
 6 Auvinen   intelligent    10  1750 0.00571 1.79  0.0102 
 7 Auvinen   minded         10  1750 0.00571 1.79  0.0102 
 8 Cho       jesus          18  1971 0.00913 1.10  0.0100 
 9 Unabomber leftist        27  5100 0.00529 1.79  0.00949
10 Breivik   frankfurt      27  5186 0.00521 1.79  0.00933
# ℹ 5,869 more rows

This is a chart, by author and word, of the term frequency (how often the word appears in a document), inverse document frequency (a measure of word uniqueness and uncommonness) and tf-idf (the term frequency and inverse document frequency multiplied together).

manifesto_tf_idf |>
  arrange(-tf_idf) |>
  mutate(word = factor(word, levels = rev(unique(word)))) |> 
  group_by(author) |> 
  top_n(5) |> 
  ggplot(aes(word, tf_idf, fill = author)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~author, scales = "free") +
  coord_flip() +
  theme_minimal() +
  scale_fill_viridis_d() +
  labs(title = "Most distinctive words in each manifesto")

Selecting by tf_idf

This is a graph of tf-idf by author and their most unique words.

bing <- get_sentiments("bing")
bing

# A tibble: 6,786 × 2
   word        sentiment
   <chr>       <chr>    
 1 2-faces     negative 
 2 abnormal    negative 
 3 abolish     negative 
 4 abominable  negative 
 5 abominably  negative 
 6 abominate   negative 
 7 abomination negative 
 8 abort       negative 
 9 aborted     negative 
10 aborts      negative 
# ℹ 6,776 more rows

manifesto_words |> 
  inner_join(bing) |> 
  count(word, sentiment, sort = TRUE) |>
group_by(sentiment) |>
  top_n(10) |>
  ungroup() |>
  mutate(word = reorder(word, n)) |>
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(vars(sentiment), scales = "free") +
  labs(y = "Suicide notes: Words that contribute the most to each sentiment",
       x = NULL) +
  scale_fill_viridis_d() +
  coord_flip() +
  theme_minimal()

Joining with `by = join_by(word)`
Selecting by n

This is a graph of some of the most common words in the manifestos that align with either a postivie or negative sentiment.

manifestos |>
  unnest_tokens(bigram, text, token = "ngrams", n = 2) |> 
  select(bigram) -> manifesto_bigrams  

manifesto_bigrams  |> 
  count(bigram, sort = T)

# A tibble: 14,954 × 2
   bigram                    n
   <chr>                 <int>
 1 of the                  159
 2 in the                   81
 3 to the                   69
 4 i was                    60
 5 and the                  56
 6 to be                    43
 7 political correctness    37
 8 i had                    34
 9 it is                    34
10 it was                   30
# ℹ 14,944 more rows

This is a list of the most common bigrams (two-word combinations) in the manifestos.

manifesto_bigrams |> 
  separate(bigram, c("word1", "word2"), sep = " ") |> 
  filter(!word1 %in% snowball$word) |>
  filter(!word2 %in% snowball$word) |> 
  unite(bigram, word1, word2, sep = " ") |> 
count(bigram, sort = T)

# A tibble: 4,115 × 2
   bigram                    n
   <chr>                 <int>
 1 political correctness    37
 2 frankfurt school         22
 3 jesus christ             17
 4 cultural marxism         16
 5 black man                12
 6 human race               12
 7 modern leftism            9
 8 power process             9
 9 surrogate activities      9
10 will never                9
# ℹ 4,105 more rows

This is a list of the most common bigrams in the manifestos with the stop/filler words removed.

first_word <- c("we", "they")                                  

manifesto_bigrams |> 
  count(bigram, sort = T) |> 
  separate(bigram, c("word1", "word2"), sep = " ") |>       
  filter(word1 %in% first_word) |>                          
  count(word1, word2, wt = n, sort = TRUE) |> 
  mutate(word2 = factor(word2, levels = rev(unique(word2)))) |>     
  group_by(word1) |> 
  top_n(5) |> 
  ggplot(aes(word2, n, fill = word1)) +                          
  scale_fill_viridis_d() +                                           
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = NULL, title = "Word following:") +
  facet_wrap(~word1, scales = "free") +
  coord_flip() +
  theme_minimal()

Selecting by n

This is a chart showing the most common bigrams starting with “we” or “they” in the manifestos.