fix string/fct coercion

Author: dajmcdon

DESCRIPTION

@@ -14,6 +14,7 @@ Depends:
     R (>= 3.5.0)
 Imports: 
     assertthat,
+    broom,
     cli,
     dplyr,
     epiprocess,

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+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)
@@ -17,6 +20,7 @@ S3method(print,step_epi_ahead)
 S3method(print,step_epi_lag)
 export("%>%")
 export(add_epi_recipe)
+export(apply_frosting)
 export(arx_args_list)
 export(arx_forecaster)
 export(create_lags_and_leads)
@@ -39,6 +43,7 @@ export(smooth_arx_forecaster)
 export(step_epi_ahead)
 export(step_epi_lag)
 import(recipes)
+importFrom(broom,augment)
 importFrom(magrittr,"%>%")
 importFrom(rlang,"!!")
 importFrom(rlang,":=")

R/epi_recipe.R

@@ -416,3 +416,9 @@ kill_levels <- function(x, keys) {
   for (i in which(names(x) %in% keys)) x[[i]] <- list(values = NA, ordered = NA)
   x
 }
+
+#' @export
+as_tibble.epi_df <- function(x, ...) {
+  # so that downstream calls to as_tibble don't clobber our metadata
+  return(x)
+}

R/epi_workflow.R

@@ -15,15 +15,11 @@
 #' @importFrom rlang is_null
 #' @export
 #' @examples
-#' library(epiprocess)
 #' library(dplyr)
 #' library(parsnip)
 #' library(recipes)
 #'
-#' jhu <- jhu_csse_daily_subset %>%
-#'   filter(time_value > "2021-08-01") %>%
-#'   select(geo_value:death_rate_7d_av) %>%
-#'   rename(case_rate = case_rate_7d_av, death_rate = death_rate_7d_av)
+#' jhu <- case_death_rate_subset
 #'
 #' r <- epi_recipe(jhu) %>%
 #'   step_epi_lag(death_rate, lag = c(0, 7, 14)) %>%
@@ -103,7 +99,9 @@ is_epi_workflow <- function(x) {
 #' library(parsnip)
 #' library(recipes)
 #'
-#' r <- epi_recipe(case_death_rate_subset) %>%
+#' 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_epi_lag(case_rate, lag = c(0, 7, 14)) %>%
@@ -112,7 +110,7 @@ is_epi_workflow <- function(x) {
 #'
 #' wf <- epi_workflow(r, linear_reg()) %>% fit(jhu)
 #'
-#' latest <- get_test_data(r, case_death_rate_subset)
+#' latest <- get_test_data(r, jhu)
 #'
 #' preds <- predict(wf, latest) %>%
 #'   filter(!is.na(.pred))
@@ -171,6 +169,7 @@ grab_forged_keys <- function(forged, mold, new_data) {
 #' @param ... Arguments passed on to the predict method.
 #'
 #' @return new_data with additional columns containing the predicted values
+#' @importFrom broom augment
 #' @export
 augment.epi_workflow <- function (x, new_data, ...) {
   predictions <- predict(x, new_data, ...)

R/frosting.R

@@ -58,10 +58,12 @@ frosting <- function(layers = NULL, requirements = NULL) {
   out <- new_frosting()
 }
 
+#' @export
 apply_frosting <- function(workflow, ...) {
   UseMethod("apply_frosting")
 }
 
+#' @export
 apply_frosting.default <- function(workflow, components, ...) {
   if (has_postprocessor(workflow)) {
     abort(c("Postprocessing is only available for epi_workflows currently.",
@@ -74,6 +76,7 @@ apply_frosting.default <- function(workflow, components, ...) {
 
 #' @importFrom rlang is_null
 #' @importFrom rlang abort
+#' @export
 apply_frosting.epi_workflow <- function(workflow, components, the_fit, ...) {
   if (!has_postprocessor(workflow)) {
     components$preds <- predict(the_fit, components$forged$predictors, ...)

man/epi_workflow.Rd

@@ -17,4 +17,20 @@ test_that("frosting validators / constructors work", {
 
 test_that("prediction works without any postprocessor", {
 
+  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, linear_reg()) %>% fit(jhu)
+  latest <- get_test_data(r, jhu)
+
+  expect_silent(predict(wf, latest))
+  p <- predict(wf, latest) %>% dplyr::filter(!is.na(.pred))
+  expect_equal(nrow(p), 3)
+  expect_s3_class(p, "epi_df")
+  expect_equal(tail(p$time_value, 1), as.Date("2021-12-31"))
+  expect_equal(unique(p$geo_value), c("ak", "ca", "ny"))
 })