@@ -239,18 +239,21 @@ aheads and some variations we will use later.
239239``` {r arx-kweek-preliminaries, warning = FALSE}
240240forecast_wrapper <- function(
241241 epi_data, aheads, outcome, predictors,
242- process_data = identity
243- ) {
244- map(aheads,
245- \(ahead) {
246- arx_forecaster(
247- process_data(epi_data), outcome, predictors,
248- args_list = arx_args_list(
249- ahead = ahead,
250- lags = c(0:7, 14, 21),
251- adjust_latency = "extend_ahead")
252- )$predictions %>%
253- pivot_quantiles_wider(.pred_distn)}) %>%
242+ process_data = identity) {
243+ map(
244+ aheads,
245+ \(ahead) {
246+ arx_forecaster(
247+ process_data(epi_data), outcome, predictors,
248+ args_list = arx_args_list(
249+ ahead = ahead,
250+ lags = c(0:7, 14, 21),
251+ adjust_latency = "extend_ahead"
252+ )
253+ )$predictions %>%
254+ pivot_quantiles_wider(.pred_distn)
255+ }
256+ ) %>%
254257 bind_rows()
255258}
256259```
@@ -268,24 +271,25 @@ archives, and bind the results together.
268271forecast_dates <- seq(
269272 from = as.Date("2020-09-01"),
270273 to = as.Date("2021-11-01"),
271- by = "1 month")
274+ by = "1 month"
275+ )
272276aheads <- c(1, 7, 14, 21, 28)
273277
274278version_faithless <- archive_cases_dv_subset_faux %>%
275- epix_slide(
276- ~ forecast_wrapper(.x, aheads, "percent_cli", "percent_cli"),
277- .before = 120,
278- .versions = forecast_dates
279- ) %>%
280- mutate(version_faithful = FALSE)
279+ epix_slide(
280+ ~ forecast_wrapper(.x, aheads, "percent_cli", "percent_cli"),
281+ .before = 120,
282+ .versions = forecast_dates
283+ ) %>%
284+ mutate(version_faithful = FALSE)
281285
282286version_faithful <- doctor_visits %>%
283- epix_slide(
284- ~ forecast_wrapper(.x, aheads, "percent_cli", "percent_cli"),
285- .before = 120,
286- .versions = forecast_dates
287- ) %>%
288- mutate(version_faithful = TRUE)
287+ epix_slide(
288+ ~ forecast_wrapper(.x, aheads, "percent_cli", "percent_cli"),
289+ .before = 120,
290+ .versions = forecast_dates
291+ ) %>%
292+ mutate(version_faithful = TRUE)
289293
290294forecasts <-
291295 bind_rows(
@@ -348,7 +352,8 @@ p2 <-
348352 geom_point(aes(y = .pred, color = factor(time_value)), size = 0.75) +
349353 geom_vline(
350354 data = percent_cli_data %>% filter(geo_value == geo_choose) %>% select(-version_faithful),
351- aes(color = factor(version), xintercept = version), lty = 2) +
355+ aes(color = factor(version), xintercept = version), lty = 2
356+ ) +
352357 geom_line(
353358 data = percent_cli_data %>% filter(geo_value == geo_choose),
354359 aes(x = time_value, y = percent_cli, color = factor(version)),
0 commit comments