COVID - Análisis exploratorio

library(qdapRegex)
library(sentimentr)
library(syuzhet)
library(lubridate)
library(tidyverse)
library(tidytext)
library(forcats)
library(tokenizers)
library(widyr)
library(igraph)
library(ggraph)
library(topicmodels)
library(forcats)
library(scales)
library(stringr)
library(extrafont)
library(reldist)
library(grid)
library(gridExtra)
library(boot)
library(ggradar)
library(tidygraph)

# paleta
plots_palette <- c("#ad5d51", "grey55", "#2b559e", "#947240")


# orden comunidades
comunidad_order <- c("GOP", "Independent", "DNC", "Progressives")


# NECESITO SABER LA DISTRIBUCION DE TWEETS POR MIEMBRO DE UNA COMUNIDAD
# PARA SABER SI HAY UNA SITUACIÓN MUY DESEQUILIBRADA

# detectar emojis
# https://stackoverflow.com/questions/43359066/how-can-i-match-emoji-with-an-r-regex
library(remoji)

library(lexicon)
library(rtweet)
# Sys.getenv()
Sys.setenv(JAVA_HOME = "C:\\Program Files\\Java\\jre1.8.0_251")

library(tm)
library(qdap)


# funciones auxiliares
source(here::here("scripts", "funciones_auxiliares.R"))

Distribucion de tweets

Carga de datos. Estos datos han sido previamente procesados, sobre todo en lo que se refiere al texto de los tweets. Se han unificado los términos relacionados con el COVID-19, como “corona”, “coronavirus”, “pandemic” “covid2019”, etc.

Se ha recogido también información sobre los seguidores de cuentas para definir 4 comunidades

• GOP: Seguidores de la cuenta del partido republicano, que no siguen la cuenta del partido demócrata ni del movimiento progresista
• DNS: Seguidores de la cuenta del partido demócrata, que no siguen la cuenta del partido republicano ni del movimiento progresista
• Progressives: Seguidores de la cuenta del movimiento progresista, que no siguen la cuenta del partido republicano ni del partido demócrata
• Independent: usuarios de tweets recogidos que no se encuentran incluidos en ninguno de los casos anteriores

covid1 <- readRDS(here::here("datos_procesados", "formated_text_df_data", "covid_part1.rds")) 
 

covid2 <- readRDS(here::here("datos_procesados", "formated_text_df_data", "covid_part2.rds")) 

covid <- bind_rows(covid1, covid2) %>% 
  dplyr::distinct(status_id, .keep_all = TRUE) %>% 
  mutate(comunidad = fct_relevel(comunidad, c("GOP", "Independent", "DNC", "Progressives"))) %>% 
  mutate(text = str_replace_all(text, "(COVID|covid)19_?19(19|[0-9]{1,2})?s?|(COVID|covid)19pandemic|corona(19)?", "COVID19")) %>% 
  mutate(text = str_replace_all(text, "covid19covid19", "covid19"))

rm(covid1, covid2)
gc()

##            used  (Mb) gc trigger  (Mb) max used  (Mb)
## Ncells  4539024 242.5    8423615 449.9  4562056 243.7
## Vcells 27816918 212.3   56883221 434.0 48985763 373.8

El número todal de tweets únicos recogidos, sin incluir retweets es de 524.843.

Los usuarios no asociados a nunguna comunidad son los que publican la mayoría de los tweets

covid %>% 
  count(comunidad) %>% 
  mutate(f = percent(n / sum(n), accuracy = 0.1))

## # A tibble: 4 x 3
##   comunidad         n f    
##   <fct>         <int> <chr>
## 1 GOP           33512 6.4% 
## 2 Independent  446721 85.1%
## 3 DNC           30694 5.8% 
## 4 Progressives  13916 2.7%

Un reducido grupo de usuarios publica la mayor parte de los tweets.

# sentimiento
freq_tweets_usuario <- get_tweet_distribution(covid)

# Curva de lorenz
freq_tweets_usuario %>% 
  ggplot(aes(x = porc_usuarios_acum, y = porc_tweets_acum)) + 
  geom_line(aes(color = comunidad), size = 1.3) + 
  scale_color_manual(values = plots_palette) + 
  labs(x = "% acumulado de usuarios", y = "% Acumulado de tweets",
       title = "Curva de Lorenz para el nº de usarios y el nº de tweets") +
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) +
  theme_bw() + 
  theme(text = element_text(family = "Georgia", color = "grey45"), 
        legend.title = element_blank())

# gini
gini_comunidades <- freq_tweets_usuario %>% 
  group_by(comunidad) %>% 
  summarise(gini = gini(x = tweets, weights = porc_usuarios)) %>% 
  arrange(desc(gini))

Analisis de Topic

Hashtags más usados

En el GOP abundan hashtags conspirativos como #qanon, #obamagate o #fakenews. Tambíen mensajes de campaña como #trump2020 o #kag (Keep America Great).

En el partido democratá y en el movimiento progresistas abundan hashtags con connotaciones negativas relacionados con la gestión de trump (#trumpsowneverydeath, #trumpliesamericansdie, #trumpgenocide).

En estos grupos también aparece en los primeros lugares #smartnews una aplicación de curación de contenidos de noticias.

No parece haber una distinción de tópicos clara en cada comunidad. En los dos primeros grupos, #trump parece opucar una posición dentral

# datos tidy
covid_unigram <- get_unigrams(covid, c("#covid19", "covid19", "pandemic", "#s"))
covid_hashtag <- get_hashtags(covid_unigram)
covid_frequency <- get_frequencies(covid_hashtag) %>% 
  mutate(word = ifelse(word %in% c("#hydroxycloroquine", "#hcq"), "#hydroxychloroquine", word))


gop_covid_net <- create_hashtag_graph(covid_hashtag, "GOP", c("#covid19", "#s"), minim_n = 5, nodos_n = 15)

## Iniciacion data frame de links
## Obtencion de data frame con conteo de hashtag  por status_id
## Obtencion de data frame de frequencias de hasthags
## Obtencion del porcentade de usuarios del hashtag
## Filtro de datos por nodos mas frecuentes
## Obtencion de tweets unicos
## Inicio de loop para obtener data frame de links
## [1] "Nodo: 1  -  #obamagate"
## [1] "Nodo: 2  -  #hydroxychloroquine"
## [1] "Nodo: 3  -  #wwg1wga"
## [1] "Nodo: 4  -  #foxnews"
## [1] "Nodo: 5  -  #maga"
## [1] "Nodo: 6  -  #qanon"
## [1] "Nodo: 7  -  #trump2020"
## [1] "Nodo: 8  -  #fakenews"
## [1] "Nodo: 9  -  #openamericanow"
## [1] "Nodo: 10  -  #kag"
## [1] "Nodo: 11  -  #trump"
## [1] "Nodo: 12  -  #breaking"
## [1] "Nodo: 13  -  #factsmatter"
## [1] "Nodo: 14  -  #china"
## [1] "Nodo: 15  -  #pandemic"
## Fin de loop
## Adicion de nodos sin links
## Wrangling final del data frame
## Devolucion del data frame

dnc_covid_net <- create_hashtag_graph(covid_hashtag, "DNC", c("#covid19", "#s"), minim_n = 5, nodos_n = 15)

## Iniciacion data frame de links
## Obtencion de data frame con conteo de hashtag  por status_id
## Obtencion de data frame de frequencias de hasthags
## Obtencion del porcentade de usuarios del hashtag
## Filtro de datos por nodos mas frecuentes
## Obtencion de tweets unicos
## Inicio de loop para obtener data frame de links
## [1] "Nodo: 1  -  #smartnews"
## [1] "Nodo: 2  -  #trump"
## [1] "Nodo: 3  -  #news"
## [1] "Nodo: 4  -  #trumpvirus"
## [1] "Nodo: 5  -  #pandemic"
## [1] "Nodo: 6  -  #stayhome"
## [1] "Nodo: 7  -  #hydroxychloroquine"
## [1] "Nodo: 8  -  #maga"
## [1] "Nodo: 9  -  #trumpownseverydeath"
## [1] "Nodo: 10  -  #trumpliesamericansdie"
## [1] "Nodo: 11  -  #trumpgate"
## [1] "Nodo: 12  -  #covid19iots"
## [1] "Nodo: 13  -  #howwefeel"
## [1] "Nodo: 14  -  #biden2020"
## [1] "Nodo: 15  -  #topbuzz"
## Fin de loop
## Adicion de nodos sin links
## Wrangling final del data frame
## Devolucion del data frame

prg_covid_net <- create_hashtag_graph(covid_hashtag, "Progressives", c("#covid19", "#s"), minim_n = 5, nodos_n = 15)

## Iniciacion data frame de links
## Obtencion de data frame con conteo de hashtag  por status_id
## Obtencion de data frame de frequencias de hasthags
## Obtencion del porcentade de usuarios del hashtag
## Filtro de datos por nodos mas frecuentes
## Obtencion de tweets unicos
## Inicio de loop para obtener data frame de links
## [1] "Nodo: 1  -  #votebluenomatterwho"
## [1] "Nodo: 2  -  #smartnews"
## [1] "Nodo: 3  -  #trump"
## [1] "Nodo: 4  -  #pandemic"
## [1] "Nodo: 5  -  #medicareforall"
## [1] "Nodo: 6  -  #usa"
## [1] "Nodo: 7  -  #maga"
## [1] "Nodo: 8  -  #hydroxychloroquine"
## [1] "Nodo: 9  -  #stayhome"
## [1] "Nodo: 10  -  #trumpvirus"
## [1] "Nodo: 11  -  #trumpownseverydeath"
## [1] "Nodo: 12  -  #covid19iots"
## [1] "Nodo: 13  -  #cdnpoli"
## [1] "Nodo: 14  -  #trumpgenocide"
## [1] "Nodo: 15  -  #trumpliesamericansdie"
## Fin de loop
## Adicion de nodos sin links
## Wrangling final del data frame
## Devolucion del data frame

covid_graph <- bind_graphs(gop_covid_net, dnc_covid_net, prg_covid_net) %>% 
  activate(nodes) %>% 
  mutate(comunidad = fct_relevel(comunidad, c("GOP", "DNC", "Progressives")))

# SACAR KPI DE CENTRALIDAD: NODO CON DEGREE/STRENGH MAS ALTO

grob_bars <- ggplotGrob(plot_topics(covid_frequency %>% filter(comunidad != "Independent"), 
                                    c("#health", "#pandemic"), 
                                    cols = 1, colores = c(1, 3, 4)) + 
                          guides(fill = F) + 
                          labs(x = "Frecuencia") +
                          theme(axis.title.y = element_blank(),
                                axis.text.y = element_text(size = 16),
                                axis.text.x = element_text(size = 12),
                                strip.text = element_text(size = 14)))


set.seed(123)
grob_graph <- ggplotGrob(covid_graph %>% 
  ggraph(layout = "nicely") +
  geom_edge_link(alpha = 0.5) + 
  geom_node_point(alpha = 0.3) + 
  geom_node_text(aes(label = nodes, color = comunidad), size = 5.2, family = "Candara", repel = T) +
  facet_nodes(~comunidad, ncol = 1, scales = "free") +
  theme_bw() + 
  guides(color = F) +
  scale_color_manual(values = plots_palette[c(1, 3, 4)]) + 
    theme(panel.grid = element_blank(),
          strip.background = element_blank(),
          strip.text = element_text(family = "Georgia", size = 14, color = "white"),
          panel.border = element_blank(),
          axis.title = element_blank(), 
          axis.text = element_blank(),
          axis.ticks = element_blank()))


titulo <-  textGrob(label = "Hastags más mencionados con el tópico 'COVID19'", gp = gpar(fontfamily = "Georgia", cex = 2))
leyenda <- legendGrob(labels = c("GOP",  "DNC", "Progressives"),  pch = 21, 
                      gp = gpar(fill = plots_palette[c(1, 3, 4)], fontfamily = "Georgia", cex = 1.5), nrow = 1)

plots_grob = arrangeGrob(grob_bars, grob_graph, nrow = 1, widths = c(4, 6))

grid.arrange(titulo, leyenda, plots_grob, heights = c(1, 1, 8))

Terminos propios de cada comunidad

Ahora en GOP, los temas son casiexclusivamente relaciondos con teorías conspirativas: #wwg1wga (donde va uno vamos todos, relacionado con #qanon), o #greatawakening (#también relacionado con #qanon). También hay un hashtag contra el governador del estado de New York, Andrew Cuomo, y otro relacionado con el medicamento hydroxychloroquine.

Tanto en el DNC como en el el movimiento progressista hay hashtags contra Trump, hay unos pocos partidos de campaña a favor del partido demócrata. En el caso del movimiento progresista, el hashtag #votebluenomatterwho podría ser una llamada para los miembros del movimiento progresista más reacios a Votar a Biden.

covid_tfidf_hashtags <- get_tfidf(covid_frequency %>% filter(comunidad!= "Independent"))

plot_tfidf(covid_tfidf_hashtags, cols = 3, colores = c(1, 3, 4)) + 
  labs(title = "Tópicos característicos de cada comunidad", y = "TF-IDF") + 
  theme(axis.title.x= element_blank(),
        axis.text.y = element_text(size = 15),
        legend.title = element_blank())

Sentimiento percibido COVID

Utilizaremos el diccionario NRC para analizar los sentimientos que genera este evento en las diferentes comunidades

covid_nrc <- covid_unigram %>% 
  filter(comunidad != "Independent") %>% 
  inner_join(get_sentiments("nrc"), by = "word") %>% 
  filter(!sentiment %in% c("positive", "negative")) %>% 
  count(comunidad, sentiment, sort = T) %>% 
  mutate(sentiment = str_to_title(sentiment)) %>% 
  ungroup() %>% 
  group_by(comunidad) %>% 
  mutate(n = rescale(n)) %>% 
  pivot_wider(names_from = sentiment, values_from = n) %>% 
  select(comunidad, Joy, Trust, Fear, Surprise, Sadness, Disgust, Anger, Anticipation) %>% 
  ungroup() %>% 
  mutate(comunidad = fct_drop(comunidad))

ggradar(covid_nrc, group.colours = plots_palette[c(1, 3, 4)], legend.position = "top",
        group.point.size = 4,
        plot.title = "Sentimientos expresados hacia el tópico 'COVI19'", 
        legend.text.size = 11) + 
  theme(plot.title = element_text(size = 12, family = "Georgia", color = "grey55"),
        axis.title = element_text(family = "Georgia"))

La puntuación es similar para todas las comunidades

Polarización

Realizamos un test de diferencia de medias para comprobar si la mínima diferencia hallada es significativa.

library(boot)
pol_test_dif <- readRDS(here::here("datos_procesados", "formated_polarization_df_data", "polarization_testing", "covid_polarization.rds"))


pol_test_dif[-1]

## $IC
##                2.5%       97.5%
## DNC-GOP  0.03322876  0.04975325
## DNC-PRG -0.08141952 -0.06794638
## 
## $resultado
## [1] "Diferencia significativa en medias"

pol_test_dif$data %>% 
  ggplot(aes(x = sentimiento)) + 
  geom_histogram(aes(group = comunidad, fill = comunidad), color = "white", alpha = 0.5, binwidth = 0.002, position = "identity") + 
  scale_fill_manual(values = plots_palette[c(1, 4)]) + 
  labs(x = "Average polarity score", title = "Replicaciones bootstrap de la media del scoring de polarización")