Twitter Analysis sobre Amnistía Internacional
Sebastian Varela- Geronimo Tutusaus- Julian Tutusaus
2021-10-19
Importación de archivos
library(tidyverse)
library(tidytext)#loop para importar y joinear muchos archivos
folderfiles <- list.files(path = "C:/Users/Usuario/Desktop/Seba/proyectos2021/tuiter_gero/data_tuits",
pattern = "\\.csv$",33
full.names = TRUE)
tuits <- folderfiles %>%
set_names() %>%
map_dfr(.f = read_delim,
delim = ",",
.id = "file_name", show_col_types = FALSE) #show_col_types = FALSE aquieta un mensajelibrary(readr)
tuits <- read_csv("tuits_amnistia.csv", show_col_types = FALSE)Data wrangling
Generar fecha:
fecha <- tuits %>%
separate(created_at, into = c("a", "b","c","d","e","f","g", "h")) %>%
select(id, a, b,c,d,e,f,g,h) %>%
select(id, c, b, h) %>%
unite(fecha, c,b,h,sep = "")
fecha$fecha <- lubridate::dmy(fecha$fecha)
tuits <- tuits %>%
left_join(fecha) ## Joining, by = "id"tuits %>%
count(user.name)## # A tibble: 7 x 2
## user.name n
## <chr> <int>
## 1 "Amnistía Chile" 3219
## 2 "Amnistía Int. México" 3215
## 3 "Amnistía Internacional Américas" 3207
## 4 "Amnistía Internacional Argentina" 3223
## 5 "Amnistía Internacional Perú" 3227
## 6 "Anistia Internacional Brasil \U0001f56f" 3235
## 7 <NA> 25hay un caracter emoji en Brasil… voy a borrar de la string los caracteres no alfanuméricos de la variable:
tuits$user.name <- str_replace_all(tuits$user.name, "[^[:alnum:]]", "") tuits <- tuits %>%
mutate(oficina = fct_recode(user.name,
"Chile" = "AmnistíaChile",
"México" = "AmnistíaIntMéxico",
"Américas" = "AmnistíaInternacionalAméricas",
"Argentina" = "AmnistíaInternacionalArgentina",
"Perú" = "AmnistíaInternacionalPerú",
"Brasil" = "AnistiaInternacionalBrasil",
)) tuits %>%
count(oficina)## # A tibble: 7 x 2
## oficina n
## <fct> <int>
## 1 Chile 3219
## 2 Américas 3207
## 3 Argentina 3223
## 4 Perú 3227
## 5 México 3215
## 6 Brasil 3235
## 7 <NA> 25Omitir filas con perdidos en todas las columnas:
tuits <- tuits %>%
drop_na(oficina)
rm(fecha)Time series por oficina
ggplot(tuits, aes(x = fecha, fill = oficina)) +
geom_histogram(position = "identity", bins = 20, show.legend = FALSE) +
facet_wrap(~oficina, ncol = 1) +
scale_y_continuous(expand = c(0,0)) +
labs(y = NULL,
x = NULL,
title = "Tweets por oficina",
subtitle = "Periodo: 2018-06-06 al 2021-09-13")## Error : The fig.showtext code chunk option must be TRUE
TF-IDF
El estadístico tf-idf (term frequency times inverse document frequency) es un índice para identificar términos que son especialmente importantes o distintivos en un determinado documento en una colección o corpus de documentos. En este caso identificar términos que son característicos de una oficina en comparación con otras.
# mis stop_words en castellano y portugues
mipropio_stop_words <- read_csv("mipropio_stop_words", show_col_types = FALSE) #tokenización 1
remove_reg <- "&|<|>" #remueve caracteres como & y otros
tidy_tuits <- tuits %>%
filter(!str_detect(text, "^RT")) %>% #remover re tuits
mutate(text = str_remove_all(text, remove_reg)) %>%
unnest_tokens(word, text, token = "tweets") %>% #tweets tokenizer
filter(!word %in% mipropio_stop_words$word,
!word %in% str_remove_all(stop_words$word, "'"),
str_detect(word, "[a-z]"))## Using `to_lower = TRUE` with `token = 'tweets'` may not preserve URLs.Cabe resaltar que arriba se elimimaron los re tuits.
ahora sí, el tf-idf statistic:
tf_idf <- tidy_tuits %>%
count(oficina, word, sort = TRUE)La función bind_tf_idf() del tidytext package takes a tidy text dataset as input with one row per token (term), per document:
tf_idf <- tf_idf %>%
bind_tf_idf(word, oficina, n) #bind_tf_idf()
tf_idf## # A tibble: 69,221 x 6
## oficina word n tf idf tf_idf
## <fct> <chr> <int> <dbl> <dbl> <dbl>
## 1 Perú derechos 799 0.0153 0 0
## 2 Américas personas 683 0.0140 0.182 0.00256
## 3 Américas derechos 643 0.0132 0 0
## 4 Perú personas 607 0.0116 0.182 0.00212
## 5 Perú humanos 592 0.0113 0 0
## 6 Brasil direitos 577 0.0109 1.10 0.0120
## 7 Argentina personas 542 0.0103 0.182 0.00188
## 8 México personas 529 0.0114 0.182 0.00208
## 9 México mujeres 500 0.0108 0.182 0.00197
## 10 México derechos 475 0.0102 0 0
## # ... with 69,211 more rowsNotar que los cuando idf y por ende los tf-idf son cero, dichas palabras son extremadamente comunes.
Se grafican los resultados. Es conveniente usar en el chunk la función reorder_within(), véase https://juliasilge.com/blog/reorder-within/
tf_idf %>%
group_by(oficina) %>%
top_n(10, tf_idf) %>%
ungroup %>%
mutate(oficina = as.factor(oficina),
word = reorder_within(word, tf_idf, oficina)) %>%
ggplot(aes(word, tf_idf, fill = oficina)) +
geom_col(show.legend = FALSE) +
facet_wrap(~oficina, scales = "free") +
coord_flip() +
scale_x_reordered() +
scale_y_continuous(expand = c(0,0)) +
labs(y = NULL,
x = NULL,
title = "Palabras con mayor tf_idf por oficina",
subtitle = "Data de twitter del 2018-06-06 al 2021-09-13" )## Error : The fig.showtext code chunk option must be TRUE
Preparación de datos para topic modeling
tuits <- tuits %>%
rename(Id_unico =`Id unico`)tuits %>%
count(Id_unico) %>%
arrange(desc(n))## # A tibble: 19,192 x 2
## Id_unico n
## <chr> <int>
## 1 AB2998 3
## 2 AB3003 3
## 3 AB3009 3
## 4 AA1000 2
## 5 AA1001 2
## 6 AA1219 2
## 7 AA1400 2
## 8 AA1401 2
## 9 AA1511 2
## 10 AA1600 2
## # ... with 19,182 more rowsHay duplicados, se eliminan:
tuits <- tuits %>%
distinct(Id_unico, .keep_all = TRUE)Ahora ver si hay duplicados específicamente respecto del texto del tuit:
tuits_duplicados <- tuits %>% #un dataset con las casos de filas duplicadas en la variable text
group_by(text) %>%
filter(n()>1) Sí, son 368 tuits duplicados… se eliminan:
tuits <- anti_join(tuits, tuits_duplicados, by = "text")rm(tf_idf, tuits_duplicados)Seleccionar variables para el topic modeling
df_topic <- tuits
df_topic <- df_topic %>%
select(Id_unico, text)se debe llegar a un dataset con id y word (tokenizada):
#tokenización 2
remove_reg <- "&|<|>" #remueve caracteres (& y otras)
df_topic <- df_topic %>%
filter(!str_detect(text, "^RT")) %>% #remover re tuits
mutate(text = str_remove_all(text, remove_reg)) %>%
unnest_tokens(word, text, token = "tweets") %>% #tweets tokenizer
filter(!word %in% mipropio_stop_words$word,
!word %in% str_remove_all(stop_words$word, "'"),
str_detect(word, "[a-z]")) ## Using `to_lower = TRUE` with `token = 'tweets'` may not preserve URLs.Acá el número de Ids vajo a 15.856 por re tuits (y duplicados)
df_topic %>%
count(Id_unico)## # A tibble: 15,903 x 2
## Id_unico n
## <chr> <int>
## 1 AA01 21
## 2 AA02 23
## 3 AA03 16
## 4 AA04 22
## 5 AA05 21
## 6 AA06 20
## 7 AA07 12
## 8 AA08 16
## 9 AA09 14
## 10 AA10 25
## # ... with 15,893 more rowscambio el formato del dataset para transformar a matrix
word_counts <- df_topic %>%
count(Id_unico, word, sort = TRUE)
word_counts## # A tibble: 275,036 x 3
## Id_unico word n
## <chr> <chr> <int>
## 1 AB875 mortos 10
## 2 AB875 têm 10
## 3 AB2303 #votepormarielle 9
## 4 AB103 direito 8
## 5 AB826 direitos 8
## 6 AM2612 policía 8
## 7 AM2612 racista 8
## 8 AA194 derecho 7
## 9 AA102 aborto 6
## 10 AA102 derecho 6
## # ... with 275,026 more rowsDocument Term Matrix
Se transforma la matriz del chunk anterior en una document-term matrix. En esta matriz:
cada fila representa un documento (tuit en este caso)
cada columna representa un término
cada valor el número de apariciones de ese término en el documento
A este tipo de matrices se les denomina sparse matrix (matriz dispersa) porque la mayor parte de sus valores son 0 (términos que no aparecen en documentos). Muchos algotitmos esperan este formato más eficiente como insumo, es el caso de Latent Dirichlet allocation.
library(tm)
desc_dtm <- word_counts %>%
cast_dtm(Id_unico, word, n) #converting to a DocumentTermMatrix
desc_dtm## <<DocumentTermMatrix (documents: 15903, terms: 47291)>>
## Non-/sparse entries: 275036/751793737
## Sparsity : 100%
## Maximal term length: 107
## Weighting : term frequency (tf)Explorar la extensión de los tuits:
tuits$extension <-nchar(tuits$text)ggplot(tuits) +
aes(x = extension) +
geom_histogram(bins = 30L, fill = "#EF562D") +
labs(title = "Extensión de los tweets",
subtitle = "cantidad de caracteres",
y = "frecuencia",
x = "") ## Error : The fig.showtext code chunk option must be TRUE
Topic modeling
Se utiliza la técnica de topic modeling para la detección de tópicos y clasificación de los tweets. La técnica se aplica mediante el algoritmo Latent Dirichlet allocation (LDA)
Solución k=2
Solución con dos tópicos
library(topicmodels)
# be aware that running this model is time intensive
topicos_lda <- LDA(desc_dtm, k = 2, control = list(seed = 24))
topicos_lda## A LDA_VEM topic model with 2 topics.Interpretación
#tidy() turns a document-term matrix into a tidy data frame.
tidy_topicos_lda <- tidy(topicos_lda)
tidy_topicos_lda## # A tibble: 94,582 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 mortos 0.000135
## 2 2 mortos 0.000143
## 3 1 têm 0.000254
## 4 2 têm 0.000259
## 5 1 #votepormarielle 0.000207
## 6 2 #votepormarielle 0.0000991
## 7 1 direito 0.000449
## 8 2 direito 0.00127
## 9 1 direitos 0.00250
## 10 2 direitos 0.00148
## # ... with 94,572 more rowsLa columna β (coeficiente beta) indica la probabilidad de pertenencia de cada término a cada tópico. Se extraen a continuación los 10 términos más importantes para cada uno de los dos tópicos:
top_terms <- tidy_topicos_lda %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)top_terms %>%
mutate(term = reorder(term, beta)) %>%
group_by(topic, term) %>%
arrange(desc(beta)) %>%
ungroup() %>%
mutate(term = factor(paste(term, topic, sep = "__"),
levels = rev(paste(term, topic, sep = "__")))) %>%
ggplot(aes(term, beta, fill = as.factor(topic))) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_x_discrete(labels = function(x) gsub("__.+$", "", x)) +
labs(title = "10 términos top en cada tópico",
x = NULL, y = expression(beta),
subtitle = "Latent Dirichlet allocation (LDA)") +
facet_wrap(~ topic, ncol = 5, scales = "free")## Error : The fig.showtext code chunk option must be TRUE
No sale mucho, el primero parece más relacionado con temas de gobierno y en el segundo aparecen cuestiones de género y justicia. Pero no parece una buena solución.
Cantidad de tópicos: tuning
Usando el paquete ldatuning es posible calcular un conjunto de métricas que pueden ser de utilidad para ayudar a definir el número óptimo de tópicos:
#puede ser computer intensive
library(topicmodels)
library(ldatuning)
result <- FindTopicsNumber(
desc_dtm,
topics = seq(from = 2, to = 15, by = 1),
metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
method = "Gibbs",
control = list(seed = 77),
mc.cores = 2L,
verbose = TRUE
)## fit models... done.
## calculate metrics:
## Griffiths2004... done.
## CaoJuan2009... done.
## Arun2010... done.
## Deveaud2014... done.result## topics Griffiths2004 CaoJuan2009 Arun2010 Deveaud2014
## 1 15 -2205140 0.02372689 74660.32 1.982288
## 2 14 -2200571 0.02665198 75457.27 2.016333
## 3 13 -2205184 0.02270759 75806.32 2.052437
## 4 12 -2209350 0.02077554 76582.55 2.088827
## 5 11 -2222394 0.03747435 77994.38 2.113069
## 6 10 -2227874 0.02130062 78393.43 2.169929
## 7 9 -2244239 0.02207752 79448.69 2.205421
## 8 8 -2254053 0.01930443 80744.99 2.240323
## 9 7 -2271707 0.02701554 82226.95 2.279828
## 10 6 -2299233 0.02112826 83807.41 2.322985
## 11 5 -2320826 0.02402243 85970.81 2.357865
## 12 4 -2357708 0.03821286 88572.10 2.369394
## 13 3 -2412559 0.04176742 91828.98 2.393876
## 14 2 -2488893 0.04433163 96402.23 2.411617FindTopicsNumber_plot(result)## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.## Error : The fig.showtext code chunk option must be TRUE
La finalidad de este procedimiento es definir el número optimo de tópicos. Los dos indices de arriba (Arun y Cao) indican mejores soluciones cuando el valor es mínimo y los dos de abajo (Deveaud y Griffiths) cuando es máximo. Los gráficos se interpretan de manera similar al scree plot de un análisis de factorial.
Se observan resultados inconsistentes entre las distintas métricas, lo cual probablemente se deba a que el dataset no representa un buen insumo para la utilización del algoritmo LDA.
Solución k=5
Solución con cinco tópicos
topicos_lda <- LDA(desc_dtm, k = 5, control = list(seed = 24))
topicos_lda## A LDA_VEM topic model with 5 topics.Interpretación
#tidy() turns a document-term matrix into a tidy data frame.
tidy_topicos_lda <- tidy(topicos_lda)
tidy_topicos_lda## # A tibble: 236,455 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 mortos 0.000264
## 2 2 mortos 0.000245
## 3 3 mortos 0.0000491
## 4 4 mortos 0.0000949
## 5 5 mortos 0.0000417
## 6 1 têm 0.000314
## 7 2 têm 0.000267
## 8 3 têm 0.000310
## 9 4 têm 0.000146
## 10 5 têm 0.000245
## # ... with 236,445 more rowstop_terms <- tidy_topicos_lda %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)top_terms %>%
mutate(term = reorder(term, beta)) %>%
group_by(topic, term) %>%
arrange(desc(beta)) %>%
ungroup() %>%
mutate(term = factor(paste(term, topic, sep = "__"),
levels = rev(paste(term, topic, sep = "__")))) %>%
ggplot(aes(term, beta, fill = as.factor(topic))) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_x_discrete(labels = function(x) gsub("__.+$", "", x)) +
labs(title = "10 términos top en cada tópico",
x = NULL, y = expression(beta),
subtitle = "Latent Dirichlet allocation (LDA)") +
facet_wrap(~ topic, ncol = 3, scales = "free")## Error : The fig.showtext code chunk option must be TRUE
Solución k=16
Solución con 16 tópicos
topicos_lda <- LDA(desc_dtm, k = 16, control = list(seed = 24))
topicos_lda## A LDA_VEM topic model with 16 topics.Interpretación
#tidy() turns a document-term matrix into a tidy data frame.
tidy_topicos_lda <- tidy(topicos_lda)
tidy_topicos_lda## # A tibble: 756,656 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 mortos 0.000145
## 2 2 mortos 0.000109
## 3 3 mortos 0.0000205
## 4 4 mortos 0.0000500
## 5 5 mortos 0.0000199
## 6 6 mortos 0.000126
## 7 7 mortos 0.000130
## 8 8 mortos 0.0000448
## 9 9 mortos 0.000112
## 10 10 mortos 0.000150
## # ... with 756,646 more rowstop_terms <- tidy_topicos_lda %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)top_terms %>%
mutate(term = reorder(term, beta)) %>%
group_by(topic, term) %>%
arrange(desc(beta)) %>%
ungroup() %>%
mutate(term = factor(paste(term, topic, sep = "__"),
levels = rev(paste(term, topic, sep = "__")))) %>%
ggplot(aes(term, beta, fill = as.factor(topic))) +
geom_col(show.legend = FALSE) +
coord_flip() +
scale_x_discrete(labels = function(x) gsub("__.+$", "", x)) +
scale_y_continuous(labels = NULL) +
labs(title = "10 términos top en cada tópico",
x = NULL, y = expression(beta),
subtitle = "Latent Dirichlet allocation (LDA)") +
facet_wrap(~ topic, ncol = 4, scales = "free")## Error : The fig.showtext code chunk option must be TRUE
Asignación de documentos a tópicos
Se pueden examinar las probabilidades de los documentos de pertenecer a cada tópico, mediante el coficiente gamma. Se toma la solución de 16 tópicos:
documents_topic <- tidy(topicos_lda, matrix = "gamma")
documents_topic## # A tibble: 254,448 x 3
## document topic gamma
## <chr> <int> <dbl>
## 1 AB875 1 0.0619
## 2 AB2303 1 0.0651
## 3 AB103 1 0.0618
## 4 AB826 1 0.0649
## 5 AM2612 1 0.0650
## 6 AA194 1 0.0620
## 7 AA102 1 0.0601
## 8 AA213 1 0.0598
## 9 AA2311 1 0.0601
## 10 AB126 1 0.0620
## # ... with 254,438 more rowsCada uno de estos valores indica la proporción estimada de palabras del documento que fueron generadas por ese tópico. Se observan valores bajos, lo cuál indica que el modelo no es sarisfactorio. A continuación se asignan los documentos (tweets aquí) a los tópicos.
documents_topic_1 <- documents_topic %>%
group_by(document) %>%
slice_max(gamma) %>%
ungroup() %>%
select(- gamma)
documents_topic_1 ## # A tibble: 15,903 x 2
## document topic
## <chr> <int>
## 1 AA01 10
## 2 AA02 9
## 3 AA03 2
## 4 AA04 10
## 5 AA05 15
## 6 AA06 5
## 7 AA07 16
## 8 AA08 13
## 9 AA09 6
## 10 AA10 6
## # ... with 15,893 more rowsCabe recordar que hay 15.903 filas y no 18.824 como en el dataset original porque se eliminaron los retuits y los duplicados. Se pega la variable document al dataset original:
dataset_final_tm <- documents_topic_1 %>%
left_join(tuits, by= c("document" = "Id_unico"))Guardar dataset:
write_csv(dataset_final_tm, "dataset_final_tm.csv")