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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
#### Positive-definite Symmetric Packed Matrices -- Coercion and Methods
setAs("dppMatrix", "dpoMatrix",
function(from)
copyClass(.Call(dspMatrix_as_dsyMatrix, from),
"dpoMatrix",
sNames = c("x", "Dim", "Dimnames", "uplo", "factors")))#FIXME , check=FALSE
dpp2sC <- function(from) as(.Call(dspMatrix_as_dsyMatrix, from), "dsCMatrix")
## setAs("dppMatrix", "dsCMatrix", dpp2sC)
setAs("dppMatrix", "CsparseMatrix", dpp2sC)
setAs("dppMatrix", "sparseMatrix", dpp2sC)
setAs("dppMatrix", "lMatrix",
function(from) as(as(from, "dsyMatrix"), "lMatrix"))
setAs("dppMatrix", "nMatrix",
function(from) as(as(from, "dsyMatrix"), "nMatrix"))
to_dpp <- function(from) as(as(as(as(from, "symmetricMatrix"), "dMatrix"),
"dpoMatrix"), "dppMatrix")
setAs("Matrix", "dppMatrix", to_dpp)# some may fail, but this tries
setAs("matrix", "dppMatrix", to_dpp)
setAs("dspMatrix", "dppMatrix",
function(from){
if(is.null(tryCatch(.Call(dppMatrix_chol, from),
error = function(e) NULL)))
stop("not a positive definite matrix")
## else
copyClass(from, "dppMatrix",
sNames = c("x", "Dim", "Dimnames", "uplo", "factors"))#FIXME , check=FALSE
})
setMethod("chol", signature(x = "dppMatrix"),
function(x, pivot, LINPACK) .Call(dppMatrix_chol, x))
setMethod("determinant", signature(x = "dppMatrix", logarithm = "logical"), mkDet.via.chol)
setMethod("determinant", signature(x = "dppMatrix", logarithm = "missing"),
function(x, logarithm, ...) mkDet.via.chol(x, logarithm=TRUE))
setMethod("rcond", signature(x = "dppMatrix", norm = "character"),
function(x, norm, ...)
.Call(dppMatrix_rcond, x, norm),
valueClass = "numeric")
setMethod("rcond", signature(x = "dppMatrix", norm = "missing"),
function(x, norm, ...)
.Call(dppMatrix_rcond, x, "O"),
valueClass = "numeric")
setMethod("solve", signature(a = "dppMatrix", b = "missing"),
function(a, b, ...)
.Call(dppMatrix_solve, a),
valueClass = "dppMatrix")
setMethod("solve", signature(a = "dppMatrix", b = "dgeMatrix"),
function(a, b, ...)
.Call(dppMatrix_matrix_solve, a, b),
valueClass = "dgeMatrix")
setMethod("solve", signature(a = "dppMatrix", b = "matrix"),
function(a, b, ...)
.Call(dppMatrix_matrix_solve, a, b),
valueClass = "dgeMatrix")
##setMethod("solve", signature(a = "dppMatrix", b = "numeric"),
## function(a, b, ...)
## .Call(dppMatrix_matrix_solve, a, as.matrix(b)),
## valueClass = "dgeMatrix")
setMethod("solve", signature(a = "dppMatrix", b = "integer"),
function(a, b, ...) {
storage.mode(b) <- "double"
.Call(dppMatrix_matrix_solve, a, cbind(b, deparse.level=0L))
}, valueClass = "dgeMatrix")
setMethod("t", signature(x = "dppMatrix"),
function(x) as(t(as(x, "dspMatrix")), "dppMatrix"),
valueClass = "dppMatrix")
|
