diff --git a/NAMESPACE b/NAMESPACE index d6fd32bc1..3343bc850 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,6 @@ S3method(apply_frosting,default) S3method(apply_frosting,epi_workflow) -S3method(as_tibble,epi_df) S3method(augment,epi_workflow) S3method(bake,step_epi_ahead) S3method(bake,step_epi_lag) @@ -18,6 +17,8 @@ S3method(prep,step_epi_ahead) S3method(prep,step_epi_lag) 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_naomit) S3method(slather,layer_predict) S3method(slather,layer_residual_quantile) @@ -32,6 +33,7 @@ export(default_epi_recipe_blueprint) export(df_mat_mul) export(epi_keys) export(epi_recipe) +export(epi_recipe_blueprint) export(epi_workflow) export(frosting) export(get_precision) @@ -46,6 +48,8 @@ export(knnarx_forecaster) export(layer_naomit) export(layer_predict) export(layer_residual_quantile) +export(new_default_epi_recipe_blueprint) +export(new_epi_recipe_blueprint) export(remove_frosting) export(slather) export(smooth_arx_args_list) @@ -55,6 +59,8 @@ export(step_epi_lag) import(recipes) importFrom(generics,augment) importFrom(generics,fit) +importFrom(hardhat,refresh_blueprint) +importFrom(hardhat,run_mold) importFrom(magrittr,"%>%") importFrom(rlang,"!!") importFrom(rlang,":=") @@ -69,5 +75,4 @@ importFrom(stats,predict) importFrom(stats,quantile) importFrom(stats,residuals) importFrom(stats,setNames) -importFrom(tibble,as_tibble) importFrom(tibble,tibble) diff --git a/R/blueprint-epi_recipe-default.R b/R/blueprint-epi_recipe-default.R new file mode 100644 index 000000000..4bf6b7e17 --- /dev/null +++ b/R/blueprint-epi_recipe-default.R @@ -0,0 +1,110 @@ + +#' Recipe blueprint that accounts for `epi_df` panel data +#' +#' Used for simplicity. See [hardhat::new_recipe_blueprint()] or +#' [hardhat::default_recipe_blueprint()] for more details. +#' +#' @inheritParams hardhat::new_recipe_blueprint +#' +#' @details The `bake_dependent_roles` are automatically set to `epi_df` defaults. +#' @return A recipe blueprint. +#' +#' @export +new_epi_recipe_blueprint <- + function(intercept = FALSE, allow_novel_levels = FALSE, fresh = TRUE, + bake_dependent_roles = character(), composition = "tibble", + ptypes = NULL, recipe = NULL, ..., subclass = character()) { + hardhat::new_recipe_blueprint( + intercept = intercept, + allow_novel_levels = allow_novel_levels, + fresh = fresh, + bake_dependent_roles = c(bake_dependent_roles, "time_value", "geo_value", "key", "raw"), + composition = composition, + ptypes = ptypes, + recipe = recipe, + ..., + subclass = c(subclass, "epi_recipe_blueprint") + ) +} + + +#' @rdname new_epi_recipe_blueprint +#' @export +epi_recipe_blueprint <- + function(intercept = FALSE, allow_novel_levels = FALSE, + fresh = TRUE, bake_dependent_roles = character(), + composition = "tibble") { + new_epi_recipe_blueprint(intercept = intercept, + allow_novel_levels = allow_novel_levels, + fresh = fresh, + bake_dependent_roles = bake_dependent_roles, + composition = composition) + } + +#' @rdname new_epi_recipe_blueprint +#' @export +default_epi_recipe_blueprint <- + function(intercept = FALSE, allow_novel_levels = FALSE, fresh = TRUE, + bake_dependent_roles = character(), composition = "tibble") { + new_default_epi_recipe_blueprint( + intercept = intercept, + allow_novel_levels = allow_novel_levels, + fresh = fresh, + bake_dependent_roles = bake_dependent_roles, + composition = composition + ) + } + +#' @rdname new_epi_recipe_blueprint +#' @inheritParams hardhat::new_default_recipe_blueprint +#' @export +new_default_epi_recipe_blueprint <- + function(intercept = FALSE, allow_novel_levels = FALSE, + fresh = TRUE, bake_dependent_roles = character(), + composition = "tibble", ptypes = NULL, recipe = NULL, + extra_role_ptypes = NULL, ..., subclass = character()) { + new_epi_recipe_blueprint( + intercept = intercept, + allow_novel_levels = allow_novel_levels, + fresh = fresh, + bake_dependent_roles = bake_dependent_roles, + composition = composition, + ptypes = ptypes, + recipe = recipe, + extra_role_ptypes = extra_role_ptypes, + ..., + subclass = c(subclass, "default_epi_recipe_blueprint", "default_recipe_blueprint") + ) +} + +#' @importFrom hardhat run_mold +#' @export +run_mold.default_epi_recipe_blueprint <- function(blueprint, ..., data) { + rlang::check_dots_empty0(...) + blueprint <- hardhat:::patch_recipe_default_blueprint(blueprint) + cleaned <- mold_epi_recipe_default_clean(blueprint = blueprint, data = data) + blueprint <- cleaned$blueprint + data <- cleaned$data + hardhat:::mold_recipe_default_process(blueprint = blueprint, data = data) +} + +mold_epi_recipe_default_clean <- function(blueprint, data) { + data <- er_check_is_data_like(data) + hardhat:::new_mold_clean(blueprint, data) +} + +#' @importFrom hardhat refresh_blueprint +#' @export +refresh_blueprint.default_epi_recipe_blueprint <- function(blueprint) { + do.call(new_default_epi_recipe_blueprint, as.list(blueprint)) +} + +er_check_is_data_like <- function(.x, .x_nm) { + if (rlang::is_missing(.x_nm)) { + .x_nm <- rlang::as_label(rlang::enexpr(.x)) + } + if (!hardhat:::is_new_data_like(.x)) { + hardhat:::glubort("`{.x_nm}` must be a data.frame or a matrix, not a {class1(.x)}.") + } + .x +} diff --git a/R/epi_recipe.R b/R/epi_recipe.R index 496d819bd..57272ee88 100644 --- a/R/epi_recipe.R +++ b/R/epi_recipe.R @@ -280,24 +280,6 @@ add_epi_recipe <- function( -#' Recipe blueprint that accounts for `epi_df` panel data -#' -#' Used for simplicity. See [hardhat::default_recipe_blueprint()] for more -#' details. -#' -#' @inheritParams hardhat::default_recipe_blueprint -#' -#' @details The `bake_dependent_roles` are automatically set to `epi_df` defaults. -#' @return A recipe blueprint. -#' @export -default_epi_recipe_blueprint <- - function(intercept = FALSE, allow_novel_levels = FALSE, fresh = TRUE, - bake_dependent_roles = c("time_value", "geo_value", "key", "raw"), - composition = "tibble") { - hardhat::default_recipe_blueprint( - intercept, allow_novel_levels, fresh, bake_dependent_roles, composition) - } - # unfortunately, everything the same as in prep.recipe except string/fctr handling #' @export @@ -403,13 +385,3 @@ kill_levels <- function(x, keys) { for (i in which(names(x) %in% keys)) x[[i]] <- list(values = NA, ordered = NA) x } - -#' @importFrom tibble as_tibble -#' @export -as_tibble.epi_df <- function(x, ...) { - # so that downstream calls to as_tibble don't clobber our metadata - # this avoids infinite recursion inside dplyr::dplyr_col_modify - # TODO: this needs a different approach, long-term - class(x) <- class(x)[class(x) != "grouped_df"] - return(x) -} diff --git a/man/layer_residual_quantile.Rd b/man/layer_residual_quantile.Rd index bfe0b507e..138e593b6 100644 --- a/man/layer_residual_quantile.Rd +++ b/man/layer_residual_quantile.Rd @@ -26,3 +26,27 @@ an updated \code{frosting} postprocessor with additional columns of the residual \description{ Creates predictions based on residual quantiles } +\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) \%>\% + 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 <- get_test_data(recipe = r, x = jhu) + +f <- epipredict:::frosting() \%>\% + layer_predict() \%>\% + layer_residual_quantile(probs = c(0.0275, 0.975), symmetrize = FALSE) \%>\% + layer_naomit(.pred) +wf1 <- wf \%>\% epipredict:::add_frosting(f) + +p <- predict(wf1, latest) +p +} diff --git a/man/default_epi_recipe_blueprint.Rd b/man/new_epi_recipe_blueprint.Rd similarity index 52% rename from man/default_epi_recipe_blueprint.Rd rename to man/new_epi_recipe_blueprint.Rd index a8f99daaa..6cfd77030 100644 --- a/man/default_epi_recipe_blueprint.Rd +++ b/man/new_epi_recipe_blueprint.Rd @@ -1,16 +1,52 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/epi_recipe.R -\name{default_epi_recipe_blueprint} +% Please edit documentation in R/blueprint-epi_recipe-default.R +\name{new_epi_recipe_blueprint} +\alias{new_epi_recipe_blueprint} +\alias{epi_recipe_blueprint} \alias{default_epi_recipe_blueprint} +\alias{new_default_epi_recipe_blueprint} \title{Recipe blueprint that accounts for \code{epi_df} panel data} \usage{ +new_epi_recipe_blueprint( + intercept = FALSE, + allow_novel_levels = FALSE, + fresh = TRUE, + bake_dependent_roles = character(), + composition = "tibble", + ptypes = NULL, + recipe = NULL, + ..., + subclass = character() +) + +epi_recipe_blueprint( + intercept = FALSE, + allow_novel_levels = FALSE, + fresh = TRUE, + bake_dependent_roles = character(), + composition = "tibble" +) + default_epi_recipe_blueprint( intercept = FALSE, allow_novel_levels = FALSE, fresh = TRUE, - bake_dependent_roles = c("time_value", "geo_value", "key", "raw"), + bake_dependent_roles = character(), composition = "tibble" ) + +new_default_epi_recipe_blueprint( + intercept = FALSE, + allow_novel_levels = FALSE, + fresh = TRUE, + bake_dependent_roles = character(), + composition = "tibble", + ptypes = NULL, + recipe = NULL, + extra_role_ptypes = NULL, + ..., + subclass = character() +) } \arguments{ \item{intercept}{A logical. Should an intercept be included in the @@ -41,13 +77,31 @@ the \code{forge()$extras$roles} slot. See the documentation of of the processed predictors. If "matrix" or "dgCMatrix" are chosen, all of the predictors must be numeric after the preprocessing method has been applied; otherwise an error is thrown.} + +\item{ptypes}{Either \code{NULL}, or a named list with 2 elements, \code{predictors} +and \code{outcomes}, both of which are 0-row tibbles. \code{ptypes} is generated +automatically at \code{\link[hardhat:mold]{mold()}} time and is used to validate \code{new_data} at +prediction time.} + +\item{recipe}{Either \code{NULL}, or an unprepped recipe. This argument is set +automatically at \code{\link[hardhat:mold]{mold()}} time.} + +\item{...}{Name-value pairs for additional elements of blueprints that +subclass this blueprint.} + +\item{subclass}{A character vector. The subclasses of this blueprint.} + +\item{extra_role_ptypes}{A named list. The names are the unique non-standard +recipe roles (i.e. everything except \code{"predictors"} and \code{"outcomes"}). The +values are prototypes of the original columns with that role. These are +used for validation in \code{forge()}.} } \value{ A recipe blueprint. } \description{ -Used for simplicity. See \code{\link[hardhat:default_recipe_blueprint]{hardhat::default_recipe_blueprint()}} for more -details. +Used for simplicity. See \code{\link[hardhat:new-blueprint]{hardhat::new_recipe_blueprint()}} or +\code{\link[hardhat:default_recipe_blueprint]{hardhat::default_recipe_blueprint()}} for more details. } \details{ The \code{bake_dependent_roles} are automatically set to \code{epi_df} defaults. diff --git a/tests/testthat/test-blueprint.R b/tests/testthat/test-blueprint.R new file mode 100644 index 000000000..ea171a128 --- /dev/null +++ b/tests/testthat/test-blueprint.R @@ -0,0 +1,24 @@ +test_that("epi_recipe blueprint keeps the class, mold works", { + bp <- new_default_epi_recipe_blueprint() + expect_length(class(bp), 5L) + expect_s3_class(bp, "default_epi_recipe_blueprint") + expect_s3_class(refresh_blueprint(bp), "default_epi_recipe_blueprint") + + jhu <- case_death_rate_subset + expect_s3_class(er_check_is_data_like(jhu), "epi_df") + + 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) + + mm <- mold_epi_recipe_default_clean(bp, jhu) + expect_s3_class(mm$blueprint, "default_epi_recipe_blueprint") + expect_s3_class(mm$data, "epi_df") + + bp <- hardhat:::update_blueprint(bp, recipe = r) + run_mm <- run_mold(bp, data = jhu) + expect_false(is.factor(run_mm$extras$roles$geo_value$geo_value)) + +}) diff --git a/tests/testthat/test-layer_predict.R b/tests/testthat/test-layer_predict.R index db9888779..f98bec2a0 100644 --- a/tests/testthat/test-layer_predict.R +++ b/tests/testthat/test-layer_predict.R @@ -19,7 +19,7 @@ test_that("predict layer works alone", { expect_equal(ncol(p), 3L) expect_s3_class(p, "epi_df") expect_equal(nrow(p), 108L) - expect_named(p, c("time_value", "geo_value", ".pred")) + expect_named(p, c("geo_value", "time_value", ".pred")) }) test_that("prediction with interval works", { @@ -31,5 +31,5 @@ test_that("prediction with interval works", { expect_equal(ncol(p), 4L) expect_s3_class(p, "epi_df") expect_equal(nrow(p), 108L) - expect_named(p, c("time_value", "geo_value", ".pred_lower", ".pred_upper")) + expect_named(p, c("geo_value", "time_value", ".pred_lower", ".pred_upper")) })