tests/testthat/test-tabdiagi.R

test_that("tabdiagi calculates a standard 2 x 2 table correctly", {
  x <- tabdiagi(80, 20, 10, 90, show = FALSE)

  expect_s3_class(x, "r4vn_diagi")
  expect_equal(unname(x$estimates["sensitivity"]), 80 / 90)
  expect_equal(unname(x$estimates["specificity"]), 90 / 110)
  expect_equal(unname(x$estimates["ppv"]), 80 / 100)
  expect_equal(unname(x$estimates["npv"]), 90 / 100)
  expect_equal(unname(x$estimates["accuracy"]), 170 / 200)
  expect_equal(unname(x$estimates["lr_pos"]), (80 / 90) / (20 / 110))
  expect_equal(unname(x$estimates["lr_neg"]), (10 / 90) / (90 / 110))
  expect_equal(unname(x$estimates["dor"]), 36)
})

test_that("tabdiagi accepts a b c d aliases", {
  x <- tabdiagi(a = 80, b = 20, c = 10, d = 90, show = FALSE)
  expect_equal(unname(x$estimates["tp"]), 80)
  expect_equal(unname(x$estimates["fp"]), 20)
  expect_equal(unname(x$estimates["fn"]), 10)
  expect_equal(unname(x$estimates["tn"]), 90)
})

test_that("tabdiagi rejects mixed naming systems", {
  expect_error(
    tabdiagi(tp = 80, fp = 20, fn = 10, tn = 90, a = 80, show = FALSE),
    "either"
  )
})

test_that("tabdiagi calculates requested Wilson confidence intervals", {
  x <- tabdiagi(
    80, 20, 10, 90,
    ci = c("sens", "spec"),
    show = FALSE
  )
  expect_true(all(c("sensitivity", "specificity") %in% names(x$ci)))
  expect_true(x$ci$sensitivity[1] < x$estimates["sensitivity"])
  expect_true(x$ci$sensitivity[2] > x$estimates["sensitivity"])
  expect_null(x$ci$ppv)
})

test_that("tabdiagi ci TRUE requests supported intervals", {
  x <- tabdiagi(80, 20, 10, 90, ci = TRUE, show = FALSE)
  expect_true(all(
    c("sensitivity", "specificity", "ppv", "npv", "accuracy", "lr_pos", "lr_neg", "dor") %in%
      names(x$ci)
  ))
})

test_that("tabdiagi prevalence changes PPV and NPV but not sensitivity specificity", {
  x1 <- tabdiagi(80, 20, 10, 90, show = FALSE)
  x2 <- tabdiagi(80, 20, 10, 90, prevalence = 0.10, show = FALSE)

  expect_equal(x1$estimates["sensitivity"], x2$estimates["sensitivity"])
  expect_equal(x1$estimates["specificity"], x2$estimates["specificity"])
  expect_false(isTRUE(all.equal(x1$estimates["ppv"], x2$estimates["ppv"])))
  expect_false(isTRUE(all.equal(x1$estimates["npv"], x2$estimates["npv"])))
})

test_that("tabdiagi handles zero cells without crashing", {
  x <- tabdiagi(10, 0, 2, 20, ci = TRUE, show = FALSE)
  expect_true(is.infinite(x$estimates["lr_pos"]))
  expect_true("dor" %in% names(x$ci))
  expect_true(isTRUE(attr(x$ci$dor, "zero_corrected")))
})

test_that("tabdiagi validates counts", {
  expect_error(tabdiagi(-1, 2, 3, 4, show = FALSE), "non-negative")
  expect_error(tabdiagi(1.5, 2, 3, 4, show = FALSE), "integer")
  expect_error(tabdiagi(0, 0, 0, 0, show = FALSE), "no observations")
})

Try the R4VN package in your browser

Any scripts or data that you put into this service are public.

R4VN documentation built on Sept. 30, 2026, 5:13 p.m.