delta8tweets_tidy_author.Rmd

---
title: "delta8tweets"
author: "Drew Walker"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output: html_document
bibliography: references.bib
---

# Tidy Adaptation

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
#remotes::install_github("slu-openGIS/postmastr")
library(operators)
library(magrittr)
library(stm)
library(here)
library(postmastr)
library(textmineR)
detach(package:plyr)
library(tidyverse)
library(tidytext)
library(knitr) #Create nicely formatted output tables
library(kableExtra) #Create nicely formatted output tables
library(formattable) #For the color_tile function
library(lubridate)
library(academictwitteR)
library(tm)
library(tidygeocoder)
library(ggpubr)
library(topicmodels)
library(scales)
library(gt)
library(webshot)
library(epitweetr)

APIToken <- read_csv("apikeys.csv")
api_key <- as.character(APIToken[1,1])
api_secret_key <- as.character(APIToken[1,2])
bearer_token <- as.character(APIToken[1,3])
```

# Resources for topic modeling

Tidy Text Mining With R (Julia Silge) <https://www.tidytextmining.com/topicmodeling.html>

Predominantly used: has some older code that i had to fix, may try to convert to Julia's topicmodels package <https://towardsdatascience.com/beginners-guide-to-lda-topic-modelling-with-r-e57a5a8e7a25>

# Pull tweet full archive tweet data

-   Add search by hashtag

```{r get-hashtag-delta8-tweets}
#
##Get tweets with Delta 8 thc or delta 8 hashtag

today <- as.POSIXct(Sys.Date())
hashtag_delta8_tweets_jan_2020 <-  get_all_tweets(
  query = "#delta8",
  start_tweets = "2020-01-01T00:00:00Z",
  end_tweets = "2021-08-03T00:00:00Z",
  bearer_token,data_path = "data/",
  n = 100000)

users_hashtag_d8_tweets_jan_2020 <-
get_user_profile(unique(hashtag_delta8_tweets_jan_2020$author_id), bearer_token)
#
users_hashtag_d8_tweets_jan_2020 <- users_hashtag_d8_tweets_jan_2020 %>% 
  rename(author_id = id)
#
#
hashtag_delta8_tweets_and_user_info_jan_2020 <- left_join(hashtag_delta8_tweets_jan_2020, users_hashtag_d8_tweets_jan_2020, by = "author_id")

write_rds(hashtag_delta8_tweets_and_user_info_jan_2020, "hashtag_delta8_tweets_and_user_info_jan_2020.rds")
```

# Tweet data NLP and trend analysis

```{r delta8tweets,}
d8_tweets <- readRDS("hashtag_delta8_tweets_and_user_info_jan_2020.rds")
d8_tweets <- d8_tweets
```

# prepping for nlp

 and recent research recommending for adhoc removeal of stopwords and stuff instead  instead. [@schofield2017]

-   [@boon-itt2020] removed urls, emojis, special characters, retweets, hashtag symbols, hyperlinks.
    -   Also removed stopwords, lower cased, digits, words like delta8, delta, thc, http

```{r, preprocessing-tweets}
#Remove @ and RT tweet notation
d8_tweets$text <- gsub("RT.*:", "", d8_tweets$text)
d8_tweets$text <- gsub("@.* ", "", d8_tweets$text)
# sub out digits , punctuation
#Should digits be included in case of delta 8, delta 10? 

d8_tweets_text_id <- d8_tweets %>% 
  select(text,author_id,id) %>% 
  group_by(author_id) %>% 
  mutate(author_text = paste0(text, collapse = " ")) %>% 
  distinct(author_id,author_text) %>% 
  select(id = author_id,
         text = author_text)

d8_tweets_text_id$text <- gsub('[[:punct:]]+', '', d8_tweets_text_id$text)
text_cleaning_tokens <- d8_tweets_text_id %>% 
  tidytext::unnest_tokens(word, text) %>% 
  left_join(d8_tweets_text_id, by = "id") %>%
  mutate(raw_text = text)
#remove words? like 

text_cleaning_tokens$word <- gsub('[[:digit:]]+', '', text_cleaning_tokens$word)
text_cleaning_tokens$word <- gsub('^https|^amp$|^delta$|^delta 8$|^thc$|^cbd$|^hemp$|^cannabis$', '', text_cleaning_tokens$word)
#remove anything where word is only 1 character like a i d, remove stopwords
text_cleaning_tokens <- text_cleaning_tokens %>% filter(!(nchar(word) == 1))%>% 
  anti_join(stop_words)
#Stem/lemmatizer?
# https://blogs.cornell.edu/cornellnlp/2019/02/09/choose-your-words-wisely-for-topic-models/ 
# may not need to, is often done to save resources, or combine multiple words to mean same thing. May try to do as a sensitivity check 

#remove commonly occurring words


#remove spaces
text_cleaning_tokens <- text_cleaning_tokens %>% 
  count(id,word) %>% 
  filter(word != "")
```

# Create document term matrix

```{r, create-dtm}
#create DTM
tweet_dtm <- text_cleaning_tokens %>% 
  cast_dtm(id,word,n)
```

# Running lda on up to 20 clusters, determining number of ks for analysis by highest coherence score

-   We evaluated lda models using 1-20 clusters, and chose to conduct the analysis using 3 clusters due to the highest coherence score.

-   We tried others inaugural_dfmas a sensitivity analysis

```{r, lda}
models <- tibble(K = 2:40) %>%
  mutate(topic_model = map(K, ~LDA(tweet_dtm,k = ., control = list(seed = 5849))))

current_time <- Sys.time()
st <- format(current_time,"%Y-%m-%d_%H_%M",)

rdsfilename <- paste0(here("summarysave_authors"),st,".rds") 
saveRDS(models, rdsfilename)
```

```{r, get-model-perplexity}
tibble(
  k = models$K,
  perplex = map_dbl(models$topic_model, perplexity)
) %>%
  ggplot(aes(k, perplex)) +
  geom_point() +
  geom_line() +
  labs(
    title = "Evaluating LDA topic models",
    subtitle = "Optimal number of topics (smaller is better)",
    x = "Number of topics",
    y = "Perplexity"
  )
#Save ggplot below, change to classic theme
perplexityFilename <- paste0(here("perplexity_author"),st,".png") 
ggsave(perplexityFilename)
```

```{r test-model}

topics <- 2:15

lda_and_summary <- function(topic_number){
best_fit_model <- LDA(tweet_dtm,k=topic_number, control = (list(seed = 5849)))


d8_twitter_topics_beta <- tidy(best_fit_model, matrix = "beta")
d8_twitter_topics_beta

d8_top_terms <- d8_twitter_topics_beta %>%
  group_by(topic) %>%
  slice_max(beta, n = 15) %>% 
  ungroup() %>%
  arrange(topic, -beta)

top_terms_plot <- d8_top_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>% 
  ggplot(aes(beta, term, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  scale_y_reordered() %>% 
  print()
current_time <- Sys.time()
st <- format(current_time,"%Y-%m-%d_%H_%M")

topicsFilename <- paste0(here("topics_authors"),topic_number,st,".png") 
ggsave(topicsFilename)
return(d8_top_terms)
}

topics_dfs <- topics %>% 
  as_tibble() 

for (value in topics_dfs$value){
  lda_and_summary(value)
}

```

"Alternatively, expert human judgment has been used to evaluate topic modeling outputs, especially when the modeling outputs are supposed to be used for human interpretation (Mimno et al., 2011, Mimno et al., 2011). Although human judgment is effective for judging the interpretability of topic modeling outputs, it is labor and time intensive (Baumer et al., 2017)."

-   Meaning, if we can identify topics that highlight meaningful differences/features to identify texts. Can we use delphi method?
-   Instructions: indicate a selected topic to most frequent word clusters that makes the most sense to substance abuse researcher/social media expert.

# Sentiment Analysis

```{r, nrc}
nrc <- get_sentiments("nrc") # get specific sentiment lexicons in a tidy format

nrc_words <- text_cleaning_tokens %>%
  inner_join(nrc, by="word")

nrc_sentiment_top_terms <- nrc_words %>%
  group_by(sentiment) %>%
  slice_max(n, n = 5) %>% 
  mutate(top_terms = paste0(word, collapse = " , ")) %>% 
  ungroup() %>%
  arrange(sentiment, -n) 

kable(nrc_sentiment_top_terms)

bar_words<- nrc_words %>%
  group_by(sentiment) %>% # group by sentiment type
  tally %>% # counts number of rows
  arrange(desc(n)) %>% 
  mutate(percent = n/sum(n)) %>% 
  left_join(nrc_sentiment_top_terms, by = "sentiment")
       
bar_words_table <- bar_words %>% 
  select(sentiment,n.x,percent,top_terms) %>% 
  rename(word_count_by_sentiment = n.x) %>% 
  distinct(sentiment,word_count_by_sentiment,percent,top_terms)

kable(bar_words_table)

# arrange sentiments in descending order based on frequency
#get row percentage

nrc_bar_filename <- paste0(here("nrc_bar_authors"),st,".png") 

nrc_bar <- ggplot(bar_words, aes(x= fct_reorder(sentiment,n.x),y = n.x, fill = sentiment, label = percent)) + 
          geom_col(show.legend = FALSE,
                   width = 1)+
    geom_text(aes(label = percent), hjust = .14)+
  labs(x = "NRC Sentiment", y = "Frequency of Sentiment Words in Delta 8 Tweets")+
  coord_flip()+
  theme_classic()

ggsave(nrc_bar_filename)

kable(bar_words)
sum(bar_words$n)

bar_words_table_gt <- gt(bar_words_table)

bar_words_table_gt %>% 
  gtsave("nrc_sentiment_table.html", inline_css = TRUE)
```

```{r, trends-over-time}

d8_tweets_by_date <- d8_tweets %>% 
  mutate(day = as.Date(created_at.x),
         month = month(day),
         year = year(day)) %>% 
  dplyr::group_by(day) %>% 
  dplyr::summarize(tweets_per_day = n(),
            likes_per_day = sum(public_metrics.x$like_count, na.rm = TRUE),
            retweets_per_day = sum(public_metrics.x$retweet_count, na.rm = TRUE),
            replies_per_day = sum(public_metrics.x$reply_count, na.rm = TRUE),
            quotes_per_day = sum(public_metrics.x$quote_count, na.rm = TRUE))

tweets_per_day <- ggplot(d8_tweets_by_date, aes(day, tweets_per_day)) +
  geom_line(aes(y = tweets_per_day), color = "darkred")+
  geom_smooth(method = "loess", se = FALSE) +
  labs(x = "January 1, 2020 to August 3, 2021", y = "Tweets per Day", title = "Frequency of Original Tweets per day mentioning #delta8")+
  scale_x_date(date_breaks = "2 months", date_labels = "%b-%y")+
    theme_classic()
tweets_per_day
tweets_per_day_filename <- paste0(here("tweets_per_day"),st,".png") 
ggsave(tweets_per_day_filename)

#likes per day graph
likes_per_day <- ggplot(d8_tweets_by_date, aes(day, likes_per_day)) +
  geom_line(aes(y = likes_per_day), color = "darkblue")+
  geom_smooth(method = "loess", se = FALSE) +
  labs(x = "January 1, 2020 to August 3, 2021", y = "Likes per Day", title = "Frequency of Tweet likes mentioning #delta8")+
  scale_x_date(date_breaks = "2 months", date_labels = "%b-%y")+
    theme_classic()
likes_per_day
likes_per_day_file_name <- paste0(here("likes_per_day"),st,".png") 
ggsave(likes_per_day_file_name)

retweets_per_day <- ggplot(d8_tweets_by_date, aes(day, retweets_per_day)) +
  geom_line(aes(y = retweets_per_day), color = "orange")+
  geom_smooth(method = "loess", se = FALSE) +
  labs(x = "January 1, 2020 to August 3, 2021", y = "Retweets per Day", title = "Frequency of Tweet retweets mentioning #delta8")+
  scale_x_date(date_breaks = "2 months", date_labels = "%b-%y")+
    theme_classic()
retweets_per_day
retweets_per_day_file_name <- paste0(here("retweets_per_day"),st,".png") 
ggsave(retweets_per_day_file_name)

quotes_per_day <- ggplot(d8_tweets_by_date, aes(day, quotes_per_day)) +
  geom_line(aes(y = quotes_per_day))+
  geom_smooth(method = "loess", se = FALSE) +
  labs(x = "January 1, 2020 to August 3, 2021", y = "quotes per Day", title = "Frequency of Tweet quotes mentioning #delta8")+
  scale_x_date(date_breaks = "2 months", date_labels = "%b-%y")+
    theme_classic()
quotes_per_day
quotes_per_day_file_name <- paste0(here("quotes_per_day"),st,".png") 
ggsave(quotes_per_day_file_name)

replies_per_day <- ggplot(d8_tweets_by_date, aes(day, replies_per_day)) +
  geom_line(aes(y = replies_per_day))+
  geom_smooth(method = "loess", se = FALSE) +
  labs(x = "January 1, 2020 to August 3, 2021", y = "replies per Day", title = "Frequency of Tweet replies mentioning #delta8")+
  scale_x_date(date_breaks = "2 months", date_labels = "%b-%y")+
    theme_classic()
replies_per_day
replies_per_day_file_name <- paste0(here("replies_per_day"),st,".png") 
ggsave(replies_per_day_file_name)


```

# Explorations

1.  Filter for "effects"

2.  Maybe try to match with a vocabulary of drug effects? 1. Many of these topics are around different sites selling-- can we prove this by seeing topic:user ratios? 1. Anxiety, High, euphoria, psychoactive, real, depression, calm, wellness, anti(anxiety or depression)

3.  legal (anything interesting we could do there?)

4.  topic models conducted after filtering for words?

5.  Group by authors-- aka concatenate all text data for each unique author (where authors are documents, instead of tweets) Not sure if this has been done

    1.  [@hong2010] pool tweets by author