Clustering and NLP: Text, Tweets, and Sentiment

class: center, middle, inverse, title-slide

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

---

# Returning to Trump (Wrangle from last time)

``` r
require(tidyverse)
require(tidytext) # Might need to install.packages('textdata')
tweet_words <- read_rds(file="../Data/Trump_tweet_words.Rds") %>% 
  mutate(PostPresident = Tweeting.date > as.Date('2016-11-06'))
nrc <- read_rds('../Data/nrc.Rds')
tweet_sentiment <- tweet_words %>%
    inner_join(nrc, by = "word") 
prepost_logodds <- tweet_words %>%
  count(word, PostPresident) %>%
  spread(PostPresident, n, fill = 0) %>%
  ungroup() %>%
  mutate(totFALSE = sum(`FALSE`),
         totTRUE = sum(`TRUE`)) %>%
  mutate(propFALSE = (`FALSE` + 1) / (totFALSE + 1),
         propTRUE = (`TRUE` + 1) / (totTRUE + 1)) %>%
  mutate(odds = propTRUE / propFALSE) %>% 
  mutate(logodds = log(odds)) %>%
  select(word,logodds,odds,everything())

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)
```

---

# Understanding Trump

- When Trump is coded as "positive" or "negative", what is he saying?

- Look at log-odds ratio words, matched to sentiment!

``` r
p <- prepost_logodds %>%
  inner_join(nrc, by = "word") %>%
  filter(!sentiment %in% c("positive", "negative")) %>%
  mutate(sentiment = reorder(sentiment, -logodds),
         word = reorder(word, -logodds)) %>%
  group_by(sentiment) %>%
  top_n(10, abs(logodds)) %>%
  ungroup() %>%
  ggplot(aes(y = word, x = logodds, fill = logodds < 0)) +
  facet_wrap(~ sentiment, scales = "free", nrow = 2) +
  geom_bar(stat = "identity") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  labs(x = "", y = "Post / Pre log ratio") +
  scale_fill_manual(name = "", labels = c("Post", "Pre"),
                    values = c("red", "lightblue")) + 
  theme(legend.position = 'bottom')
```

---

# Understanding Trump

``` r
p
```

---

# Text as predictors

- Let's say we didn't know when each tweet was written

- Could we predict whether it was written during his presidency or not?

- Logit model using **text** as predictors
  
  
---

# Text as Data

- Predict tweets by average of words' log-odds!

``` r
toanalyze <- tweet_words %>%
  select(document,word,PostPresident) %>%
  left_join(prepost_logodds %>% select(word,logodds)) %>% # Link data with log-odds
  group_by(document,PostPresident) %>%
  summarise(logodds = mean(logodds)) %>% # Calculate average log-odds by document
  ungroup()

m <- glm(PostPresident ~ logodds,toanalyze,family = binomial) # logit regression
```

---

# Text as Data

- Evaluate the performance

``` r
require(tidymodels)
forAUC <- toanalyze %>% # Evaluate model performance
  mutate(preds = predict(m,type = 'response'),
         truth = factor(PostPresident,levels = c('TRUE','FALSE')))

roc_auc(forAUC,'truth','preds')
```

```
## # A tibble: 1 × 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.962
```

``` r
p <- roc_curve(forAUC,'truth','preds') %>%
  ggplot(aes(x = 1-specificity,y = sensitivity)) + 
  geom_line() + 
  geom_abline(intercept = 0,slope = 1,linetype = 'dashed')
```

---

# Evaluate performance

``` r
p
```

---

# Evaluate on some sample tweets

``` r
raw_tweets <- read_rds('../Data/Trumptweets.Rds')
set.seed(20)
toCheck <- raw_tweets %>% slice(sample(1:nrow(.),size = 10))

toCheck %>%
  select(content)
```

```
## # A tibble: 10 × 1
##    content                                                  
##    <chr>                                                    
##  1 "RT @ShannonBream: BREAKING:  POTUS commutes Roger Stone…
##  2 "Congratulations to a future STAR of the Republican Part…
##  3 "@Seanelmi  Thanks Sean."                                
##  4 "\"\"\"@007lLisav: @CNN @realDonaldTrump @CNNPolitics ca…
##  5 "RT @thejtlewis: @realDonaldTrump https://t.co/W7L9kCZK3…
##  6 "RT @TrumpWarRoom: WATCH: @KatrinaPierson explains Joe B…
##  7 "The State Department's 'shadow government' #DrainTheSwa…
##  8 "Sexual pervert Anthony Weiner has zero business holding…
##  9 "TO MY FAVORITE PEOPLE IN THE WORLD! https://t.co/38DbQt…
## 10 "Small businesses will have an ally in the White House w…
```

---

# Evaluate on some sample tweets

``` r
toTest <- toCheck %>% left_join(toanalyze,by = c('id' = 'document')) # Merge the raw text with the log-odds

toTest %>%
  mutate(preds = predict(m,newdata = toTest,type = 'response')) %>%
  select(content,PostPresident,preds) %>%
  mutate(pred_binary = preds > .5) %>%
  filter(PostPresident != pred_binary)
```

```
## # A tibble: 3 × 4
##   content                    PostPresident preds pred_binary
##   <chr>                      <lgl>         <dbl> <lgl>      
## 1 @Seanelmi  Thanks Sean.    FALSE         0.985 TRUE       
## 2 The State Department's 's… FALSE         0.731 TRUE       
## 3 TO MY FAVORITE PEOPLE IN … TRUE          0.316 FALSE
```

``` r
# We only make 3 mistakes!
```

---

# Can we do better if we add sentiment?

``` r
toanalyze <- toanalyze %>%
  left_join(tweet_sentiment_summary) %>%
  drop_na()

m1 <- glm(PostPresident ~ logodds,toanalyze,family = binomial)
m2 <- glm(PostPresident ~ logodds + sentiment,toanalyze,family = binomial)
m3 <- glm(PostPresident ~ logodds + anger + anticipation + disgust + fear + joy + sadness + surprise + trust,toanalyze,family = binomial)

forAUC <- toanalyze %>%
  mutate(preds1 = predict(m1,type = 'response'),
         preds2 = predict(m2,type = 'response'),
         preds3 = predict(m3,type = 'response'),
         truth = factor(PostPresident,levels = c('TRUE','FALSE')))
```

---

# Can we do better if we add sentiment?

``` r
roc_auc(forAUC,'truth','preds1') %>% mutate(model = 'logodds') %>%
  bind_rows(roc_auc(forAUC,'truth','preds2') %>% 
              mutate(model = 'logodds & net sentiment')) %>%
  bind_rows(roc_auc(forAUC,'truth','preds3') %>% 
              mutate(model = 'logodds & detailed sentiment'))
```

```
## # A tibble: 3 × 4
##   .metric .estimator .estimate model                       
##   <chr>   <chr>          <dbl> <chr>                       
## 1 roc_auc binary         0.966 logodds                     
## 2 roc_auc binary         0.967 logodds & net sentiment     
## 3 roc_auc binary         0.968 logodds & detailed sentiment
```

- Not really

---

# Conclusion

- Sentiment can...

- ...help us describe the data (i.e., infer what someone meant)
  
  - ...help us predict the data (RQ: do positive tweets get more likes?)

---

# Pat yourselves on the back! Look how far you've come...

- R basics, ggplot, and **MORE ggplot**!!

- Data wrangling and univariate analysis (**AND MORE ggplot!**)

- Multivariate analysis (conditional means)

- Uncertainty

- Linear regression

- Logistic regression

- K-means clustering and Natural Language Processing

---

# Conclusion

- That's it! We're done!