forked from kararudolph/transport
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Readme.Rmd
103 lines (76 loc) · 3.96 KB
/
Readme.Rmd
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
---
output: github_document
---
```{r, echo = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "images/README-",
fig.width = 4,
fig.height = 3
)
```
# transport
[](https://travis-ci.org/ck37/transport)
[](https://ci.appveyor.com/project/ck37/transport)
[](https://codecov.io/github/ck37/transport?branch=master)
> Robust targeted maximum likelihood estimators (TMLEs) for transporting intervention effects from one population to another
## Description
transport is an R package for transport estimators: applying the estimated treatment effect from one population or site to another.
The package implements TMLE-based estimators for three parameters:
* intent-to-treat average treatment effect (ITTATE)
* average causal effect of the exposure on outcome (EACE)
* complier average causal effect (CACE)
## Installation
Install the development version from github:
```{r gh-installation, eval = FALSE}
# install.packages("devtools")
devtools::install_github("ck37/transport")
```
## Example
This example from Rudolph & van der Laan (2017) does not work yet, but will soon.
```{r example, eval = FALSE}
n <- 5000
site <- rbinom(n, 1, .5)
race <- rbinom(n,1, .4 + (.2 * site))
crime <- rnorm(n, .1 * site , 1)
discrimination <- rnorm(n, 1 + (.2 * site ), 1)
# Instrument
voucher <- rbinom(n, 1, .5)
# Exposure
move0 <- rbinom(n, 1, plogis(-log(1.6) -
log(1.1) * crime - log(1.3) * discrimination))
move1 <- rbinom(n, 1, plogis(-log(1.6) + log(4) - log(1.1) * crime -
log(1.3) * discrimination))
move <- ifelse(voucher == 1, move1, move0)
# Outcomes
inschoola0 <- rbinom(n, 1, plogis(log(1.6) +
(log(1.9) * move0) - log(1.3) * discrimination -
log(1.2) * race + log(1.2) * race * move0))
inschoola1 <- rbinom(n, 1, plogis(log(1.6) +
(log(1.9) * move1) - log(1.3) * discrimination -
log(1.2) * race + log(1.2) * race * move1))
inschoola <- ifelse(voucher == 1, inschoola1, inschoola0)
dat <- data.frame(w2 = crime , w3 = discrimination, w1 = race , site = site ,
a = voucher, z = move, y = inschoola)
wmat <- dat[, c("w1", "w2", "w3")]
amodel <- "a ~ 1"
sitemodel <- "site ~ w1 + w2 + w3 "
zmodel <- "z ~ a + w2 + w3"
outmodel <- "y ~ z + w1 + w3 + z:w1"
outmodelnoz <- "y ~ a + w1 + w3 + a:w1"
q2model <- "w1 + w2 + w3 "
ittate_est <- transport_ittate(a = dat$a, z = dat$z, y = dat$y, site = dat$site,
w = wmat, aamodel = amodel, asitemodel = sitemodel,
azmodel = zmodel, aoutmodel = outmodel,
aq2model = q2model)
cace_est <- transport_cace(ca = dat$a, cz = dat$z, cy = dat$y, csite = dat$site,
cw = wmat, csitemodel = sitemodel, czmodel = zmodel,
coutmodel = outmodel, cq2model = q2model)
eace_est <- transport_eace(a = dat$a, z = dat$z, y = dat$y, site = dat$site, w = wmat,
nsitemodel = sitemodel, nzmodel = zmodel,
noutmodel = outmodel)
```
## References
Rudolph, K. E., & van der Laan, M. J. (2017). [Robust estimation of encouragement design intervention effects transported across sites.](http://onlinelibrary.wiley.com/doi/10.1111/rssb.12213/full) Journal of the Royal Statistical Society: Series B (Statistical Methodology), 79(5), 1509-1525.
Rudolph, K. E., Schmidt, N. M., Glymour, M. M., Crowder, R., Galin, J., Ahern, J., & Osypuk, T. L. (2017). [Composition or context: using transportability to understand drivers of site differences in a large-scale housing experiment.](http://europepmc.org/abstract/med/29076878) Epidemiology (Cambridge, Mass.).