cem.R
In cem: Coarsened Exact Matching

### R code from vignette source 'cem.Rnw'

###################################################
### code chunk number 1: cem.Rnw:354-357
###################################################
old.options <- options()
options("digits"=4)
options("width"=80)


###################################################
### code chunk number 2: cem.Rnw:359-361
###################################################
require(cem)
data(LeLonde)


###################################################
### code chunk number 3: cem.Rnw:366-367
###################################################
Le <- data.frame(na.omit(LeLonde))


###################################################
### code chunk number 4: cem.Rnw:370-374
###################################################
tr <- which(Le$treated==1)
ct <- which(Le$treated==0)
ntr <- length(tr)
nct <- length(ct)


###################################################
### code chunk number 5: cem.Rnw:380-381
###################################################
mean(Le$re78[tr]) - mean(Le$re78[ct])


###################################################
### code chunk number 6: cem.Rnw:388-390
###################################################
vars <- c("age", "education", "black", "married", "nodegree", "re74",
"re75", "hispanic", "u74", "u75","q1")


###################################################
### code chunk number 7: cem.Rnw:394-395
###################################################
L1 <- L1.meas(Le$treated, Le[vars])$L1 


###################################################
### code chunk number 8: cem.Rnw:402-403
###################################################
imbalance(group=Le$treated, data=Le[vars])


###################################################
### code chunk number 9: cem.Rnw:478-479
###################################################
mat <- cem(treatment = "treated", data = Le, drop = "re78",keep.all=TRUE)


###################################################
### code chunk number 10: cem.Rnw:494-495
###################################################
mat


###################################################
### code chunk number 11: cem.Rnw:538-539
###################################################
levels(Le$q1)


###################################################
### code chunk number 12: cem.Rnw:543-544
###################################################
q1.grp <- list(c("strongly agree", "agree"), c("neutral","no opinion"), c("strongly disagree","disagree"))


###################################################
### code chunk number 13: cem.Rnw:566-567
###################################################
table(Le$education)


###################################################
### code chunk number 14: cem.Rnw:570-571
###################################################
educut <- c(0, 6.5, 8.5, 12.5, 17)


###################################################
### code chunk number 15: cem.Rnw:575-578
###################################################
mat1 <- cem(treatment = "treated", data = Le, drop = "re78", 
cutpoints = list(education=educut), grouping=list(q1=q1.grp))
mat1


###################################################
### code chunk number 16: cem.Rnw:586-587
###################################################
mat$breaks$education


###################################################
### code chunk number 17: cem.Rnw:590-591
###################################################
mat1$breaks$education


###################################################
### code chunk number 18: cem.Rnw:643-646
###################################################
cem("treated", Le, cutpoints = list(age=10), drop="re78", grouping=list(q1=q1.grp))
cem("treated", Le, cutpoints = list(age=6), drop="re78", grouping=list(q1=q1.grp))
cem("treated", Le, cutpoints = list(age=3), drop="re78", grouping=list(q1=q1.grp))


###################################################
### code chunk number 19: cem.Rnw:661-662
###################################################
tab <- relax.cem(mat, Le, depth=1, perc=0.3) 


###################################################
### code chunk number 20: cem.Rnw:666-669
###################################################
pdf("coarsen1.pdf", width=9, height=6, pointsize=10)
plot(tab,perc=0.3)
invisible(dev.off())


###################################################
### code chunk number 21: cem.Rnw:711-712
###################################################
plot(tab, group="1", perc=0.35,unique=TRUE)


###################################################
### code chunk number 22: cem.Rnw:716-719
###################################################
pdf("coarsen2.pdf", width=9, height=6, pointsize=10)
plot(tab, group="1", perc=0.35,unique=TRUE)
invisible(dev.off())


###################################################
### code chunk number 23: cem.Rnw:753-756
###################################################
mat <- cem(treatment="treated",data=Le, drop="re78",keep.all=TRUE)
mat
mat$k2k


###################################################
### code chunk number 24: cem.Rnw:760-763
###################################################
mat2 <- k2k(mat, Le, "euclidean", 1)
mat2
mat2$k2k


###################################################
### code chunk number 25: cem.Rnw:775-779
###################################################
data(LL)
mat <- cem(treatment="treated", data=LL, drop="re78")
est <- att(mat, re78 ~ treated, data = LL)
est


###################################################
### code chunk number 26: cem.Rnw:800-802
###################################################
est2 <- att(mat, re78 ~ treated + re74, data = LL)
est2


###################################################
### code chunk number 27: cem.Rnw:808-809
###################################################
att(mat, re78 ~ treated + re74 , data = LL, model="linear")


###################################################
### code chunk number 28: cem.Rnw:812-813
###################################################
att(mat, re78 ~ treated + re74 , data = LL, model="linear-RE")


###################################################
### code chunk number 29: cem.Rnw:817-818
###################################################
att(mat, re78 ~ treated + re74 , data = LL, model="forest")


###################################################
### code chunk number 30: cem.Rnw:823-826
###################################################
att(mat, re78 ~ treated + re74 , data = LL, model="linear", extra=TRUE)
att(mat, re78 ~ treated + re74 , data = LL, model="linear-RE", extra=TRUE)
att(mat, re78 ~ treated + re74 , data = LL, model="rf", extra=TRUE)


###################################################
### code chunk number 31: cem.Rnw:829-832
###################################################
est3 <- att(mat, re78 ~ treated + re74 , data = LL)
est3
plot(est3, mat, LL, vars=c("education", "age", "re74", "re75"))


###################################################
### code chunk number 32: cem.Rnw:836-840
###################################################
pdf("teff.pdf", width=9, height=6, pointsize=10)
est3 <- att(mat, re78 ~ treated + re74 + re75, data = LL)
plot(est3, mat, LL, vars=c("education", "age", "re74", "re75"))
invisible(dev.off())


###################################################
### code chunk number 33: cem.Rnw:879-881
###################################################
mat3 <- cem("treated", LeLonde, drop="re78", cutpoints = mat$breaks, grouping=list(q1=q1.grp))
mat3


###################################################
### code chunk number 34: cem.Rnw:884-886
###################################################
mat4 <- cem("treated", Le, drop="re78", cutpoints = mat$breaks, grouping=list(q1=q1.grp))
mat4


###################################################
### code chunk number 35: cem.Rnw:904-905
###################################################
summary(LeLonde)


###################################################
### code chunk number 36: cem.Rnw:909-914
###################################################
require(Amelia)
set.seed(123)
imputed <- amelia(LeLonde,noms=c("black","hispanic","treated","married","nodegree",
"u74","u75","q1"))
imputed <- imputed$imputations[1:5]


###################################################
### code chunk number 37: cem.Rnw:931-933
###################################################
mat2 <- cem("treated", datalist=imputed, drop="re78", data=LeLonde, grouping=list(q1=q1.grp))
mat2


###################################################
### code chunk number 38: cem.Rnw:940-942
###################################################
out <- att(mat2, re78 ~ treated, data=imputed)
out


###################################################
### code chunk number 39: cem.Rnw:948-955
###################################################
data(LL)

# cem match: automatic bin choice
mat <- cem(data=LL, drop="re78")

# we want a set of paired units
psample <- pair(mat, data=LL)


###################################################
### code chunk number 40: cem.Rnw:958-959
###################################################
table(psample$paired)


###################################################
### code chunk number 41: cem.Rnw:962-963
###################################################
psample$paired[1:100]


###################################################
### code chunk number 42: cem.Rnw:967-969
###################################################
table(psample$full.paired)
psample$full.paired[1:10]


###################################################
### code chunk number 43: cem.Rnw:973-979
###################################################
# cem match: automatic bin choice, we drop one row from the data set
mat1 <- cem(data=LL[-1,], drop="re78")

# we want a set of paired units but we have an odd number of units in the data
psample <- pair(mat1, data=LL[-1,])
table(psample$full.paired)


###################################################
### code chunk number 44: cem.Rnw:981-982
###################################################
options(old.options)