https://github.com/cran/Matrix
Tip revision: eb1f7fce82afee7a58cbc169eba0d67fbe3540ad authored by Doug and Martin on 12 January 2008, 00:00:00 UTC
version 0.999375-4
version 0.999375-4
Tip revision: eb1f7fc
dsCMatrix.R
#### Symmetric Sparse Matrices in compressed column-oriented format
setAs("dgCMatrix", "dsCMatrix",
function(from) {
if(isSymmetric(from))
## FIXME: should be able to *not* need Tsparse route
as(as(as(from, "dgTMatrix"), "dsTMatrix"), "dsCMatrix")
else stop("not a symmetric matrix")})
## Specific conversions, should they be necessary. Better to convert as
## as(x, "TsparseMatrix") or as(x, "denseMatrix")
## Moved to ./Csparse.R
## setAs("dsCMatrix", "dsTMatrix",
## function(from) .Call(Csparse_to_Tsparse, from, FALSE))
setAs("dsCMatrix", "dgTMatrix", # needed for show(), image()
function(from)
## pre-Cholmod -- FIXME: get rid of
.Call(dsCMatrix_to_dgTMatrix, from))
setAs("dsCMatrix", "dgeMatrix",
function(from) as(as(from, "dgTMatrix"), "dgeMatrix"))
setAs("dgeMatrix", "dsCMatrix",
function(from) as(as(from, "dsyMatrix"), "dsTMatrix"))
setAs("dsCMatrix", "matrix",
function(from) as(as(from, "dgTMatrix"), "matrix"))
setAs("matrix", "dsCMatrix",
function(from) as(as(from, "dgTMatrix"), "dsCMatrix"))
setAs("dsCMatrix", "lsCMatrix",
function(from) new("lsCMatrix", i = from@i, p = from@p, uplo = from@uplo,
x = as.logical(from@x),
Dim = from@Dim, Dimnames = from@Dimnames))
setAs("dsCMatrix", "nsCMatrix",
function(from) new("nsCMatrix", i = from@i, p = from@p, uplo = from@uplo,
Dim = from@Dim, Dimnames = from@Dimnames))
setAs("dsCMatrix", "dgCMatrix",
function(from) .Call(Csparse_symmetric_to_general, from))
setAs("dsCMatrix", "dsyMatrix",
function(from) as(as(from, "dsTMatrix"), "dsyMatrix"))
## have rather tril() and triu() methods than
## setAs("dsCMatrix", "dtCMatrix", ....)
setMethod("tril", "dsCMatrix",
function(x, k = 0, ...) {
if(x@uplo == "L" && k == 0)
## same internal structure (speedup potential !?)
new("dtCMatrix", uplo = x@uplo, i = x@i, p = x@p,
x = x@x, Dim = x@Dim, Dimnames = x@Dimnames)
else tril(as(x, "dgCMatrix"), k = k, ...)
})
setMethod("triu", "dsCMatrix",
function(x, k = 0, ...) {
if(x@uplo == "U" && k == 0)
## same internal structure (speedup potential !?)
new("dtCMatrix", uplo = x@uplo, i = x@i, p = x@p,
x = x@x, Dim = x@Dim, Dimnames = x@Dimnames)
else triu(as(x, "dgCMatrix"), k = k, ...)
})
setMethod("solve", signature(a = "dsCMatrix", b = "ddenseMatrix"),
function(a, b, ...) {
if (class(b) != "dgeMatrix")
b <- .Call(dup_mMatrix_as_dgeMatrix, b)
.Call(dsCMatrix_matrix_solve, a, b)
},
valueClass = "dgeMatrix")
setMethod("solve", signature(a = "dsCMatrix", b = "matrix"),
function(a, b, ...)
.Call(dsCMatrix_matrix_solve, a,
.Call(dup_mMatrix_as_dgeMatrix, b)),
valueClass = "dgeMatrix")
setMethod("solve", signature(a = "dsCMatrix", b = "numeric"),
function(a, b, ...)
.Call(dsCMatrix_matrix_solve, a,
.Call(dup_mMatrix_as_dgeMatrix, b)),
valueClass = "dgeMatrix")
## `` Fully-sparse'' solve() :
setMethod("solve", signature(a = "dsCMatrix", b = "dsparseMatrix"),
function(a, b, ...) {
if (!is(b, "CsparseMatrix"))
b <- as(b, "CsparseMatrix")
if (is(b, "symmetricMatrix")) ## not supported (yet) by cholmod_spsolve
b <- as(b, "dgCMatrix")
.Call(dsCMatrix_Csparse_solve, a, b)
})
setMethod("chol", signature(x = "dsCMatrix", pivot = "missing"),
function(x, pivot, ...) .Call(dsCMatrix_chol, x, FALSE),
valueClass = "dtCMatrix")
setMethod("chol", signature(x = "dsCMatrix", pivot = "logical"),
function(x, pivot, ...) .Call(dsCMatrix_chol, x, pivot),
valueClass = "dtCMatrix")
setMethod("Cholesky", signature(A = "dsCMatrix"),
function(A, perm = TRUE, LDL = TRUE, super = FALSE, ...)
.Call(dsCMatrix_Cholesky, A, perm, LDL, super))
setMethod("t", signature(x = "dsCMatrix"),
function(x) .Call(Csparse_transpose, x, FALSE),
valueClass = "dsCMatrix")
setMethod("determinant", signature(x = "dsCMatrix", logarithm = "missing"),
function(x, logarithm, ...) determinant(x, TRUE))
setMethod("determinant", signature(x = "dsCMatrix", logarithm = "logical"),
function(x, logarithm, ...)
{
stop("Temporarily disabled until we work out the LDL factorization diagonal")
ldet <- sum(log(chol(x)@D))
modulus <- if (logarithm) ldet else exp(ldet)
attr(modulus, "logarithm") <- logarithm
val <- list(modulus = modulus, sign = as.integer(1))
class(val) <- "det"
val
})
## setMethod("writeHB", signature(obj = "dsCMatrix"),
## function(obj, file, ...) {
## .Deprecated("writeMM")
## .Call(Matrix_writeHarwellBoeing,
## if (obj@uplo == "U") t(obj) else obj,
## as.character(file), "DSC")
## })