tests/testthat/test.dichotomy.R

In propertee: Standardization-Based Effect Estimation with Optional Prior Covariance Adjustment

test_that("find and validate dichotomies with no upstream dichotomies and list of NULLs argument", {
  expect_true(is.null(.validate_dichotomy(list(lmitt = NULL, weights = NULL))))
})

test_that("find and validate dichotomies with no upstream dichotomies and non-null argument", {
  expect_identical(deparse1(.validate_dichotomy(z ~ 1)), deparse1(z ~ 1))
})

test_that("find and validate dichotomies doesn't get valid option", {
  expect_error(.validate_dichotomy(character()), "formulas provided")
})

test_that("find and validate dichotomies with upstream dichotomy in lmitt.formula()", {
  data(simdata)
  spec <- rct_spec(dose ~ cluster(uoa1, uoa2), simdata)
  expect_warning(
    expect_warning(
      expect_warning(
        mod1 <- lmitt(y ~ 1, specification = spec, data = simdata, dichotomy = dose > 50 ~ dose == 50,
                      weights = ate(spec, dichotomy = dose <= 250 ~ dose > 250)),
        "passed to `.weights_calc()"
      ),
      "passed to `a.()"
    ),
    "passed to `a.()"
  )
  expect_equal(mod1$model$dose., as.numeric(simdata$dose > 50))
  expect_equal(mod1$model$`(weights)`, ate(spec, dose <= 250 ~ dose > 250, data = simdata))

  mod2 <- lmitt(y ~ 1, specification = spec, data = simdata, dichotomy = dose <= 250 ~ dose > 250,
                weights = ate(spec, dichotomy = dose <= 250 ~ dose > 250))
  expect_equal(mod2$model$dose., as.numeric(simdata$dose <= 250))
  expect_equal(mod2$model$`(weights)`, ate(spec, dose <= 250 ~ dose > 250, data = simdata))

  mod3 <- lmitt(y ~ 1, specification = spec, data = simdata, dichotomy = dose <= 250 ~ dose > 250,
                weights = ate(spec))
  expect_equal(mod3$model$dose., mod2$model$dose.)
  expect_equal(mod3$model$`(weights)`@.Data, mod2$model$`(weights)`@.Data)
})

test_that("find and validate dichotomies with no upstream lmitt.formula()", {
  data(simdata)
  spec <- rct_spec(dose ~ cluster(uoa1, uoa2), simdata)
  expect_warning(
    mod1 <- lm(y ~ assigned(dichotomy = dose > 50 ~ dose == 50), data = simdata,
               weights = ate(spec, dichotomy = dose <= 250 ~ dose > 250)),
    "passed to `assigned()"
  )
  expect_equal(mod1$model[[2]], as.numeric(simdata$dose > 50))
  expect_equal(mod1$model$`(weights)`@.Data,
               ate(spec, dose <= 250 ~ dose > 250, data = simdata)@.Data)
  expect_equal(mod1$model$`(weights)`@target,
               ate(spec, dose <= 250 ~ dose > 250, data = simdata)@target)
  expect_equal(deparse1(mod1$model$`(weights)`@dichotomy),
               deparse1(ate(spec, dose <= 250 ~ dose > 250, data = simdata)@dichotomy))


  mod2 <- lm(y ~ assigned(dichotomy = dose <= 250 ~ dose > 250), data = simdata,
             weights = ate(spec, dichotomy = dose <= 250 ~ dose > 250))
  expect_equal(mod2$model[[2]], as.numeric(simdata$dose <= 250))
  expect_equal(mod2$model$`(weights)`@.Data,
               ate(spec, dose <= 250 ~ dose > 250, data = simdata)@.Data)
  expect_equal(mod2$model$`(weights)`@target,
               ate(spec, dose <= 250 ~ dose > 250, data = simdata)@target)
  expect_equal(deparse1(mod2$model$`(weights)`@dichotomy),
               deparse1(ate(spec, dose <= 250 ~ dose > 250, data = simdata)@dichotomy))

  expect_error(
    mod3 <- lm(y ~ assigned(dichotomy = dose > 50 ~ dose == 50), data = simdata,
               weights = ate(spec)),
    "Must provide a dichotomy"
  )
})

test_that("no warning when dichotomy is passed as a stored object", {
  set.seed(33)
  uoadata <- data.frame(cid = seq_len(8),
                        bid = c(rep(seq_len(2), 2), rep(1, 2), rep(2, 2)),
                        dose = c(rep(0, 4), rep(1, 2), rep(2, 2)))
  individdata <- data.frame(cid = rep(seq_len(8), each = 10), y = rnorm(80))
  specification <- rct_spec(dose ~ uoa(cid) + block(bid), data = uoadata)
  
  # store the dichotomy in an object and create weights ahead of time with stored dichotomy
  dich <- dose == 1 ~ dose == 0
  wts <- ett(specification, data = individdata, dichotomy = dich)
  
  # first, check when dichotomy is passed directly and through the weights
  expect_silent(om1 <- lmitt(y~1, specification, individdata, weights = wts, dichotomy = dich))
  
  # then check when only passed through the weights
  expect_silent(om2 <- lmitt(y~1, specification, individdata,
                             weights = ett(specification, data = individdata, dichotomy = dich)))
  
  # also, check when the dichotomy or an object storing a dichotomy is passed to a function
  fit_lmitt <- function(data, spec, d) {
    wts <- ett(spec, data = data, dichotomy = d)
    m1 <- lmitt(y~1, spec, data, weights = wts, dichotomy = d)
    m1
  }
  expect_silent(om3 <- fit_lmitt(individdata, specification, dose == 1 ~ dose == 0))
  expect_silent(om4 <- fit_lmitt(individdata, specification, dich))
  
  expect_equal(om1$coef, om2$coef)
  expect_equal(om1$coef, om3$coef)
  expect_equal(om1$coef, om4$coef)
  
  # and finally, non-lmitt calls
  expect_silent(om5 <- lm(y ~ assigned(specification, individdata, dich), individdata, weights = wts))
  expect_equal(unname(om1$coef[1:2]), unname(om5$coef))
})

test_that("proceed with NULL dichotomy when passed as a named object", {
  fit_lmitt <- function(data, spec, dich) {
    m1 <- lmitt(y~1, spec, data, dichotomy = dich)
    m1
  }
  
  testdata <- data.frame(cid = 1:10, z = c(rep(1, 5), rep(0, 5)), y = rnorm(10))
  spec <- rct_spec(z ~ unit_of_assignment(cid), data = testdata)
  
  expect_silent(om1 <- lmitt(y~1, spec, testdata))
  expect_silent(om2 <- lmitt(y~1, spec, testdata, dichotomy = NULL))
  expect_silent(om3 <- fit_lmitt(testdata, spec, z == 1 ~ z == 0))
  expect_silent(om4 <- fit_lmitt(testdata, spec, NULL))
  expect_equal(om1$coefficients, om2$coefficients)
  expect_equal(om1$coefficients, om3$coefficients)
  expect_equal(om1$coefficients, om4$coefficients)
})

test_that("fail when dichotomy is a named but non-existent object", {
  testdata <- data.frame(cid = 1:10, z = c(rep(1, 5), rep(0, 5)), y = rnorm(10))
  spec <- rct_spec(z ~ unit_of_assignment(cid), data = testdata)
  expect_error(ett(spec, data = testdata, dichotomy = quote(d)),
               "Could not find d in call stack")
})