Nothing
data <- gfoRmulaICE::compData
set.seed(1)
test_that(
"check classical pooled ICE direct effect - dynamic interventions",
{
ice_fit1 <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
ref_idx = 0,
estimator = pool(hazard = F),
int_descript = c("Dynamic Intervention 1", "Dynamic Intervention 2",
"Dynamic Intervention 3"),
intervention1.A2 = list(dynamic("L1 == 0", static(0), static(1))),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1), absorb = T)),
intervention3.A2 = list(dynamic("L1 == 0", static(0), natural_course()))
)
out <- as.matrix(ice_fit1$summary)
print(out)
rownames(out) <- c()
out <- as.vector(out)
expect_equal(
out,
c(0.26851, NA, NA, NA, 0.26874, 0.30568, 0.25787, 0.32326,
1.00000, 1.13746, 0.95957, 1.20286, 0.00000, 0.03694, -0.01087, 0.05452)
)})
test_that(
"check classical pooled ICE direct effect - dynamic interventions (using data table)",
{
ice_fit1 <- ice(data = data.table(data), time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
ref_idx = 0,
estimator = pool(hazard = F),
int_descript = c("Dynamic Intervention 1", "Dynamic Intervention 2",
"Dynamic Intervention 3"),
intervention1.A2 = list(dynamic("L1 == 0", static(0), static(1))),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1), absorb = T)),
intervention3.A2 = list(dynamic("L1 == 0", static(0), natural_course()))
)
out <- as.matrix(ice_fit1$summary)
print(out)
rownames(out) <- c()
out <- as.vector(out)
expect_equal(
out,
c(0.26851, NA, NA, NA, 0.26874, 0.30568, 0.25787, 0.32326,
1.00000, 1.13746, 0.95957, 1.20286, 0.00000, 0.03694, -0.01087, 0.05452)
)})
test_that(
"check different interventions",
{
set.seed(1)
ice_fit2 <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
ref_idx = 0,
estimator = pool(hazard = F),
int_descript = c("Static Intervention", "Threshold Intervention",
"Dynamic Intervention with Grace Period"),
intervention1.A1 = list(static(3)),
intervention1.A2 = list(static(1)),
intervention2.L2 = list(threshold(-3, Inf)),
intervention3.A2 = list(grace_period("uniform", 2, "L1 == 0"))
)
out <- as.matrix(ice_fit2$summary)
print(out)
rownames(out) <- c()
out <- as.vector(out)
expect_equal(
out,
c(0.26851, NA, NA, NA, 0.26874, 0.24935, 0.26874, 0.28701, 1.00000, 0.92784, 1.00000, 1.06799,
0.000000, -0.01939, 0.00000, 0.01827)
)})
test_that(
"check user-defined intervention",
{
ice_fit3 <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
ref_idx = 0,
estimator = pool(hazard = F),
int_descript = c("Static Intervention", "Dynamic Intervention"),
intervention1.A1 = list(static(3)),
intervention1.A2 = list(static(1)),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3)),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)))
)
out <- as.matrix(ice_fit3$summary)
print(out)
rownames(out) <- c()
out <- as.vector(out)
expect_equal(
out,
c(0.26851, NA, NA, 0.26874, 0.24935, 0.34078, 1.00000, 0.92784, 1.26807,
0.00000, -0.01939, 0.07204)
)})
test_that(
"check complicated scenario 2 - doubly robust ICE with intervention-specific models",
{
library(splines)
ice_fit6b <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
outcome_model = Y ~ I(L1^2), censor_model = C ~ lag1_L1,
competing_model = D ~ L1,
comp_effect = 1,
ref_idx = 0,
estimator = weight(list(A1 ~ L1 + I(L2^2) + lag1_L2, A2 ~ lag2_L1 + L1 + ns(L2, df = 2))),
int_descript = c("Static Intervention",
"Dynamic Intervention"),
intervention1.A1 = list(static(3)),
intervention1.A2 = list(static(1)),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3)),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1))),
outcomeModel.1 = Y ~ I(L1^2) + ns(lag1_L2, df = 3),
compModel.2 = D ~ lag1_L1 + ns(L2, df = 2)
)
out <- as.matrix(ice_fit6b$summary)
print(out)
rownames(out) <- c()
out <- as.vector(out)
expect_equal(
out,
as.vector(c(0.22982, NA, NA, 0.22722, 0.19441, 0.24194,
1.00000, 0.85562, 1.06480, 0.00000, -0.03280, 0.01472))
)})
test_that(
"check complicated scenario 3 - intervention-specific time options",
{
library(splines)
set.seed(1)
ice_fit7a <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
ref_idx = 0,
estimator = pool(hazard = F),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:2),
intervention1.A2 = list(static(1), 1:3),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 1:2),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)))
)
ice_fit7b <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
competing_model = D ~ L1 + L2 + A1 + A2,
ref_idx = 0,
estimator = pool(hazard = T),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2)
)
ice_fit7c <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
competing_model = D ~ L1 + L2 + A1 + A2,
hazard_model = Y ~ L1 + L2,
ref_idx = 0,
estimator = pool(hazard = T),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2)
)
ice_fit7d <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2 + A1 + A2,
censor_model = C ~ L1 + L2 + A1 + A2,
competing_model = D ~ L1 + L2 + A1 + A2,
hazard_model = Y ~ L1 + L2 + A1 + A2 + ns(t0, df = 2),
global_hazard = T,
ref_idx = 0,
estimator = pool(hazard = T),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2)
)
ice_fit7e <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2,
censor_model = C ~ L1 + L2,
ref_idx = 0,
estimator = strat(hazard = F),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2)
)
ice_fit7f <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2,
censor_model = C ~ L1 + L2,
competing_model = D ~ L1 + L2,
hazard_model = Y ~ L1,
ref_idx = 0,
estimator = strat(hazard = T),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2)
)
ice_fit7g <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
comp_effect = 0,
outcome_model = Y ~ L1 + L2,
censor_model = C ~ L1 + L2,
ref_idx = 0,
estimator = weight(list(A1 ~ L1 + L2, A2 ~ L1 + L2)),
int_descript = c("Static Intervention", "Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2)
)
ice_fit7h <- ice(data = data, time_points = 4,
id = "id", time_name = "t0",
censor_name = "C", outcome_name = "Y",
compevent_name = "D",
outcome_model = Y ~ L1, censor_model = C ~ L1,
competing_model = D ~ L1,
comp_effect = 1,
ref_idx = 0,
estimator = strat(hazard = T),
int_descript = c("Static Intervention",
"Dynamic Intervention"),
# nsamples = 5, ci_method = "percentile", parallel = T, ncores = 5,
intervention1.A1 = list(static(3), 0:1),
intervention1.A2 = list(static(1), 1:2),
intervention2.A1 = list(case_when(data$L2 < 0 ~ 1,
data$L2 >= 0 & data$L2 < 2 ~ 2, T ~ 3), 2:3),
intervention2.A2 = list(dynamic("L1 == 0", static(0), static(1)), 0:2),
outcomeModel.1 = Y ~ L1 + L2,
compModel.2 = D ~ L1 + L2
)
out <- as.matrix(summary(ice_fit7a, ice_fit7b, ice_fit7c, ice_fit7d,
ice_fit7e, ice_fit7f, ice_fit7g, ice_fit7h)[, -(1:2)])
print(out)
rownames(out) <- c()
colnames(out) <- c()
out <- as.vector(out)
expect_equal(
out,
as.vector(c(0.26851, NA, NA, 0.26851, NA, NA, 0.26851, NA, NA, 0.26851, NA, NA,
0.26947, NA, NA, 0.26947, NA, NA, 0.26947, NA, NA, 0.22987, NA, NA,
0.26874, 0.27218, 0.33107, 0.21482, 0.26318, 0.20892, 0.21573, 0.23855, 0.21463,
0.26811, 0.27992, 0.32020, 0.26967, 0.27646, 0.31554, 0.26941, 0.27523, 0.31377,
0.26118, 0.27455, 0.31287, 0.24359, 0.24675, 0.27024,
1.00000, 1.01280, 1.23195, 1.00000, 1.22513, 0.97255, 1.00000, 1.10579, 0.99492,
1.00000, 1.04407, 1.19430, 1.00000, 1.02521, 1.17010, 1.00000, 1.02162, 1.16467,
1.00000, 1.05118, 1.19790, 1.00000, 1.01294, 1.10937,
0.00000, 0.00344, 0.06234, 0.00000, 0.04836, -0.00590, 0.00000, 0.02282, -0.00110,
0.00000, 0.01181, 0.05209, 0.00000, 0.00680, 0.04587, 0.00000, 0.00582, 0.04436,
0.00000, 0.01337, 0.05169, 0.00000, 0.00315, 0.02664))
)})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.