tests/testthat/test-input-edge-cases.R

In CalibrationCurves: Calibration Performance

# Edge case and regression tests

test_that("constant predictions (all identical p) returns valid CalibrationCurve", {
  set.seed(6174)
  y <- rbinom(100, 1, 0.3)
  p <- rep(0.3, 100)

  # Constant predictions trigger a special code path (returns early)
  res <- val.prob.ci.2(p, y, pl = FALSE)
  expect_s3_class(res, "CalibrationCurve")
  # C-statistic should be 0.5 for uninformative model
  expect_equal(unname(res$stats["C (ROC)"]), 0.5)
})

test_that("small sample (n = 50) works", {
  set.seed(2847)
  y <- rbinom(50, 1, 0.4)
  p <- runif(50, 0.1, 0.9)

  res <- val.prob.ci.2(p, y, pl = FALSE)
  expect_s3_class(res, "CalibrationCurve")
  expect_length(res$stats, 17)
})

test_that("NAs in weights produce a warning and are handled", {
  set.seed(5012)
  y <- rbinom(100, 1, 0.4)
  p <- runif(100, 0.1, 0.9)
  w <- rep(1, 100)
  w[c(1, 5, 10)] <- NA

  expect_warning(
    res <- val.prob.ci.2(p, y, pl = FALSE, weights = w),
    "missing"
  )
  expect_s3_class(res, "CalibrationCurve")
})

test_that("val.prob.ci.2 with logistic calibration curve", {
  set.seed(3309)
  y <- rbinom(200, 1, 0.5)
  p <- runif(200, 0.05, 0.95)

  res <- val.prob.ci.2(p, y, pl = FALSE, logistic.cal = TRUE)
  expect_s3_class(res, "CalibrationCurve")
})

test_that("valProbggplot with logistic calibration curve", {
  set.seed(3309)
  y <- rbinom(200, 1, 0.5)
  p <- runif(200, 0.05, 0.95)

  res <- valProbggplot(p, y, pl = FALSE, logistic.cal = TRUE)
  expect_s3_class(res, "ggplotCalibrationCurve")
})

test_that("val.prob.ci.2 errors on all-zero predictions with allowPerfectPredictions", {
  y <- c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1)
  p <- rep(0, 10)

  expect_error(
    val.prob.ci.2(p, y, pl = FALSE, allowPerfectPredictions = TRUE),
    "deterministic"
  )
})

test_that("val.prob.ci.2 nr.knots validation", {
  set.seed(8816)
  y <- rbinom(200, 1, 0.5)
  p <- runif(200, 0.05, 0.95)

  expect_error(val.prob.ci.2(p, y, pl = FALSE, smooth = "rcs", nr.knots = 6))
  expect_error(val.prob.ci.2(p, y, pl = FALSE, smooth = "rcs", nr.knots = 2))
  # nr.knots = 3 should work
  res <- val.prob.ci.2(p, y, pl = FALSE, smooth = "rcs", nr.knots = 3)
  expect_s3_class(res, "CalibrationCurve")
})

test_that("val.prob.ci.2 dostats = FALSE still returns stats", {
  set.seed(1543)
  y <- rbinom(200, 1, 0.5)
  p <- runif(200, 0.05, 0.95)

  res <- val.prob.ci.2(p, y, pl = FALSE, dostats = FALSE)
  expect_s3_class(res, "CalibrationCurve")
  expect_true(length(res$stats) >= 15)
})

test_that("val.prob.ci.2 dostats with specific stats", {
  set.seed(1543)
  y <- rbinom(200, 1, 0.5)
  p <- runif(200, 0.05, 0.95)

  res <- val.prob.ci.2(p, y, pl = FALSE,
                       dostats = c("C (ROC)", "Intercept", "Slope"))
  expect_s3_class(res, "CalibrationCurve")
})