En el post anterior vimos como extraer 1 de cada n fotogramas de un video, recortar una zona en concreto y pasarle un software de reconocimiento óptico de caracteres para tener el texto. En esta parte vamos a ver como leer esos ficheros de texto y también una de las formas de quitar subtítulos duplicados. Para eso vamos a utilizar R. Vamos al lío.
Ejecuto el script extract_subtitles.sh del post anterior de la siguiente forma.
Se baja el video desde alacarta, recorta los subtítulos y obtiene el texto. La estructura de directorios que me crea en dónde le haya dicho que es el root_directory es
╰─ $ ▶ tree -d.├── 2019_txt├── 2020_txt└── video├── 2019_jpg└── 2020_jpg
Dónde en video tenemos los dos videos en mp4, y los directorios con los fotogramas originales junto con los subtítulos, y en los directorios anno_txt cada uno de los ficheros de texto correspondientes a los fotogramas.
╰─ $ ▶ ll 2020_txt |head-n 20total 5456drwxrwxr-x 2 jose jose 77824 ene 11 20:51 ./drwxrwxr-x 8 jose jose 4096 ene 13 19:41 ../-rw-rw-r-- 1 jose jose 1 ene 4 13:07 00000001.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 1 ene 4 13:06 00000002.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 1 ene 4 13:07 00000003.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 1 ene 4 13:08 00000004.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 3 ene 4 13:07 00000005.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 3 ene 4 13:07 00000006.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 3 ene 4 13:07 00000007.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 3 ene 4 13:06 00000008.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 1 ene 4 13:07 00000009.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 3 ene 4 13:08 00000010.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 1 ene 4 13:08 00000011.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 6 ene 4 13:07 00000012.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 24 ene 4 13:06 00000013.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 94 ene 4 13:07 00000014.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 65 ene 4 13:07 00000015.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 93 ene 4 13:06 00000016.jpg.subtitulo.tif.txt-rw-rw-r-- 1 jose jose 1 ene 4 13:06 00000017.jpg.subtitulo.tif.txt╰─ $ ▶ ll 2020_txt |wc-l1347
Y vemos que hay 1347 ficheros txt, y algunos muy pequeños (los que no tienen texto)
Veamos el 00000016.jpg.subtitulo.tif.txt
╰─ $ ▶ cat 2020_txt/00000016.jpg.subtitulo.tif.txtViendo la actitud del público, más que una actuaciónesto es una sesión de coaching.
Pues vamos a leerlos todos usando R.
Mostrar / ocultar código
library(tidyverse)root_directory ="/media/hd1/canadasreche@gmail.com/public/proyecto_cachitos/"anno <-"2020"# Construims un data frame con los nombrs de los ficheros nombre_ficheros <-list.files(path =str_glue("{root_directory}{anno}_txt/")) %>%enframe() %>%rename(n_fichero = value)nombre_ficheros#> # A tibble: 1,344 × 2#> name n_fichero #> <int> <chr> #> 1 1 00000001.jpg.subtitulo.tif.txt#> 2 2 00000002.jpg.subtitulo.tif.txt#> 3 3 00000003.jpg.subtitulo.tif.txt#> 4 4 00000004.jpg.subtitulo.tif.txt#> 5 5 00000005.jpg.subtitulo.tif.txt#> 6 6 00000006.jpg.subtitulo.tif.txt#> 7 7 00000007.jpg.subtitulo.tif.txt#> 8 8 00000008.jpg.subtitulo.tif.txt#> 9 9 00000009.jpg.subtitulo.tif.txt#> 10 10 00000010.jpg.subtitulo.tif.txt#> # … with 1,334 more rows
Ahora los podemos leer en orden
Mostrar / ocultar código
subtitulos <-list.files(path =str_glue("{root_directory}{anno}_txt/"), pattern ="*.txt", full.names =TRUE) %>%map(~read_file(.)) %>%enframe() %>%# hacemos el join con el dataframe anterior para tener el nombre del fichero originalleft_join(nombre_ficheros)glimpse(subtitulos)#> Rows: 1,344#> Columns: 3#> $ name <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 1…#> $ value <list> "\f", "\f", "\f", "\f", " \n\f", " \n\f", " \n\f", " \n\f",…#> $ n_fichero <chr> "00000001.jpg.subtitulo.tif.txt", "00000002.jpg.subtitulo.ti…subtitulos#> # A tibble: 1,344 × 3#> name value n_fichero #> <int> <list> <chr> #> 1 1 <chr [1]> 00000001.jpg.subtitulo.tif.txt#> 2 2 <chr [1]> 00000002.jpg.subtitulo.tif.txt#> 3 3 <chr [1]> 00000003.jpg.subtitulo.tif.txt#> 4 4 <chr [1]> 00000004.jpg.subtitulo.tif.txt#> 5 5 <chr [1]> 00000005.jpg.subtitulo.tif.txt#> 6 6 <chr [1]> 00000006.jpg.subtitulo.tif.txt#> 7 7 <chr [1]> 00000007.jpg.subtitulo.tif.txt#> 8 8 <chr [1]> 00000008.jpg.subtitulo.tif.txt#> 9 9 <chr [1]> 00000009.jpg.subtitulo.tif.txt#> 10 10 <chr [1]> 00000010.jpg.subtitulo.tif.txt#> # … with 1,334 more rows
en n_fichero tenemos el nombre y en value el texto
Mostrar / ocultar código
subtitulos %>%pull(value) %>%## usamos `[[` que es el operador para acceder a la lista el que normalemente se usa [[nombre_elemento]]`[[`(16)#> [1] "Viendo la actitud del público, más que una actuación\nesto es una sesión de coaching.\n\n \n\f"# equivalentemente# subtitulos %>% # pull(value) %>% # pluck(16)
Como sabemos que hay muchos ficheros sin texto podemos contar letras.
Usando la librería magick en R que permite usar imagemagick en R, ver post de Raúl Vaquerizo y su homenaje a Sean Connery, podemos ver el fotgrama correspondiente
Vemos que también pasa, pero ya vamos pillando rótulos de verdad como el “Descanse en Pau” que pusieron ante una actuación de Pau Donés.
Como vemos hay que hacer limpieza, pero por el momento vamos a quedarnos con los subtítulos con número de caracteres mayor de 17. Esta decisión hace que perdamos algunos subtítulos de verdad, como por ejemplo el conocido “Loco Vox”.
Pues ya hemos pasado de más de 1000 rótulos a 664. Pero sabemos, por el post anterior que hay algunos duplicados.
Con el fin de detectar cuáles están duplicados y aprovechando que están en orden de aparición, podemos hacer utilizar distancias de texto para calcular la distancia de cada subtítulo con el anterior, y si la distancia es pequeña es que es el mismo rótulo.
Primero hacemos una minilimpieza.
Mostrar / ocultar código
string_mini_clean <-function(string){ string <-gsub("?\n|\n", " ", string) string <-gsub("\r|?\f|=", " ", string) string <-gsub('“|”|—|>'," ", string) string <-gsub("[[:punct:][:blank:]]+", " ", string) string <-tolower(string) string <-gsub(" ", " ", string) string <-return(string)}# Haciendo uso de programacion funciona con purrr es muy fácil pasar esta función a cada elemento. y decirle que # el reultado es string con map_chrsubtitulos_proces <- subtitulos %>%mutate(texto =map_chr(value, string_mini_clean)) %>%select(-value)subtitulos_proces %>%select(texto)#> # A tibble: 664 × 1#> texto #> <chr> #> 1 " a baeza " #> 2 "después del añito que hemos pasado quien mm aman 110 se consuela es porque …#> 3 "viendo la actitud del público más que una actuación esto es " #> 4 "viendo la actitud del público más que una actuación esto es una sesión de c…#> 5 " intura y su conjunto conga del jaruco 2 " #> 6 "la última vez que hiciste algo parecido fue en el súper y llevabas 25 rollo…#> 7 " a que produce nostalgia ver a un grupo de españoles p poniéndose de acuerd…#> 8 " a que produce nostalgia ver a un grupo de españoles poniéndose de acuerdo …#> 9 "jno lomas xte conmigo pi " #> 10 "í 7 igual lo que nos ha caído es una maldición india rel y este es el orige…#> # … with 654 more rows
Y ya vemos a simple vista que hay algun duplicado. Calculemos ahora la distancia de strings, utilizando la función stringdist de la librería del mismo nombre.
Mostrar / ocultar código
subtitulos_proces %>%mutate(texto_anterior =lag(texto)) %>%# calculamos distancias con método lcs (que no me he leído que hace exactamente)mutate(distancia = stringdist::stringdist(texto, texto_anterior, method ="lcs")) %>%# veamos algunos elementosfilter(distancia <10) %>%arrange(desc(distancia) ) %>%select(texto, texto_anterior, distancia) %>%head()#> # A tibble: 6 × 3#> texto texto…¹ dista…²#> <chr> <chr> <dbl>#> 1 "mn por si no te lo ha dicho aún tu cuñado 98 6 se considerab… "a si … 9#> 2 "por alguna razón a beyoncé le sale bastante mejor el truco d… " zz p… 6#> 3 "asi es como se visten los daft punk lr ey para teletrabajar " "asi e… 6#> 4 "la pandemia interrumpió su gira de 40 aniversario pasas carl… "la pa… 6#> 5 "2 xl en viajes al pasado los 80 con nostalgia de los 50 yy c… "2 xl … 6#> 6 "lp parece que a nek le ha pillado despistado 3 el cachito an… "parec… 6#> # … with abbreviated variable names ¹texto_anterior, ²distancia
Y parece que funciona. Así que decido quitar las filas dónde la distancia sea menos que 19 y así eliminar muchos de los duplicados.
Mostrar / ocultar código
subtitulos_proces <- subtitulos_proces %>%mutate(texto_anterior =lag(texto)) %>%mutate(distancia = stringdist::stringdist(texto, texto_anterior, method ="lcs")) %>%filter(distancia >19) %>%select(-texto_anterior)subtitulos_proces %>%head()#> # A tibble: 6 × 5#> name n_fichero n_caracteres texto dista…¹#> <int> <chr> <int> <chr> <dbl>#> 1 14 00000014.jpg.subtitulo.tif.txt 92 "después del añito … 84#> 2 15 00000015.jpg.subtitulo.tif.txt 62 "viendo la actitud … 89#> 3 16 00000016.jpg.subtitulo.tif.txt 89 "viendo la actitud … 23#> 4 19 00000019.jpg.subtitulo.tif.txt 50 " intura y su conju… 76#> 5 20 00000020.jpg.subtitulo.tif.txt 112 "la última vez que … 103#> 6 21 00000021.jpg.subtitulo.tif.txt 114 " a que produce nos… 128#> # … with abbreviated variable name ¹distancia
Y ahora escribimos este dataframe en un csv y será la materia prima para ver qué podemos hacer con esto (para eso requeriré ayuda de algún amigo más ducho en tales artes)
