tests/testthat/test-accuracy_metrics.R

In DPComb: Discrete p-Value Combination Tests

# Tests for accuracy_metrics(): variance ratio and normalized Wasserstein distance.
# Reference values are from Table 4 (tab:exqoa) of Contador and Wu (2026).

test_that("var_Y is the correct reference constant for each method", {
  ps <- c(0.2, 0.5, 1)
  expect_equal(accuracy_metrics(ps, "fisher_mean")$var_Y, 4)
  expect_equal(accuracy_metrics(ps, "fisher_median")$var_Y, 4)
  expect_equal(accuracy_metrics(ps, "pearson")$var_Y, 4)
  expect_equal(accuracy_metrics(ps, "george")$var_Y, pi^2 / 3)
  expect_equal(accuracy_metrics(ps, "stouffer")$var_Y, 1)
  expect_equal(accuracy_metrics(ps, "edgington")$var_Y, 1 / 12)
})

test_that("var_ratio equals Var(Z)/Var(Y) and lies in [0, 1]", {
  pL <- c(0.40, (41:100) / 100)
  for (m in c("fisher_mean", "pearson", "stouffer", "edgington", "george")) {
    res <- accuracy_metrics(pL, m)
    expect_equal(res$var_ratio, res$var_Z / res$var_Y)
    expect_true(res$var_ratio >= 0 && res$var_ratio <= 1 + 1e-8)
    expect_equal(res$norm_dist, res$W2 / sqrt(res$var_Y))
  }
})

test_that("accuracy_metrics reproduces Table 4 for P_L (large mass at small p-values)", {
  pL <- c(0.40, (41:100) / 100)
  ratio_ref <- c(fisher_mean = 0.600, pearson = 0.980, stouffer = 0.874,
                 edgington = 0.936, george = 0.842)
  ndist_ref <- c(fisher_mean = 0.469, pearson = 0.139, stouffer = 0.337,
                 edgington = 0.379, george = 0.337)
  for (m in names(ratio_ref)) {
    res <- accuracy_metrics(pL, m)
    expect_equal(res$var_ratio, unname(ratio_ref[m]), tolerance = 5e-3)
    expect_equal(res$norm_dist, unname(ndist_ref[m]), tolerance = 5e-3)
  }
})

test_that("accuracy_metrics reproduces Table 4 for P_C (large mass at center)", {
  pC <- c((1:30) / 100, 0.70, (71:100) / 100)
  ratio_ref <- c(fisher_mean = 0.966, pearson = 0.966, stouffer = 0.962,
                 edgington = 0.936, george = 0.966)
  ndist_ref <- c(fisher_mean = 0.182, pearson = 0.182, stouffer = 0.191,
                 edgington = 0.270, george = 0.207)
  for (m in names(ratio_ref)) {
    res <- accuracy_metrics(pC, m)
    expect_equal(res$var_ratio, unname(ratio_ref[m]), tolerance = 5e-3)
    expect_equal(res$norm_dist, unname(ndist_ref[m]), tolerance = 5e-3)
  }
})

test_that("accuracy_metrics validates its inputs", {
  expect_error(accuracy_metrics(c(0.2, 0.1, 1)), "nondecreasing")
  expect_error(accuracy_metrics(c(0.2, 0.5, 1), method = "bogus"), "Invalid method")
})