Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
misc/vcomb.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
67 lines (66 sloc)
2.45 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
##' 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) | |
} |