SCM

SCM Repository

[matrix] Annotation of /pkg/R/dtpMatrix.R
ViewVC logotype

Annotation of /pkg/R/dtpMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1174 - (view) (download)

1 : bates 597 #### Triangular Packed Matrices -- Coercion and Methods
2 :    
3 :     setAs("dtpMatrix", "dtrMatrix",
4 : bates 1038 function(from) .Call("dtpMatrix_as_dtrMatrix", from, PACKAGE = "Matrix"))
5 : bates 597
6 :     setAs("dtpMatrix", "dgeMatrix",
7 :     function(from) as(as(from, "dtrMatrix"), "dgeMatrix"))
8 :    
9 : maechler 1174 setAs("dtpMatrix", "dtTMatrix",
10 :     ## FIXME this is NOT efficient:
11 :     function(from) {
12 :     x <- as(from, "TsparseMatrix")
13 :     if(is(x, "dtTMatrix"))
14 :     x
15 :     else
16 :     gt2tT(as(x, "dgTMatrix"), uplo = from@uplo, diag = from@diag)
17 :     })
18 :    
19 :     gt2tT <- function(x, uplo, diag) {
20 :     ## coerce *gtMatrix to *tTMatrix {general -> triangular}
21 :     i <- x@i
22 :     j <- x@j
23 :     sel <-
24 :     if(uplo == "U") {
25 :     if(diag == "U") i < j else i <= j
26 :     } else {
27 :     if(diag == "U") i > j else i >= j
28 :     }
29 :     i <- i[sel]
30 :     j <- j[sel]
31 :     if(is(x, "lMatrix"))
32 :     new("ltTMatrix", i = i, j = j, uplo = uplo, diag = diag,
33 :     Dim = x@Dim, Dimnames = x@Dimnames) # no 'x' slot
34 :     else
35 :     new(paste(substr(class(x), 1,1), # "d", "l", "i" or "z"
36 :     "tTMatrix", sep=''),
37 :     i = i, j = j, uplo = uplo, diag = diag,
38 :     x = x@x[sel], Dim = x@Dim, Dimnames = x@Dimnames)
39 :     }
40 :    
41 : bates 597 setAs("dtpMatrix", "matrix",
42 :     function(from) as(as(from, "dtrMatrix"), "matrix"))
43 : maechler 657 setAs("matrix", "dtpMatrix",
44 :     function(from) as(as(from, "dtrMatrix"), "dtpMatrix"))
45 : bates 597
46 : maechler 609
47 : bates 597 setMethod("%*%", signature(x = "dtpMatrix", y = "dgeMatrix"),
48 : bates 1038 function(x, y) .Call("dtpMatrix_dgeMatrix_mm", x, y, PACKAGE = "Matrix"))
49 : maechler 609 setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"),
50 : bates 1038 function(x, y) .Call("dgeMatrix_dtpMatrix_mm", x, y, PACKAGE = "Matrix"))
51 : maechler 657 ## %*% should always work for <fooMatrix> %*% <fooMatrix>
52 :     setMethod("%*%", signature(x = "dtpMatrix", y = "dtpMatrix"),
53 :     function(x, y)
54 :     ## FIXME: this is cheap; could we optimize chosing the better of
55 :     ## callGeneric(x, as(y, "dgeMatrix")) and
56 :     ## callGeneric(as(x "dgeMatrix"), y)) depending on their 'uplo' ?
57 :     callGeneric(x, as(y, "dgeMatrix")))
58 :    
59 :     ## dtpMatrix <-> matrix : will be used by the "numeric" one
60 : bates 603 setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"),
61 : maechler 657 function(x, y) callGeneric(x, as(y, "dgeMatrix")))
62 : maechler 628 setMethod("%*%", signature(x = "matrix", y = "dtpMatrix"),
63 : maechler 657 function(x, y) callGeneric(as(x, "dgeMatrix"), y))
64 : bates 603
65 : maechler 657 ## dtpMatrix <-> numeric : the auxiliary functions are R version specific!
66 : bates 683 ##setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"), .M.v)
67 :     ##setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"), .v.M)
68 : maechler 628
69 : maechler 657
70 : bates 597 setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"),
71 :     function(x, logarithm, ...) determinant(x, TRUE))
72 :    
73 :     setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"),
74 :     function(x, logarithm, ...) {
75 :     dg <- diag(x)
76 :     if (logarithm) {
77 :     modulus <- sum(log(abs(dg)))
78 :     sgn <- prod(sign(dg))
79 :     } else {
80 :     modulus <- prod(dg)
81 :     sgn <- sign(modulus)
82 :     modulus <- abs(modulus)
83 :     }
84 :     attr(modulus, "logarithm") <- logarithm
85 :     val <- list(modulus = modulus, sign = sgn)
86 :     class(val) <- "det"
87 :     val
88 :     })
89 :    
90 : maechler 657 setMethod("diag", signature(x = "dtpMatrix"),
91 : bates 1038 function(x = 1, nrow, ncol = n) .Call("dtpMatrix_getDiag", x, PACKAGE = "Matrix"),
92 : maechler 657 valueClass = "numeric")
93 :    
94 : bates 597 setMethod("norm", signature(x = "dtpMatrix", type = "character"),
95 :     function(x, type, ...)
96 : bates 1038 .Call("dtpMatrix_norm", x, type, PACKAGE = "Matrix"),
97 : bates 597 valueClass = "numeric")
98 :    
99 :     setMethod("norm", signature(x = "dtpMatrix", type = "missing"),
100 :     function(x, type, ...)
101 : bates 1038 .Call("dtpMatrix_norm", x, "O", PACKAGE = "Matrix"),
102 : bates 597 valueClass = "numeric")
103 :    
104 :     setMethod("rcond", signature(x = "dtpMatrix", type = "character"),
105 :     function(x, type, ...)
106 : bates 1038 .Call("dtpMatrix_rcond", x, type, PACKAGE = "Matrix"),
107 : bates 597 valueClass = "numeric")
108 :    
109 :     setMethod("rcond", signature(x = "dtpMatrix", type = "missing"),
110 :     function(x, type, ...)
111 : bates 1038 .Call("dtpMatrix_rcond", x, "O", PACKAGE = "Matrix"),
112 : bates 597 valueClass = "numeric")
113 :    
114 :     setMethod("solve", signature(a = "dtpMatrix", b="missing"),
115 :     function(a, b, ...)
116 : bates 1038 .Call("dtpMatrix_solve", a, PACKAGE = "Matrix"),
117 : bates 597 valueClass = "dtpMatrix")
118 :    
119 :     setMethod("solve", signature(a = "dtpMatrix", b="matrix"),
120 :     function(a, b, ...)
121 : bates 1038 .Call("dtpMatrix_matrix_solve", a, b, PACKAGE = "Matrix"),
122 : bates 597 valueClass = "matrix")
123 :    
124 :     setMethod("t", signature(x = "dtpMatrix"),
125 :     function(x) as(t(as(x, "dtrMatrix")), "dtpMatrix"),
126 :     valueClass = "dtpMatrix")
127 : bates 642
128 :     setMethod("unpack", signature(x = "dtpMatrix"),
129 :     function(x, ...) as(x, "dtrMatrix"),
130 :     valueClass = "dtrMatrix")
131 : bates 597 ###

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge