tests/testthat/test-cal-estimate-beta.R

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

test_that("Beta estimates work - data.frame", {
  skip_if_not_installed("betacal")
  sl_beta <- cal_estimate_beta(segment_logistic, Class, smooth = FALSE)
  expect_cal_type(sl_beta, "binary")
  expect_cal_method(sl_beta, "Beta calibration")
  expect_cal_rows(sl_beta)
  expect_snapshot(print(sl_beta))

  sl_beta_group <- segment_logistic |>
    dplyr::mutate(group = .pred_poor > 0.5) |>
    cal_estimate_beta(Class, smooth = FALSE, .by = group)

  expect_cal_type(sl_beta_group, "binary")
  expect_cal_method(sl_beta_group, "Beta calibration")
  expect_cal_rows(sl_beta_group)
  expect_snapshot(print(sl_beta_group))

  expect_snapshot_error(
    segment_logistic |>
      dplyr::mutate(group1 = 1, group2 = 2) |>
      cal_estimate_beta(Class, smooth = FALSE, .by = c(group1, group2))
  )

})

test_that("Beta estimates work - tune_results", {
  skip_if_not_installed("betacal")
  skip_if_not_installed("modeldata")

  tl_beta <- cal_estimate_beta(testthat_cal_binary())
  expect_cal_type(tl_beta, "binary")
  expect_cal_method(tl_beta, "Beta calibration")
  expect_snapshot(print(tl_beta))

  expect_equal(
    testthat_cal_binary_count(),
    nrow(cal_apply(testthat_cal_binary(), tl_beta))
  )

  # ------------------------------------------------------------------------------
  # multinomial outcomes

  set.seed(100)
  suppressWarnings(
    mtnl_beta <- cal_estimate_beta(testthat_cal_multiclass())
  )
  expect_cal_type(mtnl_beta, "one_vs_all")
  expect_cal_method(mtnl_beta, "Beta calibration")
  expect_snapshot(print(mtnl_beta))

  expect_equal(
    testthat_cal_multiclass_count(),
    nrow(cal_apply(testthat_cal_multiclass(), mtnl_beta))
  )
})

test_that("Beta estimates errors - grouped_df", {
  skip_if_not_installed("betacal")
  expect_snapshot_error(
    cal_estimate_beta(dplyr::group_by(mtcars, vs))
  )
})