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())) })