Nothing
setMethod('apply', signature(X="big.matrix"),
function(X, MARGIN, FUN, ...) return(bmapply(X, MARGIN, FUN, ...)))
bmapply <- function(X, MARGIN, FUN, ...)
{
if (length(MARGIN)>1)
stop("MARGIN > 1 not supported with big.matrix objects.\n")
FUN <- match.fun(FUN)
dn.ans <- dimnames(X)[MARGIN]
if (MARGIN==1) {
d2 <- nrow(X)
ans <- vector("list", nrow(X))
for (i in 1:d2) {
tmp <- FUN(X[i,], ...)
if (!is.null(tmp)) ans[[i]] <- tmp
}
} else {
if (MARGIN==2) {
d2 <- ncol(X)
ans <- vector("list", ncol(X))
for (i in 1:d2) {
tmp <- FUN(X[,i], ...)
if (!is.null(tmp)) ans[[i]] <- tmp
}
} else {
stop("Only MARGIN equal to 1 or 2 is supported for a big.matrix.\n")
}
}
ans.list <- is.recursive(ans[[1]])
l.ans <- length(ans[[1]])
ans.names <- names(ans[[1]])
if (!ans.list)
ans.list <- any(unlist(lapply(ans, length)) != l.ans)
if (!ans.list && length(ans.names)) {
all.same <- sapply(ans, function(x) identical(names(x), ans.names))
if (!all(all.same)) ans.names <- NULL
}
if (ans.list) len.a <- d2
else len.a <- length(ans <- unlist(ans, recursive = FALSE))
if (len.a == d2) {
if (length(dn.ans[[1]])) names(ans) <- dn.ans[[1]]
return(ans)
}
if (len.a > 0 && len.a%%d2 == 0) {
if (is.null(dn.ans))
dn.ans <- vector(mode = "list", length(d2))
dn.ans <- c(list(ans.names), dn.ans)
return(array(ans, c(len.a%/%d2, d2), if (!all(sapply(dn.ans,
is.null))) dn.ans))
}
return(ans)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.