tests/testthat/test-confMeta.weights.R

In confMeta: Confidence Curves and P-Value Functions for Meta-Analysis

# ========================================================================
# Tests for weights (w) argument with p_edgington_w
# ========================================================================

test_that("weights argument is validated correctly", {
  
  n <- 5
  estimates <- rnorm(n)
  SEs <- rgamma(n, 5, 5)
  conf_level <- 0.95
  
  cl1 <- quote({
    confMeta(
      estimates = estimates,
      SEs = SEs,
      conf_level = conf_level,
      fun = p_edgington_w,   # <-- use p_edgington_w directly
      w = w
    )
  })
  
  # wrong length
  w <- as.numeric(1:4)
  expect_error(eval(cl1))
  
  # contains NA
  w <- c(1, NA, 1, 1, 1)
  expect_error(eval(cl1))
  
  # contains NaN
  w <- c(1, 1, as.numeric(NaN), 1, 1)
  expect_error(eval(cl1))
  
  # contains negative value
  w <- c(-1, 1, 1, 1, 1)
  expect_error(eval(cl1))
  
  # all zero weights (not allowed)
  w <- rep(0, n)
  expect_error(eval(cl1))
  
  # valid integer weights
  w <- as.numeric(1:5)
  expect_s3_class(eval(cl1), "confMeta")
  
  # valid numeric weights (non-integers)
  w <- runif(n, min = 0.1, max = 2)
  expect_s3_class(eval(cl1), "confMeta")
  
  # very large weights
  w <- rep(1e6, n)
  expect_s3_class(eval(cl1), "confMeta")
  
  # very small positive weights
  w <- rep(1e-6, n)
  expect_s3_class(eval(cl1), "confMeta")
})





################################################################################
test_that("Weighted vs unweighted", {
  est <- c(-0.5, -0.1, 0.2)
  se  <- c(0.2, 0.25, 0.3)
  w   <- c(2, 1, 1)
  
  obj_unw <- confMeta(
    estimates = est,
    SEs = se,
    conf_level = 0.95,
    fun = p_edgington_w,
    fun_name = "Edgington unweighted"
  )
  
  obj_w <- confMeta(
    estimates = est,
    SEs = se,
    conf_level = 0.95,
    fun = p_edgington_w,
    fun_name = "Edgington weighted",
    w = w
  )
  
  # what MUST not change
  expect_equal(obj_unw$estimates,       obj_w$estimates)
  expect_equal(obj_unw$SEs,             obj_w$SEs)
  expect_equal(obj_unw$study_names,     obj_w$study_names)
  expect_equal(obj_unw$conf_level,      obj_w$conf_level)
  expect_equal(obj_unw$individual_cis,  obj_w$individual_cis)
  expect_equal(obj_unw$comparison_cis,  obj_w$comparison_cis)
  expect_equal(obj_unw$comparison_p_0,  obj_w$comparison_p_0)
  
  # what MUST change
  expect_false(isTRUE(all.equal(obj_unw$w,          obj_w$w)))
  expect_false(isTRUE(all.equal(obj_unw$joint_cis,  obj_w$joint_cis)))
  expect_false(isTRUE(all.equal(obj_unw$gamma,      obj_w$gamma)))
  expect_false(isTRUE(all.equal(obj_unw$p_max,      obj_w$p_max)))
  expect_false(isTRUE(all.equal(obj_unw$p_0,        obj_w$p_0)))
  expect_false(isTRUE(all.equal(obj_unw$aucc,       obj_w$aucc)))
  expect_false(isTRUE(all.equal(obj_unw$aucc_ratio, obj_w$aucc_ratio)))
})


##################################################################à
test_that("Weighted with weights=1 vs unweighted", {
  est <- c(-0.5, -0.1, 0.2)
  se  <- c(0.2, 0.25, 0.3)
  w1  <- rep(1, length(est))
  
  obj_unw <- confMeta(
    estimates = est,
    SEs = se,
    conf_level = 0.95,
    fun = p_edgington_w,
    fun_name = "Edgington unweighted"
  )
  
  obj_w1 <- confMeta(
    estimates = est,
    SEs = se,
    conf_level = 0.95,
    fun = p_edgington_w,
    fun_name = "Edgington weighted (all ones)",
    w = w1
  )
  
  # What changes
  ignore <- c("w", "fun_name")
  
  #The rest MUST be the same
  for (nm in setdiff(names(obj_unw), ignore)) {
    expect_equal(obj_unw[[nm]], obj_w1[[nm]])
  }
})







#######################


test_that("The order doesnt change the output", {
  est <- c(-0.5, -0.1, 0.2)
  se  <- c(0.2, 0.25, 0.3)
  w   <- c(2, 1, 3)
  
  obj1 <- confMeta(
    estimates = est,
    SEs = se,
    w = w,
    conf_level = 0.95,
    fun = p_edgington_w
  )
  
  o <- c(3,1,2)  # reorder in a different way
  obj2 <- confMeta(
    estimates = est[o],
    SEs = se[o],
    w = w[o],
    conf_level = 0.95,
    fun = p_edgington_w
  )
  
  #expect equal
  expect_equal(obj1$joint_cis,     obj2$joint_cis)
  expect_equal(obj1$gamma,         obj2$gamma)
  expect_equal(obj1$p_max,         obj2$p_max)
  expect_equal(obj1$p_0,           obj2$p_0)
  expect_equal(obj1$aucc,          obj2$aucc)
  expect_equal(obj1$aucc_ratio,    obj2$aucc_ratio)
  expect_equal(obj1$comparison_cis,obj2$comparison_cis)
  expect_equal(obj1$comparison_p_0,obj2$comparison_p_0)

})