Skip to content

Instantly share code, notes, and snippets.

@dgrtwo
Created May 8, 2020 19:56
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dgrtwo/98fd50058289626cd3a170f672059614 to your computer and use it in GitHub Desktop.
Save dgrtwo/98fd50058289626cd3a170f672059614 to your computer and use it in GitHub Desktop.
Showing how a 3rd-degree polynomial model would predict future deaths if a plateau continues
library(tidyverse)
library(broom)
library(scales)
theme_set(theme_light())
US <- read_csv("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us.csv") %>%
mutate(new_deaths = deaths - lag(deaths)) %>%
filter(date >= "2020-02-26")
today <- max(US$date)
# Imagine 5 weeks in the future repeating the last week
simulated_future <- rerun(10, tail(US, 7)) %>%
bind_rows() %>%
mutate(date = today + row_number())
US_future <- US %>%
bind_rows(simulated_future) %>%
crossing(days_future = seq(0, 20))
# Predict for 21 days in the future
models <- US_future %>%
filter(date <= today + days_future) %>%
group_by(days_future) %>%
nest() %>%
mutate(model = map(data, ~ lm(log(new_deaths + .5) ~ poly(date, 3), data = .)))
# Predict a few weeks future from each threshold
US_extrapolated <- US_future %>%
filter(date < today + days_future + 42) %>%
mutate(new_deaths = ifelse(date <= today + days_future, new_deaths, NA)) %>%
group_by(days_future) %>%
nest()
library(gganimate)
models %>%
select(-data) %>%
inner_join(US_extrapolated, by = "days_future") %>%
mutate(augmented = map2(model, data, ~ augment(.x, newdata = .y))) %>%
unnest(augmented) %>%
ggplot(aes(date, new_deaths)) +
geom_line(size = 2) +
geom_line(aes(color = date > today), size = 2) +
geom_line(aes(y = exp(.fitted) - 1), size = 1, lty = 2, color = "red") +
labs(title = "How a cubic model's predictions will change if the plateau continues",
subtitle = paste0("3rd degree polynomial fit to log(deaths + .5).\n",
"Hypothetical future (shown in gray) repeats most recent week.\n"),
y = "Daily US deaths (NY Times)",
x = "") +
scale_y_continuous(labels = comma_format()) +
scale_color_manual(values = c("black", "gray")) +
transition_manual(days_future) +
theme(legend.position = "none")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment