COVID Brooklyn Forecast

forecast.R

library(tidyverse)

df <- read_csv("https://raw.githubusercontent.com/nychealth/coronavirus-data/master/latest/now-cases-by-day.csv")

df %>%
  mutate(date = as.Date(date_of_interest, "%m/%d/%Y")) ->df

df %>%
  ggplot(aes(date, BK_CASE_COUNT)) +
  geom_point()


m1 <- lm(BK_CASE_COUNT ~ date + weekdays(date), data = filter(df, date >= "2021-04-01", date <= "2021-05-12"))
m2 <- glm(BK_CASE_COUNT ~ date + weekdays(date), data = filter(df, date >= "2021-04-01", date <= "2021-05-12"), family=quasipoisson())

tibble(
  date = seq(as.Date("2021-02-01"), as.Date("2021-08-01"), by = 1)
) %>%
  mutate(
    linear = pmin(pmax(predict(m1, .), 0), 1000),
    poisson = pmin(exp(predict(m2, ., scale="response")), 1000)
  ) %>%
  left_join(df) %>%
  ggplot(aes(date)) +
  annotate("rect", xmin=as.Date("2021-04-01"), xmax=as.Date("2021-05-12"), ymin=0, ymax=1000, fill="red", alpha=.25) +
  geom_line(aes(y  = linear), color = "blue", alpha = .5) +
  geom_line(aes(y = poisson), color = "darkgreen", alpha=.5) +
  geom_point(aes(y = BK_CASE_COUNT), alpha = .8) +
  annotate("text", label= "Training Data", x = as.Date("2021-04-15"), y=1000, hjust = "left") +
  geom_label(aes(x=date, y =BK_CASE_COUNT, label=paste(format(date, "%b %d"), BK_CASE_COUNT, sep="\n")), data = filter(df, date == max(date)), nudge_x = 3, hjust="left", size=2, alpha=.5) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b 01") +
  scale_y_continuous(breaks = c(0, 100, 200, 300, 400, 500, 750, 1000, 1500)) +
  theme_minimal() +
  labs(x = "Date", y = "Brooklyn New Daily Cases", title = "Linear vs. Poisson Models")