Many models

gistfile1.txt

library(tidyverse)
library(RcppRoll)
library(lubridate)
library(broom)

covid <- read_csv("https://covid.ourworldindata.org/data/owid-covid-data.csv") %>%
  filter(location != "World")

covid <- covid %>%
  group_by(iso_code) %>%
  arrange(date) %>%
  mutate(rolling_deaths = roll_sum(new_deaths, 7, align = "right", fill = NA) / 7,
         rolling_cases = roll_sum(new_cases, 7, align = "right", fill = NA) / 7,
         lagged_cfr = rolling_deaths / lag(rolling_cases, 14),
         week = week(date) - week(ymd("2020-05-01")),
         lagged_tests = lag(new_tests_smoothed_per_thousand, 14)) %>%
  filter(week > 0)

 stats <-  covid %>%
  filter(!is.na(lagged_tests)) %>%
  group_by(iso_code, location) %>%
  nest() %>%
  rowwise() %>%
  mutate(mod = list(lm(lagged_cfr ~ week + lagged_tests, data)),
   summary = list(tidy(mod)),
   fit = list(glance(mod))
  ) %>%
   unnest(fit) %>%
   select(location, summary, r.squared) %>%
   unnest(summary)

countries <- covid %>%
  filter(date == ymd("2020-06-29")) %>%
  filter(rolling_cases > 500,
         rolling_deaths > 10)

stats <- stats %>%
  arrange(estimate) %>%
  filter(term %in% c("week"))

stats$location <- fct_reorder(stats$location, rev(stats$estimate))

stats %>%
  filter(location %in% countries$location) %>%
  mutate(lower = estimate - std.error,
         upper = estimate + std.error) %>%
  ggplot(aes(y = location, x = estimate, colour = r.squared)) +
  geom_pointrange(aes(xmin = lower, xmax = upper)) +
  scale_color_viridis_c() +
  theme_light() +
  scale_x_continuous(labels = scales::percent) +
  geom_vline(xintercept = 0, alpha = 0.2) +
  labs(title = "Weekly change in lagged CFR",
       subtitle = "After accounting for changes in testing") +
  ylab("Country") +
  xlab("Average weekly change in CFR")