context("Direct ATE for single node interventions")
library(sl3)
library(tmle3)
library(uuid)
library(assertthat)
library(data.table)
library(future)
# setup data for test
data(cpp)
data <- cpp
data$haz01 <- as.numeric(data$haz > 0)
data[is.na(data)] <- 0
node_list <- list(
W = c("sexn"),
A = "parity",
Y = "haz01"
)
qlib <- make_learner_stack(
"Lrnr_mean",
"Lrnr_glm_fast"
)
glib <- make_learner_stack(
"Lrnr_mean",
"Lrnr_xgboost"
)
logit_metalearner <- make_learner(
Lrnr_solnp, metalearner_logistic_binomial,
loss_loglik_binomial
)
mn_metalearner <- make_learner(
Lrnr_solnp, metalearner_linear_multinomial,
loss_loglik_multinomial
)
Q_learner <- make_learner(Lrnr_sl, qlib, logit_metalearner)
g_learner <- make_learner(Lrnr_sl, glib, mn_metalearner)
learner_list <- list(Y = Q_learner, A = g_learner)
tmle_spec <- tmle_ATE(1, 0)
# define data
tmle_task <- tmle_spec$make_tmle_task(data, node_list)
# LF_fit$undebug("get_likelihood")
# estimate likelihood
initial_likelihood <- tmle_spec$make_initial_likelihood(tmle_task, learner_list)
updater <- tmle3_Update$new(cvtmle = FALSE, convergence_type = "sample_size")
targeted_likelihood <- Targeted_Likelihood$new(initial_likelihood, updater)
# define parameter
tmle_params <- tmle_spec$make_params(tmle_task, targeted_likelihood)
updater$tmle_params <- tmle_params
ate <- tmle_params[[1]]
# fit tmle update
tmle_fit <- fit_tmle3(
tmle_task, targeted_likelihood, list(ate), updater,
max_it
)
# extract results
tmle3_psi <- tmle_fit$summary$tmle_est
tmle3_se <- tmle_fit$summary$se
tmle3_epsilon <- updater$epsilons[[1]]$Y
expect_equivalent(tmle3_psi, -0.0655, tolerance = 1e-3)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.