forked from alexluedtke12/sg
-
Notifications
You must be signed in to change notification settings - Fork 0
/
README.rmd
80 lines (60 loc) · 2.38 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
---
title: "sg"
output: rmarkdown::github_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
# Description
This package implements methods for methods for conducting subgroup analyses and estimating the impact of implementing the optimal individualized treatment strategy in the population.
# Installation
To install the package via [devtools](https://www.rstudio.com/products/rpackages/devtools/), use
```{r, eval=FALSE}
devtools::install_github("alexluedtke12/sg")
```
# Example
We now present an example on a sample of size n=1000. The SuperLearner library is small so that the example does not take long to run -- in practice, we recommend using a larger SuperLearner library.
```{r, echo=FALSE}
library(quadprog)
library(nnls)
library(SuperLearner)
```
```{r}
library(sg)
sim.data = function(nn){
W = data.frame(W1=rnorm(nn),W2=rnorm(nn),W3=rnorm(nn),W4=rnorm(nn))
A = rbinom(nn,1,1/2)
Y = rbinom(nn,1,Qbar(A,W))
return(list(W=W,A=A,Y=Y))
}
SL.library = c('SL.mean','SL.glm')
n = 1000
Qbar = function(a,w){plogis(-1 + 2*a*w$W1)} # function(a,w){plogis(a*(w$W1>0)*w$W1)}
# data to run methods on
dat = sim.data(n)
W = dat$W
A = dat$A
Y = dat$Y
# data to evaluate true parameter values
n.mc = 2e4
dat = sim.data(n.mc)
W.mc = dat$W
A.mc = dat$A
Y.mc = dat$Y
blip.mc = Qbar(1,W.mc)-Qbar(0,W.mc)
```
Below each example, we also print the true impact of implementing the rule, i.e. the quantity that sg.cvtmle is estimating.
```{r}
# Contrast optimal treatment strategy against treating with probability 1/2
sg.cvtmle(W,A,Y,txs=c(0,1),baseline.probs=c(1/2,1/2),SL.library=SL.library,sig.trunc=0.001,family=binomial(),kappa=1,num.SL.rep=2,num.est.rep=2,lib.ests=TRUE,verbose=FALSE)
# truth
mean(Qbar(1,W.mc)*((blip.mc>0)-1/2) + Qbar(0,W.mc)*((blip.mc<=0)-1/2))
# Contrast optimal treatment strategy against treating everyone with tx 0
sg.cvtmle(W,A,Y,txs=c(0,1),baseline.probs=c(1,0),SL.library=SL.library,sig.trunc=0.001,family=binomial(),kappa=1,num.SL.rep=2,num.est.rep=2,lib.ests=TRUE,verbose=FALSE)
# truth
mean((blip.mc)*(blip.mc>=0))
# Resource constraint: at most 25% can be treated. Contrast against treating everyone with tx 0
sg.cvtmle(W,A,Y,txs=c(0,1),baseline.probs=c(1,0),SL.library=SL.library,sig.trunc=0.001,family=binomial(),kappa=0.25,num.SL.rep=2,num.est.rep=2,lib.ests=TRUE,verbose=FALSE)
# truth
mean((blip.mc)*(blip.mc>=max(quantile(blip.mc,1-0.25),0)))
```