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 2904, Tue Sep 10 19:43:53 2013 UTC revision 2912, Sat Sep 14 17:09:49 2013 UTC
# Line 654  Line 654 
654  ##        function(x, y = NULL) {  ##        function(x, y = NULL) {
655  ##           })  ##           })
656    
657    ##' @param x CsparseMatrix
658    ##' @param y diagonalMatrix
659    ##' @return x %*% y
660  Cspdiagprod <- function(x, y) {  Cspdiagprod <- function(x, y) {
661      dx <- dim(x <- .Call(Csparse_diagU2N, x))      dx <- dim(x <- .Call(Csparse_diagU2N, x))
662      dy <- dim(y)      dy <- dim(y)
663      if(dx[2] != dy[1]) stop("non-matching dimensions")      if(dx[2] != dy[1]) stop("non-matching dimensions")
664      if(y@diag == "N") {      if(y@diag == "N") { ## otherwise: y == Diagonal(n) : multiplication is identity
665          if(!all(y@x[1L] == y@x[-1L]) && is(x, "symmetricMatrix"))          if(!all(y@x[1L] == y@x[-1L]) && is(x, "symmetricMatrix"))
666              x <- as(x, "generalMatrix")              x <- as(x, "generalMatrix")
667          ind <- rep.int(seq_len(dx[2]), x@p[-1] - x@p[-dx[2]-1L])          ind <- rep.int(seq_len(dx[2]), x@p[-1] - x@p[-dx[2]-1L])
668          x@x <- x@x * y@x[ind]          x@x <- x@x * y@x[ind]
     }  
669      if(is(x, "compMatrix") && length(xf <- x@factors)) {      if(is(x, "compMatrix") && length(xf <- x@factors)) {
670          ## instead of dropping all factors, be smart about some          ## instead of dropping all factors, be smart about some
671          ## TODO ......          ## TODO ......
672          x@factors <- list()          x@factors <- list()
673      }      }
674        }
675      x      x
676  }  }
677    
678    ##' @param x diagonalMatrix
679    ##' @param y CsparseMatrix
680    ##' @return x %*% y
681  diagCspprod <- function(x, y) {  diagCspprod <- function(x, y) {
682      dx <- dim(x)      dx <- dim(x)
683      dy <- dim(y <- .Call(Csparse_diagU2N, y))      dy <- dim(y <- .Call(Csparse_diagU2N, y))
# Line 680  Line 686 
686          if(!all(x@x[1L] == x@x[-1L]) && is(y, "symmetricMatrix"))          if(!all(x@x[1L] == x@x[-1L]) && is(y, "symmetricMatrix"))
687              y <- as(y, "generalMatrix")              y <- as(y, "generalMatrix")
688          y@x <- y@x * x@x[y@i + 1L]          y@x <- y@x * x@x[y@i + 1L]
     }  
689      if(is(y, "compMatrix") && length(yf <- y@factors)) {      if(is(y, "compMatrix") && length(yf <- y@factors)) {
         ## instead of dropping all factors, be smart about some  
690          ## TODO          ## TODO
691                if(FALSE) { ## instead of dropping all factors, be smart about some
692          keep <- character()          keep <- character()
693          if(iLU <- names(yf) == "LU") {                  if(any(iLU <- names(yf) == "LU")) {
694              ## TODO keep <- "LU"                      keep <- "LU"
695          }          }
696          y@factors <- yf[keep]          y@factors <- yf[keep]
697                } else y@factors <- list() ## for now
698            }
699      }      }
700      y      y
701  }  }
# Line 722  Line 729 
729  setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"),  setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"),
730            function(x, y) diagCspprod(x, y))            function(x, y) diagCspprod(x, y))
731    
732    ## instead of "sparseMatrix", use: [RT]sparse.. ("closer" in method dispatch)
733    for(cl in c("TsparseMatrix", "RsparseMatrix")) {
734    
735  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
736            function(x, y) diagCspprod(as(x, "CsparseMatrix"), y))            function(x, y) diagCspprod(as(x, "CsparseMatrix"), y))
737    
738  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
739            function(x, y) Cspdiagprod(as(x, "CsparseMatrix"), y))            function(x, y) Cspdiagprod(as(x, "CsparseMatrix"), y))
740    }
741    
742  setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"),
743            function(x, y) Cspdiagprod(x, y))            function(x, y) Cspdiagprod(x, y))

Legend:
Removed from v.2904  
changed lines
  Added in v.2912

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