tests/testthat/test-summary-table-characterization.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    expect_equal,
    test_that
  ],
  withr[local_options, local_seed]
)

box::use(
  artma / methods / linear_tests[linear_tests],
  artma / methods / nonlinear_tests[nonlinear_tests]
)

# These tests pin the exact printed shape of the linear- and nonlinear-tests
# summary tables on fixed fixtures, ahead of consolidating the three
# `build_summary_table()`/`build_exogeneity_summary()` implementations
# (linear.R, nonlinear.R, exogeneity.R) into one shared builder in
# `libs/formatting/`. Migrated call sites must keep producing the exact same
# data frames captured here. Exogeneity's own build_exogeneity_summary is
# already pinned directly by tests/testthat/test-econometric-exogeneity.R.
#
# Every seeded draw below pins the RNG kind explicitly (via `local_seed()`)
# rather than relying on `set.seed()` alone: other test files can leave the
# global RNG kind changed (e.g. method orchestration switches it to
# "L'Ecuyer-CMRG" for per-method streams), which would otherwise make the
# fixture data, and therefore the pinned tables below, depend on run order.

make_linear_demo_data <- function() {
  local_seed(42, .rng_kind = "Mersenne-Twister", .rng_normal_kind = "Inversion", .rng_sample_kind = "Rejection")
  n_studies <- 6L
  per_study <- 5L
  study_ids <- rep(paste0("S", seq_len(n_studies)), each = per_study)
  se_vals <- runif(n_studies * per_study, min = 0.05, max = 0.15)
  data.frame(
    study_id = study_ids,
    effect = rnorm(n_studies * per_study, mean = 0.2, sd = 0.05),
    se = se_vals,
    study_size = sample(20:80, n_studies * per_study, replace = TRUE),
    precision = 1 / se_vals,
    check.names = FALSE
  )
}

make_nonlinear_demo_data <- function() {
  n_studies <- 15L
  per_study <- 6L
  study_ids <- rep(paste0("S", seq_len(n_studies)), each = per_study)
  base_se <- seq(0.05, 0.12, length.out = per_study)
  se_vals <- rep(base_se, times = n_studies)
  effect_base <- 0.15 + seq(-0.01, 0.01, length.out = n_studies)
  effect_offsets <- seq(-0.02, 0.02, length.out = per_study)
  effect_vals <- rep(effect_base, each = per_study) + rep(effect_offsets, times = n_studies)
  data.frame(
    study_id = study_ids,
    effect = effect_vals,
    se = se_vals,
    stringsAsFactors = FALSE
  )
}

test_that("linear_tests summary table is pinned on fixture data", {
  testthat::skip_if_not_installed("plm")

  df <- make_linear_demo_data()

  local_options(
    "artma.methods.add_significance_marks" = TRUE,
    "artma.methods.linear_tests.bootstrap_replications" = 10L,
    "artma.methods.linear_tests.conf_level" = 0.9,
    "artma.output.number_of_decimals" = 2,
    "artma.verbose" = 1
  )

  local_seed(100, .rng_kind = "Mersenne-Twister", .rng_normal_kind = "Inversion", .rng_sample_kind = "Rejection")
  res <- suppressWarnings(suppressMessages(linear_tests(df)))

  expected <- structure(
    list(
      Metric = c(
        "Publication Bias", "(Std. Error)", "Bootstrap CI (PB)",
        "Effect Beyond Bias", "(Std. Error)", "Bootstrap CI (Effect)",
        "Total Observations", "Standard Errors"
      ),
      OLS = c(
        "-0.25", "(0.30)", "[-0.61, 0.38]", "0.21***", "(0.03)",
        "[0.13, 0.25]", "30", "Cluster-robust (HC1)"
      ),
      `Fixed Effects` = c(
        "-0.19", "(0.33)", "[-0.54, 0.02]", "0.20***", "(0.04)",
        "[0.18, 0.25]", "30", "Cluster-robust (HC1)"
      ),
      # The between estimator is OLS on group means, where plm::vcovHC does not
      # apply and clustering is degenerate; its column is the only one on
      # heteroskedasticity-robust rather than cluster-robust errors.
      `Between Effects` = c(
        "-1.63", "(0.86)", "[-3.95, 0.21]", "0.36**", "(0.10)",
        "[0.17, 0.62]", "30", "Heteroskedasticity-robust (HC1)"
      ),
      `Random Effects` = c(
        "-0.23", "(0.29)", "[-0.59, 0.16]", "0.21***", "(0.03)",
        "[0.18, 0.24]", "30", "Cluster-robust (HC1)"
      ),
      `Study Weighted OLS` = c(
        "-0.17", "(0.30)", "[-0.60, 0.08]", "0.21***", "(0.03)",
        "[0.18, 0.24]", "30", "Cluster-robust (HC1)"
      ),
      `Precision Weighted OLS` = c(
        "-0.24", "(0.24)", "[-0.53, 0.03]", "0.21***", "(0.03)",
        "[0.18, 0.23]", "30", "Cluster-robust (HC1)"
      )
    ),
    row.names = c(
      "Publication Bias", "(Std. Error)", "Bootstrap CI (PB)",
      "Effect Beyond Bias", "(Std. Error)", "Bootstrap CI (Effect)",
      "Total Observations", "Standard Errors"
    ),
    class = "data.frame"
  )

  expect_equal(res$tables$summary, expected)
})

test_that("nonlinear_tests summary table is pinned on fixture data", {
  local_options(
    "artma.methods.nonlinear_tests.add_significance_marks" = TRUE,
    "artma.methods.nonlinear_tests.round_to" = 2L,
    "artma.methods.nonlinear_tests.stem_representative_sample" = "medians",
    "artma.methods.nonlinear_tests.selection_cutoffs" = c(1.96, 2.58),
    "artma.methods.nonlinear_tests.selection_symmetric" = FALSE,
    "artma.methods.nonlinear_tests.selection_model" = "normal",
    "artma.methods.nonlinear_tests.hierarchical_iterations" = 50L,
    "artma.output.number_of_decimals" = 3L,
    "artma.visualization.export_graphics" = FALSE,
    "artma.verbose" = 0L
  )

  df <- make_nonlinear_demo_data()
  local_seed(7, .rng_kind = "Mersenne-Twister", .rng_normal_kind = "Inversion", .rng_sample_kind = "Rejection")
  res <- suppressWarnings(nonlinear_tests(df))

  expected <- structure(
    list(
      Metric = c(
        "Publication Bias", "(Std. Error)", "Effect Beyond Bias",
        "(Std. Error)", "Effect Heterogeneity (tau)", "(Std. Error)",
        "Total observations", "Model observations"
      ),
      # The WAAP standard error is the study-clustered WLS regression SE; the
      # fixture effects are nearly homogeneous, so it rounds below 0.01 here.
      # STEM and Endogenous Kink have no standard error for their
      # heterogeneity estimate, which on this near-homogeneous fixture also
      # rounds to exactly zero; Hierarchical derives both an estimate and an
      # SE from posterior draws of Vbeta.
      WAAP = c("NA", "", "0.13***", "(0.00)", "", "", "90", "15"),
      Stem = c("NA", "", "0.15***", "(0.02)", "0.00", "", "90", "14"),
      Hierarch = c("0.56***", "(0.16)", "0.08", "(0.15)", "0.55***", "(0.10)", "90", "90"),
      `Endogenous Kink` = c("0.57***", "(0.03)", "0.10***", "(0.00)", "0.00", "", "90", "90")
    ),
    row.names = c(
      "Publication Bias", "(Std. Error)", "Effect Beyond Bias",
      "(Std. Error)", "Effect Heterogeneity (tau)", "(Std. Error)",
      "Total observations", "Model observations"
    ),
    class = "data.frame"
  )

  expect_equal(res$tables$summary, expected)
})