Issue #156

Author: jrosell

NAMESPACE

@@ -3,6 +3,7 @@
 S3method("[",workflow_set)
 S3method("names<-",workflow_set)
 S3method(autoplot,workflow_set)
+S3method(collect_extracts,workflow_set)
 S3method(collect_metrics,workflow_set)
 S3method(collect_notes,workflow_set)
 S3method(collect_predictions,workflow_set)
@@ -38,6 +39,7 @@ S3method(vec_restore,workflow_set)
 export("%>%")
 export(as_workflow_set)
 export(autoplot)
+export(collect_extracts)
 export(collect_metrics)
 export(collect_notes)
 export(collect_predictions)
@@ -93,6 +95,7 @@ importFrom(stats,as.formula)
 importFrom(stats,model.frame)
 importFrom(stats,predict)
 importFrom(stats,qnorm)
+importFrom(tune,collect_extracts)
 importFrom(tune,collect_metrics)
 importFrom(tune,collect_notes)
 importFrom(tune,collect_predictions)

R/0_imports.R

@@ -37,6 +37,10 @@ tune::collect_predictions
 #' @export
 tune::collect_notes
 
+#' @importFrom tune collect_extracts
+#' @export
+tune::collect_extracts
+
 #' @importFrom dplyr %>%
 #' @export
 dplyr::`%>%`

R/collect.R

@@ -166,3 +166,18 @@ collect_notes.workflow_set <- function(x, ...) {
 
   res
 }
+
+#' 
+#' @export
+#' @rdname collect_metrics.workflow_set
+collect_extracts.workflow_set <- function(x, ...) {
+  check_incompete(x)
+
+  res <- dplyr::rowwise(x)
+  res <- dplyr::mutate(res, extracts = list(collect_extracts(result)))
+  res <- dplyr::ungroup(res)
+  res <- dplyr::select(res, wflow_id, extracts)
+  res <- tidyr::unnest(res, cols = extracts)
+
+  res
+}

man/collect_metrics.workflow_set.Rd

@@ -0,0 +1,28 @@
+skip_on_cran()
+
+test_that("collect_extracts works", {
+   set.seed(1)
+   folds <- rsample::vfold_cv(mtcars, v = 3)
+
+   wflow_set <-
+     workflow_set(
+       list(reg = mpg ~ ., nonlin = mpg ~ wt + 1 / sqrt(disp)),
+       list(lm = parsnip::linear_reg())
+     )
+
+   wflow_set_trained <-
+     wflow_set %>%
+     workflow_map("fit_resamples",
+       resamples = folds,
+       control = tune::control_resamples(extract = function(x) { x })
+     )
+
+
+   extracts <- collect_extracts(wflow_set_trained)
+
+   expect_equal(nrow(extracts), 6)
+   expect_contains(
+    class(extracts$.extracts[[1]]), "workflow"
+   )
+   expect_named(extracts, c("wflow_id", "id", ".extracts", ".config"))
+})

man/reexports.Rd

@@ -22,5 +22,5 @@ test_that("collect_notes works", {
 
    expect_equal(nrow(notes), 6)
    expect_contains(notes$note, "hey!")
-   expect_named(notes, c("wflow_id", "id", "location", "type", "note"))
+   expect_named(notes, c("wflow_id", "id", "location", "type", "note", "trace"))
 })

man/workflow_set.Rd

@@ -40,6 +40,8 @@ test_that("fit_best fits with correct hyperparameters", {
 
    manual_wf$pre$mold$blueprint$recipe$fit_times <-
       fit_best_wf$pre$mold$blueprint$recipe$fit_times
+   manual_wf$fit$fit$elapsed$elapsed <-
+      fit_best_wf$fit$fit$elapsed$elapsed
    expect_equal(manual_wf, fit_best_wf)
 
    # metric: iic
@@ -53,6 +55,8 @@ test_that("fit_best fits with correct hyperparameters", {
 
    manual_wf_2$pre$mold$blueprint$recipe$fit_times <-
       fit_best_wf_2$pre$mold$blueprint$recipe$fit_times
+   manual_wf_2$fit$fit$elapsed$elapsed <-
+      fit_best_wf_2$fit$fit$elapsed$elapsed
    expect_equal(manual_wf_2, fit_best_wf_2)
 })