Tidy Tuesday - Simpsons

The Simpsons Data

Vamos a cargar los datos con el paquete tidytuesdayR:

# tuesdata <- tidytuesdayR::tt_load('2025-02-04')
# ## OR
# tuesdata <- tidytuesdayR::tt_load(2025, week = 5)
# 
# simpsons_characters <- tuesdata$simpsons_characters
# simpsons_episodes <- tuesdata$simpsons_episodes
# simpsons_locations <- tuesdata$simpsons_locations
# simpsons_script_lines <- tuesdata$simpsons_script_lines

simpsons_characters <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-02-04/simpsons_characters.csv')
simpsons_episodes <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-02-04/simpsons_episodes.csv')
simpsons_locations <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-02-04/simpsons_locations.csv')
simpsons_script_lines <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-02-04/simpsons_script_lines.csv')

Pares de personajes

Mi primer análisis consiste en averiguar qué combinaciones de personajes, generan las mejores calificaciones en IMDb, y mayor cantidad de visualizaciones.

Para eso voy a usar los datos de episodes y los de script_lines y elegir las columnas que necesito.

# Librerias
library(tidyverse)
library(extrafont)

loadfonts()

# Subset de episodios y script_lines
episodes <- simpsons_episodes %>% 
  select(id, imdb_rating, 
         year = original_air_year, 
         us_viewers = us_viewers_in_millions,
         title)

# Quedarme sólo con los scripts que tienen personajes conversando
script_lines <- simpsons_script_lines %>% 
  filter(speaking_line == TRUE) 

# Uno los datos en un dataframe nuevo
df <- left_join(script_lines, episodes, by = c("episode_id" = "id"))

# Exploremos los datos
glimpse(df)

Rows: 26,169
Columns: 17
$ id                 <dbl> 132917, 134285, 127110, 126516, 126517, 126520, 126…
$ episode_id         <dbl> 473, 478, 452, 450, 450, 450, 450, 450, 450, 450, 4…
$ number             <dbl> 128, 198, 61, 1, 2, 5, 35, 6, 7, 9, 10, 11, 12, 13,…
$ raw_text           <chr> "Fbi Supervisor: No.", "Willis: Oh my.", "Homer Sim…
$ timestamp_in_ms    <dbl> 607000, 1150000, 231000, 40000, 53000, 58000, 20400…
$ speaking_line      <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRU…
$ character_id       <dbl> 5734, 5816, 2, 2, 2, 1, 31, 1, 9, 8, 31, 33, 1, 33,…
$ location_id        <dbl> 6, 2117, 2, 3656, 3656, 3656, 354, 3656, 3656, 3656…
$ raw_character_text <chr> "Fbi Supervisor", "Willis", "Homer Simpson", "Homer…
$ raw_location_text  <chr> "KITCHEN", "COTTAGE", "Car", "Seaworld-type Park", …
$ spoken_words       <chr> "No.", "Oh my.", "Holy moly!", "Oh, I love going to…
$ normalized_text    <chr> "no", "oh my", "holy moly", "oh i love going to aqu…
$ word_count         <dbl> 1, 2, 2, 25, 7, 27, 13, 43, 4, 9, 18, 2, 2, 9, 21, …
$ imdb_rating        <dbl> 7.0, 7.2, 7.1, 6.8, 6.8, 6.8, 6.8, 6.8, 6.8, 6.8, 6…
$ year               <dbl> 2010, 2011, 2010, 2010, 2010, 2010, 2010, 2010, 201…
$ us_viewers         <dbl> 7.18, 6.35, 5.11, 8.65, 8.65, 8.65, 8.65, 8.65, 8.6…
$ title              <chr> "Donnie Fatso", "Angry Dad: The Movie", "Million Do…

Ahora vamos a crear una lista de personajes que aparecen por episodio:

personajes_por_episodio <- df %>% 
  filter(raw_character_text != "Man") %>% 
  group_by(episode_id) %>% 
  summarise(personajes = list(unique(raw_character_text)))

Este paso genera un data frame que contiene una fila por episodio, y luego una lista con los nombres de todos los personajes que tienen al menos una línea de diálogo en cada capítulo.

El siguiente paso es procesar la lista de personas para encontrar las parejas dentro de cada capítulo.

# Generar todas las combinaciones de duplas por episodio
duplas_por_episodio <- personajes_por_episodio %>%
  rowwise() %>% # Realiza el análisis por filas en vez de por columnas
  mutate(duplas = list(combn(personajes, 2,   # Crea combinaciones de 2 personajes
                             simplify = FALSE))) %>%
  unnest(duplas) %>% # Transforma la listas en dataframe
  mutate(dupla = map_chr(duplas, ~ paste(sort(.x), collapse = "-"))) %>%
  select(episode_id, dupla)

Les soy honesto. Usé deepseek para este paso, así que les paso la explicación del código porque me pareció un enfoque muy interesante:

Explicación del código

1. personajes_por_episodio

Este es el dataframe que contiene, para cada episodio (episode_id), una lista de los character_id únicos que aparecen en ese episodio. Por ejemplo:

episode_id	characters
1	[1, 2, 3]
2	[2, 4]

Aquí, characters es una columna de tipo lista, donde cada elemento es un vector de character_id.

2. rowwise()

La función rowwise() se usa para aplicar operaciones fila por fila en un dataframe. En este caso, queremos generar combinaciones de personajes para cada episodio (es decir, para cada fila).

3. mutate(duplas = list(combn(characters, 2, simplify = FALSE)))

• combn(): Esta función genera todas las combinaciones posibles de un conjunto de elementos. En este caso, queremos combinaciones de 2 personajes (2 es el segundo argumento).

• characters: Es la lista de character_id para el episodio actual.

• simplify = FALSE: Esto asegura que el resultado sea una lista de combinaciones en lugar de una matriz.

• list(): Envuelve el resultado en una lista para que sea compatible con mutate().

• mutate(duplas = ...): Crea una nueva columna llamada duplas, que contiene una lista de todas las combinaciones de 2 personajes para ese episodio.

Por ejemplo, si characters = [1, 2, 3], las combinaciones serían:

• [1, 2]

• [1, 3]

• [2, 3]

4. unnest(duplas)

La función unnest() se usa para “desanidar” una columna que contiene listas. En este caso, duplas es una columna de listas, donde cada elemento es una combinación de 2 personajes. Al usar unnest(), cada combinación se convierte en una fila separada.

Por ejemplo, si teníamos:

episode_id	duplas
1	[[1,2],[1,3],[2,3]][[1,2],[1,3],[2,3]]

Después de unnest(), tendríamos:

episode_id	duplas
1	[1, 2]
1	[1, 3]
1	[2, 3]

5. mutate(dupla = map_chr(duplas, ~ paste(sort(.x), collapse = "-")))

• map_chr(): Aplica una función a cada elemento de una lista y devuelve un vector de caracteres.

• sort(.x): Ordena los character_id en cada dupla. Esto asegura que la dupla “1-2” sea la misma que “2-1”.

• paste(..., collapse = "-"): Convierte la dupla ordenada en una cadena de texto, separando los character_id con un guion (-).

• mutate(dupla = ...): Crea una nueva columna llamada dupla, que contiene la representación en texto de cada combinación.

Por ejemplo, si duplas = [1, 2], después de este paso tendríamos dupla = "1-2".

6. select(episode_id, dupla)

Finalmente, seleccionamos solo las columnas episode_id y dupla para quedarnos con un dataframe limpio que contiene, para cada episodio, todas las duplas de personajes que aparecen juntos.

Calcular el rating promedio por duplas

Vamos a limpiar un poco más los datos, quedándonos únicamente con las duplas que aparezcan al menos 5 veces

top_duplas <- duplas_por_episodio %>% 
  count(dupla, name = "cuenta") %>% 
  filter(cuenta >= 10)

# Reducimos el dataframe
duplas_por_episodio <- duplas_por_episodio %>% 
  filter(dupla %in% top_duplas$dupla)

Ahora podemos unir los datos de duplas_por_episodio y de esa manera calculamos el rating de cada pareja de personajes.

duplas_con_rating <- duplas_por_episodio %>% 
  inner_join(episodes, by = c("episode_id" = "id")) %>% 
  group_by(dupla) %>% 
  summarise(imdb_promedio = mean(imdb_rating, na.rm = TRUE),
            episodios = n())

# Filtrar solo las duplas que aparecen en al menos 10 episodios
duplas_con_rating <- duplas_con_rating %>%
  filter(episodios >= 10) %>%
  arrange(desc(imdb_promedio))

Y ahora podemos hacer un gráfico de las 10 parejas con mejor puntaje promedio en imdb_ranking.

# Seleccionar los mejores dúos
top_10_duplas <- duplas_con_rating %>% 
  head(10)


# Gráfico
ggplot(top_10_duplas, aes(y = reorder(dupla, imdb_promedio), x = imdb_promedio)) +
  geom_point(size = 3, color = "#4f76df") +
  geom_segment(aes(x = 0, xend = imdb_promedio,
                   y = dupla, yend = dupla), color = "#4f76df") +
  geom_text(aes(label = paste0("Rating: ", round(imdb_promedio, 2), " Episodios: ", episodios)),nudge_y = 0.35,
            size = 3.5, 
            face = "bold",
            color = "#4f76df", 
            family = "Atma Medium") +
  labs(
    title = "Top 10 duplas de personajes con mejor IMDb rating promedio",
    y = "Dupla de personajes",
    x = "IMDb rating promedio"
  ) +
  theme(panel.grid = element_blank(),
                 plot.background = element_rect(fill = "#ffd90f"),
                 panel.background = element_blank(),
                 panel.grid.major.x = element_line(color = "#70d1ff"),
                 text = element_text(face = "bold", family = "Atma Medium"),
                 plot.title.position = "plot") +
  scale_x_continuous(limits = c(0,8.5))

ggsave("top_duplas.png", dpi = 300)

Y si agregamos donas en vez de puntos?

# Y si metemos una dona en vez de puntos?
library(ggimage)

# Agregamos una columna con la imagen de la dona
top_10_duplas <- top_10_duplas %>% 
  mutate(imagen = "dona.png")

# Gráfico
ggplot(top_10_duplas, aes(y = reorder(dupla, imdb_promedio), x = imdb_promedio)) +
  geom_segment(aes(x = 0, xend = imdb_promedio,
                   y = dupla, yend = dupla), color = "#4f76df") +
  geom_image(aes(image = imagen), size = 0.06) +
  geom_text(aes(label = paste0("Rating: ", round(imdb_promedio, 2), " Episodios: ", episodios)),
            nudge_y = 0.15,
            nudge_x = -2.15,
            size = 3.7,
            family = "Atma Medium",
            face = "bold",
            color = "#4f76df") +
  labs(
    title = "Top 10 duplas de personajes con mejor IMDb rating promedio",
    y = "Dupla de personajes",
    x = "IMDb rating promedio"
  ) +
  theme(panel.grid = element_blank(),
                 plot.background = element_rect(fill = "#ffd90f"),
                 panel.background = element_blank(),
                 panel.grid.major.x = element_line(color = "#70d1ff"),
                 text = element_text(face = "bold", family = "Atma Medium"),
                 plot.title.position = "plot") +
  scale_x_continuous(limits = c(0,8.5))

ggsave("top_duplas_dona.png", dpi = 300)