# SCM Repository

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

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

revision 3023, Sat Dec 20 22:29:49 2014 UTC revision 3046, Mon Feb 16 14:40:37 2015 UTC
# Line 282  Line 282
282
283  setAs("diagonalMatrix", "nMatrix",  setAs("diagonalMatrix", "nMatrix",
284        function(from) {        function(from) {
n <- from@Dim[1]
285            i <- if(from@diag == "U") integer(0) else which(isN0(from@x)) - 1L            i <- if(from@diag == "U") integer(0) else which(isN0(from@x)) - 1L
286            new("ntTMatrix", i = i, j = i, diag = from@diag,            new("ntTMatrix", i = i, j = i, diag = from@diag,
287                Dim = from@Dim, Dimnames = from@Dimnames)                Dim = from@Dim, Dimnames = from@Dimnames)
# Line 694  Line 693
693          if(!all(x@x[1L] == x@x[-1L]) && is(y, "symmetricMatrix"))          if(!all(x@x[1L] == x@x[-1L]) && is(y, "symmetricMatrix"))
694              y <- as(y, "generalMatrix")              y <- as(y, "generalMatrix")
695          y@x <- y@x * x@x[y@i + 1L]          y@x <- y@x * x@x[y@i + 1L]
696          if(.hasSlot(y, "factors") && length(yf <- y@factors)) {          if(.hasSlot(y, "factors") && length(y@factors)) {
697              ## TODO       ## if(.hasSlot(y, "factors") && length(yf <- y@factors)) { ## -- TODO? --
698              if(FALSE) { ## instead of dropping all factors, be smart about some              ## instead of dropping all factors, be smart about some
699                  keep <- character()              ## keep <- character()
700                  if(any(iLU <- names(yf) == "LU")) {              ## if(any(names(yf) == "LU")) { ## <- not easy: y = P'LUQ,  x y = xP'LUQ => LU ???
701                      keep <- "LU"              ##     keep <- "LU"
702                  }              ## }
703                  y@factors <- yf[keep]              ## y@factors <- yf[keep]
704              } else y@factors <- list() ## for now              y@factors <- list()
705          }          }
706      }      }
707      y      y
# Line 841  Line 840
840      ## result must be triangular      ## result must be triangular
841      r <- callGeneric(d1 <- .diag.x(e1), diag(e2)) # error if not "compatible"      r <- callGeneric(d1 <- .diag.x(e1), diag(e2)) # error if not "compatible"
842      ## Check what happens with non-diagonals, i.e. (0 o 0), (FALSE o 0), ...:      ## Check what happens with non-diagonals, i.e. (0 o 0), (FALSE o 0), ...:
843      e1.0 <- if(.n1 <- is.numeric(d1   )) 0 else FALSE      e1.0 <- if(is.numeric(d1)) 0 else FALSE
844      r00 <- callGeneric(e1.0, if(.n2 <- is.numeric(e2[0])) 0 else FALSE)      r00 <- callGeneric(e1.0, if(.n2 <- is.numeric(e2[0])) 0 else FALSE)
845      if(is0(r00)) { ##  r00 == 0 or FALSE --- result *is* triangular      if(is0(r00)) { ##  r00 == 0 or FALSE --- result *is* triangular
846          diag(e2) <- r          diag(e2) <- r

Legend:
 Removed from v.3023 changed lines Added in v.3046