Animating Covid-19

Previous analysis in this area has tended not to show maps over time against the right measures. I aim to do so here for Europe. The general picture that emerges is one of sobering consistency.

Robin Penfold
2020-03-21

In other words, the analysis below follows-up on my post last week.

What did I do in that post? Well, for each of the twelve large countries with the most per-capita cases, I considered the cumulative Covid-19 infections per million inhabitants. I charted these figures against what I call the time since the outbreak – that is, the days since ‘Day-Zero’: the day that country’s cumulative infections first exceeded 10 per million.

In this analysis, I animate these details over time, showing the proportion of cases per country against the time since the outbreak.

Doing so generates the following animation (the code for which is in the Appendix below).


Overall, it adds to the sobering impression that many countries are on a similar unfortunate path.

For more detail, here’s the same chart in a static form, broken-out day by day.



For completeness (and reproducibility), here’s the code that I used to calculate what’s above.

Data and animation


# Initialise ----
library(countrycode)
library(gganimate)
library(ggtext)
library(glue)
library(lubridate)
library(maps)
library(rtweet)
library(scales)
library(sf)
library(tidyverse)
library(wbstats)

country_num <- 20
pop_min <- 4000000
cases_PM_init <- 10


# Get data ----
data <- read_csv('https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_19-covid-Confirmed.csv') %>% 
  select(-Lat, -Long, -`Province/State`) %>% 
  group_by(`Country/Region`) %>% 
  summarise_all(.funs = sum) %>% 
  gather(
    key = "Date", 
    value = "Cases", 
    -`Country/Region`
  ) %>% 
  rename("Country" = `Country/Region`) %>% 
  mutate(
    Date = as.Date(Date, "%m/%d/%y"),
    DateNumber = as.integer(
      Date - as.Date("01/21/20", "%m/%d/%y")
    ),
    Country = str_to_upper(Country)
  )

# countries <- countrycode::codelist
# write_rds(x = countries, path = 'countries.rds')
countries <- read_rds('countries.rds')

# population <- wbstats::wb(country = "all", indicator = "SP.POP.TOTL") %>% 
#   group_by(iso3c) %>% 
#   arrange(desc(date)) %>% 
#   slice(1) %>% 
#   ungroup() %>% 
#   distinct()
# write_rds(x = population, path = 'population.rds')
population <- read_rds('population.rds')


# Tidy data ----
data_tidy <- data %>% 
  left_join(
    countries, 
    by = c('Country' = 'genc.name')
  ) %>% 
  left_join(
    population, 
    by = 'iso3c'
  ) %>% 
  select("Country" = country.name.en, Date, Cases, DateNumber, continent, iso3c, value) %>% 
  filter(
    !is.na(Country),
    value > pop_min
  ) %>% 
  mutate(
    Cases_PM = 1000000 * Cases / value,
    Country = as_factor(Country),
    Country = fct_reorder(
      .f = Country, 
      .x = Cases, 
      .fun = max, 
      .desc = TRUE
    ),
    Country_PM = fct_reorder(
      .f = Country, 
      .x = Cases_PM, 
      .fun = max, 
      .desc = TRUE
    )
  )


# Rebase per capita cases ----
data_base_value <- data_tidy %>% 
  arrange(Date) %>% 
  group_by(Country) %>% 
  filter(Cases_PM > cases_PM_init) %>% 
  slice(1) %>% 
  ungroup() %>% 
  select(Country, "Date_base" = Date, "DateNumber_base" = DateNumber, "Cases_PM_base" = Cases_PM)

data_rebased <- data_tidy %>% 
  left_join(
    data_base_value, 
    by = 'Country'
  ) %>% 
  mutate(
    Cases_PM_rebased = Cases_PM / Cases_PM_base,
    DateNumber_rebased = DateNumber - DateNumber_base
  ) %>% 
  filter(DateNumber_rebased >= 0)


# Global chart ----
country <- st_as_sf(
  maps::map(
    database = 'world', 
    plot = FALSE, 
    fill = TRUE
    )
  )

countries <- cbind(
  country, 
  st_coordinates(st_centroid(country))
  ) %>% 
  as_tibble() %>% 
  mutate(
    name_country = str_to_title(
      countrycode(
        sourcevar = ID, 
        origin = 'country.name.en',
        destination = 'genc.name')
      )
    ) 

data_rebased_country <- data_rebased %>% 
  filter(continent == "Europe") %>% 
  left_join(countries, by = c('Country' = 'name_country'))

data_rebased_country_wide <- data_rebased_country %>% 
  select(Country, iso3c, DateNumber_rebased, X, Y, geom, Cases_PM_rebased) %>% 
  pivot_wider(
    names_from = DateNumber_rebased, 
    values_from = Cases_PM_rebased,
    values_fill = list(Cases_PM_rebased = 0)
    ) %>% 
  pivot_longer(
    cols = -c(Country, iso3c, X, Y, geom),
    names_to = "DateNumber_rebased", 
    values_to = "Cases_PM_rebased"
    ) %>% 
  mutate(DateNumber_rebased = as.integer(DateNumber_rebased))

animation <- data_rebased_country_wide %>% 
  filter(DateNumber_rebased <= 20) %>% 
  ggplot() + 
  geom_sf(
    aes(
      geometry = geom, 
      fill = Cases_PM_rebased
      )
    ) + 
  coord_sf(
    xlim = c(-10.7, 30),
    ylim = c(34.6, 65),
    expand = FALSE
    ) + 
  scale_fill_binned(type = "gradient") +
  scale_fill_gradient(
    low = "white", 
    high = "red", 
    trans = "log", 
    labels = label_number(
      big.mark = ',', 
      accuracy = 2
      )
  ) +
  theme_void() + 
  theme(
    panel.background = element_rect(fill = 'grey90'),
    plot.title.position = "plot",
    plot.title = element_textbox_simple(
      size = 12,
      lineheight = 1,
      padding = margin(5.5, 5.5, 2, 5.5)
    ),
    plot.subtitle = element_textbox_simple(
      size = 10,
      lineheight = 1,
      padding = margin(2, 5.5, 11, 5.5)
      ),
    plot.caption.position = "plot",
    plot.caption = element_text(size = 8, hjust = 0)
    ) + 
  labs(
    title = "Cumulative Covid-19 cases relative to those at Day-Zero",
    subtitle = '**{frame_time} days** after Day-Zero, when cumulative infections first exceeded 10 per million',
    fill = '',
    caption = '\nFurther details available @p0bs or p0bs.com'
  ) +
  transition_time(DateNumber_rebased) +
  enter_fade() + 
  exit_shrink() +
  ease_aes('sine-in-out')

# gganimate::anim_save(
#   animation = animation,
#   filename = 'europe.gif'
#   )

data_rebased_country_wide %>% 
  filter(DateNumber_rebased <= 15) %>% 
  ggplot() + 
  geom_sf(
    aes(
      geometry = geom, 
      fill = Cases_PM_rebased
      )
    ) + 
  coord_sf(
    xlim = c(-10.7, 30),
    ylim = c(34.6, 65),
    expand = FALSE
    ) + 
  scale_fill_gradient(
    low = "white", 
    high = "red", 
    trans = "log", 
    labels = label_number(
      big.mark = ',', 
      accuracy = 2
      )
    ) +
  theme_void() + 
  theme(
    panel.background = element_rect(fill = 'grey90'),
    plot.title.position = "plot",
    plot.caption.position = "plot",
    plot.caption = element_text(size = 8, hjust = 0)
    ) + 
  labs(
    title = "Cumulative Covid-19 cases relative to those at Day-Zero",
    subtitle = 'Days after Day-Zero, when cumulative infections first exceeded 10 per million \n',
    fill = '',
    caption = '\nFurther details available @p0bs or p0bs.com'
  ) + 
  facet_wrap(
    ~DateNumber_rebased, 
    ncol = 4
    )

System settings


R version 3.6.0 (2019-04-26)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS  10.15.3

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib

locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
 [1] wbstats_0.2        forcats_0.5.0      stringr_1.4.0     
 [4] dplyr_0.8.5        purrr_0.3.3        readr_1.3.1       
 [7] tidyr_1.0.2        tibble_2.1.3       tidyverse_1.3.0   
[10] sf_0.8-1           scales_1.1.0       rtweet_0.7.0      
[13] maps_3.3.0         lubridate_1.7.4    glue_1.3.2        
[16] ggtext_0.1.0       gganimate_1.0.5    ggplot2_3.3.0.9000
[19] countrycode_1.1.1 

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.4           lattice_0.20-38      prettyunits_1.1.1   
 [4] class_7.3-15         assertthat_0.2.1     digest_0.6.25       
 [7] R6_2.4.1             cellranger_1.1.0     backports_1.1.5     
[10] reprex_0.3.0         evaluate_0.14        e1071_1.7-3         
[13] httr_1.4.1           pillar_1.4.3         rlang_0.4.5         
[16] progress_1.2.2       curl_4.3             readxl_1.3.1        
[19] rstudioapi_0.11      gifski_0.8.6         rmarkdown_2.1       
[22] munsell_0.5.0        gridtext_0.1.1       broom_0.5.4         
[25] compiler_3.6.0       modelr_0.1.5         xfun_0.12           
[28] pkgconfig_2.0.3      htmltools_0.4.0.9003 tidyselect_1.0.0    
[31] fansi_0.4.1          crayon_1.3.4         dbplyr_1.4.2        
[34] withr_2.1.2          grid_3.6.0           nlme_3.1-139        
[37] jsonlite_1.6.1       gtable_0.3.0         lifecycle_0.2.0     
[40] DBI_1.1.0            magrittr_1.5         units_0.6-5         
[43] KernSmooth_2.23-15   cli_2.0.2            stringi_1.4.6       
[46] farver_2.0.3         fs_1.3.2             xml2_1.2.5          
[49] ellipsis_0.3.0       vctrs_0.2.4          generics_0.0.2      
[52] distill_0.7          tools_3.6.0          tweenr_1.0.1        
[55] hms_0.5.3            yaml_2.2.1           colorspace_1.4-1    
[58] rvest_0.3.5          classInt_0.4-2       knitr_1.28          
[61] haven_2.2.0