smaller suggestions: local tests passing again

Author: dsweber2

R/step_adjust_latency.R

@@ -194,6 +194,7 @@ prep.step_adjust_latency <- function(x, training, info = NULL, ...) {
     # check that the shift amount isn't too extreme
     latency <- max(shift_cols$latency)
     time_type <- attributes(training)$metadata$time_type
+    i_latency <- which.max(shift_cols$latency)
     if (
       (grepl("day", time_type) && (latency >= 10)) ||
         (grepl("week", time_type) && (latency >= 4)) ||
@@ -207,8 +208,8 @@ prep.step_adjust_latency <- function(x, training, info = NULL, ...) {
           "which is questionable for it's `time_type` of ",
           "{time_type}"
         ),
-        "i" = "input ahead: {shift_cols$shifts[[i_latency]]}",
-        "i" = "shifted ahead: {shift_cols$effective_shift[[i_latency]]}",
+        "i" = "input shift: {shift_cols$shifts[[i_latency]]}",
+        "i" = "latency adjusted shift: {shift_cols$effective_shift[[i_latency]]}",
         "i" = "max_time = {max_time} -> as_of = {as_of}"
       ))
     }

R/step_epi_shift.R

@@ -72,9 +72,8 @@ step_epi_lag <-
         )
       )
     }
-    latency_adjustment <- rlang::arg_match(latency_adjustment)
     arg_is_nonneg_int(lag)
-    arg_is_chr_scalar(prefix, id, latency_adjustment)
+    arg_is_chr_scalar(prefix, id)
     if (!is.null(columns)) {
       cli::cli_abort(c(
         "The `columns` argument must be `NULL`.",
@@ -91,7 +90,6 @@ step_epi_lag <-
         prefix = prefix,
         default = default,
         keys = epi_keys(recipe),
-        latency_adjustment = latency_adjustment,
         columns = columns,
         skip = skip,
         id = id
@@ -112,12 +110,6 @@ step_epi_ahead <-
            trained = FALSE,
            prefix = "ahead_",
            default = NA,
-           latency_adjustment = c(
-             "None",
-             "extend_ahead",
-             "locf",
-             "extend_lags"
-           ),
            columns = NULL,
            skip = FALSE,
            id = rand_id("epi_ahead")) {
@@ -131,9 +123,8 @@ step_epi_ahead <-
         i = "Did you perhaps pass an integer in `...` accidentally?"
       ))
     }
-    latency_adjustment <- rlang::arg_match(latency_adjustment)
     arg_is_nonneg_int(ahead)
-    arg_is_chr_scalar(prefix, id, latency_adjustment)
+    arg_is_chr_scalar(prefix, id)
     if (!is.null(columns)) {
       cli::cli_abort(c("The `columns` argument must be `NULL`.",
         i = "Use `tidyselect` methods to choose columns to lead."
@@ -149,7 +140,6 @@ step_epi_ahead <-
         prefix = prefix,
         default = default,
         keys = epi_keys(recipe),
-        latency_adjustment = latency_adjustment,
         columns = columns,
         skip = skip,
         id = id
@@ -160,7 +150,7 @@ step_epi_ahead <-
 
 step_epi_lag_new <-
   function(terms, role, trained, lag, prefix, default, keys,
-           latency_adjustment, columns, skip, id) {
+           columns, skip, id) {
     step(
       subclass = "epi_lag",
       terms = terms,
@@ -170,15 +160,14 @@ step_epi_lag_new <-
       prefix = prefix,
       default = default,
       keys = keys,
-      latency_adjustment = latency_adjustment,
       columns = columns,
       skip = skip,
       id = id
     )
   }
 
 step_epi_ahead_new <-
-  function(terms, role, trained, ahead, prefix, default, keys, latency_adjustment,
+  function(terms, role, trained, ahead, prefix, default, keys,
            columns, skip, id) {
     step(
       subclass = "epi_ahead",
@@ -188,7 +177,6 @@ step_epi_ahead_new <-
       ahead = ahead,
       prefix = prefix,
       default = default,
-      latency_adjustment = latency_adjustment,
       keys = keys,
       columns = columns,
       skip = skip,
@@ -208,7 +196,6 @@ prep.step_epi_lag <- function(x, training, info = NULL, ...) {
     prefix = x$prefix,
     default = x$default,
     keys = x$keys,
-    latency_adjustment = x$latency_adjustment,
     columns = recipes_eval_select(x$terms, training, info),
     skip = x$skip,
     id = x$id
@@ -225,7 +212,6 @@ prep.step_epi_ahead <- function(x, training, info = NULL, ...) {
     prefix = x$prefix,
     default = x$default,
     keys = x$keys,
-    latency_adjustment = x$latency_adjustment,
     columns = recipes_eval_select(x$terms, training, info),
     skip = x$skip,
     id = x$id

R/utils-latency.R

@@ -101,7 +101,7 @@ get_shifted_column_tibble <- function(
     mutate(
       new_name = adjust_name(prefix, original_name, effective_shift)
     )
-  info <- shift_cols %>% select(variable, type, role)
+  info <- info %>% select(variable, type, role)
   shift_cols <- left_join(shift_cols, info, by = join_by(original_name == variable))
   if (length(unique(shift_cols$role)) != 1) {
     cli::cli_abort("not all roles are the same!",
@@ -138,7 +138,7 @@ set_asof <- function(new_data, info) {
   as_of <- attributes(new_data)$metadata$as_of
   max_time <- max(time_values)
   # make sure the as_of is sane
-  if (!inherits(as_of, class(time_values))) {
+  if (!inherits(as_of, class(time_values)) & !inherits(as_of, "POSIXt")) {
     cli::cli_abort(glue::glue(
       "the data matrix `as_of` value is {as_of}, ",
       "and not a valid `time_type` with type ",

man/step_epi_shift.Rd

@@ -34,10 +34,11 @@ test_that("epi_adjust_latency correctly extends the lags", {
   # the as_of on x is today's date, which is >970 days in the future
   # also, there's no data >970 days in the past, so it gets an error trying to
   # fit on no data
-  expect_error(expect_warning(fit5 <- slm_fit(r5)))
+  expect_error(expect_warning(fit5 <- slm_fit(r5), regexp = "The shift has been adjusted by 1022"), class = "simpleError")
 
   # now trying with the as_of a reasonable distance in the future
   fit5 <- slm_fit(r5, data = real_x)
+
   expect_equal(
     names(fit5$pre$mold$predictors),
     c(

tests/testthat/test-step_adjust_latency.R

@@ -8,9 +8,8 @@ old_data <- tibble(
   tmp_death_rate = atan(0.1 * 1:200) + cos(5 * 1:200) + 1
 ) %>%
   as_epi_df(as_of = as_of)
-old_data %>% tail()
 keys <- c("time_value", "geo_value")
-old_data <- shift_cols %>%
+old_data <- old_data %>%
   full_join(epi_shift_single(
     old_data, "tmp_death_rate", 1, "death_rate", keys
   ), by = keys) %>%