fix: address n_train and ahead mismatch #290

Author: dshemetov

R/flatline_forecaster.R

@@ -39,19 +39,25 @@ flatline_forecaster <- function(
   ek <- kill_time_value(keys)
   outcome <- rlang::sym(outcome)
 
+  args_list$forecast_date <- args_list$forecast_date %||% max(epi_data$time_value)
+  if (is.null(args_list$ahead) && is.null(args_list$target_date)) {
+    args_list$ahead <- 7L
+    args_list$target_date <- args_list$forecast_date + args_list$ahead
+  } else if (is.null(args_list$ahead)) {
+    args_list$ahead <- as.integer(difftime(args_list$target_date, args_list$forecast_date, units = "days"))
+  } else if (is.null(args_list$target_date)) {
+    args_list$target_date <- args_list$forecast_date + args_list$ahead
+  }
 
   r <- epi_recipe(epi_data) %>%
     step_epi_ahead(!!outcome, ahead = args_list$ahead, skip = TRUE) %>%
     recipes::update_role(!!outcome, new_role = "predictor") %>%
     recipes::add_role(tidyselect::all_of(keys), new_role = "predictor") %>%
     step_training_window(n_recent = args_list$n_training)
 
-  forecast_date <- args_list$forecast_date %||% max(epi_data$time_value)
-  target_date <- args_list$target_date %||% (forecast_date + args_list$ahead)
-
   latest <- get_test_data(
     epi_recipe(epi_data), epi_data, TRUE, args_list$nafill_buffer,
-    forecast_date
+    args_list$forecast_date
   )
 
   f <- frosting() %>%
@@ -61,8 +67,8 @@ flatline_forecaster <- function(
       symmetrize = args_list$symmetrize,
       by_key = args_list$quantile_by_key
     ) %>%
-    layer_add_forecast_date(forecast_date = forecast_date) %>%
-    layer_add_target_date(target_date = target_date)
+    layer_add_forecast_date(forecast_date = args_list$forecast_date) %>%
+    layer_add_target_date(target_date = args_list$target_date)
   if (args_list$nonneg) f <- layer_threshold(f, dplyr::starts_with(".pred"))
 
   eng <- parsnip::linear_reg() %>% parsnip::set_engine("flatline")
@@ -87,7 +93,6 @@ flatline_forecaster <- function(
 }
 
 
-
 #' Flatline forecaster argument constructor
 #'
 #' Constructs a list of arguments for [flatline_forecaster()].
@@ -108,7 +113,7 @@ flatline_forecaster <- function(
 #' flatline_args_list(symmetrize = FALSE)
 #' flatline_args_list(quantile_levels = c(.1, .3, .7, .9), n_training = 120)
 flatline_args_list <- function(
-    ahead = 7L,
+    ahead = NULL,
     n_training = Inf,
     forecast_date = NULL,
     target_date = NULL,
@@ -119,11 +124,11 @@ flatline_args_list <- function(
     nafill_buffer = Inf,
     ...) {
   rlang::check_dots_empty()
-  arg_is_scalar(ahead, n_training)
+  arg_is_scalar(n_training)
   arg_is_chr(quantile_by_key, allow_empty = TRUE)
   arg_is_scalar(forecast_date, target_date, allow_null = TRUE)
   arg_is_date(forecast_date, target_date, allow_null = TRUE)
-  arg_is_nonneg_int(ahead)
+  arg_is_nonneg_int(ahead, allow_null = TRUE)
   arg_is_lgl(symmetrize, nonneg)
   arg_is_probabilities(quantile_levels, allow_null = TRUE)
   arg_is_pos(n_training)

R/layer_residual_quantiles.R

@@ -123,6 +123,10 @@ slather.layer_residual_quantiles <-
           probs = object$quantile_levels, na.rm = TRUE
         ))
       )
+    # Check for NA
+    if (any(sapply(r$dstn, is.na))) {
+      cli::cli_abort("Quantiles could not be calculated due to missing residuals. Check your n_train and ahead values.")
+    }
 
     estimate <- components$predictions$.pred
     res <- tibble::tibble(

man/flatline_args_list.Rd

@@ -1,3 +1,6 @@
+# These tests address #290:
+# https://github.com/cmu-delphi/epipredict/issues/290
+
 library(dplyr)
 train <- jhu_csse_daily_subset |>
   filter(time_value >= as.Date("2021-10-01")) |>
@@ -13,7 +16,6 @@ test_that("flatline determines target_date where forecast_date exists", {
       ahead = 1L
     )
   )
-
   # previously, if target_date existed, it could be
   # erroneously incremented by the ahead
   expect_identical(
@@ -24,9 +26,6 @@ test_that("flatline determines target_date where forecast_date exists", {
     flat$predictions$forecast_date,
     rep(as.Date("2021-12-31"), ngeos)
   )
-
-  # potentially resulted in NA predictions
-  # see #290 https://github.com/cmu-delphi/epipredict/issues/290
   expect_true(all(!is.na(flat$predictions$.pred_distn)))
   expect_true(all(!is.na(flat$predictions$.pred)))
 })
@@ -50,9 +49,6 @@ test_that("arx_forecaster determines target_date where forecast_date exists", {
     arx$predictions$forecast_date,
     rep(as.Date("2021-12-31"), ngeos)
   )
-
-  # potentially resulted in NA predictions
-  # see #290 https://github.com/cmu-delphi/epipredict/issues/290
   expect_true(all(!is.na(arx$predictions$.pred_distn)))
   expect_true(all(!is.na(arx$predictions$.pred)))
 })
@@ -67,7 +63,6 @@ test_that("arx_classifier determines target_date where forecast_date exists", {
       ahead = 1L
     )
   )
-
   # previously, if target_date existed, it could be
   # erroneously incremented by the ahead
   expect_identical(
@@ -78,8 +73,19 @@ test_that("arx_classifier determines target_date where forecast_date exists", {
     arx$predictions$forecast_date,
     rep(as.Date("2021-12-31"), ngeos)
   )
-
-  # potentially resulted in NA predictions
-  # see #290 https://github.com/cmu-delphi/epipredict/issues/290
   expect_true(all(!is.na(arx$predictions$.pred_class)))
 })
+
+test_that("n_training and ahead bugs", {
+  expect_error(
+    flatline_forecaster(
+      train, "dr",
+      args_list = flatline_args_list(
+        forecast_date = as.Date("2021-12-31"),
+        # n_training is less than default ahead which is 7
+        n_training = 5L
+      )
+    ),
+    "Check your n_train and ahead values"
+  )
+})