tests/testthat/test-cal-apply.R

In tidymodels/probably: Tools for Post-Processing Predicted Values

test_that("Logistic apply works - data.frame", {
  sl_logistic <- cal_estimate_logistic(segment_logistic, Class, smooth = FALSE)
  ap_logistic <- cal_apply(segment_logistic, sl_logistic)

  pred_good <- ap_logistic$.pred_good
  expect_equal(mean(pred_good), 0.3425743, tolerance = 0.000001)
  expect_equal(sd(pred_good), 0.2993934, tolerance = 0.000001)
})

test_that("Logistic apply works - tune_results", {
  skip_if_not_installed("modeldata")

  tct <- testthat_cal_binary()
  tl_logistic <- cal_estimate_logistic(tct, smooth = FALSE)
  tap_logistic <- cal_apply(tct, tl_logistic)
  expect_equal(
    testthat_cal_binary_count(),
    nrow(tap_logistic)
  )
})

test_that("Logistic spline apply works", {
  sl_gam <- cal_estimate_logistic(segment_logistic, Class)
  ap_gam <- cal_apply(segment_logistic, sl_gam)

  pred_good <- ap_gam$.pred_good
  expect_equal(mean(pred_good), 0.3425743, tolerance = 0.000001)
  expect_equal(sd(pred_good), 0.2987027, tolerance = 0.000001)
})

test_that("Logistic spline apply works - tune_results", {
  skip_if_not_installed("modeldata")

  tct <- testthat_cal_binary()
  tl_gam <- cal_estimate_logistic(tct)
  tap_gam <- cal_apply(tct, tl_gam)
  expect_equal(
    testthat_cal_binary_count(),
    nrow(tap_gam)
  )
})

# ------------------------------------------------------------------------------

test_that("Linear apply works - data.frame", {
  sl_linear <- cal_estimate_linear(boosting_predictions_oob, outcome, smooth = FALSE)
  ap_linear <- cal_apply(boosting_predictions_oob, sl_linear)

  pred <- ap_linear$.pred
  expect_equal(mean(pred), 14.87123, tolerance = 0.000001)
  expect_equal(sd(pred), 14.94483, tolerance = 0.000001)
})

test_that("Linear apply works - tune_results", {
  tct <- testthat_cal_reg()
  tl_linear <- cal_estimate_linear(tct, smooth = FALSE)
  tap_linear <- cal_apply(tct, tl_linear)
  expect_equal(
    testthat_cal_reg_count(),
    nrow(tap_linear)
  )
})

test_that("Linear spline apply works", {
  sl_gam <- cal_estimate_linear(boosting_predictions_oob, outcome)
  ap_gam <- cal_apply(boosting_predictions_oob, sl_gam)

  pred <- ap_gam$.pred
  expect_equal(mean(pred), 14.87123, tolerance = 0.000001)
  expect_equal(sd(pred), 15.00711, tolerance = 0.000001)
})

test_that("Linear spline apply works - tune_results", {
  tct <- testthat_cal_reg()
  tl_gam <- cal_estimate_linear(tct)
  tap_gam <- cal_apply(tct, tl_gam)
  expect_equal(
    testthat_cal_reg_count(),
    nrow(tap_gam)
  )
})

# ------------------------------------------------------------------------------

test_that("Isotonic apply works - data.frame", {
  set.seed(100)

  sl_isotonic <- cal_estimate_isotonic(segment_logistic, Class)
  ap_isotonic <- cal_apply(segment_logistic, sl_isotonic)

  pred_good <- ap_isotonic$.pred_good
  expect_equal(mean(pred_good), 0.2839132, tolerance = 0.000001)
  expect_equal(sd(pred_good), 0.3079697, tolerance = 0.000001)
})

test_that("Isotonic apply works - tune_results", {
  skip_if_not_installed("modeldata")

  tct <- testthat_cal_binary()
  tl_isotonic <- cal_estimate_isotonic(tct)
  tap_isotonic <- cal_apply(tct, tl_isotonic)
  expect_equal(
    testthat_cal_binary_count(),
    nrow(tap_isotonic)
  )
})

test_that("Isotonic Bootstrapped apply works - data.frame", {
  sl_boot <- cal_estimate_isotonic_boot(segment_logistic, Class)
  ap_boot <- cal_apply(segment_logistic, sl_boot)

  expect_true(all(ap_boot$.pred_poor + ap_boot$.pred_good == 1))
})

test_that("Isotonic Bootstrapped apply works - tune_results", {
  skip_if_not_installed("modeldata")

  tct <- testthat_cal_binary()
  tl_boot <- cal_estimate_isotonic_boot(tct)
  tap_boot <- cal_apply(tct, tl_boot)
  expect_equal(
    testthat_cal_binary_count(),
    nrow(tap_boot)
  )
})

# ------------------------------------------------------------------------------

test_that("Beta apply works - data.frame", {
  skip_if_not_installed("betacal")
  sl_beta <- cal_estimate_beta(segment_logistic, Class)
  ap_beta <- cal_apply(segment_logistic, sl_beta)

  pred_good <- ap_beta$.pred_good
  expect_equal(mean(pred_good), 0.3425743, tolerance = 0.000001)
  expect_equal(sd(pred_good), 0.294565, tolerance = 0.000001)
})

test_that("Beta apply works - tune_results", {
  skip_if_not_installed("betacal")
  skip_if_not_installed("modeldata")

  tct <- testthat_cal_binary()
  tl_beta <- cal_estimate_beta(tct)
  tap_beta <- cal_apply(tct, tl_beta)
  expect_equal(
    testthat_cal_binary_count(),
    nrow(tap_beta)
  )
})

# ------------------------------------------------------------------------------

test_that("Passing the data frame first returns expected abort message", {
  sl_boot <- cal_estimate_isotonic_boot(segment_logistic, Class)

  expect_error(
    cal_apply(sl_boot, segment_logistic)
  )
})

test_that("Passing a tune_results without saved predictions causes error", {
  skip_if_not_installed("betacal")
  skip_if_not_installed("modeldata")

  tct <- testthat_cal_binary()
  tl_beta <- cal_estimate_beta(tct)
  expect_error(cal_apply(tune::ames_grid_search, tl_beta))
})

test_that("Passing a calibration object as the first arg fails", {
  skip_if_not_installed("betacal")
  sl_beta <- cal_estimate_beta(segment_logistic, Class)
  expect_error(cal_apply(sl_beta, segment_logistic))
})