tests/testthat/test-shifted.R

In lmtp: Non-Parametric Causal Effects of Feasible Interventions Based on Modified Treatment Policies

context("Fidelity of estimates with shifted data supplied")

a <- c("A1", "A2")
nodes <- list(c("L1"), c("L2"))
cens <- c("C1", "C2")
truth <- 0.88

sc <- shift_data(sim_cens, a, cens, function(data, trt) data[[trt]] + 0.5)

tmle <-
  sw(lmtp_tmle(sim_cens, a, "Y", nodes, baseline = NULL,
               cens, k = 0, shifted = sc,
               outcome_type = "binomial", folds = 2, mtp = TRUE))

sdr <-
  sw(lmtp_sdr(sim_cens, a, "Y", nodes, baseline = NULL,
              cens, k = 0, shifted = sc,
              outcome_type = "binomial", folds = 2, mtp = TRUE))

test_that("estimator fidelity with shifted data supplied", {
  expect_equal(truth, tmle$estimate@x, tolerance = 0.01)
  expect_equal(truth, sdr$estimate@x, tolerance = 0.01)
})

# Testing with multivariate exposure
A <- list(c("D1", "D2"))
W <- paste0("C", 1:3)
Y <- "Y"

shifted <- multivariate_data
shifted$D1 <- multivariate_data$D1 - 0.1
shifted$D2 <- multivariate_data$D2 - 0.5

uses_shifted <- lmtp_tmle(multivariate_data, A, Y, W, shifted = shifted,
                          outcome_type = "continuous", folds = 1, mtp = TRUE)

d <- function(data, a) {
  out = list(
    data[[a[1]]] - 0.1,
    data[[a[2]]] - 0.5
  )
  setNames(out, a)
}

uses_shift <- lmtp_tmle(multivariate_data, A, Y, W, shift = d,
                        outcome_type = "continuous", folds = 1, mtp = TRUE)

test_that("shifted works with multivariate exposure", {
  expect_true(identical(uses_shifted$estimate, uses_shift$estimate))
})