On Tue, Dec 28, 2010 at 19:14, Tony Plate <tpl...@acm.org> wrote:
> The abind() function from the abind package is an alternative here -- it can
> take a list argument, which makes it easy to use with the result of
> lapply(). It's also able take direction about which dimension to join on.
>
>> x <- list(a=1,b=2,c=3)
>> f <- function(v) matrix(v, nrow=2, ncol=4)
>> sapply(x, f)
> a b c
> [1,] 1 2 3
> [2,] 1 2 3
> [3,] 1 2 3
> [4,] 1 2 3
> [5,] 1 2 3
> [6,] 1 2 3
> [7,] 1 2 3
> [8,] 1 2 3
>>
>> # The 'along=' argument to abind() determines on which dimension
>> # the list elements are joined. Use a fractional value to put the new
>> # dimension between existing ones.
>>
>> dim(abind(lapply(x, f), along=0))
> [1] 3 2 4
>> dim(abind(lapply(x, f), along=1.5))
> [1] 2 3 4
>> dim(abind(lapply(x, f), along=3))
> [1] 2 4 3
>> abind(lapply(x, f), along=3)
> , , a
>
> [,1] [,2] [,3] [,4]
> [1,] 1 1 1 1
> [2,] 1 1 1 1
>
> , , b
>
> [,1] [,2] [,3] [,4]
> [1,] 2 2 2 2
> [2,] 2 2 2 2
>
> , , c
>
> [,1] [,2] [,3] [,4]
> [1,] 3 3 3 3
> [2,] 3 3 3 3
>
Thank you, Tony.
Indeed, yes, abind() is nice here (and in the good ol' APL spirit !)
Wanting to keep things both simple *and* fast here, of course,
hence I currently contemplate the following code,
where the new simplify2array() is considerably simpler than abind():
##' "Simplify" a list of commonly structured components into an array.
##'
##' @title simplify list() to an array if the list elements are
structurally equal
##' @param x a list, typically resulting from lapply()
##' @param higher logical indicating if an array() of "higher rank"
##' should be returned when appropriate, namely when all elements of
##' \code{x} have the same \code{\link{dim}()}ension.
##' @return x itself, or an array if the simplification "is sensible"
simplify2array <- function(x, higher = TRUE)
{
if(length(common.len <- unique(unlist(lapply(x, length)))) > 1L)
return(x)
if(common.len == 1L)
unlist(x, recursive = FALSE)
else if(common.len > 1L) {
n <- length(x)
## make sure that array(*) will not call rep() {e.g. for 'call's}:
r <- as.vector(unlist(x, recursive = FALSE))
if(higher && length(c.dim <- unique(lapply(x, dim))) == 1 &&
is.numeric(c.dim <- c.dim[[1L]]) &&
prod(d <- c(c.dim, n)) == length(r)) {
iN1 <- is.null(n1 <- dimnames(x[[1L]]))
n2 <- names(x)
dnam <-
if(!(iN1 && is.null(n2)))
c(if(iN1) rep.int(list(n1), length(c.dim)) else n1,
list(n2)) ## else NULL
array(r, dim = d, dimnames = dnam)
} else if(prod(d <- c(common.len, n)) == length(r))
array(r, dim = d,
dimnames= if(!(is.null(n1 <- names(x[[1L]])) &
is.null(n2 <- names(x)))) list(n1,n2))
else x
}
else x
}
sapply <- function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE)
{
FUN <- match.fun(FUN)
answer <- lapply(X, FUN, ...)
if(USE.NAMES && is.character(X) && is.null(names(answer)))
names(answer) <- X
if(!identical(simplify, FALSE) && length(answer))
simplify2array(answer, higher = (simplify == "array"))
else answer
}
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
