tests/testthat/test_DRIPTW.R

In BarkleyBG/causalsandwich: Estimating Causal Effects with M-Estimation Sandwich Variance Estimator

context("DRIPTW output")

set.seed(55)
n <- 200
data <- data.frame(
  X = rnorm(n),
  Z = rnorm(n)
)
trtprobs <- plogis(0.2  + 0.5*data$X + 0.1*data$Z + 0.2*data$X * data$Z)
data$Trt <- rbinom(n, 1, trtprobs)

outprobs <- plogis(0.5  + 0.2*data$X - 0.2*data$Z + 0.2*data$X * data$Z -
                     0.2*data$Trt)
# outprobs <- plogis(0.5  + 0.2*data$X - 0.2*data$Z + 0.2*data$X * data$Z -
                     # 0.2*data$Trt+0.01*data$Trt*data$X*data$Z)
data$YY <- rbinom(n, 1, outprobs)


formula_GF <- YY ~ Trt + X*Z
model_method="logistic"
# weight_type="unstabilized"
# weight_type="stabilized"


args_DRIPTW <- list(
  data = data,
  outcome_formula = YY ~ X * Z + Trt  ,
  treatment_formula =  Trt ~ X * Z       ,
  # deriv_control = geex::setup_deriv_control(method="simple"),

  outcome_model_method="logistic"       ,
  treatment_model_method="logistic"        ,
  # weight_type="unstabilized"     ,
  deriv_control = geex::setup_deriv_control(method="simple")
)
DRIPTW <- do.call(estimateDRIPTW, args = args_DRIPTW)
ests <- DRIPTW@estimates
vcov <- DRIPTW@vcov

ests_baseline <- structure(c(0.331067859863857, 0.192275730426782, -0.251029275334906,
            -0.0117827411851662, 0.191746723923105, 0.557019398358754, 0.619053201264627,
            -0.0429263162418821, 0.168075605954563, -0.0252848259173177),
            .Names = c("(Intercept)",
                       "X", "Z", "Trt", "X:Z", "(Intercept)", "X", "Z", "X:Z", ""))

testthat::test_that( "DRIPTW Estimates are equal",
  testthat::expect_equal(
    ests,
    ests_baseline,
    tol=1e-8
  )
)

vcov_baseline <- structure(
  c(0.0569711590876516, 0.00995861120900211, -0.00282688061524262,
    -0.0582150021217562, 0.00331597434471039, -0.00243542723044761,
    -0.00392711779779321, -0.00196807337625362, -0.00364373233294236,
    -0.0131743324991564, 0.0099586112090021, 0.0248360691173406,
    0.000150276709427447, -0.0123280800724682, 0.00165503518300018,
    -0.00157688802398829, -0.000438699061106516, -0.002101923554266,
    -0.00292789389435852, -0.00235165383550402, -0.00282688061524261,
    0.000150276709427448, 0.0243908424939177, 0.00309609539123564,
    0.00221930537490018, 0.000222579501812309, -0.00140924889153724,
    0.00261191466332682, -0.00112989229999126, 0.000798344840676347,
    -0.0582150021217562, -0.0123280800724682, 0.00309609539123564,
    0.0946759305949861, -0.00441841794095532, 0.00340385403285764,
    0.00420865737565719, 0.0032126059278434, 0.00369785389820744,
    0.0217926073660418, 0.00331597434471039, 0.00165503518300018,
    0.00221930537490018, -0.00441841794095532, 0.018980374772826,
    -0.00155229246430495, -0.00229637519464019, -0.000763984783763135,
    0.00506322030975499, -0.000790357712450329, -0.00243542723044761,
    -0.00157688802398829, 0.000222579501812309, 0.00340385403285764,
    -0.00155229246430495, 0.0240435402402021, 0.00426435436096873,
    0.000426859364788199, -0.00122751518159356, 3.95358697697915e-05,
    -0.00392711779779321, -0.000438699061106516, -0.00140924889153724,
    0.00420865737565719, -0.00229637519464019, 0.00426435436096873,
    0.0255862944898333, -0.00187658414492479, -5.76879905656753e-05,
    0.000191994296602897, -0.00196807337625362, -0.002101923554266,
    0.00261191466332682, 0.0032126059278434, -0.000763984783763136,
    0.000426859364788199, -0.00187658414492479, 0.0243995733195431,
    0.000198528876131661, 0.000212619353546572, -0.00364373233294236,
    -0.00292789389435852, -0.00112989229999126, 0.00369785389820744,
    0.00506322030975499, -0.00122751518159356, -5.76879905656753e-05,
    0.000198528876131661, 0.0174004666189648, 0.000372921185398169,
    -0.0131743324991564, -0.00235165383550402, 0.000798344840676347,
    0.0217926073660419, -0.000790357712450329, 3.95358697697915e-05,
    0.000191994296602898, 0.000212619353546572, 0.000372921185398169,
    0.00524762286477053), .Dim = c(10L, 10L))


testthat::test_that( "DRIPTW Vcovs are equal",
  testthat::expect_equal(
    vcov,
    vcov_baseline,
    # vcov[1:3,1:3],
    # vcov_baseline[1:3, 1:3],
    tol=1e-8
  )
)