library(targeted) # remotes::install_github("kkholst/targeted", ref = "dev")
future::plan("multicore")
progressr::handlers(global = FALSE)
nsim <- 1000
n <- 150
onerun <- function(n, true_ate, ...) {
x <- rnorm(n)
a <- rbinom(n, 1, 0.5)
y <- true_ate * a + 0 * x + rnorm(n, sd = 1)
d <- data.frame(y = y, a = a, x = x)
fit1 <- cate(
response.model = y ~ a,
treatment.model = learner_glm(a ~ 1, family = binomial),
nfolds = 1,
rep = 1,
data = d
)
outcome_model <- learner_sl(
# learner_glm(y ~ a + x),
learner_glm(y ~ a * x),
learner_glm(y ~ a),
learner_gam(y ~ a + s(x))
)
fit2 <- cate(
response.model = outcome_model,
# treatment.model = ~ a,
treatment.model = learner_glm(a ~ 1, family = binomial),
calibration.model = ~1,
nfolds = n, # results in wrong coverage
rep = 1,
data = d
)
ci1 <- parameter(subset(fit1, 3))[,3:4]
ci2 <- parameter(subset(fit2, 3))[,3:4]
cover <- c(
ci1[1] <= true_ate && true_ate <= ci1[2],
ci2[1] <= true_ate && true_ate <= ci2[2]
)
return(cover)
}
res <- lava::sim(onerun, R = nsim, n = n, true_ate = 1)
print(res)
Additional tests to verify that the behaviour of linear calibration when
nfoldsis close to the sample size (and the predictions from the outcome regression model are already quite correlated with the outcomes? (not sure if that's actually the case) is not due a bug incatebut due to the method failing in these edge case situations.