From 4b6fd1a81aef685cd6a337dc69687a6bddad6746 Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Tue, 24 Sep 2024 09:37:52 -0500 Subject: [PATCH 1/4] correct slot for calibration `method` --- R/adjust-numeric-calibration.R | 2 +- R/adjust-probability-calibration.R | 2 +- .../test-adjust-numeric-calibration.R | 34 +++++++++++++- .../test-adjust-probability-calibration.R | 44 +++++++++++++++++++ 4 files changed, 79 insertions(+), 3 deletions(-) diff --git a/R/adjust-numeric-calibration.R b/R/adjust-numeric-calibration.R index 402ddbc..8170961 100644 --- a/R/adjust-numeric-calibration.R +++ b/R/adjust-numeric-calibration.R @@ -84,7 +84,7 @@ print.numeric_calibration <- function(x, ...) { #' @export fit.numeric_calibration <- function(object, data, tailor = NULL, ...) { - method <- check_method(object$method, tailor$type) + method <- check_method(object$arguments$method, tailor$type) # todo: adjust_numeric_calibration() should take arguments to pass to # cal_estimate_* via dots fit <- diff --git a/R/adjust-probability-calibration.R b/R/adjust-probability-calibration.R index 6b7e16c..1524fcd 100644 --- a/R/adjust-probability-calibration.R +++ b/R/adjust-probability-calibration.R @@ -88,7 +88,7 @@ print.probability_calibration <- function(x, ...) { #' @export fit.probability_calibration <- function(object, data, tailor = NULL, ...) { - method <- check_method(object$method, tailor$type) + method <- check_method(object$arguments$method, tailor$type) # todo: adjust_probability_calibration() should take arguments to pass to # cal_estimate_* via dots fit <- diff --git a/tests/testthat/test-adjust-numeric-calibration.R b/tests/testthat/test-adjust-numeric-calibration.R index 379907d..2e4c37d 100644 --- a/tests/testthat/test-adjust-numeric-calibration.R +++ b/tests/testthat/test-adjust-numeric-calibration.R @@ -32,7 +32,39 @@ test_that("basic adjust_numeric_calibration usage works", { # TODO: write out the probably code manually here }) -# TODO: test sensitivity to function arguments +test_that("adjust_numeric_calibration() respects `method` argument", { + library(tibble) + + set.seed(1) + d_calibration <- tibble(y = rnorm(100), y_pred = y/2 + rnorm(100)) + d_test <- tibble(y = rnorm(100), y_pred = y/2 + rnorm(100)) + + expect_no_condition( + tlr <- + tailor() %>% + adjust_numeric_calibration(method = "isotonic") + ) + + # TODO: cannot be `expect_no_condition()` due to tidymodels/probably#157 + expect_no_error(expect_no_warning( + tlr_fit <- fit(tlr, d_calibration, outcome = y, estimate = y_pred) + )) + + expect_no_error(expect_no_warning( + tlr_pred <- predict(tlr_fit, d_test) + )) + + # classes are as expected + expect_s3_class(tlr, "tailor") + expect_s3_class(tlr_fit, "tailor") + expect_s3_class(tlr_pred, "tbl_df") + + # column names are as expected + expect_equal(colnames(d_test), colnames(tlr_pred)) + + # probably actually used an isotonic calibrator + expect_equal(tlr_fit$adjustments[[1]]$results$fit$method, "Isotonic regression") +}) test_that("adjustment printing", { expect_snapshot(tailor() %>% adjust_numeric_calibration()) diff --git a/tests/testthat/test-adjust-probability-calibration.R b/tests/testthat/test-adjust-probability-calibration.R index 5caafd3..a1b6a9f 100644 --- a/tests/testthat/test-adjust-probability-calibration.R +++ b/tests/testthat/test-adjust-probability-calibration.R @@ -43,6 +43,50 @@ test_that("basic adjust_probability_calibration() usage works", { # TODO: write out the manual code with probably }) +test_that("basic adjust_probability_calibration() usage works", { + skip_if_not_installed("modeldata") + library(modeldata) + + # split example data + set.seed(1) + in_rows <- sample(c(TRUE, FALSE), nrow(two_class_example), replace = TRUE) + d_calibration <- two_class_example[in_rows, ] + d_test <- two_class_example[!in_rows, ] + + # fitting and predicting happens without raising conditions + expect_no_condition( + tlr <- + tailor() %>% + adjust_probability_calibration(method = "isotonic") + ) + + skip("TODO: cannot run until #49 is merged") + + expect_no_condition( + tlr_fit <- fit( + tlr, + d_calibration, + outcome = c(truth), + estimate = c(predicted), + probabilities = c(Class1, Class2) + ) + ) + + expect_no_condition( + tlr_pred <- predict(tlr_fit, d_test) + ) + + # classes are as expected + expect_s3_class(tlr, "tailor") + expect_s3_class(tlr_fit, "tailor") + expect_s3_class(tlr_pred, "tbl_df") + + # column names are as expected + expect_equal(colnames(d_test), colnames(tlr_pred)) + + # probably actually used an isotonic calibrator + expect_equal(tlr_fit$adjustments[[1]]$results$fit$method, "Generalized additive model") +}) test_that("adjustment printing", { expect_snapshot(tailor() %>% adjust_probability_calibration("logistic")) From 117fb1b260761ce40b1679b4b4b5dfd08e6ba7a3 Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Tue, 24 Sep 2024 09:40:01 -0500 Subject: [PATCH 2/4] remove `skip()` re: resolved issue --- tests/testthat/test-adjust-probability-calibration.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/testthat/test-adjust-probability-calibration.R b/tests/testthat/test-adjust-probability-calibration.R index 9c1e2bb..cc4dc42 100644 --- a/tests/testthat/test-adjust-probability-calibration.R +++ b/tests/testthat/test-adjust-probability-calibration.R @@ -58,8 +58,6 @@ test_that("basic adjust_probability_calibration() usage works", { adjust_probability_calibration(method = "isotonic") ) - skip("TODO: cannot run until #49 is merged") - expect_no_condition( tlr_fit <- fit( tlr, From 1b06bfbdf5d1774204f3eaa0d423abd53fdd668d Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Tue, 24 Sep 2024 09:43:40 -0500 Subject: [PATCH 3/4] relax test --- tests/testthat/test-adjust-probability-calibration.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-adjust-probability-calibration.R b/tests/testthat/test-adjust-probability-calibration.R index cc4dc42..3396da2 100644 --- a/tests/testthat/test-adjust-probability-calibration.R +++ b/tests/testthat/test-adjust-probability-calibration.R @@ -58,7 +58,8 @@ test_that("basic adjust_probability_calibration() usage works", { adjust_probability_calibration(method = "isotonic") ) - expect_no_condition( + # TODO: cannot be `expect_no_condition()` due to tidymodels/probably#157 + expect_no_error(expect_no_warning( tlr_fit <- fit( tlr, d_calibration, @@ -66,11 +67,11 @@ test_that("basic adjust_probability_calibration() usage works", { estimate = c(predicted), probabilities = c(Class1, Class2) ) - ) + )) - expect_no_condition( + expect_no_error(expect_no_warning( tlr_pred <- predict(tlr_fit, d_test) - ) + )) # classes are as expected expect_s3_class(tlr, "tailor") From d3ef7fc44388907572abc42ee7a25530f3a5525f Mon Sep 17 00:00:00 2001 From: simonpcouch Date: Tue, 24 Sep 2024 09:52:49 -0500 Subject: [PATCH 4/4] correct expected `method` --- tests/testthat/test-adjust-probability-calibration.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-adjust-probability-calibration.R b/tests/testthat/test-adjust-probability-calibration.R index 3396da2..0ca01b7 100644 --- a/tests/testthat/test-adjust-probability-calibration.R +++ b/tests/testthat/test-adjust-probability-calibration.R @@ -82,7 +82,7 @@ test_that("basic adjust_probability_calibration() usage works", { expect_equal(colnames(d_test), colnames(tlr_pred)) # probably actually used an isotonic calibrator - expect_equal(tlr_fit$adjustments[[1]]$results$fit$method, "Generalized additive model") + expect_equal(tlr_fit$adjustments[[1]]$results$fit$method, "Isotonic regression") }) test_that("adjustment printing", {