Itzulpena: Animar capas de anotaciones con gganimate
Tidytuesday 2020-03-03
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))## `summarise()` has grouped output by 'player'. You can override using the `.groups` argument.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
seasony 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:
inicioyfin: (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 carreracareer_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 2018Visualizació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.