tests/testthat/test-linear-tests.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    expect_equal,
    expect_error,
    expect_false,
    expect_gt,
    expect_match,
    expect_message,
    expect_named,
    expect_no_message,
    expect_null,
    expect_true,
    skip_if_not_installed,
    test_that
  ],
  withr[local_options]
)

box::use(
  artma / econometric / linear[
    flag_ci_conflicts,
    linear_model_specs,
    resample_cluster_rows,
    run_linear_models
  ],
  artma / methods / linear_tests[linear_tests]
)

make_demo_data <- function() {
  set.seed(42)
  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
  )
}

# Studies contribute unequal numbers of estimates, which is essential for the
# study-weighted regression tests: with equal counts, every per-observation
# weight is the same constant and any (mis)weighting collapses to plain OLS.
make_unbalanced_data <- function() {
  set.seed(2026)
  sizes <- c(2L, 3L, 5L, 7L, 11L, 4L)
  study_ids <- rep(paste0("S", seq_along(sizes)), times = sizes)
  se_vals <- runif(sum(sizes), min = 0.05, max = 0.2)
  data.frame(
    study_id = study_ids,
    effect = rnorm(sum(sizes), mean = 0.2, sd = 0.05) + 0.3 * se_vals,
    se = se_vals,
    study_size = rep(sizes, times = sizes),
    precision = 1 / se_vals,
    check.names = FALSE
  )
}

# A study with an extreme, trend-breaking `se`/`effect` pair gives the
# unweighted specs a high-leverage point: the analytic clustered-vcov test and
# the percentile bootstrap CI reliably disagree on several rows, which is
# exactly the disagreement `flag_ci_conflicts()` is meant to surface.
make_conflict_data <- function() {
  set.seed(1)
  n_studies <- 10L
  per_study <- 4L
  study_ids <- rep(paste0("S", seq_len(n_studies)), each = per_study)
  se_level <- runif(n_studies, 0.05, 0.15)
  se_level[1] <- 8
  se_vals <- rep(se_level, each = per_study) * exp(rnorm(n_studies * per_study, 0, 0.05))
  effect_level <- rnorm(n_studies, mean = -0.05, sd = 0.02) + 0.02 * se_level
  effect_level[1] <- 5
  effect <- rep(effect_level, each = per_study) + rnorm(n_studies * per_study, 0, 0.01)
  data.frame(
    study_id = study_ids,
    effect = effect,
    se = se_vals,
    study_size = sample(20:80, n_studies * per_study, replace = TRUE),
    precision = 1 / se_vals,
    check.names = FALSE
  )
}

test_that("flag_ci_conflicts marks disagreement between the analytic test and the bootstrap CI", {
  p_value <- c(0.01, 0.5, 0.5, 0.01, NA, 0.01)
  bootstrap_lower <- c(-0.1, -0.1, 0.2, 0.2, -0.1, NA)
  bootstrap_upper <- c(0.5, 0.5, 0.5, 0.5, 0.1, NA)

  result <- flag_ci_conflicts(p_value, bootstrap_lower, bootstrap_upper, conf_level = 0.95)

  expect_equal(
    result,
    c(
      TRUE, # significant analytically, CI includes zero
      FALSE, # not significant, CI includes zero
      TRUE, # not significant, CI excludes zero
      FALSE, # significant, CI excludes zero
      FALSE, # p-value missing (treated as not significant), CI includes zero -> no conflict
      NA # bootstrap CI unavailable
    )
  )
})

test_that("run_linear_models flags and marks conflicting rows on high-leverage data", {
  skip_if_not_installed("plm")

  df <- make_conflict_data()
  opts <- list(
    add_significance_marks = TRUE,
    bootstrap_replications = 60L,
    conf_level = 0.95,
    round_to = 3L
  )

  set.seed(100)
  res <- run_linear_models(df, opts)

  conflicts <- res$coefficients[res$coefficients$ci_conflict %in% TRUE, , drop = FALSE]
  expect_gt(nrow(conflicts), 0)
  expect_true(all(grepl("†$", conflicts$bootstrap_formatted)))

  non_conflicts <- res$coefficients[res$coefficients$ci_conflict %in% FALSE, , drop = FALSE]
  if (nrow(non_conflicts) > 0) {
    expect_false(any(grepl("†", non_conflicts$bootstrap_formatted)))
  }
})

test_that("linear_tests warns when few bootstrap replications are requested", {
  skip_if_not_installed("plm")

  df <- make_demo_data()

  local_options(
    "artma.methods.linear_tests.bootstrap_replications" = 10L,
    "artma.methods.linear_tests.conf_level" = 0.95,
    "artma.verbose" = 1
  )

  # linear_tests() prints its result table regardless of verbosity (the
  # table is the method's deliverable, not progress narration); the test
  # session's global sink (see setup.R) keeps that off the log, while
  # expect_message's own inner handler still sees the signaled condition.
  expect_message(linear_tests(df), "Only 10 bootstrap replications")
})

test_that("linear_tests does not warn about replications when the count is high enough", {
  skip_if_not_installed("plm")

  df <- make_demo_data()

  local_options(
    "artma.methods.linear_tests.bootstrap_replications" = 999L,
    "artma.methods.linear_tests.conf_level" = 0.95,
    "artma.verbose" = 1
  )

  expect_no_message(linear_tests(df), message = "bootstrap replications")
})

test_that("linear_tests reports the count of estimates with disagreeing stars and CIs", {
  skip_if_not_installed("plm")

  df <- make_conflict_data()

  local_options(
    "artma.methods.add_significance_marks" = TRUE,
    "artma.methods.linear_tests.bootstrap_replications" = 60L,
    "artma.methods.linear_tests.conf_level" = 0.95,
    "artma.verbose" = 1
  )

  set.seed(100)
  expect_message(linear_tests(df), "estimates are.*marked with")
})

test_that("linear tests return tidy coefficients and summary", {
  skip_if_not_installed("plm")

  df <- make_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
  )

  res <- linear_tests(df)

  expect_named(res, c("tables", "estimates", "plots", "meta"))
  expect_named(res$tables, "summary")
  expect_named(
    res$meta,
    c("coefficients", "skipped_models", "options"),
    ignore.order = TRUE
  )

  expect_equal(
    sort(unique(res$meta$coefficients$model)),
    sort(c(
      "ols", "fe", "be", "re", "ols_study_weighted", "ols_precision_weighted"
    ))
  )

  expect_equal(nrow(res$meta$coefficients), 12L)
  expect_named(
    res$meta$coefficients,
    c(
      "estimate", "std_error", "statistic", "p_value", "term", "vcov_type",
      "model", "model_label", "n_obs", "term_label", "bootstrap_lower",
      "bootstrap_upper", "significance", "estimate_rounded",
      "std_error_rounded", "estimate_formatted", "std_error_formatted",
      "bootstrap_formatted", "ci_conflict"
    )
  )

  expect_gt(nrow(res$tables$summary), 0)
  expect_equal(
    rownames(res$tables$summary),
    c(
      "Publication Bias", "(Std. Error)", "Bootstrap CI (PB)",
      "Effect Beyond Bias", "(Std. Error)", "Bootstrap CI (Effect)",
      "Total Observations", "Standard Errors"
    )
  )

  # The between column cannot be clustered, so the table has to say so.
  expect_equal(
    res$tables$summary[["Between Effects"]][[8L]],
    "Heteroskedasticity-robust (HC1)"
  )
  expect_equal(res$tables$summary[["OLS"]][[8L]], "Cluster-robust (HC1)")

  expect_true(all(res$meta$coefficients$significance %in% c("", "*", "**", "***")))
  expect_equal(res$meta$options$bootstrap_replications, 10L)
})

test_that("linear tests gracefully skip models with missing columns", {
  df <- make_demo_data()
  df$precision <- NULL

  local_options(
    "artma.methods.add_significance_marks" = FALSE,
    "artma.methods.linear_tests.bootstrap_replications" = 0L,
    "artma.methods.linear_tests.conf_level" = 0.95,
    "artma.output.number_of_decimals" = 3,
    "artma.verbose" = 1
  )

  res <- linear_tests(df)

  expect_false("ols_precision_weighted" %in% res$meta$coefficients$model)
  expect_true("ols_precision_weighted" %in% names(res$meta$skipped_models))
  expect_true(grepl("Missing required columns", res$meta$skipped_models$ols_precision_weighted$reason))
})

test_that("bootstrap CIs are deterministic and seed-identical to the tidy-path implementation", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  opts <- list(
    add_significance_marks = FALSE,
    bootstrap_replications = 50L,
    conf_level = 0.9,
    round_to = 3L
  )

  set.seed(123)
  res <- run_linear_models(df, options = opts)

  set.seed(123)
  res_repeat <- run_linear_models(df, options = opts)

  ci_cols <- c("model", "term", "bootstrap_lower", "bootstrap_upper")
  ci <- res$coefficients[, ci_cols]
  rownames(ci) <- NULL
  expect_equal(ci, res_repeat$coefficients[, ci_cols], ignore_attr = TRUE)

  finite_rows <- is.finite(ci$bootstrap_lower) & is.finite(ci$bootstrap_upper)
  expect_true(all(ci$bootstrap_lower[finite_rows] <= ci$bootstrap_upper[finite_rows]))

  # Reference values pinned when the fast boot_estimate paths were verified
  # against per-replication refits (see the fast-path tests below). The ols
  # and fe values match the pre-optimization clustered-vcov tidy path;
  # enabling the be bootstrap shifted the RNG stream for the specs after it,
  # so those values were regenerated from the verified implementation. The
  # ols_study_weighted values were regenerated again when its weighting was
  # corrected to equal-total-weight per study (issue #365); the resamples are
  # unchanged, only the estimator applied to them.
  expected <- data.frame(
    model = rep(
      c("ols", "fe", "be", "re", "ols_study_weighted", "ols_precision_weighted"),
      each = 2L
    ),
    term = rep(c("effect", "publication_bias"), times = 6L),
    bootstrap_lower = c(
      0.160739545997458, -0.601087904579698,
      0.140819890400399, -0.600311615629511,
      -0.211101307249788, -2.575829691320434,
      0.152547356054246, -0.570520287992651,
      0.135891505542401, -0.603062744099735,
      0.164684612181770, -0.583949862340950
    ),
    bootstrap_upper = c(
      0.237035405467370, 0.165658257380718,
      0.243966037478644, 0.440057444128715,
      0.481753330561316, 3.827252082114144,
      0.243411054603044, 0.301689687613106,
      0.240079968258059, 0.404233453422908,
      0.244794965444753, 0.172746267850587
    ),
    stringsAsFactors = FALSE
  )

  expect_equal(ci, expected, tolerance = 1e-8, ignore_attr = TRUE)
})

test_that("FE effect-beyond-bias SE comes from the auxiliary intercept model, not the slope", {
  skip_if_not_installed("plm")

  df <- make_unbalanced_data()
  res <- run_linear_models(
    df,
    options = list(
      add_significance_marks = FALSE,
      bootstrap_replications = 0L,
      conf_level = 0.95,
      round_to = 3L
    )
  )

  fe <- res$coefficients[res$coefficients$model == "fe", , drop = FALSE]
  se_slope <- fe$std_error[fe$term == "publication_bias"]
  se_effect <- fe$std_error[fe$term == "effect"]

  expect_false(isTRUE(all.equal(se_effect, se_slope)))

  model <- plm::plm(effect ~ se, data = df, model = "within", index = "study_id")
  expected <- plm::within_intercept(
    model,
    vcov = function(m) plm::vcovHC(m, method = "arellano", type = "HC1", cluster = "group")
  )

  expect_equal(fe$estimate[fe$term == "effect"], expected[[1L]], tolerance = 1e-12)
  expect_equal(se_effect, attr(expected, "se")[[1L]], tolerance = 1e-12)
})

test_that("study-weighted OLS gives each study equal total weight", {
  df <- make_unbalanced_data()
  res <- run_linear_models(
    df,
    options = list(
      add_significance_marks = FALSE,
      bootstrap_replications = 0L,
      conf_level = 0.95,
      round_to = 3L
    )
  )

  sw <- res$coefficients[res$coefficients$model == "ols_study_weighted", , drop = FALSE]

  # Independent per-study estimate counts; each study's estimates must enter
  # with lm weight 1/count so every study carries the same total weight.
  counts <- as.vector(table(df$study_id)[as.character(df$study_id)])
  expect_equal(df$study_size, counts)

  reference <- stats::lm(effect ~ se, data = df, weights = 1 / counts)

  expect_equal(
    sw$estimate[sw$term == "effect"],
    stats::coef(reference)[["(Intercept)"]],
    tolerance = 1e-12
  )
  expect_equal(
    sw$estimate[sw$term == "publication_bias"],
    stats::coef(reference)[["se"]],
    tolerance = 1e-12
  )
})

test_that("bootstrap fast paths match slow-path refits on resampled data", {
  skip_if_not_installed("plm")

  set.seed(42)
  n_studies <- 12L
  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)
  df <- data.frame(
    study_id = droplevels(factor(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
  )
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  fast_path_specs <- c("ols", "fe", "be", "re", "ols_study_weighted", "ols_precision_weighted")
  compared <- stats::setNames(integer(length(fast_path_specs)), fast_path_specs)

  set.seed(1234)
  for (replication in seq_len(2L)) {
    rows <- resample_cluster_rows(nrow(df), cluster_splits)
    boot_data <- df[rows, , drop = FALSE]

    for (spec_name in fast_path_specs) {
      spec <- specs[[spec_name]]
      fast <- tryCatch(spec$boot_estimate(df, rows), error = function(e) NULL)
      slow_model <- tryCatch(spec$fit(boot_data), error = function(e) NULL)

      if (is.null(slow_model)) {
        # A degenerate resample (e.g. too few distinct clusters) must fail
        # identically on both paths.
        expect_true(is.null(fast), info = paste(spec_name, "replication", replication))
        next
      }

      # Small resampled clusters can legitimately fail clustered vcov
      # estimation; spec$tidy() reports that with a cli_alert_warning that
      # isn't test-relevant here (this test compares estimates, not vcov
      # diagnostics), so keep it off the log.
      slow_tidy <- suppressMessages(spec$tidy(slow_model, boot_data))
      slow <- stats::setNames(slow_tidy$estimate, slow_tidy$term)

      expect_equal(
        fast[c("effect", "publication_bias")],
        slow[c("effect", "publication_bias")],
        tolerance = 1e-12,
        info = paste(spec_name, "replication", replication)
      )
      compared[spec_name] <- compared[spec_name] + 1L
    }
  }

  expect_true(all(compared > 0L))

  # Under set.seed(1234) no sampled replication is degenerate (every draw
  # keeps at least six distinct clusters), so force a two-cluster resample:
  # too few groups for Swamy-Arora, and both random effects paths must fail
  # identically on it.
  degenerate_rows <- unlist(cluster_splits[rep(c("S1", "S2"), 6L)], use.names = FALSE)
  re_spec <- specs[["re"]]
  expect_null(tryCatch(re_spec$boot_estimate(df, degenerate_rows), error = function(e) NULL))
  expect_null(suppressWarnings(
    tryCatch(re_spec$fit(df[degenerate_rows, , drop = FALSE]), error = function(e) NULL)
  ))
})

test_that("within fast path merges duplicated resampled clusters like plm", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  df$study_id <- droplevels(factor(df$study_id))
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  fe_spec <- specs[["fe"]]

  # Force duplicated clusters so the merge semantics are actually exercised.
  rows <- unlist(
    cluster_splits[c("S1", "S1", "S2", "S3", "S3", "S3")],
    use.names = FALSE
  )
  boot_data <- df[rows, , drop = FALSE]

  fast <- fe_spec$boot_estimate(df, rows)
  model <- plm::plm(effect ~ se, data = boot_data, model = "within", index = "study_id")

  expect_equal(
    fast[["publication_bias"]],
    unname(stats::coef(model)[["se"]]),
    tolerance = 1e-12
  )
  expect_equal(
    fast[["effect"]],
    unname(plm::within_intercept(model)[[1L]]),
    tolerance = 1e-12
  )
})

test_that("between effects standard errors are heteroskedasticity-robust on group means", {
  skip_if_not_installed("plm")
  skip_if_not_installed("sandwich")

  df <- make_demo_data()
  df$study_id <- droplevels(factor(df$study_id))

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  be_spec <- specs[["be"]]

  model <- be_spec$fit(df)

  # The reason the between column needs its own tidy path: plm::vcovHC accepts
  # only random/within/pooling/fd models. Should a future plm gain `between`
  # support, this expectation fails rather than the numbers changing quietly.
  expect_error(
    plm::vcovHC(model, type = "HC1", cluster = "group"),
    regexp = "random"
  )

  tidy <- be_spec$tidy(model, df)

  group <- droplevels(factor(df$study_id))
  first_in_group <- !duplicated(as.integer(group))
  means <- data.frame(
    effect = stats::ave(df$effect, group)[first_in_group],
    se = stats::ave(df$se, group)[first_in_group]
  )
  means_model <- stats::lm(effect ~ se, data = means)
  oracle <- lmtest::coeftest(
    means_model,
    vcov. = sandwich::vcovHC(means_model, type = "HC1")
  )

  expect_equal(tidy$estimate[tidy$term == "effect"], oracle["(Intercept)", "Estimate"])
  expect_equal(tidy$std_error[tidy$term == "effect"], oracle["(Intercept)", "Std. Error"])
  expect_equal(tidy$std_error[tidy$term == "publication_bias"], oracle["se", "Std. Error"])
  expect_equal(unique(tidy$vcov_type), "Heteroskedasticity-robust (HC1)")

  # Point estimates still come from the between estimator itself.
  expect_equal(
    tidy$estimate[tidy$term == "publication_bias"],
    unname(stats::coef(model)[["se"]])
  )

  # Clustering by study after collapsing to one row per study is degenerate:
  # vcovCL returns the HC1 matrix element for element, which is why
  # heteroskedasticity-robust is the ceiling rather than a shortcut.
  expect_equal(
    sandwich::vcovCL(means_model, cluster = seq_len(nrow(means)), type = "HC1"),
    sandwich::vcovHC(means_model, type = "HC1")
  )

  # The classical standard errors the old path fell through to are different
  # numbers, not a rounding difference.
  expect_false(isTRUE(all.equal(
    unname(tidy$std_error[tidy$term == "publication_bias"]),
    unname(sqrt(diag(stats::vcov(model)))[["se"]])
  )))
})

test_that("between effects fast path matches plm on duplicated resampled clusters", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  df$study_id <- droplevels(factor(df$study_id))
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  be_spec <- specs[["be"]]

  # Force duplicated clusters so the merge semantics are actually exercised:
  # duplicated ids collapse to one cluster-mean row with unchanged means.
  rows <- unlist(
    cluster_splits[c("S1", "S1", "S2", "S3", "S3", "S3", "S5")],
    use.names = FALSE
  )
  boot_data <- df[rows, , drop = FALSE]

  fast <- be_spec$boot_estimate(df, rows)
  model <- plm::plm(effect ~ se, data = boot_data, model = "between", index = "study_id")

  expect_equal(
    fast[["effect"]],
    unname(stats::coef(model)[["(Intercept)"]]),
    tolerance = 1e-12
  )
  expect_equal(
    fast[["publication_bias"]],
    unname(stats::coef(model)[["se"]]),
    tolerance = 1e-12
  )
})

test_that("between effects fast path matches plm on unbalanced clusters", {
  skip_if_not_installed("plm")

  set.seed(7)
  sizes <- c(2L, 3L, 5L, 8L, 13L, 21L, 4L, 30L, 2L, 9L)
  study_ids <- rep(paste0("U", seq_along(sizes)), times = sizes)
  se_vals <- runif(sum(sizes), min = 0.05, max = 0.15)
  df <- data.frame(
    study_id = droplevels(factor(study_ids)),
    effect = rnorm(sum(sizes), mean = 0.2, sd = 0.05),
    se = se_vals
  )
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  be_spec <- specs[["be"]]

  set.seed(99)
  for (replication in seq_len(5L)) {
    rows <- resample_cluster_rows(nrow(df), cluster_splits)
    boot_data <- df[rows, , drop = FALSE]

    fast <- tryCatch(be_spec$boot_estimate(df, rows), error = function(e) NULL)
    model <- tryCatch(
      plm::plm(effect ~ se, data = boot_data, model = "between", index = "study_id"),
      error = function(e) NULL
    )

    if (is.null(model)) {
      expect_true(is.null(fast), info = paste("replication", replication))
      next
    }

    expect_equal(
      fast[c("effect", "publication_bias")],
      stats::setNames(
        unname(stats::coef(model)[c("(Intercept)", "se")]),
        c("effect", "publication_bias")
      ),
      tolerance = 1e-12,
      info = paste("replication", replication)
    )
  }
})

test_that("between effects fast path fails on degenerate resamples exactly like plm", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  df$study_id <- droplevels(factor(df$study_id))
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  be_spec <- specs[["be"]]

  # A single distinct cluster leaves fewer mean rows than coefficients.
  rows <- unlist(cluster_splits[c("S2", "S2", "S2")], use.names = FALSE)
  boot_data <- df[rows, , drop = FALSE]

  fast <- tryCatch(be_spec$boot_estimate(df, rows), error = function(e) NULL)
  model <- tryCatch(
    plm::plm(effect ~ se, data = boot_data, model = "between", index = "study_id"),
    error = function(e) NULL
  )

  expect_true(is.null(model))
  expect_true(is.null(fast))

  # Two distinct clusters fit exactly (two mean rows, two coefficients) on
  # both paths, so neither may error there.
  rows <- unlist(cluster_splits[c("S2", "S5")], use.names = FALSE)
  boot_data <- df[rows, , drop = FALSE]

  fast <- be_spec$boot_estimate(df, rows)
  model <- plm::plm(effect ~ se, data = boot_data, model = "between", index = "study_id")

  expect_equal(
    fast[c("effect", "publication_bias")],
    stats::setNames(
      unname(stats::coef(model)[c("(Intercept)", "se")]),
      c("effect", "publication_bias")
    ),
    tolerance = 1e-12
  )
})

test_that("random effects fast path matches plm on duplicated resampled clusters", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  df$study_id <- droplevels(factor(df$study_id))
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  re_spec <- specs[["re"]]

  # Force duplicated clusters so the merge semantics are actually exercised.
  rows <- unlist(
    cluster_splits[c("S1", "S1", "S2", "S3", "S3", "S3", "S5")],
    use.names = FALSE
  )
  boot_data <- df[rows, , drop = FALSE]

  fast <- re_spec$boot_estimate(df, rows)
  model <- plm::plm(effect ~ se, data = boot_data, model = "random", index = "study_id")

  expect_equal(
    fast[["effect"]],
    unname(stats::coef(model)[["(Intercept)"]]),
    tolerance = 1e-12
  )
  expect_equal(
    fast[["publication_bias"]],
    unname(stats::coef(model)[["se"]]),
    tolerance = 1e-12
  )
})

test_that("random effects fast path matches plm on unbalanced clusters", {
  skip_if_not_installed("plm")

  set.seed(7)
  sizes <- c(2L, 3L, 5L, 8L, 13L, 21L, 4L, 30L, 2L, 9L)
  study_ids <- rep(paste0("U", seq_along(sizes)), times = sizes)
  se_vals <- runif(sum(sizes), min = 0.05, max = 0.15)
  df <- data.frame(
    study_id = droplevels(factor(study_ids)),
    effect = rnorm(sum(sizes), mean = 0.2, sd = 0.05),
    se = se_vals
  )
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  re_spec <- specs[["re"]]

  set.seed(99)
  for (replication in seq_len(5L)) {
    rows <- resample_cluster_rows(nrow(df), cluster_splits)
    boot_data <- df[rows, , drop = FALSE]

    fast <- tryCatch(re_spec$boot_estimate(df, rows), error = function(e) NULL)
    model <- tryCatch(
      plm::plm(effect ~ se, data = boot_data, model = "random", index = "study_id"),
      error = function(e) NULL
    )

    if (is.null(model)) {
      expect_true(is.null(fast), info = paste("replication", replication))
      next
    }

    expect_equal(
      fast[c("effect", "publication_bias")],
      stats::setNames(
        unname(stats::coef(model)[c("(Intercept)", "se")]),
        c("effect", "publication_bias")
      ),
      tolerance = 1e-12,
      info = paste("replication", replication)
    )
  }
})

test_that("random effects fast path fails on degenerate resamples exactly like plm", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  df$study_id <- droplevels(factor(df$study_id))
  cluster_splits <- split(seq_len(nrow(df)), df$study_id)

  specs <- linear_model_specs()
  names(specs) <- vapply(specs, function(spec) spec$name, character(1))
  re_spec <- specs[["re"]]

  degenerate_draws <- list(
    single_cluster = c("S2", "S2", "S2"),
    two_clusters = c("S2", "S5")
  )

  for (case in names(degenerate_draws)) {
    rows <- unlist(cluster_splits[degenerate_draws[[case]]], use.names = FALSE)
    boot_data <- df[rows, , drop = FALSE]

    fast <- tryCatch(re_spec$boot_estimate(df, rows), error = function(e) NULL)
    # plm warns about a perfect between fit before erroring on these draws.
    model <- suppressWarnings(tryCatch(
      plm::plm(effect ~ se, data = boot_data, model = "random", index = "study_id"),
      error = function(e) NULL
    ))

    expect_true(is.null(model), info = case)
    expect_true(is.null(fast), info = case)
  }

  # All-singleton clusters: plm rejects the within model as empty.
  singleton_df <- data.frame(
    study_id = droplevels(factor(paste0("P", 1:8))),
    effect = rnorm(8, mean = 0.2, sd = 0.05),
    se = runif(8, min = 0.05, max = 0.15)
  )
  rows <- seq_len(nrow(singleton_df))

  fast <- tryCatch(re_spec$boot_estimate(singleton_df, rows), error = function(e) NULL)
  model <- tryCatch(
    plm::plm(effect ~ se, data = singleton_df, model = "random", index = "study_id"),
    error = function(e) NULL
  )

  expect_true(is.null(model))
  expect_true(is.null(fast))
})

test_that("two-cluster data skips RE and BE with a plain-language reason", {
  skip_if_not_installed("plm")

  set.seed(7)
  df <- make_demo_data()
  df <- df[df$study_id %in% c("S1", "S2"), , drop = FALSE]

  res <- run_linear_models(
    df,
    options = list(
      add_significance_marks = FALSE,
      bootstrap_replications = 0L,
      conf_level = 0.95,
      round_to = 3L
    )
  )

  expect_true(all(c("re", "be") %in% names(res$skipped)))
  expect_true(grepl("Not enough clusters to fit", res$skipped$re$reason))
  expect_true(grepl("Random Effects", res$skipped$re$reason))
  expect_true(grepl("found 2", res$skipped$re$reason))
  expect_true(grepl("Not enough clusters to fit", res$skipped$be$reason))
  expect_true(grepl("Between Effects", res$skipped$be$reason))
  expect_false(grepl("not estimable", res$skipped$re$reason))

  expect_true(all(c("ols", "fe") %in% res$coefficients$model))
})

test_that("singleton-cluster data skips FE and RE with a plain-language reason", {
  skip_if_not_installed("plm")

  set.seed(7)
  n_studies <- 6L
  se_vals <- runif(n_studies, min = 0.05, max = 0.15)
  df <- data.frame(
    study_id = paste0("S", seq_len(n_studies)),
    effect = rnorm(n_studies, mean = 0.2, sd = 0.05),
    se = se_vals,
    study_size = sample(20:80, n_studies, replace = TRUE),
    precision = 1 / se_vals,
    check.names = FALSE
  )

  res <- run_linear_models(
    df,
    options = list(
      add_significance_marks = FALSE,
      bootstrap_replications = 0L,
      conf_level = 0.95,
      round_to = 3L
    )
  )

  expect_true(all(c("fe", "re") %in% names(res$skipped)))
  expect_true(grepl("does not vary within any", res$skipped$fe$reason))
  expect_true(grepl("Fixed Effects", res$skipped$fe$reason))
  expect_true(grepl("Not enough observations to fit", res$skipped$re$reason))
  expect_true(grepl("Random Effects", res$skipped$re$reason))
  expect_false(grepl("empty model", res$skipped$fe$reason))

  expect_true(all(c("ols", "be") %in% res$coefficients$model))
})

test_that("constant within-cluster se skips FE and RE even with many clusters", {
  skip_if_not_installed("plm")

  df <- make_demo_data()
  df$se <- stats::ave(df$se, df$study_id)

  res <- run_linear_models(
    df,
    options = list(
      add_significance_marks = FALSE,
      bootstrap_replications = 0L,
      conf_level = 0.95,
      round_to = 3L
    )
  )

  expect_true(all(c("fe", "re") %in% names(res$skipped)))
  expect_true(grepl("does not vary within any", res$skipped$fe$reason))
  expect_true(grepl("does not vary within any", res$skipped$re$reason))

  expect_true(all(c("ols", "be") %in% res$coefficients$model))
})

test_that("panel models are skipped with a clear message when plm is unavailable", {
  df <- make_demo_data()

  res <- run_linear_models(
    df,
    options = list(
      add_significance_marks = FALSE,
      bootstrap_replications = 0L,
      conf_level = 0.95,
      round_to = 3L
    ),
    is_pkg_available = function(pkg) pkg != "plm"
  )

  panel_models <- c("fe", "be", "re")

  expect_false(any(panel_models %in% res$coefficients$model))
  expect_true(all(panel_models %in% names(res$skipped)))

  reasons <- vapply(res$skipped[panel_models], function(item) item$reason, character(1))
  expect_true(all(grepl("plm", reasons, fixed = TRUE)))
  expect_true(all(grepl("install.packages", reasons, fixed = TRUE)))

  expect_true("ols" %in% res$coefficients$model)
})

test_that("linear tests return unrounded estimates in the shared schema", {
  skip_if_not_installed("plm")

  box::use(
    artma / modules / runtime_methods[ESTIMATES_COLUMNS]
  )

  df <- make_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
  )

  res <- linear_tests(df)
  estimates <- res$estimates

  expect_named(estimates, ESTIMATES_COLUMNS)
  expect_equal(nrow(estimates), nrow(res$meta$coefficients))
  expect_equal(unique(estimates$method), "linear_tests")
  expect_equal(sort(unique(estimates$term)), c("effect", "publication_bias"))

  expect_true(is.numeric(estimates$estimate))
  expect_true(is.numeric(estimates$std_error))
  expect_true(is.numeric(estimates$p_value))
  expect_true(is.integer(estimates$n_obs))

  # The numbers come straight from the model, untouched by the display
  # rounding that `artma.output.number_of_decimals` drives.
  expect_equal(estimates$estimate, res$meta$coefficients$estimate)
  expect_equal(estimates$std_error, res$meta$coefficients$std_error)
  expect_false(all(estimates$estimate == round(estimates$estimate, 2)))
})

test_that("linear_tests_estimates flags CI conflicts and handles an empty frame", {
  box::use(
    artma / methods / linear_tests[linear_tests_estimates]
  )

  coefficients <- data.frame(
    model = c("ols", "fe"),
    term = c("effect", "effect"),
    estimate = c(0.1, 0.2),
    std_error = c(0.01, 0.02),
    statistic = c(10, 10),
    p_value = c(0.001, 0.2),
    bootstrap_lower = c(0.05, -0.1),
    bootstrap_upper = c(0.15, 0.3),
    n_obs = c(30L, 30L),
    ci_conflict = c(FALSE, TRUE),
    stringsAsFactors = FALSE
  )

  estimates <- linear_tests_estimates(coefficients)
  expect_true(is.na(estimates$note[1]))
  expect_match(estimates$note[2], "disagree")
  expect_equal(estimates$conf_low, coefficients$bootstrap_lower)

  # The variance estimator travels with the numbers, so an exported CSV keeps
  # the distinction that would otherwise live only in a console warning.
  coefficients$vcov_type <- c("Cluster-robust (HC1)", "Heteroskedasticity-robust (HC1)")
  annotated <- linear_tests_estimates(coefficients)
  expect_equal(annotated$note[1], "Standard errors: Cluster-robust (HC1)")
  expect_match(annotated$note[2], "^Standard errors: Heteroskedasticity-robust \\(HC1\\); ")
  expect_match(annotated$note[2], "disagree$")

  empty <- linear_tests_estimates(data.frame())
  expect_equal(nrow(empty), 0L)
  expect_true(is.numeric(empty$estimate))
})