Nothing
## METHODS FOR GENERIC: c
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c.Matrix <- function(...) {
if(nargs() == 0L)
return(NULL)
args <- lapply(list(...), as.vector)
unlist(args, FALSE, TRUE)
}
c.sparseVector <- function(...) {
N <- nargs()
if(N == 0L)
return(NULL)
args <- lapply(list(...), as, "sparseVector")
args.length <- vapply(args, slot, 0, "length")
args.i <- lapply(args, slot, "i")
args.nnz <- lengths(args.i, FALSE)
s <- c("n", "l", "i", "d", "z")
i <- match(vapply(args, .M.kind, ""), s)
k <- range(i)
n <- sum(args.length)
a <- if(n - 1 <= .Machine$integer.max) as.integer else as.double
r <- new(paste0(s[k[2L]], "sparseVector"))
r@length <- a(n)
r@i <- a(unlist(args.i, FALSE, FALSE)) +
rep.int(cumsum(c(0L, a(args.length)[-N])), args.nnz)
if(k[2L] > 1L) {
if(k[1L] > 1L)
args.x <- lapply(args, slot, "x")
else {
pattern <- i == 1L
args.x <- vector("list", N)
args.x[!pattern] <- lapply(args [!pattern], slot, "x")
args.x[ pattern] <- lapply(args.nnz[ pattern], rep.int, x = TRUE)
}
r@x <- unlist(args.x, FALSE, FALSE)
}
r
}
## These are insufficient as dispatch only consides the first argument,
## which need not be a Matrix or sparseVector:
if(FALSE) {
setMethod("c", c(x = "Matrix"),
function(x, ...) c.Matrix (x, ...))
setMethod("c", c(x = "sparseVector"),
function(x, ...) c.sparseVector(x, ...))
}
## METHODS FOR GENERIC: cbind, rbind
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## MJ: not yet registered or exported
cbind.Matrix <- function(..., deparse.level = 1)
.External(R_bind, deparse.level, 1L, substitute(list(...)), ...)
rbind.Matrix <- function(..., deparse.level = 1)
.External(R_bind, deparse.level, 0L, substitute(list(...)), ...)
## METHODS FOR GENERIC: cbind2, rbind2
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
.cbind2 <- function(x, y, ...) cbind.Matrix(x, y, deparse.level = 0L)
.rbind2 <- function(x, y, ...) rbind.Matrix(x, y, deparse.level = 0L)
setMethod("cbind2", c(x = "Matrix", y = "missing"),
function(x, y, ...) x)
setMethod("rbind2", c(x = "Matrix", y = "missing"),
function(x, y, ...) x)
setMethod("cbind2", c(x = "Matrix", y = "NULL"), .cbind2)
setMethod("cbind2", c(x = "NULL", y = "Matrix"), .cbind2)
setMethod("rbind2", c(x = "Matrix", y = "NULL"), .rbind2)
setMethod("rbind2", c(x = "NULL", y = "Matrix"), .rbind2)
setMethod("cbind2", c(x = "Matrix", y = "vector"), .cbind2)
setMethod("cbind2", c(x = "vector", y = "Matrix"), .cbind2)
setMethod("rbind2", c(x = "Matrix", y = "vector"), .rbind2)
setMethod("rbind2", c(x = "vector", y = "Matrix"), .rbind2)
setMethod("cbind2", c(x = "Matrix", y = "matrix"), .cbind2)
setMethod("cbind2", c(x = "matrix", y = "Matrix"), .cbind2)
setMethod("rbind2", c(x = "Matrix", y = "matrix"), .rbind2)
setMethod("rbind2", c(x = "matrix", y = "Matrix"), .rbind2)
setMethod("cbind2", c(x = "Matrix", y = "Matrix"), .cbind2)
setMethod("rbind2", c(x = "Matrix", y = "Matrix"), .rbind2)
rm(.cbind2, .rbind2)
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.