PK
>iΡ4 4 CEM.xml
PK xXu@ META-INF/PK
>Ԕ META-INF/MANIFEST.MF Name: CEM
Dialog-Specs: CEM.spd
Command-Specs: CEM.xml,RCEM.xml
Code-Files: CEM.py,RCEM.R
Summary: Coarsened Exact Matching
Description: This program is designed to improve the estimation of cau
sal effects via an extremely powerful method of matching that is wide
ly applicable and exceptionally easy to understand and use (if you un
derstand how to draw a histogram, you will understand this method). T
he program implements the Coarsened Exact Matching (CEM) algorithm de
scribed in Iacus, King, and Porro (2011).
Author: Matthew Blackwell, Stefano Iacus, Gary King, and Giuseppe Porro
Version: 0.1.0
Product-Version: 18
Plugins: Python,R
R-Packages: cem
PK
> RCEM.R # CEM for SPSS
# Author: Matthew Blackwell
# history
# 02-June-2011 - original version
rcem <- function(tr, mvars, k2k = FALSE, outdata="cem", noimbal =
FALSE, cutpoints = NULL,grouping = NULL,
depth = NULL, perc = 0.5, idvars = NULL, noncoarse = NULL) {
library(cem)
if (!is.null(cutpoints)) {
cuts <- gsub("\\(", "c\\(", cutpoints)
cuts <- paste(cuts, collapse=",")
cuts <- paste("list(",cuts,")", sep="")
cutpoints <- eval(parse(text=cuts))
}
if (!is.null(grouping)) {
grps <- gsub("\\(", "c\\(", grouping)
grps <- gsub("\\[", "list\\(", grps)
grps <- gsub("\\]", "\\)", grps)
grps <- paste(grps, collapse=",")
grps <- paste("list(",grps,")", sep="")
grouping <- eval(parse(text=grps))
}
if (!is.null(grouping)) {
for (i in 1:length(grouping)) {
if (is.numeric(grouping[[i]])) {
if (grouping[[i]] == 0) {
noncoarse <- c(noncoarse, names(grouping)[[i]])
groupings[[i]] <- NULL
}
}
}
}
noncoarse <- unique(noncoarse)
dict <- spssdictionary.GetDictionaryFromSPSS(variables = c(tr, mvars))
idict <- spssdictionary.GetDictionaryFromSPSS(variables = idvars)
data <- spssdata.GetDataFromSPSS(variables = c(tr, mvars), missingValueToNA = TRUE)
idata <- spssdata.GetDataFromSPSS(variables = idvars, missingValueToNA = TRUE)
drop.vars <- setdiff(names(data), c(tr, mvars))
for (i in mvars) {
if (is.factor(data[[i]])) {
levels(data[[i]]) <- gsub("\\s+$", "", levels(data[[i]]))
}
}
if (!is.null(noncoarse)) {
if (is.null(grouping))
grouping <- list()
for (i in noncoarse) {
grouping[[i]] <- unique(data[,i])
}
}
m.out <- cem(treatment = tr, data = data, k2k = k2k,
eval.imbalance = !noimbal, cutpoints=cutpoints,
drop = drop.vars, grouping=grouping)
varSpec1 <- c("cem.matched", "Unit was matched by CEM", 0, "F8.0", "nominal")
varSpec2 <- c("cem.strata", "CEM Strata", 0, "F8.0", "nominal")
varSpec3 <- c("cem.weights", "CEM Weights", 0, "F8.4", "scale")
if (outdata %in% spssdata.GetDataSetList()) {
stop("Cannot create output dataset. Dataset name already exists.")
}
tryCatch({
#dict <- data.frame(idict, varSpec1, varSpec2, varSpec3)
dict <- spssdictionary.CreateSPSSDictionary(varSpec1, varSpec2, varSpec3)
spssdictionary.SetDictionaryToSPSS(datasetName = outdata, x = dict, hidden = TRUE)
newdata <- data.frame(as.numeric(m.out$matched),m.out$strata, m.out$w)
spssdata.SetDataToSPSS(outdata, newdata)
spssdictionary.EndDataStep()
},
error=function(e) {print(e)
cat("Failed to create output dataset. Dataset name must not already exist: ", outdata)
}
)
if (!noimbal) {
L1df <- data.frame(rbind(m.out$imbalance$L1$L1, m.out$imbalance$L1$LCS))
colnames(L1df) <- "Statistic"
rownames(L1df) <- c("Multivariate Imbalance Measure (L1):", "Percentage of local common support (LCS):")
}
spsspkg.StartProcedure("CEM")
spsspivottable.Display(m.out$tab, title = "Matching Summary", format=formatSpec.Count)
if (!noimbal) {
spsspivottable.Display(L1df, title = "Multivariate Imbalance")
spsspivottable.Display(m.out$imbalance$tab, title = "Univariate Imbalance After Matching")
}
spsspkg.EndProcedure()
if (!is.null(depth)) {
spsspkg.StartProcedure("Relaxing CEM")
relax.cem(m.out, data = data, depth = depth, perc = perc)
spsspkg.EndProcedure()
}
}
Run<-function(args){
args <- args[[2]]
oobj<-spsspkg.Syntax(templ=list(
spsspkg.Template(kwd="VARIABLES",subc="",ktype="existingvarlist",
var="mvars",islist=TRUE),
spsspkg.Template(kwd="TREATMENT",subc="",ktype="existingvarlist",
var="tr",islist=FALSE),
spsspkg.Template(kwd="ID",subc="SAVE",ktype="existingvarlist",
var="idvars",islist=TRUE),
spsspkg.Template(kwd="VARIABLES",subc="NOCOARSENING",ktype="existingvarlist",
var="noncoarse",islist=TRUE),
spsspkg.Template(kwd="K2K",subc="OPTIONS",ktype="bool",var="k2k"),
spsspkg.Template(kwd="NOIMBAL",subc="OPTIONS",ktype="bool",var="noimbal"),
spsspkg.Template(kwd="DEPTH",subc="RELAX",ktype="int",var="depth",vallist=list(1,3)),
spsspkg.Template(kwd="PERC",subc="RELAX",ktype="float",var="perc",vallist=list(0,1)),
spsspkg.Template(kwd="",subc="CUTPOINTS", islist=TRUE, ktype="literal", var="cutpoints"),
spsspkg.Template(kwd="",subc="GROUPING", islist=TRUE, ktype="literal", var="grouping"), spsspkg.Template(kwd="OUTPUTDATA",subc="SAVE",ktype="literal",var="outdata")
))
if ("HELP" %in% attr(args,"names"))
writeLines(helptext)
else
res <- spsspkg.processcmd(oobj,args,"rcem")
}
PK
>xD RCEM.xml
PK 4Z@mj CEM.pyWQsں~qbpIgLO d@lP+K%wWl@vzU<<*SP![n6Pr&MPBɨ~Ȓ 2"JF\2 0Q30FF$UyNeFJ%Ɣ\K%5\Ir'٭(Gw