ate.R
In targeted: Targeted Inference

## ----include = FALSE----------------------------------------------------------
library("targeted")


## ----sim-continuous-----------------------------------------------------------
sim_data <- function(n = 2000) {
  w1 <- rnorm(n)
  w2 <- rnorm(n)
  a <- rbinom(n, 1, plogis(-1 + w1))
  y <- cos(w1) + w2 * a + 0.2 * w2^2 + a + rnorm(n)
  data.frame(y = y, a = a, w1 = w1, w2 = w2)
}

set.seed(2025)
d <- sim_data(2000)


## ----ate-parametric-----------------------------------------------------------
est <- cate(
  response.model = y ~ a * (w1 + w2),
  treatment.model = a ~ w1 + w2,
  cate.model = ~1,
  data = d
)
est


## ----ate-crossfit-------------------------------------------------------------
est_cf <- cate(
  response.model = y ~ a * (w1 + w2),
  treatment.model = a ~ w1 + w2,
  cate.model = ~1,
  data = d,
  nfolds = 5
)
est_cf


## ----ate-gam------------------------------------------------------------------
est_gam <- cate(
  response.model = learner_gam(y ~ s(w1) + s(w2)),
  treatment.model = learner_glm(a ~ w1 + w2, family = binomial),
  cate.model = ~1,
  data = d,
  nfolds = 5,
  stratify = TRUE
)
est_gam


## ----ate-sl-------------------------------------------------------------------
outcome_model <- learner_sl(
  list(
    glm = learner_glm(y ~ w1 * w2),
    gam = learner_gam(y ~ s(w1) + s(w2))
  ),
  nfolds = 5
)

est_sl <- cate(
  response.model = outcome_model,
  treatment.model = learner_glm(a ~ w1 + w2, family = binomial),
  cate.model = ~1,
  data = d,
  nfolds = 5,
  stratify = TRUE
)
est_sl


## ----sim-binary---------------------------------------------------------------
sim_binary <- function(n = 2000) {
  w1 <- rnorm(n)
  w2 <- rnorm(n)
  a <- rbinom(n, 1, plogis(-0.5 + 0.5 * w1))
  p1 <- plogis(-1 + 0.5 * w1 - 0.3 * w2 + 0.8 * a)
  y <- rbinom(n, 1, p1)
  data.frame(y = y, a = a, w1 = w1, w2 = w2)
}

set.seed(2025)
db <- sim_binary(3000)


## ----ate-binary---------------------------------------------------------------
est_bin <- cate(
  response.model = learner_glm(y ~ a * (w1 + w2), family = binomial),
  treatment.model = learner_glm(a ~ w1 + w2, family = binomial),
  cate.model = ~1,
  data = db,
  nfolds = 5
)
est_bin


## ----ate-or-------------------------------------------------------------------
or <- with(lava::estimate(est_bin$estimate),
           lava::logit(`E[y(1)]`) - lava::logit(`E[y(0)]`))
merge(or, exp(or), labels = c("log(OR)", "OR"))


## ----sessioninfo--------------------------------------------------------------
sessionInfo()