Description Usage Arguments Examples
General TMLE function that takes care of the bookkeeping of estimation and update steps.
1 |
estimate_fun |
Function for estimation step |
<<<<<<< HEAD
update_fun, |
Function for update step |
max_iter, |
Maximum number of iteration steps |
..., |
Extra arguments that can be passed to update_fun and estimate_fun |
=======
update_fun, |
Function for update step |
max_iter, |
Maximum number of iteration steps |
..., |
Extra arguments that can be passed to update_fun and estimate_fun |
>>>>>>> gentmle/master
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 | ###### Example of TMLE for the treatment-specific mean E[Y_1]
Qbar0 <- function(A, W) {
W1 <- W[, 1]
W2 <- W[, 2]
Qbar <- plogis(A + A * W1 + W2)
return(Qbar)
}
g0 <- function(W) {
W1 <- W[, 1]
W2 <- W[, 2]
# rep(0.5, nrow(W))
plogis(0.25 * W1 - 0.1 * W2)
}
gen_data <- function(n = 1000, p = 2) {
W <- matrix(rnorm(n * p), nrow = n)
colnames(W) <- paste("W", seq_len(p), sep = "")
A <- rbinom(n, 1, g0(W))
u <- runif(n)
Y <- as.numeric(u < Qbar0(A, W))
Y0 <- as.numeric(u < Qbar0(0, W))
Y1 <- as.numeric(u < Qbar0(1, W))
data.frame(W, A, Y, Y0, Y1)
}
data <- gen_data(1000)
Wnodes <- grep("^W", names(data), value = T)
gk <- g0(data[, Wnodes])
Qk <- Qbar0(data$A, data[, Wnodes])
Q1k <- Qbar0(1, data[, Wnodes])
Q0k <- Qbar0(1, data[, Wnodes])
tmledata <- data.frame(A = data$A, Y = data$Y, gk = gk, Qk = Q1k)
result <- gentmle(tmledata, ey1_estimate, ey1_update)
print(result)
tmledata2 <- data.frame(A = data$A, Y = data$Y, gk = gk, QAk = Qk, Q1k = Q1k, Q0k = Q0k)
result2 <- gentmle(tmledata2, ey1_estimate2, ey1_update2)
print(result2)
###### Example of TMLE for a stochastic intervention mean E[Y_gstar]
Qbar0 <- function(A, W) {
W1 <- W[, 1]
W2 <- W[, 2]
W3 <- W[, 3]
W4 <- W[, 4]
Qbar <- plogis(ifelse(W4 > 0, (A == 1) + (A == 1) * (5 * W1^2 - 4.45), (A == 2) + (A == 3) +
(A == 2) * (4 * W2) + (A == 3) * (5 * W3)))
return(Qbar)
}
g0 <- function(W) {
W1 <- W[, 1]
W2 <- W[, 2]
W3 <- W[, 3]
W4 <- W[, 4]
# rep(0.5, nrow(W))
A1 <- plogis(W1)
A2 <- plogis(W2)
A3 <- plogis(W3)
A <- cbind(A1, A2, A3)
# make sure A sums to 1
A <- normalize_rows(A)
}
gen_data <- function(n = 1000, p = 4) {
W <- matrix(rnorm(n * p), nrow = n)
colnames(W) <- paste("W", seq_len(p), sep = "")
pA <- g0(W)
A <- factor(apply(pA, 1, function(pAi) which(rmultinom(1, 1, pAi) == 1)))
A_vals <- vals_from_factor(A)
u <- runif(n)
Y <- as.numeric(u < Qbar0(A, W))
Q0aW <- sapply(A_vals, Qbar0, W)
d0 <- apply(Q0aW, 1, which.max)
Yd0 <- as.numeric(u < Qbar0(d0, W))
data.frame(W, A, Y, Q0aW, d0, Yd0)
}
data <- gen_data(1e+05, 5)
Anode <- "A"
Wnodes <- grep("^W", names(data), value = T)
Q_fit <- glm(data$Y ~ ., data[, c("A", Wnodes)], family = binomial(link = "logit"))
g_fit <- multinomial_SuperLearner(data$A, data[, Wnodes])
A_vals <- vals_from_factor(data$A)
Q_a <- sapply(A_vals, function(A_val) {
newdata <- data[, c(Anode, Wnodes)]
newdata[, Anode] <- A_val
predict(Q_fit, newdata, type = "response")
})
pA <- predict(g_fit, newdata = data[, Wnodes])$pred
# A sample gstar--treat with A=1, if the patient received A=1 or 2, otherwise leave alone
gstar <- function(A, gk) {
ifelse(A == 1, gk[, 1] + gk[, 2], ifelse(A == 3, gk[, 3], 0))
}
# estimate using Qn, gn Initial data set-up
initdata <- data
initdata$Q_a <- Q_a
initdata$pA <- pA
result <- gentmle(initdata, eysi_estimate, eysi_update, max_iter = 100, gstar = gstar)
print(result)
# estimate using Q0, g0 Initial data set-up
initdata2 <- data
initdata2$Q_a <- sapply(A_vals, Qbar0, data[, Wnodes])
initdata2$pA <- g0(data[, Wnodes])
result2 <- gentmle(initdata2, eysi_estimate, eysi_update, max_iter = 100, gstar = gstar)
print(result2)
mean(data$Y)
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.