diff --git a/DESCRIPTION b/DESCRIPTION index 747fa76..8d276a8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: container Title: Sandbox for a postprocessor object -Version: 0.0.0.9000 +Version: 0.0.0.9001 Authors@R: c( person("Simon", "Couch", , "simon.couch@posit.co", role = "aut"), person("Hannah", "Frick", , "hannah@posit.co", role = "aut"), diff --git a/R/adjust-equivocal-zone.R b/R/adjust-equivocal-zone.R index 6df78b8..8f785a1 100644 --- a/R/adjust-equivocal-zone.R +++ b/R/adjust-equivocal-zone.R @@ -9,7 +9,7 @@ #' library(modeldata) #' #' post_obj <- -#' container(mode = "classification") %>% +#' container() %>% #' adjust_equivocal_zone(value = 1 / 4) #' #' @@ -43,7 +43,6 @@ adjust_equivocal_zone <- function(x, value = 0.1, threshold = 1 / 2) { ) new_container( - mode = x$mode, type = x$type, operations = c(x$operations, list(op)), columns = x$dat, diff --git a/R/adjust-numeric-calibration.R b/R/adjust-numeric-calibration.R index 19c3176..7e38327 100644 --- a/R/adjust-numeric-calibration.R +++ b/R/adjust-numeric-calibration.R @@ -1,7 +1,7 @@ #' Re-calibrate numeric predictions #' #' @param x A [container()]. -#' @param type Character. One of `"linear"`, `"isotonic"`, or +#' @param method Character. One of `"linear"`, `"isotonic"`, or #' `"isotonic_boot"`, corresponding to the function from the \pkg{probably} #' package [probably::cal_estimate_linear()], #' [probably::cal_estimate_isotonic()], or @@ -19,21 +19,21 @@ #' #' # specify calibration #' reg_ctr <- -#' container(mode = "regression") %>% -#' adjust_numeric_calibration(type = "linear") +#' container() %>% +#' adjust_numeric_calibration(method = "linear") #' #' # train container #' reg_ctr_trained <- fit(reg_ctr, dat, outcome = y, estimate = y_pred) #' #' predict(reg_ctr_trained, dat) #' @export -adjust_numeric_calibration <- function(x, type = NULL) { +adjust_numeric_calibration <- function(x, method = NULL) { # to-do: add argument specifying `prop` in initial_split check_container(x, calibration_type = "numeric") - # wait to `check_type()` until `fit()` time - if (!is.null(type)) { + # wait to `check_method()` until `fit()` time + if (!is.null(method)) { arg_match0( - type, + method, c("linear", "isotonic", "isotonic_boot") ) } @@ -43,13 +43,12 @@ adjust_numeric_calibration <- function(x, type = NULL) { "numeric_calibration", inputs = "numeric", outputs = "numeric", - arguments = list(type = type), + arguments = list(method = method), results = list(), trained = FALSE ) new_container( - mode = x$mode, type = x$type, operations = c(x$operations, list(op)), columns = x$dat, @@ -67,13 +66,13 @@ print.numeric_calibration <- function(x, ...) { #' @export fit.numeric_calibration <- function(object, data, container = NULL, ...) { - type <- check_type(object$type, container$type) + method <- check_method(object$method, container$type) # todo: adjust_numeric_calibration() should take arguments to pass to # cal_estimate_* via dots fit <- eval_bare( call2( - paste0("cal_estimate_", type), + paste0("cal_estimate_", method), .data = data, truth = container$columns$outcome, estimate = container$columns$estimate, diff --git a/R/adjust-numeric-range.R b/R/adjust-numeric-range.R index 3a5e21c..49b77bb 100644 --- a/R/adjust-numeric-range.R +++ b/R/adjust-numeric-range.R @@ -19,7 +19,6 @@ adjust_numeric_range <- function(x, lower_limit = -Inf, upper_limit = Inf) { ) new_container( - mode = x$mode, type = x$type, operations = c(x$operations, list(op)), columns = x$dat, diff --git a/R/adjust-predictions-custom.R b/R/adjust-predictions-custom.R index 8b61ab9..ef8e7c4 100644 --- a/R/adjust-predictions-custom.R +++ b/R/adjust-predictions-custom.R @@ -9,7 +9,7 @@ #' library(modeldata) #' #' post_obj <- -#' container(mode = "classification") %>% +#' container() %>% #' adjust_equivocal_zone() %>% #' adjust_predictions_custom(linear_predictor = binomial()$linkfun(Class2)) #' @@ -39,7 +39,6 @@ adjust_predictions_custom <- function(x, ..., .pkgs = character(0)) { ) new_container( - mode = x$mode, type = x$type, operations = c(x$operations, list(op)), columns = x$dat, diff --git a/R/adjust-probability-calibration.R b/R/adjust-probability-calibration.R index 6206d53..35ea6e3 100644 --- a/R/adjust-probability-calibration.R +++ b/R/adjust-probability-calibration.R @@ -1,18 +1,18 @@ #' Re-calibrate classification probability predictions #' #' @param x A [container()]. -#' @param type Character. One of `"logistic"`, `"multinomial"`, +#' @param method Character. One of `"logistic"`, `"multinomial"`, #' `"beta"`, `"isotonic"`, or `"isotonic_boot"`, corresponding to the #' function from the \pkg{probably} package [probably::cal_estimate_logistic()], #' [probably::cal_estimate_multinomial()], etc., respectively. #' @export -adjust_probability_calibration <- function(x, type = NULL) { +adjust_probability_calibration <- function(x, method = NULL) { # to-do: add argument specifying `prop` in initial_split check_container(x, calibration_type = "probability") - # wait to `check_type()` until `fit()` time - if (!is.null(type)) { + # wait to `check_method()` until `fit()` time + if (!is.null(method)) { arg_match( - type, + method, c("logistic", "multinomial", "beta", "isotonic", "isotonic_boot") ) } @@ -22,13 +22,12 @@ adjust_probability_calibration <- function(x, type = NULL) { "probability_calibration", inputs = "probability", outputs = "probability_class", - arguments = list(type = type), + arguments = list(method = method), results = list(), trained = FALSE ) new_container( - mode = x$mode, type = x$type, operations = c(x$operations, list(op)), columns = x$dat, @@ -46,14 +45,14 @@ print.probability_calibration <- function(x, ...) { #' @export fit.probability_calibration <- function(object, data, container = NULL, ...) { - type <- check_type(object$type, container$type) + method <- check_method(object$method, container$type) # todo: adjust_probability_calibration() should take arguments to pass to # cal_estimate_* via dots # to-do: add argument specifying `prop` in initial_split fit <- eval_bare( call2( - paste0("cal_estimate_", type), + paste0("cal_estimate_", method), .data = data, # todo: make getters for the entries in `columns` truth = container$columns$outcome, diff --git a/R/adjust-probability-threshold.R b/R/adjust-probability-threshold.R index fcf13a3..69eed9c 100644 --- a/R/adjust-probability-threshold.R +++ b/R/adjust-probability-threshold.R @@ -7,7 +7,7 @@ #' library(modeldata) #' #' post_obj <- -#' container(mode = "classification") %>% +#' container() %>% #' adjust_probability_threshold(threshold = .1) #' #' two_class_example %>% count(predicted) @@ -39,7 +39,6 @@ adjust_probability_threshold <- function(x, threshold = 0.5) { ) new_container( - mode = x$mode, type = x$type, operations = c(x$operations, list(op)), columns = x$dat, diff --git a/R/container.R b/R/container.R index a07e852..d3a232a 100644 --- a/R/container.R +++ b/R/container.R @@ -1,7 +1,5 @@ #' Declare post-processing for model predictions #' -#' @param mode The model's mode, one of `"classification"`, or `"regression"`. -#' Modes of `"censored regression"` are not currently supported. #' @param type The model sub-type. Possible values are `"unknown"`, `"regression"`, #' `"binary"`, or `"multiclass"`. #' @param outcome The name of the outcome variable. @@ -14,9 +12,9 @@ #' @param time The name of the predicted event time. (not yet supported) #' @examples #' -#' container(mode = "regression") +#' container() #' @export -container <- function(mode, type = "unknown", outcome = NULL, estimate = NULL, +container <- function(type = "unknown", outcome = NULL, estimate = NULL, probabilities = NULL, time = NULL) { columns <- list( @@ -28,7 +26,6 @@ container <- function(mode, type = "unknown", outcome = NULL, estimate = NULL, ) new_container( - mode, type, operations = list(), columns = columns, @@ -37,13 +34,7 @@ container <- function(mode, type = "unknown", outcome = NULL, estimate = NULL, ) } -new_container <- function(mode, type, operations, columns, ptype, call) { - mode <- arg_match0(mode, c("regression", "classification")) - - if (mode == "regression") { - type <- "regression" - } - +new_container <- function(type, operations, columns, ptype, call) { type <- arg_match0(type, c("unknown", "regression", "binary", "multiclass")) if (!is.list(operations)) { @@ -58,11 +49,11 @@ new_container <- function(mode, type, operations, columns, ptype, call) { } # validate operation order and check duplicates - validate_order(operations, mode, call) + validate_order(operations, type, call) # check columns res <- list( - mode = mode, type = type, operations = operations, + type = type, operations = operations, columns = columns, ptype = ptype ) class(res) <- "container" @@ -120,7 +111,6 @@ fit.container <- function(object, .data, outcome, estimate, probabilities = c(), object <- set_container_type(object, .data[[columns$outcome]]) object <- new_container( - object$mode, object$type, operations = object$operations, columns = columns, diff --git a/R/utils.R b/R/utils.R index b6bcef7..616ed04 100644 --- a/R/utils.R +++ b/R/utils.R @@ -61,13 +61,13 @@ check_container <- function(x, calibration_type = NULL, call = caller_env(), arg # check that the type of calibration ("numeric" or "probability") is # compatible with the container type if (!is.null(calibration_type)) { - container_type <- x$type + type <- x$type switch( - container_type, + type, regression = - check_calibration_type(calibration_type, "numeric", container_type, call = call), - binary = , multinomial = - check_calibration_type(calibration_type, "probability", container_type, call = call) + check_calibration_type(calibration_type, "numeric", type, call = call), + binary = , multiclass = + check_calibration_type(calibration_type, "probability", type, call = call) ) } @@ -90,20 +90,19 @@ types_binary <- c("logistic", "beta", "isotonic", "isotonic_boot") types_multiclass <- c("multinomial", "beta", "isotonic", "isotonic_boot") # a check function to be called when a container is being `fit()`ted. # by the time a container is fitted, we have: -# * `adjust_type`, the `type` argument passed to an `adjust_*` function +# * `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()`. # * `container_type`, the `type` argument either specified in `container()` # or inferred in `fit.container()`. -check_type <- function(adjust_type, - container_type, - arg = caller_arg(adjust_type), +check_method <- function(method, + type, + arg = caller_arg(method), call = caller_env()) { - # if no `adjust_type` was supplied, infer a reasonable one based on the - # `container_type` - if (is.null(adjust_type)) { + # if no `method` was supplied, infer a reasonable one based on the `type` + if (is.null(method)) { switch( - container_type, + type, regression = return("linear"), binary = return("logistic"), multiclass = return("multinomial") @@ -111,33 +110,33 @@ check_type <- function(adjust_type, } switch( - container_type, + type, regression = arg_match0( - adjust_type, + method, types_regression, arg_nm = arg, error_call = call ), binary = arg_match0( - adjust_type, + method, types_binary, arg_nm = arg, error_call = call ), multiclass = arg_match0( - adjust_type, + method, types_multiclass, arg_nm = arg, error_call = call ), arg_match0( - adjust_type, + method, unique(c(types_regression, types_binary, types_multiclass)), arg_nm = arg, error_call = call ) ) - adjust_type + method } diff --git a/R/validation-rules.R b/R/validation-rules.R index a6a74a7..7a8e2a9 100644 --- a/R/validation-rules.R +++ b/R/validation-rules.R @@ -1,4 +1,4 @@ -validate_order <- function(ops, mode, call) { +validate_order <- function(ops, type, call = caller_env()) { orderings <- tibble::new_tibble(list( name = purrr::map_chr(ops, ~ class(.x)[1]), @@ -13,12 +13,17 @@ validate_order <- function(ops, mode, call) { return(invisible(orderings)) } - if (mode == "classification") { - check_classification_order(orderings, call) - } else { - check_regression_order(orderings, call) + if (type == "unknown") { + type <- infer_type(orderings) } + switch( + type, + regression = check_regression_order(orderings, call), + binary = , multiclass = check_classification_order(orderings, call), + invisible() + ) + invisible(orderings) } @@ -83,3 +88,19 @@ check_duplicates <- function(x, call) { } invisible(x) } + +infer_type <- function(orderings) { + if (all(orderings$output_all)) { + return("unknown") + } + + if (all(orderings$output_numeric | orderings$output_all)) { + return("regression") + } + + if (all(orderings$output_prob | orderings$output_class | orderings$output_all)) { + return("binary") + } + + "unknown" +} diff --git a/inst/examples/container_regression_example.qmd b/inst/examples/container_regression_example.qmd index bebdb00..6ff8480 100644 --- a/inst/examples/container_regression_example.qmd +++ b/inst/examples/container_regression_example.qmd @@ -101,7 +101,7 @@ We could manually use `cal_apply()` to adjust predictions, but instead, we'll ad #| label: post-1 post_obj <- - container(mode = "regression") %>% + container() %>% adjust_numeric_calibration(bst_cal) post_obj ``` diff --git a/man/adjust_equivocal_zone.Rd b/man/adjust_equivocal_zone.Rd index 705f41e..75e55f5 100644 --- a/man/adjust_equivocal_zone.Rd +++ b/man/adjust_equivocal_zone.Rd @@ -22,7 +22,7 @@ library(dplyr) library(modeldata) post_obj <- - container(mode = "classification") \%>\% + container() \%>\% adjust_equivocal_zone(value = 1 / 4) diff --git a/man/adjust_numeric_calibration.Rd b/man/adjust_numeric_calibration.Rd index 0650ac0..f37da10 100644 --- a/man/adjust_numeric_calibration.Rd +++ b/man/adjust_numeric_calibration.Rd @@ -4,12 +4,12 @@ \alias{adjust_numeric_calibration} \title{Re-calibrate numeric predictions} \usage{ -adjust_numeric_calibration(x, type = NULL) +adjust_numeric_calibration(x, method = NULL) } \arguments{ \item{x}{A \code{\link[=container]{container()}}.} -\item{type}{Character. One of \code{"linear"}, \code{"isotonic"}, or +\item{method}{Character. One of \code{"linear"}, \code{"isotonic"}, or \code{"isotonic_boot"}, corresponding to the function from the \pkg{probably} package \code{\link[probably:cal_estimate_linear]{probably::cal_estimate_linear()}}, \code{\link[probably:cal_estimate_isotonic]{probably::cal_estimate_isotonic()}}, or @@ -31,8 +31,8 @@ dat # specify calibration reg_ctr <- - container(mode = "regression") \%>\% - adjust_numeric_calibration(type = "linear") + container() \%>\% + adjust_numeric_calibration(method = "linear") # train container reg_ctr_trained <- fit(reg_ctr, dat, outcome = y, estimate = y_pred) diff --git a/man/adjust_predictions_custom.Rd b/man/adjust_predictions_custom.Rd index 4f54ced..2413ec6 100644 --- a/man/adjust_predictions_custom.Rd +++ b/man/adjust_predictions_custom.Rd @@ -22,7 +22,7 @@ library(dplyr) library(modeldata) post_obj <- - container(mode = "classification") \%>\% + container() \%>\% adjust_equivocal_zone() \%>\% adjust_predictions_custom(linear_predictor = binomial()$linkfun(Class2)) diff --git a/man/adjust_probability_calibration.Rd b/man/adjust_probability_calibration.Rd index 3bd2adf..e174da9 100644 --- a/man/adjust_probability_calibration.Rd +++ b/man/adjust_probability_calibration.Rd @@ -4,12 +4,12 @@ \alias{adjust_probability_calibration} \title{Re-calibrate classification probability predictions} \usage{ -adjust_probability_calibration(x, type = NULL) +adjust_probability_calibration(x, method = NULL) } \arguments{ \item{x}{A \code{\link[=container]{container()}}.} -\item{type}{Character. One of \code{"logistic"}, \code{"multinomial"}, +\item{method}{Character. One of \code{"logistic"}, \code{"multinomial"}, \code{"beta"}, \code{"isotonic"}, or \code{"isotonic_boot"}, corresponding to the function from the \pkg{probably} package \code{\link[probably:cal_estimate_logistic]{probably::cal_estimate_logistic()}}, \code{\link[probably:cal_estimate_multinomial]{probably::cal_estimate_multinomial()}}, etc., respectively.} diff --git a/man/adjust_probability_threshold.Rd b/man/adjust_probability_threshold.Rd index ea227dd..b6881df 100644 --- a/man/adjust_probability_threshold.Rd +++ b/man/adjust_probability_threshold.Rd @@ -19,7 +19,7 @@ library(dplyr) library(modeldata) post_obj <- - container(mode = "classification") \%>\% + container() \%>\% adjust_probability_threshold(threshold = .1) two_class_example \%>\% count(predicted) diff --git a/man/container.Rd b/man/container.Rd index 1d074b5..53b68f1 100644 --- a/man/container.Rd +++ b/man/container.Rd @@ -5,7 +5,6 @@ \title{Declare post-processing for model predictions} \usage{ container( - mode, type = "unknown", outcome = NULL, estimate = NULL, @@ -14,9 +13,6 @@ container( ) } \arguments{ -\item{mode}{The model's mode, one of \code{"classification"}, or \code{"regression"}. -Modes of \code{"censored regression"} are not currently supported.} - \item{type}{The model sub-type. Possible values are \code{"unknown"}, \code{"regression"}, \code{"binary"}, or \code{"multiclass"}.} @@ -37,5 +33,5 @@ Declare post-processing for model predictions } \examples{ -container(mode = "regression") +container() } diff --git a/tests/testthat/_snaps/adjust-equivocal-zone.md b/tests/testthat/_snaps/adjust-equivocal-zone.md index 4021efc..392c9b9 100644 --- a/tests/testthat/_snaps/adjust-equivocal-zone.md +++ b/tests/testthat/_snaps/adjust-equivocal-zone.md @@ -1,7 +1,7 @@ # adjustment printing Code - ctr_cls %>% adjust_equivocal_zone() + container() %>% adjust_equivocal_zone() Message -- Container ------------------------------------------------------------------- @@ -12,7 +12,7 @@ --- Code - ctr_cls %>% adjust_equivocal_zone(hardhat::tune()) + container() %>% adjust_equivocal_zone(hardhat::tune()) Message -- Container ------------------------------------------------------------------- diff --git a/tests/testthat/_snaps/adjust-numeric-calibration.md b/tests/testthat/_snaps/adjust-numeric-calibration.md index 0d904a3..06aac0e 100644 --- a/tests/testthat/_snaps/adjust-numeric-calibration.md +++ b/tests/testthat/_snaps/adjust-numeric-calibration.md @@ -1,26 +1,26 @@ # adjustment printing Code - ctr_reg %>% adjust_numeric_calibration() + container() %>% adjust_numeric_calibration() Message -- Container ------------------------------------------------------------------- - A regression postprocessor with 1 operation: + A postprocessor with 1 operation: * Re-calibrate numeric predictions. # errors informatively with bad input Code - adjust_numeric_calibration(ctr_reg, "boop") + adjust_numeric_calibration(container(), "boop") Condition Error in `adjust_numeric_calibration()`: - ! `type` must be one of "linear", "isotonic", or "isotonic_boot", not "boop". + ! `method` must be one of "linear", "isotonic", or "isotonic_boot", not "boop". --- Code - container("classification", "binary") %>% adjust_numeric_calibration("linear") + container("binary") %>% adjust_numeric_calibration("linear") Condition Error in `adjust_numeric_calibration()`: ! A binary container is incompatible with the operation `adjust_numeric_calibration()`. @@ -28,9 +28,9 @@ --- Code - container("regression", "regression") %>% adjust_numeric_calibration("binary") + container("regression") %>% adjust_numeric_calibration("binary") Condition Error in `adjust_numeric_calibration()`: - ! `type` must be one of "linear", "isotonic", or "isotonic_boot", not "binary". + ! `method` must be one of "linear", "isotonic", or "isotonic_boot", not "binary". i Did you mean "linear"? diff --git a/tests/testthat/_snaps/adjust-numeric-range.md b/tests/testthat/_snaps/adjust-numeric-range.md index b3df879..2e02acd 100644 --- a/tests/testthat/_snaps/adjust-numeric-range.md +++ b/tests/testthat/_snaps/adjust-numeric-range.md @@ -1,44 +1,44 @@ # adjustment printing Code - ctr_reg %>% adjust_numeric_range() + container() %>% adjust_numeric_range() Message -- Container ------------------------------------------------------------------- - A regression postprocessor with 1 operation: + A postprocessor with 1 operation: * Constrain numeric predictions to be between [-Inf, Inf]. --- Code - ctr_reg %>% adjust_numeric_range(hardhat::tune()) + container() %>% adjust_numeric_range(hardhat::tune()) Message -- Container ------------------------------------------------------------------- - A regression postprocessor with 1 operation: + A postprocessor with 1 operation: * Constrain numeric predictions to be between [?, Inf]. --- Code - ctr_reg %>% adjust_numeric_range(-1, hardhat::tune()) + container() %>% adjust_numeric_range(-1, hardhat::tune()) Message -- Container ------------------------------------------------------------------- - A regression postprocessor with 1 operation: + A postprocessor with 1 operation: * Constrain numeric predictions to be between [-1, ?]. --- Code - ctr_reg %>% adjust_numeric_range(hardhat::tune(), 1) + container() %>% adjust_numeric_range(hardhat::tune(), 1) Message -- Container ------------------------------------------------------------------- - A regression postprocessor with 1 operation: + A postprocessor with 1 operation: * Constrain numeric predictions to be between [?, 1]. diff --git a/tests/testthat/_snaps/adjust-predictions-custom.md b/tests/testthat/_snaps/adjust-predictions-custom.md index 71e9e76..50ccfce 100644 --- a/tests/testthat/_snaps/adjust-predictions-custom.md +++ b/tests/testthat/_snaps/adjust-predictions-custom.md @@ -1,7 +1,7 @@ # adjustment printing Code - ctr_cls %>% adjust_predictions_custom() + container() %>% adjust_predictions_custom() Message -- Container ------------------------------------------------------------------- diff --git a/tests/testthat/_snaps/adjust-probability-calibration.md b/tests/testthat/_snaps/adjust-probability-calibration.md index 2fefbea..9b6376b 100644 --- a/tests/testthat/_snaps/adjust-probability-calibration.md +++ b/tests/testthat/_snaps/adjust-probability-calibration.md @@ -1,7 +1,7 @@ # adjustment printing Code - ctr_cls %>% adjust_probability_calibration("logistic") + container() %>% adjust_probability_calibration("logistic") Message -- Container ------------------------------------------------------------------- @@ -12,16 +12,15 @@ # errors informatively with bad input Code - adjust_probability_calibration(ctr_cls, "boop") + adjust_probability_calibration(container(), "boop") Condition Error in `adjust_probability_calibration()`: - ! `type` must be one of "logistic", "multinomial", "beta", "isotonic", or "isotonic_boot", not "boop". + ! `method` must be one of "logistic", "multinomial", "beta", "isotonic", or "isotonic_boot", not "boop". --- Code - container("regression", "regression") %>% adjust_probability_calibration( - "binary") + container("regression") %>% adjust_probability_calibration("binary") Condition Error in `adjust_probability_calibration()`: ! A regression container is incompatible with the operation `adjust_probability_calibration()`. @@ -29,9 +28,8 @@ --- Code - container("classification", "binary") %>% adjust_probability_calibration( - "linear") + container("binary") %>% adjust_probability_calibration("linear") Condition Error in `adjust_probability_calibration()`: - ! `type` must be one of "logistic", "multinomial", "beta", "isotonic", or "isotonic_boot", not "linear". + ! `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 index 2affcca..5e4b29f 100644 --- a/tests/testthat/_snaps/adjust-probability-threshold.md +++ b/tests/testthat/_snaps/adjust-probability-threshold.md @@ -1,7 +1,7 @@ # adjustment printing Code - ctr_cls %>% adjust_probability_threshold() + container() %>% adjust_probability_threshold() Message -- Container ------------------------------------------------------------------- @@ -12,7 +12,7 @@ --- Code - ctr_cls %>% adjust_probability_threshold(hardhat::tune()) + container() %>% adjust_probability_threshold(hardhat::tune()) Message -- Container ------------------------------------------------------------------- diff --git a/tests/testthat/_snaps/container.md b/tests/testthat/_snaps/container.md index 24aa650..f5f9ab8 100644 --- a/tests/testthat/_snaps/container.md +++ b/tests/testthat/_snaps/container.md @@ -1,7 +1,7 @@ # container printing Code - ctr_cls + container() Message -- Container ------------------------------------------------------------------- @@ -10,7 +10,7 @@ --- Code - container(mode = "classification", type = "binary") + container(type = "binary") Message -- Container ------------------------------------------------------------------- @@ -19,8 +19,7 @@ --- Code - container(mode = "classification", type = "binary") %>% - adjust_probability_threshold(0.2) + container(type = "binary") %>% adjust_probability_threshold(0.2) Message -- Container ------------------------------------------------------------------- @@ -31,8 +30,8 @@ --- Code - container(mode = "classification", type = "binary") %>% - adjust_probability_threshold(0.2) %>% adjust_equivocal_zone() + container(type = "binary") %>% adjust_probability_threshold(0.2) %>% + adjust_equivocal_zone() Message -- Container ------------------------------------------------------------------- diff --git a/tests/testthat/_snaps/validation-rules.md b/tests/testthat/_snaps/validation-rules.md index df42bda..0e9f3ff 100644 --- a/tests/testthat/_snaps/validation-rules.md +++ b/tests/testthat/_snaps/validation-rules.md @@ -1,7 +1,7 @@ # validation of operations (regression) Code - container(mode = "regression") %>% adjust_numeric_range(lower_limit = 2) %>% + container(type = "regression") %>% adjust_numeric_range(lower_limit = 2) %>% adjust_numeric_calibration() %>% adjust_predictions_custom(squared = .pred^2) Condition Error in `adjust_numeric_calibration()`: @@ -10,7 +10,7 @@ # validation of operations (classification) Code - container(mode = "classification") %>% adjust_probability_threshold(threshold = 0.4) %>% + container(type = "binary") %>% adjust_probability_threshold(threshold = 0.4) %>% adjust_probability_calibration() Condition Error in `adjust_probability_calibration()`: @@ -19,7 +19,26 @@ --- Code - container(mode = "classification") %>% adjust_predictions_custom(veg = "potato") %>% + container() %>% adjust_probability_threshold(threshold = 0.4) %>% + adjust_probability_calibration() + Condition + Error in `adjust_probability_calibration()`: + ! Operations that change the hard class predictions must come after operations that update the class probability estimates. + +--- + + Code + container(type = "binary") %>% adjust_predictions_custom(veg = "potato") %>% + adjust_probability_threshold(threshold = 0.4) %>% + adjust_probability_calibration() + Condition + Error in `adjust_probability_calibration()`: + ! Operations that change the hard class predictions must come after operations that update the class probability estimates. + +--- + + Code + container() %>% adjust_predictions_custom(veg = "potato") %>% adjust_probability_threshold(threshold = 0.4) %>% adjust_probability_calibration() Condition @@ -29,7 +48,7 @@ --- Code - container(mode = "classification") %>% adjust_predictions_custom(veg = "potato") %>% + container(type = "binary") %>% adjust_predictions_custom(veg = "potato") %>% adjust_probability_threshold(threshold = 0.4) %>% adjust_probability_threshold(threshold = 0.5) %>% adjust_probability_calibration() @@ -40,7 +59,27 @@ --- Code - container(mode = "classification") %>% adjust_equivocal_zone(value = 0.2) %>% + container() %>% adjust_predictions_custom(veg = "potato") %>% + adjust_probability_threshold(threshold = 0.4) %>% + adjust_probability_threshold(threshold = 0.5) %>% + adjust_probability_calibration() + Condition + Error in `adjust_probability_threshold()`: + ! Operations cannot be duplicated: "probability_threshold" + +--- + + Code + container(type = "binary") %>% adjust_equivocal_zone(value = 0.2) %>% + adjust_probability_threshold(threshold = 0.4) + Condition + Error in `adjust_probability_threshold()`: + ! Equivocal zone addition should come after operations that update the class probability estimates or hard class predictions. + +--- + + Code + container() %>% adjust_equivocal_zone(value = 0.2) %>% adjust_probability_threshold(threshold = 0.4) Condition Error in `adjust_probability_threshold()`: diff --git a/tests/testthat/helper-objects.R b/tests/testthat/helper-objects.R deleted file mode 100644 index 2f53f8c..0000000 --- a/tests/testthat/helper-objects.R +++ /dev/null @@ -1,2 +0,0 @@ -ctr_cls <- container(mode = "classification") -ctr_reg <- container(mode = "regression") diff --git a/tests/testthat/test-adjust-equivocal-zone.R b/tests/testthat/test-adjust-equivocal-zone.R index ab0793e..4ba9b0c 100644 --- a/tests/testthat/test-adjust-equivocal-zone.R +++ b/tests/testthat/test-adjust-equivocal-zone.R @@ -1,4 +1,4 @@ test_that("adjustment printing", { - expect_snapshot(ctr_cls %>% adjust_equivocal_zone()) - expect_snapshot(ctr_cls %>% adjust_equivocal_zone(hardhat::tune())) + expect_snapshot(container() %>% adjust_equivocal_zone()) + expect_snapshot(container() %>% adjust_equivocal_zone(hardhat::tune())) }) diff --git a/tests/testthat/test-adjust-numeric-calibration.R b/tests/testthat/test-adjust-numeric-calibration.R index d664653..d9392ef 100644 --- a/tests/testthat/test-adjust-numeric-calibration.R +++ b/tests/testthat/test-adjust-numeric-calibration.R @@ -1,22 +1,20 @@ test_that("adjustment printing", { - expect_snapshot(ctr_reg %>% adjust_numeric_calibration()) + expect_snapshot(container() %>% adjust_numeric_calibration()) }) test_that("errors informatively with bad input", { # check for `adjust_numeric_calibration(container)` is in `utils.R` tests - expect_snapshot(error = TRUE, adjust_numeric_calibration(ctr_reg, "boop")) + expect_snapshot(error = TRUE, adjust_numeric_calibration(container(), "boop")) expect_snapshot( error = TRUE, - container("classification", "binary") %>% adjust_numeric_calibration("linear") + container("binary") %>% adjust_numeric_calibration("linear") ) expect_snapshot( error = TRUE, - container("regression", "regression") %>% adjust_numeric_calibration("binary") + container("regression") %>% adjust_numeric_calibration("binary") ) - # todo: this should error, mode is incompatible even though type is fine - # expect_snapshot(error = TRUE, adjust_numeric_calibration(ctr_cls, "linear")) - expect_no_condition(adjust_numeric_calibration(ctr_reg)) - expect_no_condition(adjust_numeric_calibration(ctr_reg, "linear")) + expect_no_condition(adjust_numeric_calibration(container())) + expect_no_condition(adjust_numeric_calibration(container(), "linear")) }) diff --git a/tests/testthat/test-adjust-numeric-range.R b/tests/testthat/test-adjust-numeric-range.R index 6e04c75..a2fcad7 100644 --- a/tests/testthat/test-adjust-numeric-range.R +++ b/tests/testthat/test-adjust-numeric-range.R @@ -1,7 +1,7 @@ test_that("adjustment printing", { - expect_snapshot(ctr_reg %>% adjust_numeric_range()) - expect_snapshot(ctr_reg %>% adjust_numeric_range(hardhat::tune())) - expect_snapshot(ctr_reg %>% adjust_numeric_range(-1, hardhat::tune())) - expect_snapshot(ctr_reg %>% adjust_numeric_range(hardhat::tune(), 1)) + expect_snapshot(container() %>% adjust_numeric_range()) + expect_snapshot(container() %>% adjust_numeric_range(hardhat::tune())) + expect_snapshot(container() %>% adjust_numeric_range(-1, hardhat::tune())) + expect_snapshot(container() %>% adjust_numeric_range(hardhat::tune(), 1)) }) diff --git a/tests/testthat/test-adjust-predictions-custom.R b/tests/testthat/test-adjust-predictions-custom.R index 70c6359..f74f6b5 100644 --- a/tests/testthat/test-adjust-predictions-custom.R +++ b/tests/testthat/test-adjust-predictions-custom.R @@ -1,3 +1,3 @@ test_that("adjustment printing", { - expect_snapshot(ctr_cls %>% adjust_predictions_custom()) + expect_snapshot(container() %>% adjust_predictions_custom()) }) diff --git a/tests/testthat/test-adjust-probability-calibration.R b/tests/testthat/test-adjust-probability-calibration.R index 9e68d51..170d12a 100644 --- a/tests/testthat/test-adjust-probability-calibration.R +++ b/tests/testthat/test-adjust-probability-calibration.R @@ -1,22 +1,20 @@ test_that("adjustment printing", { - expect_snapshot(ctr_cls %>% adjust_probability_calibration("logistic")) + expect_snapshot(container() %>% adjust_probability_calibration("logistic")) }) test_that("errors informatively with bad input", { # check for `adjust_probably_calibration(container)` is in `utils.R` tests - expect_snapshot(error = TRUE, adjust_probability_calibration(ctr_cls, "boop")) + expect_snapshot(error = TRUE, adjust_probability_calibration(container(), "boop")) expect_snapshot( error = TRUE, - container("regression", "regression") %>% adjust_probability_calibration("binary") + container("regression") %>% adjust_probability_calibration("binary") ) expect_snapshot( error = TRUE, - container("classification", "binary") %>% adjust_probability_calibration("linear") + container("binary") %>% adjust_probability_calibration("linear") ) - # todo: this should error, mode is incompatible even though type is fine - # expect_snapshot(error = TRUE, adjust_numeric_calibration(ctr_cls, "linear")) - expect_no_condition(adjust_numeric_calibration(ctr_reg)) - expect_no_condition(adjust_numeric_calibration(ctr_reg, "linear")) + expect_no_condition(adjust_numeric_calibration(container())) + expect_no_condition(adjust_numeric_calibration(container(), "linear")) }) diff --git a/tests/testthat/test-adjust-probability-threshold.R b/tests/testthat/test-adjust-probability-threshold.R index 38ae223..94933d7 100644 --- a/tests/testthat/test-adjust-probability-threshold.R +++ b/tests/testthat/test-adjust-probability-threshold.R @@ -1,4 +1,4 @@ test_that("adjustment printing", { - expect_snapshot(ctr_cls %>% adjust_probability_threshold()) - expect_snapshot(ctr_cls %>% adjust_probability_threshold(hardhat::tune())) + expect_snapshot(container() %>% adjust_probability_threshold()) + expect_snapshot(container() %>% adjust_probability_threshold(hardhat::tune())) }) diff --git a/tests/testthat/test-container.R b/tests/testthat/test-container.R index 35837a5..2bc3cfa 100644 --- a/tests/testthat/test-container.R +++ b/tests/testthat/test-container.R @@ -1,12 +1,12 @@ test_that("container printing", { - expect_snapshot(ctr_cls) - expect_snapshot(container(mode = "classification", type = "binary")) + expect_snapshot(container()) + expect_snapshot(container(type = "binary")) expect_snapshot( - container(mode = "classification", type = "binary") %>% + container(type = "binary") %>% adjust_probability_threshold(.2) ) expect_snapshot( - container(mode = "classification", type = "binary") %>% + container(type = "binary") %>% adjust_probability_threshold(.2) %>% adjust_equivocal_zone() ) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 41b093a..f6bd959 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,4 +1,4 @@ test_that("check_container raises informative error", { expect_snapshot(error = TRUE, adjust_probability_threshold("boop")) - expect_no_condition(ctr_cls %>% adjust_probability_threshold(.5)) + expect_no_condition(container() %>% adjust_probability_threshold(.5)) }) diff --git a/tests/testthat/test-validation-rules.R b/tests/testthat/test-validation-rules.R index 421130a..1a6e477 100644 --- a/tests/testthat/test-validation-rules.R +++ b/tests/testthat/test-validation-rules.R @@ -1,25 +1,25 @@ test_that("validation of operations (regression)", { - expect_silent( + expect_no_condition( reg_ctr <- - container(mode = "regression") %>% + container(type = "regression") %>% adjust_numeric_calibration() %>% adjust_numeric_range(lower_limit = 2) %>% adjust_predictions_custom(squared = .pred^2) ) expect_snapshot( - container(mode = "regression") %>% + error = TRUE, + container(type = "regression") %>% adjust_numeric_range(lower_limit = 2) %>% adjust_numeric_calibration() %>% - adjust_predictions_custom(squared = .pred^2), - error = TRUE + adjust_predictions_custom(squared = .pred^2) ) # todo should we error if a mutate occurs beforehand? Can we detect if it # modifies the prediction? - expect_silent( + expect_no_condition( reg_ctr <- - container(mode = "regression") %>% + container(type = "regression") %>% adjust_predictions_custom(squared = .pred^2) %>% adjust_numeric_calibration() %>% adjust_numeric_range(lower_limit = 2) @@ -27,17 +27,16 @@ test_that("validation of operations (regression)", { }) test_that("validation of operations (classification)", { - expect_silent( + expect_no_condition( cls_ctr_1 <- - container(mode = "classification") %>% - # to-do: should be able to supply no `type` argument here + container(type = "binary") %>% adjust_probability_calibration("logistic") %>% adjust_probability_threshold(threshold = .4) ) - expect_silent( + expect_no_condition( cls_ctr_2 <- - container(mode = "classification") %>% + container(type = "binary") %>% adjust_predictions_custom(starch = "potato") %>% adjust_predictions_custom(veg = "green beans") %>% adjust_probability_calibration("logistic") %>% @@ -45,33 +44,75 @@ test_that("validation of operations (classification)", { ) expect_snapshot( - container(mode = "classification") %>% + error = TRUE, + container(type = "binary") %>% + adjust_probability_threshold(threshold = .4) %>% + adjust_probability_calibration() + ) + + expect_snapshot( + error = TRUE, + container() %>% + adjust_probability_threshold(threshold = .4) %>% + adjust_probability_calibration() + ) + + expect_snapshot( + error = TRUE, + container(type = "binary") %>% + adjust_predictions_custom(veg = "potato") %>% adjust_probability_threshold(threshold = .4) %>% - adjust_probability_calibration(), - error = TRUE + adjust_probability_calibration() ) expect_snapshot( - container(mode = "classification") %>% + error = TRUE, + container() %>% adjust_predictions_custom(veg = "potato") %>% adjust_probability_threshold(threshold = .4) %>% - adjust_probability_calibration(), - error = TRUE + adjust_probability_calibration() ) expect_snapshot( - container(mode = "classification") %>% + error = TRUE, + container(type = "binary") %>% adjust_predictions_custom(veg = "potato") %>% adjust_probability_threshold(threshold = .4) %>% adjust_probability_threshold(threshold = .5) %>% - adjust_probability_calibration(), - error = TRUE + adjust_probability_calibration() ) expect_snapshot( - container(mode = "classification") %>% + error = TRUE, + container() %>% + adjust_predictions_custom(veg = "potato") %>% + adjust_probability_threshold(threshold = .4) %>% + adjust_probability_threshold(threshold = .5) %>% + adjust_probability_calibration() + ) + + expect_snapshot( + error = TRUE, + container(type = "binary") %>% adjust_equivocal_zone(value = .2) %>% - adjust_probability_threshold(threshold = .4), - error = TRUE + adjust_probability_threshold(threshold = .4) ) + + expect_snapshot( + error = TRUE, + container() %>% + adjust_equivocal_zone(value = .2) %>% + adjust_probability_threshold(threshold = .4) + ) +}) + +test_that("validation of operations (ambiguous type)", { + expect_no_condition( + ambiguous_ctr <- + container() %>% + adjust_predictions_custom(squared = .pred^2) %>% + adjust_predictions_custom(boop = boop) + ) + + expect_equal(ambiguous_ctr$type, "unknown") })