# SCM Repository

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

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

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