Tidytuesday 2020-04-14

20 de abril de 2020

ggplot2 • tidyr • dplyr • gganimate • patchwork

Herramientas: ggplot2, tidyr, dplyr, gganimate, patchwork

Introducción

Mi objetivo principal para para este ejercicio de #tidytuesday de 2020-04-14 ha sido trastear con la interacción entre los paquetes gganimate y patchwork con el fin de crear una composición con varios gráficos animados y sincronizados.

La composición está formada por tres gráficos:

Barras apiladas de puntos por tipo de voto para canciones con más de un voto
Facetas de barras con total de votos por tipo de voto para canciones con más de un voto
Lista de canciones con más de un voto. Está creada con ggplot para poder estilizar y coordinar todos los elementos de la composición.

Para facilitar la sincronización de los gráficos animados, la variable base de la animación es la misma en ambos casos.

En el post con los pasos necesarios para crear una animación de un gráfico de barras animadas con gganimate explicaba las tareas de ETL necesarias para poder crear el gráfico y la animación.

library(tidyverse)
library(patchwork)
library(gganimate)
library(magick)
library(svMisc)

rankings <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-14/rankings.csv')

## Parsed with column specification:
## cols(
##   ID = col_double(),
##   title = col_character(),
##   artist = col_character(),
##   year = col_double(),
##   gender = col_character(),
##   points = col_double(),
##   n = col_double(),
##   n1 = col_double(),
##   n2 = col_double(),
##   n3 = col_double(),
##   n4 = col_double(),
##   n5 = col_double()
## )

canciones_x_tipovoto <- rankings %>%
 filter(n > 1) %>% # primero filtramos las canciones
 mutate(new_ID = dense_rank(ID)) %>% # y calculamos el nuevo ranking
 pivot_longer(n1:n5, names_to = "puesto", values_to = "votos") %>%
 group_by(title) %>%
 mutate(
   puntos = case_when(
     puesto == "n1" ~  votos * 10,
     puesto == "n2" ~  votos * 8,
     puesto == "n3" ~  votos * 6,
     puesto == "n4" ~  votos * 4,
     puesto == "n5" ~  votos * 2,
     TRUE ~ 0
   ),
   acumulados = cumsum(puntos)
 )

Para poder combinar los tres gráficos en un gif animado final, el gráfico con los títulos de las canciones también está animado… ¡aunque no lo parezca!

Gráficos de base

Los dos gráficos de barras son bastante similares.

El gráfico con los nombres de las canciones es una especie de “trampantojo”, ya que en lugar de mostrar los textos del eje, se muestran como geom_text().

## Gráfico de barras apiladas

(barras_puntos <- ggplot(
  canciones_x_tipovoto,
  aes(
    x = puntos,
    y = new_ID,
    group = fct_relevel(rev(puesto)),
    fill = puesto,
    xmin = acumulados - puntos,
    xmax = acumulados,
    ymin = new_ID - 0.45,
    ymax = new_ID + 0.45
  )
) +
  geom_rect() +
  scale_y_continuous(trans = "reverse", expand = c(0,0)) +
  scale_x_continuous("Puntos por tipo de voto", trans = "reverse", expand = c(0, 1), position = "top") +
  theme_minimal() +
  theme(
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    panel.grid.major.y = element_blank(),
    panel.grid.minor.y = element_blank(),
    axis.ticks.y = element_blank(),
    legend.position = "none"
  )
)

## Gráfico facetado de barras

(barras_facetas <- ggplot(canciones_x_tipovoto,
                   aes(votos, fct_reorder(title, desc(ID)),)) +
  geom_col() +
  geom_col(aes(fill = puesto)) +
  facet_wrap(~ puesto, nrow = 1) +
  theme_minimal() +
  theme(legend.position = "none") +
  scale_y_discrete(expand = c(0,0)) +
  scale_x_discrete("Número de votos por tipo", position ="top", expand = c(0,0))
)

## Gráfico con los títulos de las canciones (y otros datos)

(lista_nombres <- ggplot(filter(rankings, n > 1),
                          aes(1, fct_reorder(title, desc(ID)))) +
    geom_text(aes(
      label = paste(points, fct_reorder(title, desc(ID)), n , sep = " | ")),
      color = "#dcbf35", 
      size = 3
    ) +
    scale_x_continuous("Puntos | Canción | Votos", position = "top", limits = c(0.99, 1.01)) +
    theme_minimal() +
    theme(legend.position = "none")
)

Composición estática con `Patchwork`

Patchwork es un paquete que está doseñado para crear composiciones con gráficos de ggplot (e incluso permite integrar objetos que nos sean gráficos, como textos largos, imágenes, o gráficos no creados con ggplot).

Contiene una serie de funciones que ayudan a “coordinar” los distintos gráficos: alinear los ejes de distintos gráficos, etc.

Sin embargo, tiene algunas limitaciones. Por ejemplo, no “hereda” todas las personalizaciones realizadas con la función theme() de ggplot. A modo de ejemplo, tomamos los gráfcos creados en el paso anterior y los modificamos estéticamente: colores, rejillas, alineaciones de texto…

## Gráficos ----------------------------------

(grafico_anim <- barras_puntos +
  theme_minimal() +
    theme(
      legend.position = "none",
      plot.background = element_rect(fill = "#3e3d40", color = "#3e3d40"),
      axis.title.x.top = element_text(color = "#dcbf35", hjust = 1),
      panel.grid.major.y = element_blank(),
      panel.grid.minor.y = element_blank(),
      panel.grid.major.x = element_line(color = "#dcbf35"),
      panel.grid.minor.x = element_blank(),
      axis.text.y = element_blank(),
      axis.title.y = element_blank(),
      axis.title.x = element_text(hjust = 1),
      axis.text.x = element_text(color = "#dcbf35")
    ) +
  scale_fill_manual(values = c("#4f970c","#74b03c","#98ca62","#bbe488","#ddffae"))
)

(barras_facetas_anim <- barras_facetas + 
   theme_minimal() +
    theme(
      legend.position = "none",
      plot.background = element_rect(fill = "#3e3d40", color = "#3e3d40"),
      strip.text.x = element_text(hjust = 0, color = "#dcbf35"),
      axis.title.x.top = element_text(color = "#dcbf35", hjust = 0),
      panel.grid.major.y = element_blank(),
      panel.grid.minor.y = element_blank(),
      panel.grid.major.x = element_line(color = "#dcbf35"),
      panel.grid.minor.x = element_blank(),
      axis.text.y = element_blank(),
      axis.title.y = element_blank(),
      axis.title.x = element_text(hjust = 1),
      axis.text.x = element_text(color = "#dcbf35")
    ) +
  scale_fill_manual(values =  c("#4f970c","#74b03c","#98ca62","#bbe488","#ddffae"))
)

(lista_nombres_anim <- lista_nombres + 
   theme_minimal() +
    theme(
      legend.position = "none",
      plot.background = element_rect(fill = "#3e3d40", color = "#3e3d40"),
      axis.title.x.top = element_text(color = "#dcbf35", hjust = 0.5),
      panel.grid = element_blank(),
      axis.text.y = element_blank(),
      axis.title.y = element_blank(),
      axis.title.x = element_text(hjust = 0.5),
      axis.text.x = element_blank()
    ) +
  scale_fill_manual(values =  c("#4f970c","#74b03c","#98ca62","#bbe488","#ddffae"))
)

Una vez que los gráficos tienen el aspecto que nos interesa, podemos recoger las dimensiones y aplicarlas a todos por igual, para que todos los ejes y elementos estén correctamente alineados (nos podemos fijar en el espacio entre el título del eje y el gráfico, algo mayor que en el paso anterior).

## Normalización ----------------------------------

max_dims <- get_max_dim(barras_facetas_anim, grafico_anim, lista_nombres_anim)
set_dim(barras_facetas_anim, max_dims)

set_dim(grafico_anim, max_dims)

set_dim(lista_nombres_anim, max_dims)

Para controlar mejor la composición, “diseñamos” la retícula. En este ejemplo, son cinco módulos (1 fila, 5 columnas). El primer gráfico ocupará dos módulos, el segundo uno y el tercero los dos restantes.

## Poster estático ------------------------------

layout <- c(area(1,1,1,2),area(1,3,1,3),area(1,4,1,5))

Y creamos la composición.

(
  maqueta <- grafico_anim + lista_nombres_anim + barras_facetas_anim +
    plot_layout(design = layout) &
    plot_annotation(
      title = 'Las canciones de hip-hop mejor valoradas',
      subtitle = 'El gráfico recoge las canciones que han recibido más de un voto',
      caption = '@neregauzak | #tidytuesday | Data: BBC Music'
    ) &
    theme_minimal() &
    theme(
      legend.position = "none",
      plot.background = element_rect(fill = "#3e3d40", color = "#3e3d40"),
      plot.title = element_text(colour = "#dcbf35", hjust = 0.015, size = 20),
      plot.subtitle = element_text(colour = "#dcbf35", hjust = 0.015, size = 16),
      plot.caption = element_text(colour = "#dcbf35", hjust = 0.985)
    ) 
    
)

Como resulta evidente, al aplicar la función theme() a la maqueta, no se han heredado las modificaciones de cada uno de los gráficos.

Podemos volver a aplicarlos, pero en este caso se aplicarán a los tres gráficos por igual, por lo que perderemos algunas de las opciones de diseño que hemos usado (la alineación del título de los ejes, por ejemplo).

(
  maqueta <- grafico_anim + lista_nombres_anim + barras_facetas_anim +
    plot_layout(design = layout) +
    plot_annotation(
      title = 'Las canciones de hip-hop mejor valoradas',
      subtitle = 'El gráfico recoge las canciones que han recibido más de un voto',
      caption = '@neregauzak | #tidytuesday | Data: BBC Music'
    ) &
    theme_minimal() +
    theme(
      legend.position = "none",
      plot.background = element_rect(fill = "#3e3d40", color = "#3e3d40"),
      plot.title = element_text(colour = "#dcbf35", hjust = 0.015, size = 20),
      plot.subtitle = element_text(colour = "#dcbf35", hjust = 0.015, size = 16),
      plot.caption = element_text(colour = "#dcbf35", hjust = 0.985),
      strip.text.x = element_text(hjust = 0, color = "#dcbf35"),
      axis.title.y = element_blank(),
      axis.text.y = element_blank(),
      axis.text.x = element_blank(),
      panel.grid = element_blank(),
      axis.title = element_text(color = "#dcbf35")
    ) 
    
)

Animación con `gganimate`

Una vez que ya tenemos la composición a nuestro gusto, pasamos a animar los gráficos de barras. Como ya se ha mencionado, aplicamos la misma animación a los dos gráficos de barras, salvo la dirección de enter_drift(), para que en un caso las barras entren de izquierda a derecha, y en el otro de derecha a izquierda.

Para los títulos de las canciones usaremos transition_null().

Keep all data constant across the animation

En principio, una animación en la que todo es constante no parece especialmente útil; pero como queremos coordinar los tres gráficos, que van a tener una serie de fotogramas (por defecto 100), nos interesa tener un gráfico animado con gganimate, aunque nada se mueva.

## Animaciones ----------------------------------

anim_grafico <- grafico_anim +
  transition_states(puesto,
                    state_length = 1,
                    transition_length = 1) +
  enter_fade() +
  enter_drift(x_mod = 1) +
  shadow_mark(past = TRUE)

(a_gif <- animate(anim_grafico, width = 500, height = 1750))
anim_save("a.gif", a_gif)

anim_barras_facetas <- barras_facetas_anim +
  transition_states(puesto,
                    state_length = 1,
                    transition_length = 1) +
  enter_fade() +
  enter_drift(x_mod = -1) +
  shadow_mark(past = TRUE)

b_gif <- animate(anim_barras_facetas, width = 500, height = 1750)
anim_save("b.gif", b_gif)

anim_lista_nombres <- lista_nombres_anim +
  transition_null()

c_gif <- animate(anim_lista_nombres, width = 300, height = 1750)
anim_save("c.gif", c_gif)

Composición final con `imagemagick`

A día de hoy los paquetes patchwork y gganimate no “se hablan” entre sí, pero en el wiki ofrecen una posible solución usando el paquete magick (basado en imagemagick): “Placing Animations side-by-side with magick”.

En las primeras pruebas este sistema me funcionó sin problemas, pero en los últimos intentos tardaba muchísimo tiemepo e incluso en alguna ocasión ha llegado a bloquear la sesión de R, por lo que finalmente la solución ha pasado por realizar una técnica similar directamente con Imagemagick.

## Inicialmente funcionaba

a_mgif <- image_read(a_gif)
b_mgif <- image_read(b_gif)
c_mgif <- image_read(c_gif)

new_gif <- image_append(c(a_mgif[1], c_mgif[1], b_mgif[1]))

for(i in 2:100){
  combined <- image_append(c(a_mgif[i], c_mgif[i], b_mgif[i]))
  new_gif <- c(new_gif, combined)
  progress(i, progress.bar = TRUE)
  Sys.sleep(0.01)
  if(1==100) cat ("Listo!\n")
}

new_gif

Solución con Imagemagick (en Windows):

Los comandos para ir pegando los gifs los he adapatado a partir de la información encontrada en esta página de Stack Overflow: “append two gifs side-by-side with ImageMagick on Windows”

Primero, añadimos los GIFs de izquierda a derecha, de dos en dos:

# Combinar barras apiladas y títulos

convert ( a.gif -coalesce -set page %[fx:w*1.6]x%[h]+0+0 -coalesce ^) ^
   null: ( c.gif -coalesce ) -gravity east -layers composite ^
   -set delay 20 -loop 0 ac.gif

# Combinar barras apiladas + títulos y barras facetadas

convert ( ac.gif -coalesce -set page %[fx:w*1.625]x%[h]+0+0 -coalesce ) ^
      null: ( b.gif -coalesce ) -gravity east -layers composite ^
      -set delay 20 -loop 0 acb.gif

convert -crop 1500x100+0+0 prueba.png titulos.png

convert -crop 1500x37+0+1520 prueba.png caption.png

Solo nos quedaría añadir en la parte superior el título y el subtítulo, y en la inferior la nota al pie. He creado las imágenes a partir de la exportación de la composición con patchwork; sin embargo, al replicar los pasos para “concatenar” dos gifs animados no ocurría nada (el comando de imagemagick no acababa nunca), así que la solución final ha sido crear titulos.gif y caption.gif con Gimp; y con esos archivos, sí que me ha vuelto a funcionar imagemagick:

## Añadir título y subtítulo

convert ( acb.gif -coalesce -set page %[w]x%[fx:h*1.05]+0+90 -coalesce ) ^
   null: ( titulos.gif -coalesce ) -gravity north -layers composite ^
   -set delay 0 -loop 0 acb_tit.gif

## Añadir pie

convert ( acb_tit.gif -coalesce -set page %[w]x%[fx:h*1.0185]+0+0 -coalesce ) ^
  null: ( caption.gif -coalesce ) -gravity south -layers composite ^
  -set delay 0 -loop 0 acb_tit_cap.gif

Tidytuesday 2020-04-14

Introducción

Gráficos de base

Composición estática con `Patchwork`

Animación con `gganimate`

Composición final con `imagemagick`

Recursos consultados

Más posts

Introducción

Gráficos de base

Composición estática con Patchwork

Animación con gganimate

Composición final con imagemagick

Recursos consultados

Más posts

Composición estática con `Patchwork`

Animación con `gganimate`

Composición final con `imagemagick`