tests/testthat/test-print_methods.R

In sbwadjust: Stable Balancing Weights for Covariate Adjustment in Trials

# Smoke tests for the S3 print/plot methods (R/sbw_weights.R, R/sbw_estimate.R).
# These were exported but untested as of v0.2.0. They assert the identifying
# header lines and the documented invisible return, not exact formatting, so
# that cosmetic wording changes don't break the suite.

make_print_toy = function(n = 60, seed = 3) {
  set.seed(seed)
  df = data.frame(
    age = rnorm(n, 50, 10),
    bmi = rnorm(n, 27, 4),
    arm = rbinom(n, 1, 0.5)
  )
  df$Y = with(df, 0.02 * age + 0.5 * arm + rnorm(nrow(df), sd = 0.5))
  df
}

test_that("print.sbw_fit shows the header and arm counts, returning x invisibly", {
  df = make_print_toy()
  sbw = sbw_weights(~ age + bmi, data = df, treatment = arm)

  expect_output(print(sbw), "<sbw_fit>", fixed = TRUE)
  expect_output(print(sbw), paste0("n:\\s+", sbw$n))
  expect_output(print(sbw), paste0(sum(sbw$treatment == 1L), " treated"))

  expect_output(out <- print(sbw))
  expect_identical(out, sbw)
})

test_that("print.sbw_fit names the treated and control levels for a character treatment", {
  df = make_print_toy()
  df$arm_chr = ifelse(df$arm == 1, "placebo", "drug")
  sbw = sbw_weights(~ age + bmi, data = df, treatment = arm_chr)

  # alphabetical: drug = 0 (control), placebo = 1 (treated)
  expect_output(print(sbw), "treated [placebo]", fixed = TRUE)
  expect_output(print(sbw), "control [drug]", fixed = TRUE)

  sbw_num = sbw_weights(~ age + bmi, data = df, treatment = arm)
  expect_false(any(grepl("[", capture.output(print(sbw_num)), fixed = TRUE)))
})

test_that("print.sbw_fit counts zero-weight units per arm, and is silent when there are none", {
  set.seed(14)
  d = data.frame(x = c(rexp(8, 1), rnorm(40, 1.2)), a = rep(1:0, c(8, 40)))
  sbw = sbw_weights(~ x, data = d, treatment = a)
  n0 = sum(sbw$weights[d$a == 1] < 1e-10)
  expect_gt(n0, 0L)
  expect_output(print(sbw), paste0(n0, " of 8 treated units got weight 0"), fixed = TRUE)

  sbw_ok = sbw_weights(~ age + bmi, data = make_print_toy(), treatment = arm)
  expect_false(any(grepl("note:", capture.output(print(sbw_ok)), fixed = TRUE)))
})

test_that("print.sbw_fit keeps a long balance formula on one line, without deparse's padding", {
  df = make_print_toy()
  for (v in c("height_cm", "weight_kg", "systolic_bp", "cholesterol")) df[[v]] = rnorm(nrow(df))
  sbw = sbw_weights(~ age + bmi + height_cm + weight_kg + systolic_bp + cholesterol,
                    data = df, treatment = arm)
  out = capture.output(print(sbw))
  expect_true(any(grepl("cholesterol", out)))
  expect_false(any(grepl("\\+\\s{2,}", out)))
})

test_that("print.summary.sbw_fit shows the balance table", {
  df = make_print_toy()
  s = summary(sbw_weights(~ age + bmi, data = df, treatment = arm))

  expect_s3_class(s, "summary.sbw_fit")
  expect_output(print(s), "Balance")
  expect_false(any(grepl("Effective sample size", capture.output(print(s)), fixed = TRUE)))
  # both balance covariates are named in the printed table
  expect_output(print(s), "age")
  expect_output(print(s), "bmi")

  expect_output(out <- print(s))
  expect_identical(out, s)
  expect_false(any(grepl("Zero weights", capture.output(print(s)), fixed = TRUE)))
})

test_that("summary.sbw_fit counts zero-weight units per arm and prints them", {
  set.seed(14)
  d = data.frame(x = c(rexp(8, 1), rnorm(40, 1.2)), a = rep(1:0, c(8, 40)))
  sbw = sbw_weights(~ x, data = d, treatment = a)
  s = summary(sbw)

  expect_equal(s$n_zero, .n_zero_by_arm(sbw$weights, sbw$treatment))
  expect_gt(s$n_zero[["treated"]], 0L)
  expect_output(print(s), paste0("Zero weights: ", s$n_zero[["treated"]], " of 8 treated"),
                fixed = TRUE)
})

test_that("plot.sbw_fit draws without error and returns x invisibly", {
  df = make_print_toy()
  sbw = sbw_weights(~ age + bmi, data = df, treatment = arm)

  grDevices::pdf(NULL)
  on.exit(grDevices::dev.off(), add = TRUE)

  expect_silent(out <- plot(sbw))
  expect_identical(out, sbw)
})

test_that("plot.sbw_fit lets `...` override its defaults and restores par()", {
  df = make_print_toy()
  sbw = sbw_weights(~ age + bmi, data = df, treatment = arm)

  grDevices::pdf(NULL)
  on.exit(grDevices::dev.off(), add = TRUE)

  mar0 = graphics::par("mar")
  expect_silent(plot(sbw, main = "My trial", xlim = c(-1, 1), xlab = "SMD", col = "red"))
  expect_equal(graphics::par("mar"), mar0)
})

test_that("print.sbw_estimate shows the estimand and a CI line", {
  df = make_print_toy()
  sbw = sbw_weights(~ age + bmi, data = df, treatment = arm)
  res = sbw_estimate(sbw, Y ~ 1, estimand = "ATE", B = 20, seed = 5)

  expect_output(print(res), "<sbw_estimate: ATE>", fixed = TRUE)
  expect_output(print(res), "CI:")

  expect_output(out <- print(res))
  expect_identical(out, res)
})