add extract_fit_time

DESCRIPTION

@@ -26,7 +26,7 @@ Imports:
     generics (>= 0.1.2),
     glue,
     gower,
-    hardhat (>= 1.3.0),
+    hardhat (>= 1.3.1.9000),
     ipred (>= 0.9-12),
     lifecycle (>= 1.0.3),
     lubridate (>= 1.8.0),
@@ -71,3 +71,5 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
+Remotes:  
+    tidymodels/hardhat

NAMESPACE

@@ -122,6 +122,7 @@ S3method(bake,step_zv)
 S3method(conditionMessage,recipes_error)
 S3method(discretize,default)
 S3method(discretize,numeric)
+S3method(extract_fit_time,recipe)
 S3method(extract_parameter_dials,recipe)
 S3method(extract_parameter_set_dials,recipe)
 S3method(fixed,Date)
@@ -567,6 +568,7 @@ export(dummy_extract_names)
 export(dummy_names)
 export(ellipse_check)
 export(estimate_yj)
+export(extract_fit_time)
 export(extract_parameter_dials)
 export(extract_parameter_set_dials)
 export(fixed)
@@ -729,6 +731,7 @@ importFrom(generics,tunable)
 importFrom(generics,tune_args)
 importFrom(glue,glue)
 importFrom(gower,gower_topn)
+importFrom(hardhat,extract_fit_time)
 importFrom(hardhat,extract_parameter_dials)
 importFrom(hardhat,extract_parameter_set_dials)
 importFrom(hardhat,frequency_weights)

NEWS.md

@@ -1,5 +1,7 @@
 # recipes (development version)
 
+* New `extract_fit_time()` method has been added that returns the time it took to train the recipe. (#1071)
+
 # recipes 1.0.10
 
 ## Bug Fixes

R/extract_fit_time.R

@@ -0,0 +1,20 @@
+#' @export
+extract_fit_time.recipe <- function(x, summarize = TRUE, ...) {
+  res <- x$fit_times
+
+  if (is.null(res)) {
+    cli::cli_abort(
+      "This recipe was created before {.fn recipes::extract_fit_time} was \\
+      added. Fit time cannot be extracted."
+    )
+  }
+
+  if (summarize) {
+    res <- tibble(
+      stage_id = "recipe",
+      elapsed = sum(res$elapsed)
+    )
+  }
+
+  res
+}

R/recipe.R

@@ -425,6 +425,8 @@ prep.recipe <-
       x$term_info <- x$var_info
     }
 
+    fit_times <- list()
+
     running_info <- x$term_info %>% mutate(number = 0, skip = FALSE)
 
     get_needs_tuning <- function(x) {
@@ -470,17 +472,28 @@ prep.recipe <-
 
         # Compute anything needed for the preprocessing steps
         # then apply it to the current training set
+        time <- proc.time()
         x$steps[[i]] <- recipes_error_context(
           prep(x$steps[[i]],
             training = training,
             info = x$term_info
           ),
           step_name = step_name
         )
+        prep_time <- proc.time() - time
+
+        time <- proc.time()
         training <- recipes_error_context(
           bake(x$steps[[i]], new_data = training),
           step_name = step_name
         )
+        bake_time <- proc.time() - time
+
+        fit_times[[i]] <- list(
+          stage_id = paste(c("prep", "bake"), x$steps[[i]]$id, sep = "."),
+          elapsed = c(prep_time[["elapsed"]], bake_time[["elapsed"]])
+        )
+
         if (!is_tibble(training)) {
           cli::cli_abort(c(
             "x" = "{.fun bake} methods should always return tibbles.",
@@ -539,6 +552,7 @@ prep.recipe <-
     x$levels <- lvls
     x$orig_lvls <- orig_lvls
     x$retained <- retain
+    x$fit_times <- dplyr::bind_rows(fit_times)
     # In case a variable was removed, and that removal step used
     # `skip = TRUE`, we need to retain its record so that
     # selectors can be properly used with `bake`. This tibble

R/reexports.R

@@ -34,3 +34,7 @@ hardhat::frequency_weights
 #' @importFrom magrittr %>%
 #' @export
 magrittr::`%>%`
+
+#' @importFrom hardhat extract_fit_time
+#' @export
+hardhat::extract_fit_time

tests/testthat/_snaps/extract_fit_time.md

@@ -0,0 +1,8 @@
+# extract_fit_time() works
+
+    Code
+      extract_fit_time(rec)
+    Condition
+      Error in `extract_fit_time()`:
+      ! This recipe was created before `recipes::extract_fit_time()` was added. Fit time cannot be extracted.
+

tests/testthat/test-basics.R

@@ -131,6 +131,9 @@ test_that("prep with fresh = TRUE", {
 
   new_rec <- prep(rec, training = test_data, fresh = TRUE)
 
+  rec$fit_times$elapsed <- 0
+  new_rec$fit_times$elapsed <- 0
+
   expect_identical(rec, new_rec)
 
   expect_equal(

tests/testthat/test-extract_fit_time.R

@@ -0,0 +1,32 @@
+test_that("extract_fit_time() works", {
+  rec <- recipe(mpg ~ ., data = mtcars) %>%
+    step_scale(all_numeric_predictors(), id = "scale") %>%
+    step_center(all_numeric_predictors(), id = "center") %>%
+    prep()
+
+  res <- extract_fit_time(rec)
+
+  expect_true(is_tibble(res))
+  expect_identical(names(res), c("stage_id", "elapsed"))
+  expect_identical(res$stage_id, "recipe")
+  expect_true(is.double(res$elapsed))
+  expect_true(res$elapsed >= 0)
+
+  res <- extract_fit_time(rec, summarize = FALSE)
+
+  expect_true(is_tibble(res))
+  expect_identical(names(res), c("stage_id", "elapsed"))
+  expect_identical(
+    res$stage_id,
+    c("prep.scale", "bake.scale", "prep.center", "bake.center")
+  )
+  expect_true(is.double(res$elapsed))
+  expect_true(all(res$elapsed >= 0))
+
+  rec$fit_times <- NULL
+
+  expect_snapshot(
+    error = TRUE,
+    extract_fit_time(rec)
+  )
+})

tests/testthat/test-interact.R

@@ -262,13 +262,16 @@ test_that("works when formula is passed in as an object", {
     step_interact(terms = cars_formula, id = "") %>%
     prep()
 
+  rec1$fit_times$elapsed <- 0
+  rec2$fit_times$elapsed <- 0
   expect_identical(rec1, rec2)
 
   cars_formula <- ~ vs:am
   rec3 <- recipe(~., data = mtcars) %>%
     step_interact(terms = !!cars_formula, id = "") %>%
     prep()
 
+  rec3$fit_times$elapsed <- 0
   expect_identical(rec1, rec3)
 })