[r-cran-matchit] 10/45: Import Upstream version 2.2-5
Andreas Tille
tille at debian.org
Fri Oct 20 06:17:19 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-matchit.
commit de2f7b0ac4ff3400c656b5cabdfaa740ffb897c1
Author: Andreas Tille <tille at debian.org>
Date: Fri Oct 20 07:40:52 2017 +0200
Import Upstream version 2.2-5
---
DESCRIPTION | 8 ++---
R/discard.R | 2 +-
R/match.qoi.R | 79 ++++++++++++++++++++++++++------------------
R/matchit.R | 12 +++++--
R/matchit2full.R | 2 +-
R/matchit2optimal.R | 2 +-
R/qqsum.R | 23 ++++++++-----
R/summary.matchit.R | 37 +++++++++++++--------
R/summary.matchit.full.R | 26 ++++++++++-----
R/summary.matchit.subclass.R | 33 ++++++++++--------
10 files changed, 137 insertions(+), 87 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 09528b5..b103d41 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,13 +1,13 @@
Package: MatchIt
-Version: 2.1-4
-Date: 2005-10-14
+Version: 2.2-5
+Date: 2005-12-07
Title: MatchIt: Nonparametric Preprocessing for Parametric Casual Inference
Author: Daniel Ho <daniel.e.ho at gmail.com>,
Kosuke Imai <kimai at Princeton.Edu>,
Gary King <king at harvard.edu>,
Elizabeth Stuart <stuart at stat.harvard.edu>
Maintainer: Kosuke Imai <kimai at Princeton.Edu>
-Depends: R (>= 2.1), MASS, Zelig
+Depends: R (>= 2.2), MASS, Zelig
Suggests: optmatch, Matching, WhatIf
Description: MatchIt selects matched samples of the
the original treated and control groups with similar
@@ -18,4 +18,4 @@ LazyLoad: yes
LazyData: yes
License: GPL version 2 or newer
URL: http://gking.harvard.edu/matchit
-Packaged: Fri Oct 14 11:43:20 2005; kimai
+Packaged: Wed Dec 7 09:39:20 2005; kimai
diff --git a/R/discard.R b/R/discard.R
index cb19df1..a7c9527 100644
--- a/R/discard.R
+++ b/R/discard.R
@@ -18,7 +18,7 @@ discard <- function(treat, pscore, option, X) {
else if (any(grep(option, c("hull.control", "hull.treat", "hull.both")))) {
## convext hull stuff
if (!("WhatIf" %in% .packages(all = TRUE)))
- install.packages("WhatIf", CRAN="http://gking.harvard.edu")
+ install.packages("WhatIf")
if (!("lpSolve" %in% .packages(all = TRUE)))
install.packages("lpSolve")
require(WhatIf)
diff --git a/R/match.qoi.R b/R/match.qoi.R
index 07ce657..4658dbf 100644
--- a/R/match.qoi.R
+++ b/R/match.qoi.R
@@ -1,12 +1,17 @@
## Function to calculate summary stats
-qoi <- function(xx,tt,ww, t.plot=NULL, c.plot=NULL, sds=NULL){
+qoi <- function(xx,tt,ww, t.plot=NULL, c.plot=NULL, sds=NULL,
+ standardize = FALSE){
weighted.var <- function(x, w) {
sum(w * (x - weighted.mean(x,w))^2)/(sum(w) - 1)}
- xsum <- matrix(NA,2,7)
+ xsum <- matrix(NA,2,6)
xsum <- as.data.frame(xsum)
row.names(xsum) <- c("Full","Matched")
- names(xsum) <- c("Means Treated","Means Control","Treated SD","Std. Bias", "QQ Med",
- "QQ Mean", "QQ Max")
+ if (standardize)
+ names(xsum) <- c("Means Treated","Means Control", "Std. Mean Diff.",
+ "eCDF Med", "eCDF Mean", "eCDF Max")
+ else
+ names(xsum) <- c("Means Treated","Means Control","Mean Diff", "eQQ Med",
+ "eQQ Mean", "eQQ Max")
x1 <- xx[tt==1]
x0 <- xx[tt==0]
ww1 <- ww[tt==1]
@@ -18,43 +23,53 @@ qoi <- function(xx,tt,ww, t.plot=NULL, c.plot=NULL, sds=NULL){
xsum[2,1] <- weighted.mean(X.t.m, ww1[ww1>0])
xsum[2,2] <- weighted.mean(X.c.m, ww0[ww0>0])
if(!(sum(tt==1)<2|(sum(tt==0)<2))){
- xsum[1,3] <- sd(x1,na.rm=T)
- qqall <- qqsum(x1,x0)
- xsum[1,5:7] <- c(qqall$meddiff,qqall$meandiff,qqall$maxdiff)
- #xsum[1,7] <- (mean(x1,na.rm=T)-mean(x0,na.rm=T))/sd(x1,na.rm=T)
- if (!is.null(sds)) xsum[1,4] <- (mean(x1,na.rm=T)-mean(x0,na.rm=T))/sds
- else xsum[1,4] <- (mean(x1,na.rm=T)-mean(x0,na.rm=T))/xsum[1,3]
- xsum[2,3] <- sqrt(weighted.var(x1[ww1>0],ww1[ww1>0]))
- if(!is.null(t.plot)) qqmat <- qqsum(xx[t.plot],xx[c.plot])
- else qqmat <- qqsum(x1[ww1>0],x0[ww0>0])
- xsum[2,5:7] <- c(qqmat$meddiff,qqmat$meandiff,qqmat$maxdiff)
- #xsum[2,7] <- (xsum[2,1]-xsum[2,2])/sqrt(weighted.var(X.t.m,ww1[ww1>0]))
- if (!is.null(sds)) xsum[2,4] <- (xsum[2,1]-xsum[2,2])/sds
- xsum[2,4] <- (xsum[2,1]-xsum[2,2])/xsum[1,3]
+ xsd <- sd(x1,na.rm=T)
+ qqall <- qqsum(x1,x0,standardize=standardize)
+ xsum[1,4:6] <- c(qqall$meddiff,qqall$meandiff,qqall$maxdiff)
+ if (standardize)
+ if (!is.null(sds))
+ xsum[1,3] <- (mean(x1,na.rm=T)-mean(x0,na.rm=T))/sds
+ else
+ xsum[1,3] <- (mean(x1,na.rm=T)-mean(x0,na.rm=T))/xsd
+ else
+ xsum[1,3] <- mean(x1,na.rm=T)-mean(x0,na.rm=T)
+ if(!is.null(t.plot))
+ qqmat <- qqsum(xx[t.plot],xx[c.plot],standardize=standardize)
+ else
+ qqmat <- qqsum(x1[ww1>0],x0[ww0>0],standardize=standardize)
+ xsum[2,4:6] <- c(qqmat$meddiff,qqmat$meandiff,qqmat$maxdiff)
+ if (standardize)
+ if (!is.null(sds))
+ xsum[2,3] <- (xsum[2,1]-xsum[2,2])/sds
+ else
+ xsum[2,3] <- (xsum[2,1]-xsum[2,2])/xsd
+ else
+ xsum[2,3] <- xsum[2,1]-xsum[2,2]
}
xsum
}
## By subclass
-qoi.by.sub <- function(xx,tt,ww,qq){
+qoi.by.sub <- function(xx,tt,ww,qq,standardize=FALSE){
qbins <- max(qq,na.rm=TRUE)
- q.table <- matrix(0,7,qbins)
+ q.table <- matrix(0,6,qbins)
qn <- matrix(0,3,qbins)
matched <- ww!=0
- for (i in 1:qbins)
- {
- qi <- qq[matched]==i & (!is.na(qq[matched]))
- qx <- xx[matched][qi]
- qt <- tt[matched][qi]
- qw <- as.numeric(ww[matched][qi]!=0)
- if(sum(qt==1)<2|(sum(qt==0)<2)){
- if(sum(qt==1)<2){warning("Not enough treatment units in subclass ",i,call.=FALSE)}
- else if(sum(qt==0)<2){warning("Not enough control units in subclass ",i,call.=FALSE)}
- }
- qoi.i <- qoi(qx,qt,qw, sds=sd(xx[tt==1],na.rm=T))
- q.table[,i] <- as.numeric(qoi.i[1,])
- qn[,i] <- c(sum(qt),sum(qt==0),length(qt))
+ for (i in 1:qbins) {
+ qi <- qq[matched]==i & (!is.na(qq[matched]))
+ qx <- xx[matched][qi]
+ qt <- tt[matched][qi]
+ qw <- as.numeric(ww[matched][qi]!=0)
+ if(sum(qt==1)<2|(sum(qt==0)<2)){
+ if(sum(qt==1)<2)
+ warning("Not enough treatment units in subclass ",i,call.=FALSE)
+ else if(sum(qt==0)<2)
+ warning("Not enough control units in subclass ",i,call.=FALSE)
}
+ qoi.i <- qoi(qx,qt,qw, sds=sd(xx[tt==1],na.rm=T), standardize=standardize)
+ q.table[,i] <- as.numeric(qoi.i[1,])
+ qn[,i] <- c(sum(qt),sum(qt==0),length(qt))
+ }
q.table <- as.data.frame(q.table)
qn <- as.data.frame(qn)
names(q.table) <- names(qn) <- paste("Subclass",1:qbins)
diff --git a/R/matchit.R b/R/matchit.R
index 07d305b..3e91ffa 100644
--- a/R/matchit.R
+++ b/R/matchit.R
@@ -9,9 +9,11 @@ matchit <- function(formula, data, method = "nearest", distance = "logit",
stop("Data must be a dataframe",call.=FALSE)}
## check inputs
- fn1 <- paste("distance2", distance, sep = "")
- if (!exists(fn1))
- stop(distance, "not supported.")
+ if (!is.numeric(distance)) {
+ fn1 <- paste("distance2", distance, sep = "")
+ if (!exists(fn1))
+ stop(distance, "not supported.")
+ }
fn2 <- paste("matchit2", method, sep = "")
if (!exists(fn2))
stop(method, "not supported.")
@@ -29,6 +31,10 @@ matchit <- function(formula, data, method = "nearest", distance = "logit",
if (!is.null(distance))
warning("distance is set to `NULL' when exact matching is used.")
}
+ else if (is.numeric(distance)){
+ out1 <- NULL
+ discarded <- discard(treat, distance, discard, X)
+ }
else {
if (is.null(distance.options$formula))
distance.options$formula <- formula
diff --git a/R/matchit2full.R b/R/matchit2full.R
index 6c7939c..7b297cf 100644
--- a/R/matchit2full.R
+++ b/R/matchit2full.R
@@ -1,7 +1,7 @@
matchit2full <- function(treat, X, data, distance, discarded,
verbose=FALSE, ...) {
if (!("optmatch" %in% .packages(all = TRUE)))
- install.packages("optmatch", contriburl="http://www.stat.lsa.umich.edu/~bbh/optmatch")
+ install.packages("optmatch")
require(optmatch)
if(verbose)
diff --git a/R/matchit2optimal.R b/R/matchit2optimal.R
index e575ee9..68e27ae 100644
--- a/R/matchit2optimal.R
+++ b/R/matchit2optimal.R
@@ -2,7 +2,7 @@ matchit2optimal <- function(treat, X, data, distance, discarded,
ratio = 1, verbose=FALSE, ...) {
if (!("optmatch" %in% .packages(all = TRUE)))
- install.packages("optmatch", contriburl="http://www.stat.lsa.umich.edu/~bbh/optmatch")
+ install.packages("optmatch")
require(optmatch)
if(verbose)
diff --git a/R/qqsum.R b/R/qqsum.R
index 3e9dcd3..6f99be7 100644
--- a/R/qqsum.R
+++ b/R/qqsum.R
@@ -1,18 +1,25 @@
## Function for QQ summary stats
-qqsum <- function (x, y){
+qqsum <- function (x, y, standardize = FALSE){
sx <- sort(x)
sy <- sort(y)
lenx <- length(sx)
leny <- length(sy)
- if (leny < lenx)
- sx <- approx(1:lenx, sx, n = leny, method = "constant")$y
- if (leny > lenx)
- sy <- approx(1:leny, sy, n = lenx, method = "constant")$y
+ if (standardize) {
+ vals <- sort(unique(c(sx, sy)))
+ sx <- ecdf(sx)
+ sx <- sx(vals)
+ sy <- ecdf(sy)
+ sy <- sy(vals)
+ }
+ else {
+ if (leny < lenx)
+ sx <- approx(1:lenx, sx, n = leny, method = "constant")$y
+ if (leny > lenx)
+ sy <- approx(1:leny, sy, n = lenx, method = "constant")$y
+ }
dxy <- abs(sx-sy)
meandiff <- mean(dxy)
meddiff <- median(dxy)
maxdiff <- max(dxy)
- invisible(list(meandiff=meandiff,
- meddiff = meddiff,
- maxdiff = maxdiff))
+ invisible(list(meandiff=meandiff, meddiff=meddiff, maxdiff=maxdiff))
}
diff --git a/R/summary.matchit.R b/R/summary.matchit.R
index 5e20d22..94f089c 100644
--- a/R/summary.matchit.R
+++ b/R/summary.matchit.R
@@ -1,4 +1,6 @@
-summary.matchit <- function(object, interactions = FALSE, addlvariables = NULL, ...) {
+summary.matchit <- function(object, interactions = FALSE,
+ addlvariables = NULL, standardize = FALSE,
+ ...) {
XX <- cbind(distance=object$distance,object$X)
if (!is.null(addlvariables)) XX <- cbind(XX, addlvariables)
@@ -9,9 +11,9 @@ summary.matchit <- function(object, interactions = FALSE, addlvariables = NULL,
kk <- ncol(XX)
## Summary Stats
- aa <- apply(XX,2,qoi,tt=treat,ww=weights)
- sum.all <- as.data.frame(matrix(0,kk,7))
- sum.matched <- as.data.frame(matrix(0,kk,7))
+ aa <- apply(XX,2,qoi,tt=treat,ww=weights,standardize=standardize)
+ sum.all <- as.data.frame(matrix(0,kk,6))
+ sum.matched <- as.data.frame(matrix(0,kk,6))
row.names(sum.all) <- row.names(sum.matched) <- nam
names(sum.all) <- names(sum.matched) <- names(aa[[1]])
sum.all.int <- sum.matched.int <- NULL
@@ -21,7 +23,7 @@ summary.matchit <- function(object, interactions = FALSE, addlvariables = NULL,
if(interactions){
for(j in i:kk){
x2 <- XX[,i]*as.matrix(XX[,j])
- jqoi <- qoi(x2,tt=treat,ww=weights)
+ jqoi <- qoi(x2,tt=treat,ww=weights,standardize=standardize)
sum.all.int <- rbind(sum.all.int,jqoi[1,])
sum.matched.int <- rbind(sum.matched.int,jqoi[2,])
row.names(sum.all.int)[nrow(sum.all.int)] <-
@@ -36,9 +38,9 @@ summary.matchit <- function(object, interactions = FALSE, addlvariables = NULL,
## Imbalance Reduction
stat0 <- abs(cbind(sum.all[,2]-sum.all[,1],
- sum.all[,5:7]))
+ sum.all[,4:6]))
stat1 <- abs(cbind(sum.matched[,2]-sum.matched[,1],
- sum.matched[,5:7]))
+ sum.matched[,4:6]))
reduction <- as.data.frame(100*(stat0-stat1)/stat0)
if(sum(stat0==0 & stat1==0, na.rm=T)>0){
reduction[stat0==0 & stat1==0] <- 0
@@ -46,14 +48,21 @@ summary.matchit <- function(object, interactions = FALSE, addlvariables = NULL,
if(sum(stat0==0 & stat1>0,na.rm=T)>0){
reduction[stat0==0 & stat1>0] <- -Inf
}
- names(reduction) <- c("Mean and Std. Bias", "QQ Med","QQ Mean", "QQ Max")
-
+ if (standardize)
+ names(reduction) <- c("Std. Mean Diff.", "eCDF Med","eCDF Mean",
+ "eCDF Max")
+ else
+ names(reduction) <- c("Mean Diff.", "eQQ Med","eQQ Mean", "eQQ Max")
+
## Sample sizes
nn <- matrix(0, ncol=2, nrow=4)
nn[1,] <- c(sum(object$treat==0), sum(object$treat==1))
- nn[2,] <- c(sum(object$treat==0 & object$weights>0), sum(object$treat==1 & object$weights>0))
- nn[3,] <- c(sum(object$treat==0 & object$weights==0 & object$discarded==0), sum(object$treat==1 & object$weights==0 & object$discarded==0))
- nn[4,] <- c(sum(object$treat==0 & object$weights==0 & object$discarded==1), sum(object$treat==1 & object$weights==0 & object$discarded==1))
+ nn[2,] <- c(sum(object$treat==0 & object$weights>0),
+ sum(object$treat==1 & object$weights>0))
+ nn[3,] <- c(sum(object$treat==0 & object$weights==0 & object$discarded==0),
+ sum(object$treat==1 & object$weights==0 & object$discarded==0))
+ nn[4,] <- c(sum(object$treat==0 & object$weights==0 & object$discarded==1),
+ sum(object$treat==1 & object$weights==0 & object$discarded==1))
dimnames(nn) <- list(c("All","Matched","Unmatched","Discarded"),
c("Control","Treated"))
@@ -62,8 +71,8 @@ summary.matchit <- function(object, interactions = FALSE, addlvariables = NULL,
# table(object$weights!=0,object$treat)[2:1,])
## output
- res <- list(call=object$call, nn = nn, sum.all = sum.all, sum.matched = sum.matched,
- reduction = reduction)
+ res <- list(call=object$call, nn = nn, sum.all = sum.all,
+ sum.matched = sum.matched, reduction = reduction)
class(res) <- "summary.matchit"
return(res)
}
diff --git a/R/summary.matchit.full.R b/R/summary.matchit.full.R
index e810aea..578b4e0 100644
--- a/R/summary.matchit.full.R
+++ b/R/summary.matchit.full.R
@@ -1,4 +1,7 @@
-summary.matchit.full <- function(object, interactions = FALSE, addlvariables = NULL, numdraws = 5000, ...) {
+summary.matchit.full <- function(object, interactions = FALSE,
+ addlvariables = NULL, numdraws =
+ 5000, standardize = FALSE,
+ ...) {
XX <- cbind(distance=object$distance,object$X)
if (!is.null(addlvariables)) XX <- cbind(XX, addlvariables)
@@ -13,9 +16,10 @@ summary.matchit.full <- function(object, interactions = FALSE, addlvariables = N
c.plot <- sample(names(treat)[treat==0], numdraws/2, replace=TRUE, prob=weights[treat==0])
## Summary Stats
- aa <- apply(XX,2,qoi,tt=treat,ww=weights, t.plot=t.plot, c.plot=c.plot)
- sum.all <- as.data.frame(matrix(0,kk,7))
- sum.matched <- as.data.frame(matrix(0,kk,7))
+ aa <- apply(XX,2,qoi,tt=treat,ww=weights, t.plot=t.plot,
+ c.plot=c.plot, standardize=standardize)
+ sum.all <- as.data.frame(matrix(0,kk,6))
+ sum.matched <- as.data.frame(matrix(0,kk,6))
row.names(sum.all) <- row.names(sum.matched) <- nam
names(sum.all) <- names(sum.matched) <- names(aa[[1]])
sum.all.int <- sum.matched.int <- NULL
@@ -25,7 +29,8 @@ summary.matchit.full <- function(object, interactions = FALSE, addlvariables = N
if(interactions){
for(j in i:kk){
x2 <- XX[,i]*as.matrix(XX[,j])
- jqoi <- qoi(x2,tt=treat,ww=weights, t.plot=t.plot, c.plot=c.plot)
+ jqoi <- qoi(x2,tt=treat,ww=weights, t.plot=t.plot,
+ c.plot=c.plot, standardize=standardize)
sum.all.int <- rbind(sum.all.int,jqoi[1,])
sum.matched.int <- rbind(sum.matched.int,jqoi[2,])
row.names(sum.all.int)[nrow(sum.all.int)] <-
@@ -40,9 +45,9 @@ summary.matchit.full <- function(object, interactions = FALSE, addlvariables = N
## Imbalance Reduction
stat0 <- abs(cbind(sum.all[,2]-sum.all[,1],
- sum.all[,5:7]))
+ sum.all[,4:6]))
stat1 <- abs(cbind(sum.matched[,2]-sum.matched[,1],
- sum.matched[,5:7]))
+ sum.matched[,4:6]))
reduction <- as.data.frame(100*(stat0-stat1)/stat0)
if(sum(stat0==0 & stat1==0, na.rm=T)>0){
reduction[stat0==0 & stat1==0] <- 0
@@ -50,7 +55,10 @@ summary.matchit.full <- function(object, interactions = FALSE, addlvariables = N
if(sum(stat0==0 & stat1>0,na.rm=T)>0){
reduction[stat0==0 & stat1>0] <- -Inf
}
- names(reduction) <- c("Mean and Std. Bias", "QQ Med","QQ Mean", "QQ Max")
+ if (standardize)
+ names(reduction) <- c("Std. Mean Diff.", "eCDF Med","eCDF Mean", "eCDF Max")
+ else
+ names(reduction) <- c("Mean Diff.", "eQQ Med","eQQ Mean", "eQQ Max")
## Sample sizes
nn <- matrix(0, ncol=2, nrow=4)
@@ -60,7 +68,7 @@ summary.matchit.full <- function(object, interactions = FALSE, addlvariables = N
nn[4,] <- c(sum(object$treat==0 & object$weights==0 & object$discarded==1), sum(object$treat==1 & object$weights==0 & object$discarded==1))
dimnames(nn) <- list(c("All","Matched","Unmatched","Discarded"),
- c("Control","Treated"))
+ c("Control","Treated"))
## output
res <- list(call=object$call, nn = nn, sum.all = sum.all, sum.matched = sum.matched,
diff --git a/R/summary.matchit.subclass.R b/R/summary.matchit.subclass.R
index 7ca31a8..e42194f 100644
--- a/R/summary.matchit.subclass.R
+++ b/R/summary.matchit.subclass.R
@@ -1,4 +1,5 @@
-summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables=NULL,
+summary.matchit.subclass <- function(object, interactions = FALSE,
+ addlvariables=NULL, standardize = FALSE,
...) {
XX <- cbind(distance=object$distance,object$X)
@@ -10,9 +11,9 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
kk <- ncol(XX)
## Summary Stats
- aa <- apply(XX,2,qoi,tt=treat,ww=as.numeric(weights!=0))
- sum.all <- as.data.frame(matrix(0,kk,7))
- sum.matched <- as.data.frame(matrix(0,kk,7))
+ aa <- apply(XX,2,qoi,tt=treat,ww=as.numeric(weights!=0),standardize=standardize)
+ sum.all <- as.data.frame(matrix(0,kk,6))
+ sum.matched <- as.data.frame(matrix(0,kk,6))
row.names(sum.all) <- row.names(sum.matched) <- nam
names(sum.all) <- names(sum.matched) <- names(aa[[1]])
sum.all.int <- sum.matched.int <- NULL
@@ -22,7 +23,7 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
if(interactions){
for(j in i:kk){
x2 <- XX[,i]*as.matrix(XX[,j])
- jqoi <- qoi(x2,tt=treat,ww=as.numeric(weights!=0))
+ jqoi <- qoi(x2,tt=treat,ww=as.numeric(weights!=0),standardize=standardize)
sum.all.int <- rbind(sum.all.int,jqoi[1,])
sum.matched.int <- rbind(sum.matched.int,jqoi[2,])
row.names(sum.all.int)[nrow(sum.all.int)] <-
@@ -38,14 +39,14 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
## By Subclass
qbins <- max(object$subclass,na.rm=TRUE)
if(interactions){
- q.table <- array(0,dim=c(kk+sum(1:kk),7,qbins))
+ q.table <- array(0,dim=c(kk+sum(1:kk),6,qbins))
ii <- 0
nn <- NULL
} else {
- q.table <- array(0,dim=c(kk,7,qbins))
+ q.table <- array(0,dim=c(kk,6,qbins))
}
aa <- apply(XX,2,qoi.by.sub,tt=treat,ww=weights,
- qq=object$subclass)
+ qq=object$subclass,standardize=standardize)
for(i in 1:kk){
if(!interactions){
q.table[i,,] <- as.matrix(aa[[i]]$q.table)
@@ -57,7 +58,7 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
for(j in i:kk){
ii <- ii + 1
x2 <- XX[,i]*as.matrix(XX[,j])
- q.table[ii,,] <- as.matrix(qoi.by.sub(x2,tt=treat,ww=weights,qq=object$subclass)$q.table)
+ q.table[ii,,] <- as.matrix(qoi.by.sub(x2,tt=treat,ww=weights,qq=object$subclass,standardize=standardize)$q.table)
nn <- c(nn,paste(nam[i],nam[j],sep="x"))
}
}
@@ -78,7 +79,7 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
}
sum.subclass <- sum.all
for(i in 1:kk){
- for(j in 1:7){
+ for(j in 1:6){
if(j==3) {
sum.subclass[i,j] <- sqrt(sum((wsub^2)*(q.table[i,j,]^2)))
} else {
@@ -89,9 +90,9 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
## Imbalance Reduction
stat0 <- abs(cbind(sum.all[,2]-sum.all[,1],
- sum.all[,5:7]))
+ sum.all[,4:6]))
stat1 <- abs(cbind(sum.subclass[,2]-sum.subclass[,1],
- sum.subclass[,5:7]))
+ sum.subclass[,4:6]))
reduction <- as.data.frame(100*(stat0-stat1)/stat0)
if(sum(stat0==0 & stat1==0, na.rm=T)>0){
reduction[stat0==0 & stat1==0] <- 0
@@ -99,8 +100,12 @@ summary.matchit.subclass <- function(object, interactions = FALSE, addlvariables
if(sum(stat0==0 & stat1>0,na.rm=T)>0){
reduction[stat0==0 & stat1>0] <- -Inf
}
- names(reduction) <- c("Mean and Std. Bias", "QQ Med","QQ Mean", "QQ Max")
-
+ if (standardize)
+ names(reduction) <- c("Std. Mean Diff.", "eCDF Med","eCDF Mean",
+ "eCDF Max")
+ else
+ names(reduction) <- c("Mean Diff.", "eQQ Med","eQQ Mean",
+ "eQQ Max")
## output
res <- list(call=object$call, sum.all = sum.all, sum.matched = sum.matched,
sum.subclass = sum.subclass, reduction = reduction,
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-matchit.git
More information about the debian-science-commits
mailing list