tests/testthat/test-predict_counterfactual.R

In RobinCar2: ROBust INference for Covariate Adjustment in Randomized Clinical Trials

test_that("predict_counterfactual works for guassian", {
  expect_snapshot(predict_counterfactual(fit_glm, treatment ~ 1))
})

test_that("predict_counterfactual works for guassian with lm", {
  expect_snapshot(predict_counterfactual(fit_lm, treatment ~ 1, data = glm_data))
})

test_that("predict_counterfactual works for binomial", {
  expect_snapshot(predict_counterfactual(fit_binom, treatment ~ 1))
})

test_that("predict_counterfactual for negative binomial", {
  fit <- glm(y_b ~ treatment * covar, data = glm_data, family = negative.binomial(theta = 1))
  pc <- predict_counterfactual(fit, treatment ~ 1, glm_data)
  predictions <- pc$predictions

  # Check that the mean of the predicted outcomes within
  # each treatment group matches with the observed outcomes
  trt_levels <- levels(glm_data$treatment)
  for (i in seq_along(trt_levels)) {
    idx <- glm_data$treatment == trt_levels[i]
    # mean of the predicted outcomes within treatment group i
    pred_mean <- mean(predictions[idx, i])
    # mean of the y's within treatment group i
    obs_mean <- mean(glm_data[idx, ][["y_b"]])
    expect_equal(pred_mean, obs_mean, tolerance = 1e-15)
  }

  # check that the mean of the residuals is zero within a treatment group
  # this test exists because previously residual and predictions attributes
  # were not aligned properly when predictions were biased
  residuals <- pc$residual
  res_mean <- mean(residuals[idx])
  expect_equal(res_mean, 0, tolerance = 1e-15)
})

test_that("predict_counterfactual works if contrast are non-standard", {
  glm_data2 <- glm_data
  glm_data2$s1 <- as.ordered(glm_data2$s1)
  fit <- glm(y_b ~ treatment * s1, data = glm_data2, family = binomial())
  expect_silent(pc <- predict_counterfactual(fit, treatment ~ 1, data = find_data(fit)))
  expect_snapshot(pc)
  newdf <- rbind(glm_data2, glm_data2, glm_data2)
  newdf$treatment <- rep(factor(levels(glm_data2$treatment), levels(glm_data2$treatment)), each = nrow(glm_data2))
  expect_identical(
    pc$predictions_linear[, 1],
    predict(fit, newdata = newdf, type = "link")
  )
})

test_that("predict_counterfactual works with provided vcov function", {
  vcov_dummy <- function(x) {
    n <- length(x$estimate)
    matrix(0.1, nrow = n, ncol = n)
  }
  expect_snapshot(predict_counterfactual(fit_lm, treatment ~ 1, data = glm_data, vcov = vcov_dummy))
  expect_snapshot(predict_counterfactual(fit_lm, treatment ~ 1, data = glm_data, vcov = NULL))
})

test_that("confint method for prediction_cf works as expected", {
  expect_snapshot(
    confint(predict_counterfactual(fit_binom, treatment = treatment ~ s1, eff_measure = h_diff))
  )
})