Animated Barplots

I used to love watching videos from “data is beautiful”, where barplots where animated and overtaking each other over time to show data changing over time.

Now I wanted to create one myself using R. I chose to use covid-data for this, because it is a relevant topic at these times.

I dug the web and stackoverflow and R-bloggers had answers for me. It is indeed possible to create nice animation movies out of plots in R and save them as GIF or mp4!

Goals:

• create a bar plot as known from “data is beautiful”
• use n-COVID-19 data to see the top countries animated
• smoothen it up!

Turns out gganimate can help us achieve this, by animating the bars created by ggplot.

I added as many clarifying comments in the code as possible. Have fun recreating / improving!

Let’s start by loading the data and do some data wrangling:

# to get nCov2019 dataset:
#install.packages("remotes")
remotes::install_github("YuLab-SMU/nCov2019")

library(nCov2019) # the dataset
library(plotly) # the animation library
library(tidyverse) # useful for wrangling
library(gganimate) # for the animations
library(magrittr) # %<>% function is a dplyr shortcut, look it up ;)
library(magick) # the renderer for gif files

#### LOAD DATA ####
res <- query()

Now we can get the covid data:

y =res$historical
d <- y["global"]
# get global data:

# FORMAT DATA
formatted <- d %>% 
  group_by(date) %>% # group by the date
  mutate(rank = min_rank(-cases) * 1, # create a rank for every day 
         Value_lbl = paste0(" ", round(cases))) %>%  # create labels for the values
  group_by(country) %>% 
  filter(rank <= 10) %>% # get the top 10 ranks every day
  filter(date > as.Date("2020-01-01")) %>%  # filter custom date
  ungroup()

formatted$date = as.Date(formatted$date)

head(formatted)

## # A tibble: 6 x 7
##   country     date       cases deaths recovered  rank Value_lbl
##   <chr>       <date>     <int>  <int>     <int> <dbl> <chr>    
## 1 Afghanistan 2020-01-22     0      0         0     7 " 0"     
## 2 Afghanistan 2020-01-23     0      0         0     9 " 0"     
## 3 Afghanistan 2020-01-24     0      0         0    10 " 0"     
## 4 Albania     2020-01-22     0      0         0     7 " 0"     
## 5 Albania     2020-01-23     0      0         0     9 " 0"     
## 6 Albania     2020-01-24     0      0         0    10 " 0"

Great! We have a rank for every day for every country in the top 10. Now let us use this inside ggplot and use gganimate to get it animated!

# animate
animated <- 
  # create a ggplot with ..
  ggplot(formatted, aes(rank, group = country, 
        fill = as.factor(country), color = as.factor(country))) +
  # the aesthetics for the bars: y position, height, alpha is the opacity
  geom_tile(aes(y = cases/2,
                height = cases,
                width = 0.9), alpha = 0.8, color = NA) +
  # the labels for the countries in front, the paste0
  # needs to be there for the right position
  geom_text(aes(y = 0, label = paste(country, " ")), vjust = 0.1, hjust = 1) +
  # the labels for the numbers. 
  geom_text(aes(y=cases, label = paste0(Value_lbl), hjust = 0)) +
  # flip the coordinate system, clip off for the right display
  coord_flip(clip = "off", expand = FALSE) +
  # reverse the x-scale to have the largest bar on top
  scale_x_reverse() +
  scale_y_continuous(labels = scales::comma) +
  # to make the background grid lines moving, use view_follow
  view_follow() +
  # this is for removing redundant labels etc:
  guides(color = FALSE, fill = FALSE) +
  # change background & theme
  theme(axis.line=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank(),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        legend.position="none",
        panel.background=element_blank(),
        panel.border=element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.grid.major.x = element_line( size=.1, color="grey" ),
        panel.grid.minor.x = element_line( size=.1, color="grey" ),
        # aesthetics for the title, subtitle etc.
        plot.title=element_text(size=20, hjust=0.5, face="bold", colour="grey", vjust=-1),
        plot.subtitle=element_text(size=15, hjust=0.5, face="italic", color="grey"),
        plot.caption =element_text(size=8, hjust=0.5, face="italic", color="grey"),
        plot.background=element_blank(),
        plot.margin = margin(2, 2, 2, 4, "cm")) +
  # the transition between the states is defined here
  transition_states(date, transition_length = 25, state_length = 5) +
  # to make the countries overtake each other more smoothly:
  # more options to smoothen the transitions
  enter_grow() +
  exit_shrink() +
  ease_aes("cubic-in-out") +
  labs(title = 'Cumulative confirmed cases on {closest_state}',  
       subtitle  =  "Top 10 Countries",
       caption  = "Tianzhi Wu, Erqiang Hu, Xijin Ge*, Guangchuang Yu*. 
         Open-source analytics tools for studying the COVID-19 coronavirus outbreak. medRxiv, 2020.02.25.20027433. 
         doi: https://doi.org/10.1101/2020.02.25.20027433") 

# this is the animation here
animate(animated, duration = 75, fps = 25, renderer = magick_renderer())

Click here for the github repo