add extract_fit_time

DESCRIPTION

@@ -47,7 +47,9 @@ Config/Needs/website:
     tidyverse/tidytemplate,
     yardstick
 Remotes:
-    tidymodels/parsnip
+    tidymodels/hardhat@extract_fit_time,
+    tidymodels/recipes@extract_fit_time,
+    tidymodels/parsnip@extract_fit_time
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(augment,workflow)
 S3method(extract_fit_engine,workflow)
 S3method(extract_fit_parsnip,workflow)
+S3method(extract_fit_time,workflow)
 S3method(extract_mold,workflow)
 S3method(extract_parameter_dials,workflow)
 S3method(extract_parameter_set_dials,workflow)
@@ -28,6 +29,7 @@ export(add_variables)
 export(control_workflow)
 export(extract_fit_engine)
 export(extract_fit_parsnip)
+export(extract_fit_time)
 export(extract_mold)
 export(extract_parameter_dials)
 export(extract_parameter_set_dials)
@@ -61,6 +63,7 @@ importFrom(generics,tunable)
 importFrom(generics,tune_args)
 importFrom(hardhat,extract_fit_engine)
 importFrom(hardhat,extract_fit_parsnip)
+importFrom(hardhat,extract_fit_time)
 importFrom(hardhat,extract_mold)
 importFrom(hardhat,extract_parameter_dials)
 importFrom(hardhat,extract_parameter_set_dials)

NEWS.md

@@ -10,6 +10,8 @@
 * The prediction columns are now appended to the LHS rather than RHS of 
   `new_data` in `augment.workflow()`, following analogous changes in parsnip (#200).
 
+* New `extract_fit_time()` method has been added that return the time it took to train the workflow. (#191)
+
 # workflows 1.1.3
 
 * The workflows methods for `generics::tune_args()` and `generics::tunable()`

R/extract.R

@@ -27,11 +27,15 @@
 #'
 #' - `extract_parameter_set_dials()` returns a set of dials parameter objects.
 #'
+#' - `extract_fit_time()` returns a tibble with elapsed fit times.
+#'
 #' @param x A workflow
 #'
 #' @param estimated A logical for whether the original (unfit) recipe or the
 #' fitted recipe should be returned. This argument should be named.
 #' @param parameter A single string for the parameter ID.
+#' @param summarize A logical for whether the elapsed fit time should be returned as a
+#' single row or multiple rows.
 #' @param ... Not currently used.
 #'
 #' @details
@@ -212,3 +216,26 @@ extract_parameter_set_dials.workflow <- function(x, ...) {
 extract_parameter_dials.workflow <- function(x, parameter, ...) {
   extract_parameter_dials(extract_parameter_set_dials(x), parameter)
 }
+
+#' @export
+#' @rdname extract-workflow
+extract_fit_time.workflow <- function(x, summarize = TRUE, ...) {
+  if (has_preprocessor_recipe(x)) {
+    preprocessor <- extract_fit_time(extract_recipe(x), summarize = summarize)
+    preprocessor <- vctrs::vec_cbind(stage = "preprocess", preprocessor)
+  }
+
+  model <- extract_fit_time(extract_fit_parsnip(x))
+  model <- vctrs::vec_cbind(stage = "model", model)
+
+  res <- vctrs::vec_rbind(preprocessor, model)
+
+  if (summarize) {
+    res$stage = "workflow"
+    res$process_id = "workflow"
+    res$time = sum(res$time)
+    res <- res[1, ]
+  }
+
+  res
+}

R/reexports.R

@@ -29,3 +29,7 @@ hardhat::extract_parameter_set_dials
 #' @importFrom hardhat extract_parameter_dials
 #' @export
 hardhat::extract_parameter_dials
+#'
+#' @importFrom hardhat extract_fit_time
+#' @export
+hardhat::extract_fit_time

tests/testthat/test-extract.R

@@ -353,3 +353,41 @@ test_that("extract single parameter from workflow with tunable recipe and model"
     NA
   )
 })
+
+# ------------------------------------------------------------------------------
+# extract_recipe()
+
+test_that("extract_fit_time() works", {
+  skip_if_not_installed("recipes")
+  rec_spec <- recipes::recipe(mpg ~ ., data = mtcars) %>%
+    recipes::step_scale(recipes::all_numeric_predictors(), id = "scale") %>%
+    recipes::step_center(recipes::all_numeric_predictors(), id = "center")
+
+  lm_spec <- parsnip::linear_reg()
+
+  wf <- workflow(rec_spec, lm_spec) %>% fit(mtcars)
+
+  res <- extract_fit_time(wf)
+
+  expect_s3_class(res, "tbl_df")
+  expect_identical(names(res), c("stage", "process_id", "time"))
+  expect_identical(res$stage, "workflow")
+  expect_identical(res$process_id, "workflow")
+  expect_true(is.double(res$time))
+  expect_true(res$time >= 0)
+
+  res <- extract_fit_time(wf, summarize = FALSE)
+
+  expect_s3_class(res, "tbl_df")
+  expect_identical(names(res), c("stage", "process_id", "time"))
+  expect_identical(
+    res$stage,
+    c("preprocess", "preprocess", "preprocess", "preprocess", "model")
+  )
+  expect_identical(
+    res$process_id,
+    c("prep.scale", "bake.scale", "prep.center", "bake.center", "linear_reg")
+  )
+  expect_true(is.double(res$time))
+  expect_true(all(res$time >= 0))
+})