tests/testthat/test-power_marginaleffect.R

In postcard: Estimating Marginal Effects with Prognostic Covariate Adjustment

test_that("`power_marginaleffect` snapshot tests", {
  withr::local_seed(42)
  exp_prob <- 1/2
  n <- 100
  dat <- glm_data(Y ~ X1 + 2*A,
                  X1 = rnorm(n),
                  A = rbinom(n, 1, exp_prob))
  mod <- glm(Y ~ X1 + A, data = dat)
  preds <- predict(mod, newdata = dat)

  pow <- power_marginaleffect(
    response = dat$Y,
    predictions = preds,
    target_effect = 2,
    exposure_prob = exp_prob
  )
  expect_snapshot(pow)

  spec_var_kappa <- power_marginaleffect(
    response = dat$Y,
    predictions = preds,
    var1 = function(var0) 2 * var0,
    kappa1_squared = 1.5,
    target_effect = 2,
    exposure_prob = exp_prob
  )
  expect_snapshot(spec_var_kappa)
})

test_that("`power_marginaleffect` gives errors", {
  Y <- rnorm(100)
  preds <- rnorm(50)

  expect_error(
    power_marginaleffect(
      response = Y,
      predictions = preds,
      target_effect = 2,
      exposure_prob = 2/3
    ),
    regexp = "Specify them with the same length"
  )

  expect_error(
    power_marginaleffect(
      margin = not_defined_value,
      response = Y,
      predictions = Y,
      target_effect = 2,
      exposure_prob = 2/3,
      verbose = 0
    ),
    regexp = "Specify `margin` explicitly as a `numeric`"
  )
})

#inverse
test_that("`inverse` works", {
  inv_sqrt <- inverse(sqrt, lower = 0.01, upper = 100)
  inv_sum <- inverse(function(x) x + 2, lower = -100, upper = 100)
  inv_div <- inverse(function(x) x / 3, lower = -100, upper = 100)

  expect_equal(inv_sqrt(2), 2^2)
  expect_equal(inv_sum(3), 1)
  expect_equal(inv_div(3), 9)
})

test_that("`inverse_val` works", {
  inv_sum_val <- inverse_val(function(x) x + 7, 1e2)
  inv_div_val <- inverse_val(function(x) x / 4, 5)
  expect_equal(inv_sum_val, 1e2-7)
  expect_equal(inv_div_val, 20)
})

# check_lower_upper
test_that("`check_lower_upper` works", {
  give_args <- check_lower_upper(lower = -100, upper = 100)
  expect_equal(give_args, list(lower = -100, upper = 100))

  negative_okay <- check_lower_upper(
    f = function(x) x / 4, f_arg = 5,
    default_lu_scale = 1e2
  )
  expect_equal(negative_okay, list(lower = -1e2, upper = 1e2))

  nonnegative_only <- check_lower_upper(
    sqrt, f_arg = 4,
    default_lu_scale = 1e5, default_lu_times = 2
  )
  expect_equal(nonnegative_only, list(lower = 1 / ((1+2)*1e5), upper = (1+2)*1e5))
})

# derive_check_psi1
test_that("`derive_check_psi1` works", {
  ate_fun <- function(psi1, psi0) psi1 - psi0
  ate_manual_inv <- derive_check_psi1(
    estimand_fun = ate_fun,
    inv_estimand_fun = function(psi0, target_effect) psi0 + target_effect,
    psi0 = 2, target_effect = 2
  )
  ate_auto_inv <- derive_check_psi1(
    estimand_fun = ate_fun,
    psi0 = 2, target_effect = 2
  )
  expect_equal(ate_manual_inv, ate_auto_inv)

  rate_ratio_fun <- function(psi1, psi0) psi1 / psi0
  rr_manual_inv <- derive_check_psi1(
    estimand_fun = rate_ratio_fun,
    inv_estimand_fun = function(psi0, target_effect) psi0 * target_effect,
    psi0 = 2, target_effect = 2
  )
  rr_auto_inv <- derive_check_psi1(
    estimand_fun = rate_ratio_fun,
    psi0 = 2, target_effect = 2
  )
  expect_equal(rr_manual_inv, rr_auto_inv)

  nonsense_fun <- function(psi1, psi0) psi1^2 * (psi0 - log(psi0))
  ns_manual_inv <- derive_check_psi1(
    estimand_fun = nonsense_fun,
    inv_estimand_fun = function(psi0, target_effect) sqrt(target_effect / (psi0 - log(psi0))),
    psi0 = 2, target_effect = 2,
    tolerance = 1e-2
  )
  ns_auto_inv <- derive_check_psi1(
    estimand_fun = nonsense_fun,
    psi0 = 2, target_effect = 2,
    tolerance = 1e-2
  )
  expect_equal(ns_manual_inv, ns_auto_inv, tolerance = 1e-2)
})

test_that("`derive_check_psi1` gives warning when inverse does not produce correct result", {
  nonsense_fun <- function(psi1, psi0) psi1^2 * (psi0 - log(psi0))
  expect_warning(
    derive_check_psi1(
      estimand_fun = nonsense_fun,
      psi0 = 2, target_effect = 2,
      tolerance = .Machine$double.eps
    ),
    regexp = "did not produce a good result"
  )
})