Covid-19 Vaccination Program Growth Rates

covid-vaccine-growth-rates.R

# ---
# title: "Covid-19 Vaccination Program Growth Rates"
# author: "Christopher Gandrud"
# date: "2021-02-21"
# ---

# For hrbragg installation instructions see:
# https://git.rud.is/hrbrmstr/hrbragg#installation
xfun::pkg_attach2("hrbragg", "tsibble", "tidyverse")


# Load data
covid_data <- read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv") 

# Summarise data by week ---------
covid_data$year_week <- tsibble::yearweek(covid_data$date)
covid_week <- covid_data %>% group_by(location, year_week) %>%
    summarise(doses = sum(daily_vaccinations))

growth <- function(change, old) {
    (change / old) * 100
}

covid_week <- covid_week %>% group_by(location) %>%
    mutate(diff_doses = difference(doses)) %>%
    mutate(lag_doses = lag(doses)) %>%
    drop_na(diff_doses) %>%
    slice(2:n()) # Drop possibly incomplete first comparison week of data

covid_week$doses_growth <- growth(covid_week$diff_doses, 
                                  covid_week$lag_doses)

# Plot selected locations -----------
locations <- c("Germany", "United States", "European Union",
               "Spain", "Italy", "Denmark", "Poland",
               "Israel", "United Kingdom")

covid_week <- subset(covid_week, location %in% locations)

# drop likely incomplete week
covid_week <- filter(covid_week, year_week != yearweek("2021 W07"))


ggplot(covid_week, aes(year_week, doses_growth, group = location)) +
    facet_wrap(.~location) +
    geom_line(color = "#f953c6") +
    geom_hline(yintercept = 0) +
    scale_y_continuous(breaks = c(0, 25, 50, 100, 150)) +
    ylab("Week-over-Week Doses (% change)\n") +
    xlab("\nCalendar Week") +
    ggtitle("How fast are Covid-19 vaccination programs growing?") +
    labs(caption = "Note: first data point compares the 2nd to 3rd weeks of program rollout to avoid including incomplete weeks.\nData source: Our World in Data") +
    theme_inter(grid = "XY", mode = "dark")

Creates: