Placement of the eval_time argument (#104)

tidymodels · Feb 28, 2024 · 7bbb18f · 7bbb18f
1 parent e65925b
commit 7bbb18f
Show file tree

Hide file tree

Showing 10 changed files with 215 additions and 114 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -56,4 +56,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
diff --git a/NEWS.md b/NEWS.md
@@ -12,6 +12,11 @@
 
 * Updates based on the new version of tune, primarily for survival analysis models. 
 
+## Breaking Change
+
+* `show_best.tune_race()` gains an `eval_time` argument for censored regression models. This breaks passing `n` by position (#104).
+
+
 # finetune 1.1.0
 
 * Various minor changes to keep up with developments in the tune and dplyr packages (#60) (#62) (#67) (#68). 

diff --git a/R/racing_helpers.R b/R/racing_helpers.R
@@ -704,7 +704,7 @@ collect_metrics.tune_race <- function(x, summarize = TRUE, all_configs = FALSE,
 #' resampled). Comparing performance metrics for configurations averaged with
 #' different resamples is likely to lead to inappropriate results.
 #' @export
-show_best.tune_race <- function(x, metric = NULL, n = 5, eval_time = NULL, ...) {
+show_best.tune_race <- function(x, metric = NULL, eval_time = NULL, n = 5, ...) {
   if (!is.null(metric)) {
     # What was used to judge the race and how are they being sorted now?
     metrics <- tune::.get_tune_metrics(x)
@@ -722,7 +722,7 @@ show_best.tune_race <- function(x, metric = NULL, n = 5, eval_time = NULL, ...)
   x <- dplyr::select(x, -.order)
   final_configs <- subset_finished_race(x)
 
-  res <- NextMethod(metric = metric, n = Inf, eval_time = eval_time, ...)
+  res <- NextMethod(metric = metric, eval_time = eval_time, n = Inf, ...)
   res$.ranked <- 1:nrow(res)
   res <- dplyr::inner_join(res, final_configs, by = ".config")
   res$.ranked <- NULL

diff --git a/R/tune_race_anova.R b/R/tune_race_anova.R
@@ -20,12 +20,12 @@
 #'  tuning parameter candidates. An integer denotes the number of candidate
 #'  parameter sets to be created automatically.
 #' @param metrics A [yardstick::metric_set()] or `NULL`.
-#' @param control An object used to modify the tuning process. See
-#'  [control_race()] for more details.
 #' @param eval_time A numeric vector of time points where dynamic event time
 #' metrics should be computed (e.g. the time-dependent ROC curve, etc). The
 #' values must be non-negative and should probably be no greater than the
 #' largest event time in the training set (See Details below).
+#' @param control An object used to modify the tuning process. See
+#'  [control_race()] for more details.
 #' @param ... Not currently used.
 #' @references
 #' Kuhn, M 2014. "Futility Analysis in the Cross-Validation of Machine Learning
@@ -123,43 +123,70 @@ tune_race_anova.default <- function(object, ...) {
 
 #' @export
 tune_race_anova.recipe <-
-  function(object, model, resamples, ..., param_info = NULL, grid = 10,
-           metrics = NULL, control = control_race(), eval_time = NULL) {
+  function(object,
+           model,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     tune::empty_ellipses(...)
 
     control <- parsnip::condense_control(control, control_race())
 
     tune_race_anova(
       model,
-      preprocessor = object, resamples = resamples,
-      param_info = param_info, grid = grid,
-      metrics = metrics, control = control,
-      eval_time = eval_time
+      preprocessor = object,
+      resamples = resamples,
+      param_info = param_info,
+      grid = grid,
+      metrics = metrics,
+      eval_time = eval_time,
+      control = control
     )
   }
 
 #' @export
 tune_race_anova.formula <-
-  function(formula, model, resamples, ..., param_info = NULL, grid = 10,
-           metrics = NULL, control = control_race(), eval_time = NULL) {
+  function(formula,
+           model,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     tune::empty_ellipses(...)
 
     control <- parsnip::condense_control(control, control_race())
 
     tune_race_anova(
       model,
-      preprocessor = formula, resamples = resamples,
-      param_info = param_info, grid = grid,
-      metrics = metrics, control = control,
-      eval_time = eval_time
+      preprocessor = formula,
+      resamples = resamples,
+      param_info = param_info,
+      grid = grid,
+      metrics = metrics,
+      eval_time = eval_time,
+      control = control
     )
   }
 
 #' @export
 #' @rdname tune_race_anova
 tune_race_anova.model_spec <-
-  function(object, preprocessor, resamples, ..., param_info = NULL, grid = 10,
-           metrics = NULL, control = control_race(), eval_time = NULL) {
+  function(object,
+           preprocessor,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     if (rlang::is_missing(preprocessor) || !tune::is_preprocessor(preprocessor)) {
       cli::cli_abort(
         "To tune a model spec, you must preprocess with a formula, recipe, \\
@@ -184,17 +211,23 @@ tune_race_anova.model_spec <-
       resamples = resamples,
       grid = grid,
       metrics = metrics,
+      eval_time = eval_time,
       param_info = param_info,
-      control = control,
-      eval_time = eval_time
+      control = control
     )
   }
 
 #' @export
 #' @rdname tune_race_anova
 tune_race_anova.workflow <-
-  function(object, resamples, ..., param_info = NULL, grid = 10, metrics = NULL,
-           control = control_race(), eval_time = NULL) {
+  function(object,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     tune::empty_ellipses(...)
 
     control <- parsnip::condense_control(control, control_race())
@@ -204,17 +237,23 @@ tune_race_anova.workflow <-
       resamples = resamples,
       grid = grid,
       metrics = metrics,
+      eval_time = eval_time,
       param_info = param_info,
-      control = control,
-      eval_time = eval_time
+      control = control
     )
   }
 
 ## -----------------------------------------------------------------------------
 
 tune_race_anova_workflow <-
-  function(object, resamples, param_info = NULL, grid = 10, metrics = NULL,
-           control = control_race(), eval_time = NULL, call = caller_env()) {
+  function(object,
+           resamples,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race(),
+           call = caller_env()) {
     rlang::check_installed("lme4")
 
     tune::initialize_catalog(control = control)
@@ -252,8 +291,8 @@ tune_race_anova_workflow <-
         param_info = param_info,
         grid = grid,
         metrics = metrics,
-        control = grid_control,
-        eval_time = eval_time
+        eval_time = eval_time,
+        control = grid_control
       )
 
     param_names <- tune::.get_tune_parameter_names(res)
@@ -304,8 +343,8 @@ tune_race_anova_workflow <-
           param_info = param_info,
           grid = new_grid,
           metrics = metrics,
-          control = grid_control,
-          eval_time = eval_time
+          eval_time = eval_time,
+          control = grid_control
         )
 
       res <- restore_tune(res, tmp_res, opt_metric_time)

diff --git a/R/tune_race_win_loss.R b/R/tune_race_win_loss.R
@@ -120,8 +120,15 @@ tune_race_win_loss.default <- function(object, ...) {
 
 #' @export
 tune_race_win_loss.recipe <-
-  function(object, model, resamples, ..., param_info = NULL, grid = 10,
-           metrics = NULL, control = control_race(), eval_time = NULL) {
+  function(object,
+           model,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     tune::empty_ellipses(...)
 
     control <- parsnip::condense_control(control, control_race())
@@ -137,26 +144,43 @@ tune_race_win_loss.recipe <-
 
 #' @export
 tune_race_win_loss.formula <-
-  function(formula, model, resamples, ..., param_info = NULL, grid = 10,
-           metrics = NULL, control = control_race(), eval_time = NULL) {
+  function(formula,
+           model,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     tune::empty_ellipses(...)
 
     control <- parsnip::condense_control(control, control_race())
 
     tune_race_win_loss(
       model,
-      preprocessor = formula, resamples = resamples,
-      param_info = param_info, grid = grid,
-      metrics = metrics, control = control,
-      eval_time = eval_time
+      preprocessor = formula,
+      resamples = resamples,
+      param_info = param_info,
+      grid = grid,
+      metrics = metrics,
+      eval_time = eval_time,
+      control = control
     )
   }
 
 #' @export
 #' @rdname tune_race_win_loss
 tune_race_win_loss.model_spec <-
-  function(object, preprocessor, resamples, ..., param_info = NULL, grid = 10,
-           metrics = NULL, control = control_race(), eval_time = NULL) {
+  function(object,
+           preprocessor,
+           resamples,
+           ...,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race()) {
     if (rlang::is_missing(preprocessor) || !tune::is_preprocessor(preprocessor)) {
       cli::cli_abort(
         "To tune a model spec, you must preprocess with a formula, recipe, \\
@@ -181,17 +205,22 @@ tune_race_win_loss.model_spec <-
       resamples = resamples,
       grid = grid,
       metrics = metrics,
+      eval_time = eval_time,
       param_info = param_info,
-      control = control,
-      eval_time = eval_time
+      control = control
     )
   }
 
 #' @export
 #' @rdname tune_race_win_loss
-tune_race_win_loss.workflow <- function(object, resamples, ..., param_info = NULL,
-                                        grid = 10, metrics = NULL,
-                                        control = control_race(), eval_time = NULL) {
+tune_race_win_loss.workflow <- function(object,
+                                        resamples,
+                                        ...,
+                                        param_info = NULL,
+                                        grid = 10,
+                                        metrics = NULL,
+                                        eval_time = NULL,
+                                        control = control_race()) {
   tune::empty_ellipses(...)
 
   control <- parsnip::condense_control(control, control_race())
@@ -201,17 +230,23 @@ tune_race_win_loss.workflow <- function(object, resamples, ..., param_info = NUL
     resamples = resamples,
     grid = grid,
     metrics = metrics,
+    eval_time = eval_time,
     param_info = param_info,
-    control = control,
-    eval_time = eval_time
+    control = control
   )
 }
 
 ## -----------------------------------------------------------------------------
 
 tune_race_win_loss_workflow <-
-  function(object, resamples, param_info = NULL, grid = 10, metrics = NULL,
-           control = control_race(), eval_time = NULL, call = caller_env()) {
+  function(object,
+           resamples,
+           param_info = NULL,
+           grid = 10,
+           metrics = NULL,
+           eval_time = NULL,
+           control = control_race(),
+           call = caller_env()) {
     rlang::check_installed("BradleyTerry2")
 
     B <- nrow(resamples)
@@ -235,8 +270,8 @@ tune_race_win_loss_workflow <-
         param_info = param_info,
         grid = grid,
         metrics = metrics,
-        control = grid_control,
-        eval_time = eval_time
+        eval_time = eval_time,
+        control = grid_control
       )
 
     param_names <- tune::.get_tune_parameter_names(res)
@@ -288,8 +323,8 @@ tune_race_win_loss_workflow <-
           param_info = param_info,
           grid = new_grid,
           metrics = metrics,
-          control = grid_control,
-          eval_time = eval_time
+          eval_time = eval_time,
+          control = grid_control
         )
       res <- restore_tune(res, tmp_res, opt_metric_time)