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 1655, Mon Oct 30 17:16:27 2006 UTC revision 1708, Fri Dec 22 19:53:37 2006 UTC
# Line 173  Line 173 
173                x = if(uni) x[FALSE] else x)                x = if(uni) x[FALSE] else x)
174        })        })
175    
176    
177    setMethod("diag", signature(x = "diagonalMatrix"),
178              function(x = 1, nrow, ncol = n) .diag.x(x))
179    
180  ## When you assign to a diagonalMatrix, the result should be  ## When you assign to a diagonalMatrix, the result should be
181  ## diagonal or sparse  ## diagonal or sparse ---
182    ## FIXME: this now fails because the "denseMatrix" methods come first in dispatch
183  setReplaceMethod("[", signature(x = "diagonalMatrix",  setReplaceMethod("[", signature(x = "diagonalMatrix",
184                                  i = "ANY", j = "ANY", value = "ANY"),                                  i = "ANY", j = "ANY", value = "ANY"),
185                   function(x, i, j, value) {                   function(x, i, j, value) {
# Line 203  Line 208 
208  ## chol(L) is L for logical diagonal:  ## chol(L) is L for logical diagonal:
209  setMethod("chol", signature(x = "ldiMatrix"), function(x, pivot) x)  setMethod("chol", signature(x = "ldiMatrix"), function(x, pivot) x)
210    
   
 setMethod("diag", signature(x = "diagonalMatrix"),  
           function(x = 1, nrow, ncol = n) {  
              if(x@diag == "U")  
                  rep.int(if(is.logical(x@x)) TRUE else 1, x@Dim[1])  
              else x@x  
           })  
   
211  setMethod("!", "ldiMatrix", function(e1) {  setMethod("!", "ldiMatrix", function(e1) {
212      if(e1@diag == "N")      if(e1@diag == "N")
213          e1@x <- !e1@x          e1@x <- !e1@x
# Line 360  Line 357 
357    
358    
359  ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()  ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()
   
360  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
361            function(x, y) as(x, "sparseMatrix") %*% y)            function(x, y) as(x, "sparseMatrix") %*% y)
362    ## NB: The previous is *not* triggering for  "ddi" o "dgC" (= distance 3)
363    ##     since there's a "ddense" o "Csparse" at dist. 2 => triggers first.
364    ## ==> do this:
365    setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"),
366              function(x, y) as(x, "CsparseMatrix") %*% y)
367    ## NB: this is *not* needed for Tsparse & Rsparse
368    ## TODO: Write tests in ./tests/ which ensure that many "ops" with diagonal*
369    ##       do indeed work by going throug sparse (and *not* ddense)!
370    
371  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
372            function(x, y) x %*% as(y, "sparseMatrix"))            function(x, y) x %*% as(y, "sparseMatrix"))
# Line 380  Line 384 
384            function(x, y = NULL) { y <- as(y, "sparseMatrix"); callGeneric() })            function(x, y = NULL) { y <- as(y, "sparseMatrix"); callGeneric() })
385    
386    
   
   
387  ## similar to prTriang() in ./Auxiliaries.R :  ## similar to prTriang() in ./Auxiliaries.R :
388  prDiag <-  prDiag <-
389      function(x, digits = getOption("digits"), justify = "none", right = TRUE)      function(x, digits = getOption("digits"), justify = "none", right = TRUE)

Legend:
Removed from v.1655  
changed lines
  Added in v.1708

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