Merge pull request #386 from cmu-delphi/ds/epiprocess-0.9.0

fix: update for compatibility with epiprocess==0.9.0

Author: dshemetov

.Rbuildignore

@@ -19,4 +19,5 @@
 ^DEVELOPMENT\.md$
 ^doc$
 ^Meta$
-^.lintr$
+^.lintr$
+^.venv$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: epipredict
 Title: Basic epidemiology forecasting methods
-Version: 0.0.20
+Version: 0.0.21
 Authors@R: c(
     person("Daniel", "McDonald", , "[email protected]", role = c("aut", "cre")),
     person("Ryan", "Tibshirani", , "[email protected]", role = "aut"),
@@ -23,8 +23,7 @@ URL: https://github.com/cmu-delphi/epipredict/,
     https://cmu-delphi.github.io/epipredict
 BugReports: https://github.com/cmu-delphi/epipredict/issues/
 Depends:
-    epiprocess (>= 0.8.0),
-    epiprocess (< 0.9.0),
+    epiprocess (>= 0.9.0),
     parsnip (>= 1.0.0),
     R (>= 3.5.0)
 Imports:

R/autoplot.R

@@ -131,7 +131,7 @@ autoplot.epi_workflow <- function(
   if (length(extra_keys) == 0L) extra_keys <- NULL
   edf <- as_epi_df(edf,
     as_of = object$fit$meta$as_of,
-    additional_metadata = list(other_keys = extra_keys)
+    other_keys = extra_keys %||% character()
   )
   if (is.null(predictions)) {
     return(autoplot(

R/cdc_baseline_forecaster.R

@@ -29,11 +29,11 @@
 #'   mutate(deaths = pmax(death_rate / 1e5 * pop * 7, 0)) %>%
 #'   select(-pop, -death_rate) %>%
 #'   group_by(geo_value) %>%
-#'   epi_slide(~ sum(.$deaths), before = 6, new_col_name = "deaths") %>%
+#'   epi_slide(~ sum(.$deaths), .window_size = 7, .new_col_name = "deaths_7dsum") %>%
 #'   ungroup() %>%
 #'   filter(weekdays(time_value) == "Saturday")
 #'
-#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths")
+#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths_7dsum")
 #' preds <- pivot_quantiles_wider(cdc$predictions, .pred_distn)
 #'
 #' if (require(ggplot2)) {
@@ -47,7 +47,7 @@
 #'     geom_line(aes(y = .pred), color = "orange") +
 #'     geom_line(
 #'       data = weekly_deaths %>% filter(geo_value %in% four_states),
-#'       aes(x = time_value, y = deaths)
+#'       aes(x = time_value, y = deaths_7dsum)
 #'     ) +
 #'     scale_x_date(limits = c(forecast_date - 90, forecast_date + 30)) +
 #'     labs(x = "Date", y = "Weekly deaths") +

R/epi_recipe.R

@@ -95,7 +95,7 @@ epi_recipe.epi_df <-
     keys <- key_colnames(x) # we know x is an epi_df
 
     var_info <- tibble(variable = vars)
-    key_roles <- c("geo_value", "time_value", rep("key", length(keys) - 2))
+    key_roles <- c("geo_value", rep("key", length(keys) - 2), "time_value")
 
     ## Check and add roles when available
     if (!is.null(roles)) {
@@ -499,8 +499,11 @@ prep.epi_recipe <- function(
       if (!is_epi_df(training)) {
         # tidymodels killed our class
         # for now, we only allow step_epi_* to alter the metadata
-        training <- dplyr::dplyr_reconstruct(
-          as_epi_df(training), before_template
+        metadata <- attr(before_template, "metadata")
+        training <- as_epi_df(
+          training,
+          as_of = metadata$as_of,
+          other_keys = metadata$other_keys %||% character()
         )
       }
       training <- dplyr::relocate(training, all_of(key_colnames(training)))
@@ -579,8 +582,7 @@ bake.epi_recipe <- function(object, new_data, ..., composition = "epi_df") {
     new_data <- as_epi_df(
       new_data,
       as_of = meta$as_of,
-      # avoid NULL if meta is from saved older epi_df:
-      additional_metadata = meta$additional_metadata %||% list()
+      other_keys = meta$other_keys %||% character()
     )
   }
   new_data

R/epi_workflow.R

@@ -98,7 +98,8 @@ is_epi_workflow <- function(x) {
 fit.epi_workflow <- function(object, data, ..., control = workflows::control_workflow()) {
   object$fit$meta <- list(
     max_time_value = max(data$time_value),
-    as_of = attributes(data)$metadata$as_of
+    as_of = attr(data, "metadata")$as_of,
+    other_keys = attr(data, "metadata")$other_keys
   )
   object$original_data <- data
 

R/flusight_hub_formatter.R

@@ -67,11 +67,11 @@ abbr_to_location <- function(abbr) {
 #'   mutate(deaths = pmax(death_rate / 1e5 * pop * 7, 0)) %>%
 #'   select(-pop, -death_rate) %>%
 #'   group_by(geo_value) %>%
-#'   epi_slide(~ sum(.$deaths), before = 6, new_col_name = "deaths") %>%
+#'   epi_slide(~ sum(.$deaths), .window_size = 7, .new_col_name = "deaths_7dsum") %>%
 #'   ungroup() %>%
 #'   filter(weekdays(time_value) == "Saturday")
 #'
-#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths")
+#' cdc <- cdc_baseline_forecaster(weekly_deaths, "deaths_7dsum")
 #' flusight_hub_formatter(cdc)
 #' flusight_hub_formatter(cdc, target = "wk inc covid deaths")
 #' flusight_hub_formatter(cdc, target = paste(horizon, "wk inc covid deaths"))

R/key_colnames.R

@@ -1,19 +1,20 @@
 #' @export
 key_colnames.recipe <- function(x, ...) {
-  possible_keys <- c("geo_value", "time_value", "key")
-  keys <- x$var_info$variable[x$var_info$role %in% possible_keys]
-  keys[order(match(keys, possible_keys))] %||% character(0L)
+  geo_key <- x$var_info$variable[x$var_info$role %in% "geo_value"]
+  time_key <- x$var_info$variable[x$var_info$role %in% "time_value"]
+  keys <- x$var_info$variable[x$var_info$role %in% "key"]
+  c(geo_key, keys, time_key) %||% character(0L)
 }
 
 #' @export
 key_colnames.epi_workflow <- function(x, ...) {
   # safer to look at the mold than the preprocessor
   mold <- hardhat::extract_mold(x)
-  possible_keys <- c("geo_value", "time_value", "key")
   molded_names <- names(mold$extras$roles)
-  keys <- map(mold$extras$roles[molded_names %in% possible_keys], names)
-  keys <- unname(unlist(keys))
-  keys[order(match(keys, possible_keys))] %||% character(0L)
+  geo_key <- names(mold$extras$roles[molded_names %in% "geo_value"]$geo_value)
+  time_key <- names(mold$extras$roles[molded_names %in% "time_value"]$time_value)
+  keys <- names(mold$extras$roles[molded_names %in% "key"]$key)
+  c(geo_key, keys, time_key) %||% character(0L)
 }
 
 kill_time_value <- function(v) {

R/layer_add_forecast_date.R

@@ -104,6 +104,7 @@ slather.layer_add_forecast_date <- function(object, components, workflow,
     workflows::extract_preprocessor(workflow)$template, "metadata"
   )$time_type
   if (expected_time_type == "week") expected_time_type <- "day"
+  if (expected_time_type == "integer") expected_time_type <- "year"
   validate_date(
     forecast_date, expected_time_type,
     call = rlang::expr(layer_add_forecast_date())

R/layer_add_target_date.R

@@ -90,6 +90,7 @@ slather.layer_add_target_date <- function(object, components, workflow,
     workflows::extract_preprocessor(workflow)$template, "metadata"
   )$time_type
   if (expected_time_type == "week") expected_time_type <- "day"
+  if (expected_time_type == "integer") expected_time_type <- "year"
 
   if (!is.null(object$target_date)) {
     target_date <- object$target_date