51 replace as tibble

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)

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
+}

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)
-}

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))
+
+})

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"))
 })