tests/testthat/test-data-config-defaults.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    expect_equal,
    expect_null,
    expect_true,
    expect_false,
    expect_error,
    test_that,
    expect_length
  ]
)

# ── identical_or_both_na ─────────────────────────────────────────────────────

# Each case is list(a, b, expected); NULL and NA operands survive as list
# elements. TRUE when both sides are NA, both NULL, or identical; FALSE for any
# mismatch, including NA-vs-value, NULL-vs-value, and NULL-vs-NA.
test_that("identical_or_both_na equates both-NA and both-NULL, rejects mismatches", {
  box::use(artma / data_config / defaults[identical_or_both_na])

  cases <- list(
    list(NA, NA, TRUE),
    list(NULL, NULL, TRUE),
    list(TRUE, TRUE, TRUE),
    list(FALSE, FALSE, TRUE),
    list("hello", "hello", TRUE),
    list(42, 42, TRUE),
    list(TRUE, FALSE, FALSE),
    list("a", "b", FALSE),
    list(1, 2, FALSE),
    list(NA, TRUE, FALSE),
    list(TRUE, NA, FALSE),
    list(NA, "hello", FALSE),
    list(NULL, TRUE, FALSE),
    list("a", NULL, FALSE),
    list(NULL, NA, FALSE),
    list(NA, NULL, FALSE)
  )

  for (i in seq_along(cases)) {
    case <- cases[[i]]
    expect_equal(
      identical_or_both_na(case[[1]], case[[2]]),
      case[[3]],
      info = sprintf("case %d", i)
    )
  }
})

# ── build_default_config_entry ────────────────────────────────────────────────

test_that("build_default_config_entry: numeric column", {
  box::use(artma / data_config / defaults[build_default_config_entry])

  col_data <- c(1.5, 2.3, 3.7)
  entry <- build_default_config_entry("my_var", col_data)

  expect_equal(entry$var_name, "my_var")
  expect_equal(entry$var_name_verbose, entry$var_name_description)
  expect_true(entry$variable_summary)
  expect_true(is.na(entry$bma))
  expect_true(is.na(entry$effect_sum_stats))
  expect_true(is.na(entry$equal))
  expect_true(is.na(entry$gltl))
  expect_true(is.na(entry$group_category))
})

test_that("build_default_config_entry: character column sets variable_summary FALSE", {
  box::use(artma / data_config / defaults[build_default_config_entry])

  col_data <- c("a", "b", "c")
  entry <- build_default_config_entry("category", col_data)

  expect_equal(entry$var_name, "category")
  expect_false(entry$variable_summary)
})

test_that("build_default_config_entry: entry has all expected fields", {
  box::use(artma / data_config / defaults[build_default_config_entry])

  entry <- build_default_config_entry("x", c(1, 2, 3))
  expected_fields <- c(
    "source_name", "drop_conflicting_raw", "is_computed",
    "var_name", "var_name_verbose", "var_name_description",
    "data_type", "group_category", "variable_summary",
    "effect_sum_stats", "equal", "gltl", "bma", "bma_reference_var",
    "bma_to_log", "bma_allow_derived", "bpe", "bpe_sum_stats",
    "bpe_equal", "bpe_gltl"
  )
  expect_equal(sort(names(entry)), sort(expected_fields))
})

test_that("build_default_config_entry: source_name defaults to the column's own name", {
  box::use(artma / data_config / defaults[build_default_config_entry, extract_overrides])

  entry <- build_default_config_entry("x", c(1, 2, 3))
  expect_equal(entry$source_name, "x")

  # An identity source_name is stripped by the sparse diff; a genuine rename
  # survives it.
  default <- build_default_config_entry("effect", c(1, 2, 3))
  identity_entry <- default
  expect_null(extract_overrides(identity_entry, default))

  renamed_entry <- default
  renamed_entry$source_name <- "effect_size"
  result <- extract_overrides(renamed_entry, default)
  expect_equal(result$source_name, "effect_size")
})

# ── build_base_config ─────────────────────────────────────────────────────────

test_that("build_base_config: creates entry for each column", {
  box::use(artma / data_config / defaults[build_base_config])

  df <- data.frame(
    age = c(25, 30, 35),
    country = c("US", "UK", "DE"),
    stringsAsFactors = FALSE
  )

  config <- build_base_config(df)

  expect_length(config, 2)
  expect_true("age" %in% names(config))
  expect_true("country" %in% names(config))
  expect_equal(config$age$var_name, "age")
  expect_equal(config$country$var_name, "country")
  expect_true(config$age$variable_summary)
  expect_false(config$country$variable_summary)
})

test_that("build_base_config: keys are make.names of column names", {
  box::use(artma / data_config / defaults[build_base_config])

  df <- data.frame(
    a = 1,
    b = 2,
    check.names = FALSE
  )
  names(df) <- c("my var", "x.y")

  config <- build_base_config(df)

  expect_true("my.var" %in% names(config))
  expect_true("x.y" %in% names(config))
  expect_equal(config[["my.var"]]$var_name, "my var")
})

test_that("build_base_config: errors on empty dataframe", {
  box::use(artma / data_config / defaults[build_base_config])

  df <- data.frame(x = numeric(0))
  expect_error(build_base_config(df), "empty")
})

# ── extract_overrides ─────────────────────────────────────────────────────────

test_that("extract_overrides: returns NULL when entry matches defaults", {
  box::use(artma / data_config / defaults[extract_overrides])

  entry <- list(var_name = "x", bma = NA, gltl = NA, equal = NA)
  default <- list(var_name = "x", bma = NA, gltl = NA, equal = NA)

  result <- extract_overrides(entry, default)
  expect_null(result)
})

test_that("extract_overrides: returns only changed fields", {
  box::use(artma / data_config / defaults[extract_overrides])

  default <- list(var_name = "x", bma = NA, gltl = NA, equal = NA)
  entry <- list(var_name = "x", bma = TRUE, gltl = NA, equal = "median")

  result <- extract_overrides(entry, default)

  expect_equal(result$bma, TRUE)
  expect_equal(result$equal, "median")
  expect_null(result$gltl)
  expect_null(result$var_name)
})

test_that("extract_overrides: skips var_name even if different", {
  box::use(artma / data_config / defaults[extract_overrides])

  default <- list(var_name = "x", bma = NA)
  entry <- list(var_name = "modified_x", bma = NA)

  result <- extract_overrides(entry, default)
  expect_null(result)
})

test_that("extract_overrides: detects change from NA to value", {
  box::use(artma / data_config / defaults[extract_overrides])

  default <- list(var_name = "x", effect_sum_stats = NA)
  entry <- list(var_name = "x", effect_sum_stats = TRUE)

  result <- extract_overrides(entry, default)
  expect_equal(result$effect_sum_stats, TRUE)
})

test_that("extract_overrides: detects change from value to different value", {
  box::use(artma / data_config / defaults[extract_overrides])

  default <- list(var_name = "x", gltl = "mean")
  entry <- list(var_name = "x", gltl = "median")

  result <- extract_overrides(entry, default)
  expect_equal(result$gltl, "median")
})