SCM

SCM Repository

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

Diff of /pkg/Matrix/R/diagMatrix.R

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

revision 1294, Thu Jun 8 16:06:02 2006 UTC revision 1295, Fri Jun 9 21:47:22 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 188  Line 211 
211                x                x
212            })            })
213    
214  ## crossprod  ## crossprod {more of these}
215    
216    ## tcrossprod --- all are not yet there: do the dense ones here:
217    
218    ## FIXME:
219    ## setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "denseMatrix"),
220    ##        function(x, y = NULL) {
221    ##           })
222    
223    ## setMethod("tcrossprod", signature(x = "denseMatrix", y = "diagonalMatrix"),
224    ##        function(x, y = NULL) {
225    ##           })
226    
227    
228    ### ---------------- diagonal  o   sparse  -----------------------------
229    
230    ## These are cheap implementations via coercion
231    
232    ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()
233    
234    setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
235              function(x, y) as(x, "sparseMatrix") %*% y)
236    
237    setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
238              function(x, y) x %*% as(y, "sparseMatrix"))
239    
240    setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
241              function(x, y = NULL) { x <- as(x, "sparseMatrix"); callGeneric() })
242    
243    setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
244              function(x, y = NULL) { y <- as(y, "sparseMatrix"); callGeneric() })
245    
246    setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
247              function(x, y = NULL) { x <- as(x, "sparseMatrix"); callGeneric() })
248    
249    setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
250              function(x, y = NULL) { y <- as(y, "sparseMatrix"); callGeneric() })
251    
252    
 ## tcrossprod  
253    
254    
255  ## similar to prTriang() in ./Auxiliaries.R :  ## similar to prTriang() in ./Auxiliaries.R :

Legend:
Removed from v.1294  
changed lines
  Added in v.1295

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