Cachitos 2023. Tercera parte

estadística
polémica
2024
textmining
ocr
linux
cachitos
Author

José Luis Cañadas Reche

Published

January 8, 2024

Vamos ya con la penú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 2023 lo tenemos en este enlace

Vamos al lío

Aviso:

Esta entrada ejecuta casi sin revisar la entrada de 2023 Lo poco que he cambiado es añadir alguna palabra polémica como amnistía o puigdemont al listado de palabras polémicas o hacer 5 topics en lugar de 7 en algún modelo

Librerías

Code 

    suppressPackageStartupMessages({
        library(tidyverse) 
        library(tidytext)
        library(quanteda)
        library(magick)
        library(RColorBrewer)
        library(wordcloud)
        library(topicmodels)
        
        }
    )

Lectura de datos, y vistazo datos

Code 
root_directory = "~/proyecto_cachitos/"
anno <- "2023"

Leemos el csv. Uso DT y así podéis ver todos los datos o buscar cosas, por ejemplo amnistía o crispación

Code 
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

Code 

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)

dim(subtitulos_proces_one_word)
#> [1] 4258    5
Code 
DT::datatable(subtitulos_proces_one_word)

Contar ocurrencias de cosas es lo más básico.

Code 

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 una de las palabras más comunes 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.

Code 
(add_to_stop_words <- palabras_ordenadas_1 %>% 
    slice(1:25) %>% 
    pull(word) )
#>  [1] "año"     "canción" "si"      "vida"    "ahora"   "menos"   "después"
#>  [8] "españa"  "aplauso" "años"    "música"  "noche"   "tema"    "1990"   
#> [15] "feliz"   "primera" "bien"    "siempre" "vez"     "2023"    "aunque" 
#> [22] "igual"   "señores" "tan"     "tiempo"


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)
Code 

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

Code 

pal <- brewer.pal(8,"Dark2")

subtitulos_proces_one_word %>% 
    group_by(word) %>% 
    count() %>% 
    with(wordcloud(word, n, random.order = FALSE, max.words = 110, colors=pal))

¿Polémicos?

Creamos lista de palabras polémicas (se aceptan otras, podéis poner en los comentarios).

Code 

palabras_polem <-
    c(
        "abascal",
        "almeida",
        "amnistía",
        "ayuso",
        "belarra",
        "bloqueo",
        "brusel",
        "catal",
        "ciudada",
        "comunidad",
        "constitucional",
        "coron",
        "crispación",
        "democr",
        "democracia",
        "derech",
        "díaz",
        "dioni",
        "errejon",
        "extremadura",
        "fach",
        "falcon",
        "fasc",
        "feij",
        "feijóo",
        "gobierno",
        "guardia",
        "guerra",
        "iglesias",
        "izquier",
        "ley",
        "madrid",
        "manipulador",
        "militares",
        "minist",
        "monarca",
        "montero",
        "oposición",
        "page",
        "pandem",
        "polarización",
        "polarizados",
        "pp",
        "principe",
        "prisión",
        "psoe",
        "sumar",
        "puigdemont",
        "republic",
        "rey",
        "rufián",
        "sánchez",
        "sanz",
        "tezanos",
        "toled",
        "transición",
        "ultra",
        "vicepre",
        "vox",
        "yolanda",
        "zarzu",
        "zarzuela"
    )

Y construimos una regex simple

Code 
(exp_regx <- paste0("^",paste(palabras_polem, collapse = "|^")))
#> [1] "^abascal|^almeida|^amnistía|^ayuso|^belarra|^bloqueo|^brusel|^catal|^ciudada|^comunidad|^constitucional|^coron|^crispación|^democr|^democracia|^derech|^díaz|^dioni|^errejon|^extremadura|^fach|^falcon|^fasc|^feij|^feijóo|^gobierno|^guardia|^guerra|^iglesias|^izquier|^ley|^madrid|^manipulador|^militares|^minist|^monarca|^montero|^oposición|^page|^pandem|^polarización|^polarizados|^pp|^principe|^prisión|^psoe|^sumar|^puigdemont|^republic|^rey|^rufián|^sánchez|^sanz|^tezanos|^toled|^transición|^ultra|^vicepre|^vox|^yolanda|^zarzu|^zarzuela"

Y nos creamos una variable para identificar si es palabra polémica

Code 
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] "00000035.jpg.subtitulo.tif.txt" "00000059.jpg.subtitulo.tif.txt"
#>  [3] "00000091.jpg.subtitulo.tif.txt" "00000114.jpg.subtitulo.tif.txt"
#>  [5] "00000121.jpg.subtitulo.tif.txt" "00000222.jpg.subtitulo.tif.txt"
#>  [7] "00000292.jpg.subtitulo.tif.txt" "00000355.jpg.subtitulo.tif.txt"
#>  [9] "00000382.jpg.subtitulo.tif.txt" "00000383.jpg.subtitulo.tif.txt"
#> [11] "00000397.jpg.subtitulo.tif.txt" "00000411.jpg.subtitulo.tif.txt"
#> [13] "00000427.jpg.subtitulo.tif.txt" "00000432.jpg.subtitulo.tif.txt"
#> [15] "00000474.jpg.subtitulo.tif.txt" "00000534.jpg.subtitulo.tif.txt"
#> [17] "00000549.jpg.subtitulo.tif.txt" "00000595.jpg.subtitulo.tif.txt"
#> [19] "00000640.jpg.subtitulo.tif.txt" "00000656.jpg.subtitulo.tif.txt"
#> [21] "00000680.jpg.subtitulo.tif.txt" "00000772.jpg.subtitulo.tif.txt"
#> [23] "00000803.jpg.subtitulo.tif.txt" "00000810.jpg.subtitulo.tif.txt"
#> [25] "00000825.jpg.subtitulo.tif.txt" "00000902.jpg.subtitulo.tif.txt"
#> [27] "00000920.jpg.subtitulo.tif.txt" "00000964.jpg.subtitulo.tif.txt"
#> [29] "00000973.jpg.subtitulo.tif.txt" "00001103.jpg.subtitulo.tif.txt"
#> [31] "00001129.jpg.subtitulo.tif.txt" "00001157.jpg.subtitulo.tif.txt"
#> [33] "00001181.jpg.subtitulo.tif.txt" "00001194.jpg.subtitulo.tif.txt"
#> [35] "00001278.jpg.subtitulo.tif.txt" "00001330.jpg.subtitulo.tif.txt"
#> [37] "00001343.jpg.subtitulo.tif.txt"

Y podemos ver en el texto original antes de tokenizar qué rótulos hemos considerado polémicos y qué texto

Code 
subtitulos_proces %>% 
    filter(n_fichero %in% subtitulos_polemicos) %>% 
    arrange(n_fichero) %>% 
    pull(texto) %>% 
    unique()
#>  [1] "ste tema se escribió con cartas de mujeres con cáncer de mama si te ha tocado este año lo de la amnistía igual lo relativizas"   
#>  [2] "si no sabéis quién es quién toñi es la de la izquierda y encorna la que le da el chorro de aire acondicionado"                   
#>  [3] "el de la izquierda del todo ya no está en la coalición para algunos el chunguito verdadero"                                      
#>  [4] "la de la izquierda hizo lo que todo padre sueña al mirar su whatsapp abandonar el grupo"                                         
#>  [5] "quizá por eso se decía que estaba como un tren bueno en extremadura decían como un autobús"                                      
#>  [6] "ana belén conoció a victor manuel al mismo tiempo que a julio iglesias ésta se la cantó a julio"                                 
#>  [7] "la versión que habla de la relación de feijóo con el último resultado electoral se titula nosentera"                             
#>  [8] "a henry como a los ultras de las protestas contra la amnistía le gusta estar cara al sol"                                        
#>  [9] "juan luis guerra 4 40 visa para un sueño pero esto qué es esto es lo que hay 1990"                                               
#> [10] "ojalá todas las guerras que hemos vivido este año se llamaran juan luis"                                                         
#> [11] "vicente fernández y massiel el rey palmarés 1976"                                                                                
#> [12] "con todos los respetos a antonio josé esperábamos que el dúo de rufián fuera con junqueras"                                      
#> [13] "la pandemia creímos que formaban el dúo más estomagante gonzález y guerra han vuelto para recordarnos que no"                    
#> [14] "el pp usó verano azul para su campaña el plan b era fariña o crematorio pero el resultado fue poco yo"                           
#> [15] "el grupo más longevo del pop español años antes de protagonizar su propia guerra de los clones"                                  
#> [16] "en este año de crispación política la propuesta no de ley sobre alud mental logró 340 votos aún así seguimos sin una ley naciona"
#> [17] "los niños protagonistas de esta canción ya tienen mejor currículum que santiago abascal"                                         
#> [18] "el rey de la copla callejera vestía como un agente de tecnocaso y cobía por la puerta chica del imaginarium"                     
#> [19] "alejandro sanz viviendo deprisa ay vida mia 1992"                                                                                
#> [20] "lleva la camisa más abierta que las barreras de sánchez en una negociación de investidura"                                       
#> [21] "si puigdemont la hubiera pedido así la amnistía no sería tan impopular"                                                          
#> [22] "9 de cada 10 españoles son como la cantudo odian planchar la otra es yolanda díaz"                                               
#> [23] "hablando de volcanes los afectados de la palma siguen intentando sacar adelante una ley nacional de volcanes"                    
#> [24] "has sido tú resume el discurso de la oposición desde que llegó pedro sánchez hasta hoy"                                          
#> [25] "danza invisible catalina cajón desastre 1990"                                                                                    
#> [26] "la última gran diva una manchega moderna abierta y rompedora en las antípodas de garcia page"                                    
#> [27] "este programa era como canal red con iglesias y montero siempre vigilantes"                                                      
#> [28] "los reyes del eurodisco alemán también triunfaron en españa y eso que aquí competían con el tigretón y la pantera rosa"          
#> [29] "recordáis la corona del roscón que llevaba bobby farrell pues aqui tenéis el abba"                                               
#> [30] "ha sido la canción más enviada entre pp y psoe estos años aunque la versión definitiva ha sido para irene montero"               
#> [31] "alvaro benito jugaba en el real madrid se lesionó y se dedicó a la música como julio iglesias pero no"                           
#> [32] "a compusieron en pandemia pensando que igual todo acababa no tendríamos que escucharla en bucle durante tres años"               
#> [33] "una mezcla entre un maniquí de una tienda de segunda mano y puigdemont después de sobrevivir a una pelea con junqueras"          
#> [34] "un homenaje a antonio gonzález el pescailla padre de la rumba catalana y de todos los hijos de lola flores"                      
#> [35] "la canción habla de la margen izquierda del nervión el rio en el que desembocan los cinco océanos"                               
#> [36] "un catalán puso de moda los campos de castilla y reivindicó que españa puede avanzar a golpes sin romperse"                      
#> [37] "julio iglesias la vida sigue igual fin de año 1969"

Escribimos en un fichero los subtítulos polémicos , por si hago lo que estoy pensando hacer .

Code 
subtitulos_proces %>% 
    filter(n_fichero %in% subtitulos_polemicos) %>% 
    arrange(n_fichero) %>% 
    write_csv(file = "~/proyecto_cachitos/2023_solo_polem.csv")

Y podemos ver los fotogramas.

Code 
# identificamos nombre del archivo jpg con los rótulos polémicos
polemica_1_fotogramas <- unique(substr(subtitulos_polemicos, 1,9))

head(polemica_1_fotogramas)
#> [1] "00000035." "00000059." "00000091." "00000114." "00000121." "00000222."

# creamos la ruta completa donde están
polemica_1_fotogramas_full <- paste0(str_glue("{root_directory}video/{anno}_jpg/"), polemica_1_fotogramas, "jpg")


# 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

Code 
fotogramas_polemicos_img <- map(polemica_1_fotogramas_full, image_read)
subtitulos_polemicos_img <- map(subtitulos_polemicos_1_full, image_read)
Code 

subtitulos_polemicos_img[[24]]

Code 
fotogramas_polemicos_img[[24]]

Podemos ver una muestra de algunos de ellos.

No es perfecto, esto requiere más trabajo pero por el momento nos podria valer. Vemos una muestra de los rótulos polémicos

Code 
set.seed(42)
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.

Code 
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”, 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

Code 

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] 583

head(word_counts, 15)
#> # A tibble: 15 × 3
#>     name word            n
#>    <dbl> <chr>       <int>
#>  1    80 paco            3
#>  2     4 pues            2
#>  3    11 estopa          2
#>  4    24 quién           2
#>  5    59 rollo           2
#>  6   100 mujer           2
#>  7   106 pena            2
#>  8   109 julio           2
#>  9   111 himno           2
#> 10   156 dolor           2
#> 11   257 ley             2
#> 12   307 aitana          2
#> 13   322 chapa           2
#> 14   363 milenarismo     2
#> 15   396 olé             2

Ahora convertimos este data.frame a un DocumentTermMatrix

Code 
# usamos como peso la TermFrequency de la palabra
rotulos_dtm <- word_counts %>%
    cast_dtm(name, word, n, weighting = tm::weightTf)


rotulos_dtm
#> <<DocumentTermMatrix (documents: 583, terms: 2662)>>
#> Non-/sparse entries: 3780/1548166
#> Sparsity           : 100%
#> Maximal term length: 18
#> Weighting          : term frequency (tf)

Podríamos haberlo visto en forma de filas = palabras y columnas = rótulo

Code 
word_counts  %>%
    cast_dfm(word, name, n)
#> Document-feature matrix of: 2,662 documents, 583 features (99.76% sparse) and 0 docvars.
#>         features
#> docs     80 4 11 24 59 100 106 109 111 156
#>   paco    3 0  0  0  0   0   0   0   0   0
#>   pues    0 2  0  0  0   0   0   0   0   0
#>   estopa  0 0  2  0  0   0   0   0   0   0
#>   quién   0 0  0  2  0   0   0   0   0   0
#>   rollo   0 0  0  0  2   0   0   0   0   0
#>   mujer   0 0  0  0  1   2   0   0   0   0
#> [ reached max_ndoc ... 2,656 more documents, reached max_nfeat ... 573 more features ]

Vamos a ver si sale algo haciendo un LDA (Latent Dirichlet Allocation)

Considero 20 tópicos porque sí. El que quiera elegir con algo más de criterio que se mire esto

Code 

# Cons

rotulos_lda <- LDA(rotulos_dtm, k = 20, control = list(seed = 1234))
rotulos_lda
#> A LDA_VEM topic model with 20 topics.

rotulos_lda_td <- tidy(rotulos_lda)
rotulos_lda_td
#> # A tibble: 53,240 × 3
#>    topic term       beta
#>    <int> <chr>     <dbl>
#>  1     1 paco  7.59e-224
#>  2     2 paco  1.29e-223
#>  3     3 paco  8.20e-224
#>  4     4 paco  8.90e-224
#>  5     5 paco  9.20e-224
#>  6     6 paco  6.36e-224
#>  7     7 paco  8.77e-224
#>  8     8 paco  8.41e-224
#>  9     9 paco  6.13e-224
#> 10    10 paco  6.17e-  3
#> # ℹ 53,230 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: 136 × 3
#>    topic term     beta
#>    <int> <chr>   <dbl>
#>  1     1 1975   0.0305
#>  2     1 habla  0.0203
#>  3     1 himno  0.0152
#>  4     1 verdad 0.0152
#>  5     1 sabe   0.0152
#>  6     2 you    0.0232
#>  7     2 bravo  0.0174
#>  8     2 día    0.0116
#>  9     2 habla  0.0116
#> 10     2 puerta 0.0116
#> # ℹ 126 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.

Code 

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    80 paco               3 0.375  5.27   1.98
#> 2     4 pues               2 0.222  4.98   1.11
#> 3    11 estopa             2 0.333  6.37   2.12
#> 4    24 quién              2 0.222  4.58   1.02
#> 5    59 rollo              2 0.222  5.27   1.17
#> 6   100 mujer              2 0.286  4.98   1.42

Para cada palabra tenemos su tf_idf dentro de cada rótulo en el que aparece

Code 
tf_idf_data %>% 
    filter(word== "amnistía")
#> # A tibble: 3 × 6
#>    name word     veces_palabra    tf   idf tf_idf
#>   <dbl> <chr>            <int> <dbl> <dbl>  <dbl>
#> 1    13 amnistía             1 0.111  5.27  0.586
#> 2   175 amnistía             1 0.143  5.27  0.753
#> 3   334 amnistía             1 0.25   5.27  1.32

Como de nuevo LDA solo acepta peso con valores enteros, pues simplemente multiplicamos por 100 el tf_idf y redondeamos

Code 
dtm_long <- tf_idf_data %>% 
    mutate(tf_idf_integer = round(100*tf_idf)) %>% 
    cast_dfm(name, word, tf_idf_integer)
Code 
lda_model_long_1 <- LDA(dtm_long, k = 20, control = list(seed = 1234))
Code 
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.

Code 

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   257 ley                     2 0.667  2.89   1.93
#> 2    13 amnistía                1 1      2.48   2.48
#> 3    24 izquierda               1 1      2.20   2.20
#> 4    41 izquierda               1 1      2.20   2.20
#> 5    53 izquierda               1 1      2.20   2.20
#> 6    57 extremadura             1 1      3.58   3.58

Topic modelling usando conteo de palabras

Code 
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 = 5, control = list(seed = 1234))

result_polem <- tidy(lda_model_long_polem, 'beta')
Code 
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 1 vemos palabras como amnistía, puigdemont, rey o sánchez. O en el 2 iglesias, amnistía, catalana.

Si vemos en qué tópico cae cada documento.

Code 
result_documento_polem <-  tidy(lda_model_long_polem, 'gamma')


result_documento_polem %>%
    group_by(topic) %>%
    top_n(7, 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 1

Code 
subtitulos_proces %>% 
    filter(name %in% c(175, 385, 334, 598, 321, 13, 408)) %>% 
    pull(texto)
#> [1] "ste tema se escribió con cartas de mujeres con cáncer de mama si te ha tocado este año lo de la amnistía igual lo relativizas"
#> [2] "a henry como a los ultras de las protestas contra la amnistía le gusta estar cara al sol"                                     
#> [3] "lleva la camisa más abierta que las barreras de sánchez en una negociación de investidura"                                    
#> [4] "si puigdemont la hubiera pedido así la amnistía no sería tan impopular"                                                       
#> [5] "9 de cada 10 españoles son como la cantudo odian planchar la otra es yolanda díaz"                                            
#> [6] "has sido tú resume el discurso de la oposición desde que llegó pedro sánchez hasta hoy"                                       
#> [7] "una mezcla entre un maniquí de una tienda de segunda mano y puigdemont después de sobrevivir a una pelea con junqueras"

Veamos más documentos relacionados con este tópico

Code 

top_10_topic3 <-  result_documento_polem %>%
    group_by(topic) %>% 
    top_n(12, gamma) %>% 
    filter(topic==1) %>% 
    pull(document)

subtitulos_proces %>% 
    filter(name %in% top_10_topic3) %>% 
    pull(texto)
#>  [1] "ste tema se escribió con cartas de mujeres con cáncer de mama si te ha tocado este año lo de la amnistía igual lo relativizas"
#>  [2] "a henry como a los ultras de las protestas contra la amnistía le gusta estar cara al sol"                                     
#>  [3] "ojalá todas las guerras que hemos vivido este año se llamaran juan luis"                                                      
#>  [4] "vicente fernández y massiel el rey palmarés 1976"                                                                             
#>  [5] "con todos los respetos a antonio josé esperábamos que el dúo de rufián fuera con junqueras"                                   
#>  [6] "el rey de la copla callejera vestía como un agente de tecnocaso y cobía por la puerta chica del imaginarium"                  
#>  [7] "lleva la camisa más abierta que las barreras de sánchez en una negociación de investidura"                                    
#>  [8] "si puigdemont la hubiera pedido así la amnistía no sería tan impopular"                                                       
#>  [9] "9 de cada 10 españoles son como la cantudo odian planchar la otra es yolanda díaz"                                            
#> [10] "has sido tú resume el discurso de la oposición desde que llegó pedro sánchez hasta hoy"                                       
#> [11] "recordáis la corona del roscón que llevaba bobby farrell pues aqui tenéis el abba"                                            
#> [12] "una mezcla entre un maniquí de una tienda de segunda mano y puigdemont después de sobrevivir a una pelea con junqueras"

Y bueno si que parece que ha agrupado algunos rótulos relacionados con la amnistía

Topic modelling usando tf_idf

Code 
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 = 5, control = list(seed = 1234))

result_polem_tf_idf <- tidy(lda_model_long_polem_tf_idf, 'beta')
Code 
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 bueno más o menos igual.

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.

IA’s

Probando que me decía ChatGPT 3.5, (no tengo versión de pago). le he pasado la mitad de los rótulos de este año y le digo que me saque los 7 puntos más importantes y me devuelve esto.

Aquí están los 7 puntos más importantes del texto proporcionado:

  1. Variedad de Temas y Artistas: El texto aborda una amplia variedad de temas y artistas de la música, tocando géneros y décadas diferentes.

  2. Anécdotas y Curiosidades: Se presentan anécdotas y curiosidades sobre algunos artistas, como detalles sobre sus canciones, momentos destacados de sus carreras y datos interesantes.

  3. Comentarios Irónicos y Humor: El texto utiliza un tono irónico y humorístico para comentar sobre diversos aspectos de la música y los artistas, proporcionando un enfoque entretenido.

  4. Referencias Históricas y Culturales: Se realizan referencias a eventos históricos, políticos y culturales, situando a los artistas y sus obras en un contexto más amplio.

  5. Comentarios Socio-políticos: Se incluyen comentarios que tocan temas sociales y políticos, como la referencia a la amnistía y menciones a personajes políticos.

  6. Observaciones sobre la Industria Musical: El texto realiza observaciones sobre la industria musical, como la evolución de los formatos de música, la viralidad en las redes sociales y la temática de algunas canciones.

  7. Diversidad de Géneros Musicales: Se abordan diversos géneros musicales, desde el pop y la música urbana hasta el rock y el flamenco, mostrando la diversidad en la escena musical española.

Luego he probado lo mismo usando Chat Arena que lo acabo de leer en el blog de Carlos Gil Bellosta y le he podido pasar todos los rótulos y el resultado de ChatGpt 4 y demás, me ha decepcionado bastante. Os animo a probarlo

Si hago una próxima entrada exploraré a ver si puedo conectarme a algún modelo de huggin face y ver qué tal lo hace.

Coda

En esta serie de post he dejado reflejado como bajar el video, extraer fotogramas, recortar rótulos, hacer ocrs y un pequeño análisis de los rótulos. Queda para cada cual discernir si los rótulos de este año se meten más con el gobierno, la oposición , los nacionalistas o con otros personajes. Sea como fuere en la serie de post se dan herramientas para que el que quiera realice su propio análisis y se forme una opinión propia.

Sin más, os deseo un Feliz 2024 a todos y espero el año que viene seguir cumpliendo con la ya casi tradición del análisis de Nochevieja a Cachitos