Climate change - análisis exploratorio
Martín Pons
2/6/2020
# librerias
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)
library(boot)
# 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"))
# paleta
plots_palette <- c("#ad5d51", "grey55", "#2b559e", "#947240")
# orden comunidades
comunidad_order <- c("GOP", "Independent", "DNC", "Progressives")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 excluyen términos relacionados con la pandemia que provoca la enfermedad COVID-19 (en el texto sin limpiar, hay un número amplio de términos para referirse a la enfermedad. Se han unificado todos en el término COVID19).
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
climate <- readRDS(here::here("datos_procesados", "formated_text_df_data", "climatechange.rds")) %>%
filter(str_detect(text, "#?covid19|#?COVID|#?[Pp]andemic|#chinavirus|#wuhanvirus", negate = T)) %>%
mutate(comunidad = fct_relevel(comunidad, c("GOP", "Independent", "DNC", "Progressives")))climate %>%
count(comunidad) %>%
mutate(Porcentaje = percent(n /sum(n), accuracy = 0.1))## # A tibble: 4 x 3
## comunidad n Porcentaje
## <fct> <int> <chr>
## 1 GOP 5893 6.9%
## 2 Independent 69013 80.5%
## 3 DNC 5000 5.8%
## 4 Progressives 5838 6.8%# sentimiento
freq_tweets_usuario <- get_tweet_distribution(climate)
# 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
climate_unigram <- get_unigrams(climate, c("#climatechange", "#globalwarming"))
climate_hashtag <- get_hashtags(climate_unigram)
climate_frequency <- get_frequencies(climate_hashtag)
gop_hash_net <- create_hashtag_graph(climate_hashtag, "GOP", c("#climatechange", "#globalwarming"), minim_n = 3)## 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 - #earthday"
## [1] "Nodo: 2 - #climateaction"
## [1] "Nodo: 3 - #climatehoax"
## [1] "Nodo: 4 - #maga"
## [1] "Nodo: 5 - #climatecrisis"
## [1] "Nodo: 6 - #climate"
## [1] "Nodo: 7 - #earthday2020"
## [1] "Nodo: 8 - #trump2020"
## [1] "Nodo: 9 - #co2"
## [1] "Nodo: 10 - #earthday50"
## [1] "Nodo: 11 - #rightonclimate"
## [1] "Nodo: 12 - #climatechangehoax"
## [1] "Nodo: 13 - #greennewdeal"
## [1] "Nodo: 14 - #environment"
## [1] "Nodo: 15 - #science"
## [1] "Nodo: 16 - #fakenews"
## [1] "Nodo: 17 - #qanon"
## [1] "Nodo: 18 - #billgates"
## [1] "Nodo: 19 - #china"
## [1] "Nodo: 20 - #foxnews"
## [1] "Nodo: 21 - #kag"
## [1] "Nodo: 22 - #walkaway"
## Fin de loop
## Adicion de nodos sin links
## Wrangling final del data frame
## Devolucion del data framednc_hash_net <- create_hashtag_graph(climate_hashtag, "DNC", c("#climatechange", "#globalwarming"), minim_n = 3)## 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 - #earthday"
## [1] "Nodo: 2 - #earthday2020"
## [1] "Nodo: 3 - #climatecrisis"
## [1] "Nodo: 4 - #actonclimate"
## [1] "Nodo: 5 - #climateaction"
## [1] "Nodo: 6 - #renewableenergy"
## [1] "Nodo: 7 - #climateactionnow"
## [1] "Nodo: 8 - #biden2020"
## [1] "Nodo: 9 - #energy"
## [1] "Nodo: 10 - #greennewdeal"
## [1] "Nodo: 11 - #sustainability"
## [1] "Nodo: 12 - #cleanenergy"
## [1] "Nodo: 13 - #climate"
## [1] "Nodo: 14 - #climatejustice"
## [1] "Nodo: 15 - #environment"
## [1] "Nodo: 16 - #earthday50"
## [1] "Nodo: 17 - #climateemergency"
## [1] "Nodo: 18 - #gojoe"
## [1] "Nodo: 19 - #teamjoe"
## [1] "Nodo: 20 - #wtp2020"
## Fin de loop
## Adicion de nodos sin links
## Wrangling final del data frame
## Devolucion del data frameprg_hash_net <- create_hashtag_graph(climate_hashtag, "Progressives", c("#climatechange", "#globalwarming"), minim_n = 3)## 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 - #earthday"
## [1] "Nodo: 2 - #greennewdeal"
## [1] "Nodo: 3 - #earthday2020"
## [1] "Nodo: 4 - #climatecrisis"
## [1] "Nodo: 5 - #climateemergency"
## [1] "Nodo: 6 - #climate"
## [1] "Nodo: 7 - #environment"
## [1] "Nodo: 8 - #neverbiden"
## [1] "Nodo: 9 - #climateaction"
## [1] "Nodo: 10 - #medicareforall"
## [1] "Nodo: 11 - #earthday50"
## [1] "Nodo: 12 - #climatejustice"
## [1] "Nodo: 13 - #actonclimate"
## [1] "Nodo: 14 - #gnd"
## [1] "Nodo: 15 - #sustainability"
## [1] "Nodo: 16 - #notmeus"
## [1] "Nodo: 17 - #earthdayathome"
## [1] "Nodo: 18 - #joe"
## [1] "Nodo: 19 - #peoplefoodplanet"
## [1] "Nodo: 20 - #protectthearctic"
## [1] "Nodo: 21 - #renewableenergy"
## [1] "Nodo: 22 - #science"
## Fin de loop
## Adicion de nodos sin links
## Wrangling final del data frame
## Devolucion del data frameclimate_graph <- bind_graphs(gop_hash_net, dnc_hash_net, prg_hash_net) %>%
activate(nodes) %>%
mutate(comunidad = fct_relevel(comunidad, c("GOP", "DNC", "Progressives"))) %>%
activate(nodes) %>%
mutate(degree = centrality_degree()) %>%
filter(degree > 1) %>%
activate(edges) %>%
filter(strength > 1)grob_bars <- ggplotGrob(plot_topics(climate_frequency %>% filter(comunidad != "Independent"),
c("#health"),
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)))
set.seed(123)
grob_graph <- ggplotGrob(climate_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 = 4.8, 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 = 11, 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 'Climate change'", 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))
# plot_topics(healthcare_frequency, c("#covid19", "#health"))Temas propios de comunidades
Hashtags
climate_tfidf_hashtags <- get_tfidf(climate_frequency %>% filter(comunidad!= "Independent"))
plot_tfidf(climate_tfidf_hashtags, cols = 3, colores = c(1, 3, 4)) +
labs(title = "Tópicos característicos de cada comunidad", y = "TF-IDF") +
guides(fill = F) +
theme(axis.title.x= element_blank(),
axis.text.y = element_text(size = 16),
legend.title = element_blank(),
strip.text = element_text(size = 15))
Menciones
La referencia distintiva de cabecera para el GOP es BribeBart News. Un medio conservador, que tuvo como director a Steve Bannon.
La mención más destacada en el partido demócrata es (Rick Wilson)[http://www.therickwilson.com/about/] , estratega político asociado al (Lincoln Project)[https://lincolnproject.us/], un movimiento republicano anti Donald Trump
climate_tfidf_mentions <- get_tfidf(climate_unigram %>% filter(str_detect(word, "^@"),comunidad!= "Independent") %>% get_frequencies())
plot_tfidf(climate_tfidf_mentions, cols = 3, colores = c(1, 3, 4)) +
labs(title = "Tópicos característicos de cada comunidad", y = "TF-IDF") +
guides(fill = F) +
theme(axis.title.x= element_blank(),
axis.text.y = element_text(size = 16),
legend.title = element_blank(),
strip.text = element_text(size = 15))
Sentimiento - NRC
# climatechangte
nrc_climate <- climate_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, Joy)
# predomina miedo
ggradar(nrc_climate %>% ungroup() %>% mutate(comunidad = fct_drop(comunidad)), group.colours = plots_palette[c(1, 3, 4)], legend.position = "top",
group.point.size = 4,
plot.title = "Sentimientos expresados hacia el tópico 'Climate Change'", legend.text.size = 11) +
theme(plot.title = element_text(size = 12, family = "Georgia", color = "grey55"),
axis.title = element_text(family = "Georgia"))
Analisis green new deal
sentimiento - Polaridad
Sorporendentemente los tres grupos dan una valoración positiva.
# he filtrado fuera temas algunos temas políticos porque hay demasiada ironía
green_sent <- readRDS(here::here("datos_procesados", "formated_sent_df_data", "greennewdeal_sent.rds")) %>%
filter(str_detect(text, "#?covid19|#?COVID|#?[Pp]andemic|#chinavirus|#wuhamvirus", negate = T))
green_sent %>%
filter(!is_retweet) %>%
group_by(comunidad) %>%
summarise(sent = mean(ave_sentiment),
n = n())## # A tibble: 3 x 3
## comunidad sent n
## <chr> <dbl> <int>
## 1 DNC 0.227 251
## 2 GOP 0.187 841
## 3 Progressives 0.253 1276En este caso, en el partido republicano hay un número significativo de tweets irónicos, con lo que este tipo de análisis queda invalidado
green_sent %>%
filter(status_id == "1260399668594454531") %>% .$text## [1] "@rooticusprime @sadieisrael @gatewaypundit only leftist approved thought i am sure we will learn to love our green new deal and spout that aoc is a genius project dragonfly was for us not china"Correlación de términos
Esto es parecido al grafico de red al lado de las barras, pero ahor midiendo directamente la correlación entre los hashtags con el coeficiente phi. puede que sustituya al grafico de red de arriba.
gop_cor_net <- get_correlation_network(climate_hashtag, climate_frequency, com = "GOP", exclude_words = "#greennewdeal", cor_limit = 0.2) %>%
activate(nodes) %>% mutate(comunidad = "GOP")
dnc_cor_net <- get_correlation_network(climate_hashtag, climate_frequency, com = "DNC", exclude_words = "#greennewdeal", cor_limit = 0.2) %>%
activate(nodes) %>% mutate(comunidad = "DNC")
prg_cor_net <- get_correlation_network(climate_hashtag, climate_frequency, com = "Progressives", exclude_words = "#greennewdeal", cor_limit = 0.2) %>%
activate(nodes) %>% mutate(comunidad = "Progressives")
climate_net <- bind_graphs(gop_cor_net, dnc_cor_net, prg_cor_net) %>%
activate(nodes) %>%
mutate(comunidad = fct_relevel(comunidad, c("GOP", "DNC", "Progressives")))
climate_net %>%
ggraph(layout = "fr") +
geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
geom_node_point(pch = 21, aes(fill = sent, size = n)) +
geom_node_text( aes(label = name, color = comunidad), repel = TRUE, size = 3) +
facet_nodes(~comunidad, ncol = 1, scales = "free") +
scale_fill_gradient2(low = "red", high = "green", mid = "grey") +
scale_color_manual(values = plots_palette[c(1, 3, 4)]) +
facet_nodes(~comunidad, ncol = 1, scales = "free") +
theme_graph() +
guides(color = F) +
theme(strip.text = element_text(size = 16))
# gop_cor_net <- ggplotGrob(plot_correlation_network(climate_hashtag, climate_frequency, com = "GOP", exclude_words = "#greennewdeal",
# text_size = 2, point_size = 2, text_color = plots_palette[1]))
# dnc_cor_net <- ggplotGrob(plot_correlation_network(climate_hashtag, climate_frequency, com = "DNC", exclude_words = "#greennewdeal",
# text_size = 2, point_size = 2, text_color = plots_palette[3]))
# prg_cor_net <- ggplotGrob(plot_correlation_network(climate_hashtag, climate_frequency, com = "Progressives", exclude_words = "#greennewdeal",
# text_size = 2, point_size = 2, text_color = plots_palette[4]))
# grid.arrange(gop_cor_net, dnc_cor_net, prg_cor_net, ncol = 1)Polaridad
Niveles inexistentes de polarización al comparar las comunidades
library(boot)
pol_test_dif <- readRDS(here::here("datos_procesados", "formated_polarization_df_data", "polarization_testing", "climatechange_polarization.rds"))
pol_test_dif[-1]## $IC
## 2.5% 97.5%
## DNC-GOP 0.02083333 0.07886905
## DNC-PRG 0.02083333 0.07916667
##
## $resultado
## [1] "No se encuentran diferencias 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 polarization score", title = "Replicaciones bootstrap del scoring medio de polarización")