Doc. for fit.epi_workflow and trying different things for mtv

NAMESPACE

@@ -32,6 +32,7 @@ S3method(extract_layers,workflow)
 S3method(extrapolate_quantiles,dist_default)
 S3method(extrapolate_quantiles,dist_quantiles)
 S3method(extrapolate_quantiles,distribution)
+S3method(fit,epi_workflow)
 S3method(format,dist_quantiles)
 S3method(is.na,dist_quantiles)
 S3method(is.na,distribution)

R/epi_recipe.R

@@ -131,6 +131,7 @@ epi_recipe.epi_df <-
       term_info = var_info,
       steps = NULL,
       template = x[1,],
+      mtv = max(x$time_value), #%%
       levels = NULL,
       retained = NA
     )
@@ -374,6 +375,7 @@ prep.epi_recipe <- function(
   } else {
     x$template <- training[0, ]
   }
+  x$mtv <- max(training$time_value) #%%
   x$tr_info <- tr_data
   x$levels <- lvls
   x$orig_lvls <- orig_lvls

R/epi_workflow.R

@@ -58,6 +58,47 @@ is_epi_workflow <- function(x) {
   inherits(x, "epi_workflow")
 }
 
+#' Fit an `epi_workflow` object
+#'
+#' @description
+#' This is the `fit()` method for an `epi_workflow` object that
+#' estimates parameters for a given model from a set of data.
+#' Fitting an `epi_workflow` involves two main steps, which are
+#' preprocessing the data and fitting the underlying parsnip model.
+#'
+#' @inheritParams workflows::fit.workflow
+#'
+#' @param object an `epi_workflow` object
+#'
+#' @param x an `epi_df` of predictors and outcomes to use when
+#' fitting the `epi_workflow`
+#'
+#' @return The `epi_workflow` object, updated with a fit parsnip
+#' model in the `object$fit$fit` slot.
+#'
+#' @seealso workflows::fit-workflow
+#'
+#' @name fit-epi_workflow
+#' @export
+#' @examples
+#' jhu <- case_death_rate_subset %>%
+#' 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)
+#'
+#' wf <- epi_workflow(r, parsnip::linear_reg()) %>% fit(jhu)
+#' wf
+#'
+#' @export
+fit.epi_workflow <- function(object, x, ...){
+
+  object$fit$meta <- list(mtv = max(x$time_value))
+  #object$fit$as_of <- attributes(x)$metadata$as_of
+
+  NextMethod()
+}
 
 #' Predict from an epi_workflow
 #'
@@ -112,13 +153,15 @@ predict.epi_workflow <- function(object, new_data, ...) {
       c("Can't predict on an untrained epi_workflow.",
         i = "Do you need to call `fit()`?"))
   }
+
   components <- list()
   components$mold <- workflows::extract_mold(object)
   components$forged <- hardhat::forge(new_data,
                                       blueprint = components$mold$blueprint)
   components$keys <- grab_forged_keys(components$forged,
                                       components$mold, new_data)
   components <- apply_frosting(object, components, new_data, ...)
+
   components$predictions
 }
 

R/frosting.R

@@ -229,6 +229,9 @@ apply_frosting.default <- function(workflow, components, ...) {
 apply_frosting.epi_workflow <-
   function(workflow, components, new_data, ...) {
 
+    #%% wf1$post$meta <<- list(mtv = max(new_data$time_value)) #%% change wf1 and possibly <<-
+    # assign("workflow$post$meta", list(mtv = max(new_data$time_value)), envir = .GlobalEnv)
+
     the_fit <- workflows::extract_fit_parsnip(workflow)
 
     if (!has_postprocessor(workflow)) {
@@ -268,6 +271,21 @@ apply_frosting.epi_workflow <-
     return(components)
   }
 
+#%% change_workflow = function(x){
+#  assign(deparse(substitute(x)), "changed", env=.GlobalEnv)
+#}
+
+#%% add_meta_post <- function(workflow, new_data){
+#
+#  workflow$post$meta <- list(mtv = max(new_data$time_value))
+#
+#  workflow
+#}
+
+#%% changeMe = function(x){
+#  assign(deparse(substitute(x)), "changed", env=.GlobalEnv)
+#}
+
 #' @export
 print.frosting <- function(x, form_width = 30, ...) {
   cli::cli_div(

R/layer_add_forecast_date.R

@@ -82,9 +82,9 @@ layer_add_forecast_date_new <- function(forecast_date, id) {
 
 #' @export
 slather.layer_add_forecast_date <- function(object, components, workflow, new_data, ...) {
-
+  wf <<- workflow
   if (is.null(object$forecast_date)) {
-    max_time_value <- max(new_data$time_value)
+    max_time_value <- max(workflows::extract_preprocessor(wf)$mtv, wf$fit$meta$mtv, max(new_data$time_value))#wf$post$meta$mtv) # workflow$fit$max_train_time #max(new_data$time_value)
     object$forecast_date <- max_time_value
   }