[r-cran-matchit] 08/45: Import Upstream version 2.1-4
Andreas Tille
tille at debian.org
Fri Oct 20 06:17:18 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 c7999ac10944311a940de6afe3007aa1e78aefeb
Author: Andreas Tille <tille at debian.org>
Date: Fri Oct 20 07:40:51 2017 +0200
Import Upstream version 2.1-4
---
DESCRIPTION | 8 ++++----
R/discard.R | 31 ++++++++++++++++++++++---------
R/eqqplot.R | 15 +++++++++++++++
R/matchit.qqplot.R | 4 ++--
R/qqsum.R | 6 +++---
5 files changed, 46 insertions(+), 18 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 75477d3..09528b5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: MatchIt
-Version: 2.1-3
-Date: 2005-10-05
+Version: 2.1-4
+Date: 2005-10-14
Title: MatchIt: Nonparametric Preprocessing for Parametric Casual Inference
Author: Daniel Ho <daniel.e.ho at gmail.com>,
Kosuke Imai <kimai at Princeton.Edu>,
@@ -8,7 +8,7 @@ Author: Daniel Ho <daniel.e.ho at gmail.com>,
Elizabeth Stuart <stuart at stat.harvard.edu>
Maintainer: Kosuke Imai <kimai at Princeton.Edu>
Depends: R (>= 2.1), MASS, Zelig
-Suggests: optmatch, Matching
+Suggests: optmatch, Matching, WhatIf
Description: MatchIt selects matched samples of the
the original treated and control groups with similar
covariate distributions -- can be used to match exactly
@@ -18,4 +18,4 @@ LazyLoad: yes
LazyData: yes
License: GPL version 2 or newer
URL: http://gking.harvard.edu/matchit
-Packaged: Thu Oct 6 21:05:56 2005; kimai
+Packaged: Fri Oct 14 11:43:20 2005; kimai
diff --git a/R/discard.R b/R/discard.R
index 6188e53..cb19df1 100644
--- a/R/discard.R
+++ b/R/discard.R
@@ -5,7 +5,9 @@ discard <- function(treat, pscore, option, X) {
pmax1 <- max(pscore[treat==1])
pmin0 <- min(pscore[treat==0])
pmin1 <- min(pscore[treat==1])
- if (option == "none") # keep all units
+ if (is.logical(option)) # user input
+ return(option)
+ else if (option == "none") # keep all units
discarded <- rep(FALSE, n.obs)
else if (option == "both") # discard units outside of common support
discarded <- (pscore < max(pmin0, pmin1) | pscore > min(pmax0, pmax1))
@@ -13,18 +15,29 @@ discard <- function(treat, pscore, option, X) {
discarded <- (pscore < pmin1 | pscore > pmax1)
else if (option == "treat") # discard treated units only
discarded <- (pscore < pmin0 | pscore > pmax0)
- else if (option == "convex.hull"){ # discard units not in T convex hull
- if (!("whatif" %in% .packages(all = TRUE)))
- install.packages("whatif", CRAN="http://gking.harvard.edu")
+ 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")
if (!("lpSolve" %in% .packages(all = TRUE)))
install.packages("lpSolve")
- require(whatif)
+ require(WhatIf)
require(lpSolve)
- wif <- whatif(cfact = X[treat==0,], data = X[treat==1,])
discarded <- rep(FALSE, n.obs)
- discarded[treat==0] <- !wif$in.hull
- } else
- stop("invalid input for `discard'")
+ if (option == "hull.control"){ # discard units not in T convex hull
+ wif <- whatif(cfact = X[treat==0,], data = X[treat==1,])
+ discarded[treat==0] <- !wif$in.hull
+ } else if (option == "hull.treat") {
+ wif <- whatif(cfact = X[treat==1,], data = X[treat==0,])
+ discarded[treat==1] <- !wif$in.hull
+ } else if (option == "hull.both"){ # discard units not in T&C convex hull
+ wif <- whatif(cfact = cbind(1-treat, X), data = cbind(treat, X))
+ discarded <- !wif$in.hull
+ }
+ else
+ stop("invalid input for `discard'")
+ } else
+ stop("invalid input for `discard'")
names(discarded) <- names(treat)
return(discarded)
}
diff --git a/R/eqqplot.R b/R/eqqplot.R
new file mode 100644
index 0000000..c51b569
--- /dev/null
+++ b/R/eqqplot.R
@@ -0,0 +1,15 @@
+eqqplot <- function(x, y, plot.it = TRUE, xlab = deparse(substitute(x)),
+ ylab = deparse(substitute(y)), ...)
+{ ## empirical quantile-quantile plot; hacked from qqplot() in stats.
+ 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 (plot.it)
+ plot(sx, sy, xlab = xlab, ylab = ylab, ...)
+ invisible(list(x = sx, y = sy))
+}
diff --git a/R/matchit.qqplot.R b/R/matchit.qqplot.R
index 2a0009a..42a6357 100644
--- a/R/matchit.qqplot.R
+++ b/R/matchit.qqplot.R
@@ -71,13 +71,13 @@ matchit.qqplot <- function(x,discrete.cutoff,
m.xi <- jitter(m.xi)
}
rr <- range(xi)
- qqplot(xi[treat==0],xi[treat==1], xlim=rr,ylim=rr,axes=F,ylab="",xlab="")
+ eqqplot(xi[treat==0],xi[treat==1], xlim=rr,ylim=rr,axes=F,ylab="",xlab="")
abline(a=0,b=1)
abline(a=(rr[2]-rr[1])*0.1,b=1,lty=2)
abline(a=-(rr[2]-rr[1])*0.1,b=1,lty=2)
axis(2)
box()
- qqplot(m.xi[m.treat==0],m.xi[m.treat==1],xlim=rr,ylim=rr,axes=F,ylab="",xlab="")
+ eqqplot(m.xi[m.treat==0],m.xi[m.treat==1],xlim=rr,ylim=rr,axes=F,ylab="",xlab="")
abline(a=0,b=1)
abline(a=(rr[2]-rr[1])*0.1,b=1,lty=2)
abline(a=-(rr[2]-rr[1])*0.1,b=1,lty=2)
diff --git a/R/qqsum.R b/R/qqsum.R
index 3d4f884..3e9dcd3 100644
--- a/R/qqsum.R
+++ b/R/qqsum.R
@@ -5,12 +5,12 @@ qqsum <- function (x, y){
lenx <- length(sx)
leny <- length(sy)
if (leny < lenx)
- sx <- approx(1:lenx, sx, n = leny)$y
+ sx <- approx(1:lenx, sx, n = leny, method = "constant")$y
if (leny > lenx)
- sy <- approx(1:leny, sy, n = lenx)$y
+ sy <- approx(1:leny, sy, n = lenx, method = "constant")$y
dxy <- abs(sx-sy)
meandiff <- mean(dxy)
- meddiff <- as.numeric(median(dxy))
+ meddiff <- median(dxy)
maxdiff <- max(dxy)
invisible(list(meandiff=meandiff,
meddiff = meddiff,
--
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