Text Analysis Assignment

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.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)        # package for text analysis
library(readxl)          # reads excel files, the format I used for the data

manifestos <- read_excel("manifestos.xlsx")

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

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 table shows the number of words, the lexical diversity, and the lexical density for each manifesto author.

manifesto_words |>
  mutate(word_length = nchar(word)) |> 
  ggplot(aes(word_length)) +
  facet_wrap(vars(author), scales = "free_y") +
  geom_histogram(binwidth = 1) +
  theme_minimal() +
  labs(title = "Word length distribution for each manifesto")

These graphs show the distribution of word lengths for each manifesto author.

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") +           # creates separate graphs for each author
  scale_fill_viridis_d() +                         # uses a nicer color scheme
  theme_minimal() +                                # removes the gray background
  labs(x = NULL, y = "Most common words")

Selecting by n

These graphs show the most common words used by each manifesto author.

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


::: {.cell}

```{.r .cell-code}
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) +
  coord_flip() +
  facet_wrap(~author, scales = "free") +           # creates separate graphs for each author
  scale_fill_viridis_d() +                         # uses a nicer color scheme
  theme_minimal() + 
  coord_flip() +
   labs(x = NULL, y = "Most common words")

Joining with `by = join_by(word)`
Selecting by n
Coordinate system already present. Adding new coordinate system, which will
replace the existing one.

:::

These graphs show the most common words used by each manifesto author when excluding stop words (common words such as the, a, and, etc.).

manifesto_word_counts <- manifestos |>             # This counts each word per author
  unnest_tokens(word, text) |>
  count(author, word, sort = TRUE) 

total_words <- manifesto_word_counts |>               # This counts total words per author
  group_by(author) |> 
  summarize(total = sum(n))

manifesto_word_counts <- left_join(manifesto_word_counts, total_words)    # Joins the two

Joining with `by = join_by(author)`

manifesto_tf_idf <- manifesto_word_counts |>             # Calculates tf-idf
  bind_tf_idf(word, author, n)

manifesto_tf_idf |>                                   # Displays it
  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 table shows the Term Frequency-Inverse Document Frequency for each manifesto author.

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") +
  theme_minimal() +
  scale_fill_viridis_d() +
  labs(title = "Most distinctive words in each manifesto") +
  coord_flip()

Selecting by tf_idf

These graphs show the TF-IDF for each manifesto author.

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 = "Manifestos: 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

These graphs show a sentiment analysis with the most common and negative words used by the manifesto authors.

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 table shows the most common bigrams used by the manifesto authors.

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 table shows the most common bigrams used by the manifesto authors with stop words (commonly used words) excluded.

first_word <- c("i", "you")                                  # these need to be lowercase

manifesto_bigrams |> 
  count(bigram, sort = T) |> 
  separate(bigram, c("word1", "word2"), sep = " ") |>       # separate the two words
  filter(word1 %in% first_word) |>                          # find first words from our list
  count(word1, word2, wt = n, sort = TRUE) |>
  mutate(word2 = factor(word2, levels = rev(unique(word2)))) |>     # put the words in order
  group_by(word1) |> 
  top_n(5) |> 
  ggplot(aes(word2, n, fill = word1)) +                          
  scale_fill_viridis_d() +                                           # set the color palette
  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

These graphs show the most common words to come after “i” and “you” by the manifesto authors.