Itzulpena: Animar capas de anotaciones con gganimate

Tidytuesday 2020-03-03

5 de marzo de 2020

Herramientas: ggplot2, dplyr

Introducción

Usaremos el dataset de tidytuesday (2020-03-03) con datos de la NHL. La intención es mostrar la aportación goleadora de los máximos goleadores con respecto a todos los goles que se metieron en liga durante la carrera de cada uno de ellos (nos centraremos en los 10 máximos goleadores).

# Cargar librerías

library(tidyverse)
# Obtener los datos

game_goals <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-03/game_goals.csv')
game_goals
## # A tibble: 49,384 x 25
##    player season  rank date       game_num age   team  at    opp   location
##    <chr>   <dbl> <dbl> <date>        <dbl> <chr> <chr> <chr> <chr> <chr>   
##  1 Alex …   2006     1 2005-10-05        1 20-0… WSH   <NA>  CBJ   Home    
##  2 Alex …   2006     2 2005-10-07        2 20-0… WSH   <NA>  ATL   Home    
##  3 Alex …   2006     3 2005-10-08        3 20-0… WSH   @     ATL   Away    
##  4 Alex …   2006     4 2005-10-10        4 20-0… WSH   <NA>  NYR   Home    
##  5 Alex …   2006     5 2005-10-12        5 20-0… WSH   @     CAR   Away    
##  6 Alex …   2006     6 2005-10-13        6 20-0… WSH   <NA>  NYI   Home    
##  7 Alex …   2006     7 2005-10-16        7 20-0… WSH   <NA>  TBL   Home    
##  8 Alex …   2006     8 2005-10-20        8 20-0… WSH   @     FLA   Away    
##  9 Alex …   2006     9 2005-10-22        9 20-0… WSH   <NA>  CAR   Home    
## 10 Alex …   2006    10 2005-10-26       10 20-0… WSH   @     BUF   Away    
## # … with 49,374 more rows, and 15 more variables: outcome <chr>, goals <dbl>,
## #   assists <dbl>, points <dbl>, plus_minus <dbl>, penalty_min <dbl>,
## #   goals_even <dbl>, goals_powerplay <dbl>, goals_short <dbl>,
## #   goals_gamewinner <dbl>, assists_even <dbl>, assists_powerplay <dbl>,
## #   assists_short <dbl>, shots <dbl>, shot_percent <dbl>

Preparar los datos

El dataset original cuenta con muchas variables, pero nos centraremos en los goles. Para poder calcular el porcentaje que suponen todos los goles de un jugador determinado con respecto a todos los goles que se metieron en la liga mientras dicho jugador estuvo en activo, tenemos que realizar cálculos a distintos niveles de agregación: goles marcados por cada jugador y goles marcados en cada temporada. Para ello, almacenaremos los cálculos en dos tablas distintas, que combinaremos en un tercer paso.

  • Comenzamos calculando los goles marcados cada temporada por todos los jugadores
## goles marcados cada temporada
total_goals_per_season <- game_goals %>% 
  group_by(season) %>% 
  summarise(season_goals = sum(goals))

head(total_goals_per_season)
## # A tibble: 6 x 2
##   season season_goals
##    <dbl>        <dbl>
## 1   1980           99
## 2   1981          176
## 3   1982          264
## 4   1983          253
## 5   1984          331
## 6   1985          336
  • Calculamos el número de goles obtenido por cada jugador; hay que realizar el cálculo por jugador Y sesión para poder combinar las tablas más adelante.
## goles marcados por cada jugador en cada temporada
total_goals_per_player <- game_goals %>% 
  group_by(player, season) %>% 
  summarise(goals_player = sum(goals))

head(total_goals_per_player)
## # A tibble: 6 x 3
## # Groups:   player [1]
##   player        season goals_player
##   <chr>          <dbl>        <dbl>
## 1 Alex Ovechkin   2006           52
## 2 Alex Ovechkin   2007           46
## 3 Alex Ovechkin   2008           65
## 4 Alex Ovechkin   2009           56
## 5 Alex Ovechkin   2010           50
## 6 Alex Ovechkin   2011           32
  • Combinamos las dos tablas a partir de la variable season y calculamos el porcentaje de goles marcado por cada jugador en cada temporada. NOTA: en el gráfico final no vamos a utilizar esta variable.
datos <- left_join(total_goals_per_player, total_goals_per_season, by = "season") %>% 
  mutate(player_ratio_per_season = goals_player / season_goals)

head(datos)
## # A tibble: 6 x 5
## # Groups:   player [1]
##   player        season goals_player season_goals player_ratio_per_season
##   <chr>          <dbl>        <dbl>        <dbl>                   <dbl>
## 1 Alex Ovechkin   2006           52          653                  0.0796
## 2 Alex Ovechkin   2007           46          661                  0.0696
## 3 Alex Ovechkin   2008           65          705                  0.0922
## 4 Alex Ovechkin   2009           56          753                  0.0744
## 5 Alex Ovechkin   2010           50          786                  0.0636
## 6 Alex Ovechkin   2011           32          776                  0.0412
  • Finalmente, calculamos las variables que usaremos en la visualización:
    • inicio y fin: (eje X) gracias a estos valores obtendremos el inicio y el final de cada línea de carrera de los jugadores (primero tendremos que pivotar los datos).
    • goals: total de goles obtenidos por un jugador a lo largo de su carrera
    • career_goals_all: total de goles obtenidos por todos los jugadores dutante la carrera de cada jugador.
    • player_ratio_career: (eje Y) porcentaje de los goles obtenidos por cada jugador con respecto a los obtenidos por todos los jugadores durante los años que estuvo en activo.
    • estado: (color, tipo de línea) creamos una variable categórica para distinguir aquellos jugadores en activo de los que ya han dejado de jugar.
    • grosor: (grosor de línea) variable numérica basada en la anterior.
    • texto: variable que usaremos a modo de etiqueta y que concatena varias de las variables anteriores.

Tras calcular las variables, filtramos el dataset para quedarnos con los 10 jugadores que más goles han marcado durante su carrera.

Para poder usar geom_path(), tenemos que pivotar los datos para crear una variable categórica (que tendrá los valores inicio o final) y una variable que almacenará el valor.

NOTA: podríamos obtener el mismo resultado usando geom_segment(), en cuyo caso no sería necesario pivotar los datos. En el ejemplo se pivotan los datos porque es bastante habitual tener que hacerlo para crear los gráficos que nos interesen, y de esta forma

datos_carrera_top_ten <- datos %>% 
  group_by(player) %>% 
  summarise(inicio = as.integer(min(season)),
            final = as.integer(max(season)),
            goals = sum(goals_player),
            career_goals_all = sum(season_goals),
            player_ratio_career = goals / career_goals_all) %>%  
  mutate(estado = case_when(
    as.integer(final) == lubridate::year(Sys.Date()) ~ "En activo",
    TRUE ~ "Retirado"),
    grosor = case_when(
      estado == "Retirado" ~ 1,
      estado == "En activo" ~ 2,
      TRUE ~ 0),
    texto = paste0(player," (",goals,"/",career_goals_all,")")
  ) %>% 
  top_n(10, goals) %>% 
  pivot_longer(inicio:final, names_to = "etapa")

head(datos_carrera_top_ten)
## # A tibble: 6 x 9
##   player goals career_goals_all player_ratio_ca~ estado grosor texto etapa value
##   <chr>  <dbl>            <dbl>            <dbl> <chr>   <dbl> <chr> <chr> <int>
## 1 Alex ~   701            10668           0.0657 En ac~      2 Alex~ inic~  2006
## 2 Alex ~   701            10668           0.0657 En ac~      2 Alex~ final  2020
## 3 Brett~   741             8621           0.0860 Retir~      1 Bret~ inic~  1987
## 4 Brett~   741             8621           0.0860 Retir~      1 Bret~ final  2006
## 5 Jarom~   766            13222           0.0579 Retir~      1 Jaro~ inic~  1991
## 6 Jarom~   766            13222           0.0579 Retir~      1 Jaro~ final  2018

Visualización

El gráfico que vamos a crear va a ser un timeline en el que cada línea mostrará los años en activo de los jugadores. En el eje X se mostrarán los años, mientras que en el eje Y se colocarán las líneas a partir del porcentaje de los goles marcados por cada jugador con respecto a todos los que se metieron en la liga durante su carrera.

Dado que se tratan de datos históricos, podemos encontrarnos con jugadores que ya se han retirado (y para los que los datos no van a variar en próximas temporadas) y con jugadores que aún están en activo (por lo que cabe pensar que sus datos variarán según se jueguen más partidos). Distinguiremos gráficamente estos dos tipos de jugadores. Además, añadiremos unos pequeños textos para explicar cómo interpretar los distintos elemnetos gráficos, lo que nos permitirá eliminar las leyendas de estos canales (color, tipo y grosor de línea).

Por otra parte, algunas de las etiquetas con los datos de los jugadores, que se sitúan en el eje Y a la misma altura que las líneas, se solapan entre sí, por lo que las añadiremos en tres capas distintas, para poder controlar mejor su posicionamiento. Para ello, creamos dos subgrupos de jugadores, uno para subir las etiquetas y otro para bajarlas (los jugadores de cada grupo no se han elegido al azar, sino que se han seleccionado tras un par de iteraciones del gráfico en lo que estas etiquetas se solapan).

bajar <- c("Brett Hull", "Mark Messier", "Jaromir Jagr")
subir <- c("Mario Lemieux", "Steve Yzerman", "Teemu Selanne")
ggplot(datos_carrera_top_ten, aes(value, player_ratio_career, group=player, color=estado)) +
  # dibujamos las líneas
  geom_line(aes(size = fct_rev(as.factor(estado)), 
                linetype=fct_rev(as_factor(estado)))) +
  # dibujamos los corchetes
  geom_point(data = filter(datos_carrera_top_ten, value < lubridate::year(Sys.Date()) & etapa != "medio"),
             aes(y = player_ratio_career + 0.0002, shape=etapa), size = 4) +
  # Mostramos los nombres de los jugadores, con desplazamientos ad hoc para que no se solapen
  geom_text(data = filter(datos_carrera_top_ten, etapa == "inicio" & !player %in% c(subir, bajar)),
            aes(label = texto),
            x = max(datos_carrera_top_ten$value) + 1, hjust = "left") +
  geom_text(data = filter(datos_carrera_top_ten, etapa == "inicio" & player %in% bajar),
            aes(y = player_ratio_career - 0.0015, label = texto), 
            x = max(datos_carrera_top_ten$value) + 1, hjust = "left") +
  geom_text(data = filter(datos_carrera_top_ten, etapa == "inicio" & player %in% subir),
            aes(y = player_ratio_career + 0.0015, label = texto), 
            x = max(datos_carrera_top_ten$value) + 1, hjust = "left") +
  # Añadimos una línea y una tiqueta para marcar la última temporada del dataset
  geom_vline(xintercept = max(datos_carrera_top_ten$value), 
             linetype = "F4", color = "#7c4d25") +
  geom_label(x = max(datos_carrera_top_ten$value), 
             y = max(datos_carrera_top_ten$player_ratio_career) - 0.01, 
             hjust = "middle", label ="Última temporada", color ="#7c4d25") +
  labs(
    title = "¿Cuál es la aportación de los máximos goleadores?",
    subtitle = "Estamos acostumbrados a ver la lista de los máximos goleadores, pero hace años un número parecido de goles\nen la carrera de un jugadorsuponía un mayor porcentaje de todos los goles de la liga.\n",
    caption = "\n@neregauzak | #tidytuesday | Data: hockey-reference.com"
  ) +
  # Añadimos anotaciones personalizadas para saber cómo interpretar las líneas
  ## Anotación para un jugador cuya carrera ha terminado
  annotate(geom = "text", x = 2000, y = 0.105, size = 3, color = "#3e3d40", 
           label ="Gretzky jugó entre 1979 y 1999\n y metió 894 goles", 
           lineheight = 0.9) +
  annotate(geom ="curve", x = 1992, y = 0.1075, xend = 1990, yend = 0.1145, 
           curvature = -0.25, color = "#3e3d40") +
  ## Anotación para el jugador que aún está en activo
  annotate(geom = "text", x = 2015, y = 0.08, size = 3, color = "#4f970c", 
           label ="Ovechkin es el único\njugador en activo\nde la lista de los\n10 máximos goleadores", 
           lineheight = 0.9) +
  annotate(geom ="curve", x = 2010, y = 0.08, xend = 2007, yend = 0.0657, 
           curvature = 0.25, color = "#4f970c") +
  # Modificamos la escala de color para usar colores personalizados
  scale_color_manual(values = c("#4f970c","#707173")) +
  # Modificamos la escala de formas para usar corchetes de apertura y cierre con geom_point
  scale_shape_manual(values = c(93,91)) +
  # Modificamos la escala de tamño para dar más anchura a las líneas de jugadores en activo
  scale_size_discrete(range = c(0.2,1.5), breaks = c(1,2)) +
  # Modificamos la escala de tamño para dar un estilo de linea discontinua a las líneas de jugadores en activo
  scale_linetype_manual(values=c("solid","longdash")) +
  # Modificamos los límites de X para poder acomodar los nombres de los jugadores
  scale_x_continuous("", limits = c(min(datos_carrera_top_ten$value)-1, max(datos_carrera_top_ten$value)+15),
                     breaks = seq(from = min(datos_carrera_top_ten$value), to = max(datos_carrera_top_ten$value), by = 5)
                    ) +
  scale_y_continuous("", labels = scales::percent_format()) +
  # Eliminamos las leyendas
  guides(color = "none", size = "none", linetype = "none", shape ="none") +
  #○ Seleccionamos el tema minimal y realizamos un par de modificaciones
  theme_minimal() +
  theme(panel.border = element_blank(), panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))
## Warning: Using size for a discrete variable is not advised.


Más posts