suppressPackageStartupMessages({
library(tidyverse)
library(tidytext)
library(magick)
library(RColorBrewer)
library(wordcloud)
library(topicmodels)
}
)Cachitos 2022. Tercera parte
estadística
polémica
2023
textmining
ocr
linux
cachitos
Vamos ya con la última entrada del cachitos de este año. Las anteriores, las tenemos en esta y esta otra
El csv con el texto de los rótulos para 2022 lo tenemos en este enlace
Vamos al lío
Librerías
Lectura de datos, y vistazo datos
root_directory = "/media/hd1/canadasreche@gmail.com/public/proyecto_cachitos/"
anno <- "2022"Leemos el csv. Uso DT y así podéis ver todos los datos o buscar cosas, por ejemplo emérito o Ayuso
subtitulos_proces <- read_csv(str_glue("{root_directory}{anno}_txt_unido.csv"))
subtitulos_proces %>%
select(texto, n_fichero, n_caracteres) %>%
DT::datatable()Pues nos valdría con esto para buscar términos polémicos.
Algo de minería de texto
Quitamos stopwords y tokenizamos de forma que tengamos cada palabra en una fila manteniendo de qué rótulo proviene
to_remove <- c(tm::stopwords("es"),
"110", "4","1","2","7","10","0","ñ","of",
"5","á","i","the","3", "n", "p",
"ee","uu","mm","ema", "zz",
"wr","wop","wy","x","xi","xl","xt",
"xte","yí", "your")
subtitulos_proces_one_word <- subtitulos_proces %>%
unnest_tokens(input = texto,
output = word) %>%
filter(! word %in% to_remove) %>%
filter(nchar(word) > 1)
# Se nos quedan 3766 filas/palabras de los 488 rótulos
dim(subtitulos_proces_one_word)
#> [1] 3766 5DT::datatable(subtitulos_proces_one_word)Contar ocurrencias de cosas es lo más básico.
palabras_ordenadas_1 <- subtitulos_proces_one_word %>%
group_by(word) %>%
summarise(veces = n()) %>%
arrange(desc(veces))
palabras_ordenadas_1 %>%
slice(1:20) %>%
ggplot(aes(x = reorder(word, veces), y = veces)) +
geom_col(show.legend = FALSE) +
ylab("veces") +
xlab("") +
coord_flip() +
theme_bw()
Y como el año pasado la palabra más común es “canción” . ¿Y si añadimos las 20 palabras como stopword, junto con algunas como [“tan”, “sólo”,“así”, “aquí”, “hoy”] . La tarea de añadir palabras como stopwords requiere trabajo, tampoco nos vamos a parar tanto.
(add_to_stop_words <- palabras_ordenadas_1 %>%
slice(1:25) %>%
pull(word) )
#> [1] "canción" "si" "año" "años" "después" "menos"
#> [7] "mismo" "ahora" "banda" "grupo" "versión" "letra"
#> [13] "ser" "siempre" "bien" "cantante" "dos" "momento"
#> [19] "parece" "sigue" "tema" "ver" "aquí" "así"
#> [25] "casa"
to_remove <- unique(c(to_remove,
add_to_stop_words,
"tan",
"sólo",
"así",
"aquí",
"hoy",
"va"))
subtitulos_proces_one_word <- subtitulos_proces %>%
unnest_tokens(input = texto,
output = word) %>%
filter(! word %in% to_remove) %>%
filter(nchar(word) > 1)
palabras_ordenadas_2 <- subtitulos_proces_one_word %>%
group_by(word) %>%
summarise(veces = n()) %>%
arrange(desc(veces))
palabras_ordenadas_2 %>%
slice(1:20) %>%
ggplot(aes(x = reorder(word, veces), y = veces)) +
geom_col(show.legend = FALSE) +
ylab("veces") +
xlab("") +
coord_flip() +
theme_bw()
También podemos ver ahora una nube de palabras
pal <- brewer.pal(8,"Dark2")
subtitulos_proces_one_word %>%
group_by(word) %>%
count() %>%
with(wordcloud(word, n, random.order = FALSE, max.words = 80, colors=pal)) 
¿Polémicos?
Creamos lista de palabras polémicas (se aceptan otras, podéis poner en los comentarios)
palabras_polem <- c("abascal", "almeida", "ayuso", "belarra", "bloqueo",
"borbon", "borras", "calvo", "celaa", "cgpj", "cis",
"ciudada", "comunidad", "conde", "constitucional", "coron",
"democr", "democracia", "derech", "díaz", "dioni",
"errejon", "extremadura", "fach", "falcon", "feij",
"gobierno", "guardia", "iglesias", "illa", "ivan",
"izquier", "ley", "madrid","manipulador", "marlaska",
"marruecos","melilla", "militares", "minist", "monarca",
"montero","negacion", "negacionismo", "olona", "oposición",
"page", "pandem", "pp", "principe", "prisión", "psoe",
"redondo", "republic", "rey", "rufian", "rufián",
"sabina", "sanchez", "sánchez", "sanz","tezanos",
"toled", "trans", "transición", "tren", "ultra",
"vicepre", "vox", "yolanda", "zarzu", "zarzuela")Y construimos una regex simple
(exp_regx <- paste0("^",paste(palabras_polem, collapse = "|^")))
#> [1] "^abascal|^almeida|^ayuso|^belarra|^bloqueo|^borbon|^borras|^calvo|^celaa|^cgpj|^cis|^ciudada|^comunidad|^conde|^constitucional|^coron|^democr|^democracia|^derech|^díaz|^dioni|^errejon|^extremadura|^fach|^falcon|^feij|^gobierno|^guardia|^iglesias|^illa|^ivan|^izquier|^ley|^madrid|^manipulador|^marlaska|^marruecos|^melilla|^militares|^minist|^monarca|^montero|^negacion|^negacionismo|^olona|^oposición|^page|^pandem|^pp|^principe|^prisión|^psoe|^redondo|^republic|^rey|^rufian|^rufián|^sabina|^sanchez|^sánchez|^sanz|^tezanos|^toled|^trans|^transición|^tren|^ultra|^vicepre|^vox|^yolanda|^zarzu|^zarzuela"Y nos creamos una variable para identificar si es palabra polémica
subtitulos_proces_one_word <- subtitulos_proces_one_word %>%
mutate(polemica= str_detect(word, exp_regx))
subtitulos_polemicos <- subtitulos_proces_one_word %>%
filter(polemica) %>%
pull(n_fichero) %>%
unique()
subtitulos_polemicos
#> [1] "00000018.jpg.subtitulo.tif.txt" "00000086.jpg.subtitulo.tif.txt"
#> [3] "00000100.jpg.subtitulo.tif.txt" "00000113.jpg.subtitulo.tif.txt"
#> [5] "00000127.jpg.subtitulo.tif.txt" "00000193.jpg.subtitulo.tif.txt"
#> [7] "00000209.jpg.subtitulo.tif.txt" "00000225.jpg.subtitulo.tif.txt"
#> [9] "00000242.jpg.subtitulo.tif.txt" "00000258.jpg.subtitulo.tif.txt"
#> [11] "00000289.jpg.subtitulo.tif.txt" "00000377.jpg.subtitulo.tif.txt"
#> [13] "00000475.jpg.subtitulo.tif.txt" "00000483.jpg.subtitulo.tif.txt"
#> [15] "00000522.jpg.subtitulo.tif.txt" "00000551.jpg.subtitulo.tif.txt"
#> [17] "00000563.jpg.subtitulo.tif.txt" "00000564.jpg.subtitulo.tif.txt"
#> [19] "00000566.jpg.subtitulo.tif.txt" "00000643.jpg.subtitulo.tif.txt"
#> [21] "00000706.jpg.subtitulo.tif.txt" "00000814.jpg.subtitulo.tif.txt"
#> [23] "00000846.jpg.subtitulo.tif.txt" "00000939.jpg.subtitulo.tif.txt"
#> [25] "00000945.jpg.subtitulo.tif.txt" "00000946.jpg.subtitulo.tif.txt"
#> [27] "00000997.jpg.subtitulo.tif.txt" "00001005.jpg.subtitulo.tif.txt"
#> [29] "00001006.jpg.subtitulo.tif.txt" "00001026.jpg.subtitulo.tif.txt"
#> [31] "00001030.jpg.subtitulo.tif.txt" "00001031.jpg.subtitulo.tif.txt"
#> [33] "00001061.jpg.subtitulo.tif.txt" "00001072.jpg.subtitulo.tif.txt"
#> [35] "00001112.jpg.subtitulo.tif.txt" "00001122.jpg.subtitulo.tif.txt"
#> [37] "00001132.jpg.subtitulo.tif.txt" "00001200.jpg.subtitulo.tif.txt"
#> [39] "00001231.jpg.subtitulo.tif.txt" "00001232.jpg.subtitulo.tif.txt"
#> [41] "00001276.jpg.subtitulo.tif.txt"Y podemos ver en el texto original antes de tokenizar qué rótulos hemos considerado polémicos y qué texto
subtitulos_proces %>%
filter(n_fichero %in% subtitulos_polemicos) %>%
arrange(n_fichero) %>%
pull(texto) %>%
unique()
#> [1] "bienvenidos si estáis todos es porque habéis recordado que tras los cuartos van tu banco hacienda y el rey emérito"
#> [2] "la orquesta gente joven fue posponiendo el cambio de nombre como el psoe con la ley trans"
#> [3] "hace chacachá entonces podemos llamarlo y q tren de altas prestaciones de extremadura"
#> [4] "debieron traducir la letra con el google translate de la época el collins no phil sino el diccionario"
#> [5] "de imagen y de mensaje iban sobrados pp como samantha hudson pero con musicón"
#> [6] "rocío ya cumplía la ley de transparencia 23 años antes de su aproba"
#> [7] "en 2022 cayeron los muros de metacrilato ya sólo llevamos mascarilla en transporte orgías y atracos"
#> [8] "si tuviera sólo una pizca más de clase habría que aplicarle la ley celaá"
#> [9] "es muy raro ver actuar con tanta coordinación a quienes están a la izquierda"
#> [10] "como feos de pleno derecho por eso somos guionistas vamos a ofendernos un poco y ahora seguimos"
#> [11] "oes del silencio roe de leyenda"
#> [12] "la primera comunión 7 de macarena olona rena olona"
#> [13] "pa así eran las fiestas de nochevieja a antes de la ley antitabaco"
#> [14] "midge fue líder de ultravox y como veis domina el arte o del falsete el santiago abascal escocés"
#> [15] "niños no os preocupéis que en cuanto terminen la actuación los reyes magos se ponen con lo de los regalos"
#> [16] "su hombre blandengue ha servido para una campaña del ministerio de igualdad a ver cuándo le toca a la mandanga"
#> [17] "mn poner resistiré y salir al balcón a aplaudir a los militares"
#> [18] "recuperar el lema de la transición a follar que el mundo se va a acabar"
#> [19] "82 negarlo todo y seguir viviendo no como el resto de borregos que creen a los medios manipuladores"
#> [20] "esta leyenda de la música italiana cultivó con éxito el look llevo 15 días durmiendo en un ford fiesta"
#> [21] "necesitaron una pandemia mundial para dar el pelotazo a almeida le bastó con un saque de honor"
#> [22] "desde la atrevida ignorancia de algún panfleto le definieron como transformista supremacista asturiano"
#> [23] "me tienes aquí colgado es originalmente de las supremes hoy se canta en los centros médicos de la comunidad de madrid"
#> [24] "y se entiende perfectamente los disfraces de ardilla pp lo que más"
#> [25] "nos ha pedido pedro sánchez que os digamos que esta subida también es culpa de la guerra en ucrania"
#> [26] "izquierda derecha como veis tienen la postura tan sólidamente definida como el gobierno respecto al sahara"
#> [27] "la relación entre rufián y borrás tiene menos roces"
#> [28] "no dirás que no es doble negacionismo"
#> [29] "venga que esta nos la sabemos todos de mario conde al dioni"
#> [30] "sin documentos es mejor no quedarse q entreespaña y marruecos"
#> [31] "quín sabina to entre caballeros"
#> [32] "sabina pactó con unos ladrones hacerles esta copla y cumplió como lo del cgpj pero con gente responsable"
#> [33] "es incomprensible que los negacionistas no usaran este tema para protestar por las mascarillas"
#> [34] "y ahora que hemos localizado a la prima de mari carmen del hermano de ayuso sabéis algo"
#> [35] "en su último disco se han disfrazado de star wars ángeles de leia y dioni de maestro jedi"
#> [36] "transitando la fina línea que separa a danny zuko att del protagonista de una peli de eloy de la iglesia"
#> [37] "desde 2013 tina es ciudadana suiza allí disfruta de sus paisajes alpinos y un poco también de su régimen fiscal"
#> [38] "esas hombreras nos habrían venido muy bien para mantener la distancia social durante la pandemia"
#> [39] "catar no es una democracia sino una monarquía absoluta sin respeto por los derechos humanos dos"
#> [40] "el esfuerzo del coreógrafo es inútil la única forma de bailar esto es haciendo el trenecito"
#> [41] "g 1 cachitos es como el roscón de reyes a a siempre suele llevar abba dentro"Y podemos ver los fotogramas.
# identificamos nombre del archivo jpg con los rótulos polémicos
polemica_1_fotogramas <- unique(substr(subtitulos_polemicos, 1,12))
head(polemica_1_fotogramas)
#> [1] "00000018.jpg" "00000086.jpg" "00000100.jpg" "00000113.jpg" "00000127.jpg"
#> [6] "00000193.jpg"
# creamos la ruta completa donde están
polemica_1_fotogramas_full <- paste0(str_glue("{root_directory}video/{anno}_jpg/"), polemica_1_fotogramas)
# añadimos sufijo subtitulo.tif para tenr localizado la imagen que tiene solo los rótulos
subtitulos_polemicos_1_full <- paste0(polemica_1_fotogramas_full,".subtitulo.tif")Con la función image_read del paquete magick leemos las imágenes polémicas y los rótulos
fotogramas_polemicos_img <- map(polemica_1_fotogramas_full, image_read)
subtitulos_polemicos_img <- map(subtitulos_polemicos_1_full, image_read)
subtitulos_polemicos_img[[25]]
fotogramas_polemicos_img[[25]]
Podemos ver una muestra de algunos de ellos.
No es perfecto ( al meter ley o tren como palabras polémticas) pero bueno, nos vale.
set.seed(2023)
indices <- sort(sample(1:length(fotogramas_polemicos_img), 9))
lista_fotogram_polemicos <- lapply(fotogramas_polemicos_img[indices], grid::rasterGrob)
gridExtra::grid.arrange(grobs=lista_fotogram_polemicos )
Y el recorte de los subtítulos que hicimos enla primera entrega.
lista_subtitulos <- lapply(subtitulos_polemicos_img[indices], grid::rasterGrob)
gridExtra::grid.arrange(grobs=lista_subtitulos)
Tópicos
Aquí no me refiero a los tópicos de este país nuestro, sino a identificar si hay temas comunes a varios documentos.
Ya aviso que con tan pocos “documentos”, unos 488 y siendo tan cortos cada rótulo, es muy probable que no salga mucho..
Tópicos usando conteo de palabras.
Contamos palabras con 3 caracteres o más.
Guardamos la variable name que nos indica en qué rótulo ha aparecido
word_counts <- subtitulos_proces_one_word %>%
group_by(name, word) %>%
count(sort=TRUE) %>%
mutate(ncharacters = nchar(word)) %>%
filter(
ncharacters >= 3) %>%
select(-ncharacters) %>%
ungroup()
length(unique(word_counts$name))
#> [1] 488
head(word_counts, 15)
#> # A tibble: 15 × 3
#> name word n
#> <dbl> <chr> <int>
#> 1 433 duran 3
#> 2 924 boom 3
#> 3 51 palabra 2
#> 4 181 voz 2
#> 5 269 enemigos 2
#> 6 269 john 2
#> 7 269 wayne 2
#> 8 355 plano 2
#> 9 377 olona 2
#> 10 396 iba 2
#> 11 455 montar 2
#> 12 492 gusta 2
#> 13 558 ropa 2
#> 14 598 calderón 2
#> 15 598 carlos 2Ahora convertimos este data.frame a un DocumentTermMatrix
# usamos como peso la TermFrequency de la palabra
rotulos_dtm <- word_counts %>%
cast_dtm(name, word, n, weighting = tm::weightTf)
rotulos_dtm
#> <<DocumentTermMatrix (documents: 488, terms: 2478)>>
#> Non-/sparse entries: 3257/1206007
#> Sparsity : 100%
#> Maximal term length: 24
#> Weighting : term frequency (tf)Podríamos haberlo visto en forma de filas = palabras y columnas = rótulo
word_counts %>%
cast_dfm(word, name, n)
#> Document-feature matrix of: 2,478 documents, 488 features (99.73% sparse) and 0 docvars.
#> features
#> docs 433 924 51 181 269 355 377 396 455 492
#> duran 3 0 0 0 0 0 0 0 0 0
#> boom 0 3 0 0 0 0 0 0 0 0
#> palabra 0 0 2 0 0 0 0 0 0 0
#> voz 0 0 0 2 0 0 0 0 0 0
#> enemigos 0 0 0 0 2 0 0 0 0 0
#> john 0 0 0 0 2 0 0 0 0 0
#> [ reached max_ndoc ... 2,472 more documents, reached max_nfeat ... 478 more features ]Vamos a ver si sale algo haciendo un LDA (Latent Dirichlet Allocation)
Considero 7 tópicos porque me gusta el número 7. El que quiera elegir con algo más de criterio que se mire esto
# Cons
rotulos_lda <- LDA(rotulos_dtm, k = 7, control = list(seed = 1234))
rotulos_lda
#> A LDA_VEM topic model with 7 topics.
rotulos_lda_td <- tidy(rotulos_lda)
rotulos_lda_td
#> # A tibble: 17,346 × 3
#> topic term beta
#> <int> <chr> <dbl>
#> 1 1 duran 3.39e-75
#> 2 2 duran 3.55e-75
#> 3 3 duran 6.13e- 3
#> 4 4 duran 3.56e-75
#> 5 5 duran 3.18e-75
#> 6 6 duran 3.75e-75
#> 7 7 duran 3.63e-75
#> 8 1 boom 6.21e- 3
#> 9 2 boom 4.49e-75
#> 10 3 boom 4.23e-75
#> # … with 17,336 more rows
# se suele ordenar por beta que ahora mismo no recuerdo que era,
top_terms <- rotulos_lda_td %>%
group_by(topic) %>%
top_n(3, beta) %>%
ungroup() %>%
arrange(topic, -beta)
top_terms
#> # A tibble: 34 × 3
#> topic term beta
#> <int> <chr> <dbl>
#> 1 1 disco 0.0124
#> 2 1 juan 0.0104
#> 3 1 hacer 0.00878
#> 4 2 mundo 0.0130
#> 5 2 gusta 0.00651
#> 6 2 bueno 0.00651
#> 7 2 salir 0.00651
#> 8 2 peret 0.00651
#> 9 3 fama 0.0123
#> 10 3 voz 0.00817
#> # … with 24 more rows
top_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta)) +
geom_bar(stat = "identity") +
scale_x_reordered() +
facet_wrap(~ topic, scales = "free_x") +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
Pues la verdad es que yo no veo nada interesante
Tópicos usando tfidf como peso
Vamos a probar usando tfidf
Como la función LDA no permite usar un DocumentTermMatrix que se haya construido con cast_dtm y usando como parámetro de weighting el peso tm::weightTfIdf nos construimos los datos de otra forma.
tf_idf_data <- subtitulos_proces_one_word %>%
filter(nchar(word)>2) %>%
group_by(name,word) %>%
summarise(veces_palabra = n()) %>%
bind_tf_idf(word, name, veces_palabra) %>%
ungroup()
tf_idf_data %>%
arrange(desc(veces_palabra)) %>%
head()
#> # A tibble: 6 × 6
#> name word veces_palabra tf idf tf_idf
#> <dbl> <chr> <int> <dbl> <dbl> <dbl>
#> 1 433 duran 3 0.6 6.19 3.71
#> 2 924 boom 3 0.75 6.19 4.64
#> 3 51 palabra 2 0.286 5.50 1.57
#> 4 181 voz 2 0.5 4.24 2.12
#> 5 269 enemigos 2 0.25 5.50 1.37
#> 6 269 john 2 0.25 4.80 1.20Para cada palabra tenemos su tf_idf dentro de cada rótulo en el que aparece
tf_idf_data %>%
filter(word== "izquierda")
#> # A tibble: 2 × 6
#> name word veces_palabra tf idf tf_idf
#> <dbl> <chr> <int> <dbl> <dbl> <dbl>
#> 1 242 izquierda 1 0.2 5.50 1.10
#> 2 946 izquierda 1 0.111 5.50 0.611Como de nuevo LDA solo acepta peso con valores enteros, pues simplemente multiplicamos por 100 el tf_idf y redondeamos
dtm_long <- tf_idf_data %>%
mutate(tf_idf_integer = round(100*tf_idf)) %>%
cast_dfm(name, word, tf_idf_integer)lda_model_long_1 <- LDA(dtm_long, k = 7, control = list(seed = 1234))result <- tidy(lda_model_long_1, 'beta')
result %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta) %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free", ncol = 4) +
coord_flip()
Y claramente , yo sigo sin ver nada claro. Aunque me daría pistas para añadir más palabras a las stopwords y para aceptar que para el tamaño de los documentos (unas pocas palabras por rótulo), quizá no valga el LDA.
Esta es la vida del analista de datos, prueba y error y sólo de vez en cuándo algún éxito.
Sólo con los rótulos polémicos
Asumiendo que parece que no tiene sentido hacer topicmodelling sobre estos datos, me picó la curiosidad de ver qué pasaba si sólo usaba los rótulos polémicos.
tf_idf_data_polem <- subtitulos_proces_one_word %>%
filter(nchar(word)>2, polemica == TRUE) %>%
group_by(name,word) %>%
summarise(veces_palabra = n()) %>%
bind_tf_idf(word, name, veces_palabra) %>%
ungroup()
tf_idf_data_polem %>%
arrange(desc(veces_palabra)) %>%
head()
#> # A tibble: 6 × 6
#> name word veces_palabra tf idf tf_idf
#> <dbl> <chr> <int> <dbl> <dbl> <dbl>
#> 1 377 olona 2 1 3.66 3.66
#> 2 18 rey 1 1 3.66 3.66
#> 3 86 ley 1 0.333 2.28 0.759
#> 4 86 psoe 1 0.333 3.66 1.22
#> 5 86 trans 1 0.333 3.66 1.22
#> 6 100 extremadura 1 0.5 3.66 1.83Topic modelling usando conteo de palabras
dtm_long_polem <- tf_idf_data_polem %>%
# filter(tf_idf > 0.00006) %>%
# filter(veces_palabra>1) %>%
cast_dtm(name, word, veces_palabra)
lda_model_long_polem <- LDA(dtm_long_polem, k = 7, control = list(seed = 1234))
result_polem <- tidy(lda_model_long_polem, 'beta')result_polem %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta) %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free", ncol = 4) +
coord_flip()
Y bueno parece que en el tópico 3 se meten juntos rótulos que hablan de pandemia y de negacionistas, ha podido ser casalidad, quién sabe.
Si vemos en qué tópico cae cada documento.
result_documento_polem <- tidy(lda_model_long_polem, 'gamma')
result_documento_polem %>%
group_by(topic) %>%
top_n(5, gamma) %>%
ungroup() %>%
arrange(topic, -gamma) %>%
mutate(document = reorder(document, gamma)) %>%
ggplot(aes(document, gamma, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free", ncol = 4) +
coord_flip()
Veamos algunos subtítulos del tópico 3
subtitulos_proces %>%
filter(name %in% c(100, 706, 1061, 563)) %>%
pull(texto)
#> [1] "hace chacachá entonces podemos llamarlo y q tren de altas prestaciones de extremadura"
#> [2] "mn poner resistiré y salir al balcón a aplaudir a los militares"
#> [3] "necesitaron una pandemia mundial para dar el pelotazo a almeida le bastó con un saque de honor"
#> [4] "es incomprensible que los negacionistas no usaran este tema para protestar por las mascarillas"top_10_topic3 <- result_documento_polem %>%
group_by(topic) %>%
top_n(10, gamma) %>%
filter(topic==3) %>%
pull(document)
subtitulos_proces %>%
filter(name %in% top_10_topic3) %>%
pull(texto)
#> [1] "hace chacachá entonces podemos llamarlo y q tren de altas prestaciones de extremadura"
#> [2] "es muy raro ver actuar con tanta coordinación a quienes están a la izquierda"
#> [3] "mn poner resistiré y salir al balcón a aplaudir a los militares"
#> [4] "necesitaron una pandemia mundial para dar el pelotazo a almeida le bastó con un saque de honor"
#> [5] "nos ha pedido pedro sánchez que os digamos que esta subida también es culpa de la guerra en ucrania"
#> [6] "no dirás que no es doble negacionismo"
#> [7] "quín sabina to entre caballeros"
#> [8] "es incomprensible que los negacionistas no usaran este tema para protestar por las mascarillas"
#> [9] "desde 2013 tina es ciudadana suiza allí disfruta de sus paisajes alpinos y un poco también de su régimen fiscal"
#> [10] "esas hombreras nos habrían venido muy bien para mantener la distancia social durante la pandemia"Y bueno si que parece que ha agrupado algunos rótulos relacionados con la pandemia
Topic modelling usando tf_idf
dtm_long_polem_tf_idf <- tf_idf_data_polem %>%
mutate(tf_idf_integer = round(100 * tf_idf)) %>%
cast_dfm(name, word, tf_idf_integer)
lda_model_long_polem_tf_idf <- LDA(dtm_long_polem_tf_idf, k = 7, control = list(seed = 1234))
result_polem_tf_idf <- tidy(lda_model_long_polem_tf_idf, 'beta')result_polem_tf_idf %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta) %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free", ncol = 4) +
coord_flip()
Y no parece tan diferente. Veamos el tópico 4
result_documento_polem_tf_idf <- tidy(lda_model_long_polem_tf_idf, 'gamma')
result_documento_polem_tf_idf %>%
group_by(topic) %>%
top_n(5, gamma) %>%
ungroup() %>%
arrange(topic, -gamma) %>%
mutate(document = reorder(document, gamma)) %>%
ggplot(aes(document, gamma, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free", ncol = 4) +
coord_flip()
Veamos algunos subtítulos del tópico 4
top_5_topic4 <- result_documento_polem_tf_idf %>%
group_by(topic) %>%
top_n(5, gamma) %>%
filter(topic==4) %>%
pull(document)
subtitulos_proces %>%
filter(name %in% top_5_topic4) %>%
pull(texto)
#> [1] "la orquesta gente joven fue posponiendo el cambio de nombre como el psoe con la ley trans"
#> [2] "como feos de pleno derecho por eso somos guionistas vamos a ofendernos un poco y ahora seguimos"
#> [3] "izquierda derecha como veis tienen la postura tan sólidamente definida como el gobierno respecto al sahara"
#> [4] "es incomprensible que los negacionistas no usaran este tema para protestar por las mascarillas"
#> [5] "el esfuerzo del coreógrafo es inútil la única forma de bailar esto es haciendo el trenecito"Y bueno no lo veo tan poco muy claro.
Otras pruebas realizadas
- En vez de considerar que cada rótulo es un documento, consideré los rótulos correspondientes a la primera parte del programa, a la segunda, y así hasta 10. pero no se obtuvo nada consistente
Y bueno aquí acaba el análisis del cachitos de este año, salvo que alguien tenga interés en que haga alguna prueba o mejore algo.
Feliz 2023 a todos