Skip to content

Covariance-Variance Matrix and For Loops

3 messages · sf1979, R. Michael Weylandt

#
Hello again,

sapply works. 

However it does not explicitly call a simplify function, but rather seems to
handle the case within its own body of code. I should be able to figure out
basically what simplify2array does from the code though.

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 (simplify && length(answer) && length(common.len <-
unique(unlist(lapply(answer, 
        length)))) == 1L) {
        if (common.len == 1L) 
            unlist(answer, recursive = FALSE)
        else if (common.len > 1L) {
            r <- as.vector(unlist(answer, recursive = FALSE))
            if (prod(d <- c(common.len, length(X))) == length(r)) 
                array(r, dim = d, dimnames = if (!(is.null(n1 <-
names(answer[[1L]])) & 
                  is.null(n2 <- names(answer)))) 
                  list(n1, n2))
            else answer
        }
        else answer
    }
    else answer
}
<environment: namespace:base>

--
View this message in context: http://r.789695.n4.nabble.com/Covariance-Variance-Matrix-and-For-Loops-tp3859441p3862347.html
Sent from the R help mailing list archive at Nabble.com.
#
Surprising: must be  newer update than I realized....anyways, here's
the code if you want to add it manually:

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)
        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))
            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
}
<environment: namespace:base>
On Sat, Oct 1, 2011 at 4:22 AM, sf1979 <simonfuller9 at gmail.com> wrote: