Cachitos. Tercera parte

estadística
polémica
textmining
ocr
2022
cachitos
Author

José Luis Cañadas Reche

Published

January 16, 2022

Cómo aún ando medio “covitoso”, reciclo el código y comentarios de la entrada de 2021 y con solo cambiar la ruta del fichero de subtítulos ya nos vale todo el código.

El csv con el texto de los subtítulos para 2021 lo tenéis en este enlace.

Vamos al lío


library(tidyverse)

root_directory = "/media/hd1/canadasreche@gmail.com/public/proyecto_cachitos/"
anno <- "2021"

Leemos el csv. Uso DT y así podéis ver todos los datos o buscar cosas, por ejemplo Ayuso o pandemia , monarquía o podemos

subtitulos_proces <-  read_csv(str_glue("{root_directory}{anno}_txt_unido.csv"))

subtitulos_proces %>% 
  select(texto, n_fichero, n_caracteres) %>% 
  DT::datatable()

Oye, pues sólo con esto ya nos valdría ¿no?

Quitamos stopwords

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", "si")

head(to_remove, 40)
#>  [1] "de"      "la"      "que"     "el"      "en"      "y"       "a"      
#>  [8] "los"     "del"     "se"      "las"     "por"     "un"      "para"   
#> [15] "con"     "no"      "una"     "su"      "al"      "lo"      "como"   
#> [22] "más"     "pero"    "sus"     "le"      "ya"      "o"       "este"   
#> [29] "sí"      "porque"  "esta"    "entre"   "cuando"  "muy"     "sin"    
#> [36] "sobre"   "también" "me"      "hasta"   "hay"

Pero en nuestros datos, las palabras no están separadas, tendríamos que separarlas y luego quitar las que no queremos. Para eso voy a utilizar la librería tidytext

library(tidytext)

# Con unnest token pasamos a un dataframe qeu tiene tantas filas como palabras

print(str_glue("Filas datos originales: {tally(subtitulos_proces)}"))
#> Filas datos originales: 687

subtitulos_proces_one_word <- subtitulos_proces %>% 
    unnest_tokens(input = texto,
                  output = word) %>% 
    filter(! word %in% to_remove) %>% # quito palabras de la lista 
    filter(nchar(word)>1) # Nos quedamos con palabras que tengan más de un cáracter


print(str_glue("Filas datos tokenizado: {tally(subtitulos_proces_one_word)}"))
#> Filas datos tokenizado: 4735

subtitulos_proces_one_word %>% 
  select(name,n_fichero,word, n_caracteres)
#> # A tibble: 4,735 × 4
#>     name n_fichero                      word          n_caracteres
#>    <dbl> <chr>                          <chr>                <dbl>
#>  1    14 00000014.jpg.subtitulo.tif.txt servicio               118
#>  2    14 00000014.jpg.subtitulo.tif.txt meteorológico          118
#>  3    14 00000014.jpg.subtitulo.tif.txt cachitos               118
#>  4    14 00000014.jpg.subtitulo.tif.txt informa                118
#>  5    14 00000014.jpg.subtitulo.tif.txt prevén                 118
#>  6    14 00000014.jpg.subtitulo.tif.txt vientos                118
#>  7    14 00000014.jpg.subtitulo.tif.txt fiesta                 118
#>  8    14 00000014.jpg.subtitulo.tif.txt fuertes                118
#>  9    14 00000014.jpg.subtitulo.tif.txt próximas               118
#> 10    14 00000014.jpg.subtitulo.tif.txt tres                   118
#> # … with 4,725 more rows

Una cosa simple que podemos hacer es contar palabras, y vemos que lo que más se repite es canción, obvio

palabras_ordenadas <- subtitulos_proces_one_word %>% 
    group_by(word) %>% 
    summarise(veces = n()) %>% 
    arrange(desc(veces))

palabras_ordenadas %>% 
    slice(1:20) %>% 
    ggplot(aes(x = reorder(word, veces), y = veces)) +
    geom_col(show.legend = FALSE) +
    ylab("veces") +
    xlab("") +
    coord_flip() +
    theme_bw()

O pintarlas en plan nube de palabras.

library(wordcloud)
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))    

Pues una vez que tenemos las palabras de cada subtítulo separadas podemos buscar palabras polémicas, aunque antes al usar la librería DT ya podíamos buscar, veamos como sería con el código.

Creamos lista de palabras a buscar.

palabras_1 <- c("monarca","pp","vox","rey","coron","zarzuela",
                "prisión", "democracia", "abascal","casado",
                "ultra","ciudada", "oposición","derech",
                "podem","sanchez","iglesias","errejon","izquier",
                "gobierno","illa","redondo","ivan","celaa",
                "guardia","príncipe","principe","ayuso",
                "tezanos","cis","republic", "simon", "pandem","lazo","arrim",
                "toled","alber","fach", "zarzu", "democr","vicepre", "minist",
                "irene","montero","almeida", "monarq")

Construimos una regex para que encuentre las palabras que empiecen así.

(exp_regx <- paste0("^",paste(palabras_1, collapse = "|^")))
#> [1] "^monarca|^pp|^vox|^rey|^coron|^zarzuela|^prisión|^democracia|^abascal|^casado|^ultra|^ciudada|^oposición|^derech|^podem|^sanchez|^iglesias|^errejon|^izquier|^gobierno|^illa|^redondo|^ivan|^celaa|^guardia|^príncipe|^principe|^ayuso|^tezanos|^cis|^republic|^simon|^pandem|^lazo|^arrim|^toled|^alber|^fach|^zarzu|^democr|^vicepre|^minist|^irene|^montero|^almeida|^monarq"

Y nos creamos una variable que valga TRUE cuando suceda esto


subtitulos_proces_one_word <- subtitulos_proces_one_word %>% 
    mutate(polemica= str_detect(word, exp_regx))

subtitulos_proces_one_word %>% 
  filter(polemica) %>% 
  select(name, word, n_fichero) 
#> # A tibble: 32 × 3
#>     name word      n_fichero                     
#>    <dbl> <chr>     <chr>                         
#>  1   139 reyes     00000139.jpg.subtitulo.tif.txt
#>  2   169 arrima    00000169.jpg.subtitulo.tif.txt
#>  3   169 monarquía 00000169.jpg.subtitulo.tif.txt
#>  4   330 pandemia  00000330.jpg.subtitulo.tif.txt
#>  5   397 ministro  00000397.jpg.subtitulo.tif.txt
#>  6   398 pandemia  00000398.jpg.subtitulo.tif.txt
#>  7   404 guardia   00000404.jpg.subtitulo.tif.txt
#>  8   581 iglesias  00000581.jpg.subtitulo.tif.txt
#>  9   621 podemos   00000621.jpg.subtitulo.tif.txt
#> 10   641 illa      00000641.jpg.subtitulo.tif.txt
#> # … with 22 more rows

Podríamos ver el texto de los subtítulos, para eso, nos quedamos con un identificador, como el nombre del fichero txt, que nos servirá luego para leer la imagen.

Pues en realidad tenemos sólo 27 subtítulos polémicos de los de alrededor de 680 que hay

subtitulos_polemicos <- subtitulos_proces_one_word %>% 
    filter(polemica) %>% 
    pull(n_fichero) %>% 
    unique()
subtitulos_polemicos
#>  [1] "00000139.jpg.subtitulo.tif.txt" "00000169.jpg.subtitulo.tif.txt"
#>  [3] "00000330.jpg.subtitulo.tif.txt" "00000397.jpg.subtitulo.tif.txt"
#>  [5] "00000398.jpg.subtitulo.tif.txt" "00000404.jpg.subtitulo.tif.txt"
#>  [7] "00000581.jpg.subtitulo.tif.txt" "00000621.jpg.subtitulo.tif.txt"
#>  [9] "00000641.jpg.subtitulo.tif.txt" "00000665.jpg.subtitulo.tif.txt"
#> [11] "00000671.jpg.subtitulo.tif.txt" "00000680.jpg.subtitulo.tif.txt"
#> [13] "00000763.jpg.subtitulo.tif.txt" "00000828.jpg.subtitulo.tif.txt"
#> [15] "00000853.jpg.subtitulo.tif.txt" "00000865.jpg.subtitulo.tif.txt"
#> [17] "00000866.jpg.subtitulo.tif.txt" "00000955.jpg.subtitulo.tif.txt"
#> [19] "00000980.jpg.subtitulo.tif.txt" "00000981.jpg.subtitulo.tif.txt"
#> [21] "00001135.jpg.subtitulo.tif.txt" "00001169.jpg.subtitulo.tif.txt"
#> [23] "00001176.jpg.subtitulo.tif.txt" "00001183.jpg.subtitulo.tif.txt"
#> [25] "00001189.jpg.subtitulo.tif.txt" "00001228.jpg.subtitulo.tif.txt"
#> [27] "00001233.jpg.subtitulo.tif.txt" "00001254.jpg.subtitulo.tif.txt"
#> [29] "00001262.jpg.subtitulo.tif.txt"
(texto_polemicos <- subtitulos_proces %>% 
    filter(n_fichero %in% subtitulos_polemicos) %>% 
    arrange(n_fichero) %>% 
    pull(texto))
#>  [1] "ella se conformaba con poquita cosa no como tú que sigues poniendo el scalextric en la carta a los reyes"             
#>  [2] "el cámara se arrima pero sin tocar nw sn 4 como el psoe con la monarquía aaa"                                         
#>  [3] "el mítico rockero henry stephen autor de esta canción también murió en 2021 a causa de la pandemia"                   
#>  [4] "con el fary perdimos un buen taxista y un mejor ministro de economía"                                                 
#>  [5] "ha hecho falta una crisis financiera de 10 años y una pandemia para que alguien hiciera caso a el fary"               
#>  [6] "si en una verbena gallega la tortilla está muy hecha o no suena ana kiro viene la guardia civil y la cierra"          
#>  [7] "4 la italiana le supo sacar más partido al bamboleo y que julio iglesias o los gypsy kings"                           
#>  [8] "anita triunfó con un tema que al principio no le molaba nada como sánchez con podemos"                                
#>  [9] "illa rusa tt y los coches del pasado"                                                                                 
#> [10] "con tanto escenario para ellos solos parece la sede de ciudadanos"                                                    
#> [11] "himno de los nuevos románticos al que también pertenecieron ultravox duran duran o hace poco pablo alborán y lópez"   
#> [12] "marian gold era una mezcla entre isa serra e ivonne reyes"                                                            
#> [13] "a una canción de pimpinela b sánchez y casado en una sesión de control"                                               
#> [14] "se ganó la corona del rey de la bachata como líder del grupo aventura"                                                
#> [15] "olvidaste la tabla periódica y a reyes godos pero esto sigue en algún lugar de tu cerebro junto al fijo de tus padres"
#> [16] "sherpa a la izquierda solo de la imagen sigue siendo igual de barón pero bastante menos rojo"                         
#> [17] "como buen sherpa es capaz de cargar con el pack completo plandemia inmigrantes invasores gobierno comunista"          
#> [18] "cuentan que iván redondo susurraba este estribillo al oído de pedro sánchez un par de veces al día"                   
#> [19] "o iglesias an e y canto a galicia dn d"                                                                               
#> [20] "lo único virgen alrededor de julio iglesias eran 4 las islas en las que invertía su patrimonio"                       
#> [21] "a estas alturas de la noche es cuando te arrimas y sentencias ni héroes ni mecano el último"                          
#> [22] "e podría haber sido la música de la campaña electoral de ayuso 4 ye la campañn"                                       
#> [23] "creéis que rodrigo de lorenzo sabe que no lleva maraca en la mano izquierda"                                          
#> [24] "aparte de ser el mejor letrista en español el intelectual de la salsa y ministro de turismo hizo"                     
#> [25] "este clásico tiene más versiones que ministros este gobierno"                                                         
#> [26] "22 en realidad esas coletas siempre fueron polémicas me lo milagroso es llegar a vicepresidente con una"              
#> [27] "azúcar no bueno mejor asi alberto garzón"                                                                             
#> [28] "concretamente falín a vuestra izquierda era el padre de falete"                                                       
#> [29] "amanece se recorta en el horizonte el perfil de santiago abascal p"

Podemos ver las imágenes

(polemica_fotogramas <- unique(substr(subtitulos_polemicos, 1,12)))
#>  [1] "00000139.jpg" "00000169.jpg" "00000330.jpg" "00000397.jpg" "00000398.jpg"
#>  [6] "00000404.jpg" "00000581.jpg" "00000621.jpg" "00000641.jpg" "00000665.jpg"
#> [11] "00000671.jpg" "00000680.jpg" "00000763.jpg" "00000828.jpg" "00000853.jpg"
#> [16] "00000865.jpg" "00000866.jpg" "00000955.jpg" "00000980.jpg" "00000981.jpg"
#> [21] "00001135.jpg" "00001169.jpg" "00001176.jpg" "00001183.jpg" "00001189.jpg"
#> [26] "00001228.jpg" "00001233.jpg" "00001254.jpg" "00001262.jpg"

polemica_fotogramas_full <- paste0(str_glue("{root_directory}video/{anno}_jpg/"), polemica_fotogramas)

subtitulos_polemicos_full <- paste0(polemica_fotogramas_full,".subtitulo.tif")

Y ahora utilizando la librería magick en R y un poco de programación funcional (un simple map), tenemos la imagen leída

library(magick)

fotogramas_polemicos_img <- map(polemica_fotogramas_full, image_read)
subtitulos_polemicos_img <- map(subtitulos_polemicos_full, image_read)
subtitulos_polemicos_img[[18]]

fotogramas_polemicos_img[[18]]

Podemos ponerlos todos juntos.

lista_fotogram_polemicos <- map(fotogramas_polemicos_img, grid::rasterGrob)
gridExtra::grid.arrange(grobs=lista_fotogram_polemicos)