context("Basic interventions: TSM for single static intervention.")
library(sl3)
# library(tmle3)
library(uuid)
library(assertthat)
library(data.table)
library(future)
# setup data for test
# tmle3_Fit$debug(".tmle_fit")
data(cpp)
data <- as.data.table(cpp)
data$parity01 <- as.numeric(data$parity > 0)
data$parity01_fac <- factor(data$parity01)
data$haz01 <- as.numeric(data$haz > 0)
data[is.na(data)] <- 0
node_list <- list(
W = c(
"apgar1", "apgar5", "gagebrth", "mage",
"meducyrs", "sexn"
),
A = "parity01",
Y = "haz01"
)
qlib <- make_learner_stack(
"Lrnr_mean",
"Lrnr_glm_fast"
)
glib <- make_learner_stack(
"Lrnr_mean",
"Lrnr_glm_fast"
)
logit_metalearner <- make_learner(
Lrnr_solnp, metalearner_logistic_binomial,
loss_loglik_binomial
)
Q_learner <- make_learner(Lrnr_sl, qlib, logit_metalearner)
g_learner <- make_learner(Lrnr_sl, glib, logit_metalearner)
learner_list <- list(Y = Q_learner, A = g_learner)
tmle_spec <- tmle_TSM_all()
# define data
tmle_task <- tmle_spec$make_tmle_task(data, node_list)
# define likelihood
initial_likelihood <- tmle_spec$make_initial_likelihood(tmle_task, learner_list)
# define update method (submodel + loss function)
# disable cvtmle for this test to compare with tmle package
updater <- tmle3_Update$new(cvtmle = FALSE)
targeted_likelihood <- Targeted_Likelihood$new(initial_likelihood, updater)
tl_preds <- targeted_likelihood$get_likelihood(tmle_task, "Y", "validation")
lf_targ <- LF_targeted$new("Y", targeted_likelihood)
lf_preds <- lf_targ$get_likelihood(tmle_task, "validation")
test_that("LF_targeted returns the correct likelihood values", expect_equal(tl_preds, lf_preds))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.