vcomb.R

##' combine all possible pairs of vectors \code{v1} and \code{v2}
##' using function \code{myfun}
##'
##' In essence, this is a generalized version of \code{\link[base]{outer}}
##' allowing non-scalar return values for \code{myfun}.
##'
##' Possible extensions:
##' \enumerate{
##' \item reformat the output to be matrix-like (see outer)
##' \item use a list of index pairs with \code{lapply} to allow
##'       irregular return values
##' \item shuffle the order of elements (incompatible with (1))
##' }
##' @title vector combine
##' @param v1 first vector
##' @param v2 second vector
##' @param myfun function to combine the element pairs from the two vectors
##' @param matlike return in format similar to \code{outer}, i.e., the first
##'                two dimensions reflect the vectors lengths, additional
##'                dimensions are added when \code{myfun} has non-scalar output
##' @param ... not used
##' @return vector (or matrix, array) of combinations
##' @author Benno Puetz \email{puetz@@mpipsykl.mpg.de}
##' @examples
##' a <- 1:3
##' b <- 5:9
##' vcomb(a, b)
vcomb <- function(v1, v2,
                  myfun = c,
                  matlike = TRUE,
                  ...){
    mat <- matrix(as.numeric(unlist(strsplit(outer(seq_along(v1),
                                                   seq_along(v2),
                                                   FUN = function(a, b){
                                                       paste(a, b,
                                                             sep = '.')
                                                   }),
                                             '.',
                                             fixed = TRUE)
                                    )),
                  ncol = 2,
                  byrow = TRUE)
    combine.vectors <- function(rv) {
        retval <- myfun(v1[rv[1]], v2[rv[2]])
        return(retval)
    }
    retval <- apply(mat, 1, combine.vectors)
    if(matlike){
      d <- dim(retval)
        if(is.null(d)){
            ## got vector (scalar output from myfun)
            dim(retval) <- c(length(v1), length(v2))
        } else {
          retval <- t(retval)
          rd <- dim(myfun(1,1))
            if(is.null(rd)){
              ## vector from myfun
              dim(retval) <- c(length(v1), length(v2), d[1])
            } else {
              ## matrix or array from myfun
              dim(retval) <- c(length(v1), length(v2), rd)
            }

        }
    }
    return(retval)
}