Updates to execution time collection

NEWS.md

@@ -15,6 +15,8 @@
 ## Other Changes
 
  * When the xy interface is used and the underlying model expects to use a matrix, a better warning is issued when predictors contain non-numeric columns (including dates). 
+
+ * The fit time is only calculated when the `verbosity` argument of `control_parsnip()` is 2L or greater. Also, the call to `system.time()` now uses `gcFirst = FALSE`. (#611)
 
 # parsnip 0.1.7
 

R/aaa.R

@@ -90,7 +90,8 @@ utils::globalVariables(
     "neighbors", ".submodels", "has_submodel", "max_neighbor", "max_penalty",
     "max_terms", "max_tree", "model", "name", "num_terms", "penalty", "trees",
     "sub_neighbors", ".pred_class", "x", "y", "predictor_indicators",
-    "compute_intercept", "remove_intercept", "estimate", "term")
+    "compute_intercept", "remove_intercept", "estimate", "term",
+    "call_info", "component", "component_id", "func")
 )
 
 # nocov end

R/control_parsnip.R

@@ -1,21 +1,23 @@
 #' Control the fit function
 #'
-#' Options can be passed to the [fit.model_spec()] function that control the output and
-#'  computations
+#' Pass options to the [fit.model_spec()] function to control its
+#' output and computations
+#'
+#' @param verbosity An integer to control how verbose the output is. For a
+#'  value of zero, no messages or output are shown when packages are loaded or
+#'  when the model is fit. For a value of 1, package loading is quiet but model
+#'  fits can produce output to the screen (depending on if they contain their
+#'  own `verbose`-type argument). For a value of 2 or more, any output at all
+#'  is displayed and the execution time of the fit is recorded and printed.
+#' @param catch A logical where a value of `TRUE` will evaluate the model
+#'  inside of `try(, silent = TRUE)`. If the model fails, an object is still
+#'  returned (without an error) that inherits the class "try-error".
+#' @return An S3 object with class "control_parsnip" that is a named list
+#' with the results of the function call
+#'
+#' @examples
+#' control_parsnip(verbosity = 2L)
 #'
-#' @param verbosity An integer where a value of zero indicates
-#'  that no messages or output should be shown when packages are
-#'  loaded or when the model is fit. A value of 1 means that package
-#'  loading is quiet but model fits can produce output to the screen
-#'  (depending on if they contain their own `verbose`-type
-#'  argument). A value of 2 or more indicates that any output should
-#'  be seen.
-#' @param catch A logical where a value of `TRUE` will evaluate
-#'  the model inside of `try(, silent = TRUE)`. If the model fails,
-#'  an object is still returned (without an error) that inherits the
-#'  class "try-error".
-#' @return An S3 object with class "fit_control" that is a named list with the
-#' results of the function call
 #' @details
 #' `fit_control()` is deprecated in favor of `control_parsnip()`.
 #' @export

R/fit.R

@@ -420,7 +420,9 @@ allow_sparse <- function(x) {
 #' @export
 print.model_fit <- function(x, ...) {
   cat("parsnip model object\n\n")
-  cat("Fit time: ", prettyunits::pretty_sec(x$elapsed[["elapsed"]]), "\n")
+  if (!is.na(x$elapsed[["elapsed"]])) {
+    cat("Fit time: ", prettyunits::pretty_sec(x$elapsed[["elapsed"]]), "\n")
+  }
 
   if (inherits(x$fit, "try-error")) {
     cat("Model fit failed with error:\n", x$fit, "\n")

R/fit_helpers.R

@@ -38,15 +38,27 @@ form_form <-
       spec = object
     )
 
-    elapsed <- system.time(
+    if (control$verbosity > 1L) {
+      elapsed <- system.time(
+        res$fit <- eval_mod(
+          fit_call,
+          capture = control$verbosity == 0,
+          catch = control$catch,
+          env = env,
+          ...
+        ),
+        gcFirst = FALSE
+      )
+    } else {
       res$fit <- eval_mod(
         fit_call,
         capture = control$verbosity == 0,
         catch = control$catch,
         env = env,
         ...
       )
-    )
+      elapsed <- list(elapsed = NA_real_)
+    }
     res$preproc <- list(y_var = all.vars(env$formula[[2]]))
     res$elapsed <- elapsed
     res
@@ -85,16 +97,27 @@ xy_xy <- function(object, env, control, target = "none", ...) {
 
   res <- list(lvl = levels(env$y), spec = object)
 
-
-  elapsed <- system.time(
+  if (control$verbosity > 1L) {
+    elapsed <- system.time(
+      res$fit <- eval_mod(
+        fit_call,
+        capture = control$verbosity == 0,
+        catch = control$catch,
+        env = env,
+        ...
+      ),
+      gcFirst = FALSE
+    )
+  } else {
     res$fit <- eval_mod(
       fit_call,
       capture = control$verbosity == 0,
       catch = control$catch,
       env = env,
       ...
     )
-  )
+    elapsed <- list(elapsed = NA_real_)
+  }
 
   if (is.vector(env$y)) {
     y_name <- character(0)

tests/testthat/test_fit_interfaces.R

@@ -84,16 +84,27 @@ test_that("elapsed time parsnip mods", {
   lm1 <-
     linear_reg() %>%
     set_engine("lm") %>%
-    fit_xy(x = mtcars[, 2:4], y = mtcars$mpg)
+    fit_xy(x = mtcars[, 2:4], y = mtcars$mpg,
+           control = control_parsnip(verbosity = 2L))
 
   lm2 <-
     linear_reg() %>%
     set_engine("lm") %>%
-    fit(mpg ~ ., data = mtcars)
+    fit(mpg ~ ., data = mtcars,
+        control = control_parsnip(verbosity = 2))
 
   expect_output(print(lm1), "Fit time:")
   expect_output(print(lm2), "Fit time:")
   expect_true(!is.null(lm1$elapsed))
   expect_true(!is.null(lm2$elapsed))
+
+  lm3 <-
+    linear_reg() %>%
+    set_engine("lm") %>%
+    fit_xy(x = mtcars[, 2:4], y = mtcars$mpg)
+
+  output3 <- capture.output(print(lm3))
+
+  expect_equal(sum(grepl("Fit time", output3)), 0)
 })