SCM

SCM Repository

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

Diff of /pkg/R/diagMatrix.R

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

revision 1174, Mon Jan 16 20:03:48 2006 UTC revision 1331, Sat Jul 22 17:59:53 2006 UTC
# Line 34  Line 34 
34                x = x, i = i, j = i)                x = x, i = i, j = i)
35            })            })
36    
   
37  setAs("diagonalMatrix", "matrix",  setAs("diagonalMatrix", "matrix",
38        function(from) {        function(from) {
39            n <- from@Dim[1]            n <- from@Dim[1]
# Line 54  Line 53 
53               else "dgeMatrix")               else "dgeMatrix")
54        })        })
55    
56    setAs("ddiMatrix", "dgTMatrix",
57          function(from) {
58              n <- from@Dim[1]
59              i <- seq(length = n) - 1:1
60              new("dgTMatrix", i = i, j = i,
61                  x = if(from@diag == "U") rep(1,n) else from@x,
62                  Dim = c(n,n), Dimnames = from@Dimnames) })
63    
64    setAs("ddiMatrix", "dgCMatrix",
65          function(from) as(as(from, "dgTMatrix"), "dgCMatrix"))
66    
67    setAs("ldiMatrix", "lgTMatrix",
68          function(from) {
69              n <- from@Dim[1]
70              i <- (if(from@diag == "U") seq(length = n) else which(from@x)) - 1:1
71              new("lgTMatrix", i = i, j = i,
72                  Dim = c(n,n), Dimnames = from@Dimnames) })
73    
74    setAs("ldiMatrix", "lgCMatrix",
75          function(from) as(as(from, "lgTMatrix"), "lgCMatrix"))
76    
77    setAs("diagonalMatrix", "sparseMatrix",
78          function(from)
79              as(from, if(is(from, "dMatrix")) "dgCMatrix" else "lgCMatrix"))
80    
81  setAs("ddiMatrix", "dgeMatrix",  setAs("ddiMatrix", "dgeMatrix",
82        function(from) as(as(from, "matrix"), "dgeMatrix"))        function(from) as(as(from, "matrix"), "dgeMatrix"))
83    
   
84  setAs("matrix", "diagonalMatrix",  setAs("matrix", "diagonalMatrix",
85        function(from) {        function(from) {
86            d <- dim(from)            d <- dim(from)
# Line 100  Line 123 
123  setMethod("t", signature(x = "diagonalMatrix"),  setMethod("t", signature(x = "diagonalMatrix"),
124            function(x) { x@Dimnames <- x@Dimnames[2:1] ; x })            function(x) { x@Dimnames <- x@Dimnames[2:1] ; x })
125    
126    setMethod("isDiagonal", signature(object = "diagonalMatrix"),
127              function(object) TRUE)
128    setMethod("isTriangular", signature(object = "diagonalMatrix"),
129              function(object) TRUE)
130  setMethod("isSymmetric", signature(object = "diagonalMatrix"),  setMethod("isSymmetric", signature(object = "diagonalMatrix"),
131            function(object) TRUE)            function(object) TRUE)
132    
# Line 188  Line 215 
215                x                x
216            })            })
217    
218  ## crossprod  ## crossprod {more of these}
219    
220    ## tcrossprod --- all are not yet there: do the dense ones here:
221    
222    ## FIXME:
223    ## setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "denseMatrix"),
224    ##        function(x, y = NULL) {
225    ##           })
226    
227    ## setMethod("tcrossprod", signature(x = "denseMatrix", y = "diagonalMatrix"),
228    ##        function(x, y = NULL) {
229    ##           })
230    
231    
232    ### ---------------- diagonal  o   sparse  -----------------------------
233    
234    ## These are cheap implementations via coercion
235    
236    ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()
237    
238    setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
239              function(x, y) as(x, "sparseMatrix") %*% y)
240    
241    setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
242              function(x, y) x %*% as(y, "sparseMatrix"))
243    
244    setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
245              function(x, y = NULL) { x <- as(x, "sparseMatrix"); callGeneric() })
246    
247    setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
248              function(x, y = NULL) { y <- as(y, "sparseMatrix"); callGeneric() })
249    
250    setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
251              function(x, y = NULL) { x <- as(x, "sparseMatrix"); callGeneric() })
252    
253    setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
254              function(x, y = NULL) { y <- as(y, "sparseMatrix"); callGeneric() })
255    
256    
 ## tcrossprod  
257    
258    
259  ## similar to prTriang() in ./Auxiliaries.R :  ## similar to prTriang() in ./Auxiliaries.R :

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

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