Nothing
## METHODS FOR GENERIC: coerce, as.*
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
.M2kind <- function(from, kind = ".", sparse = NA)
.Call(R_Matrix_as_kind, from, kind, sparse)
.M2gen <- function(from, kind = ".")
.Call(R_Matrix_as_general, from, kind)
..M2gen <- function(from) # for setAs()
.Call(R_Matrix_as_general, from, ".")
.M2sym <- function(from, ...) {
if(isSymmetric(from, ...))
forceSymmetric(from)
else
stop("matrix is not symmetric; consider forceSymmetric(.) or symmpart(.)")
}
..M2sym <- .M2sym # for setAs()
formals(..M2sym) <- formals(..M2sym)[-2L]
body(..M2sym)[[2L]][[2L]] <-
body(..M2sym)[[2L]][[2L]][-3L]
.M2tri <- function(from, ...) {
if(!(it <- isTriangular(from, ...)))
stop("matrix is not triangular; consider triu(.) or tril(.)")
else if(attr(it, "kind") == "U")
triu(from)
else
tril(from)
}
..M2tri <- .M2tri # for setAs()
formals(..M2tri) <- formals(..M2tri)[-2L]
body(..M2tri)[[2L]][[2L]][[2L]][[2L]][[3L]] <-
body(..M2tri)[[2L]][[2L]][[2L]][[2L]][[3L]][-3L]
.M2diag <- function(from) {
if (!isDiagonal(from))
stop("matrix is not diagonal; consider Diagonal(x=diag(.))")
forceDiagonal(from)
}
.M2v <- function(from)
.Call(R_Matrix_as_vector, from)
.M2m <- function(from)
.Call(R_Matrix_as_matrix, from)
.M2unpacked <- function(from)
.Call(R_Matrix_as_unpacked, from)
.M2packed <- function(from)
.Call(R_Matrix_as_packed, from)
.M2C <- function(from)
.Call(R_Matrix_as_Csparse, from)
.M2R <- function(from)
.Call(R_Matrix_as_Rsparse, from)
.M2T <- function(from)
.Call(R_Matrix_as_Tsparse, from)
.M2V <- function(from)
.Call(R_Matrix_as_Vector, from)
.sparse2dense <- function(from, packed = FALSE)
.Call(R_sparse_as_dense, from, packed)
.diag2dense <- function(from, kind = ".", shape = "t", packed = FALSE,
uplo = "U", trans = "T")
.Call(R_diagonal_as_dense, from, kind, shape, packed, uplo, trans)
.ind2dense <- function(from, kind = "n")
.Call(R_index_as_dense, from, kind)
.dense2sparse <- function(from, repr = "C")
.Call(R_dense_as_sparse, from, repr)
.diag2sparse <- function(from, kind = ".", shape = "t", repr = "C",
uplo = "U", trans = "T")
.Call(R_diagonal_as_sparse, from, kind, shape, repr, uplo, trans)
.ind2sparse <- function(from, kind = "n", repr = ".")
.Call(R_index_as_sparse, from, kind, repr)
.m2dense <- function(from, class = ".ge",
uplo = "U", trans = "C", diag = "N", margin = 2L)
.Call(R_matrix_as_dense, from, class, uplo, trans, diag, margin)
.m2dense.checking <- function(from, kind = ".", ...) {
switch(typeof(from), logical =, integer =, double = NULL,
stop(gettextf("invalid type \"%s\" in '%s'",
typeof(from), ".m2dense.checking"),
domain = NA))
if(kind != ".") {
## These must happen before isSymmetric() call
storage.mode(from) <-
switch(kind, n =, l = "logical", d = "double",
stop(gettextf("invalid %s=\"%s\" to '%s'",
"kind", kind, ".m2dense.checking"),
domain = NA))
if(kind == "n" && anyNA(from))
from[is.na(from)] <- TRUE
}
if(isSymmetric(from, ...))
.m2dense(from, paste0(kind, "sy"),
uplo = "U", trans = "C")
else if(it <- isTriangular(from))
.m2dense(from, paste0(kind, "tr"),
uplo = attr(it, "kind"), diag = "N")
else
.m2dense(from, paste0(kind, "ge"))
}
.m2sparse <- function(from, class = ".gC",
uplo = "U", trans = "C", diag = "N", margin = 2L)
.Call(R_matrix_as_sparse, from, class, uplo, trans, diag, margin)
.m2sparse.checking <- function(from, kind = ".", repr = "C", ...) {
switch(typeof(from), logical =, integer =, double = NULL,
stop(gettextf("invalid type \"%s\" in '%s'",
typeof(from), ".m2sparse.checking"),
domain = NA))
if(kind != ".") {
## These must happen before isSymmetric() call
storage.mode(from) <-
switch(kind, n =, l = "logical", d = "double",
stop(gettextf("invalid %s=\"%s\" to '%s'",
"kind", kind, ".m2sparse.checking"),
domain = NA))
if(kind == "n" && anyNA(from))
from[is.na(from)] <- TRUE
}
if(isSymmetric(from, ...))
.m2sparse(from, paste0(kind, "s", repr),
uplo = "U", trans = "C")
else if(it <- isTriangular(from))
.m2sparse(from, paste0(kind, "t", repr),
uplo = attr(it, "kind"), diag = "N")
else
.m2sparse(from, paste0(kind, "g", repr))
}
.m2V <- function(from, kind = ".")
.Call(R_vector_as_Vector, from, kind)
.V2kind <- function(from, kind = ".") {
if(kind == ".")
return(from)
kind. <- .M.kind(from)
if(kind == ",")
kind <- if(kind. == "z") "z" else "d"
if(kind == kind.)
return(from)
to <- new(paste0(kind, "sparseVector"))
to@length <- from@length
to@i <- from@i
if(kind != "n")
to@x <-
if(kind. == "n")
rep.int(switch(kind, "l" = TRUE, "i" = 1L, "d" = 1, "z" = 1+0i), length(from@i))
else as.vector(from@x, typeof(to@x))
to
}
.V2v <- function(from) {
if(.M.kind(from) != "n") {
to <- vector(typeof(from@x), from@length)
to[from@i] <- from@x
} else {
to <- logical(from@length)
to[from@i] <- TRUE
}
to
}
.V2m <- function(from) {
if(is.double(m <- length(from)))
stop(gettextf("dimensions cannot exceed %s", "2^31-1"),
domain = NA)
to <- .V2v(from)
dim(to) <- c(m, 1L)
to
}
.V2a <- function(from) {
if(is.double(m <- length(from)))
stop(gettextf("dimensions cannot exceed %s", "2^31-1"),
domain = NA)
to <- .V2v(from)
dim(to) <- m
to
}
.V2unpacked <- function(from) {
if(is.double(m <- length(from)))
stop(gettextf("dimensions cannot exceed %s", "2^31-1"),
domain = NA)
kind <- .M.kind(from)
to <- new(paste0(if(kind == "i") "d" else kind, "geMatrix"))
to@Dim <- c(m, 1L)
to@x <- replace(vector(typeof(to@x), m), from@i,
if(kind == "n") TRUE else from@x)
to
}
.V2C <- function(from) {
if(is.double(m <- length(from)))
stop(gettextf("dimensions cannot exceed %s", "2^31-1"),
domain = NA)
kind <- .M.kind(from)
to <- new(paste0(if(kind == "i") "d" else kind, "gCMatrix"))
to@Dim <- c(m, 1L)
to@p <- c(0L, length(from@i))
to@i <- as.integer(from@i) - 1L
if(kind != "n")
to@x <- if(kind == "i") as.double(from@x) else from@x
to
}
.V2R <- function(from) {
if(is.double(m <- length(from)))
stop(gettextf("dimensions cannot exceed %s", "2^31-1"),
domain = NA)
kind <- .M.kind(from)
to <- new(paste0(if(kind == "i") "d" else kind, "gRMatrix"))
to@Dim <- c(m, 1L)
to@p <- c(0L, cumsum(replace(logical(m), from@i, TRUE)))
to@j <- integer(length(from@i))
if(kind != "n")
to@x <- if(kind == "i") as.double(from@x) else from@x
to
}
.V2T <- function(from) {
if(is.double(m <- length(from)))
stop(gettextf("dimensions cannot exceed %s", "2^31-1"),
domain = NA)
kind <- .M.kind(from)
to <- new(paste0(if(kind == "i") "d" else kind, "gTMatrix"))
to@Dim <- c(m, 1L)
to@i <- as.integer(from@i) - 1L
to@j <- integer(length(from@i))
if(kind != "n")
to@x <- if(kind == "i") as.double(from@x) else from@x
to
}
## ==== To vector ======================================================
## Need 'base' functions calling as.*() to dispatch to our S4 methods:
if (FALSE) {
## 2023-08-10: breaks iGraphMatch, mcmcsae, mcompanion
## which define proper subclasses of Matrix not extending
## any of _our_ proper subclasses of Matrix
as.matrix.Matrix <- function(x, ...) .M2m(x)
as.array.Matrix <- function(x, ...) .M2m(x)
} else {
as.matrix.Matrix <- function(x, ...) as(x, "matrix")
as.array.Matrix <- function(x, ...) as(x, "matrix")
setAs("Matrix", "matrix", .M2m)
}
as.matrix.sparseVector <- function(x, ...) .V2m(x)
as.array.sparseVector <- function(x, ...) .V2a(x)
setMethod("as.vector" , c(x = "Matrix"),
function(x, mode = "any") as.vector(.M2v(x), mode))
setMethod("as.matrix" , c(x = "Matrix"),
as.matrix.Matrix)
setMethod("as.array" , c(x = "Matrix"),
as.array.Matrix)
setMethod("as.logical", c(x = "Matrix"),
function(x, ...) as.logical(.M2v(x)))
setMethod("as.integer", c(x = "Matrix"),
function(x, ...) as.integer(.M2v(x)))
setMethod("as.numeric", c(x = "Matrix"),
function(x, ...) as.numeric(.M2v(x)))
setMethod("as.complex", c(x = "Matrix"),
function(x, ...) as.complex(.M2v(x)))
setMethod("as.vector" , c(x = "sparseVector"),
function(x, mode = "any") as.vector(.V2v(x), mode))
setMethod("as.matrix" , c(x = "sparseVector"),
as.matrix.sparseVector)
setMethod("as.array" , c(x = "sparseVector"),
as.array.sparseVector)
setMethod("as.logical", c(x = "sparseVector"),
function(x, ...) as.logical(.V2v(x)))
setMethod("as.integer", c(x = "sparseVector"),
function(x, ...) as.integer(.V2v(x)))
setMethod("as.numeric", c(x = "sparseVector"),
function(x, ...) as.numeric(.V2v(x)))
setMethod("as.complex", c(x = "sparseVector"),
function(x, ...) as.complex(.V2v(x)))
## ==== To Matrix ======================================================
setAs("sparseVector", "Matrix",
.V2C)
setAs("matrix", "Matrix",
function(from) {
if(isDiagonal(from))
forceDiagonal(from)
else if(.sparseDefault(from))
.m2sparse.checking(from, ".", "C")
else .m2dense.checking(from, ".")
})
setAs("vector", "Matrix",
function(from) {
if(is.object(from) && length(dim(from)) == 2L) # e.g., data.frame
as(as.matrix(from), "Matrix")
else if(.sparseDefault(from))
.m2sparse(from, ".gC")
else .m2dense(from, ".ge")
})
setAs( "ANY", "Matrix",
function(from) as(as(from, "matrix"), "Matrix"))
if(FALSE) {
## MJ: not yet ... must first make as(<sparseCholesky>, "Matrix") defunct
setAs("MatrixFactorization", "Matrix",
function(from) {
n <- length(x <- expand2(from))
to <- x[[1L]]
if(n >= 2L) for(i in 2L:n) to <- to %*% x[[i]]
to
})
}
## ==== To sparseVector ================================================
setAs("Matrix", "sparseVector",
function(from) .M2V(from))
setAs("matrix", "sparseVector",
function(from) .m2V(from))
setAs("vector", "sparseVector",
function(from) .m2V(from))
setAs( "ANY", "sparseVector",
function(from) .m2V(as.vector(from)))
## ==== To "kind" ======================================================
setAs("Matrix", "nMatrix",
function(from) .M2kind(from, "n", NA))
setAs("Matrix", "lMatrix",
function(from) .M2kind(from, "l", NA))
setAs("Matrix", "dMatrix",
function(from) .M2kind(from, "d", NA))
setAs("Matrix", "ndenseMatrix",
function(from) .M2kind(from, "n", FALSE))
setAs("Matrix", "ldenseMatrix",
function(from) .M2kind(from, "l", FALSE))
setAs("Matrix", "ddenseMatrix",
function(from) .M2kind(from, "d", FALSE))
setAs("Matrix", "nsparseMatrix",
function(from) .M2kind(from, "n", TRUE))
setAs("Matrix", "lsparseMatrix",
function(from) .M2kind(from, "l", TRUE))
setAs("Matrix", "dsparseMatrix",
function(from) .M2kind(from, "d", TRUE))
setAs("matrix", "nMatrix",
function(from) {
if(.sparseDefault(from))
.m2sparse.checking(from, "n", "C")
else .m2dense.checking(from, "n")
})
setAs("matrix", "lMatrix",
function(from) {
if(isDiagonal(from))
forceDiagonal(`storage.mode<-`(from, "logical"))
else if(.sparseDefault(from))
.m2sparse.checking(from, "l", "C")
else .m2dense.checking(from, "l")
})
setAs("matrix", "dMatrix",
function(from) {
if(isDiagonal(from))
forceDiagonal(`storage.mode<-`(from, "double"))
else if(.sparseDefault(from))
.m2sparse.checking(from, "d", "C")
else .m2dense.checking(from, "d")
})
setAs("matrix", "ndenseMatrix",
function(from) .m2dense.checking(from, "n"))
setAs("matrix", "ldenseMatrix",
function(from) .m2dense.checking(from, "l"))
setAs("matrix", "ddenseMatrix",
function(from) .m2dense.checking(from, "d"))
setAs("matrix", "nsparseMatrix",
function(from) .m2sparse.checking(from, "n", "C"))
setAs("matrix", "lsparseMatrix",
function(from) .m2sparse.checking(from, "l", "C"))
setAs("matrix", "dsparseMatrix",
function(from) .m2sparse.checking(from, "d", "C"))
setAs("vector", "nMatrix",
function(from) {
if(.sparseDefault(from))
.m2sparse(from, "ngC")
else .m2dense(from, "nge")
})
setAs("vector", "lMatrix",
function(from) {
if(.sparseDefault(from))
.m2sparse(from, "lgC")
else .m2dense(from, "lge")
})
setAs("vector", "dMatrix",
function(from) {
if(.sparseDefault(from))
.m2sparse(from, "dgC")
else .m2dense(from, "dge")
})
setAs("vector", "ndenseMatrix",
function(from) .m2dense(from, "nge"))
setAs("vector", "ldenseMatrix",
function(from) .m2dense(from, "lge"))
setAs("vector", "ddenseMatrix",
function(from) .m2dense(from, "dge"))
setAs("vector", "nsparseMatrix",
function(from) .m2sparse(from, "ngC"))
setAs("vector", "lsparseMatrix",
function(from) .m2sparse(from, "lgC"))
setAs("vector", "dsparseMatrix",
function(from) .m2sparse(from, "dgC"))
setAs("sparseVector", "nsparseVector",
function(from) .V2kind(from, "n"))
setAs("sparseVector", "lsparseVector",
function(from) .V2kind(from, "l"))
setAs("sparseVector", "isparseVector",
function(from) .V2kind(from, "i"))
setAs("sparseVector", "dsparseVector",
function(from) .V2kind(from, "d"))
setAs("sparseVector", "zsparseVector",
function(from) .V2kind(from, "z"))
setAs("vector", "nsparseVector",
function(from) .m2V(from, "n"))
setAs("vector", "lsparseVector",
function(from) .m2V(from, "l"))
setAs("vector", "isparseVector",
function(from) .m2V(from, "i"))
setAs("vector", "dsparseVector",
function(from) .m2V(from, "d"))
setAs("vector", "zsparseVector",
function(from) .m2V(from, "z"))
## ==== To "shape" =====================================================
..m2gen <- function(from) .m2dense(from, ".ge")
setAs( "Matrix", "generalMatrix", ..M2gen)
setAs( "matrix", "generalMatrix", ..m2gen)
setAs( "vector", "generalMatrix", ..m2gen)
setAs("sparseVector", "generalMatrix", .V2C)
setAs("Matrix", "symmetricMatrix", ..M2sym)
setAs("matrix", "symmetricMatrix", ..M2sym)
setAs("Matrix", "triangularMatrix", ..M2tri)
setAs("matrix", "triangularMatrix", ..M2tri)
rm(..m2gen)
setAs("diagonalMatrix", "symmetricMatrix",
function(from) {
if(!isSymmetricDN(from@Dimnames))
stop("matrix is not symmetric; consider forceSymmetric(.) or symmpart(.)")
.diag2sparse(from, ".", "s", "C")
})
setAs("diagonalMatrix", "triangularMatrix",
function(from)
.diag2sparse(from, ".", "t", "C"))
## ==== To "representation" ============================================
setAs("Matrix", "denseMatrix", .M2unpacked)
setAs("Matrix", "unpackedMatrix", .M2unpacked)
setAs("Matrix", "packedMatrix", .M2packed)
setAs("Matrix", "sparseMatrix", .M2C)
setAs("Matrix", "CsparseMatrix", .M2C)
setAs("Matrix", "RsparseMatrix", .M2R)
setAs("Matrix", "TsparseMatrix", .M2T)
## Do test for structure:
## FIXME: wrongly assumes that methods are defined for pack(<sparseMatrix>) ...
setAs("generalMatrix", "packedMatrix", function(from) pack(from))
setAs("matrix", "denseMatrix",
function(from) .m2dense.checking(from, "."))
setAs("matrix", "unpackedMatrix",
function(from) .m2dense.checking(from, "."))
setAs("matrix", "packedMatrix",
function(from) pack(from))
setAs("matrix", "sparseMatrix",
function(from) .m2sparse.checking(from, ".", "C"))
setAs("matrix", "CsparseMatrix",
function(from) .m2sparse.checking(from, ".", "C"))
setAs("matrix", "RsparseMatrix",
function(from) .m2sparse.checking(from, ".", "R"))
setAs("matrix", "TsparseMatrix",
function(from) .m2sparse.checking(from, ".", "T"))
## Many people want this coercion to be available and fast:
setAs("matrix", "dgCMatrix",
function(from) .m2sparse(from, "dgC"))
setAs("vector", "denseMatrix",
function(from)
if(is.object(from) && length(dim(from)) == 2L) # e.g., data.frame
as(as.matrix(from), "denseMatrix")
else .m2dense(from, ".ge"))
setAs("vector", "unpackedMatrix",
function(from) .m2dense(from, ".ge"))
setAs("vector", "sparseMatrix",
function(from)
if(is.object(from) && length(dim(from)) == 2L) # e.g., data.frame
as(as.matrix(from), "sparseMatrix")
else .m2sparse(from, ".gC"))
setAs("vector", "CsparseMatrix",
function(from) .m2sparse(from, ".gC"))
setAs("vector", "RsparseMatrix",
function(from) .m2sparse(from, ".gR"))
setAs("vector", "TsparseMatrix",
function(from) .m2sparse(from, ".gT"))
setAs("ANY", "denseMatrix",
function(from) as(as(from, "matrix"), "denseMatrix"))
setAs("ANY", "sparseMatrix",
function(from) as(as(from, "matrix"), "sparseMatrix"))
setAs("sparseVector", "denseMatrix", .V2unpacked)
setAs("sparseVector", "unpackedMatrix", .V2unpacked)
setAs("sparseVector", "sparseMatrix", .V2C)
setAs("sparseVector", "CsparseMatrix", .V2C)
setAs("sparseVector", "RsparseMatrix", .V2R)
setAs("sparseVector", "TsparseMatrix", .V2T)
setAs("Matrix", "diagonalMatrix", .M2diag)
setAs("matrix", "diagonalMatrix", .M2diag)
setAs("Matrix", "indMatrix",
function(from) as(as(from, "nsparseMatrix"), "indMatrix"))
setAs("matrix", "indMatrix",
function(from) as(as(from, "nsparseMatrix"), "indMatrix"))
setAs("Matrix", "pMatrix",
function(from) as(as(from, "nsparseMatrix"), "pMatrix"))
setAs("matrix", "pMatrix",
function(from) as(as(from, "nsparseMatrix"), "pMatrix"))
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.