migrate probably from Imports to Suggests (#56)

* migrate probably from Imports to Suggests * error in adjustments when probably isn't available * skip tests and examples without probably
tidymodels · Oct 23, 2024 · 6e3f0a8 · 6e3f0a8
1 parent 776c2f4
commit 6e3f0a8
Show file tree

Hide file tree

Showing 22 changed files with 80 additions and 11 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -23,7 +23,6 @@ Imports:
     dplyr,
     generics,
     hardhat,
-    probably (>= 1.0.3.9000),
     purrr,
     rlang (>= 1.1.0),
     tibble,
@@ -32,6 +31,7 @@ Imports:
 Suggests: 
     dials,
     modeldata,
+    probably (>= 1.0.3.9000),
     testthat (>= 3.0.0),
     workflows
 Remotes:

diff --git a/R/adjust-equivocal-zone.R b/R/adjust-equivocal-zone.R
@@ -16,7 +16,7 @@
 #' this adjustment just collects metadata on the supplied column names and does
 #' not risk data leakage.
 #'
-#' @examplesIf rlang::is_installed("modeldata")
+#' @examplesIf rlang::is_installed(c("probably", "modeldata"))
 #' library(dplyr)
 #' library(modeldata)
 #'
@@ -48,6 +48,8 @@
 #' predict(tlr_fit, two_class_example) %>% count(predicted)
 #' @export
 adjust_equivocal_zone <- function(x, value = 0.1, threshold = 1 / 2) {
+  validate_probably_available()
+
   check_tailor(x)
   if (!is_tune(value)) {
     check_number_decimal(value, min = 0, max = 1 / 2)
@@ -94,6 +96,8 @@ print.equivocal_zone <- function(x, ...) {
 
 #' @export
 fit.equivocal_zone <- function(object, data, tailor = NULL, ...) {
+  validate_probably_available()
+
   new_adjustment(
     class(object),
     inputs = object$inputs,
@@ -107,6 +111,8 @@ fit.equivocal_zone <- function(object, data, tailor = NULL, ...) {
 
 #' @export
 predict.equivocal_zone <- function(object, new_data, tailor, ...) {
+  validate_probably_available()
+
   est_nm <- tailor$columns$estimate
   prob_nm <- tailor$columns$probabilities[1]
   lvls <- levels(new_data[[est_nm]])

diff --git a/R/adjust-numeric-calibration.R b/R/adjust-numeric-calibration.R
@@ -21,7 +21,7 @@
 #' situated in a workflow, tailors will automatically be estimated with
 #' appropriate subsets of data.
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("probably")
 #' library(tibble)
 #'
 #' # create example data
@@ -46,6 +46,8 @@
 #' predict(tlr_fit, d_test)
 #' @export
 adjust_numeric_calibration <- function(x, method = NULL) {
+  validate_probably_available()
+
   check_tailor(x, calibration_type = "numeric")
   # wait to `check_method()` until `fit()` time
   if (!is.null(method)) {
@@ -84,6 +86,8 @@ print.numeric_calibration <- function(x, ...) {
 
 #' @export
 fit.numeric_calibration <- function(object, data, tailor = NULL, ...) {
+  validate_probably_available()
+
   method <- check_method(object$arguments$method, tailor$type)
   # todo: adjust_numeric_calibration() should take arguments to pass to
   # cal_estimate_* via dots
@@ -111,6 +115,8 @@ fit.numeric_calibration <- function(object, data, tailor = NULL, ...) {
 
 #' @export
 predict.numeric_calibration <- function(object, new_data, tailor, ...) {
+  validate_probably_available()
+
   probably::cal_apply(new_data, object$results$fit)
 }
 

diff --git a/R/adjust-numeric-range.R b/R/adjust-numeric-range.R
@@ -33,6 +33,8 @@
 #' predict(tlr_fit, d)
 #' @export
 adjust_numeric_range <- function(x, lower_limit = -Inf, upper_limit = Inf) {
+  validate_probably_available()
+
   # remaining input checks are done via probably::bound_prediction
   check_tailor(x)
 
@@ -87,6 +89,8 @@ print.numeric_range <- function(x, ...) {
 
 #' @export
 fit.numeric_range <- function(object, data, tailor = NULL, ...) {
+  validate_probably_available()
+
   new_adjustment(
     class(object),
     inputs = object$inputs,
@@ -100,6 +104,8 @@ fit.numeric_range <- function(object, data, tailor = NULL, ...) {
 
 #' @export
 predict.numeric_range <- function(object, new_data, tailor, ...) {
+  validate_probably_available()
+
   est_nm <- tailor$columns$estimate
   lo <- object$arguments$lower_limit
   hi <- object$arguments$upper_limit

diff --git a/R/adjust-predictions-custom.R b/R/adjust-predictions-custom.R
@@ -10,7 +10,7 @@
 #'
 #' @inheritSection adjust_equivocal_zone Data Usage
 #'
-#' @examplesIf rlang::is_installed("modeldata")
+#' @examplesIf rlang::is_installed(c("probably", "modeldata"))
 #' library(modeldata)
 #'
 #' head(two_class_example)

diff --git a/R/adjust-probability-calibration.R b/R/adjust-probability-calibration.R
@@ -16,7 +16,7 @@
 #' @inheritSection adjust_numeric_calibration Data Usage
 #'
 #' @examplesIf FALSE
-# @examplesIf rlang::is_installed("modeldata")
+# @examplesIf rlang::is_installed(c("probably", "modeldata"))
 #' library(modeldata)
 #'
 #' # split example data
@@ -49,6 +49,8 @@
 #'
 #' @export
 adjust_probability_calibration <- function(x, method = NULL) {
+  validate_probably_available()
+
   check_tailor(x, calibration_type = "probability")
   # wait to `check_method()` until `fit()` time
   if (!is.null(method)) {
@@ -87,6 +89,8 @@ print.probability_calibration <- function(x, ...) {
 
 #' @export
 fit.probability_calibration <- function(object, data, tailor = NULL, ...) {
+  validate_probably_available()
+
   method <- check_method(object$arguments$method, tailor$type)
   # todo: adjust_probability_calibration() should take arguments to pass to
   # cal_estimate_* via dots
@@ -115,6 +119,8 @@ fit.probability_calibration <- function(object, data, tailor = NULL, ...) {
 
 #' @export
 predict.probability_calibration <- function(object, new_data, tailor, ...) {
+  validate_probably_available()
+
   probably::cal_apply(
     .data = new_data,
     object = object$results$fit,

diff --git a/R/adjust-probability-threshold.R b/R/adjust-probability-threshold.R
@@ -15,7 +15,7 @@
 #'
 #' @inheritSection adjust_equivocal_zone Data Usage
 #'
-#' @examplesIf rlang::is_installed("modeldata")
+#' @examplesIf rlang::is_installed(c("probably", "modeldata"))
 #' library(modeldata)
 #'
 #' # `predicted` gives hard class predictions based on probability threshold .5

diff --git a/R/tailor.R b/R/tailor.R
@@ -32,7 +32,7 @@
 #' `"multiclass"` types, and can also be passed at `fit()` time instead.
 #' The column names of class probability estimates. These should be given in
 #' the order of the factor levels of the `estimate`.
-#' @examplesIf rlang::is_installed("modeldata")
+#' @examplesIf rlang::is_installed(c("probably", "modeldata"))
 #' library(dplyr)
 #' library(modeldata)
 #'

diff --git a/R/utils.R b/R/utils.R
@@ -193,6 +193,21 @@ is_tailor <- function(x) {
   inherits(x, "tailor")
 }
 
+validate_probably_available <- function(..., call = caller_env()) {
+  check_dots_empty()
+
+  if (!requireNamespace("probably", quietly = TRUE)) {
+    cli_abort(
+      "The {.pkg probably} package must be available to use this adjustment.",
+      call = call
+    )
+  }
+
+  invisible()
+}
+
+requireNamespace <- NULL
+
 #' @export
 #' @keywords internal
 #' @rdname tailor-internals

diff --git a/man/adjust_equivocal_zone.Rd b/man/adjust_equivocal_zone.Rd
diff --git a/man/adjust_numeric_calibration.Rd b/man/adjust_numeric_calibration.Rd
diff --git a/man/adjust_predictions_custom.Rd b/man/adjust_predictions_custom.Rd
diff --git a/man/adjust_probability_threshold.Rd b/man/adjust_probability_threshold.Rd
diff --git a/man/tailor.Rd b/man/tailor.Rd
diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md
@@ -6,6 +6,14 @@
       Error in `adjust_probability_threshold()`:
       ! `x` should be a <tailor> (`?tailor::tailor()`), not a string.
 
+# errors informatively without probably installed
+
+    Code
+      tailor() %>% adjust_numeric_calibration()
+    Condition
+      Error in `adjust_numeric_calibration()`:
+      ! The probably package must be available to use this adjustment.
+
 # fit.tailor() errors informatively with incompatible outcome
 
     Code

diff --git a/tests/testthat/test-adjust-equivocal-zone.R b/tests/testthat/test-adjust-equivocal-zone.R
@@ -1,3 +1,5 @@
+skip_if_not_installed("probably")
+
 test_that("basic adjust_equivocal_zone() usage works", {
   skip_if_not_installed("modeldata")
   library(dplyr)

diff --git a/tests/testthat/test-adjust-numeric-calibration.R b/tests/testthat/test-adjust-numeric-calibration.R
@@ -1,3 +1,5 @@
+skip_if_not_installed("probably")
+
 test_that("basic adjust_numeric_calibration usage works", {
   library(tibble)
 

diff --git a/tests/testthat/test-adjust-numeric-range.R b/tests/testthat/test-adjust-numeric-range.R
@@ -1,3 +1,5 @@
+skip_if_not_installed("probably")
+
 test_that("basic adjust_numeric_range() usage works", {
   library(tibble)
 

diff --git a/tests/testthat/test-adjust-probability-calibration.R b/tests/testthat/test-adjust-probability-calibration.R
@@ -1,3 +1,5 @@
+skip_if_not_installed("probably")
+
 test_that("basic adjust_probability_calibration() usage works", {
   skip_if_not_installed("modeldata")
   library(modeldata)

diff --git a/tests/testthat/test-tailor.R b/tests/testthat/test-tailor.R
@@ -1,3 +1,5 @@
+skip_if_not_installed("probably")
+
 test_that("tailor printing", {
   expect_snapshot(tailor())
   expect_snapshot(tailor())

diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -3,6 +3,12 @@ test_that("check_tailor raises informative error", {
   expect_no_condition(tailor() %>% adjust_probability_threshold(.5))
 })
 
+test_that("errors informatively without probably installed", {
+  testthat::local_mocked_bindings(requireNamespace = function(...) {FALSE})
+
+  expect_snapshot(error = TRUE, tailor() %>% adjust_numeric_calibration())
+})
+
 test_that("tailor_fully_trained works", {
   skip_if_not_installed("modeldata")
   data("two_class_example", package = "modeldata")
@@ -52,6 +58,8 @@ test_that("tailor_fully_trained works", {
 
 
 test_that("tailor_requires_fit works", {
+  skip_if_not_installed("probably")
+
   expect_false(tailor_requires_fit(tailor()))
   expect_false(
     tailor_requires_fit(tailor() %>% adjust_probability_threshold(.5))

diff --git a/tests/testthat/test-validation-rules.R b/tests/testthat/test-validation-rules.R
@@ -1,3 +1,5 @@
+skip_if_not_installed("probably")
+
 test_that("validation of adjustments (regression)", {
   expect_no_condition(
     reg_tailor <-