tests/testthat/test-08-bias_functions.R

In chadhazlett/sensemakr: Sensitivity Analysis Tools for Regression Models

context("Bias functions")

test_that("Adjusted Partial R2",{

  resid_maker <- function(var) c(resid(lm(rnorm(n)~ var)))
  rcoef <- function() runif(1, min = -1, max = 1)

  # simulate data
  n <- 1e2
  z <- rnorm(n)
  d <- rcoef()*z + resid_maker(z)
  y <- rcoef()*d + rcoef()*z + resid_maker(cbind(d,z))

  # restricted model
  model.r <- lm(y  ~ d)

  # full model
  model <- lm(y ~ d + z)

  # treat reg
  treat.reg <- lm(d ~ z)

  # true partials
  r2yd   <- partial_r2(model.r, covariates = "d")
  r2yd.z <- partial_r2(model, covariates = "d")

  # true confounder strength
  r2yz.d <- partial_r2(model, covariates = "z")
  r2d.z  <- partial_r2(treat.reg, covariates = "z")
  reduce <- rel_bias(coef(model.r)["d"], coef(model)["d"]) > 0

  adj.r2 <- adjusted_partial_r2(model.r, treatment = "d", r2dz.x = r2d.z, r2yz.dx = r2yz.d, reduce = reduce)
  expect_equivalent(adj.r2, unname(r2yd.z))
})