# R/subsetMatches.R In nbpMatching: Functions for Optimal Non-Bipartite Matching

#'Subset Matches
#'
#'Remove unpaired or unnecessary matches.
#'
#'Given a nonbimatch object, remove elements matched to phantoms, chameleons, or
#'ghosts.  Also remove pairs whose distance is infinite.
#'
#'@aliases subsetMatches subsetMatches,nonbimatch-method
#'@param matches A nonbimatch object.
#'@param phantom A logical value.  Remove elements matched to phantom elements.
#'@param chameleon A logical value.  Remove elements matched to chameleon
#'elements.
#'@param ghost A logical value.  Remove elements matched to ghost elements.
#'@param infinite A logical value.  Remove elements matched at infinite
#'distance. This will include elements forced to match in spite of having an
#'infinite distance set by the prevent option in \code{\link{gendistance}}.
#'@param halvesOnly A logical value.  Use halves element instead of matches.
#'@return a data.frame
#'@exportMethod subsetMatches
#'@author Cole Beck
#'@examples
#'
#'df <- data.frame(id=LETTERS[1:25], val1=rnorm(25), val2=rnorm(25))
#'df.mdm <- distancematrix(df.dist)
#'df.match <- nonbimatch(df.mdm)
#'subsetMatches(df.match)
#'subsetMatches(df.match, halvesOnly=FALSE)
#'subsetMatches(df.match, phantom=FALSE)
#'

setGeneric("subsetMatches", function(matches, phantom=TRUE, chameleon=TRUE, ghost=TRUE, infinite=TRUE, halvesOnly=TRUE) {
standardGeneric("subsetMatches")
})

setMethod("subsetMatches", signature(matches="nonbimatch"), function(matches, phantom=TRUE, chameleon=TRUE, ghost=TRUE, infinite=TRUE, halvesOnly=TRUE) {
if(halvesOnly) {
dat <- matches\$halves
} else {
dat <- matches\$matches
}
id1 <- dat[,'Group1.ID']
id2 <- dat[,'Group2.ID']
ix <- numeric()
if(phantom) {
ix <- union(ix, c(grep('^phantom', id1), grep('^phantom', id2)))
}
if(chameleon) {
ix <- union(ix, c(grep('^chameleon', id1), grep('^chameleon', id2)))
}
if(ghost) {
ix <- union(ix, c(grep('^ghost', id1), grep('^ghost', id2)))
}
if(infinite) ix <- union(ix, which(is.infinite(dat[,'Distance'])))
if(length(ix)) dat <- dat[-ix,]
dat
})

## Try the nbpMatching package in your browser

Any scripts or data that you put into this service are public.

nbpMatching documentation built on May 29, 2017, 7:22 p.m.