/
cross.R
43 lines (41 loc) · 1.08 KB
/
cross.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#' Factor cross products
#'
#' Construct a product of factors.
#'
#' @param \dots factors to be crossed.
#' @param sep separator between levels
#' @param drop.unused.levels should levels that do not appear in cross product be dropped?
#'
#' @return a factor
#'
#' @examples
#' x <- letters[1:3]
#' y <- c(1,2,1,1,3,1,3)
#' cross(x, y)
#' cross(x, y, drop.unused.levels=TRUE)
#'
#' @keywords manipulate
#' @export
cross <- function(..., sep=":", drop.unused.levels=FALSE) {
factors <- list(...)
factors <- lapply( factors, function(x) { as.factor(x) } )
if ( length(factors) < 1 ) {
stop('No factors specified.')
}
levelsList <- lapply(factors, levels)
result <- factors[[1]]
levels <- levels(result)
factors[[1]] <- NULL
while( length(factors) > 0 ) {
levels <- as.vector(
outer (levels(factors[[1]]), levels, function(x,y) { paste(y,x,sep=sep) } )
)
if (drop.unused.levels ) {
result <- factor( paste( result, factors[[1]], sep=sep))
} else {
result <- factor( paste( result, factors[[1]], sep=sep), levels=levels)
}
factors[[1]] <- NULL
}
return(result)
}