SCM

SCM Repository

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

Diff of /pkg/R/dtpMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 609, Fri Mar 4 17:34:03 2005 UTC revision 1174, Mon Jan 16 20:03:48 2006 UTC
# Line 1  Line 1 
1  #### Triangular Packed Matrices -- Coercion and Methods  #### Triangular Packed Matrices -- Coercion and Methods
2    
3  setAs("dtpMatrix", "dtrMatrix",  setAs("dtpMatrix", "dtrMatrix",
4        function(from) .Call("dtpMatrix_as_dtrMatrix", from) )        function(from) .Call("dtpMatrix_as_dtrMatrix", from, PACKAGE = "Matrix"))
5    
6  setAs("dtpMatrix", "dgeMatrix",  setAs("dtpMatrix", "dgeMatrix",
7        function(from) as(as(from, "dtrMatrix"), "dgeMatrix"))        function(from) as(as(from, "dtrMatrix"), "dgeMatrix"))
8    
9    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  setAs("dtpMatrix", "matrix",  setAs("dtpMatrix", "matrix",
42        function(from) as(as(from, "dtrMatrix"), "matrix"))        function(from) as(as(from, "dtrMatrix"), "matrix"))
43    setAs("matrix", "dtpMatrix",
44          function(from) as(as(from, "dtrMatrix"), "dtpMatrix"))
45    
46    
47  setMethod("%*%", signature(x = "dtpMatrix", y = "dgeMatrix"),  setMethod("%*%", signature(x = "dtpMatrix", y = "dgeMatrix"),
48            function(x, y) .Call("dtpMatrix_dgeMatrix_mm", x, y))            function(x, y) .Call("dtpMatrix_dgeMatrix_mm", x, y, PACKAGE = "Matrix"))
49  setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"),  setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"),
50            function(x, y) callGeneric(x, as(y, "dgeMatrix")))            function(x, y) .Call("dgeMatrix_dtpMatrix_mm", x, y, PACKAGE = "Matrix"))
51    ## %*% 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  setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"),  setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"),
61            function(x, y) .Call("dtpMatrix_matrix_mm", x, y))            function(x, y) callGeneric(x, as(y, "dgeMatrix")))
62  ## extending to vector RHS  setMethod("%*%", signature(x = "matrix", y = "dtpMatrix"),
63  setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"),            function(x, y) callGeneric(as(x, "dgeMatrix"), y))
64            function(x, y) callGeneric(x, as.matrix(y)))  
65  ## the other way around  ## dtpMatrix <-> numeric : the auxiliary functions are R version specific!
66  setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"),  ##setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"), .M.v)
67            function(x, y) callGeneric(as(as.matrix(x), "dgeMatrix"), y))  ##setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"), .v.M)
68    
69    
70  setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"),  setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"),
71            function(x, logarithm, ...) determinant(x, TRUE))            function(x, logarithm, ...) determinant(x, TRUE))
72    
 setMethod("diag", signature(x = "dtpMatrix"),  
           function(x = 1, nrow, ncol = n) .Call("dtpMatrix_getDiag", x),  
           valueClass = "numeric")  
   
73  setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"),  setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"),
74            function(x, logarithm, ...) {            function(x, logarithm, ...) {
75                dg <- diag(x)                dg <- diag(x)
# Line 48  Line 87 
87                val                val
88            })            })
89    
90    setMethod("diag", signature(x = "dtpMatrix"),
91              function(x = 1, nrow, ncol = n) .Call("dtpMatrix_getDiag", x, PACKAGE = "Matrix"),
92              valueClass = "numeric")
93    
94  setMethod("norm", signature(x = "dtpMatrix", type = "character"),  setMethod("norm", signature(x = "dtpMatrix", type = "character"),
95            function(x, type, ...)            function(x, type, ...)
96            .Call("dtpMatrix_norm", x, type),            .Call("dtpMatrix_norm", x, type, PACKAGE = "Matrix"),
97            valueClass = "numeric")            valueClass = "numeric")
98    
99  setMethod("norm", signature(x = "dtpMatrix", type = "missing"),  setMethod("norm", signature(x = "dtpMatrix", type = "missing"),
100            function(x, type, ...)            function(x, type, ...)
101            .Call("dtpMatrix_norm", x, "O"),            .Call("dtpMatrix_norm", x, "O", PACKAGE = "Matrix"),
102            valueClass = "numeric")            valueClass = "numeric")
103    
104  setMethod("rcond", signature(x = "dtpMatrix", type = "character"),  setMethod("rcond", signature(x = "dtpMatrix", type = "character"),
105            function(x, type, ...)            function(x, type, ...)
106            .Call("dtpMatrix_rcond", x, type),            .Call("dtpMatrix_rcond", x, type, PACKAGE = "Matrix"),
107            valueClass = "numeric")            valueClass = "numeric")
108    
109  setMethod("rcond", signature(x = "dtpMatrix", type = "missing"),  setMethod("rcond", signature(x = "dtpMatrix", type = "missing"),
110            function(x, type, ...)            function(x, type, ...)
111            .Call("dtpMatrix_rcond", x, "O"),            .Call("dtpMatrix_rcond", x, "O", PACKAGE = "Matrix"),
112            valueClass = "numeric")            valueClass = "numeric")
113    
114  setMethod("solve", signature(a = "dtpMatrix", b="missing"),  setMethod("solve", signature(a = "dtpMatrix", b="missing"),
115            function(a, b, ...)            function(a, b, ...)
116            .Call("dtpMatrix_solve", a),            .Call("dtpMatrix_solve", a, PACKAGE = "Matrix"),
117            valueClass = "dtpMatrix")            valueClass = "dtpMatrix")
118    
119  setMethod("solve", signature(a = "dtpMatrix", b="matrix"),  setMethod("solve", signature(a = "dtpMatrix", b="matrix"),
120            function(a, b, ...)            function(a, b, ...)
121            .Call("dtpMatrix_matrix_solve", a, b),            .Call("dtpMatrix_matrix_solve", a, b, PACKAGE = "Matrix"),
122            valueClass = "matrix")            valueClass = "matrix")
123    
124  setMethod("t", signature(x = "dtpMatrix"),  setMethod("t", signature(x = "dtpMatrix"),
125            function(x) as(t(as(x, "dtrMatrix")), "dtpMatrix"),            function(x) as(t(as(x, "dtrMatrix")), "dtpMatrix"),
126            valueClass = "dtpMatrix")            valueClass = "dtpMatrix")
127    
128    setMethod("unpack", signature(x = "dtpMatrix"),
129              function(x, ...) as(x, "dtrMatrix"),
130              valueClass = "dtrMatrix")
131  ###  ###

Legend:
Removed from v.609  
changed lines
  Added in v.1174

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