Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

migrate probably from Imports to Suggests #56

Merged
merged 4 commits into from
Oct 23, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -23,13 +23,13 @@ Imports:
dplyr,
generics,
hardhat,
probably (>= 1.0.3.9000),
purrr,
rlang (>= 1.1.0),
tibble,
tidyselect
Suggests:
modeldata,
probably (>= 1.0.3.9000),
testthat (>= 3.0.0),
workflows
Remotes:
Expand Down
8 changes: 7 additions & 1 deletion R/adjust-equivocal-zone.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
#'
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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,
Expand All @@ -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]])
Expand Down
8 changes: 7 additions & 1 deletion R/adjust-numeric-calibration.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)) {
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
}

Expand Down
6 changes: 6 additions & 0 deletions R/adjust-numeric-range.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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,
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/adjust-predictions-custom.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
8 changes: 7 additions & 1 deletion R/adjust-probability-calibration.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion R/adjust-probability-threshold.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/tailor.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
#'
Expand Down
15 changes: 15 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,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
Expand Down
2 changes: 1 addition & 1 deletion man/adjust_equivocal_zone.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 2 additions & 0 deletions man/adjust_numeric_calibration.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/adjust_predictions_custom.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/adjust_probability_threshold.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/tailor.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

8 changes: 8 additions & 0 deletions tests/testthat/_snaps/utils.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-adjust-equivocal-zone.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
skip_if_not_installed("probably")

test_that("basic adjust_equivocal_zone() usage works", {
skip_if_not_installed("modeldata")
library(dplyr)
Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-adjust-numeric-calibration.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
skip_if_not_installed("probably")

test_that("basic adjust_numeric_calibration usage works", {
library(tibble)

Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-adjust-numeric-range.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
skip_if_not_installed("probably")

test_that("basic adjust_numeric_range() usage works", {
library(tibble)

Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-adjust-probability-calibration.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
skip_if_not_installed("probably")

test_that("basic adjust_probability_calibration() usage works", {
skip_if_not_installed("modeldata")
library(modeldata)
Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-tailor.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
skip_if_not_installed("probably")

test_that("tailor printing", {
expect_snapshot(tailor())
expect_snapshot(tailor())
Expand Down
8 changes: 8 additions & 0 deletions tests/testthat/test-utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down Expand Up @@ -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))
Expand Down
2 changes: 2 additions & 0 deletions tests/testthat/test-validation-rules.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
skip_if_not_installed("probably")

test_that("validation of adjustments (regression)", {
expect_no_condition(
reg_tailor <-
Expand Down
Loading