Clustering and NLP: Text, Tweets, and Sentiment

class: center, middle, inverse, title-slide

.title[
# Clustering and NLP: Text, Tweets, and Sentiment
]
.subtitle[
## Part 3a
]
.author[
### Prof. Ryan Weldzius
]
.institute[
### Villanova University
]

---

# Returning to Trump

``` r
require(tidyverse)
tweet_words <- read_rds(file="../Data/Trump_tweet_words.Rds")
tweet_words <- tweet_words %>% 
  mutate(PostPresident = Tweeting.date > as.Date('2016-11-06'))
```

---

# Log-Odds

- **Odds**: Probability a word is used pre/post presidency
  
- **Log**: Useful for removing skew in data
  
--

- Interactive code time!

---

# Odds Step 1

``` r
(odds1 <- tweet_words %>%
  count(word, PostPresident) %>%
  spread(PostPresident, n, fill = 0) %>%
  ungroup() %>%
  mutate(totFALSE = sum(`FALSE`),
         totTRUE = sum(`TRUE`)))
```

---

# Odds Step 1

``` r
(odds1 <- tweet_words %>%
  count(word, PostPresident) %>%
  spread(PostPresident, n, fill = 0) %>%
  ungroup() %>%
  mutate(totFALSE = sum(`FALSE`),
         totTRUE = sum(`TRUE`)))
```

```
## # A tibble: 45,221 × 5
##    word      `FALSE` `TRUE` totFALSE totTRUE
##    <chr>       <dbl>  <dbl>    <dbl>   <dbl>
##  1 a               6     27   189217  257487
##  2 aa              1      2   189217  257487
##  3 aaa            11      1   189217  257487
##  4 aamp            1      0   189217  257487
##  5 aand            0      1   189217  257487
##  6 aaron           2      1   189217  257487
##  7 ab              1      2   189217  257487
##  8 abaco           0      1   189217  257487
##  9 abandon         6      8   189217  257487
## 10 abandoned      13     11   189217  257487
## # ℹ 45,211 more rows
```

---

# Odds Step 2

``` r
(odds2 <- odds1 %>%
  mutate(propFALSE = (`FALSE` + 1) / (totFALSE + 1),
         propTRUE = (`TRUE` + 1) / (totTRUE + 1)))
```

---

# Odds Step 2

``` r
(odds2 <- odds1 %>%
  mutate(propFALSE = (`FALSE` + 1) / (totFALSE + 1),
         propTRUE = (`TRUE` + 1) / (totTRUE + 1)))
```

```
## # A tibble: 45,221 × 7
##    word   `FALSE` `TRUE` totFALSE totTRUE propFALSE propTRUE
##    <chr>    <dbl>  <dbl>    <dbl>   <dbl>     <dbl>    <dbl>
##  1 a            6     27   189217  257487   3.70e-5  1.09e-4
##  2 aa           1      2   189217  257487   1.06e-5  1.17e-5
##  3 aaa         11      1   189217  257487   6.34e-5  7.77e-6
##  4 aamp         1      0   189217  257487   1.06e-5  3.88e-6
##  5 aand         0      1   189217  257487   5.28e-6  7.77e-6
##  6 aaron        2      1   189217  257487   1.59e-5  7.77e-6
##  7 ab           1      2   189217  257487   1.06e-5  1.17e-5
##  8 abaco        0      1   189217  257487   5.28e-6  7.77e-6
##  9 aband…       6      8   189217  257487   3.70e-5  3.50e-5
## 10 aband…      13     11   189217  257487   7.40e-5  4.66e-5
## # ℹ 45,211 more rows
```

---

# Odds Step 3

``` r
(odds3 <- odds2 %>%
  mutate(odds = propTRUE / propFALSE))
```

---

# Odds Step 3

``` r
(odds3 <- odds2 %>%
  mutate(odds = propTRUE / propFALSE))
```

```
## # A tibble: 45,221 × 8
##    word   `FALSE` `TRUE` totFALSE totTRUE propFALSE propTRUE
##    <chr>    <dbl>  <dbl>    <dbl>   <dbl>     <dbl>    <dbl>
##  1 a            6     27   189217  257487   3.70e-5  1.09e-4
##  2 aa           1      2   189217  257487   1.06e-5  1.17e-5
##  3 aaa         11      1   189217  257487   6.34e-5  7.77e-6
##  4 aamp         1      0   189217  257487   1.06e-5  3.88e-6
##  5 aand         0      1   189217  257487   5.28e-6  7.77e-6
##  6 aaron        2      1   189217  257487   1.59e-5  7.77e-6
##  7 ab           1      2   189217  257487   1.06e-5  1.17e-5
##  8 abaco        0      1   189217  257487   5.28e-6  7.77e-6
##  9 aband…       6      8   189217  257487   3.70e-5  3.50e-5
## 10 aband…      13     11   189217  257487   7.40e-5  4.66e-5
## # ℹ 45,211 more rows
## # ℹ 1 more variable: odds <dbl>
```

---

# Why log?

``` r
odds3 %>%
  ggplot(aes(x = odds)) + 
  geom_histogram()
```

---

# Why log?

``` r
odds3 %>%
  ggplot(aes(x = odds)) + 
  geom_histogram(bins = 15) + 
  scale_x_log10()
```

---

# Odds Step 4

``` r
(prepost_logodds <- odds3 %>%
  mutate(logodds = log(odds))) %>%
  select(word,logodds,odds,everything())
```

```
## # A tibble: 45,221 × 9
##    word      logodds  odds `FALSE` `TRUE` totFALSE totTRUE
##    <chr>       <dbl> <dbl>   <dbl>  <dbl>    <dbl>   <dbl>
##  1 a          1.08   2.94        6     27   189217  257487
##  2 aa         0.0974 1.10        1      2   189217  257487
##  3 aaa       -2.10   0.122      11      1   189217  257487
##  4 aamp      -1.00   0.367       1      0   189217  257487
##  5 aand       0.385  1.47        0      1   189217  257487
##  6 aaron     -0.714  0.490       2      1   189217  257487
##  7 ab         0.0974 1.10        1      2   189217  257487
##  8 abaco      0.385  1.47        0      1   189217  257487
##  9 abandon   -0.0568 0.945       6      8   189217  257487
## 10 abandoned -0.462  0.630      13     11   189217  257487
## # ℹ 45,211 more rows
## # ℹ 2 more variables: propFALSE <dbl>, propTRUE <dbl>
```

---

# Effect of becoming president

``` r
p <- prepost_logodds %>%
  group_by(logodds > 0) %>%
  top_n(15, abs(logodds)) %>%
  ungroup() %>%
  mutate(word = reorder(word, logodds)) %>%
  ggplot(aes(word, logodds, fill = logodds < 0)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  ylab("Post-President/Pre-President log ratio") +
  scale_fill_manual(name = "", labels = c("President", "Pre-President"),
                    values = c("red", "lightblue"))
```

---

# Effect of becoming president

``` r
p
```

---

# Meaning

- Thus far, everything is **topic**-related

- How often he talks about things
  
--

- But what does he **mean** when he talks about Mueller?

- We can probably guess
  
--

- But we want a more systematic method

- **Sentiment**: the *feeling* behind words
  
---

# Meaning

- **Sentiment** analysis is based on **dictionaries**

- Just like **stop words** from last week!
  
--

- Prepared lists of words, but tagged according to **emotion**
  
--

- Good dictionary included in `tidytext` package

``` r
require(tidytext) # Might need to install.packages('textdata')
# nrc <- get_sentiments("nrc")
# If this doesn't work on your computer, just load it with read_rds()
nrc <- read_rds('../Data/nrc.Rds')
```

---

# Meaning

``` r
nrc
```

```
## # A tibble: 13,901 × 2
##    word        sentiment
##    <chr>       <chr>    
##  1 abacus      trust    
##  2 abandon     fear     
##  3 abandon     negative 
##  4 abandon     sadness  
##  5 abandoned   anger    
##  6 abandoned   fear     
##  7 abandoned   negative 
##  8 abandoned   sadness  
##  9 abandonment anger    
## 10 abandonment fear     
## # ℹ 13,891 more rows
```

---

# Sentiment by Pre/Post Presidency

- Measure sentiment by proportion of words

- Divide by pre/post presidency

``` r
(word_freq <- tweet_words %>%
  group_by(PostPresident) %>%
  count(word) %>%
  filter(sum(n) >= 5) %>%
  mutate(prop = prop.table(n))) # Faster way of calculating proportions!
```

```
## # A tibble: 54,438 × 4
## # Groups:   PostPresident [2]
##    PostPresident word           n       prop
##    <lgl>         <chr>      <int>      <dbl>
##  1 FALSE         a              6 0.0000317 
##  2 FALSE         aa             1 0.00000528
##  3 FALSE         aaa           11 0.0000581 
##  4 FALSE         aamp           1 0.00000528
##  5 FALSE         aaron          2 0.0000106 
##  6 FALSE         ab             1 0.00000528
##  7 FALSE         abandon        6 0.0000317 
##  8 FALSE         abandoned     13 0.0000687 
##  9 FALSE         abbott         1 0.00000528
## 10 FALSE         abbottabad     1 0.00000528
## # ℹ 54,428 more rows
```

---

# Sentiment by Pre/Post Presidency

- Attaching sentiment from `nrc`

- `inner_join()`: only keeps words that appear in `nrc`

``` r
word_freq_sentiment <- word_freq %>%
    inner_join(nrc, by = "word") 
```

---

# Sentiment overall

``` r
p <- word_freq_sentiment %>%
  group_by(sentiment) %>%
  top_n(10, n) %>%
  ungroup() %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(y = word, x = n)) +
  facet_wrap(~ sentiment, scales = "free", nrow = 3) + 
  geom_bar(stat = "identity")
```

---

# Sentiment overall

``` r
p
```

---

# Sentiment overall

- Could also just calculate positive sentiments - negative sentiments

- Want to do this at the tweet level
  
--

``` r
tweet_sentiment <- tweet_words %>%
    inner_join(nrc, by = "word") 
  
tweet_sentiment_summary <- tweet_sentiment %>%
  group_by(PostPresident, sentiment) %>%
  count(document,sentiment) %>%
  pivot_wider(names_from = sentiment, 
              values_from = n, 
              values_fill = 0) %>% # same as spread()!
  mutate(sentiment = positive - negative)
```

---

# Sentiment overall

``` r
tweet_sentiment_summary %>%
  select(PostPresident,document,sentiment,everything())
```

```
## # A tibble: 45,592 × 13
## # Groups:   PostPresident [2]
##    PostPresident   document sentiment anger anticipation
##    <lgl>              <dbl>     <int> <int>        <int>
##  1 FALSE         1701461182         1     1            3
##  2 FALSE         1741160716         0     1            1
##  3 FALSE         1924074459         0     1            1
##  4 FALSE         2045871770        -1     1            0
##  5 FALSE         2317112756        -1     1            0
##  6 FALSE         2346367430        -1     2            1
##  7 FALSE         2403435685         2     1            2
##  8 FALSE         3688564134        -2     1            0
##  9 FALSE         7677152231         0     1            1
## 10 FALSE         8083871612         0     1            1
## # ℹ 45,582 more rows
## # ℹ 8 more variables: disgust <int>, fear <int>, joy <int>,
## #   negative <int>, positive <int>, sadness <int>,
## #   surprise <int>, trust <int>
```

---

# Sentiment by presidency

- Calculate total number of tweets by sentiment

``` r
tweet_sentiment_summary  %>%
  group_by(PostPresident) %>%
  mutate(ntweet = 1) %>%
  summarize(across(-document, sum)) %>%
  select(PostPresident,sentiment,everything())
```

```
## # A tibble: 2 × 13
##   PostPresident sentiment anger anticipation disgust  fear
##   <lgl>             <int> <int>        <int>   <int> <int>
## 1 FALSE             12372  8138        13333    5356  7999
## 2 TRUE               5823 13892        14095    8933 14051
## # ℹ 7 more variables: joy <int>, negative <int>,
## #   positive <int>, sadness <int>, surprise <int>,
## #   trust <int>, ntweet <dbl>
```

---

# Sentiment by presidency

- Univariate distributions!

``` r
p <- tweet_sentiment_summary %>%
  ggplot(aes(x = sentiment, y = PostPresident)) + 
  geom_boxplot() +
  labs(y= "Trump is president", x = "Sentiment Score: Positive - Negative")
```

---

# Sentiment by presidency

- Univariate distributions!

``` r
p
```

---

# Sentiment by hour

- Univariate distributions

- Comparing sentiment by hour
  
--

``` r
p <- tweet_sentiment %>%
  group_by(PostPresident,Tweeting.hour,sentiment) %>%
  count(document,sentiment) %>%
  pivot_wider(names_from = sentiment, values_from = n, values_fill = 0) %>% 
  mutate(sentiment = positive - negative) %>%
  summarize(AvgSentiment = mean(sentiment)) %>%
  ggplot(aes(y = AvgSentiment, x= as.integer(Tweeting.hour), color=PostPresident)) + 
  geom_point(size = 4) +
  geom_hline(yintercept = 0,linetype = 'dashed') + 
  labs(x = "Tweeting Hour (EST)", y = "Average Tweet Sentiment: Positive - Negative", color = "Is President?") +
  scale_x_continuous(n.breaks = 13, limits = c(0,23))
```

---

# Sentiment by hour

- Comparing sentiment by hour

``` r
p
```

---

# Next Time

- Understanding Trump via Tweets!