Merge pull request #436 from cmu-delphi/climatological

Climatological

Author: dajmcdon

.gitignore

@@ -10,3 +10,4 @@ inst/doc
 .Rprofile
 renv.lock
 renv/
+.Renviron

DESCRIPTION

@@ -38,6 +38,7 @@ Imports:
     glue,
     hardhat (>= 1.3.0),
     lifecycle,
+    lubridate,
     magrittr,
     recipes (>= 1.0.4),
     rlang (>= 1.1.0),
@@ -54,7 +55,6 @@ Suggests:
     fs,
     grf,
     knitr,
-    lubridate,
     poissonreg,
     purrr,
     quantreg,

NAMESPACE

@@ -20,6 +20,7 @@ S3method(autoplot,epi_workflow)
 S3method(bake,check_enough_train_data)
 S3method(bake,epi_recipe)
 S3method(bake,step_adjust_latency)
+S3method(bake,step_climate)
 S3method(bake,step_epi_ahead)
 S3method(bake,step_epi_lag)
 S3method(bake,step_epi_slide)
@@ -59,6 +60,7 @@ S3method(predict,flatline)
 S3method(prep,check_enough_train_data)
 S3method(prep,epi_recipe)
 S3method(prep,step_adjust_latency)
+S3method(prep,step_climate)
 S3method(prep,step_epi_ahead)
 S3method(prep,step_epi_lag)
 S3method(prep,step_epi_slide)
@@ -72,6 +74,7 @@ S3method(print,arx_fcast)
 S3method(print,canned_epipred)
 S3method(print,cdc_baseline_fcast)
 S3method(print,check_enough_train_data)
+S3method(print,climate_fcast)
 S3method(print,epi_recipe)
 S3method(print,epi_workflow)
 S3method(print,flat_fcast)
@@ -89,6 +92,7 @@ S3method(print,layer_residual_quantiles)
 S3method(print,layer_threshold)
 S3method(print,layer_unnest)
 S3method(print,step_adjust_latency)
+S3method(print,step_climate)
 S3method(print,step_epi_ahead)
 S3method(print,step_epi_lag)
 S3method(print,step_epi_slide)
@@ -152,6 +156,8 @@ export(cdc_baseline_args_list)
 export(cdc_baseline_forecaster)
 export(check_enough_train_data)
 export(clean_f_name)
+export(climate_args_list)
+export(climatological_forecaster)
 export(default_epi_recipe_blueprint)
 export(detect_layer)
 export(dist_quantiles)
@@ -207,6 +213,7 @@ export(select)
 export(slather)
 export(smooth_quantile_reg)
 export(step_adjust_latency)
+export(step_climate)
 export(step_epi_ahead)
 export(step_epi_lag)
 export(step_epi_naomit)
@@ -286,6 +293,10 @@ importFrom(glue,glue)
 importFrom(hardhat,extract_recipe)
 importFrom(hardhat,refresh_blueprint)
 importFrom(hardhat,run_mold)
+importFrom(lubridate,"%m-%")
+importFrom(lubridate,leap_year)
+importFrom(lubridate,month)
+importFrom(lubridate,yday)
 importFrom(magrittr,"%>%")
 importFrom(magrittr,extract2)
 importFrom(recipes,bake)

NEWS.md

@@ -11,6 +11,7 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.0.x will indicat
   `data(<dataset name>)`, but can be accessed with
   `data(<dataset name>, package = "epidatasets")`, `epidatasets::<dataset name>`
   or, after loading the package, the name of the dataset alone (#382).
+- `step_adjust_latency()` no longer allows empty column selection.
 - Addresses upstream breaking changes from cmu-delphi/epiprocess#595 (`growth_rate()`). 
   `step_growth_rate()` has lost its `additional_gr_args_list` argument and now
   has an `na_rm` argument.
@@ -25,8 +26,11 @@ Pre-1.0.0 numbering scheme: 0.x will indicate releases, while 0.0.x will indicat
 - Fix `quantile_reg()` producing error when asked to output just median-level predictions.
 - (temporary) ahead negative is allowed for `step_epi_ahead` until we have `step_epi_shift`
 - Add `reference_date` as an argument to `epi_recipe()`
+- Add `step_climate()` to create "climate" predictor in forecast workflows
+- Add `climatological_forecaster()` to automatically create climate baselines
 
 ## Bug fixes
+
 - Shifting no columns results in no error for either `step_epi_ahead` and `step_epi_lag`
 - Quantiles produced by `grf` were sometimes out of order.
 - dist_quantiles can have all `NA` values without causing unrelated errors

R/arx_forecaster.R

@@ -92,7 +92,7 @@ arx_forecaster <- function(
 #'
 #' @return An unfitted `epi_workflow`.
 #' @export
-#' @seealso [arx_forecaster()]
+#' @seealso [arx_forecaster()], [arx_args_list()]
 #'
 #' @examples
 #' jhu <- covid_case_death_rates %>%
@@ -282,6 +282,7 @@ arx_fcast_epi_workflow <- function(
 #'
 #' @return A list containing updated parameter choices with class `arx_flist`.
 #' @export
+#' @seealso [arx_forecaster()]
 #'
 #' @examples
 #' arx_args_list()

R/autoplot.R

@@ -119,12 +119,13 @@ autoplot.epi_workflow <- function(
     shift <- -as.numeric(old_name_y[2])
     new_name_y <- paste(old_name_y[-c(1:2)], collapse = "_")
     edf <- rename(edf, !!new_name_y := !!names(y))
+  } else {
+    new_name_y <- names(y)
+    shift <- 0
   }
 
-  if (!is.null(shift)) {
-    edf <- mutate(edf, time_value = time_value + shift)
-  }
-  other_keys <- setdiff(key_colnames(object), c("geo_value", "time_value"))
+  edf <- mutate(edf, time_value = time_value + shift)
+  other_keys <- key_colnames(object, exclude = c("geo_value", "time_value"))
   edf <- as_epi_df(edf,
     as_of = object$fit$meta$as_of,
     other_keys = other_keys

R/canned-epipred.R

@@ -112,37 +112,39 @@ print.canned_epipred <- function(x, name, ...) {
     "At forecast date{?s}: {.val {fds}},",
     "For target date{?s}: {.val {tds}},"
   ))
-  fit_recipe <- extract_recipe(x$epi_workflow)
-  if (detect_step(fit_recipe, "adjust_latency")) {
-    is_adj_latency <- map_lgl(fit_recipe$steps, function(x) inherits(x, "step_adjust_latency"))
-    latency_step <- fit_recipe$steps[is_adj_latency][[1]]
-    # all steps after adjust_latency
-    later_steps <- fit_recipe$steps[-(1:which(is_adj_latency))]
-    if (latency_step$method == "extend_ahead") {
-      step_names <- "step_epi_ahead"
-      type_str <- "Aheads"
-    } else if (latency_step$method == "extend_lags") {
-      step_names <- "step_epi_lag"
-      type_str <- "Lags"
-    } else {
-      step_names <- ""
-      type_str <- "columns locf"
-    }
-    later_steps[[1]]$columns
-    valid_columns <- later_steps %>%
-      keep(function(x) inherits(x, step_names)) %>%
-      purrr::map("columns") %>%
-      reduce(c)
-    latency_per_base_col <- latency_step$latency_table %>%
-      filter(col_name %in% valid_columns) %>%
-      mutate(latency = abs(latency))
-    if (latency_step$method != "locf" && nrow(latency_per_base_col) > 1) {
-      intro_text <- glue::glue("{type_str} adjusted per column: ")
-    } else if (latency_step$method != "locf") {
-      intro_text <- glue::glue("{type_str} adjusted for ")
+  if ("actions" %in% names(x$pre) && "recipe" %in% names(x$pre$actions)) {
+    fit_recipe <- extract_recipe(x$epi_workflow)
+    if (detect_step(fit_recipe, "adjust_latency")) {
+      is_adj_latency <- map_lgl(fit_recipe$steps, function(x) inherits(x, "step_adjust_latency"))
+      latency_step <- fit_recipe$steps[is_adj_latency][[1]]
+      # all steps after adjust_latency
+      later_steps <- fit_recipe$steps[-(1:which(is_adj_latency))]
+      if (latency_step$method == "extend_ahead") {
+        step_names <- "step_epi_ahead"
+        type_str <- "Aheads"
+      } else if (latency_step$method == "extend_lags") {
+        step_names <- "step_epi_lag"
+        type_str <- "Lags"
+      } else {
+        step_names <- ""
+        type_str <- "columns locf"
+      }
+      later_steps[[1]]$columns
+      valid_columns <- later_steps %>%
+        keep(function(x) inherits(x, step_names)) %>%
+        purrr::map("columns") %>%
+        reduce(c)
+      latency_per_base_col <- latency_step$latency_table %>%
+        filter(col_name %in% valid_columns) %>%
+        mutate(latency = abs(latency))
+      if (latency_step$method != "locf" && nrow(latency_per_base_col) > 1) {
+        intro_text <- glue::glue("{type_str} adjusted per column: ")
+      } else if (latency_step$method != "locf") {
+        intro_text <- glue::glue("{type_str} adjusted for ")
+      }
+      latency_info <- paste0(intro_text, paste(apply(latency_per_base_col, 1, paste0, collapse = "="), collapse = ", "))
+      cli::cli_ul(latency_info)
     }
-    latency_info <- paste0(intro_text, paste(apply(latency_per_base_col, 1, paste0, collapse = "="), collapse = ", "))
-    cli::cli_ul(latency_info)
   }
   cli::cli_text("")
 }