handling no calibration (#88)

* changes for method = "none"

* add data helper for calibration

* bug fix: multinomial data were assigned type "binary"

* expanded testing

* add tests from main back in

* update test data

* re-doc

* changes based on reviewer comments

Author: topepo

R/adjust-numeric-calibration.R

@@ -7,12 +7,14 @@
 #' range of outputs.
 #'
 #' @param x A [tailor()].
-#' @param method Character. One of `"linear"`, `"isotonic"`, or
-#' `"isotonic_boot"`, corresponding to the function from the \pkg{probably}
+#' @param method Character. One of `"linear"`, `"isotonic"`,`"isotonic_boot"`,
+#' or `"none"`, corresponding to the function from the \pkg{probably}
 #' package `probably::cal_estimate_linear()`,
 #' `probably::cal_estimate_isotonic()`, or
 #' `probably::cal_estimate_isotonic_boot()`, respectively. The default is to
 #' use `"linear"` which, despite its name, fits a generalized additive model.
+#' Note that when [fit.tailor()] is called, the value may be changed to `"none"`
+#' if there is insufficient data.
 #' @param ... Optional arguments to pass to the corresponding function in the
 #' \pkg{probably} package. These arguments must be named.
 #'
@@ -37,6 +39,9 @@
 #' This adjustment requires estimation and, as such, different subsets of data
 #' should be used to train it and evaluate its predictions.
 #'
+#' Note that, when calling [fit.tailor()], if the calibration data have zero or
+#' one row, the `method` is changed to `"none"`.
+#'
 #' @return An updated [tailor()] containing the new operation.
 #'
 #' @examplesIf rlang::is_installed("probably")
@@ -66,11 +71,11 @@ adjust_numeric_calibration <- function(x, method = NULL, ...) {
   validate_probably_available()
 
   check_tailor(x, calibration_type = "numeric")
-  # wait to `check_method()` until `fit()` time
+  # We will check the method again during `fit()` using `check_cal_method()`
   if (!is.null(method) & !is_tune(method)) {
     arg_match0(
       method,
-      c("linear", "isotonic", "isotonic_boot")
+      c("linear", "isotonic", "isotonic_boot", "none")
     )
   }
 
@@ -128,7 +133,11 @@ print.numeric_calibration <- function(x, ...) {
 fit.numeric_calibration <- function(object, data, tailor = NULL, ...) {
   validate_probably_available()
 
-  method <- check_method(object$arguments$method, tailor$type)
+  method <- check_cal_method(
+    object$arguments$method,
+    type = tailor$type,
+    cal_data = data
+  )
 
   cl <- rlang::call2(
     paste0("cal_estimate_", method),

R/adjust-probability-calibration.R

@@ -9,10 +9,12 @@
 #'
 #' @inheritParams adjust_numeric_calibration
 #' @param method Character. One of `"logistic"`, `"multinomial"`,
-#' `"beta"`, `"isotonic"`, or `"isotonic_boot"`, corresponding to the
+#' `"beta"`, `"isotonic"`, `"isotonic_boot"`, or `"none"`, corresponding to the
 #' function from the \pkg{probably} package `probably::cal_estimate_logistic()`,
 #' `probably::cal_estimate_multinomial()`, etc., respectively.  The default is to
 #' use `"logistic"` which, despite its name, fits a generalized additive model.
+#' Note that when [fit.tailor()] is called, the value may be changed to `"none"`
+#' if there is insufficient data.
 #'
 #' @details
 #' The "logistic" and "multinomial" methods fit models that predict the observed
@@ -86,11 +88,11 @@ adjust_probability_calibration <- function(x, method = NULL, ...) {
   validate_probably_available()
 
   check_tailor(x, calibration_type = "probability")
-  # wait to `check_method()` until `fit()` time
+  # We will check the method again during `fit()` using `check_cal_method()`
   if (!is.null(method) & !is_tune(method)) {
     arg_match(
       method,
-      c("logistic", "multinomial", "beta", "isotonic", "isotonic_boot")
+      c("logistic", "multinomial", "beta", "isotonic", "isotonic_boot", "none")
     )
   }
 
@@ -148,7 +150,11 @@ print.probability_calibration <- function(x, ...) {
 fit.probability_calibration <- function(object, data, tailor = NULL, ...) {
   validate_probably_available()
 
-  method <- check_method(object$arguments$method, tailor$type)
+  method <- check_cal_method(
+    object$arguments$method,
+    type = tailor$type,
+    cal_data = data
+  )
 
   cl <- rlang::call2(
     paste0("cal_estimate_", method),

R/tailor.R

@@ -167,6 +167,8 @@ print.tailor <- function(x, ...) {
 #' learn from data; in that case, separate subsets of data ought to be used
 #' for training the tailor and evaluating its performance on predictions.
 #'
+#' Note that if `.data` has zero or one row, the `method` is changed to `"none"`.
+#'
 #' @param object A [tailor()].
 #' @param .data,new_data A data frame containing predictions from a model.
 #' @param outcome <[`tidy-select`][dplyr::dplyr_tidy_select]>
@@ -222,6 +224,9 @@ fit.tailor <- function(
   columns$probabilities <- names(
     tidyselect::eval_select(enquo(probabilities), .data)
   )
+  # For type = "binary", update based on number of probability estimates
+  object$type <- update_type(object$type, columns$probabilities)
+
   if (
     "probability" %in%
       purrr::map_chr(object$adjustments, purrr::pluck, "inputs")

R/utils.R

@@ -333,19 +333,20 @@ check_calibration_type <- function(
   }
 }
 
-types_regression <- c("linear", "isotonic", "isotonic_boot")
-types_binary <- c("logistic", "beta", "isotonic", "isotonic_boot")
-types_multiclass <- c("multinomial", "beta", "isotonic", "isotonic_boot")
+types_regression <- c("linear", "isotonic", "isotonic_boot", "none")
+types_binary <- c("logistic", "beta", "isotonic", "isotonic_boot", "none")
+types_multiclass <- c("multinomial", "beta", "isotonic", "isotonic_boot", "none")
 # a check function to be called when a tailor is being `fit()`ted.
 # by the time a tailor is fitted, we have:
 # * `method`, the `method` argument passed to an `adjust_*` function
 #     * this argument has already been checked to agree with the kind of
 #       `adjust_*()` function via `arg_match0()`.
 # * `tailor_type`, the `type` argument either specified in `tailor()`
 #   or inferred in `fit.tailor()`.
-check_method <- function(
+check_cal_method <- function(
   method,
   type,
+  cal_data,
   arg = caller_arg(method),
   call = caller_env()
 ) {
@@ -357,6 +358,15 @@ check_method <- function(
     )
   }
 
+  if (nrow(cal_data) < 2) {
+    cli::cli_warn(
+      "The calibration data has {nrow(cal_data)} row{?s}. There is not enough
+      data for calibration so {.arg method} is changed from {.val {method}}
+      to {.val none}."
+    )
+    method <- "none"
+  }
+
   # if no `method` was supplied, infer a reasonable one based on the `type`
   if (is.null(method)) {
     switch(

R/validation-rules.R

@@ -114,6 +114,9 @@ infer_type <- function(orderings) {
     return("regression")
   }
 
+  # Note: default for classification is "binary"; this can be updated once
+  # the data are seen. If there are 3+ classes, the type is changed to
+  # "multiclass"
   if (
     all(orderings$output_prob | orderings$output_class | orderings$output_all)
   ) {
@@ -122,3 +125,12 @@ infer_type <- function(orderings) {
 
   "unknown"
 }
+
+update_type <- function(type, probabilities) {
+  if (type  == "binary") {
+    if (length(probabilities) > 2) {
+      type <- "multiclass"
+    }
+  }
+  type
+}

man/adjust_numeric_calibration.Rd

@@ -48,25 +48,53 @@
       adjust_numeric_calibration(tailor(), "boop")
     Condition
       Error in `adjust_numeric_calibration()`:
-      ! `method` must be one of "linear", "isotonic", or "isotonic_boot", not "boop".
+      ! `method` must be one of "linear", "isotonic", "isotonic_boot", or "none", not "boop".
 
 ---
 
     Code
       adjust_numeric_calibration(tailor(), "binary")
     Condition
       Error in `adjust_numeric_calibration()`:
-      ! `method` must be one of "linear", "isotonic", or "isotonic_boot", not "binary".
+      ! `method` must be one of "linear", "isotonic", "isotonic_boot", or "none", not "binary".
       i Did you mean "linear"?
 
 # tuning the calibration method
 
     Code
-      fit(tlr, d_calibration, outcome = y, estimate = y_pred)
+      fit(tlr, d_reg_calibration, outcome = y, estimate = y_pred)
     Condition
       Error in `fit()`:
       ! The calibration method cannot be a value of `tune()` at `fit()` time.
 
+# too few data
+
+    Code
+      fit(tlr, d_reg_calibration[0, ], outcome = y, estimate = y_pred)
+    Condition
+      Warning:
+      The calibration data has 0 rows. There is not enough data for calibration so `method` is changed from "linear" to "none".
+    Message
+      
+      -- tailor ----------------------------------------------------------------------
+      A regression postprocessor with 1 adjustment:
+      
+      * Re-calibrate numeric predictions using linear method. [trained]
+
+---
+
+    Code
+      fit(tlr, d_reg_calibration[1, ], outcome = y, estimate = y_pred)
+    Condition
+      Warning:
+      The calibration data has 1 row. There is not enough data for calibration so `method` is changed from "linear" to "none".
+    Message
+      
+      -- tailor ----------------------------------------------------------------------
+      A regression postprocessor with 1 adjustment:
+      
+      * Re-calibrate numeric predictions using linear method. [trained]
+
 # passing arguments to adjust_numeric_calibration
 
     Code