tests/testthat/test-prob-roc_aunp.R

In topepo/yardstick: Tidy Characterizations of Model Performance

test_that("AUNP is equivalent to macro_weighted estimator", {
  hpc_f1 <- data_hpc_fold1()

  expect_equal(
    roc_auc(hpc_f1, obs, VF:L, estimator = "macro_weighted")[[".estimate"]],
    roc_aunp(hpc_f1, obs, VF:L)[[".estimate"]]
  )
})

test_that("AUNP is equivalent to macro_weighted estimator with case weights", {
  hpc_cv$weight <- read_weights_hpc_cv()

  expect_equal(
    roc_auc(hpc_cv, obs, VF:L, estimator = "macro_weighted", case_weights = weight)[[".estimate"]],
    roc_aunp(hpc_cv, obs, VF:L, case_weights = weight)[[".estimate"]]
  )
})

test_that("AUNP errors on binary case", {
  expect_snapshot(
    error = TRUE,
    roc_aunp(two_class_example, truth, Class1)
  )
})

test_that("AUNP results match mlr for soybean example", {
  soybeans <- data_soybean()

  # Code to generate this value and `data_soybean()` is in `helper-data.R`
  measures_mlr <- 0.964025841424236

  expect_equal(
    roc_aunp(soybeans, truth, `2-4-d-injury`:`rhizoctonia-root-rot`)[[".estimate"]],
    measures_mlr
  )
})

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

test_that("roc_aunp() - `options` is deprecated", {
  skip_if(getRversion() <= "3.5.3", "Base R used a different deprecated warning class.")
  rlang::local_options(lifecycle_verbosity = "warning")

  expect_snapshot({
    out <- roc_aunp(two_class_example, truth, Class1, Class2, options = 1)
  })

  expect_identical(
    out,
    roc_aunp(two_class_example, truth, Class1, Class2)
  )

  expect_snapshot({
    out <- roc_aunp_vec(
      truth = two_class_example$truth,
      estimate = as.matrix(two_class_example[c("Class1", "Class2")]),
      options = 1
    )
  })

  expect_identical(
    out,
    roc_aunp_vec(
      truth = two_class_example$truth,
      estimate = as.matrix(two_class_example[c("Class1", "Class2")])
    )
  )
})

test_that("works with hardhat case weights", {
  df <- two_class_example

  imp_wgt <- hardhat::importance_weights(seq_len(nrow(df)))
  freq_wgt <- hardhat::frequency_weights(seq_len(nrow(df)))

  expect_no_error(
    roc_aunp_vec(df$truth, as.matrix(df[c("Class1", "Class2")]), case_weights = imp_wgt)
  )

  expect_no_error(
    roc_aunp_vec(df$truth, as.matrix(df[c("Class1", "Class2")]), case_weights = freq_wgt)
  )
})

test_that("work with class_pred input", {
  skip_if_not_installed("probably")

  cp_truth <- probably::as_class_pred(two_class_example$truth, which = 1)
  fct_truth <- two_class_example$truth
  fct_truth[1] <- NA

  estimate <- as.matrix(two_class_example[c("Class1", "Class2")])

  expect_snapshot(
    error = TRUE,
    roc_aunp_vec(cp_truth, estimate)
  )
})