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 1447 - (view) (download)

1 : bates 597 #### Triangular Packed Matrices -- Coercion and Methods
2 :    
3 :     setAs("dtpMatrix", "dtrMatrix",
4 : maechler 1280 function(from) .Call(dtpMatrix_as_dtrMatrix, from))
5 : bates 597
6 : maechler 1447 if(FALSE) # now have faster "ddense" -> "dge"
7 : bates 597 setAs("dtpMatrix", "dgeMatrix",
8 :     function(from) as(as(from, "dtrMatrix"), "dgeMatrix"))
9 :    
10 : maechler 1174 setAs("dtpMatrix", "dtTMatrix",
11 :     ## FIXME this is NOT efficient:
12 :     function(from) {
13 :     x <- as(from, "TsparseMatrix")
14 :     if(is(x, "dtTMatrix"))
15 :     x
16 :     else
17 :     gt2tT(as(x, "dgTMatrix"), uplo = from@uplo, diag = from@diag)
18 :     })
19 :    
20 : bates 597 setAs("dtpMatrix", "matrix",
21 :     function(from) as(as(from, "dtrMatrix"), "matrix"))
22 : maechler 657 setAs("matrix", "dtpMatrix",
23 :     function(from) as(as(from, "dtrMatrix"), "dtpMatrix"))
24 : bates 597
25 : maechler 609
26 : bates 597 setMethod("%*%", signature(x = "dtpMatrix", y = "dgeMatrix"),
27 : maechler 1280 function(x, y) .Call(dtpMatrix_dgeMatrix_mm, x, y))
28 : maechler 609 setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"),
29 : maechler 1280 function(x, y) .Call(dgeMatrix_dtpMatrix_mm, x, y))
30 : maechler 657 ## %*% should always work for <fooMatrix> %*% <fooMatrix>
31 :     setMethod("%*%", signature(x = "dtpMatrix", y = "dtpMatrix"),
32 :     function(x, y)
33 :     ## FIXME: this is cheap; could we optimize chosing the better of
34 :     ## callGeneric(x, as(y, "dgeMatrix")) and
35 :     ## callGeneric(as(x "dgeMatrix"), y)) depending on their 'uplo' ?
36 :     callGeneric(x, as(y, "dgeMatrix")))
37 :    
38 :     ## dtpMatrix <-> matrix : will be used by the "numeric" one
39 : bates 603 setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"),
40 : maechler 657 function(x, y) callGeneric(x, as(y, "dgeMatrix")))
41 : maechler 628 setMethod("%*%", signature(x = "matrix", y = "dtpMatrix"),
42 : maechler 657 function(x, y) callGeneric(as(x, "dgeMatrix"), y))
43 : bates 603
44 : maechler 657 ## dtpMatrix <-> numeric : the auxiliary functions are R version specific!
45 : bates 683 ##setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"), .M.v)
46 :     ##setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"), .v.M)
47 : maechler 628
48 : maechler 657
49 : bates 597 setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"),
50 :     function(x, logarithm, ...) determinant(x, TRUE))
51 :    
52 :     setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"),
53 :     function(x, logarithm, ...) {
54 :     dg <- diag(x)
55 :     if (logarithm) {
56 :     modulus <- sum(log(abs(dg)))
57 :     sgn <- prod(sign(dg))
58 :     } else {
59 :     modulus <- prod(dg)
60 :     sgn <- sign(modulus)
61 :     modulus <- abs(modulus)
62 :     }
63 :     attr(modulus, "logarithm") <- logarithm
64 :     val <- list(modulus = modulus, sign = sgn)
65 :     class(val) <- "det"
66 :     val
67 :     })
68 :    
69 : maechler 657 setMethod("diag", signature(x = "dtpMatrix"),
70 : maechler 1280 function(x = 1, nrow, ncol = n) .Call(dtpMatrix_getDiag, x),
71 : maechler 657 valueClass = "numeric")
72 :    
73 : bates 597 setMethod("norm", signature(x = "dtpMatrix", type = "character"),
74 :     function(x, type, ...)
75 : maechler 1280 .Call(dtpMatrix_norm, x, type),
76 : bates 597 valueClass = "numeric")
77 :    
78 :     setMethod("norm", signature(x = "dtpMatrix", type = "missing"),
79 :     function(x, type, ...)
80 : maechler 1280 .Call(dtpMatrix_norm, x, "O"),
81 : bates 597 valueClass = "numeric")
82 :    
83 :     setMethod("rcond", signature(x = "dtpMatrix", type = "character"),
84 :     function(x, type, ...)
85 : maechler 1280 .Call(dtpMatrix_rcond, x, type),
86 : bates 597 valueClass = "numeric")
87 :    
88 :     setMethod("rcond", signature(x = "dtpMatrix", type = "missing"),
89 :     function(x, type, ...)
90 : maechler 1280 .Call(dtpMatrix_rcond, x, "O"),
91 : bates 597 valueClass = "numeric")
92 :    
93 :     setMethod("solve", signature(a = "dtpMatrix", b="missing"),
94 :     function(a, b, ...)
95 : maechler 1280 .Call(dtpMatrix_solve, a),
96 : bates 597 valueClass = "dtpMatrix")
97 :    
98 :     setMethod("solve", signature(a = "dtpMatrix", b="matrix"),
99 :     function(a, b, ...)
100 : maechler 1280 .Call(dtpMatrix_matrix_solve, a, b),
101 : bates 597 valueClass = "matrix")
102 :    
103 :     setMethod("t", signature(x = "dtpMatrix"),
104 :     function(x) as(t(as(x, "dtrMatrix")), "dtpMatrix"),
105 :     valueClass = "dtpMatrix")
106 : bates 642
107 :     setMethod("unpack", signature(x = "dtpMatrix"),
108 :     function(x, ...) as(x, "dtrMatrix"),
109 :     valueClass = "dtrMatrix")
110 : 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