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
|
interleave <- function(..., append.source=TRUE, sep=": ", drop=FALSE)
{
sources <- list(...)
sources[sapply(sources, is.null)] <- NULL
sources <- lapply(sources, function(x)
if(is.matrix(x) || is.data.frame(x))
x else t(x))
nrows <- sapply(sources, nrow)
mrows <- max(nrows)
if(any(nrows!=mrows & nrows!=1))
stop("arguments have differing numbers of rows")
sources <- lapply(sources, function(x)
if(nrow(x)==1) x[rep(1,mrows),,drop=drop] else x)
tmp <- do.call("rbind", sources)
nsources <- length(sources)
indexes <- outer((0:(nsources-1)) * mrows, 1:mrows, "+")
retval <- tmp[indexes,,drop=drop]
if(append.source && !is.null(names(sources)))
{
if(!is.null(row.names(tmp)))
{
row.names(retval) <- paste(format(row.names(retval)),
format(names(sources)), sep=sep)
}
else
{
row.names(retval) <- rep(names(sources), mrows)
}
}
retval
}
|
