merge pr #41: remove tailor(type)

tidymodels · Sep 17, 2024 · dfd9b0e · dfd9b0e
2 parents 6704eb6 + a9bb433
commit dfd9b0e
Show file tree

Hide file tree

Showing 15 changed files with 214 additions and 91 deletions.
diff --git a/R/tailor.R b/R/tailor.R
@@ -19,9 +19,6 @@
 #' with the [tidymodels](https://tidymodels.org) framework; for greatest ease
 #' of use, situate tailors in model workflows with `?workflows::add_tailor()`.
 #'
-#' @param type Character. The model sub-mode. Possible values are
-#' `"unknown"`, `"regression"`, `"binary"`, or `"multiclass"`. Only required
-#' when used independently of `?workflows::add_tailor()`.
 #' @param outcome <[`tidy-select`][dplyr::dplyr_tidy_select]> Only required
 #' when used independently of `?workflows::add_tailor()`, and can also be passed
 #' at `fit()` time instead. The column name of the outcome variable.
@@ -64,18 +61,16 @@
 #' # adjust hard class predictions
 #' predict(tlr_fit, two_class_example) %>% count(predicted)
 #' @export
-tailor <- function(type = "unknown", outcome = NULL, estimate = NULL,
-                      probabilities = NULL) {
+tailor <- function(outcome = NULL, estimate = NULL, probabilities = NULL) {
   columns <-
     list(
       outcome = outcome,
-      type = type,
       estimate = estimate,
       probabilities = probabilities
     )
 
   new_tailor(
-    type,
+    "unknown",
     adjustments = list(),
     columns = columns,
     ptype = tibble::new_tibble(list()),
@@ -84,8 +79,6 @@ tailor <- function(type = "unknown", outcome = NULL, estimate = NULL,
 }
 
 new_tailor <- function(type, adjustments, columns, ptype, call) {
-  type <- arg_match0(type, c("unknown", "regression", "binary", "multiclass"))
-
   if (!is.list(adjustments)) {
     cli_abort("The {.arg adjustments} argument should be a list.", call = call)
   }
@@ -97,8 +90,14 @@ new_tailor <- function(type, adjustments, columns, ptype, call) {
                    {.val adjustment}: {bad_adjustment}.", call = call)
   }
 
+  orderings <- adjustment_orderings(adjustments)
+
+  if (type == "unknown") {
+    type <- infer_type(orderings)
+  }
+
   # validate adjustment order and check duplicates
-  validate_order(adjustments, type, call)
+  validate_order(orderings, type, call)
 
   # check columns
   res <- list(
@@ -233,5 +232,5 @@ set_tailor_type <- function(object, y) {
 # todo setup eval_time
 # todo missing methods:
 # todo tune_args
-# todo tidy
+# todo tidy (this should probably just be `adjustment_orderings()`)
 # todo extract_parameter_set_dials
diff --git a/R/utils.R b/R/utils.R
@@ -88,6 +88,19 @@ tailor_adjustment_requires_fit <- function(x) {
   isTRUE(x$requires_fit)
 }
 
+# an tidy-esque method for adjustment lists, used in validating
+# compatibility of adjustments
+adjustment_orderings <- function(adjustments) {
+  tibble::new_tibble(list(
+    name = purrr::map_chr(adjustments, ~ class(.x)[1]),
+    input = purrr::map_chr(adjustments, ~ .x$inputs),
+    output_numeric = purrr::map_lgl(adjustments, ~ grepl("numeric", .x$outputs)),
+    output_prob = purrr::map_lgl(adjustments, ~ grepl("probability", .x$outputs)),
+    output_class = purrr::map_lgl(adjustments, ~ grepl("class", .x$outputs)),
+    output_all = purrr::map_lgl(adjustments, ~ grepl("everything", .x$outputs))
+  ))
+}
+
 # ad-hoc checking --------------------------------------------------------------
 check_tailor <- function(x, calibration_type = NULL, call = caller_env(), arg = caller_arg(x)) {
   if (!is_tailor(x)) {

diff --git a/R/validation-rules.R b/R/validation-rules.R
@@ -1,21 +1,9 @@
-validate_order <- function(adjustments, type, call = caller_env()) {
-  orderings <-
-    tibble::new_tibble(list(
-      name = purrr::map_chr(adjustments, ~ class(.x)[1]),
-      input = purrr::map_chr(adjustments, ~ .x$inputs),
-      output_numeric = purrr::map_lgl(adjustments, ~ grepl("numeric", .x$outputs)),
-      output_prob = purrr::map_lgl(adjustments, ~ grepl("probability", .x$outputs)),
-      output_class = purrr::map_lgl(adjustments, ~ grepl("class", .x$outputs)),
-      output_all = purrr::map_lgl(adjustments, ~ grepl("everything", .x$outputs))
-    ))
-
-  if (length(adjustments) < 2) {
+validate_order <- function(orderings, type, call = caller_env()) {
+  if (nrow(orderings) < 2) {
     return(invisible(orderings))
   }
 
-  if (type == "unknown") {
-    type <- infer_type(orderings)
-  }
+  check_incompatible_types(orderings, call)
 
   switch(
     type,
@@ -27,6 +15,24 @@ validate_order <- function(adjustments, type, call = caller_env()) {
   invisible(orderings)
 }
 
+check_incompatible_types <- function(orderings, call) {
+  if (all(c("numeric", "probability") %in% orderings$input)) {
+    numeric_adjustments <- orderings$name[which(orderings$input == "numeric")]
+    probability_adjustments <- orderings$name[which(orderings$input == "probability")]
+    cli_abort(
+      c(
+        "Can't compose adjustments for different prediction types.",
+        "i" = "{cli::qty(numeric_adjustments)}
+               Adjustment{?s} {.fn {paste0('adjust_', numeric_adjustments)}}
+               {cli::qty(numeric_adjustments[-1])} operate{?s} on numerics while
+               {.fn {paste0('adjust_', probability_adjustments)}}
+               {cli::qty(probability_adjustments[-1])} operate{?s} on probabilities."
+      ),
+      call = call
+    )
+  }
+}
+
 check_classification_order <- function(x, call) {
   cal_ind <- which(grepl("calibration$", x$name))
   eq_ind <- which(grepl("equivocal", x$name))

diff --git a/man/tailor.Rd b/man/tailor.Rd
diff --git a/tests/testthat/_snaps/adjust-equivocal-zone.md b/tests/testthat/_snaps/adjust-equivocal-zone.md
@@ -5,7 +5,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A binary postprocessor with 1 adjustment:
       
       * Add equivocal zone of size 0.1.
 
@@ -16,7 +16,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A binary postprocessor with 1 adjustment:
       
       * Add equivocal zone of optimized size.
 
diff --git a/tests/testthat/_snaps/adjust-numeric-calibration.md b/tests/testthat/_snaps/adjust-numeric-calibration.md
@@ -5,7 +5,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A regression postprocessor with 1 adjustment:
       
       * Re-calibrate numeric predictions.
 
@@ -20,15 +20,7 @@
 ---
 
     Code
-      tailor("binary") %>% adjust_numeric_calibration("linear")
-    Condition
-      Error in `adjust_numeric_calibration()`:
-      ! A binary tailor is incompatible with the adjustment `adjust_numeric_calibration()`.
-
----
-
-    Code
-      tailor("regression") %>% adjust_numeric_calibration("binary")
+      tailor() %>% adjust_numeric_calibration("binary")
     Condition
       Error in `adjust_numeric_calibration()`:
       ! `method` must be one of "linear", "isotonic", or "isotonic_boot", not "binary".

diff --git a/tests/testthat/_snaps/adjust-numeric-range.md b/tests/testthat/_snaps/adjust-numeric-range.md
@@ -5,7 +5,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A regression postprocessor with 1 adjustment:
       
       * Constrain numeric predictions to be between [-Inf, Inf].
 
@@ -16,7 +16,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A regression postprocessor with 1 adjustment:
       
       * Constrain numeric predictions to be between [?, Inf].
 
@@ -27,7 +27,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A regression postprocessor with 1 adjustment:
       
       * Constrain numeric predictions to be between [-1, ?].
 
@@ -38,7 +38,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A regression postprocessor with 1 adjustment:
       
       * Constrain numeric predictions to be between [?, 1].
 
diff --git a/tests/testthat/_snaps/adjust-probability-calibration.md b/tests/testthat/_snaps/adjust-probability-calibration.md
@@ -5,7 +5,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A binary postprocessor with 1 adjustment:
       
       * Re-calibrate classification probabilities.
 
@@ -20,15 +20,7 @@
 ---
 
     Code
-      tailor("regression") %>% adjust_probability_calibration("binary")
-    Condition
-      Error in `adjust_probability_calibration()`:
-      ! A regression tailor is incompatible with the adjustment `adjust_probability_calibration()`.
-
----
-
-    Code
-      tailor("binary") %>% adjust_probability_calibration("linear")
+      tailor() %>% adjust_probability_calibration("linear")
     Condition
       Error in `adjust_probability_calibration()`:
       ! `method` must be one of "logistic", "multinomial", "beta", "isotonic", or "isotonic_boot", not "linear".

diff --git a/tests/testthat/_snaps/adjust-probability-threshold.md b/tests/testthat/_snaps/adjust-probability-threshold.md
@@ -5,7 +5,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A binary postprocessor with 1 adjustment:
       
       * Adjust probability threshold to 0.5.
 
@@ -16,7 +16,7 @@
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A postprocessor with 1 adjustment:
+      A binary postprocessor with 1 adjustment:
       
       * Adjust probability threshold to optimized value.
 
diff --git a/tests/testthat/_snaps/tailor.md b/tests/testthat/_snaps/tailor.md
@@ -10,16 +10,16 @@
 ---
 
     Code
-      tailor(type = "binary")
+      tailor()
     Message
       
       -- tailor ----------------------------------------------------------------------
-      A binary postprocessor with 0 adjustments.
+      A postprocessor with 0 adjustments.
 
 ---
 
     Code
-      tailor(type = "binary") %>% adjust_probability_threshold(0.2)
+      tailor() %>% adjust_probability_threshold(0.2)
     Message
       
       -- tailor ----------------------------------------------------------------------
@@ -30,8 +30,7 @@
 ---
 
     Code
-      tailor(type = "binary") %>% adjust_probability_threshold(0.2) %>%
-        adjust_equivocal_zone()
+      tailor() %>% adjust_probability_threshold(0.2) %>% adjust_equivocal_zone()
     Message
       
       -- tailor ----------------------------------------------------------------------