From 59ca31ac490ad3e742635531208fe0e69047fc3b Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 02:40:49 -0700 Subject: [PATCH 01/39] Created layer_add_forecast_date and ..._target_date as well as tests for both of those postprocessing steps --- NAMESPACE | 4 ++ R/layer_add_forecast_date.R | 50 ++++++++++++++++++ R/layer_add_target_date.R | 51 +++++++++++++++++++ man/epi_workflow.Rd | 2 +- man/layer_add_forecast_date.Rd | 44 ++++++++++++++++ man/layer_add_target_date.Rd | 41 +++++++++++++++ tests/testthat/test-layer_add_forecast_date.R | 37 ++++++++++++++ tests/testthat/test-layer_add_target_date.R | 33 ++++++++++++ 8 files changed, 261 insertions(+), 1 deletion(-) create mode 100644 R/layer_add_forecast_date.R create mode 100644 R/layer_add_target_date.R create mode 100644 man/layer_add_forecast_date.Rd create mode 100644 man/layer_add_target_date.Rd create mode 100644 tests/testthat/test-layer_add_forecast_date.R create mode 100644 tests/testthat/test-layer_add_target_date.R diff --git a/NAMESPACE b/NAMESPACE index b05534ae0..9edc72c16 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,8 @@ S3method(prep,step_epi_ahead) S3method(prep,step_epi_lag) S3method(print,step_epi_ahead) S3method(print,step_epi_lag) +S3method(slather,layer_add_forecast_date) +S3method(slather,layer_add_target_date) S3method(slather,layer_naomit) S3method(slather,layer_predict) export("%>%") @@ -40,6 +42,8 @@ export(knn_iteraive_ar_args_list) export(knn_iteraive_ar_forecaster) export(knnarx_args_list) export(knnarx_forecaster) +export(layer_add_forecast_date) +export(layer_add_target_date) export(layer_naomit) export(layer_predict) export(slather) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R new file mode 100644 index 000000000..bac70b3c8 --- /dev/null +++ b/R/layer_add_forecast_date.R @@ -0,0 +1,50 @@ +#' Postprocessing step to add the forecast date +#' +#' @param frosting a `frosting` postprocessor +#' @param forecast_date The forecast date to add as a column to the `epi_df`. +#' This must be specified by the user. +#' @param id a random id string +#' +#' @return an updated `frosting` postprocessor +#' @export +#' @examples +#' jhu <- case_death_rate_subset %>% +#' dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ak", "ca", "ny")) +#' r <- epi_recipe(jhu) %>% +#' step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% +#' step_epi_ahead(death_rate, ahead = 7) %>% +#' step_naomit(all_predictors()) %>% +#' step_naomit(all_outcomes(), skip = TRUE) +#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) +#' latest <- jhu %>% +#' dplyr::filter(time_value >= max(time_value) - 14) +#' +#' f <- frosting() %>% layer_predict() %>% layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) +#' wf1 <- wf %>% add_frosting(f) +#' +#' p <- predict(wf1, latest) +#' p +layer_add_forecast_date <- + function(frosting, forecast_date = NULL, id = rand_id("add_forecast_date")) { + add_layer( + frosting, + layer_add_forecast_date_new( + forecast_date = forecast_date, + id = id + ) + ) + } + +layer_add_forecast_date_new <- function(forecast_date, id) { + layer("add_forecast_date", forecast_date = forecast_date, id = id) +} + +#' @export +slather.layer_add_forecast_date <- function(object, components, the_fit, ...) { + if(is.null(object$forecast_date)) stop("`forecast_date` must be specified.") + if(!is.character(object$forecast_date)) stop("`forecast_date` must be of class character.") + + components$predictions <- dplyr::bind_cols(components$predictions, + forecast_date = as.Date(object$forecast_date)) + components +} diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R new file mode 100644 index 000000000..ea142caef --- /dev/null +++ b/R/layer_add_target_date.R @@ -0,0 +1,51 @@ +#' Postprocessing step to add the target date +#' +#' @param frosting a `frosting` postprocessor +#' @param ahead A positive integer to add to `time_value` to get the target date. +#' This must be specified by the user. +#' @param id a random id string +#' +#' @return an updated `frosting` postprocessor +#' @export +#' @examples +#' jhu <- case_death_rate_subset %>% +#' dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ak", "ca", "ny")) +#' r <- epi_recipe(jhu) %>% +#' step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% +#' step_epi_ahead(death_rate, ahead = 7) %>% +#' step_naomit(all_predictors()) %>% +#' step_naomit(all_outcomes(), skip = TRUE) +#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) +#' latest <- jhu %>% +#' dplyr::filter(time_value >= max(time_value) - 14) +#' +#' f <- frosting() %>% layer_predict() %>% +#' layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) +#' wf1 <- wf %>% add_frosting(f) +#' +#' p <- predict(wf1, latest) +#' p +layer_add_target_date <- + function(frosting, ahead = NULL, id = rand_id("add_target_date")) { + add_layer( + frosting, + layer_add_target_date_new( + ahead = ahead, + id = id + ) + ) + } + +layer_add_target_date_new <- function(ahead, id) { + layer("add_target_date", ahead = ahead, id = id) +} + +#' @export +slather.layer_add_target_date <- function(object, components, the_fit, ...) { + if(is.null(object$ahead)) stop("`ahead` must be specified.") + if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") + + components$predictions <- dplyr::bind_cols(components$predictions, + target_date = object$ahead + components$predictions$time_value) + components +} diff --git a/man/epi_workflow.Rd b/man/epi_workflow.Rd index f9d753d84..bcf0e78aa 100644 --- a/man/epi_workflow.Rd +++ b/man/epi_workflow.Rd @@ -11,7 +11,7 @@ epi_workflow(preprocessor = NULL, spec = NULL, postprocessor = NULL) \itemize{ \item A formula, passed on to \code{\link[workflows:add_formula]{add_formula()}}. \item A recipe, passed on to \code{\link[workflows:add_recipe]{add_recipe()}}. -\item A \code{\link[workflows:workflow_variables]{workflow_variables()}} object, passed on to \code{\link[workflows:add_variables]{add_variables()}}. +\item A \code{\link[workflows:add_variables]{workflow_variables()}} object, passed on to \code{\link[workflows:add_variables]{add_variables()}}. }} \item{spec}{An optional parsnip model specification to add to the workflow. diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd new file mode 100644 index 000000000..994e7f54a --- /dev/null +++ b/man/layer_add_forecast_date.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/layer_add_forecast_date.R +\name{layer_add_forecast_date} +\alias{layer_add_forecast_date} +\title{Postprocessing step to add the forecast date} +\usage{ +layer_add_forecast_date( + frosting, + forecast_date = NULL, + id = rand_id("add_forecast_date") +) +} +\arguments{ +\item{frosting}{a \code{frosting} postprocessor} + +\item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. +This must be specified by the user.} + +\item{id}{a random id string} +} +\value{ +an updated \code{frosting} postprocessor +} +\description{ +Postprocessing step to add the forecast date +} +\examples{ +jhu <- case_death_rate_subset \%>\% + dplyr::filter(time_value > "2021-11-01", geo_value \%in\% c("ak", "ca", "ny")) +r <- epi_recipe(jhu) \%>\% + step_epi_lag(death_rate, lag = c(0, 7, 14)) \%>\% + step_epi_ahead(death_rate, ahead = 7) \%>\% + step_naomit(all_predictors()) \%>\% + step_naomit(all_outcomes(), skip = TRUE) +wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% fit(jhu) +latest <- jhu \%>\% + dplyr::filter(time_value >= max(time_value) - 14) + +f <- frosting() \%>\% layer_predict() \%>\% layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) +wf1 <- wf \%>\% add_frosting(f) + +p <- predict(wf1, latest) +p +} diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd new file mode 100644 index 000000000..728e215a3 --- /dev/null +++ b/man/layer_add_target_date.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/layer_add_target_date.R +\name{layer_add_target_date} +\alias{layer_add_target_date} +\title{Postprocessing step to add the target date} +\usage{ +layer_add_target_date(frosting, ahead = NULL, id = rand_id("add_target_date")) +} +\arguments{ +\item{frosting}{a \code{frosting} postprocessor} + +\item{ahead}{A positive integer to add to \code{time_value} to get the target date. +This must be specified by the user.} + +\item{id}{a random id string} +} +\value{ +an updated \code{frosting} postprocessor +} +\description{ +Postprocessing step to add the target date +} +\examples{ +jhu <- case_death_rate_subset \%>\% + dplyr::filter(time_value > "2021-11-01", geo_value \%in\% c("ak", "ca", "ny")) +r <- epi_recipe(jhu) \%>\% + step_epi_lag(death_rate, lag = c(0, 7, 14)) \%>\% + step_epi_ahead(death_rate, ahead = 7) \%>\% + step_naomit(all_predictors()) \%>\% + step_naomit(all_outcomes(), skip = TRUE) +wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% fit(jhu) +latest <- jhu \%>\% + dplyr::filter(time_value >= max(time_value) - 14) + +f <- frosting() \%>\% layer_predict() \%>\% + layer_add_target_date(ahead = 7) \%>\% layer_naomit(.pred) +wf1 <- wf \%>\% add_frosting(f) + +p <- predict(wf1, latest) +p +} diff --git a/tests/testthat/test-layer_add_forecast_date.R b/tests/testthat/test-layer_add_forecast_date.R new file mode 100644 index 000000000..62c09ab5b --- /dev/null +++ b/tests/testthat/test-layer_add_forecast_date.R @@ -0,0 +1,37 @@ +jhu <- case_death_rate_subset %>% + dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ak", "ca", "ny")) +r <- epi_recipe(jhu) %>% + step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% + step_epi_ahead(death_rate, ahead = 7) %>% + step_naomit(all_predictors()) %>% + step_naomit(all_outcomes(), skip = TRUE) +wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) +latest <- jhu %>% + dplyr::filter(time_value >= max(time_value) - 14) + +test_that("Specify a forecast_date in `layer_add_forecast_date()`", { + + f <- frosting() %>% + layer_predict() %>% + layer_add_forecast_date(forecast_date = "2021-12-31") %>% + layer_naomit(.pred) + wf1 <- wf %>% add_frosting(f) + + expect_silent(p <- predict(wf1, latest)) + expect_equal(ncol(p), 4L) + expect_s3_class(p, "epi_df") + expect_equal(nrow(p), 3L) + expect_equal(p$forecast_date, rep(as.Date("2021-12-31"), times = 3)) + expect_named(p, c("time_value", "geo_value", ".pred", "forecast_date")) +}) + +test_that("Fail to specify a forecast_date in `layer_add_forecast_date()`", { + + f <- frosting() %>% + layer_predict() %>% + layer_add_forecast_date() %>% + layer_naomit(.pred) + wf2 <- wf %>% add_frosting(f) + + expect_error(predict(wf2, latest), "`forecast_date` must be specified") +}) diff --git a/tests/testthat/test-layer_add_target_date.R b/tests/testthat/test-layer_add_target_date.R new file mode 100644 index 000000000..0de525b01 --- /dev/null +++ b/tests/testthat/test-layer_add_target_date.R @@ -0,0 +1,33 @@ +jhu <- case_death_rate_subset %>% + dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ak", "ca", "ny")) +r <- epi_recipe(jhu) %>% + step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% + step_epi_ahead(death_rate, ahead = 7) %>% + step_naomit(all_predictors()) %>% + step_naomit(all_outcomes(), skip = TRUE) +wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) +latest <- jhu %>% + dplyr::filter(time_value >= max(time_value) - 14) + +test_that("Specify ahead in `layer_add_target_date()`", { + + f <- frosting() %>% layer_predict() %>% + layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) + wf1 <- wf %>% add_frosting(f) + + expect_silent(p <- predict(wf1, latest)) + expect_equal(ncol(p), 4L) + expect_s3_class(p, "epi_df") + expect_equal(nrow(p), 3L) + expect_equal(p$target_date, rep(as.Date("2022-01-07"), times = 3)) + expect_named(p, c("time_value", "geo_value", ".pred", "target_date")) +}) + +test_that("Fail to specify a ahead in `layer_add_target_date()`", { + + f <- frosting() %>% layer_predict() %>% + layer_add_target_date() %>% layer_naomit(.pred) + wf2 <- wf %>% add_frosting(f) + + expect_error(predict(wf2, latest), "`ahead` must be specified") +}) From cf9aaa966c142b1124b3be4b919d71e2f081a66f Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 02:51:42 -0700 Subject: [PATCH 02/39] recipes::step --- R/layer_add_forecast_date.R | 4 ++-- R/layer_add_target_date.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index bac70b3c8..8fcc2037e 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -13,8 +13,8 @@ #' r <- epi_recipe(jhu) %>% #' step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% #' step_epi_ahead(death_rate, ahead = 7) %>% -#' step_naomit(all_predictors()) %>% -#' step_naomit(all_outcomes(), skip = TRUE) +#' recipes::step_naomit(all_predictors()) %>% +#' recipes::step_naomit(all_outcomes(), skip = TRUE) #' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index ea142caef..a6d32e8f0 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -13,8 +13,8 @@ #' r <- epi_recipe(jhu) %>% #' step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% #' step_epi_ahead(death_rate, ahead = 7) %>% -#' step_naomit(all_predictors()) %>% -#' step_naomit(all_outcomes(), skip = TRUE) +#' recipes::step_naomit(all_predictors()) %>% +#' recipes::step_naomit(all_outcomes(), skip = TRUE) #' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) From 6b82626e13d2814b59eb75ec4e3bdc6c40128755 Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 03:08:05 -0700 Subject: [PATCH 03/39] recipes:: to Rd file for added layers --- man/layer_add_forecast_date.Rd | 4 ++-- man/layer_add_target_date.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 994e7f54a..60f6dbba7 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -30,8 +30,8 @@ jhu <- case_death_rate_subset \%>\% r <- epi_recipe(jhu) \%>\% step_epi_lag(death_rate, lag = c(0, 7, 14)) \%>\% step_epi_ahead(death_rate, ahead = 7) \%>\% - step_naomit(all_predictors()) \%>\% - step_naomit(all_outcomes(), skip = TRUE) + recipes::step_naomit(all_predictors()) \%>\% + recipes::step_naomit(all_outcomes(), skip = TRUE) wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 728e215a3..5ca2a0a99 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -26,8 +26,8 @@ jhu <- case_death_rate_subset \%>\% r <- epi_recipe(jhu) \%>\% step_epi_lag(death_rate, lag = c(0, 7, 14)) \%>\% step_epi_ahead(death_rate, ahead = 7) \%>\% - step_naomit(all_predictors()) \%>\% - step_naomit(all_outcomes(), skip = TRUE) + recipes::step_naomit(all_predictors()) \%>\% + recipes::step_naomit(all_outcomes(), skip = TRUE) wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) From bcfda7f9f5bb0562536a40157529d9ea109708fa Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 03:31:06 -0700 Subject: [PATCH 04/39] parsnip::fit --- R/layer_add_forecast_date.R | 2 +- R/layer_add_target_date.R | 2 +- man/layer_add_forecast_date.Rd | 2 +- man/layer_add_target_date.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 8fcc2037e..c3c937aca 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -15,7 +15,7 @@ #' step_epi_ahead(death_rate, ahead = 7) %>% #' recipes::step_naomit(all_predictors()) %>% #' recipes::step_naomit(all_outcomes(), skip = TRUE) -#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) +#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% parsnip::fit(jhu) #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index a6d32e8f0..469c1ec3b 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -15,7 +15,7 @@ #' step_epi_ahead(death_rate, ahead = 7) %>% #' recipes::step_naomit(all_predictors()) %>% #' recipes::step_naomit(all_outcomes(), skip = TRUE) -#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) +#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% parsnip::fit(jhu) #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 60f6dbba7..fd952bd0b 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -32,7 +32,7 @@ r <- epi_recipe(jhu) \%>\% step_epi_ahead(death_rate, ahead = 7) \%>\% recipes::step_naomit(all_predictors()) \%>\% recipes::step_naomit(all_outcomes(), skip = TRUE) -wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% fit(jhu) +wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 5ca2a0a99..93d341591 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -28,7 +28,7 @@ r <- epi_recipe(jhu) \%>\% step_epi_ahead(death_rate, ahead = 7) \%>\% recipes::step_naomit(all_predictors()) \%>\% recipes::step_naomit(all_outcomes(), skip = TRUE) -wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% fit(jhu) +wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) From 7c7e6e4ea6f5e4a7acfcd60c6c81c1a8bc1e2ec3 Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 03:46:59 -0700 Subject: [PATCH 05/39] recipes::all_predictors() --- R/layer_add_forecast_date.R | 4 ++-- R/layer_add_target_date.R | 4 ++-- man/layer_add_forecast_date.Rd | 4 ++-- man/layer_add_target_date.Rd | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index c3c937aca..c2f60bf6a 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -13,8 +13,8 @@ #' r <- epi_recipe(jhu) %>% #' step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% #' step_epi_ahead(death_rate, ahead = 7) %>% -#' recipes::step_naomit(all_predictors()) %>% -#' recipes::step_naomit(all_outcomes(), skip = TRUE) +#' recipes::step_naomit(recipes::all_predictors()) %>% +#' recipes::step_naomit(recipes::all_outcomes(), skip = TRUE) #' wf <- epi_workflow(r, parsnip::linear_reg()) %>% parsnip::fit(jhu) #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 469c1ec3b..444669f39 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -13,8 +13,8 @@ #' r <- epi_recipe(jhu) %>% #' step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% #' step_epi_ahead(death_rate, ahead = 7) %>% -#' recipes::step_naomit(all_predictors()) %>% -#' recipes::step_naomit(all_outcomes(), skip = TRUE) +#' recipes::step_naomit(recipes::all_predictors()) %>% +#' recipes::step_naomit(recipes::all_outcomes(), skip = TRUE) #' wf <- epi_workflow(r, parsnip::linear_reg()) %>% parsnip::fit(jhu) #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index fd952bd0b..8d398f4bf 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -30,8 +30,8 @@ jhu <- case_death_rate_subset \%>\% r <- epi_recipe(jhu) \%>\% step_epi_lag(death_rate, lag = c(0, 7, 14)) \%>\% step_epi_ahead(death_rate, ahead = 7) \%>\% - recipes::step_naomit(all_predictors()) \%>\% - recipes::step_naomit(all_outcomes(), skip = TRUE) + recipes::step_naomit(recipes::all_predictors()) \%>\% + recipes::step_naomit(recipes::all_outcomes(), skip = TRUE) wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 93d341591..e13355bdf 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -26,8 +26,8 @@ jhu <- case_death_rate_subset \%>\% r <- epi_recipe(jhu) \%>\% step_epi_lag(death_rate, lag = c(0, 7, 14)) \%>\% step_epi_ahead(death_rate, ahead = 7) \%>\% - recipes::step_naomit(all_predictors()) \%>\% - recipes::step_naomit(all_outcomes(), skip = TRUE) + recipes::step_naomit(recipes::all_predictors()) \%>\% + recipes::step_naomit(recipes::all_outcomes(), skip = TRUE) wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) From 85e5232ddefb0f50cbce547a72c4e4c245ee05de Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 04:11:38 -0700 Subject: [PATCH 06/39] epipredict:::frosting() --- R/layer_add_forecast_date.R | 3 ++- R/layer_add_target_date.R | 2 +- man/layer_add_forecast_date.Rd | 3 ++- man/layer_add_target_date.Rd | 2 +- 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index c2f60bf6a..68a608891 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -19,7 +19,8 @@ #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' -#' f <- frosting() %>% layer_predict() %>% layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) +#' f <- epipredict:::frosting() %>% layer_predict() %>% +#' layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) #' wf1 <- wf %>% add_frosting(f) #' #' p <- predict(wf1, latest) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 444669f39..14de71842 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -19,7 +19,7 @@ #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' -#' f <- frosting() %>% layer_predict() %>% +#' f <- epipredict:::frosting() %>% layer_predict() %>% #' layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) #' wf1 <- wf %>% add_frosting(f) #' diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 8d398f4bf..b243e1ea6 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -36,7 +36,8 @@ wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) -f <- frosting() \%>\% layer_predict() \%>\% layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) +f <- epipredict:::frosting() \%>\% layer_predict() \%>\% + layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) wf1 <- wf \%>\% add_frosting(f) p <- predict(wf1, latest) diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index e13355bdf..6bbc07f1d 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -32,7 +32,7 @@ wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) -f <- frosting() \%>\% layer_predict() \%>\% +f <- epipredict:::frosting() \%>\% layer_predict() \%>\% layer_add_target_date(ahead = 7) \%>\% layer_naomit(.pred) wf1 <- wf \%>\% add_frosting(f) From 26aa627e272beb868d8beea5352491d75a68fe99 Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 18 Jun 2022 04:28:54 -0700 Subject: [PATCH 07/39] epipredict::add_frosting() --- R/layer_add_forecast_date.R | 2 +- R/layer_add_target_date.R | 2 +- man/layer_add_forecast_date.Rd | 2 +- man/layer_add_target_date.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 68a608891..2b8f12a33 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -21,7 +21,7 @@ #' #' f <- epipredict:::frosting() %>% layer_predict() %>% #' layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) -#' wf1 <- wf %>% add_frosting(f) +#' wf1 <- wf %>% epipredict:::add_frosting(f) #' #' p <- predict(wf1, latest) #' p diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 14de71842..993ebba28 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -21,7 +21,7 @@ #' #' f <- epipredict:::frosting() %>% layer_predict() %>% #' layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) -#' wf1 <- wf %>% add_frosting(f) +#' wf1 <- wf %>% epipredict:::add_frosting(f) #' #' p <- predict(wf1, latest) #' p diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index b243e1ea6..073b153c0 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -38,7 +38,7 @@ latest <- jhu \%>\% f <- epipredict:::frosting() \%>\% layer_predict() \%>\% layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) -wf1 <- wf \%>\% add_frosting(f) +wf1 <- wf \%>\% epipredict:::add_frosting(f) p <- predict(wf1, latest) p diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 6bbc07f1d..5d53acafc 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -34,7 +34,7 @@ latest <- jhu \%>\% f <- epipredict:::frosting() \%>\% layer_predict() \%>\% layer_add_target_date(ahead = 7) \%>\% layer_naomit(.pred) -wf1 <- wf \%>\% add_frosting(f) +wf1 <- wf \%>\% epipredict:::add_frosting(f) p <- predict(wf1, latest) p From 8780a360563c54ece164cb2cf7920eda361cfcc4 Mon Sep 17 00:00:00 2001 From: admin Date: Tue, 21 Jun 2022 17:09:44 -0700 Subject: [PATCH 08/39] Removed epipredict::: from doc --- R/layer_add_forecast_date.R | 4 ++-- R/layer_add_target_date.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 2b8f12a33..59a59e69b 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -19,9 +19,9 @@ #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' -#' f <- epipredict:::frosting() %>% layer_predict() %>% +#' f <- frosting() %>% layer_predict() %>% #' layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) -#' wf1 <- wf %>% epipredict:::add_frosting(f) +#' wf1 <- wf %>% add_frosting(f) #' #' p <- predict(wf1, latest) #' p diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 993ebba28..444669f39 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -19,9 +19,9 @@ #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' -#' f <- epipredict:::frosting() %>% layer_predict() %>% +#' f <- frosting() %>% layer_predict() %>% #' layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) -#' wf1 <- wf %>% epipredict:::add_frosting(f) +#' wf1 <- wf %>% add_frosting(f) #' #' p <- predict(wf1, latest) #' p From a64a54952ef64c02f2de4a65d9b2d8f6d82cdb14 Mon Sep 17 00:00:00 2001 From: admin Date: Tue, 21 Jun 2022 17:40:27 -0700 Subject: [PATCH 09/39] Removed id from user facing --- R/layer_add_forecast_date.R | 7 +++---- R/layer_add_target_date.R | 7 +++---- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 59a59e69b..5445a903e 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -26,17 +26,16 @@ #' p <- predict(wf1, latest) #' p layer_add_forecast_date <- - function(frosting, forecast_date = NULL, id = rand_id("add_forecast_date")) { + function(frosting, forecast_date = NULL) { add_layer( frosting, layer_add_forecast_date_new( - forecast_date = forecast_date, - id = id + forecast_date = forecast_date ) ) } -layer_add_forecast_date_new <- function(forecast_date, id) { +layer_add_forecast_date_new <- function(forecast_date, id = rand_id("add_forecast_date")) { layer("add_forecast_date", forecast_date = forecast_date, id = id) } diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 444669f39..8bf5300ce 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -26,17 +26,16 @@ #' p <- predict(wf1, latest) #' p layer_add_target_date <- - function(frosting, ahead = NULL, id = rand_id("add_target_date")) { + function(frosting, ahead = NULL) { add_layer( frosting, layer_add_target_date_new( - ahead = ahead, - id = id + ahead = ahead ) ) } -layer_add_target_date_new <- function(ahead, id) { +layer_add_target_date_new <- function(ahead, id = rand_id("add_target_date")) { layer("add_target_date", ahead = ahead, id = id) } From fcdddaf11bd3f98fcb12d112a641b150b01993ef Mon Sep 17 00:00:00 2001 From: admin Date: Tue, 21 Jun 2022 18:49:04 -0700 Subject: [PATCH 10/39] Setting up for changes to make once able to access the preprocessor --- R/layer_add_forecast_date.R | 27 +++++++++++++++++++++++---- R/layer_add_target_date.R | 3 +-- man/layer_add_forecast_date.Rd | 12 ++++-------- man/layer_add_target_date.Rd | 6 +++--- 4 files changed, 31 insertions(+), 17 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 5445a903e..9d2ae1a3d 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -2,7 +2,7 @@ #' #' @param frosting a `frosting` postprocessor #' @param forecast_date The forecast date to add as a column to the `epi_df`. -#' This must be specified by the user. +#' This must be specified by the user in the form "yyyy-mm-dd". #' @param id a random id string #' #' @return an updated `frosting` postprocessor @@ -40,9 +40,28 @@ layer_add_forecast_date_new <- function(forecast_date, id = rand_id("add_forecas } #' @export -slather.layer_add_forecast_date <- function(object, components, the_fit, ...) { - if(is.null(object$forecast_date)) stop("`forecast_date` must be specified.") - if(!is.character(object$forecast_date)) stop("`forecast_date` must be of class character.") +slather.layer_add_forecast_date <- function(object, components, ...) { + if(is.na(lubridate::ymd(object$forecast_date))) stop("specified `forecast_date` must be of format yyyy-mm-dd") + + last_rows_df <- new_data %>% # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? + dplyr::group_by(geo_value) %>% + dplyr::slice(dplyr::n()) + + max_time_value <- max(last_rows_df$time_value) + + as_of_date <- + as.Date(stringr::str_extract( + attributes(new_data)$metadata$as_of, # %% new_data change + "\\d{4}-\\d{2}-\\d{2}" + )) + + if (is.null(object$forecast_date)) { + forecast_date <- max_time_value + ahead ## %% need to be able to access recipe to get ahead here, yes? + warning("Set forecast_date equal to maximum time value plus ahead value.") + } + if (object$forecast_date < as_of_date) { + warning("forecast_date is less than the most recent update date of the data.") + } components$predictions <- dplyr::bind_cols(components$predictions, forecast_date = as.Date(object$forecast_date)) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 8bf5300ce..303189734 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -40,10 +40,9 @@ layer_add_target_date_new <- function(ahead, id = rand_id("add_target_date")) { } #' @export -slather.layer_add_target_date <- function(object, components, the_fit, ...) { +slather.layer_add_target_date <- function(object, components, ...) { if(is.null(object$ahead)) stop("`ahead` must be specified.") if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") - components$predictions <- dplyr::bind_cols(components$predictions, target_date = object$ahead + components$predictions$time_value) components diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 073b153c0..fe74327c4 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -4,17 +4,13 @@ \alias{layer_add_forecast_date} \title{Postprocessing step to add the forecast date} \usage{ -layer_add_forecast_date( - frosting, - forecast_date = NULL, - id = rand_id("add_forecast_date") -) +layer_add_forecast_date(frosting, forecast_date = NULL) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} \item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. -This must be specified by the user.} +This must be specified by the user in the form "yyyy-mm-dd".} \item{id}{a random id string} } @@ -36,9 +32,9 @@ wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) -f <- epipredict:::frosting() \%>\% layer_predict() \%>\% +f <- frosting() \%>\% layer_predict() \%>\% layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) -wf1 <- wf \%>\% epipredict:::add_frosting(f) +wf1 <- wf \%>\% add_frosting(f) p <- predict(wf1, latest) p diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 5d53acafc..ca654bddd 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -4,7 +4,7 @@ \alias{layer_add_target_date} \title{Postprocessing step to add the target date} \usage{ -layer_add_target_date(frosting, ahead = NULL, id = rand_id("add_target_date")) +layer_add_target_date(frosting, ahead = NULL) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} @@ -32,9 +32,9 @@ wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) -f <- epipredict:::frosting() \%>\% layer_predict() \%>\% +f <- frosting() \%>\% layer_predict() \%>\% layer_add_target_date(ahead = 7) \%>\% layer_naomit(.pred) -wf1 <- wf \%>\% epipredict:::add_frosting(f) +wf1 <- wf \%>\% add_frosting(f) p <- predict(wf1, latest) p From 0ae474ab2ca30fa8652ee5c2b5ba70fa9234c9a3 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 24 Jun 2022 18:57:47 -0700 Subject: [PATCH 11/39] Trying to see if recipe is accessible --- R/layer_add_forecast_date.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 9d2ae1a3d..25eb655b4 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -56,7 +56,7 @@ slather.layer_add_forecast_date <- function(object, components, ...) { )) if (is.null(object$forecast_date)) { - forecast_date <- max_time_value + ahead ## %% need to be able to access recipe to get ahead here, yes? + forecast_date <- max_time_value + ahead ## %% need to be able to access recipe to get ahead here, yes? warning("Set forecast_date equal to maximum time value plus ahead value.") } if (object$forecast_date < as_of_date) { @@ -65,5 +65,6 @@ slather.layer_add_forecast_date <- function(object, components, ...) { components$predictions <- dplyr::bind_cols(components$predictions, forecast_date = as.Date(object$forecast_date)) + test <<- components components } From ab795c1e766aa8563808990dc14f6dcb23d092ba Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 24 Jun 2022 20:38:08 -0700 Subject: [PATCH 12/39] testing forecast date layer --- R/layer_add_forecast_date.R | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 25eb655b4..0f22b299f 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -39,30 +39,9 @@ layer_add_forecast_date_new <- function(forecast_date, id = rand_id("add_forecas layer("add_forecast_date", forecast_date = forecast_date, id = id) } -#' @export slather.layer_add_forecast_date <- function(object, components, ...) { if(is.na(lubridate::ymd(object$forecast_date))) stop("specified `forecast_date` must be of format yyyy-mm-dd") - last_rows_df <- new_data %>% # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? - dplyr::group_by(geo_value) %>% - dplyr::slice(dplyr::n()) - - max_time_value <- max(last_rows_df$time_value) - - as_of_date <- - as.Date(stringr::str_extract( - attributes(new_data)$metadata$as_of, # %% new_data change - "\\d{4}-\\d{2}-\\d{2}" - )) - - if (is.null(object$forecast_date)) { - forecast_date <- max_time_value + ahead ## %% need to be able to access recipe to get ahead here, yes? - warning("Set forecast_date equal to maximum time value plus ahead value.") - } - if (object$forecast_date < as_of_date) { - warning("forecast_date is less than the most recent update date of the data.") - } - components$predictions <- dplyr::bind_cols(components$predictions, forecast_date = as.Date(object$forecast_date)) test <<- components From 5e79dc3ab1fa908d55355bfb0fecdfc5816903a5 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 24 Jun 2022 20:43:47 -0700 Subject: [PATCH 13/39] Re-added forecast date --- R/layer_add_forecast_date.R | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 0f22b299f..aab241519 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -42,8 +42,27 @@ layer_add_forecast_date_new <- function(forecast_date, id = rand_id("add_forecas slather.layer_add_forecast_date <- function(object, components, ...) { if(is.na(lubridate::ymd(object$forecast_date))) stop("specified `forecast_date` must be of format yyyy-mm-dd") + last_rows_df <- new_data %>% # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? + dplyr::group_by(geo_value) %>% + dplyr::slice(dplyr::n()) + + max_time_value <- max(last_rows_df$time_value) + + as_of_date <- + as.Date(stringr::str_extract( + attributes(new_data)$metadata$as_of, # %% new_data change + "\\d{4}-\\d{2}-\\d{2}" + )) + + if (is.null(object$forecast_date)) { + forecast_date <- max_time_value + ahead ## %% need to be able to access recipe to get ahead here, yes? + warning("Set forecast_date equal to maximum time value plus ahead value.") + } + if (object$forecast_date < as_of_date) { + warning("forecast_date is less than the most recent update date of the data.") + } + components$predictions <- dplyr::bind_cols(components$predictions, forecast_date = as.Date(object$forecast_date)) - test <<- components components } From 0c21a6d9477095b40629aa87b77b8fe203921a93 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 1 Jul 2022 15:24:43 -0700 Subject: [PATCH 14/39] testing --- R/layer_add_target_date.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 303189734..a317f6465 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -40,9 +40,12 @@ layer_add_target_date_new <- function(ahead, id = rand_id("add_target_date")) { } #' @export -slather.layer_add_target_date <- function(object, components, ...) { - if(is.null(object$ahead)) stop("`ahead` must be specified.") - if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") +slather.layer_add_target_date <- function(object, components, the_recipe, ...) { + test5 <<- components + object <<- object + recipe <<- the_recipe + #if(is.null(object$ahead)) stop("`ahead` must be specified.") + #if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") components$predictions <- dplyr::bind_cols(components$predictions, target_date = object$ahead + components$predictions$time_value) components From c3491dbdfdde8f6db3f3766a7abf1df29fc79b69 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 1 Jul 2022 15:43:21 -0700 Subject: [PATCH 15/39] Put id back to where it was before --- R/layer_add_target_date.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index a317f6465..df7062c2c 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -30,20 +30,21 @@ layer_add_target_date <- add_layer( frosting, layer_add_target_date_new( - ahead = ahead + ahead = ahead, + id = rand_id("add_target_date") ) ) } -layer_add_target_date_new <- function(ahead, id = rand_id("add_target_date")) { +layer_add_target_date_new <- function(ahead, id = id) { layer("add_target_date", ahead = ahead, id = id) } #' @export slather.layer_add_target_date <- function(object, components, the_recipe, ...) { - test5 <<- components - object <<- object - recipe <<- the_recipe + #test5 <<- components + #object <<- object + #recipe <<- the_recipe #if(is.null(object$ahead)) stop("`ahead` must be specified.") #if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") components$predictions <- dplyr::bind_cols(components$predictions, From 882a493813f97ed08f4b5ece6e5206fce0e94452 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 1 Jul 2022 15:54:27 -0700 Subject: [PATCH 16/39] Add id --- R/layer_add_target_date.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index df7062c2c..bf2b0d689 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -26,12 +26,12 @@ #' p <- predict(wf1, latest) #' p layer_add_target_date <- - function(frosting, ahead = NULL) { + function(frosting, ahead = NULL, id = rand_id("add_target_date")) { add_layer( frosting, layer_add_target_date_new( ahead = ahead, - id = rand_id("add_target_date") + id = id ) ) } @@ -42,12 +42,12 @@ layer_add_target_date_new <- function(ahead, id = id) { #' @export slather.layer_add_target_date <- function(object, components, the_recipe, ...) { - #test5 <<- components - #object <<- object - #recipe <<- the_recipe + test5 <<- components + object <<- object + recipe <<- the_recipe #if(is.null(object$ahead)) stop("`ahead` must be specified.") #if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") - components$predictions <- dplyr::bind_cols(components$predictions, - target_date = object$ahead + components$predictions$time_value) + #components$predictions <- dplyr::bind_cols(components$predictions, + # target_date = object$ahead + components$predictions$time_value) components } From 12351d3a27a609960a03c32428a8e4dc3b09a56a Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 1 Jul 2022 19:21:55 -0700 Subject: [PATCH 17/39] Updated documentation & fixed fun --- NAMESPACE | 5 ++--- R/layer_add_target_date.R | 24 ++++++++++----------- man/create_layer.Rd | 4 ++-- man/layer_add_target_date.Rd | 8 +++---- tests/testthat/test-layer_add_target_date.R | 4 ++-- 5 files changed, 21 insertions(+), 24 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 33330a1e5..ad6c4c544 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,10 +23,9 @@ S3method(print,epi_workflow) S3method(print,frosting) S3method(print,step_epi_ahead) S3method(print,step_epi_lag) -S3method(slather,layer_add_forecast_date) -S3method(slather,layer_add_target_date) S3method(refresh_blueprint,default_epi_recipe_blueprint) S3method(run_mold,default_epi_recipe_blueprint) +S3method(slather,layer_add_target_date) S3method(slather,layer_naomit) S3method(slather,layer_predict) S3method(slather,layer_residual_quantile) @@ -59,9 +58,9 @@ export(knn_iteraive_ar_args_list) export(knn_iteraive_ar_forecaster) export(knnarx_args_list) export(knnarx_forecaster) +export(layer) export(layer_add_forecast_date) export(layer_add_target_date) -export(layer) export(layer_naomit) export(layer_predict) export(layer_residual_quantile) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index bf2b0d689..2c1845655 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -20,34 +20,32 @@ #' dplyr::filter(time_value >= max(time_value) - 14) #' #' f <- frosting() %>% layer_predict() %>% -#' layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) +#' layer_add_target_date() %>% layer_naomit(.pred) #' wf1 <- wf %>% add_frosting(f) #' #' p <- predict(wf1, latest) #' p layer_add_target_date <- - function(frosting, ahead = NULL, id = rand_id("add_target_date")) { + function(frosting, id = rand_id("add_target_date")) { add_layer( frosting, layer_add_target_date_new( - ahead = ahead, id = id ) ) } -layer_add_target_date_new <- function(ahead, id = id) { - layer("add_target_date", ahead = ahead, id = id) +layer_add_target_date_new <- function(id = id) { + layer("add_target_date", id = id) } #' @export -slather.layer_add_target_date <- function(object, components, the_recipe, ...) { - test5 <<- components - object <<- object - recipe <<- the_recipe - #if(is.null(object$ahead)) stop("`ahead` must be specified.") - #if(!is.numeric(object$ahead)) stop("`ahead` must be a numeric value.") - #components$predictions <- dplyr::bind_cols(components$predictions, - # target_date = object$ahead + components$predictions$time_value) +slather.layer_add_target_date <- function(object, components, ...) { + ahead <- as.numeric(stringr::str_extract(names(components$mold$outcomes), + "(?<=ahead_)\\d+")) + + if(is.na(object$ahead)) stop("`ahead` must be specified in preprocessing.") + components$predictions <- dplyr::bind_cols(components$predictions, + target_date = ahead + components$predictions$time_value) components } diff --git a/man/create_layer.Rd b/man/create_layer.Rd index 81f5e33b0..7917e8854 100644 --- a/man/create_layer.Rd +++ b/man/create_layer.Rd @@ -9,9 +9,9 @@ create_layer(name = NULL, open = rlang::is_interactive()) \arguments{ \item{name}{Either a name without extension, or \code{NULL} to create the paired file based on currently open file in the script editor. If -the \verb{R/} file is open, \code{use_test()} will create/open the corresponding +the R file is open, \code{use_test()} will create/open the corresponding test file; if the test file is open, \code{use_r()} will create/open the -corresponding \verb{R/} file.} +corresponding R file.} \item{open}{Whether to open the file for interactive editing.} } diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index ca654bddd..9d5be76a9 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -4,15 +4,15 @@ \alias{layer_add_target_date} \title{Postprocessing step to add the target date} \usage{ -layer_add_target_date(frosting, ahead = NULL) +layer_add_target_date(frosting, id = rand_id("add_target_date")) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} +\item{id}{a random id string} + \item{ahead}{A positive integer to add to \code{time_value} to get the target date. This must be specified by the user.} - -\item{id}{a random id string} } \value{ an updated \code{frosting} postprocessor @@ -33,7 +33,7 @@ latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) f <- frosting() \%>\% layer_predict() \%>\% - layer_add_target_date(ahead = 7) \%>\% layer_naomit(.pred) + layer_add_target_date() \%>\% layer_naomit(.pred) wf1 <- wf \%>\% add_frosting(f) p <- predict(wf1, latest) diff --git a/tests/testthat/test-layer_add_target_date.R b/tests/testthat/test-layer_add_target_date.R index 0de525b01..d0bd59eb5 100644 --- a/tests/testthat/test-layer_add_target_date.R +++ b/tests/testthat/test-layer_add_target_date.R @@ -1,8 +1,8 @@ jhu <- case_death_rate_subset %>% dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ak", "ca", "ny")) r <- epi_recipe(jhu) %>% - step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% - step_epi_ahead(death_rate, ahead = 7) %>% + step_epi_lag(death_rate, lag = c(0)) %>% + step_epi_ahead(death_rate, ahead = 15) %>% step_naomit(all_predictors()) %>% step_naomit(all_outcomes(), skip = TRUE) wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) From 606fd89d9340b820ee9487da29cf4dce89b53ca8 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 1 Jul 2022 19:23:02 -0700 Subject: [PATCH 18/39] removed object --- R/layer_add_target_date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 2c1845655..e9ba59a83 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -44,7 +44,7 @@ slather.layer_add_target_date <- function(object, components, ...) { ahead <- as.numeric(stringr::str_extract(names(components$mold$outcomes), "(?<=ahead_)\\d+")) - if(is.na(object$ahead)) stop("`ahead` must be specified in preprocessing.") + if(is.na(ahead)) stop("`ahead` must be specified in preprocessing.") components$predictions <- dplyr::bind_cols(components$predictions, target_date = ahead + components$predictions$time_value) components From af49a7e4263c140add8492a59f993e21f42f4796 Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 2 Jul 2022 01:17:35 -0700 Subject: [PATCH 19/39] Updated doc and ex --- R/layer_add_forecast_date.R | 66 +++++++++++++++---- R/layer_add_target_date.R | 7 +- man/layer_add_forecast_date.Rd | 48 ++++++++++++-- man/layer_add_target_date.Rd | 8 ++- tests/testthat/test-layer_add_forecast_date.R | 42 +++++++++--- tests/testthat/test-layer_add_target_date.R | 19 ++---- 6 files changed, 143 insertions(+), 47 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index aab241519..02ba4ce9a 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -2,10 +2,21 @@ #' #' @param frosting a `frosting` postprocessor #' @param forecast_date The forecast date to add as a column to the `epi_df`. -#' This must be specified by the user in the form "yyyy-mm-dd". +#' This should be specified in the form "yyyy-mm-dd". +#' @param newdata The rectangular data object, such as a data frame, for which +#' one wants to make predictions. This should be the same `newdata` to be +#' used in `predict`. #' @param id a random id string #' #' @return an updated `frosting` postprocessor +#' +#' @details To use this function, either specify an ahead value in +#' preprocessing and leave the forecast date unspecifed here or simply specify +#' a forecast date here. In the former, the forecast date will be set as the +#' maximum time value plus the ahead value. In that case, as well as in the case +#' when the forecast date is less than the most recent update date of the data +#' (ie. the `as_of` value), an appropriate warning will be thrown. +#' #' @export #' @examples #' jhu <- case_death_rate_subset %>% @@ -19,30 +30,53 @@ #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' +#' # Specify a `forecast_date` that is greater than or equal to `as_of` date #' f <- frosting() %>% layer_predict() %>% -#' layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) +#' layer_add_forecast_date(forecast_date = "2022-05-31", newdata = latest) %>% +#' layer_naomit(.pred) #' wf1 <- wf %>% add_frosting(f) #' -#' p <- predict(wf1, latest) -#' p +#' p1 <- predict(wf1, latest) +#' p1 +#' +#' # Specify a `forecast_date` that is less than `as_of` date +#' f2 <- frosting() %>% +#' layer_predict() %>% +#' layer_add_forecast_date(forecast_date = "2021-12-31", newdata = latest) %>% +#' layer_naomit(.pred) +#' wf2 <- wf %>% add_frosting(f2) +#' +#' p2 <- predict(wf2, latest) +#' p2 +#' # Do not specify a forecast_date in `layer_add_forecast_date()` +#' f3 <- frosting() %>% +#' layer_predict() %>% +#' layer_add_forecast_date(newdata = latest) %>% +#' layer_naomit(.pred) +#' wf3 <- wf %>% add_frosting(f3) +#' +#' p3 <- predict(wf3, latest) +#' p3 layer_add_forecast_date <- - function(frosting, forecast_date = NULL) { + function(frosting, forecast_date = NULL, newdata = NULL, id = rand_id("add_forecast_date")) { add_layer( frosting, layer_add_forecast_date_new( - forecast_date = forecast_date + forecast_date = forecast_date, + newdata = newdata, + id = id ) ) } -layer_add_forecast_date_new <- function(forecast_date, id = rand_id("add_forecast_date")) { - layer("add_forecast_date", forecast_date = forecast_date, id = id) +layer_add_forecast_date_new <- function(forecast_date, newdata, id = id) { + layer("add_forecast_date", forecast_date = forecast_date, newdata = newdata, id = id) } slather.layer_add_forecast_date <- function(object, components, ...) { - if(is.na(lubridate::ymd(object$forecast_date))) stop("specified `forecast_date` must be of format yyyy-mm-dd") + if (is.null(object$newdata)) stop("`newdata` must be specified as an argument.") - last_rows_df <- new_data %>% # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? + last_rows_df <- object$newdata %>% # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? dplyr::group_by(geo_value) %>% dplyr::slice(dplyr::n()) @@ -50,19 +84,23 @@ slather.layer_add_forecast_date <- function(object, components, ...) { as_of_date <- as.Date(stringr::str_extract( - attributes(new_data)$metadata$as_of, # %% new_data change + attributes(object$newdata)$metadata$as_of, # %% new_data change "\\d{4}-\\d{2}-\\d{2}" )) + ahead <- as.numeric(stringr::str_extract(names(components$mold$outcomes), + "(?<=ahead_)\\d+")) if (is.null(object$forecast_date)) { - forecast_date <- max_time_value + ahead ## %% need to be able to access recipe to get ahead here, yes? - warning("Set forecast_date equal to maximum time value plus ahead value.") + object$forecast_date <- max_time_value + ahead + warning("Set forecast_date equal to maximum time value plus ahead value.") } + if (object$forecast_date < as_of_date) { - warning("forecast_date is less than the most recent update date of the data.") + warning("forecast_date is less than the most recent update date of the data.") } components$predictions <- dplyr::bind_cols(components$predictions, forecast_date = as.Date(object$forecast_date)) components } + diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index e9ba59a83..c1fd5150f 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -1,11 +1,14 @@ #' Postprocessing step to add the target date #' #' @param frosting a `frosting` postprocessor -#' @param ahead A positive integer to add to `time_value` to get the target date. -#' This must be specified by the user. #' @param id a random id string #' #' @return an updated `frosting` postprocessor +#' +#' @details This function assumes that a value for `ahead` +#' has been specified in a preprocessing step (most likely in `step_epi_ahead`). +#' Then, `ahead` is added to `time_value` to get the target date. +#' #' @export #' @examples #' jhu <- case_death_rate_subset %>% diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index fe74327c4..cf3833c4a 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -4,13 +4,22 @@ \alias{layer_add_forecast_date} \title{Postprocessing step to add the forecast date} \usage{ -layer_add_forecast_date(frosting, forecast_date = NULL) +layer_add_forecast_date( + frosting, + forecast_date = NULL, + newdata = NULL, + id = rand_id("add_forecast_date") +) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} \item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. -This must be specified by the user in the form "yyyy-mm-dd".} +This should be specified in the form "yyyy-mm-dd".} + +\item{newdata}{The rectangular data object, such as a data frame, for which +one wants to make predictions. This should be the same \code{newdata} to be +used in \code{predict}.} \item{id}{a random id string} } @@ -20,6 +29,14 @@ an updated \code{frosting} postprocessor \description{ Postprocessing step to add the forecast date } +\details{ +To use this function, either specify an ahead value in +preprocessing and leave the forecast date unspecifed here or simply specify +a forecast date here. In the former, the forecast date will be set as the +maximum time value plus the ahead value. In that case, as well as in the case +when the forecast date is less than the most recent update date of the data +(ie. the \code{as_of} value), an appropriate warning will be thrown. +} \examples{ jhu <- case_death_rate_subset \%>\% dplyr::filter(time_value > "2021-11-01", geo_value \%in\% c("ak", "ca", "ny")) @@ -32,10 +49,31 @@ wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) +# Specify a `forecast_date` that is greater than or equal to `as_of` date f <- frosting() \%>\% layer_predict() \%>\% - layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) + layer_add_forecast_date(forecast_date = "2022-05-31", newdata = latest) \%>\% + layer_naomit(.pred) wf1 <- wf \%>\% add_frosting(f) -p <- predict(wf1, latest) -p +p1 <- predict(wf1, latest) +p1 + +# Specify a `forecast_date` that is less than `as_of` date +f2 <- frosting() \%>\% + layer_predict() \%>\% + layer_add_forecast_date(forecast_date = "2021-12-31", newdata = latest) \%>\% + layer_naomit(.pred) +wf2 <- wf \%>\% add_frosting(f2) + +p2 <- predict(wf2, latest) +p2 +# Do not specify a forecast_date in `layer_add_forecast_date()` + f3 <- frosting() \%>\% + layer_predict() \%>\% + layer_add_forecast_date(newdata = latest) \%>\% + layer_naomit(.pred) +wf3 <- wf \%>\% add_frosting(f3) + +p3 <- predict(wf3, latest) +p3 } diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 9d5be76a9..c72fe891b 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -10,9 +10,6 @@ layer_add_target_date(frosting, id = rand_id("add_target_date")) \item{frosting}{a \code{frosting} postprocessor} \item{id}{a random id string} - -\item{ahead}{A positive integer to add to \code{time_value} to get the target date. -This must be specified by the user.} } \value{ an updated \code{frosting} postprocessor @@ -20,6 +17,11 @@ an updated \code{frosting} postprocessor \description{ Postprocessing step to add the target date } +\details{ +This function assumes that a value for \code{ahead} +has been specified in a preprocessing step (most likely in \code{step_epi_ahead}). +Then, \code{ahead} is added to \code{time_value} to get the target date. +} \examples{ jhu <- case_death_rate_subset \%>\% dplyr::filter(time_value > "2021-11-01", geo_value \%in\% c("ak", "ca", "ny")) diff --git a/tests/testthat/test-layer_add_forecast_date.R b/tests/testthat/test-layer_add_forecast_date.R index 62c09ab5b..7e6f56fb8 100644 --- a/tests/testthat/test-layer_add_forecast_date.R +++ b/tests/testthat/test-layer_add_forecast_date.R @@ -9,11 +9,11 @@ wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) latest <- jhu %>% dplyr::filter(time_value >= max(time_value) - 14) -test_that("Specify a forecast_date in `layer_add_forecast_date()`", { +test_that("Specify a `forecast_date` that is greater than or equal to `as_of` date", { f <- frosting() %>% layer_predict() %>% - layer_add_forecast_date(forecast_date = "2021-12-31") %>% + layer_add_forecast_date(forecast_date = "2022-05-31", newdata = latest) %>% layer_naomit(.pred) wf1 <- wf %>% add_frosting(f) @@ -21,17 +21,41 @@ test_that("Specify a forecast_date in `layer_add_forecast_date()`", { expect_equal(ncol(p), 4L) expect_s3_class(p, "epi_df") expect_equal(nrow(p), 3L) - expect_equal(p$forecast_date, rep(as.Date("2021-12-31"), times = 3)) - expect_named(p, c("time_value", "geo_value", ".pred", "forecast_date")) + expect_equal(p$forecast_date, rep(as.Date("2022-05-31"), times = 3)) + expect_named(p, c("geo_value", "time_value", ".pred", "forecast_date")) }) -test_that("Fail to specify a forecast_date in `layer_add_forecast_date()`", { +test_that("Specify a `forecast_date` that is less than `as_of` date", { - f <- frosting() %>% + f2 <- frosting() %>% + layer_predict() %>% + layer_add_forecast_date(forecast_date = "2021-12-31", newdata = latest) %>% + layer_naomit(.pred) + wf2 <- wf %>% add_frosting(f2) + + expect_warning(p2 <- predict(wf2, latest), + "forecast_date is less than the most recent update date of the data.") + expect_equal(ncol(p2), 4L) + expect_s3_class(p2, "epi_df") + expect_equal(nrow(p2), 3L) + expect_equal(p2$forecast_date, rep(as.Date("2021-12-31"), times = 3)) + expect_named(p2, c("geo_value", "time_value", ".pred", "forecast_date")) +}) + +test_that("Do not specify a forecast_date in `layer_add_forecast_date()`", { + + f3 <- frosting() %>% layer_predict() %>% - layer_add_forecast_date() %>% + layer_add_forecast_date(newdata = latest) %>% layer_naomit(.pred) - wf2 <- wf %>% add_frosting(f) + wf3 <- wf %>% add_frosting(f3) - expect_error(predict(wf2, latest), "`forecast_date` must be specified") + w <- capture_warnings(p3 <- predict(wf3, latest)) + expect_equal(w[1], "Set forecast_date equal to maximum time value plus ahead value.") + expect_equal(w[2], "forecast_date is less than the most recent update date of the data.") + expect_equal(ncol(p3), 4L) + expect_s3_class(p3, "epi_df") + expect_equal(nrow(p3), 3L) + expect_equal(p3$forecast_date, rep(as.Date("2022-01-07"), times = 3)) + expect_named(p3, c("geo_value", "time_value", ".pred", "forecast_date")) }) diff --git a/tests/testthat/test-layer_add_target_date.R b/tests/testthat/test-layer_add_target_date.R index d0bd59eb5..241f8e8de 100644 --- a/tests/testthat/test-layer_add_target_date.R +++ b/tests/testthat/test-layer_add_target_date.R @@ -1,18 +1,18 @@ jhu <- case_death_rate_subset %>% dplyr::filter(time_value > "2021-11-01", geo_value %in% c("ak", "ca", "ny")) r <- epi_recipe(jhu) %>% - step_epi_lag(death_rate, lag = c(0)) %>% - step_epi_ahead(death_rate, ahead = 15) %>% + step_epi_lag(death_rate, lag = c(0, 7, 14)) %>% + step_epi_ahead(death_rate, ahead = 7) %>% step_naomit(all_predictors()) %>% step_naomit(all_outcomes(), skip = TRUE) wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) latest <- jhu %>% dplyr::filter(time_value >= max(time_value) - 14) -test_that("Specify ahead in `layer_add_target_date()`", { +test_that("Specify ahead in preprocessing", { f <- frosting() %>% layer_predict() %>% - layer_add_target_date(ahead = 7) %>% layer_naomit(.pred) + layer_add_target_date() %>% layer_naomit(.pred) wf1 <- wf %>% add_frosting(f) expect_silent(p <- predict(wf1, latest)) @@ -20,14 +20,5 @@ test_that("Specify ahead in `layer_add_target_date()`", { expect_s3_class(p, "epi_df") expect_equal(nrow(p), 3L) expect_equal(p$target_date, rep(as.Date("2022-01-07"), times = 3)) - expect_named(p, c("time_value", "geo_value", ".pred", "target_date")) -}) - -test_that("Fail to specify a ahead in `layer_add_target_date()`", { - - f <- frosting() %>% layer_predict() %>% - layer_add_target_date() %>% layer_naomit(.pred) - wf2 <- wf %>% add_frosting(f) - - expect_error(predict(wf2, latest), "`ahead` must be specified") + expect_named(p, c("geo_value", "time_value", ".pred", "target_date")) }) From b05cff5501f5db8425a54deaa690a72593192a15 Mon Sep 17 00:00:00 2001 From: admin Date: Sat, 2 Jul 2022 01:33:11 -0700 Subject: [PATCH 20/39] added import --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 31418dc5d..8b7df7fc4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,6 +25,7 @@ Imports: purrr, recipes (>= 0.2.0.9001), rlang, + stringr, stats, tensr, tibble, From 33b80180e8f9dcfd9e3ecd98ae095f590ab3989b Mon Sep 17 00:00:00 2001 From: admin Date: Tue, 5 Jul 2022 20:08:53 -0700 Subject: [PATCH 21/39] Got ahead from recipe --- R/layer_add_target_date.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index c1fd5150f..0b5f41c27 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -43,9 +43,8 @@ layer_add_target_date_new <- function(id = id) { } #' @export -slather.layer_add_target_date <- function(object, components, ...) { - ahead <- as.numeric(stringr::str_extract(names(components$mold$outcomes), - "(?<=ahead_)\\d+")) +slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { + ahead <- the_recipe$steps[[2]][["ahead"]] if(is.na(ahead)) stop("`ahead` must be specified in preprocessing.") components$predictions <- dplyr::bind_cols(components$predictions, From 235cba8994b327b40bb8041238c2f36a6c355d3f Mon Sep 17 00:00:00 2001 From: admin Date: Tue, 5 Jul 2022 21:32:28 -0700 Subject: [PATCH 22/39] some updates to forecast_date script --- R/layer_add_forecast_date.R | 25 ++++++++++--------------- R/layer_add_target_date.R | 2 ++ 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 02ba4ce9a..f9825020d 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -73,30 +73,25 @@ layer_add_forecast_date_new <- function(forecast_date, newdata, id = id) { layer("add_forecast_date", forecast_date = forecast_date, newdata = newdata, id = id) } -slather.layer_add_forecast_date <- function(object, components, ...) { +#' @export +slather.layer_add_forecast_date <- function(object, components, the_fit, the_recipe, ...) { if (is.null(object$newdata)) stop("`newdata` must be specified as an argument.") - last_rows_df <- object$newdata %>% # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? - dplyr::group_by(geo_value) %>% - dplyr::slice(dplyr::n()) + newdata <- object$newdata # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? + + max_time_value <- max(newdata$time_value) - max_time_value <- max(last_rows_df$time_value) + as_of_date <- as.Date.POSIXct(attributes(object$newdata)$metadata$as_of) # %% new_data change - as_of_date <- - as.Date(stringr::str_extract( - attributes(object$newdata)$metadata$as_of, # %% new_data change - "\\d{4}-\\d{2}-\\d{2}" - )) + ahead <- the_recipe$steps[[2]][["ahead"]] - ahead <- as.numeric(stringr::str_extract(names(components$mold$outcomes), - "(?<=ahead_)\\d+")) if (is.null(object$forecast_date)) { - object$forecast_date <- max_time_value + ahead - warning("Set forecast_date equal to maximum time value plus ahead value.") + object$forecast_date <- max_time_value + ahead + warning("Set forecast_date equal to maximum time value plus ahead value.") } if (object$forecast_date < as_of_date) { - warning("forecast_date is less than the most recent update date of the data.") + warning("forecast_date is less than the most recent update date of the data.") } components$predictions <- dplyr::bind_cols(components$predictions, diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 0b5f41c27..5c62e3cce 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -44,6 +44,8 @@ layer_add_target_date_new <- function(id = id) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { + the_fit <<- the_fit + the_recipe <<- the_recipe ahead <- the_recipe$steps[[2]][["ahead"]] if(is.na(ahead)) stop("`ahead` must be specified in preprocessing.") From b608c2e7f767e3ff768c41a45a98d54648fc5331 Mon Sep 17 00:00:00 2001 From: admin Date: Wed, 6 Jul 2022 13:56:50 -0700 Subject: [PATCH 23/39] Fixed layer_add_forecast_date to remove parameter for newdata --- NAMESPACE | 1 + R/layer_add_forecast_date.R | 23 +++++++------------ man/layer_add_forecast_date.Rd | 11 +++------ tests/testthat/test-layer_add_forecast_date.R | 8 +++---- 4 files changed, 16 insertions(+), 27 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ad6c4c544..e0733cc77 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ S3method(print,step_epi_ahead) S3method(print,step_epi_lag) S3method(refresh_blueprint,default_epi_recipe_blueprint) S3method(run_mold,default_epi_recipe_blueprint) +S3method(slather,layer_add_forecast_date) S3method(slather,layer_add_target_date) S3method(slather,layer_naomit) S3method(slather,layer_predict) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index f9825020d..143ef826b 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -3,9 +3,6 @@ #' @param frosting a `frosting` postprocessor #' @param forecast_date The forecast date to add as a column to the `epi_df`. #' This should be specified in the form "yyyy-mm-dd". -#' @param newdata The rectangular data object, such as a data frame, for which -#' one wants to make predictions. This should be the same `newdata` to be -#' used in `predict`. #' @param id a random id string #' #' @return an updated `frosting` postprocessor @@ -32,7 +29,7 @@ #' #' # Specify a `forecast_date` that is greater than or equal to `as_of` date #' f <- frosting() %>% layer_predict() %>% -#' layer_add_forecast_date(forecast_date = "2022-05-31", newdata = latest) %>% +#' layer_add_forecast_date(forecast_date = "2022-05-31") %>% #' layer_naomit(.pred) #' wf1 <- wf %>% add_frosting(f) #' @@ -42,7 +39,7 @@ #' # Specify a `forecast_date` that is less than `as_of` date #' f2 <- frosting() %>% #' layer_predict() %>% -#' layer_add_forecast_date(forecast_date = "2021-12-31", newdata = latest) %>% +#' layer_add_forecast_date(forecast_date = "2021-12-31") %>% #' layer_naomit(.pred) #' wf2 <- wf %>% add_frosting(f2) #' @@ -51,37 +48,33 @@ #' # Do not specify a forecast_date in `layer_add_forecast_date()` #' f3 <- frosting() %>% #' layer_predict() %>% -#' layer_add_forecast_date(newdata = latest) %>% +#' layer_add_forecast_date() %>% #' layer_naomit(.pred) #' wf3 <- wf %>% add_frosting(f3) #' #' p3 <- predict(wf3, latest) #' p3 layer_add_forecast_date <- - function(frosting, forecast_date = NULL, newdata = NULL, id = rand_id("add_forecast_date")) { + function(frosting, forecast_date = NULL, id = rand_id("add_forecast_date")) { add_layer( frosting, layer_add_forecast_date_new( forecast_date = forecast_date, - newdata = newdata, id = id ) ) } -layer_add_forecast_date_new <- function(forecast_date, newdata, id = id) { - layer("add_forecast_date", forecast_date = forecast_date, newdata = newdata, id = id) +layer_add_forecast_date_new <- function(forecast_date, id = id) { + layer("add_forecast_date", forecast_date = forecast_date, id = id) } #' @export slather.layer_add_forecast_date <- function(object, components, the_fit, the_recipe, ...) { - if (is.null(object$newdata)) stop("`newdata` must be specified as an argument.") - newdata <- object$newdata # %% new_data for forecast_date needed here... perhaps this is components or components$forged$predictors here??? + max_time_value <- max(components$keys$time_value) - max_time_value <- max(newdata$time_value) - - as_of_date <- as.Date.POSIXct(attributes(object$newdata)$metadata$as_of) # %% new_data change + as_of_date <- as.Date.POSIXct(attributes(components$keys)$metadata$as_of) ahead <- the_recipe$steps[[2]][["ahead"]] diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index cf3833c4a..6ab504804 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -7,7 +7,6 @@ layer_add_forecast_date( frosting, forecast_date = NULL, - newdata = NULL, id = rand_id("add_forecast_date") ) } @@ -17,10 +16,6 @@ layer_add_forecast_date( \item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. This should be specified in the form "yyyy-mm-dd".} -\item{newdata}{The rectangular data object, such as a data frame, for which -one wants to make predictions. This should be the same \code{newdata} to be -used in \code{predict}.} - \item{id}{a random id string} } \value{ @@ -51,7 +46,7 @@ latest <- jhu \%>\% # Specify a `forecast_date` that is greater than or equal to `as_of` date f <- frosting() \%>\% layer_predict() \%>\% - layer_add_forecast_date(forecast_date = "2022-05-31", newdata = latest) \%>\% + layer_add_forecast_date(forecast_date = "2022-05-31") \%>\% layer_naomit(.pred) wf1 <- wf \%>\% add_frosting(f) @@ -61,7 +56,7 @@ p1 # Specify a `forecast_date` that is less than `as_of` date f2 <- frosting() \%>\% layer_predict() \%>\% - layer_add_forecast_date(forecast_date = "2021-12-31", newdata = latest) \%>\% + layer_add_forecast_date(forecast_date = "2021-12-31") \%>\% layer_naomit(.pred) wf2 <- wf \%>\% add_frosting(f2) @@ -70,7 +65,7 @@ p2 # Do not specify a forecast_date in `layer_add_forecast_date()` f3 <- frosting() \%>\% layer_predict() \%>\% - layer_add_forecast_date(newdata = latest) \%>\% + layer_add_forecast_date() \%>\% layer_naomit(.pred) wf3 <- wf \%>\% add_frosting(f3) diff --git a/tests/testthat/test-layer_add_forecast_date.R b/tests/testthat/test-layer_add_forecast_date.R index 7e6f56fb8..c435af7a0 100644 --- a/tests/testthat/test-layer_add_forecast_date.R +++ b/tests/testthat/test-layer_add_forecast_date.R @@ -13,7 +13,7 @@ test_that("Specify a `forecast_date` that is greater than or equal to `as_of` da f <- frosting() %>% layer_predict() %>% - layer_add_forecast_date(forecast_date = "2022-05-31", newdata = latest) %>% + layer_add_forecast_date(forecast_date = "2022-05-31") %>% layer_naomit(.pred) wf1 <- wf %>% add_frosting(f) @@ -29,7 +29,7 @@ test_that("Specify a `forecast_date` that is less than `as_of` date", { f2 <- frosting() %>% layer_predict() %>% - layer_add_forecast_date(forecast_date = "2021-12-31", newdata = latest) %>% + layer_add_forecast_date(forecast_date = "2021-12-31") %>% layer_naomit(.pred) wf2 <- wf %>% add_frosting(f2) @@ -46,7 +46,7 @@ test_that("Do not specify a forecast_date in `layer_add_forecast_date()`", { f3 <- frosting() %>% layer_predict() %>% - layer_add_forecast_date(newdata = latest) %>% + layer_add_forecast_date() %>% layer_naomit(.pred) wf3 <- wf %>% add_frosting(f3) @@ -56,6 +56,6 @@ test_that("Do not specify a forecast_date in `layer_add_forecast_date()`", { expect_equal(ncol(p3), 4L) expect_s3_class(p3, "epi_df") expect_equal(nrow(p3), 3L) - expect_equal(p3$forecast_date, rep(as.Date("2022-01-07"), times = 3)) + expect_equal(p3$forecast_date, rep(as.Date("2022-01-21"), times = 3)) expect_named(p3, c("geo_value", "time_value", ".pred", "forecast_date")) }) From ddf3d9452e1f452a99a1b466bc11070d2e5a93d7 Mon Sep 17 00:00:00 2001 From: admin Date: Wed, 6 Jul 2022 14:19:48 -0700 Subject: [PATCH 24/39] Added more details --- R/layer_add_forecast_date.R | 3 ++- man/layer_add_forecast_date.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 143ef826b..efe46ffbd 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -10,7 +10,8 @@ #' @details To use this function, either specify an ahead value in #' preprocessing and leave the forecast date unspecifed here or simply specify #' a forecast date here. In the former, the forecast date will be set as the -#' maximum time value plus the ahead value. In that case, as well as in the case +#' maximum time value in the test data (after any processing has been applied) +#' plus the ahead value. In that case, as well as in the case #' when the forecast date is less than the most recent update date of the data #' (ie. the `as_of` value), an appropriate warning will be thrown. #' diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 6ab504804..28e930e4f 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -28,7 +28,8 @@ Postprocessing step to add the forecast date To use this function, either specify an ahead value in preprocessing and leave the forecast date unspecifed here or simply specify a forecast date here. In the former, the forecast date will be set as the -maximum time value plus the ahead value. In that case, as well as in the case +maximum time value in the test data (after any processing has been applied) +plus the ahead value. In that case, as well as in the case when the forecast date is less than the most recent update date of the data (ie. the \code{as_of} value), an appropriate warning will be thrown. } From 8726dd9fed7cf9a23938065f0ad18351244df997 Mon Sep 17 00:00:00 2001 From: admin Date: Thu, 7 Jul 2022 14:53:08 -0700 Subject: [PATCH 25/39] Changed around spacing of doc. --- R/layer_add_forecast_date.R | 4 ++-- man/layer_add_forecast_date.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index efe46ffbd..3f2e11fdc 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -11,8 +11,8 @@ #' preprocessing and leave the forecast date unspecifed here or simply specify #' a forecast date here. In the former, the forecast date will be set as the #' maximum time value in the test data (after any processing has been applied) -#' plus the ahead value. In that case, as well as in the case -#' when the forecast date is less than the most recent update date of the data +#' plus the ahead value. In that case, as well as in the case when the +#' forecast date is less than the most recent update date of the data #' (ie. the `as_of` value), an appropriate warning will be thrown. #' #' @export diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 28e930e4f..2afcf0e35 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -29,8 +29,8 @@ To use this function, either specify an ahead value in preprocessing and leave the forecast date unspecifed here or simply specify a forecast date here. In the former, the forecast date will be set as the maximum time value in the test data (after any processing has been applied) -plus the ahead value. In that case, as well as in the case -when the forecast date is less than the most recent update date of the data +plus the ahead value. In that case, as well as in the case when the +forecast date is less than the most recent update date of the data (ie. the \code{as_of} value), an appropriate warning will be thrown. } \examples{ From 2ebf283d62cc1f6cfbc097753822c9aef3b0a074 Mon Sep 17 00:00:00 2001 From: admin Date: Thu, 7 Jul 2022 18:01:51 -0700 Subject: [PATCH 26/39] Updates as per comments left --- DESCRIPTION | 1 - R/layer_add_forecast_date.R | 21 ++++++++++--------- R/layer_add_target_date.R | 21 +++++++++++++------ man/layer_add_forecast_date.Rd | 18 +++++++++------- man/layer_add_target_date.Rd | 13 ++++++++++-- tests/testthat/test-layer_add_forecast_date.R | 5 ++--- 6 files changed, 49 insertions(+), 30 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8b7df7fc4..31418dc5d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,6 @@ Imports: purrr, recipes (>= 0.2.0.9001), rlang, - stringr, stats, tensr, tibble, diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 3f2e11fdc..f15cf954f 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -2,18 +2,20 @@ #' #' @param frosting a `frosting` postprocessor #' @param forecast_date The forecast date to add as a column to the `epi_df`. -#' This should be specified in the form "yyyy-mm-dd". +#' This should be specified in the form "yyyy-mm-dd". Note that when the +#' forecast date is left unspecified, it is set to the maximum time value plus +#' the ahead value from preprocessing. #' @param id a random id string #' #' @return an updated `frosting` postprocessor #' -#' @details To use this function, either specify an ahead value in -#' preprocessing and leave the forecast date unspecifed here or simply specify -#' a forecast date here. In the former, the forecast date will be set as the -#' maximum time value in the test data (after any processing has been applied) -#' plus the ahead value. In that case, as well as in the case when the -#' forecast date is less than the most recent update date of the data -#' (ie. the `as_of` value), an appropriate warning will be thrown. +#' @details To use this function, either specify a forecast date or specify an +#' ahead value in preprocessing and leave the forecast date unspecifed here. +#' In the latter, the forecast date will be set as the maximum time value +#' in the test data (after any processing has been applied) +#' plus the ahead value. In any case, when the forecast date is less than the +#' most recent update date of the data (ie. the `as_of` value), an appropriate +#' warning will be thrown. #' #' @export #' @examples @@ -75,13 +77,12 @@ slather.layer_add_forecast_date <- function(object, components, the_fit, the_rec max_time_value <- max(components$keys$time_value) - as_of_date <- as.Date.POSIXct(attributes(components$keys)$metadata$as_of) + as_of_date <- as.Date(attributes(components$keys)$metadata$as_of) ahead <- the_recipe$steps[[2]][["ahead"]] if (is.null(object$forecast_date)) { object$forecast_date <- max_time_value + ahead - warning("Set forecast_date equal to maximum time value plus ahead value.") } if (object$forecast_date < as_of_date) { diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 5c62e3cce..a77714910 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -1,11 +1,15 @@ #' Postprocessing step to add the target date #' #' @param frosting a `frosting` postprocessor +#' @param target_date The target date to add as a column to the `epi_df`. +#' By default, this is `time_value` plus `ahead`, where `ahead` has +#' been specified in preprocessing (most likely in `step_epi_ahead`). +#' The user may override this with a date in the form "yyyy-mm-dd". #' @param id a random id string #' #' @return an updated `frosting` postprocessor #' -#' @details This function assumes that a value for `ahead` +#' @details By default, this function assumes that a value for `ahead` #' has been specified in a preprocessing step (most likely in `step_epi_ahead`). #' Then, `ahead` is added to `time_value` to get the target date. #' @@ -29,27 +33,32 @@ #' p <- predict(wf1, latest) #' p layer_add_target_date <- - function(frosting, id = rand_id("add_target_date")) { + function(frosting, target_date = NULL, id = rand_id("add_target_date")) { add_layer( frosting, layer_add_target_date_new( + target_date = target_date, id = id ) ) } -layer_add_target_date_new <- function(id = id) { - layer("add_target_date", id = id) +layer_add_target_date_new <- function(id = id, target_date = target_date) { + layer("add_target_date", target_date = target_date, id = id) } #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { - the_fit <<- the_fit - the_recipe <<- the_recipe + + if(is.null(object$target_date)){ ahead <- the_recipe$steps[[2]][["ahead"]] if(is.na(ahead)) stop("`ahead` must be specified in preprocessing.") components$predictions <- dplyr::bind_cols(components$predictions, target_date = ahead + components$predictions$time_value) + } else{ + components$predictions <- dplyr::bind_cols(components$predictions, + target_date = object$target_date) + } components } diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 2afcf0e35..26e630328 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -14,7 +14,9 @@ layer_add_forecast_date( \item{frosting}{a \code{frosting} postprocessor} \item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. -This should be specified in the form "yyyy-mm-dd".} +This should be specified in the form "yyyy-mm-dd". Note that when the +forecast date is left unspecified, it is set to the maximum time value plus +the ahead value from preprocessing.} \item{id}{a random id string} } @@ -25,13 +27,13 @@ an updated \code{frosting} postprocessor Postprocessing step to add the forecast date } \details{ -To use this function, either specify an ahead value in -preprocessing and leave the forecast date unspecifed here or simply specify -a forecast date here. In the former, the forecast date will be set as the -maximum time value in the test data (after any processing has been applied) -plus the ahead value. In that case, as well as in the case when the -forecast date is less than the most recent update date of the data -(ie. the \code{as_of} value), an appropriate warning will be thrown. +To use this function, either specify a forecast date or specify an +ahead value in preprocessing and leave the forecast date unspecifed here. +In the latter, the forecast date will be set as the maximum time value +in the test data (after any processing has been applied) +plus the ahead value. In any case, when the forecast date is less than the +most recent update date of the data (ie. the \code{as_of} value), an appropriate +warning will be thrown. } \examples{ jhu <- case_death_rate_subset \%>\% diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index c72fe891b..ae3c273a5 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -4,11 +4,20 @@ \alias{layer_add_target_date} \title{Postprocessing step to add the target date} \usage{ -layer_add_target_date(frosting, id = rand_id("add_target_date")) +layer_add_target_date( + frosting, + target_date = NULL, + id = rand_id("add_target_date") +) } \arguments{ \item{frosting}{a \code{frosting} postprocessor} +\item{target_date}{The target date to add as a column to the \code{epi_df}. +By default, this is \code{time_value} plus \code{ahead}, where \code{ahead} has +been specified in preprocessing (most likely in \code{step_epi_ahead}). +The user may override this with a date in the form "yyyy-mm-dd".} + \item{id}{a random id string} } \value{ @@ -18,7 +27,7 @@ an updated \code{frosting} postprocessor Postprocessing step to add the target date } \details{ -This function assumes that a value for \code{ahead} +By default, this function assumes that a value for \code{ahead} has been specified in a preprocessing step (most likely in \code{step_epi_ahead}). Then, \code{ahead} is added to \code{time_value} to get the target date. } diff --git a/tests/testthat/test-layer_add_forecast_date.R b/tests/testthat/test-layer_add_forecast_date.R index c435af7a0..606433c9c 100644 --- a/tests/testthat/test-layer_add_forecast_date.R +++ b/tests/testthat/test-layer_add_forecast_date.R @@ -50,9 +50,8 @@ test_that("Do not specify a forecast_date in `layer_add_forecast_date()`", { layer_naomit(.pred) wf3 <- wf %>% add_frosting(f3) - w <- capture_warnings(p3 <- predict(wf3, latest)) - expect_equal(w[1], "Set forecast_date equal to maximum time value plus ahead value.") - expect_equal(w[2], "forecast_date is less than the most recent update date of the data.") + expect_warning(p3 <- predict(wf3, latest), + "forecast_date is less than the most recent update date of the data.") expect_equal(ncol(p3), 4L) expect_s3_class(p3, "epi_df") expect_equal(nrow(p3), 3L) From 2792bc498915a6b693abef616482ac25de619539 Mon Sep 17 00:00:00 2001 From: admin Date: Thu, 7 Jul 2022 18:11:51 -0700 Subject: [PATCH 27/39] Enabled user to specify a target date --- R/layer_add_target_date.R | 13 +++++++++++-- man/layer_add_target_date.Rd | 11 ++++++++++- tests/testthat/test-layer_add_target_date.R | 16 +++++++++++++++- 3 files changed, 36 insertions(+), 4 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index a77714910..5911d0630 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -4,7 +4,7 @@ #' @param target_date The target date to add as a column to the `epi_df`. #' By default, this is `time_value` plus `ahead`, where `ahead` has #' been specified in preprocessing (most likely in `step_epi_ahead`). -#' The user may override this with a date in the form "yyyy-mm-dd". +#' The user may override this with a date usually of the form "yyyy-mm-dd". #' @param id a random id string #' #' @return an updated `frosting` postprocessor @@ -26,12 +26,21 @@ #' latest <- jhu %>% #' dplyr::filter(time_value >= max(time_value) - 14) #' +#' # Use ahead from preprocessing #' f <- frosting() %>% layer_predict() %>% #' layer_add_target_date() %>% layer_naomit(.pred) #' wf1 <- wf %>% add_frosting(f) #' #' p <- predict(wf1, latest) #' p +#' +#' # Override default behaviour by specifying own target date +#' f2 <- frosting() %>% layer_predict() %>% +#' layer_add_target_date(target_date = "2022-01-08") %>% layer_naomit(.pred) +#' wf2 <- wf %>% add_frosting(f2) +#' +#' p2 <- predict(wf2, latest) +#' p2 layer_add_target_date <- function(frosting, target_date = NULL, id = rand_id("add_target_date")) { add_layer( @@ -58,7 +67,7 @@ slather.layer_add_target_date <- function(object, components, the_fit, the_recip target_date = ahead + components$predictions$time_value) } else{ components$predictions <- dplyr::bind_cols(components$predictions, - target_date = object$target_date) + target_date = as.Date(object$target_date)) } components } diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index ae3c273a5..640084e65 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -16,7 +16,7 @@ layer_add_target_date( \item{target_date}{The target date to add as a column to the \code{epi_df}. By default, this is \code{time_value} plus \code{ahead}, where \code{ahead} has been specified in preprocessing (most likely in \code{step_epi_ahead}). -The user may override this with a date in the form "yyyy-mm-dd".} +The user may override this with a date usually of the form "yyyy-mm-dd".} \item{id}{a random id string} } @@ -43,10 +43,19 @@ wf <- epi_workflow(r, parsnip::linear_reg()) \%>\% parsnip::fit(jhu) latest <- jhu \%>\% dplyr::filter(time_value >= max(time_value) - 14) +# Use ahead from preprocessing f <- frosting() \%>\% layer_predict() \%>\% layer_add_target_date() \%>\% layer_naomit(.pred) wf1 <- wf \%>\% add_frosting(f) p <- predict(wf1, latest) p + +# Override default behaviour by specifying own target date +f2 <- frosting() \%>\% layer_predict() \%>\% +layer_add_target_date(target_date = "2022-01-08") \%>\% layer_naomit(.pred) +wf2 <- wf \%>\% add_frosting(f2) + +p2 <- predict(wf2, latest) +p2 } diff --git a/tests/testthat/test-layer_add_target_date.R b/tests/testthat/test-layer_add_target_date.R index 241f8e8de..49ba1d997 100644 --- a/tests/testthat/test-layer_add_target_date.R +++ b/tests/testthat/test-layer_add_target_date.R @@ -9,7 +9,7 @@ wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu) latest <- jhu %>% dplyr::filter(time_value >= max(time_value) - 14) -test_that("Specify ahead in preprocessing", { +test_that("Use ahead from preprocessing", { f <- frosting() %>% layer_predict() %>% layer_add_target_date() %>% layer_naomit(.pred) @@ -22,3 +22,17 @@ test_that("Specify ahead in preprocessing", { expect_equal(p$target_date, rep(as.Date("2022-01-07"), times = 3)) expect_named(p, c("geo_value", "time_value", ".pred", "target_date")) }) + +test_that("Override default behaviour and specify own target date", { + + f <- frosting() %>% layer_predict() %>% + layer_add_target_date(target_date = "2022-01-08") %>% layer_naomit(.pred) + wf1 <- wf %>% add_frosting(f) + + expect_silent(p2 <- predict(wf1, latest)) + expect_equal(ncol(p2), 4L) + expect_s3_class(p2, "epi_df") + expect_equal(nrow(p2), 3L) + expect_equal(p2$target_date, rep(as.Date("2022-01-08"), times = 3)) + expect_named(p2, c("geo_value", "time_value", ".pred", "target_date")) +}) From 1037c79e1c56b0dead6e593b8d7dd93878d901d2 Mon Sep 17 00:00:00 2001 From: admin Date: Thu, 7 Jul 2022 18:15:22 -0700 Subject: [PATCH 28/39] Minor rewording --- R/layer_add_forecast_date.R | 6 +++--- R/layer_add_target_date.R | 3 ++- man/layer_add_forecast_date.Rd | 6 +++--- man/layer_add_target_date.Rd | 3 ++- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index f15cf954f..09bd3e942 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -2,9 +2,9 @@ #' #' @param frosting a `frosting` postprocessor #' @param forecast_date The forecast date to add as a column to the `epi_df`. -#' This should be specified in the form "yyyy-mm-dd". Note that when the -#' forecast date is left unspecified, it is set to the maximum time value plus -#' the ahead value from preprocessing. +#' For most cases, this should be specified in the form "yyyy-mm-dd". Note that +#' when the forecast date is left unspecified, it is set to the maximum time +#' value plus the ahead value from preprocessing. #' @param id a random id string #' #' @return an updated `frosting` postprocessor diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 5911d0630..b6943c2db 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -4,7 +4,8 @@ #' @param target_date The target date to add as a column to the `epi_df`. #' By default, this is `time_value` plus `ahead`, where `ahead` has #' been specified in preprocessing (most likely in `step_epi_ahead`). -#' The user may override this with a date usually of the form "yyyy-mm-dd". +#' The user may override this with a date of their own (that will usually +#' be in the form "yyyy-mm-dd"). #' @param id a random id string #' #' @return an updated `frosting` postprocessor diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 26e630328..5f654347d 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -14,9 +14,9 @@ layer_add_forecast_date( \item{frosting}{a \code{frosting} postprocessor} \item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. -This should be specified in the form "yyyy-mm-dd". Note that when the -forecast date is left unspecified, it is set to the maximum time value plus -the ahead value from preprocessing.} +For most cases, this should be specified in the form "yyyy-mm-dd". Note that +when the forecast date is left unspecified, it is set to the maximum time +value plus the ahead value from preprocessing.} \item{id}{a random id string} } diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index 640084e65..f1112282e 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -16,7 +16,8 @@ layer_add_target_date( \item{target_date}{The target date to add as a column to the \code{epi_df}. By default, this is \code{time_value} plus \code{ahead}, where \code{ahead} has been specified in preprocessing (most likely in \code{step_epi_ahead}). -The user may override this with a date usually of the form "yyyy-mm-dd".} +The user may override this with a date of their own (that will usually +be in the form "yyyy-mm-dd").} \item{id}{a random id string} } From 14d834415068be67ba2548178983c9a0d9778a9d Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 17:02:41 -0700 Subject: [PATCH 29/39] Made suggested changes --- R/layer_add_forecast_date.R | 22 +++++++++---------- R/layer_add_target_date.R | 21 ++++++++++-------- man/layer_add_forecast_date.Rd | 18 +++++++-------- man/layer_add_target_date.Rd | 13 ++++++----- tests/testthat/test-layer_add_forecast_date.R | 2 +- tests/testthat/test-layer_add_target_date.R | 2 +- 6 files changed, 40 insertions(+), 38 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 09bd3e942..1403d16f6 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -4,18 +4,17 @@ #' @param forecast_date The forecast date to add as a column to the `epi_df`. #' For most cases, this should be specified in the form "yyyy-mm-dd". Note that #' when the forecast date is left unspecified, it is set to the maximum time -#' value plus the ahead value from preprocessing. +#' value in the test data after any processing (ex. leads and lags) has been +#' applied. #' @param id a random id string #' #' @return an updated `frosting` postprocessor #' -#' @details To use this function, either specify a forecast date or specify an -#' ahead value in preprocessing and leave the forecast date unspecifed here. -#' In the latter, the forecast date will be set as the maximum time value -#' in the test data (after any processing has been applied) -#' plus the ahead value. In any case, when the forecast date is less than the -#' most recent update date of the data (ie. the `as_of` value), an appropriate -#' warning will be thrown. +#' @details To use this function, either specify a forecast date or leave the +#' forecast date unspecifed here. In the latter case, the forecast date will +#' be set as the maximum time value in the processed test data. In any case, +#' when the forecast date is less than the most recent update date of the data +#' (ie. the `as_of` value), an appropriate warning will be thrown. #' #' @export #' @examples @@ -48,7 +47,8 @@ #' #' p2 <- predict(wf2, latest) #' p2 -#' # Do not specify a forecast_date in `layer_add_forecast_date()` +#' +#' # Do not specify a forecast_date #' f3 <- frosting() %>% #' layer_predict() %>% #' layer_add_forecast_date() %>% @@ -79,10 +79,8 @@ slather.layer_add_forecast_date <- function(object, components, the_fit, the_rec as_of_date <- as.Date(attributes(components$keys)$metadata$as_of) - ahead <- the_recipe$steps[[2]][["ahead"]] - if (is.null(object$forecast_date)) { - object$forecast_date <- max_time_value + ahead + object$forecast_date <- max_time_value } if (object$forecast_date < as_of_date) { diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index b6943c2db..7ca9ee26b 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -2,17 +2,18 @@ #' #' @param frosting a `frosting` postprocessor #' @param target_date The target date to add as a column to the `epi_df`. -#' By default, this is `time_value` plus `ahead`, where `ahead` has -#' been specified in preprocessing (most likely in `step_epi_ahead`). -#' The user may override this with a date of their own (that will usually -#' be in the form "yyyy-mm-dd"). +#' By default, this is the maximum `time_value` from the processed test +#' data plus `ahead`, where `ahead` has been specified in preprocessing +#' (most likely in `step_epi_ahead`). The user may override this with a +#' date of their own (that will usually be in the form "yyyy-mm-dd"). #' @param id a random id string #' #' @return an updated `frosting` postprocessor #' #' @details By default, this function assumes that a value for `ahead` -#' has been specified in a preprocessing step (most likely in `step_epi_ahead`). -#' Then, `ahead` is added to `time_value` to get the target date. +#' has been specified in a preprocessing step (most likely in +#' `step_epi_ahead`). Then, `ahead` is added to the maximum `time_value` +#' in the test data to get the target date. #' #' @export #' @examples @@ -60,12 +61,14 @@ layer_add_target_date_new <- function(id = id, target_date = target_date) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { - if(is.null(object$target_date)){ + max_time_value <- max(components$keys$time_value) + + if (is.null(object$target_date)) { ahead <- the_recipe$steps[[2]][["ahead"]] - if(is.na(ahead)) stop("`ahead` must be specified in preprocessing.") + if (is.na(ahead)) stop("`ahead` must be specified in preprocessing.") components$predictions <- dplyr::bind_cols(components$predictions, - target_date = ahead + components$predictions$time_value) + target_date = max_time_value + ahead) } else{ components$predictions <- dplyr::bind_cols(components$predictions, target_date = as.Date(object$target_date)) diff --git a/man/layer_add_forecast_date.Rd b/man/layer_add_forecast_date.Rd index 5f654347d..5b2174b89 100644 --- a/man/layer_add_forecast_date.Rd +++ b/man/layer_add_forecast_date.Rd @@ -16,7 +16,8 @@ layer_add_forecast_date( \item{forecast_date}{The forecast date to add as a column to the \code{epi_df}. For most cases, this should be specified in the form "yyyy-mm-dd". Note that when the forecast date is left unspecified, it is set to the maximum time -value plus the ahead value from preprocessing.} +value in the test data after any processing (ex. leads and lags) has been +applied.} \item{id}{a random id string} } @@ -27,13 +28,11 @@ an updated \code{frosting} postprocessor Postprocessing step to add the forecast date } \details{ -To use this function, either specify a forecast date or specify an -ahead value in preprocessing and leave the forecast date unspecifed here. -In the latter, the forecast date will be set as the maximum time value -in the test data (after any processing has been applied) -plus the ahead value. In any case, when the forecast date is less than the -most recent update date of the data (ie. the \code{as_of} value), an appropriate -warning will be thrown. +To use this function, either specify a forecast date or leave the +forecast date unspecifed here. In the latter case, the forecast date will +be set as the maximum time value in the processed test data. In any case, +when the forecast date is less than the most recent update date of the data +(ie. the \code{as_of} value), an appropriate warning will be thrown. } \examples{ jhu <- case_death_rate_subset \%>\% @@ -65,7 +64,8 @@ wf2 <- wf \%>\% add_frosting(f2) p2 <- predict(wf2, latest) p2 -# Do not specify a forecast_date in `layer_add_forecast_date()` + +# Do not specify a forecast_date f3 <- frosting() \%>\% layer_predict() \%>\% layer_add_forecast_date() \%>\% diff --git a/man/layer_add_target_date.Rd b/man/layer_add_target_date.Rd index f1112282e..18e193e06 100644 --- a/man/layer_add_target_date.Rd +++ b/man/layer_add_target_date.Rd @@ -14,10 +14,10 @@ layer_add_target_date( \item{frosting}{a \code{frosting} postprocessor} \item{target_date}{The target date to add as a column to the \code{epi_df}. -By default, this is \code{time_value} plus \code{ahead}, where \code{ahead} has -been specified in preprocessing (most likely in \code{step_epi_ahead}). -The user may override this with a date of their own (that will usually -be in the form "yyyy-mm-dd").} +By default, this is the maximum \code{time_value} from the processed test +data plus \code{ahead}, where \code{ahead} has been specified in preprocessing +(most likely in \code{step_epi_ahead}). The user may override this with a +date of their own (that will usually be in the form "yyyy-mm-dd").} \item{id}{a random id string} } @@ -29,8 +29,9 @@ Postprocessing step to add the target date } \details{ By default, this function assumes that a value for \code{ahead} -has been specified in a preprocessing step (most likely in \code{step_epi_ahead}). -Then, \code{ahead} is added to \code{time_value} to get the target date. +has been specified in a preprocessing step (most likely in +\code{step_epi_ahead}). Then, \code{ahead} is added to the maximum \code{time_value} +in the test data to get the target date. } \examples{ jhu <- case_death_rate_subset \%>\% diff --git a/tests/testthat/test-layer_add_forecast_date.R b/tests/testthat/test-layer_add_forecast_date.R index 606433c9c..eae3f04ac 100644 --- a/tests/testthat/test-layer_add_forecast_date.R +++ b/tests/testthat/test-layer_add_forecast_date.R @@ -55,6 +55,6 @@ test_that("Do not specify a forecast_date in `layer_add_forecast_date()`", { expect_equal(ncol(p3), 4L) expect_s3_class(p3, "epi_df") expect_equal(nrow(p3), 3L) - expect_equal(p3$forecast_date, rep(as.Date("2022-01-21"), times = 3)) + expect_equal(p3$forecast_date, rep(as.Date("2022-01-14"), times = 3)) expect_named(p3, c("geo_value", "time_value", ".pred", "forecast_date")) }) diff --git a/tests/testthat/test-layer_add_target_date.R b/tests/testthat/test-layer_add_target_date.R index 49ba1d997..2c80fe657 100644 --- a/tests/testthat/test-layer_add_target_date.R +++ b/tests/testthat/test-layer_add_target_date.R @@ -19,7 +19,7 @@ test_that("Use ahead from preprocessing", { expect_equal(ncol(p), 4L) expect_s3_class(p, "epi_df") expect_equal(nrow(p), 3L) - expect_equal(p$target_date, rep(as.Date("2022-01-07"), times = 3)) + expect_equal(p$target_date, rep(as.Date("2022-01-21"), times = 3)) expect_named(p, c("geo_value", "time_value", ".pred", "target_date")) }) From 0a053d37b61e0c227c1ce9dc1fb2b2c7f96af8df Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 17:12:34 -0700 Subject: [PATCH 30/39] Removed white space --- R/layer_add_forecast_date.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 1403d16f6..9a3e373e8 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -91,4 +91,3 @@ slather.layer_add_forecast_date <- function(object, components, the_fit, the_rec forecast_date = as.Date(object$forecast_date)) components } - From 0b2f048c3e80b89bbee91f3ca29ee3a880471c29 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 17:41:06 -0700 Subject: [PATCH 31/39] Better way to access ahead --- R/layer_add_target_date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 7ca9ee26b..22cb0399c 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -64,7 +64,7 @@ slather.layer_add_target_date <- function(object, components, the_fit, the_recip max_time_value <- max(components$keys$time_value) if (is.null(object$target_date)) { - ahead <- the_recipe$steps[[2]][["ahead"]] + ahead <- unlist(the_recipe$steps)$ahead if (is.na(ahead)) stop("`ahead` must be specified in preprocessing.") components$predictions <- dplyr::bind_cols(components$predictions, From 77ae1858e4b92152b54c0e7e657f9d421bb26618 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 17:52:45 -0700 Subject: [PATCH 32/39] Reformatted --- R/layer_add_forecast_date.R | 7 +++---- R/layer_add_target_date.R | 16 ++++++++-------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/R/layer_add_forecast_date.R b/R/layer_add_forecast_date.R index 9a3e373e8..5d3ab4621 100644 --- a/R/layer_add_forecast_date.R +++ b/R/layer_add_forecast_date.R @@ -75,14 +75,13 @@ layer_add_forecast_date_new <- function(forecast_date, id = id) { #' @export slather.layer_add_forecast_date <- function(object, components, the_fit, the_recipe, ...) { - max_time_value <- max(components$keys$time_value) - - as_of_date <- as.Date(attributes(components$keys)$metadata$as_of) - if (is.null(object$forecast_date)) { + max_time_value <- max(components$keys$time_value) object$forecast_date <- max_time_value } + as_of_date <- as.Date(attributes(components$keys)$metadata$as_of) + if (object$forecast_date < as_of_date) { warning("forecast_date is less than the most recent update date of the data.") } diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 22cb0399c..ce4743d26 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -61,17 +61,17 @@ layer_add_target_date_new <- function(id = id, target_date = target_date) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { - max_time_value <- max(components$keys$time_value) - if (is.null(object$target_date)) { - ahead <- unlist(the_recipe$steps)$ahead + max_time_value <- max(components$keys$time_value) + ahead <- unlist(the_recipe$steps)$ahead - if (is.na(ahead)) stop("`ahead` must be specified in preprocessing.") - components$predictions <- dplyr::bind_cols(components$predictions, - target_date = max_time_value + ahead) + if (is.na(ahead)) stop("`ahead` must be specified in preprocessing.") + target_date = max_time_value + ahead } else{ - components$predictions <- dplyr::bind_cols(components$predictions, - target_date = as.Date(object$target_date)) + target_date = as.Date(object$target_date) } + + components$predictions <- dplyr::bind_cols(components$predictions, + target_date = target_date) components } From 3010355675c6e9920f3500972a5cbd6821cbac8e Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 17:57:01 -0700 Subject: [PATCH 33/39] is.null() --- R/layer_add_target_date.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index ce4743d26..a2ed04600 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -60,12 +60,12 @@ layer_add_target_date_new <- function(id = id, target_date = target_date) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { - +test <<- the_recipe if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) ahead <- unlist(the_recipe$steps)$ahead - if (is.na(ahead)) stop("`ahead` must be specified in preprocessing.") + if (is.null(ahead)) stop("`ahead` must be specified in preprocessing.") target_date = max_time_value + ahead } else{ target_date = as.Date(object$target_date) From 0084c5f6f5921bbdc3a564953f3dd4bead27611d Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 17:57:10 -0700 Subject: [PATCH 34/39] remove test --- R/layer_add_target_date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index a2ed04600..a504416a1 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -60,7 +60,7 @@ layer_add_target_date_new <- function(id = id, target_date = target_date) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { -test <<- the_recipe + if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) ahead <- unlist(the_recipe$steps)$ahead From 78ecd9d1b06d5e4f98ea79fff183eb3c93b973c6 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 19:15:10 -0700 Subject: [PATCH 35/39] Had to call ahead another way after update from frosting --- R/layer_add_target_date.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index a504416a1..dfc331d0b 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -63,9 +63,13 @@ slather.layer_add_target_date <- function(object, components, the_fit, the_recip if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) - ahead <- unlist(the_recipe$steps)$ahead + ahead <- + -test$steps[[which(unlist(lapply(test$steps, + function(x) all("ahead_" %in% unlist(x)))))]]$shift - if (is.null(ahead)) stop("`ahead` must be specified in preprocessing.") + if (is.null(ahead)){ + stop("`ahead` must be specified in preprocessing.") + } target_date = max_time_value + ahead } else{ target_date = as.Date(object$target_date) From 69970172980454798ea665b3597347a8a790ece0 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 19:16:31 -0700 Subject: [PATCH 36/39] Took out test --- R/layer_add_target_date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index dfc331d0b..80bb721f0 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -64,7 +64,7 @@ slather.layer_add_target_date <- function(object, components, the_fit, the_recip if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) ahead <- - -test$steps[[which(unlist(lapply(test$steps, + -the_recipe$steps[[which(unlist(lapply(the_recipe$steps, function(x) all("ahead_" %in% unlist(x)))))]]$shift if (is.null(ahead)){ From 9a304ed622dee0688c744485d887b73353777c93 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 19:30:42 -0700 Subject: [PATCH 37/39] Simplify code a little --- R/layer_add_target_date.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 80bb721f0..bcad496b6 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -60,12 +60,11 @@ layer_add_target_date_new <- function(id = id, target_date = target_date) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { - + steps <<- the_recipe$steps if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) - ahead <- - -the_recipe$steps[[which(unlist(lapply(the_recipe$steps, - function(x) all("ahead_" %in% unlist(x)))))]]$shift + steps <- the_recipe$steps + ahead <- -steps[[which(unlist(lapply(steps, function(x) "ahead_" %in% x)))]]$shift if (is.null(ahead)){ stop("`ahead` must be specified in preprocessing.") From 09a7e949bd6dbabf4e986609bf314cdf3348cf89 Mon Sep 17 00:00:00 2001 From: admin Date: Fri, 8 Jul 2022 19:30:57 -0700 Subject: [PATCH 38/39] take out test --- R/layer_add_target_date.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index bcad496b6..08ccf89f2 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -60,7 +60,7 @@ layer_add_target_date_new <- function(id = id, target_date = target_date) { #' @export slather.layer_add_target_date <- function(object, components, the_fit, the_recipe, ...) { - steps <<- the_recipe$steps + if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) steps <- the_recipe$steps From 2745927f5126184f9234e4100860030b088386a2 Mon Sep 17 00:00:00 2001 From: admin Date: Mon, 18 Jul 2022 17:39:22 -0700 Subject: [PATCH 39/39] extract_argument() to get ahead --- R/layer_add_target_date.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/layer_add_target_date.R b/R/layer_add_target_date.R index 08ccf89f2..330b56102 100644 --- a/R/layer_add_target_date.R +++ b/R/layer_add_target_date.R @@ -63,8 +63,7 @@ slather.layer_add_target_date <- function(object, components, the_fit, the_recip if (is.null(object$target_date)) { max_time_value <- max(components$keys$time_value) - steps <- the_recipe$steps - ahead <- -steps[[which(unlist(lapply(steps, function(x) "ahead_" %in% x)))]]$shift + ahead <- extract_argument(the_recipe, "step_epi_ahead", "ahead") if (is.null(ahead)){ stop("`ahead` must be specified in preprocessing.")