Description Usage Arguments Value Examples
View source: R/main_estimation.R
Evaluate the inverse probability weights for up to 3 intervention nodes: CENS
, TRT
and MONITOR
.
This is based on the inverse of the propensity score fits for the observed likelihood (g0.C, g0.A, g0.N),
multiplied by the indicator of not being censored and the probability of each intervention in intervened_TRT
and intervened_MONITOR
.
Requires column name(s) that specify the counterfactual node values or the counterfactual probabilities of each
node being 1 (for stochastic interventions).
The output is person-specific data with evaluated weights, wts.DT
, only observation-times with non-zero
weight are kept
Can be one regimen per single run of this block, which are then combined into a list of output datasets with lapply.
Alternative is to allow input with several rules/regimens, which are automatically combined into a list of output datasets.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | getIPWeights(
OData,
intervened_TRT = NULL,
intervened_MONITOR = NULL,
useonly_t_TRT = NULL,
useonly_t_MONITOR = NULL,
rule_name = paste0(c(intervened_TRT, intervened_MONITOR), collapse = ""),
tmax = NULL,
ignore_tmin = NULL,
ignore_tmax = NULL,
reverse_wt_prod = FALSE,
holdout = FALSE,
eval_stabP = TRUE,
trunc_weights = Inf,
intervened_type_TRT = NULL,
intervened_type_MONITOR = NULL
)
|
OData |
Input data object created by |
intervened_TRT |
Column name in the input data with the probabilities (or indicators) of counterfactual
treatment nodes being equal to 1 at each time point.
Leave the argument unspecified ( |
intervened_MONITOR |
Column name in the input data with probabilities (or indicators) of counterfactual
monitoring nodes being equal to 1 at each time point.
Leave the argument unspecified ( |
useonly_t_TRT |
Use for intervening only on some subset of observation and time-specific treatment nodes.
Should be a character string with a logical expression that defines the subset of intervention observations.
For example, using |
useonly_t_MONITOR |
Same as |
rule_name |
Optional name for the treatment/monitoring regimen. |
tmax |
Maximum value of the follow-up period. All person-time observations above this value will be excluded from the output weights dataset. |
ignore_tmin |
(ADVANCED FEATURE) Minimum value of the follow-up period at which the IP-weights should start accumulating over time. All IP-weights for time-points t < ignore_tmin will be set to a constant 1. This will have the effect of completely ignoring all weight contributions that occur before ignore_tmin. |
ignore_tmax |
(ADVANCED FEATURE) Maximum value of the follow-up period to start accumulative the weights over time. All of the time-specific IP-weights with t < ignore_tmin will be set to constant 1 PRIOR to the evaluation of the cumulative weights. This will have the effect of completely ignoring all the IP weight contributions up to and including the time-point ignore_tmin. |
reverse_wt_prod |
Set to TRUE to take the product of the cumulative weights in reverse time-ordering. That is, the cumulative product will be evaluated by starting from the highest follow-up time point (time variable value). |
holdout |
Obtain the weights based on out-of-sample (holdout / validation set) predictions of propensity scores. This is useful for running CV-TMLE or evaluating the quality of the model fits based on validation sets. |
eval_stabP |
Evaluate the additional weight stabilization factor for each time-point. This is used for MSMs only and is enabled by default. |
trunc_weights |
Specify the numeric weight truncation value. All final weights exceeding the value in
|
intervened_type_TRT |
(ADVANCED FUNCTIONALITY) Set to |
intervened_type_MONITOR |
(ADVANCED FUNCTIONALITY) Same as |
A data.table
with cumulative weights for each subject and each time-point saved under column "cum.IPAW".
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | options(stremr.verbose = TRUE)
require("data.table")
# ----------------------------------------------------------------------
# Simulated Data
# ----------------------------------------------------------------------
data(OdataNoCENS)
OdataDT <- as.data.table(OdataNoCENS, key=c("ID", "t"))
# define lagged N, first value is always 1 (always monitored at the first time point):
OdataDT[, ("N.tminus1") := shift(get("N"), n = 1L, type = "lag", fill = 1L), by = ID]
OdataDT[, ("TI.tminus1") := shift(get("TI"), n = 1L, type = "lag", fill = 1L), by = ID]
# ----------------------------------------------------------------------
# Define intervention (always treated):
# ----------------------------------------------------------------------
OdataDT[, ("TI.set1") := 1L]
OdataDT[, ("TI.set0") := 0L]
# ----------------------------------------------------------------------
# Import Data
# ----------------------------------------------------------------------
OData <- importData(OdataDT, ID = "ID", t = "t", covars = c("highA1c", "lastNat1", "N.tminus1"),
CENS = "C", TRT = "TI", MONITOR = "N", OUTCOME = "Y.tplus1")
# ----------------------------------------------------------------------
# Look at the input data object
# ----------------------------------------------------------------------
print(OData)
# ----------------------------------------------------------------------
# Access the input data
# ----------------------------------------------------------------------
get_data(OData)
# ----------------------------------------------------------------------
# Model the Propensity Scores
# ----------------------------------------------------------------------
gform_CENS <- "C ~ highA1c + lastNat1"
gform_TRT = "TI ~ CVD + highA1c + N.tminus1"
gform_MONITOR <- "N ~ 1"
stratify_CENS <- list(C=c("t < 16", "t == 16"))
# ----------------------------------------------------------------------
# Fit Propensity Scores
# ----------------------------------------------------------------------
OData <- fitPropensity(OData, gform_CENS = gform_CENS,
gform_TRT = gform_TRT,
gform_MONITOR = gform_MONITOR,
stratify_CENS = stratify_CENS)
# ----------------------------------------------------------------------
# IPW Ajusted KM or Saturated MSM
# ----------------------------------------------------------------------
require("magrittr")
AKME.St.1 <- getIPWeights(OData, intervened_TRT = "TI.set1") %>%
survNPMSM(OData) %$%
estimates
AKME.St.1
# ----------------------------------------------------------------------
# Bounded IPW
# ----------------------------------------------------------------------
IPW.St.1 <- getIPWeights(OData, intervened_TRT = "TI.set1") %>%
directIPW(OData)
IPW.St.1[]
# ----------------------------------------------------------------------
# IPW-MSM for hazard
# ----------------------------------------------------------------------
wts.DT.1 <- getIPWeights(OData = OData, intervened_TRT = "TI.set1", rule_name = "TI1")
wts.DT.0 <- getIPWeights(OData = OData, intervened_TRT = "TI.set0", rule_name = "TI0")
survMSM_res <- survMSM(list(wts.DT.1, wts.DT.0), OData, tbreaks = c(1:8,12,16)-1,)
survMSM_res$St
# ----------------------------------------------------------------------
# Sequential G-COMP
# ----------------------------------------------------------------------
t.surv <- c(0:10)
Qforms <- rep.int("Qkplus1 ~ CVD + highA1c + N + lastNat1 + TI + TI.tminus1", (max(t.surv)+1))
params <- gridisl::defModel(estimator = "speedglm__glm")
## Not run:
gcomp_est <- fit_GCOMP(OData, tvals = t.surv, intervened_TRT = "TI.set1",
Qforms = Qforms, models = params, stratifyQ_by_rule = FALSE)
gcomp_est[]
## End(Not run)
# ----------------------------------------------------------------------
# TMLE
# ----------------------------------------------------------------------
## Not run:
tmle_est <- fit_TMLE(OData, tvals = t.surv, intervened_TRT = "TI.set1",
Qforms = Qforms, models = params, stratifyQ_by_rule = TRUE)
tmle_est[]
## End(Not run)
# ----------------------------------------------------------------------
# Running IPW-Adjusted KM with optional user-specified weights:
# ----------------------------------------------------------------------
addedWts_DT <- OdataDT[, c("ID", "t"), with = FALSE]
addedWts_DT[, new.wts := sample.int(10, nrow(OdataDT), replace = TRUE)/10]
survNP_res_addedWts <- survNPMSM(wts.DT.1, OData, weights = addedWts_DT)
# ----------------------------------------------------------------------
# Multivariate Propensity Score Regressions
# ----------------------------------------------------------------------
gform_CENS <- "C + TI + N ~ highA1c + lastNat1"
OData <- fitPropensity(OData, gform_CENS = gform_CENS, gform_TRT = gform_TRT,
gform_MONITOR = gform_MONITOR)
# ----------------------------------------------------------------------
# Fitting treatment model with Gradient Boosting machines:
# ----------------------------------------------------------------------
## Not run:
require("h2o")
h2o::h2o.init(nthreads = -1)
gform_CENS <- "C ~ highA1c + lastNat1"
models_TRT <- sl3::Lrnr_h2o_grid$new(algorithm = "gbm")
OData <- fitPropensity(OData, gform_CENS = gform_CENS,
gform_TRT = gform_TRT,
models_TRT = models_TRT,
gform_MONITOR = gform_MONITOR,
stratify_CENS = stratify_CENS)
# Use `H2O-3` distributed implementation of GLM for treatment model estimator:
models_TRT <- sl3::Lrnr_h2o_glm$new(family = "binomial")
OData <- fitPropensity(OData, gform_CENS = gform_CENS,
gform_TRT = gform_TRT,
models_TRT = models_TRT,
gform_MONITOR = gform_MONITOR,
stratify_CENS = stratify_CENS)
# Use Deep Neural Nets:
models_TRT <- sl3::Lrnr_h2o_grid$new(algorithm = "deeplearning")
OData <- fitPropensity(OData, gform_CENS = gform_CENS,
gform_TRT = gform_TRT,
models_TRT = models_TRT,
gform_MONITOR = gform_MONITOR,
stratify_CENS = stratify_CENS)
## End(Not run)
# ----------------------------------------------------------------------
# Fitting different models with different algorithms
# Fine tuning modeling with optional tuning parameters.
# ----------------------------------------------------------------------
## Not run:
params_TRT <- sl3::Lrnr_h2o_grid$new(algorithm = "gbm",
ntrees = 50,
learn_rate = 0.05,
sample_rate = 0.8,
col_sample_rate = 0.8,
balance_classes = TRUE)
params_CENS <- sl3::Lrnr_glm_fast$new()
params_MONITOR <- sl3::Lrnr_glm_fast$new()
OData <- fitPropensity(OData,
gform_CENS = gform_CENS, stratify_CENS = stratify_CENS, params_CENS = params_CENS,
gform_TRT = gform_TRT, params_TRT = params_TRT,
gform_MONITOR = gform_MONITOR, params_MONITOR = params_MONITOR)
## End(Not run)
# ----------------------------------------------------------------------
# Running TMLE based on the previous fit of the propensity scores.
# Also applying Random Forest to estimate the sequential outcome model
# ----------------------------------------------------------------------
## Not run:
t.surv <- c(0:5)
Qforms <- rep.int("Qkplus1 ~ CVD + highA1c + N + lastNat1 + TI + TI.tminus1", (max(t.surv)+1))
models <- sl3::Lrnr_h2o_grid$new(algorithm = "randomForest",
ntrees = 100, learn_rate = 0.05, sample_rate = 0.8,
col_sample_rate = 0.8, balance_classes = TRUE)
tmle_est <- fit_TMLE(OData, tvals = t.surv, intervened_TRT = "TI.set1",
Qforms = Qforms, models = models,
stratifyQ_by_rule = TRUE)
## End(Not run)
## Not run:
t.surv <- c(0:5)
Qforms <- rep.int("Qkplus1 ~ CVD + highA1c + N + lastNat1 + TI + TI.tminus1", (max(t.surv)+1))
models <- sl3::Lrnr_h2o_grid$new(algorithm = "randomForest",
ntrees = 100, learn_rate = 0.05, sample_rate = 0.8,
col_sample_rate = 0.8, balance_classes = TRUE)
tmle_est <- fit_TMLE(OData, tvals = t.surv, intervened_TRT = "TI.set1",
Qforms = Qforms, models = models,
stratifyQ_by_rule = FALSE)
## End(Not run)
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.