Text Analysis_Brittanee Fisher

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
inaugural_speeches <- read_excel("inaug_speeches.xlsx")
inaugural_words <- inaugural_speeches |>
  unnest_tokens(word, text)
inaugural_words |> 
  group_by(author) |> 
  summarize(num_words = n(),
            lex_diversity = n_distinct(word),
            lex_density = lex_diversity/num_words)
# A tibble: 7 × 4
  author     num_words lex_diversity lex_density
  <chr>          <int>         <int>       <dbl>
1 FDR             1881           709       0.377
2 Jefferson       1730           680       0.393
3 Kennedy         1365           534       0.391
4 Lincoln         3637          1011       0.278
5 Obama           2399           893       0.372
6 Reagan          2442           845       0.346
7 Washington      1420           593       0.418

This table shows the total number of words each inaugural speech had, the number of distinct words in each speech, and the density of distinct words in each speech. Washington had the highest density of distinct words in his speech.

inaugural_words |>
  mutate(word_length = nchar(word)) |> 
  ggplot(aes(word_length)) +
  facet_wrap(vars(author), scales = "free_y") +
  geom_histogram(binwidth = 1) +
  labs(title = "Word Length Distrbution for Each Inaugural Speech")

These graphs show the word length distribution in each inaugural speech.

inaugural_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 graphs show five most common words used in each inaugural speech.

stop_words |>
  filter(lexicon == "snowball") -> snowball
inaugural_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 (stop words removed)") +
  facet_wrap(vars(author), scales = "free") +
  scale_fill_viridis_d() +
  theme_minimal() +
  coord_flip()
Joining with `by = join_by(word)`
Selecting by n

These graphs show the most common words used in each inaugural speech. These graphs exclude the use of stop words.

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

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

inaugural_word_counts <- left_join(inaugural_word_counts, total_words)    # Joins the two
Joining with `by = join_by(author)`
inaugural_tf_idf <- inaugural_word_counts |>             # Calculates tf-idf
  bind_tf_idf(word, author, n)

inaugural_tf_idf |>                                   # Displays it
  arrange(-tf_idf) 
# A tibble: 5,265 × 7
   author    word           n total      tf   idf  tf_idf
   <chr>     <chr>      <int> <int>   <dbl> <dbl>   <dbl>
 1 FDR       helped         7  1881 0.00372 1.95  0.00724
 2 FDR       leadership     7  1881 0.00372 1.95  0.00724
 3 Lincoln   while         13  3637 0.00357 1.95  0.00696
 4 Kennedy   both          10  1365 0.00733 0.847 0.00621
 5 Kennedy   arms           4  1365 0.00293 1.95  0.00570
 6 FDR       money          5  1881 0.00266 1.95  0.00517
 7 Kennedy   sides          8  1365 0.00586 0.847 0.00497
 8 Lincoln   case           9  3637 0.00247 1.95  0.00482
 9 Lincoln   union         20  3637 0.00550 0.847 0.00466
10 Jefferson principle      6  1730 0.00347 1.25  0.00434
# ℹ 5,255 more rows

This table shows the most unique words that show up in each inaugural speech. The uniquness of each word is determined by the frequency in which it shows up in one speech and the inverse frequency in which it shows up in the other six speeches.

inaugural_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()
Selecting by tf_idf

These graphs show the most unique words that occur in each inaugural speech.

bing <- get_sentiments("bing")
inaugural_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 = "Inaugural Speeches: 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 graph shows the words that contribute the most to both positive sentiment and negative sentiment.

inaugural_speeches |>
  unnest_tokens(bigram, text, token = "ngrams", n = 2) |>
  select(bigram) -> inaugural_bigram
inaugural_bigram |>
  count(bigram, sort = T)
# A tibble: 10,876 × 2
   bigram       n
   <chr>    <int>
 1 of the     146
 2 in the      80
 3 of our      55
 4 to the      55
 5 and the     38
 6 to be       37
 7 it is       35
 8 by the      34
 9 for the     30
10 that the    29
# ℹ 10,866 more rows

This table shows the bigrams among all the inaugural speeches from most common to least common.

inaugural_bigram |> 
  count(bigram, sort = T) |>
  separate(bigram, c("word1", "word2"), sep = " ") |> 
  filter(!word1 %in% snowball$word) |>
  filter(!word2 %in% snowball$word) |> 
  unite(bigram, word1, word2, sep = " ")
# A tibble: 2,399 × 2
   bigram                 n
   <chr>              <int>
 1 let us                18
 2 fellow citizens       16
 3 united states         11
 4 american people        6
 5 federal government     4
 6 government can         4
 7 one section            4
 8 vice president         4
 9 will endure            4
10 among us               3
# ℹ 2,389 more rows

This table shows the most common bigrams in all of the inaugural speeches after removing all stop words.

first_word <- c("american", "fellow")                                  

inaugural_bigram |> 
  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: american and fellow") +
  facet_wrap(~word1, scales = "free") +
  coord_flip() +
  theme_minimal()
Selecting by n

These graphs show the most common words that follow “american” and “fellow” across all seven speeches.