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 2363, Thu Apr 9 20:45:32 2009 UTC revision 2417, Fri Jul 10 16:17:28 2009 UTC
# Line 595  Line 595 
595  ##        function(x, y = NULL) {  ##        function(x, y = NULL) {
596  ##           })  ##           })
597    
598  ## setMethod("tcrossprod", signature(x = "denseMatrix", y = "diagonalMatrix"),  Cspdiagprod <- function(x, y) {
599  ##        function(x, y = NULL) {      dx <- dim(x)
600  ##           })      dy <- dim(y)
601        if(dx[2] != dy[1]) stop("non-matching dimensions")
602        ind <- rep.int(seq_len(dx[2]), x@p[-1] - x@p[-dx[2]-1L])
603        if(y@diag == "N")
604            x@x <- x@x * y@x[ind]
605        x
606    }
607    
608    diagCspprod <- function(x, y) {
609        dx <- dim(x)
610        dy <- dim(y)
611        if(dx[2] != dy[1]) stop("non-matching dimensions")
612        if(x@diag == "N")
613            y@x <- y@x * x@x[y@i + 1L]
614        y
615    }
616    
617    setMethod("crossprod", signature(x = "diagonalMatrix", y = "CsparseMatrix"),
618              function(x, y = NULL) diagCspprod(x, y))
619    
620  setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
621            function(x, y = NULL) crossprod(as(x, "TsparseMatrix"), y))            function(x, y = NULL) diagCspprod(x, as(y, "CsparseMatrix")))
622    
623    ## Prefer calling diagCspprod to Cspdiagprod if going to transpose anyway
624    ##  x'y == (y'x)'
625    setMethod("crossprod", signature(x = "CsparseMatrix", y = "diagonalMatrix"),
626              function(x, y = NULL) t(diagCspprod(y, x)))
627    
628  setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
629            function(x, y = NULL) crossprod(x, as(y, "TsparseMatrix")))            function(x, y = NULL) t(diagCspprod(y, as(x, "Csparsematrix"))))
630    
631    setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "CsparseMatrix"),
632              function(x, y = NULL) diagCspprod(x, t(y)))
633    
634  setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
635            function(x, y = NULL) tcrossprod(as(x, "TsparseMatrix"), y))            function(x, y = NULL) diagCspprod(x, t(as(y, "CsparseMatrix"))))
636    
637    setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "diagonalMatrix"),
638              function(x, y = NULL) Cspdiagprod(x, y))
639    
640  setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
641            function(x, y = NULL) tcrossprod(x, as(y, "TsparseMatrix")))            function(x, y = NULL) Cspdiagprod(as(x, "CsparseMatrix"), y))
642    
643    setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"),
644              function(x, y) diagCspprod(x, y))
645    
 ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()  
646  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
647            function(x, y) as(x, "TsparseMatrix") %*% y)            function(x, y) diagCspprod(as(x, "CsparseMatrix"), y))
648    
649  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
650            function(x, y) x %*% as(y, "TsparseMatrix"))            function(x, y) Cspdiagprod(as(x, "CsparseMatrix"), y))
651  ## NB: The previous is *not* triggering for  "ddi" o "dgC" (= distance 3)  
 ##     since there's a "ddense" o "Csparse" at dist. 2 => triggers first.  
 ## ==> do this:  
 setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"),  
           function(x, y) as(x, "CsparseMatrix") %*% y)  
652  setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"),
653            function(x, y) x %*% as(y, "CsparseMatrix"))            function(x, y) Cspdiagprod(x, y))
654  ## NB: this is *not* needed for Tsparse & Rsparse  
655  ## TODO: Write tests in ./tests/ which ensure that many "ops" with diagonal*  ## TODO: Write tests in ./tests/ which ensure that many "ops" with diagonal*
656  ##       do indeed work by going through sparse (and *not* ddense)!  ##       do indeed work by going through sparse (and *not* ddense)!
657    
   
   
658  setMethod("solve", signature(a = "diagonalMatrix", b = "missing"),  setMethod("solve", signature(a = "diagonalMatrix", b = "missing"),
659            function(a, b, ...) {            function(a, b, ...) {
660                a@x <- 1/ a@x                a@x <- 1/ a@x

Legend:
Removed from v.2363  
changed lines
  Added in v.2417

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