R/twodmatch.R

In drmjc/mjcbase: General helper functions for dealing with \R objects/data types

#' Extension of \code{\%in\%} for value matching in 1D or 2D objects
#'
#' @description \code{\%IN\%} is a binary operator, which
#'     returns a logical \code{matrix} or \code{data.frame}, indicating if there
#'  is a match or not for its left operand in its second. Note \code{base}
#' provides \code{\%in\%} but this only returns a vector of logicals, even if the
#' left operand is 2D.
#'
#' @param x vector or \sQuote{NULL}: the values to be matched.  Long vectors are supported.
#' @param table vector or \sQuote{NULL}: the values to be matched against. Long vectors are supported.
#'
#' @return a data.frame of logical values
#' @author Mark Cowley, 2012-07-27
#' @export
#' @rdname twodmatch
#' @seealso \code{\link{which.2D}}
#' @examples
#' if (require(datasets)) {
#' 
#' # iris is a data.frame
#' head(iris)
#' #   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#' # 1          5.1         3.5          1.4         0.2  setosa
#' # 2          4.9         3.0          1.4         0.2  setosa
#' # 3          4.7         3.2          1.3         0.2  setosa
#' # 4          4.6         3.1          1.5         0.2  setosa
#' # 5          5.0         3.6          1.4         0.2  setosa
#' # 6          5.4         3.9          1.7         0.4  setosa
#' 
#' # %in% doesn't work as expected:
#' iris %in% "setosa"
#' # [1] FALSE FALSE FALSE FALSE FALSE
#'
#' # %IN% works
#' head(iris %IN% "setosa")
#' #   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
#' # 1        FALSE       FALSE        FALSE       FALSE    TRUE
#' # 2        FALSE       FALSE        FALSE       FALSE    TRUE
#' # 3        FALSE       FALSE        FALSE       FALSE    TRUE
#' # 4        FALSE       FALSE        FALSE       FALSE    TRUE
#' # 5        FALSE       FALSE        FALSE       FALSE    TRUE
#' # 6        FALSE       FALSE        FALSE       FALSE    TRUE
#' 
#' # sum on a data.frame of logical's doesn't work straight out of the box:
#' tryCatch(sum(iris %IN% "setosa"), error = function(e) x <- 1, finally=print("ERROR"))
#' sum(as.matrix(iris %IN% "setosa"))
#' # [1] 50
#' 
#' head(which.2D(as.matrix(iris %IN% "setosa")))
#' #      x y
#' # [1,] 1 5
#' # [2,] 2 5
#' # [3,] 3 5
#' # [4,] 4 5
#' # [5,] 5 5
#' # [6,] 6 5
#' }
"%IN%" <- function(x, table) {
    res <- data.frame(matrix(FALSE, nrow(x), ncol(x)))
    dimnames(res) <- dimnames(x)
    res <- lapply(x, function(x) x %in% table)
    res <- as.data.frame(res)
    res
}