Merge pull request #77 from cmu-delphi/km-kill-lags-good

km-kill-lags branched off frosting.

Author: kenmawer

NAMESPACE

@@ -3,8 +3,7 @@
 S3method(apply_frosting,default)
 S3method(apply_frosting,epi_workflow)
 S3method(augment,epi_workflow)
-S3method(bake,step_epi_ahead)
-S3method(bake,step_epi_lag)
+S3method(bake,step_epi_shift)
 S3method(detect_layer,frosting)
 S3method(detect_layer,workflow)
 S3method(epi_keys,default)
@@ -17,12 +16,12 @@ S3method(extract_layers,frosting)
 S3method(extract_layers,workflow)
 S3method(predict,epi_workflow)
 S3method(prep,epi_recipe)
-S3method(prep,step_epi_ahead)
-S3method(prep,step_epi_lag)
+S3method(prep,step_epi_shift)
 S3method(print,epi_workflow)
 S3method(print,frosting)
 S3method(print,step_epi_ahead)
 S3method(print,step_epi_lag)
+S3method(print,step_epi_shift)
 S3method(refresh_blueprint,default_epi_recipe_blueprint)
 S3method(run_mold,default_epi_recipe_blueprint)
 S3method(slather,layer_naomit)
@@ -71,6 +70,7 @@ export(smooth_arx_forecaster)
 export(step_epi_ahead)
 export(step_epi_lag)
 export(step_epi_naomit)
+export(step_epi_shift)
 export(validate_layer)
 import(recipes)
 importFrom(generics,augment)

R/epi_ahead.R

@@ -2,26 +2,26 @@
 #'
 #' This is a lower-level function. As such it performs no error checking.
 #'
-#' @param x Data frame. Variables to lag
-#' @param lags List. Each list element is a vector of lags.
+#' @param x Data frame. Variables to shift
+#' @param shifts List. Each list element is a vector of shifts.
 #'   Negative values produce leads. The list should have the same
 #'   length as the number of columns in `x`.
 #' @param time_value Vector. Same length as `x` giving time stamps.
 #' @param keys Data frame, vector, or `NULL`. Additional grouping vars.
 #' @param out_name Chr. The output list will use this as a prefix.
 #'
 #' @return a list of tibbles
-epi_shift <- function(x, lags, time_value, keys = NULL, out_name = "x") {
+epi_shift <- function(x, shifts, time_value, keys = NULL, out_name = "x") {
   if (!is.data.frame(x)) x <- data.frame(x)
   if (is.null(keys)) keys <- rep("empty", nrow(x))
   p_in = ncol(x)
-  out_list <- tibble::tibble(i = 1:p_in, lag = lags) %>%
-    tidyr::unchop(lag) %>% # what is chop
+  out_list <- tibble::tibble(i = 1:p_in, shift = shifts) %>%
+    tidyr::unchop(shift) %>% # what is chop
     dplyr::mutate(name = paste0(out_name, 1:nrow(.))) %>%
-    # One list element for each lagged feature
-    purrr::pmap(function(i, lag, name) {
+    # One list element for each shifted feature
+    purrr::pmap(function(i, shift, name) {
       tibble(keys,
-             time_value = time_value + lag, # Shift back
+             time_value = time_value + shift, # Shift back
              !!name := x[[i]])
     })
   if (is.data.frame(keys)) common_names <- c(names(keys), "time_value")
@@ -30,9 +30,9 @@ epi_shift <- function(x, lags, time_value, keys = NULL, out_name = "x") {
   purrr::reduce(out_list, dplyr::full_join, by = common_names)
 }
 
-epi_shift_single <- function(x, col, lag_val, newname, key_cols) {
+epi_shift_single <- function(x, col, shift_val, newname, key_cols) {
   x %>%
     dplyr::select(tidyselect::all_of(c(key_cols, col))) %>%
-    dplyr::mutate(time_value = time_value + lag_val) %>%
+    dplyr::mutate(time_value = time_value + shift_val) %>%
     dplyr::rename(!!newname := col)
 }

R/epi_lag.R

@@ -28,7 +28,7 @@ get_test_data <- function(recipe, x){
   }
   ## CHECK if it is epi_df?
 
-  max_lags <- max(map_dbl(recipe$steps, ~ max(.x$lag %||% 0)))
+  max_lags <- max(map_dbl(recipe$steps, ~ max(.x$shift %||% 0)))
 
   # CHECK: Return NA if insufficient training data
   if (dplyr::n_distinct(x$time_value) < max_lags) {