--- pkg/Matrix/R/diagMatrix.R 2013/08/16 14:09:01 2891 +++ pkg/Matrix/R/diagMatrix.R 2013/09/14 17:09:49 2912 @@ -515,12 +515,9 @@ setMethod("t", signature(x = "diagonalMatrix"), function(x) { x@Dimnames <- x@Dimnames[2:1] ; x }) -setMethod("isDiagonal", signature(object = "diagonalMatrix"), - function(object) TRUE) -setMethod("isTriangular", signature(object = "diagonalMatrix"), - function(object) TRUE) -setMethod("isSymmetric", signature(object = "diagonalMatrix"), - function(object, ...) TRUE) +setMethod("isDiagonal", "diagonalMatrix", function(object) TRUE) +setMethod("isTriangular", "diagonalMatrix", function(object, ...) TRUE) +setMethod("isSymmetric", "diagonalMatrix", function(object, ...) TRUE) setMethod("symmpart", signature(x = "diagonalMatrix"), function(x) x) setMethod("skewpart", signature(x = "diagonalMatrix"), setZero) @@ -567,7 +564,7 @@ } return(x) } else ## x is unit diagonal - return(y) + return(y) } setMethod("%*%", signature(x = "diagonalMatrix", y = "diagonalMatrix"), @@ -657,24 +654,30 @@ ## function(x, y = NULL) { ## }) +##' @param x CsparseMatrix +##' @param y diagonalMatrix +##' @return x %*% y Cspdiagprod <- function(x, y) { dx <- dim(x <- .Call(Csparse_diagU2N, x)) dy <- dim(y) if(dx[2] != dy[1]) stop("non-matching dimensions") - if(y@diag == "N") { + if(y@diag == "N") { ## otherwise: y == Diagonal(n) : multiplication is identity if(!all(y@x[1L] == y@x[-1L]) && is(x, "symmetricMatrix")) x <- as(x, "generalMatrix") ind <- rep.int(seq_len(dx[2]), x@p[-1] - x@p[-dx[2]-1L]) x@x <- x@x * y@x[ind] - } - if(is(x, "compMatrix") && length(xf <- x@factors)) { - ## instead of dropping all factors, be smart about some - ## TODO ...... - x@factors <- list() + if(is(x, "compMatrix") && length(xf <- x@factors)) { + ## instead of dropping all factors, be smart about some + ## TODO ...... + x@factors <- list() + } } x } +##' @param x diagonalMatrix +##' @param y CsparseMatrix +##' @return x %*% y diagCspprod <- function(x, y) { dx <- dim(x) dy <- dim(y <- .Call(Csparse_diagU2N, y)) @@ -683,15 +686,16 @@ if(!all(x@x[1L] == x@x[-1L]) && is(y, "symmetricMatrix")) y <- as(y, "generalMatrix") y@x <- y@x * x@x[y@i + 1L] - } - if(is(y, "compMatrix") && length(yf <- y@factors)) { - ## instead of dropping all factors, be smart about some - ## TODO - keep <- character() - if(iLU <- names(yf) == "LU") { - ## TODO keep <- "LU" - } - y@factors <- yf[keep] + if(is(y, "compMatrix") && length(yf <- y@factors)) { + ## TODO + if(FALSE) { ## instead of dropping all factors, be smart about some + keep <- character() + if(any(iLU <- names(yf) == "LU")) { + keep <- "LU" + } + y@factors <- yf[keep] + } else y@factors <- list() ## for now + } } y } @@ -725,11 +729,15 @@ setMethod("%*%", signature(x = "diagonalMatrix", y = "CsparseMatrix"), function(x, y) diagCspprod(x, y)) +## instead of "sparseMatrix", use: [RT]sparse.. ("closer" in method dispatch) +for(cl in c("TsparseMatrix", "RsparseMatrix")) { + setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"), function(x, y) diagCspprod(as(x, "CsparseMatrix"), y)) setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"), function(x, y) Cspdiagprod(as(x, "CsparseMatrix"), y)) +} setMethod("%*%", signature(x = "CsparseMatrix", y = "diagonalMatrix"), function(x, y) Cspdiagprod(x, y)) @@ -1173,7 +1181,8 @@ } }) -rm(dense.subCl, diCls)# not used elsewhere +rm(arg1, arg2, other, DI, cl, c1, c2, + dense.subCl, diCls)# not used elsewhere setMethod("summary", signature(object = "diagonalMatrix"), function(object, ...) {