1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
### d(ouble)sparseMatrix methods :
setMethod("image", "dsparseMatrix",
function(x, ...) image(as(x, "dgTMatrix"), ...))
## fails e.g. for 'dtCMatrix'; "triangularMatrix" has own method in ./triangularMatrix.R
setMethod("chol", signature(x = "dsparseMatrix"),
function(x, pivot=FALSE, cache=TRUE, ...) {
nm <- if(pivot) "sPdCholesky" else "spdCholesky"
if(!is.null(ch <- x@factors[[nm]]))
return(ch) ## use the cache
px <- as(x, "symmetricMatrix")
if (isTRUE(validObject(px, test=TRUE))) {
if(cache)
.set.factors(x, nm,
chol(as(px, "CsparseMatrix"), pivot=pivot, ...))
else chol(as(px, "CsparseMatrix"), pivot=pivot, ...)
}
else stop("'x' is not positive definite -- chol() undefined.")
})
setMethod("determinant", signature(x = "dsparseMatrix", logarithm = "logical"),
function(x, logarithm = TRUE, ...)
determinant(as(x,"CsparseMatrix"), logarithm, ...))
##-> now dgC or dsC or dtC .. which *have* their methods
setMethod("lu", signature(x = "dsparseMatrix"),
function(x, cache=TRUE, ...)
if(cache) .set.factors(x, "lu", lu(as(x, "dgCMatrix"), ...))
else lu(as(x, "dgCMatrix"), ...))
setMethod("is.finite", signature(x = "dsparseMatrix"),
function(x) {
if(any(!is.finite(x@x))) {
r <- allTrueMat(x, packed = FALSE)
x <- as(as(as(x,"CsparseMatrix"), "dgCMatrix"),"dgTMatrix")
notF <- which(!is.finite(x@x))
r[cbind(x@i[notF], x@j[notF]) + 1L] <- FALSE
r
}
else allTrueMat(x)
})
setMethod("is.infinite", signature(x = "dsparseMatrix"),
function(x) {
if(any((isInf <- is.infinite(x@x)))) {
cld <- getClassDef(class(x))
if(extends(cld, "triangularMatrix") && x@diag == "U")
isInf <- is.infinite((x <- .diagU2N(x, cld))@x)
r <- as(x, "lMatrix") # will be "lsparseMatrix" - *has* x slot
r@x <- if(length(isInf) == length(r@x)) isInf else is.infinite(r@x)
if(!extends(cld, "CsparseMatrix"))
r <- as(r, "CsparseMatrix")
as(.Call(Csparse_drop, r, 0), "nMatrix") # a 'pattern matrix
}
else is.na_nsp(x)
})
## Group Methods, see ?Arith (e.g.): "Ops" --> ./Ops.R, "Math" in ./Math.R, ...
## -----
|
