Merge pull request #224 from patr1ckm/time-elapsed

Compute and print time elapsed

Author: topepo

DESCRIPTION

@@ -28,6 +28,7 @@ Imports:
     stats,
     tidyr,
     globals,
+    prettyunits,
     vctrs (>= 0.2.0)
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 6.1.99.9001

NEWS.md

@@ -1,7 +1,14 @@
 # parsnip 0.0.3.9001
 
+## New Features
+
+* The time elapsed during model fitting is stored in the `$elapsed` slot of the
+parsnip model object, and is printed when the model object is printed.
+
 * Some default parameter ranges were updated for SVM, KNN, and MARS models. 
 
+## Fixes
+
 * [A bug](https://github.com/tidymodels/parsnip/issues/208) was fixed related to using data descriptors and `fit_xy()`. 
 
 * A bug was fixed related to the column names generated by `multi_predict()`. The top-level tibble will always have a column named `.pred` and this list column contains tibbles across sub-models. The column names for these sub-model tibbles will have names consistent with `predict()` (which was previously incorrect). See [43c15db](https://github.com/tidymodels/parsnip/commit/43c15db377ea9ef27483ff209f6bd0e98cb830d2).

R/fit.R

@@ -367,6 +367,7 @@ check_xy_interface <- function(x, y, cl, model) {
 #' @export
 print.model_fit <- function(x, ...) {
   cat("parsnip model object\n\n")
+  cat("Fit in: ", prettyunits::pretty_sec(x$elapsed[["elapsed"]]))
 
   if (inherits(x$fit, "try-error")) {
     cat("Model fit failed with error:\n", x$fit, "\n")

R/fit_helpers.R

@@ -52,14 +52,17 @@ form_form <-
       spec = object
     )
 
-    res$fit <- eval_mod(
-      fit_call,
-      capture = control$verbosity == 0,
-      catch = control$catch,
-      env = env,
-      ...
+    elapsed <- system.time(
+      res$fit <- eval_mod(
+        fit_call,
+        capture = control$verbosity == 0,
+        catch = control$catch,
+        env = env,
+        ...
+      )
     )
     res$preproc <- list(y_var = all.vars(env$formula[[2]]))
+    res$elapsed <- elapsed
     res
   }
 
@@ -107,19 +110,24 @@ xy_xy <- function(object, env, control, target = "none", ...) {
 
   res <- list(lvl = levels(env$y), spec = object)
 
-  res$fit <- eval_mod(
-    fit_call,
-    capture = control$verbosity == 0,
-    catch = control$catch,
-    env = env,
-    ...
+
+  elapsed <- system.time(
+    res$fit <- eval_mod(
+      fit_call,
+      capture = control$verbosity == 0,
+      catch = control$catch,
+      env = env,
+      ...
+    )
   )
+
   if (is.vector(env$y)) {
     y_name <- character(0)
   } else {
     y_name <- colnames(env$y)
   }
   res$preproc <- list(y_var = y_name)
+  res$elapsed <- elapsed
   res
 }
 

tests/testthat/test_fit_interfaces.R

@@ -79,3 +79,20 @@ test_that('unknown modes', {
   )
 })
 
+test_that("elapsed time parsnip mods", {
+  lm1 <-
+    linear_reg() %>%
+    set_engine("lm") %>%
+    fit_xy(x = mtcars[, 2:4], y = mtcars$mpg)
+
+  lm2 <-
+    linear_reg() %>%
+    set_engine("lm") %>%
+    fit(mpg ~ ., data = mtcars)
+
+  expect_output(print(lm1), "Fit in:")
+  expect_output(print(lm2), "Fit in:")
+  expect_true(!is.null(lm1$elapsed))
+  expect_true(!is.null(lm2$elapsed))
+})
+

tests/testthat/test_linear_reg_keras.R

@@ -49,6 +49,7 @@ test_that('model fitting', {
       ),
     regexp = NA
   )
+  fit1$elapsed <- fit2$elapsed
   expect_equal(fit1, fit2)
 
   expect_error(

tests/testthat/test_logistic_reg_keras.R

@@ -65,6 +65,7 @@ test_that('model fitting', {
       ),
     regexp = NA
   )
+  fit1$elapsed <- fit2$elapsed
   expect_equal(fit1, fit2)
 
   expect_error(

tests/testthat/test_multinom_reg_keras.R

@@ -58,6 +58,7 @@ test_that('model fitting', {
       ),
     regexp = NA
   )
+  fit1$elapsed <- fit2$elapsed
   expect_equal(fit1, fit2)
 
   expect_error(