tests/testthat/test-data-compute.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[expect_equal, expect_error, expect_message, expect_no_message, expect_true, test_that]
)

box::use(
  artma / data / compute[compute_optional_columns],
  artma / data / utils[get_reserved_colnames]
)

computed_config_overrides <- list(
  obs_id = list(var_name = "obs_id", is_computed = TRUE),
  study_id = list(var_name = "study_id", is_computed = TRUE),
  study_label = list(var_name = "study_label", is_computed = TRUE),
  t_stat = list(var_name = "t_stat", is_computed = TRUE),
  study_size = list(var_name = "study_size", is_computed = TRUE),
  reg_dof = list(var_name = "reg_dof", is_computed = TRUE),
  precision = list(var_name = "precision", is_computed = TRUE)
)

# Options every compute_optional_columns test needs: mark the optional columns
# as computed, skip result persistence, and fix the precision definition.
local_compute_options <- function(.env = parent.frame()) {
  withr::local_options(list(
    "artma.data.columns" = computed_config_overrides,
    "artma.output.save_results" = FALSE,
    "artma.calc.precision_type" = "1/SE",
    "artma.verbose" = 1
  ), .local_envir = .env)
}

# A three-row frame with a repeated study id (rows 1 and 3 share a study).
sample_study_df <- function() {
  data.frame(
    study_id = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    stringsAsFactors = FALSE
  )
}


test_that("compute_optional_columns preserves study labels while normalizing study_id", {
  df <- sample_study_df()
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_true("study_label" %in% names(result))
  expect_equal(
    result$study_label,
    c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)")
  )
  expect_true(is.integer(result$study_id))
  expect_equal(result$study_id, c(1L, 2L, 1L))
})


test_that("compute_optional_columns overwrites conflicting existing study_label", {
  df <- data.frame(
    study_id = c("Study A", "Study B", "Study A"),
    study_label = c("old", "old", "old"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    stringsAsFactors = FALSE
  )

  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$study_label, c("Study A", "Study B", "Study A"))
  expect_equal(result$study_id, c(1L, 2L, 1L))
})


test_that("compute_optional_columns takes study_label from a legible study name column when study keys are numeric", {
  df <- data.frame(
    study_id = c(1L, 2L, 1L, 3L),
    study = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)", "Clark (2010)"),
    effect = c(0.2, 0.5, 0.1, 0.3),
    se = c(0.1, 0.2, 0.1, 0.2),
    n_obs = c(120, 150, 120, 130),
    stringsAsFactors = FALSE
  )
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(
    result$study_label,
    c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)", "Clark (2010)")
  )
  expect_equal(result$study_id, c(1L, 2L, 1L, 3L))
})


test_that("compute_optional_columns keeps numeric study labels when the name column does not align with study ids", {
  df <- data.frame(
    study_id = c(1L, 1L, 2L),
    # Two different names within study 1: not a usable study label source
    study = c("Albeigh (2008)", "Albeigh (2009)", "Baker (2009)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    stringsAsFactors = FALSE
  )
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$study_label, c("1", "1", "2"))
})


test_that("compute_optional_columns ignores legible columns whose names do not look like study names", {
  df <- data.frame(
    study_id = c(1L, 2L, 3L),
    grp_reward = c("cash (low)", "voucher (mid)", "praise (high)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    stringsAsFactors = FALSE
  )
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$study_label, c("1", "2", "3"))
})


test_that("compute_optional_columns preserves a user-supplied legible study_label over numeric keys", {
  df <- data.frame(
    study_id = c(1L, 2L, 1L),
    study_label = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    stringsAsFactors = FALSE
  )
  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  result <- NULL
  expect_no_message(result <- compute_optional_columns(df))

  expect_equal(
    result$study_label,
    c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)")
  )
})


test_that("compute_optional_columns recomputes a user-supplied precision column when winsorization is active", {
  df <- data.frame(
    study_id = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    precision = c(999, 999, 999),
    stringsAsFactors = FALSE
  )

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$precision, 1 / result$se)
})


test_that("compute_optional_columns warns before overwriting a mapped precision column, naming the mapping", {
  df <- data.frame(
    study_id = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    precision = c(999, 999, 999),
    stringsAsFactors = FALSE
  )

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()
  overrides <- computed_config_overrides
  overrides$precision <- list(var_name = "precision", source_name = "weight")
  withr::local_options(list("artma.data.columns" = overrides, "artma.verbose" = 2))

  expect_message(
    result <- compute_optional_columns(df),
    "data.columns.precision.source_name"
  )
  expect_message(compute_optional_columns(df), "weight")
  expect_equal(result$precision, 1 / result$se)
})


test_that("compute_optional_columns warns about an unmapped precision data column without naming a mapping", {
  df <- data.frame(
    study_id = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    precision = c(999, 999, 999),
    stringsAsFactors = FALSE
  )

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  expect_message(compute_optional_columns(df), "precision")
  expect_no_message(compute_optional_columns(df), message = "source_name")
})


test_that("compute_optional_columns does not warn about a precision column when winsorization is disabled", {
  df <- data.frame(
    study_id = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    precision = c(999, 999, 999),
    stringsAsFactors = FALSE
  )

  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  expect_no_message(compute_optional_columns(df), message = "Winsorization")
})


test_that("compute_optional_columns keeps a user-supplied precision column when winsorization is disabled", {
  df <- data.frame(
    study_id = c("Albeigh (2008)", "Baker (2009)", "Albeigh (2008)"),
    effect = c(0.2, 0.5, 0.1),
    se = c(0.1, 0.2, 0.1),
    n_obs = c(120, 150, 120),
    precision = c(999, 999, 999),
    stringsAsFactors = FALSE
  )

  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$precision, c(999, 999, 999))
})


test_that("compute_optional_columns computes t_stat from effect and se when none is mapped", {
  local_compute_options()

  result <- compute_optional_columns(sample_study_df())

  expect_equal(result$t_stat, result$effect / result$se)
})


test_that("compute_optional_columns keeps a mapped t_stat column when winsorization is disabled", {
  df <- sample_study_df()
  df$t_stat <- c(3, 4, 5)

  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$t_stat, c(3, 4, 5))
})


test_that("compute_optional_columns recomputes a mapped t_stat column when winsorization is active", {
  df <- sample_study_df()
  df$t_stat <- c(3, 4, 5)

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$t_stat, result$effect / result$se)
})


test_that("compute_optional_columns warns before overwriting a mapped t_stat column, naming the mapping", {
  df <- sample_study_df()
  df$t_stat <- c(3, 4, 5)

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()
  overrides <- computed_config_overrides
  overrides$t_stat <- list(var_name = "t_stat", source_name = "tval")
  withr::local_options(list("artma.data.columns" = overrides, "artma.verbose" = 2))

  expect_message(
    result <- compute_optional_columns(df),
    "data.columns.t_stat.source_name"
  )
  expect_message(compute_optional_columns(df), "tval")
  expect_equal(result$t_stat, result$effect / result$se)
})


test_that("compute_optional_columns warns about an unmapped t_stat data column without naming a mapping", {
  df <- sample_study_df()
  df$t_stat <- c(3, 4, 5)

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  expect_message(compute_optional_columns(df), "t_stat")
  expect_no_message(compute_optional_columns(df), message = "source_name")
})


test_that("compute_optional_columns does not warn about a t_stat column when winsorization is disabled", {
  df <- sample_study_df()
  df$t_stat <- c(3, 4, 5)

  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  expect_no_message(compute_optional_columns(df), message = "Winsorization")
})


test_that("compute_optional_columns recomputes a mapped t_stat column with missing values instead of aborting", {
  df <- sample_study_df()
  df$t_stat <- c(3, NA, 5)

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()

  result <- compute_optional_columns(df)

  expect_equal(result$t_stat, result$effect / result$se)
})


test_that("compute_optional_columns aborts on a missing t_stat it is going to keep", {
  df <- sample_study_df()
  df$t_stat <- c(3, NA, 5)

  local_compute_options()

  expect_error(compute_optional_columns(df), "missing t-statistic")
})


test_that("the unwinsorized pass keeps a mapped t_stat even when winsorization is configured", {
  # The path p_hacking_tests takes: it runs on the unwinsorized frame with
  # `t_stat_source: reported`, so the reported t-statistics must survive.
  box::use(artma / data / index[without_winsorization])

  df <- sample_study_df()
  df$t_stat <- c(3, 4, 5)

  withr::local_options(list("artma.data.winsorization_level" = 0.01))
  local_compute_options()

  result <- without_winsorization(compute_optional_columns(df))

  expect_equal(result$t_stat, c(3, 4, 5))
})


test_that("compute_optional_columns does not warn about study_id for valid string labels", {
  df <- sample_study_df()
  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  expect_no_message(compute_optional_columns(df))
})


test_that("compute_optional_columns warns about study_id only for genuinely missing values", {
  df <- data.frame(
    study_id = c("Study A", NA, "", "Study B"),
    effect = c(0.2, 0.5, 0.1, 0.3),
    se = c(0.1, 0.2, 0.1, 0.2),
    n_obs = c(120, 150, 120, 130),
    stringsAsFactors = FALSE
  )
  local_compute_options()
  withr::local_options(list("artma.verbose" = 2))

  expect_message(compute_optional_columns(df), "Found 2 invalid or missing study IDs")
})


test_that("get_reserved_colnames covers every column compute_optional_columns can add", {
  df <- sample_study_df()
  local_compute_options()

  cols_before <- names(df)
  result <- compute_optional_columns(df)
  cols_added <- setdiff(names(result), cols_before)

  expect_true(length(cols_added) > 0)
  expect_true(all(cols_added %in% get_reserved_colnames()))
})