catching up with tmle3

R/LF_shift.R

@@ -8,7 +8,7 @@
 #'
 #' @references
 #' \describe{
-#'   \item{"Stochastic Treatment Regimes."}{Díaz, Iván and van der Laan, Mark J
+#'   \item{"Stochastic Treatment Regimes."}{Díaz, Iván and van der Laan, Mark
 #'         (2018). In Targeted Learning in Data Science: Causal Inference for
 #'         Complex Longitudinal Studies, 167–80. Springer Science & Business
 #'         Media.}
@@ -34,57 +34,43 @@
 #'     shift_function, ...)}
 #'
 #'   \describe{
-#'     \item{\code{name}}{character, the name of the factor. Should match a node
-#'           name in the nodes specified by \code{\link{tmle3_Task}$npsem}
-#'     }
+#'     \item{\code{name}}{character, the name of the factor. Should match a
+#'           node name in the specification in \code{\link{tmle3_Task}$npsem}.}
 #'     \item{\code{original_lf}}{\code{\link{LF_base}} object, the likelihood
-#'           factor to shift
-#'     }
-#'     \item{\code{shift_function}}{\code{function}, defines the shift
-#'     }
+#'           factor to shift.}
+#'     \item{\code{shift_function}}{\code{function}, defines the shift.}
 #'     \item{\code{shift_inverse}}{\code{function}, the inverse of a given
-#'           \code{shift_function}
-#'     }
+#'           \code{shift_function}.}
 #'     \item{\code{shift_delta}}{\code{numeric}, specification of the magnitude
-#'           of the desired shift (on the level of the treatment)
-#'     }
-#'     \item{\code{max_shifted_ratio}}{A \code{numeric} value indicating the maximum
-#'           tolerance for the ratio of the counterfactual and observed
+#'           of the desired shift (on the level of the treatment)}
+#'     \item{\code{max_shifted_ratio}}{A \code{numeric} value indicating the
+#'           maximum tolerance for the ratio of the counterfactual and observed
 #'           intervention densities. In particular, the shifted value of the
 #'           intervention is assigned to a given observational unit when the
 #'           ratio of the counterfactual intervention density to the observed
-#'           intervention density is below this value
-##'    }
-#'     \item{\code{...}}{Not currently used.
-#'     }
+#'           intervention density is below this value.}
+#'     \item{\code{...}}{Not currently used.}
 #'   }
 #'
 #' @section Fields:
 #' \describe{
 #'     \item{\code{original_lf}}{\code{\link{LF_base}} object, the likelihood
-#'           factor to shift
-#'     }
-#'     \item{\code{shift_function}}{\code{function}, defines the shift
-#'     }
+#'           factor to shift.}
+#'     \item{\code{shift_function}}{\code{function}, defines the shift.}
 #'     \item{\code{shift_inverse}}{\code{function}, the inverse of a given
-#'           \code{shift_function}
-#'     }
+#'           \code{shift_function}.}
 #'     \item{\code{shift_delta}}{\code{numeric}, specification of the magnitude
-#'           of the desired shift (on the level of the treatment)
-##'    }
-#'     \item{\code{max_shifted_ratio}}{A \code{numeric} value indicating the maximum
-#'           tolerance for the ratio of the counterfactual and observed
+#'           of the desired shift (on the level of the treatment}.}
+#'     \item{\code{max_shifted_ratio}}{A \code{numeric} value indicating the
+#'           maximum tolerance for the ratio of the counterfactual and observed
 #'           intervention densities. In particular, the shifted value of the
 #'           intervention is assigned to a given observational unit when the
 #'           ratio of the counterfactual intervention density to the observed
-#'           intervention density is below this value
-##'    }
-#'     \item{\code{...}}{Additional arguments passed to the base class.
-#'     }
+#'           intervention density is below this value.}
+#'     \item{\code{...}}{Additional arguments passed to the base class.}
 #'   }
 #'
 #' @export
-#
 LF_shift <- R6::R6Class(
   classname = "LF_shift",
   portable = TRUE,

R/Param_MSM_linear.R

@@ -36,6 +36,7 @@
 #'     \item{\code{intervention_list}}{A list of objects inheriting from
 #'       \code{\link{LF_base}}, representing the intervention.}
 #' }
+#'
 #' @export
 Param_MSM_linear <- R6Class(
   classname = "Param_MSM_linear",

tests/testthat/test-missing_outcome.R

@@ -1,17 +1,17 @@
 context("Incorporating corrections for missingness in covariates")
-
 library(data.table)
 library(assertthat)
 library(uuid)
 library(sl3)
+library(tmle3)
+set.seed(34831)
 
 # setup data for test
-set.seed(34831)
 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[, parity01 := as.numeric(data$parity > 0)]
+data[, parity01_fac := factor(data$parity01)]
+data[, haz01 := as.numeric(data$haz > 0)]
 
 node_list <- list(
   W = c(
@@ -30,25 +30,32 @@ data <- data[!missing_W]
 # learners used for conditional expectation regression (e.g., outcome)
 mean_lrnr <- Lrnr_mean$new()
 glm_lrnr <- Lrnr_glm$new()
+xgb_lrnr <- Lrnr_xgboost$new()
 logit_metalearner <- make_learner(
   Lrnr_solnp, metalearner_logistic_binomial,
   loss_loglik_binomial
 )
 sl_lrnr <- Lrnr_sl$new(
-  learners = list(mean_lrnr, glm_lrnr),
-  metalearner = logit_metalearner 
+  learners = list(mean_lrnr, glm_lrnr, xgb_lrnr),
+  metalearner = logit_metalearner
 )
 
-# learners used for conditional density regression (i.e., propensity score)
-haldensify_lrnr <- Lrnr_haldensify$new(
-  n_bins = 5, grid_type = "equal_mass",
-  lambda_seq = exp(seq(-1, -13, length = 100))
+# learners used for conditional density estimation (i.e., propensity score)
+hse_learner <- make_learner(Lrnr_density_semiparametric,
+  mean_learner = glm_lrnr
+)
+mvd_learner <- make_learner(Lrnr_density_semiparametric,
+  mean_learner = xgb_lrnr,
+  var_learner = glm_lrnr
+)
+sl_density_lrnr <- Lrnr_sl$new(
+  learners = Stack$new(hse_learner, mvd_learner),
+  metalearner = Lrnr_solnp_density$new()
 )
-cv_haldensify_lrnr <- Lrnr_cv$new(haldensify_lrnr, full_fit = TRUE)
 
 # specify outcome and treatment regressions and create learner list
 Q_learner <- sl_lrnr
-g_learner <- cv_haldensify_lrnr
+g_learner <- sl_density_lrnr
 learner_list <- list(Y = Q_learner, A = g_learner, delta_Y = Q_learner)
 
 # initialize a tmle specification
@@ -58,23 +65,24 @@ tmle_spec <- tmle_shift(
   shift_fxn_inv = shift_additive_inv
 )
 
-## define data (from tmle3_Spec base class)
+# define data (from tmle3_Spec base class)
 tmle_task <- tmle_spec$make_tmle_task(data, node_list)
 Q_task <- tmle_task$get_regression_task("Y", drop_censored = TRUE)
 Q_learner <- learner_list$Y
 Q_fit <- Q_learner$train(Q_task)
 
-## define likelihood (from tmle3_Spec base class)
-likelihood_init <- tmle_spec$make_initial_likelihood(tmle_task, learner_list)
 
-## define update method (submodel and loss function)
-updater <- tmle_spec$make_updater()
-likelihood_targeted <- Targeted_Likelihood$new(likelihood_init, updater)
+# define likelihood
+initial_likelihood <- tmle_spec$make_initial_likelihood(tmle_task,
+                                                        learner_list)
+
+# define update method (submodel + loss function)
+updater <- tmle3_Update$new()
+targeted_likelihood <- Targeted_Likelihood$new(initial_likelihood, updater)
 
-## define param
-tmle_params <- tmle_spec$make_params(tmle_task, likelihood_targeted)
+# define param
+tmle_params <- tmle_spec$make_params(tmle_task, targeted_likelihood)
 updater$tmle_params <- tmle_params
 
-## fit tmle update
-tmle_fit <- fit_tmle3(tmle_task, likelihood_targeted, tmle_params, updater)
-tmle_fit
+# fit tmle update
+tmle_fit <- fit_tmle3(tmle_task, targeted_likelihood, tmle_params, updater)