R code using {covid19.nhs.data} and estimates from epiforecasts.io/covid to generate a gif of the effective reproduction for Covid-19 using hospital admissions by upper-tier local authority in England.

covid19-utla-rt-from-admissions.R

# Packages ----------------------------------------------------------------
library(covid19.nhs.data)
library(vroom)
library(dplyr)
library(tidyr)
library(lubridate)
library(gganimate) 
#devtools::install_github("thomasp85/transformr")
library(transformr)
library(gifski)
library(ggplot2)

# Get data ----------------------------------------------------------------
# download epiforecast Rt from hospital admissions by UTLA (latest)
# also available for cases and for deaths with each having strengths and limitations
# cases main limitation = testing bias and changing CFR
# deaths main limitation is long lag from infection to deaths makes reconstructing infections difficult
rt <- vroom("https://raw.githubusercontent.com/epiforecasts/covid-rt-estimates/master/subnational/united-kingdom-local/admissions/summary/rt.csv")

# filter from September and link to geo codes
rt <- rt %>%
  filter(!(type %in% "forecast")) %>% 
  select(geo_name = region, date, rt = median) %>%
  inner_join(utla_names, by = c("geo_name")) %>% 
  filter(date >= "2020-10-01")

# Make map ----------------------------------------------------------------
# mapping function 
map_rt <- function(rt, shapefile = england_utla_shape) {
  shapefile %>%
    inner_join(rt, by = "geo_code") %>% 
    ggplot() +
    geom_sf(data = shapefile, lwd = 0.3, col = "grey60") +
    geom_sf(aes(fill = rt), lwd = 0.3, col = "grey20") +
    scale_fill_viridis_c(option = "viridis", direction = -1, na.value = "grey80") + 
    theme_void() +
    guides(fill = guide_colorbar(title = "Effective reproduction number")) +
    theme(legend.position = "right")
}
# map latest
plot <- rt %>% 
  filter(date == max(date)) %>% 
  map_rt()

# map all time (for gif)
gif <- rt %>% 
  mutate(date = factor(date)) %>% 
  map_rt()
 
# Turn into a gif ---------------------------------------------------------
gif <- gif + 
  ggtitle('Date: {closest_state}') +
  transition_states(date)

animate(gif, fps = 10, nframes = length(unique(rt$date)) * 2, renderer = gifski_renderer())

# Save --------------------------------------------------------------------
ggsave("utla_rt.png", plot)
anim_save("utla_rt.gif")

Update: 2021-06-09