# NOT RUN {
data(schools)
# Kreft and De Leeuw, Introducing Multilevel Modeling, Sage (1988).
# The data set is the subsample of NELS-88 data consisting of 10 handpicked schools
# from the 1003 schools in the full data set.
# Let us consider the following variables:
X<-schools$ses #X<-as.matrix(schools[,c("ses","white","public")])
Y<-schools$math
Tr<-ifelse(schools$homework>1,1,0)
Group<-schools$schid
# Note that when Group is missing, NULL or there is only one Group the function
# returns the output of the Match function with a warning.
# Suppose that the effect of homeworks (Tr) on math score (Y)
# is unconfounded conditional on X and other unobserved schools features.
# Several strategies to handle unobserved group characteristics
# are described in Arpino and Cannas, 2016 (see References).
# Multivariate Matching on covariates in X
# default parameters: one-to-one matching on X
# with replacement with a caliper of 0.25; see also \code{Match}).
### Match preferentially within school
# first match within schools
# then (try to) match remaining units between schools
mpw <- MatchPW(Y=schools$math, Tr=Tr, X=schools$ses, Group=schools$schid, caliper=0.1)
# equivalent to
# CMatch(type="pwithin",Y=schools$math, Tr=Tr, X=schools$ses,
# Group=schools$schid, caliper=0.1)
# examine covariate balance
bmpw<- CMatchBalance(Tr~ses,data=schools,match.out=mpw)
# proportion of matched observations
(mpw$orig.treated.nobs-mpw$ndrops) / mpw$orig.treated.nobs
# check drops by school
mpw$orig.ndrops.by.group
# proportion of matched observations after match-within only
(mpw$orig.treated.nobs-sum(mpw$orig.ndrops.by.group.after.within)) / mpw$orig.treated.nobs
# complete output
mpw
# or use summary method for main results
summary(mpw)
#### Propensity score matching
# estimate the propensity score (ps) model
mod <- glm(Tr~ses+parented+public+sex+race+urban,
family=binomial(link="logit"),data=schools)
eps <- fitted(mod)
# eg 1: preferential within-school propensity score matching
psmw <- MatchPW(Y=schools$math, Tr=Tr, X=eps, Group=schools$schid, caliper=0.1)
# We can use other strategies for controlling unobserved cluster covariates
# by using different specifications of ps (see Arpino and Mealli for details):
# eg 2: standard propensity score matching using ps estimated
# from a logit model with dummies for schools
mod <- glm(Tr ~ ses + parented + public + sex + race + urban
+schid - 1,family=binomial(link="logit"),data=schools)
eps <- fitted(mod)
dpsm <- MatchPW(Y=schools$math, Tr=Tr, X=eps, caliper=0.1)
# this is equivalent to run Match with X=eps
# eg3: standard propensity score matching using ps estimated from
# multilevel logit model (random intercept at the school level)
require(lme4)
mod<-glmer(Tr ~ ses + parented + public + sex + race + urban + (1|schid),
family=binomial(link="logit"), data=schools)
eps <- fitted(mod)
mpsm<-MatchPW(Y=schools$math, Tr=Tr, X=eps, Group=NULL, caliper=0.1)
# this is equivalent to run Match with X=eps
# }
Run the code above in your browser using DataLab