Sports_data_animation.R

## Written by Victor Yu (@VictorYuEpi)

## From https://pastebin.com/44c6GsDM
## playing around with some sports data - tracking the rank of athletes who completed the decathlon at the 2016 Rio Olympics #r #ggplot2 #gganimate #dataviz #Datavisualization


## install/load required packages ####

library(tidyverse)
library(RColorBrewer)

# install.packages('devtools')
# devtools::install_github('thomasp85/gganimate')
library(gganimate)

# devtools::install_github('rensa/ggflags')
library(ggflags)

## df ####

rio_df <- structure(list(Year = c("2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016", "2016", "2016", "2016", "2016", "2016", "2016", "2016", 
"2016"), Athlete = structure(c(75L, 119L, 95L, 109L, 71L, 65L, 
148L, 93L, 110L, 94L, 149L, 111L, 113L, 126L, 53L, 150L, 117L, 
52L, 125L, 96L, 116L, 115L, 124L, 75L, 119L, 95L, 109L, 71L, 
65L, 148L, 93L, 110L, 94L, 149L, 111L, 113L, 126L, 53L, 150L, 
117L, 52L, 125L, 96L, 116L, 115L, 124L, 75L, 119L, 95L, 109L, 
71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 113L, 126L, 53L, 
150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 75L, 119L, 95L, 
109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 113L, 126L, 
53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 75L, 119L, 
95L, 109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 113L, 
126L, 53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 75L, 
119L, 95L, 109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 
113L, 126L, 53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 
75L, 119L, 95L, 109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 
113L, 126L, 53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 
75L, 119L, 95L, 109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 
113L, 126L, 53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 
75L, 119L, 95L, 109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 
113L, 126L, 53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L, 
75L, 119L, 95L, 109L, 71L, 65L, 148L, 93L, 110L, 94L, 149L, 111L, 
113L, 126L, 53L, 150L, 117L, 52L, 125L, 96L, 116L, 115L, 124L
), .Label = c("Eduard Hämäläinen", "Fedor Laukhin", "Volodymyr Mykhailenko", 
"Kip Janvrin", "Wilfrid Boulineau", "Laurent Hernu", "Klaus Ambrosch", 
"Indrek Kaseorg", "Oleksandr Yurkov", "Raúl Duany", "Jirí Ryba", 
"Lev Lobodin", "Mário Aníbal", "Zsolt Kürtösi", "Henrik Dagård", 
"Stefan Schmid", "Attila Zsivoczky", "Frank Busemann", "Tomáš Dvorák", 
"Tom Pappas", "Dean Macey", "Chris Huffins", "Roman Šebrle", 
"Erki Nool", "Tomáš Dvorák", "Dean Macay", "Jirí Ryba", "Roman Šebrle", 
"Michael Nolan", "Benjamin Jensen", "Phil McMullen", "Chiel Warners", 
"Dmitriy Karpov", "Qi Haifeng", "André Niklaus", "Claston Bernard", 
"Vitaliy Smirnov", "Bryan Clay", "Aleksandr Pogorelov", "Kristjan Rahnu", 
"Romain Barras", "Jaakko Ojaniemi", "Aleksey Drozdov", "Hamdi Dhouibi", 
"Mikk Pahapill", "Paul Terek", "Frédéric Xhonneux", "Roland Schwarzl", 
"Óscar González", "Maurice Smith", "Aleksey Sysoyev", "Yordanis García", 
"Arthur Abele", "Hans van Alphen", "Robert Jacob Arnold", "Aliaksandr Parkhomenka", 
"François Gourmet", "Andres Raja", "Agustín Félix", "Alberto Juantorena", 
"Hiromasa Tanaka", "Josef Karas", "Kim Kun-woo", "Trey Hardee", 
"Leonel Suárez", "Oleksiy Kasyanov", "Pascal Behrenbruch", "Nicklas Wiberg", 
"Yunior Díaz", "Andrei Krauchanka", "Larbi Bourrada", "Willem Coertzen", 
"Norman Müller", "Vasiliy Kharlamov", "Ashton Eaton", "Eugène Martineau", 
"Ingmar Vos", "Nadir El Fassi", "Brent Newdick", "Jake Arnold", 
"Daniel Almgren", "Daisuke Ikeda", "Moritz Cleve", "Yevhen Nikitin", 
"Mateo Sossah", "Simon Walter", "Attila Szabó", "Mikk-Mihkel Arro", 
"Atis Vaisjuns", "Eelco Sintnicolaas", "Mihail Dudaš", "Jan Felix Knobel", 
"Thomas van der Plaetsen", "Luiz Alberto de Araújo", "Damian Warner", 
"Keisuke Ushiro", "Michael Schrader", "Kevin Mayer", "Carlos Chinin", 
"Rico Freimuth", "Ilya Shkurenyov", "Gunnar Nixon", "Artem Lukyanenko", 
"Eduard Mikhan", "Maicel Uibo", "Sergey Sviridov", "Pelle Rietveld", 
"Marcus Nilsson", "Kai Kazmirek", "Kurt Felix", "Adam Helcelet", 
"Pieter Braun", "Bastien Auzeil", "Zachery Ziemek", "Akihiko Nakamura", 
"Pawel Wiesiolek", "Pau Tonnesen", "Janek Õiglane", "Kévin Mayer", 
"Jorge Ureña", "Devon Williams", "Ashley Bryant", "Martin Roe", 
"Karl Robert Saluri", "Dominik Distelberger", "Cedric Dubler", 
"Florian Schönbeck", "Nikolay Averyanov", "Stefan Drews", "David Gómez", 
"Indrek Turi", "Santiago Lorenzo", "Janis Karlivans", "Prodromos Korkizoglou", 
"Hans Olav Uldal", "Paolo Casarsa", "Mikalai Shubianok", "Massimo Bertocchi", 
"Jangy Addy", "Daniel Awde", "Hadi Sepehrzad", "Damjan Sitar", 
"Slaven Dizdarevic", "Gonzalo Barroilhet", "Edgars Erinš", "Darius Draudvila", 
"Rifat Artikov", "Zach Ziemek", "Jeremy Taiwo", "Lindon Victor"
), class = "factor"), cc_iso2c = c("us", "fr", "ca", "de", "dz", 
"cu", "us", "be", "gd", "br", "us", "cz", "fr", "au", "de", "gd", 
"es", "cu", "at", "jp", "pl", "jp", "ee", "us", "fr", "ca", "de", 
"dz", "cu", "us", "be", "gd", "br", "us", "cz", "fr", "au", "de", 
"gd", "es", "cu", "at", "jp", "pl", "jp", "ee", "us", "fr", "ca", 
"de", "dz", "cu", "us", "be", "gd", "br", "us", "cz", "fr", "au", 
"de", "gd", "es", "cu", "at", "jp", "pl", "jp", "ee", "us", "fr", 
"ca", "de", "dz", "cu", "us", "be", "gd", "br", "us", "cz", "fr", 
"au", "de", "gd", "es", "cu", "at", "jp", "pl", "jp", "ee", "us", 
"fr", "ca", "de", "dz", "cu", "us", "be", "gd", "br", "us", "cz", 
"fr", "au", "de", "gd", "es", "cu", "at", "jp", "pl", "jp", "ee", 
"us", "fr", "ca", "de", "dz", "cu", "us", "be", "gd", "br", "us", 
"cz", "fr", "au", "de", "gd", "es", "cu", "at", "jp", "pl", "jp", 
"ee", "us", "fr", "ca", "de", "dz", "cu", "us", "be", "gd", "br", 
"us", "cz", "fr", "au", "de", "gd", "es", "cu", "at", "jp", "pl", 
"jp", "ee", "us", "fr", "ca", "de", "dz", "cu", "us", "be", "gd", 
"br", "us", "cz", "fr", "au", "de", "gd", "es", "cu", "at", "jp", 
"pl", "jp", "ee", "us", "fr", "ca", "de", "dz", "cu", "us", "be", 
"gd", "br", "us", "cz", "fr", "au", "de", "gd", "es", "cu", "at", 
"jp", "pl", "jp", "ee", "us", "fr", "ca", "de", "dz", "cu", "us", 
"be", "gd", "br", "us", "cz", "fr", "au", "de", "gd", "es", "cu", 
"at", "jp", "pl", "jp", "ee"), finalscore = c(8893, 8834, 8666, 
8580, 8521, 8460, 8392, 8332, 8323, 8315, 8300, 8291, 8064, 8024, 
8013, 7998, 7982, 7961, 7954, 7952, 7784, 7612, 7223, 8893, 8834, 
8666, 8580, 8521, 8460, 8392, 8332, 8323, 8315, 8300, 8291, 8064, 
8024, 8013, 7998, 7982, 7961, 7954, 7952, 7784, 7612, 7223, 8893, 
8834, 8666, 8580, 8521, 8460, 8392, 8332, 8323, 8315, 8300, 8291, 
8064, 8024, 8013, 7998, 7982, 7961, 7954, 7952, 7784, 7612, 7223, 
8893, 8834, 8666, 8580, 8521, 8460, 8392, 8332, 8323, 8315, 8300, 
8291, 8064, 8024, 8013, 7998, 7982, 7961, 7954, 7952, 7784, 7612, 
7223, 8893, 8834, 8666, 8580, 8521, 8460, 8392, 8332, 8323, 8315, 
8300, 8291, 8064, 8024, 8013, 7998, 7982, 7961, 7954, 7952, 7784, 
7612, 7223, 8893, 8834, 8666, 8580, 8521, 8460, 8392, 8332, 8323, 
8315, 8300, 8291, 8064, 8024, 8013, 7998, 7982, 7961, 7954, 7952, 
7784, 7612, 7223, 8893, 8834, 8666, 8580, 8521, 8460, 8392, 8332, 
8323, 8315, 8300, 8291, 8064, 8024, 8013, 7998, 7982, 7961, 7954, 
7952, 7784, 7612, 7223, 8893, 8834, 8666, 8580, 8521, 8460, 8392, 
8332, 8323, 8315, 8300, 8291, 8064, 8024, 8013, 7998, 7982, 7961, 
7954, 7952, 7784, 7612, 7223, 8893, 8834, 8666, 8580, 8521, 8460, 
8392, 8332, 8323, 8315, 8300, 8291, 8064, 8024, 8013, 7998, 7982, 
7961, 7954, 7952, 7784, 7612, 7223, 8893, 8834, 8666, 8580, 8521, 
8460, 8392, 8332, 8323, 8315, 8300, 8291, 8064, 8024, 8013, 7998, 
7982, 7961, 7954, 7952, 7784, 7612, 7223), event = c(1, 1, 1, 
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 
2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 
3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 
4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 
5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 
6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 
10, 10, 10), rank = c(2, 7, 1, 6, 4, 20, 3, 21, 15, 5, 16, 18, 
19, 12, 13, 10, 23, 7, 11, 22, 14, 17, 9, 1, 4, 2, 3, 6, 20, 
5, 11, 9, 7, 12, 13, 21, 8, 16, 14, 18, 19, 10, 23, 22, 16, 15, 
1, 3, 2, 5, 6, 18, 9, 16, 7, 4, 8, 10, 14, 19, 12, 11, 20, 15, 
13, 22, 21, 23, 16, 1, 4, 2, 5, 6, 14, 7, 9, 8, 11, 3, 10, 17, 
12, 14, 13, 18, 16, 20, 21, 19, 23, 22, 1, 4, 3, 2, 6, 13, 9, 
10, 7, 8, 5, 12, 17, 11, 14, 16, 20, 15, 18, 22, 19, 21, 23, 
1, 3, 2, 4, 5, 13, 10, 14, 8, 7, 6, 11, 17, 9, 12, 18, 19, 15, 
16, 22, 19, 21, 23, 1, 3, 2, 4, 5, 10, 6, 14, 9, 7, 8, 11, 17, 
15, 12, 13, 19, 16, 20, 21, 18, 22, 23, 1, 2, 3, 4, 9, 10, 5, 
8, 12, 7, 6, 11, 14, 13, 15, 17, 16, 18, 20, 19, 21, 22, 23, 
1, 2, 3, 4, 7, 6, 5, 8, 9, 10, 12, 11, 14, 19, 13, 15, 16, 17, 
20, 18, 21, 22, 23, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 
14, 15, 16, 17, 18, 19, 20, 21, 22, 23)), .Names = c("Year", 
"Athlete", "cc_iso2c", "finalscore", "event", "rank"), row.names = c(NA, 
-230L), class = c("tbl_df", "tbl", "data.frame"))

## some transformation ####


rio_df <- bind_rows(rio_df %>% filter(event == 1) %>% mutate(event = 0, rank = median(seq(nrow(.)
                                                                                              )
                                                                                          )
                                                                   ), 
                       rio_df
                       ) ## create dummy rows for the athletes to begin at "Start" event (event = 0), before they gain points in the first event (100m). Also, sets the median of the total number of athletes/ranks for the animation to "Start" at. For example, if you make rank = 1, the animation will burst from Rank 1. However I'm doing this for a lot of subsets so I made it an automated process.


## Below is credit of Jon Spring, who answers a lot of gganimate questions on stack. This method takes inspiration from his answer here: https://stackoverflow.com/questions/53092216/any-way-to-pause-at-specific-frames-time-points-with-transition-reveal-in-gganim

rio_df <- rio_df %>% 
  mutate(show_time = case_when(event %in% c(10) ~ 5,
                               event %in% c(1:9) ~ 3,
                               TRUE           ~ 1)) %>% ## the rhs number is the 'ratio' or quantity of frames to create. I say ratio as the number of frames is technically determined by the fps/nframes arguments in animate()
  uncount(show_time) %>% # uncount is a tidyr function which copies each line 'n' times
  group_by(Athlete) %>%
  mutate(reveal_time = row_number()) %>%
  ungroup()

## create reference vectors for convenience

n_athletes <- rio_df %>% select(Athlete) %>% unique %>% nrow() ## num. of athletes
events_vector_ordered_v2 <- c("Start", "100m", "Long Jump", "Shotput", "High Jump", "400m", 
"110m Hurdles", "Discus Throw", "Pole Vault", "Javelin Throw", "1500m")

## the plot ####

my_anim <- rio_df %>% ggplot(aes(event, rank, group=Athlete)) + 
  geom_line(size = 1.75, colour = "black", alpha = 0.5) + ## this helps emphasize the colour of the lines. It puts a default black line with some transparency behind each coloured line you saw for the athletes.
  geom_line(aes(colour=fct_reorder(Athlete, finalscore)), size = 1.5) + ## reorder the factor so the palette matches the line colours where purple = top scorers and red = bottom scorers after finishing the decathlon. 
  geom_flag(aes(event + 0.175, country = cc_iso2c), size = 5) + ## some trial and error with getting the flags and the text of the athletes in alignment together. The number after 'event' in geom_flag and geom_text below shifts the geom in the x-direction and I found this easier to control over using hjust arguments
  geom_text(aes(event + 0.3, label = Athlete), size = 5, family = "Segoe UI", hjust = 0) +
  scale_y_reverse(name = "Rank",
                  breaks = seq(1, n_athletes, 1),
                  sec.axis = dup_axis(name = element_blank())
                  ) + 
  scale_x_continuous(name = "Event",
                     breaks = 0:10,
                     labels = events_vector_ordered_v2, 
                     limits = c(0,11.75), ## expand the limits to account for athlete names, otherwise it will cross the boundaries of the graph. Again, some trial and error here, there's a probably a better way to expand to a specific width based on the athlete with the longest name (here - Thomas van der Plaetsen)
                     sec.axis = dup_axis(name = element_blank())
                   ) +
  labs(title = "Progression of the Ranking of Decathletes who Finished the Decathlon in the 2016 Olympics") +
  theme(panel.grid.minor.y = element_blank(),
        panel.grid.minor.x = element_blank(),
        text = element_text("Segoe UI"),
        axis.text = element_text(size = 13),
        axis.title = element_text(size = 20),
        axis.title.x = element_text(hjust = 0.475, margin = margin(t=5)),
        plot.title = element_text(margin = margin(b=8), size = 28)) +
  scale_color_manual(values=colorRampPalette(brewer.pal(11, "Spectral"))(n_athletes),
                     guide=F) + #### interpolate Spectral colour values for n number of athletes
  transition_reveal(Athlete, reveal_time)

animate(my_anim, nframes = 100, fps = 25, width = 1200, height = 600, type = "cairo-png") ## Warning: this takes a while to generate. Depending on how good your cpu is, probably anywhere from 15 minute to an hour. I have an i5-3470 and it takes me around 40 mins. So it's best to run this with nframes = 100 first to check you're happy with the font layout/formatting/sizing before generating the full animation. In my full animation I set nframes = 800.