Chachitos Nochevieja 2024

Los rótulos están bajados según las instrucciones del blog Muestrear no es pecado de Jose Luis Cañadas. Desde el año 2021 tiene documentados cómo bajar los rótulos de los Cachitos de Nochevieja

Este cuaderno arranca con los datos obtenidos por el procedimiento de Jose Luis Cañadas y genera un fichero con los datos en un formato cómodo para poder ser visualizado. Estos datos se pueden generar con este cuaderno o descargarlos de este repositorio.

Las personas mencionadas en Cachitos de Nochevieja se han extraído con Copilot y se ha realizado una revisión manual a la que se le ha añadido una clasificación. Al ser los artistas los más mencionados, para ahorrar trabajo aparecen con clasificación vacía, pero luego el script la completa. Están disponibles aquí

Advertencia: A pesar de la limpieza de datos, los datos no están perfectos al 100%. Los rótulos aunque siguen una metodología, tienen algunos errores de edición y el procedimiento de conversión OCR tiene algún defecto. No obstante, al ser fallos muy escasos, he preferido no modificarlos manualmente.

Librerías

library("tidyverse")
library("stringdist")
library("stringr")
library("magick")          # para vídeo
library("ggrepel")         # Ubicación no solapada de textos
library("ggtext")          # Dar color a los textos de las leyendas o titulos
library("RColorBrewer")    # Paleta de colores

Funciones

string_mini_clean <-  function(string){
    string <- gsub("?\n|\n", " ", string)
    string <- gsub("\r|?\f|=", " ", string)
    string <- gsub('"', "", string)
    return(string)
}
# Función para detectar nombres mencionados en los comentarios
detectar_menciones <- function(comentario, nombres) {
  menciones <- nombres[str_detect(comentario, fixed(nombres))]
  if (length(menciones) > 0) {
    return(paste(menciones, collapse = ", "))
  } else {
    return(NA)
  }
}

Leer ficheros

# Definir el rango de fechas y horas
anno <- "2024"
start_time <- as.POSIXct("2024-01-01 00:00:00")
end_time <- as.POSIXct("2024-01-01 03:03:44")
# Definir el entorno de ficheros
root_directory = "./"
output <- str_glue("{root_directory}rotulos_{anno}/")
images <- str_glue("{root_directory}images_{anno}")
if(!file.exists(output)) {
 dir.create(output)
}
if(!file.exists(images)) {
 dir.create(images)
}
# Leer ficheros de rótulos
nombre_ficheros <- list.files(path = str_glue("{root_directory}{anno}_txt/")) %>% 
  enframe() %>% 
  rename(n_fichero = value)
# Leer en orden y dejar solo el subtítulo
subtitulos <-  list.files(
    path = str_glue("{root_directory}{anno}_txt/"), 
    pattern = "*.txt",
    full.names = TRUE
  ) %>% 
  map(~read_file(.)) %>% 
  enframe() %>%  
  left_join(nombre_ficheros)

# Leer fichero de mencionados
mencionados <- read_csv(str_glue("{output}menciones_{anno}.csv")) %>%
    mutate(tipo = ifelse(is.na(tipo),"artista",tipo))

Limpiar textos

# Contar las letras y quitar rótulos con menos de 6 caracteres
subtitulos <- subtitulos %>% 
    mutate(n_caracteres = nchar(value)) %>% 
    filter(n_caracteres > 15 )
# Limpiar textos de caracteres raros
subtitulos_proces <- subtitulos %>% 
    mutate(texto = str_trim(value)) %>% 
    mutate(texto = map_chr(texto, string_mini_clean)) %>% 
    select(-value)

# Distancia de texto entre rótulos consecutivos (quita duplicados)
subtitulos_proces <- subtitulos_proces %>% 
    mutate(texto_anterior = lag(texto)) %>% 
    mutate(distancia = stringdist::stringdist(texto, texto_anterior, method = "lcs"))  %>%
    filter(distancia >= 30) %>% 
    select(-texto_anterior)
# patterns
pattern_actuaciones <- "[A-ZÁÉÍÓÚÑy!\\d,\\.\\s\\\"]+(?:\\s*[“][A-ZÁÉÍÓÚÑ\\s]+[”])?\\s*-\\s*.*\\s*\\([^\\)]+\\d+[:]*\\)"
#pattern_actuaciones <- "^(\\b[A-ZÁÉÍÓÚÑy\\s]+\\b\\s*-\\s*)"
artista_pattern <-  "^[A-ZÁÉÍÓÚÑy!\\d,\\s\\\"]+(?:\\s*[“][A-ZÁÉÍÓÚÑ\\s]+[”])?(?=\\s-\\s)"
cancion_pattern <-  "(?<=-\\s)[^()]+(?=\\s\\()"
programa_pattern_coma <-  "(?<=\\()[^,]+(?=,)"
programa_pattern_sin_coma <- "(?<=\\()[^()]+\\d{4}(?=\\))"
year_pattern <- "\\d{4}"

Extraer canciones

# Detectar canciones
subtitulos_canciones <- subtitulos_proces %>%
  filter(str_detect(texto, pattern_actuaciones,)) %>%
  mutate(
    artista = str_extract(texto, pattern = artista_pattern),
    cancion = str_extract(texto, pattern = cancion_pattern),
    programa = str_extract(texto, pattern = programa_pattern_coma),
    programa = ifelse(is.na(programa),str_extract(texto, pattern = programa_pattern_sin_coma), programa ), 
    year = as.numeric(str_extract(texto, pattern = year_pattern)),
    decada = as.character(trunc(year/10) *10),
    posicion =  row_number()
  )  

# Añadir tiempo
# Generar la secuencia de tiempo
time_sequence <- seq.POSIXt(from = start_time, to = end_time, length.out = nrow(subtitulos_canciones))
# Agregar la secuencia de tiempo al dataframe
subtitulos_canciones$fecha_hora <- time_sequence

min_year <- min(subtitulos_canciones$year, na.rm = TRUE)
max_year <- max(subtitulos_canciones$year, na.rm = TRUE)
breaks_year <- seq (1950, max_year, by=5)

Extraer comentarios

# Detectar comentarios y anotar canciones asociadas
subtitulos_comentarios <- subtitulos_proces %>%
  mutate(tipo = ifelse(str_detect(texto, pattern_actuaciones),"actuacion","comentario")) %>%
  pivot_wider (names_from=tipo,values_from=texto) %>%
  fill(actuacion, .direction = "down") %>%
  filter(!is.na(comentario)) %>%
  mutate(
    artista = str_extract(actuacion, pattern = artista_pattern),
    cancion = str_extract(actuacion, pattern = cancion_pattern),
    programa = str_extract(actuacion, pattern = programa_pattern_coma),
    programa = ifelse(is.na(programa),str_extract(actuacion, pattern = programa_pattern_sin_coma), programa ),
    year =  as.numeric(str_extract(actuacion, pattern = year_pattern)),
    decada = as.character(trunc(year/10) *10),
  ) %>%
# Buscar mencionados
  mutate(mencionados = sapply(comentario, detectar_menciones, nombres = mencionados$mencionados)) 
# Añadir tiempo
# Generar la secuencia de tiempo
time_sequence <- seq.POSIXt(from = start_time, to = end_time, length.out = nrow(subtitulos_comentarios))
# Agregar la secuencia de tiempo al dataframe
subtitulos_comentarios$fecha_hora <- time_sequence

min_year <- min(subtitulos_comentarios$year, na.rm = TRUE )
max_year <- max(subtitulos_comentarios$year, na.rm = TRUE)
breaks_year <- seq (1950, max_year, by=5)
# Separar por mencionados y añadir tipo
subtitulos_comentarios <- subtitulos_comentarios %>%
  separate_rows(mencionados, sep = ",\\s*") %>%
# Quitar repetidos
  #distinct(mencionados,cancion, .keep_all = TRUE) %>%
  left_join (mencionados) %>%
# Ordenar columnas    
  select(
     name, fecha_hora, n_fichero, n_caracteres, distancia, comentario, mencionados, tipo, actuacion, artista,
     cancion, programa, year, decada)
## Joining with `by = join_by(mencionados)`
# Escribir datos comentarios
write_csv(subtitulos_comentarios, str_glue("{output}/cachitos_{anno}.csv"))
# 

Color y orden

COLOR_TEXTO <- "#5a5856"
COLOR_DECADA <- brewer.pal(8,"Dark2") # Paleta categórica
COLOR_TIPOS = ( c(
  política = "#1F78B4", medios = "#B15928", famoseo = "#FB9A99", deporte ="#33A02C", 
  judicatura= "#E31A1C", cine = "#FF7F00", religión = "#6A3D9A"))
order_tipos <- c("política", "medios", "famoseo", "deporte","judicatura","cine","religión")

Recorrido musical por décadas

ggplot(
    data = subtitulos_canciones,
    aes(x = fecha_hora, y = year, color = decada
))+
  geom_path (color="steelblue4",linewidth=0.5,alpha=0.8)+
  geom_point (color="steelblue4",linewidth=0.5,alpha=0.8)+
  geom_hline(aes(yintercept = as.numeric(decada), color = decada)) + 
  geom_label(
    aes(x= start_time, y = as.numeric(decada), label =  substring(decada,3), label.padding = unit(0.15, "lines")),
    size=6,
    hjust=1.1,
    vjust=0.5
  ) +
  geom_label_repel(
    aes(label = posicion,), label.padding = unit(0.15, "lines"),
    size=4,
    hjust=1.1,
    vjust=0.5 ) +
  scale_x_datetime(
    date_labels = "%H:%M",
    date_breaks = "15 mins"
  ) +
  scale_y_continuous(breaks = breaks_year)  +
  labs(
    title = "Recorrido musical por décadas",
    x = "",
    y = "Año de la canción",
    caption = "@congosto\nFuente: RTVE Play") +
  scale_color_manual(values = COLOR_DECADA) +
  guides(color = "none") +
  theme_light() +
  theme(
    plot.title = element_text(
      size = 25,
      face = "bold",
      color = COLOR_TEXTO
    ),
    axis.title = element_text(
      size = 20,
      color = COLOR_TEXTO
    ),
    axis.text = element_text(
      size = 16,
      color = COLOR_TEXTO
    ),
    plot.caption = element_text(
      color = COLOR_TEXTO,
      size = 16,
      hjust = 0),
    panel.grid.major = element_blank(), # Quitar la cuadrícula mayor
    panel.grid.minor = element_blank() 
  )  

# Salvamos la gráfica en un archivo
ggsave(str_glue("{images}/recorrido_musical.png"))

Artistas

ggplot(
    data = subtitulos_canciones,
    aes(x = fecha_hora, y = year, color = decada
))+
  geom_point (color="steelblue4",linewidth=0.5,alpha=0.8)+
  geom_hline(aes(yintercept = as.numeric(decada), color = decada)) +
  geom_label(
    aes(x= start_time, y = as.numeric(decada), label =  substring(decada,3), label.padding = unit(0.15, "lines")),
    size=9,
    hjust=1.1,
    vjust=0.5
  ) +
  geom_text_repel(
     aes(label = artista),
     size=6,
     hjust=1.1,
     vjust=0.5
  ) +
  scale_x_datetime(
    date_labels = "%H:%M",
    date_breaks = "15 mins"
  ) +
  scale_y_continuous(breaks = breaks_year)  +
  labs(
    title = "Recorrido musical por artistas",
    x = "",
    y = "Año de la canción",
    caption = "@congosto\nFuente: RTVE Play") +
  scale_color_manual(values = COLOR_DECADA) +
  guides(color = "none") +
  theme_light() +
  theme(
    plot.title = element_text(
      size = 35,
      face = "bold",
      color = COLOR_TEXTO
    ),
    axis.title = element_text(
      size = 30,
      color = COLOR_TEXTO
    ),
    axis.text = element_text(
      size = 25,
      color = COLOR_TEXTO
    ),
    plot.caption = element_text(
      color = COLOR_TEXTO,
      size = 25,
      hjust = 0),
    panel.grid.major = element_blank(), # Quitar la cuadrícula mayor
    panel.grid.minor = element_blank() 
  )  

# Salvamos la gráfica en un archivo
ggsave(str_glue("{images}/artistas.png"))

Canciones

ggplot(
    data = subtitulos_canciones,
    aes(x = fecha_hora, y = year, color = decada
))+
  geom_point (color="steelblue4",alpha=0.8)+
  geom_hline(aes(yintercept = as.numeric(decada), color = decada)) +
  geom_label(
    aes(x= start_time, y = as.numeric(decada), label =  substring(decada,3), label.padding = unit(0.15, "lines")),
    size=9,
    hjust=1.1,
    vjust=0.5
  ) +
  geom_text_repel(
    aes(label = cancion),
    size=7,
    hjust=1.1,
    vjust=0.5
  ) +
  scale_x_datetime(
    date_labels = "%H:%M",
    date_breaks = "15 mins"
  ) +
  scale_y_continuous(breaks = breaks_year)  +
  labs(
    title = "Recorrido musical por canciones",
    x = "",
    y = "Año de la canción",
    caption = "@congosto\nFuente: RTVE Play") +
  scale_color_manual(values = COLOR_DECADA) +
  guides(color = "none") +
  theme_light() +
  theme_light() +
  theme(
    plot.title = element_text(
      size = 35,
      face = "bold",
      color = COLOR_TEXTO
    ),
    axis.title = element_text(
      size = 30,
      color = COLOR_TEXTO
    ),
    axis.text = element_text(
      size = 25,
      color = COLOR_TEXTO
    ),
    plot.caption = element_text(
      color = COLOR_TEXTO,
      size = 25,
      hjust = 0),
    panel.grid.major = element_blank(), # Quitar la cuadrícula mayor
    panel.grid.minor = element_blank() 
  )      

# Salvamos la gráfica en un archivo
ggsave(str_glue("{images}/canciones.png"))

Programas

ggplot(
    data = subtitulos_canciones,
    aes(x = fecha_hora, y = year, color = decada
))+
  geom_point (color="steelblue4",alpha=0.8)+
  geom_hline(aes(yintercept = as.numeric(decada), color = decada)) +
  geom_label(
    aes(x= start_time, y = as.numeric(decada), label =  substring(decada,3), label.padding = unit(0.15, "lines")),
    size=10,
    hjust=1.1,
    vjust=0.5
  ) +
  geom_text_repel(
    aes(label = programa),
    size=7,
    hjust=1.1,
    vjust=0.5
  ) +
  scale_x_datetime(
    date_labels = "%H:%M",
    date_breaks = "15 mins"
  ) +
  scale_y_continuous(breaks = breaks_year)  +
  labs(
    title = "Recorrido musical por programas",
    x = "",
    y = "Año de la canción",
    caption = "@congosto\nFuente: RTVE Play") +
  scale_color_manual(values = COLOR_DECADA) +
  guides(color = "none") +
  theme_light() +
  theme(
    plot.title = element_text(
      size = 35,
      face = "bold",
      color = COLOR_TEXTO
    ),
    axis.title = element_text(
      size = 30,
      color = COLOR_TEXTO
    ),
    axis.text = element_text(
      size = 25,
      color = COLOR_TEXTO
    ),
    plot.caption = element_text(
      color = COLOR_TEXTO,
      size = 25,
      hjust = 0),
    panel.grid.major = element_blank(), # Quitar la cuadrícula mayor
    panel.grid.minor = element_blank() 
  )  

# Salvamos la gráfica en un archivo
ggsave(str_glue("{images}/programas.png"))

Menciones a política, deporte, famoseo, medios, judicatura, cine y religión

# Ordenar tipos
subtitulos_comentarios$tipo <- factor(subtitulos_comentarios$tipo, levels = order_tipos)
df <- subtitulos_comentarios %>%
    filter (!is.na(tipo)) %>%
    filter (tipo != "artista")
ggplot(
    data = df,
    aes(x = fecha_hora, y = year, color = tipo
))+
  geom_point (color="steelblue4", size = 8, alpha=0.8)+
  geom_text_repel(
    aes(label =  str_glue("{mencionados}\n({cancion})")),
    force = 5,
    vjust = 0,
    size = 7,
    nudge_x =  60 * 3,
    nudge_y = 0.005,  # Ajuste eje y
    max.overlaps = 50,
    segment.size = 0.5,
    segment.linetype = 2
  )+
  scale_x_datetime(
    date_labels = "%H:%M",
    date_breaks = "15 mins"
  ) +
  scale_y_continuous(breaks = breaks_year)  +
  labs(
    title = "Recorrido musical por menciones",
    x = "",
    y = "Año de la canción",
    color = "",
    caption = "@congosto\nFuente: RTVE Play") +
   # Aplicamos color
    scale_color_manual(
      values = COLOR_TIPOS,
      labels = paste(
        "<span style='color:",
         COLOR_TIPOS,
         "'>",
         order_tipos,
         "</span>"),
      drop = TRUE
    ) +
  guides(color = guide_legend(ncol = 10)) +
  theme_light() +
  theme(
    plot.title = element_text(
      size = 35,
      face = "bold",
      color = COLOR_TEXTO
    ),
    axis.title = element_text(
      size = 30,
      color = COLOR_TEXTO
    ),
    axis.text = element_text(
      size = 25,
      color = COLOR_TEXTO
    ),
    plot.caption = element_text(
      color = COLOR_TEXTO,
      size = 25,
      hjust = 0),
    legend.position = "top",
    legend.text=element_markdown(size = 30),
    legend.justification='left',
    panel.grid.major = element_blank(), # Quitar la cuadrícula mayor
    panel.grid.minor = element_blank() 
  )  

# Salvamos la gráfica en un archivo
ggsave(str_glue("{images}/mencionados.png"))

Leer imágenes

directorio_imagenes <- str_glue("{root_directory}video/{anno}_jpg/")
image_read(str_glue("{directorio_imagenes}00001126.jpg"))