tests/testthat/test-threshold.R

In evabic: Evaluation of Binary Classifiers

context("Threshold")

X1 <- rnorm(50)
X2 <- rnorm(50)
X3 <- rnorm(50)
predictors <- paste0("X", 1:3)
df_lm <- data.frame(
  X1 = X1,
  X2 = X2,
  X3 = X3,
  X4 = X1 + X2 + X3 + rnorm(50, sd = 0.5),
  X5 = X1 + 3 * X3 + rnorm(50, sd = 0.5),
  X6 = X2 - 2 * X3 + rnorm(50, sd = 0.5),
  X7 = X1 - X2 + rnorm(50, sd = 2),
  Y = X1 - X2 + 3 * X3 + rnorm(50)
)
model <- lm(Y ~ ., data = df_lm)
pvalues <- summary(model)$coefficients[-1, 4]
L <- length(unique(pvalues))
mymeasures <- c("TN", "TPR", "PPV", "FNR", "FDR", "ACC")

df_th <- ebc_tidy_by_threshold(
  detection_values = pvalues,
  true = predictors,
  m = 7,
  measures = mymeasures
)


test_that("output has the correct format", {
  expect_is(df_th, "data.frame")
  expect_equal(colnames(df_th), c("threshold", mymeasures))
  expect_equal(nrow(df_th), L + 1)
})


df_th <- ebc_tidy_by_threshold(
  detection_values = pvalues,
  true = predictors,
  m = 7,
  measures = ebc_allmeasures,
  direction = "<"
)
th <- mean(df_th$threshold[2:3])

test_that("values are correct", {
  expect_equivalent(
    df_th[3, -1],
    ebc_tidy(
      detected = pvalues < th,
      true = predictors,
      m = 7,
      measures = ebc_allmeasures
    )
  )
})

n_letters <- length(letters)
values_letters <- runif(n_letters)
names(values_letters) <- letters
true <- sample(letters, 10)
df_all <- ebc_tidy_by_threshold(
  detection_values = values_letters,
  true = true,
  m = n_letters,
  measures = ebc_allmeasures
)

test_that("relationships betweens values are correct", {
  expect_equal(df_all$TPR, 1 - df_all$FNR)
  expect_equal(df_all$TNR, 1 - df_all$FPR)
  expect_equal(df_all$PPV, 1 - df_all$FDR)
  expect_equal(df_all$NPV, 1 - df_all$FOR)
  HM <- 2 / ((1 / df_all$TPR) + (1 / df_all$PPV))
  expect_equal(df_all$F1[!is.nan(HM)], HM[!is.nan(HM)])
  expect_equal(df_all$DOR, df_all$PLR / df_all$NLR)
})


df_all_leq <-
  ebc_tidy_by_threshold(
    detection_values = values_letters,
    true = true,
    m = n_letters,
    measures = ebc_allmeasures,
    direction = "<="
  )
df_all_geq <-
  ebc_tidy_by_threshold(
    detection_values = values_letters,
    true = true,
    m = n_letters,
    measures = ebc_allmeasures,
    direction = ">="
  )
df_all_g <-
  ebc_tidy_by_threshold(
    detection_values = values_letters,
    true = true,
    m = n_letters,
    measures = ebc_allmeasures,
    direction = ">"
  )

test_that("directions give the correct output", {
  expect_equal(df_all[, -1], df_all_leq[, -1])
  expect_equal(df_all$threshold[-(n_letters + 1)], df_all_leq$threshold[-1])
  expect_equal(df_all_g[, -1], df_all_geq[, -1])
  expect_equal(df_all_g$threshold[-1], df_all_geq$threshold[-(n_letters + 1)])
})

test_that("all or nothing is detected at +/-Inf", {
  expect_equivalent(as.numeric(df_all[1, c("TPR", "TNR")]), c(0, 1))
  expect_equivalent(as.numeric(df_all[n_letters + 1, c("TPR", "TNR")]), c(1, 0))
  expect_equivalent(as.numeric(df_all_g[1, c("TPR", "TNR")]), c(1, 0))
  expect_equivalent(
    as.numeric(df_all_g[n_letters + 1, c("TPR", "TNR")]),
    c(0, 1)
  )
})