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 2331, Thu Jan 29 15:13:15 2009 UTC revision 2341, Mon Mar 2 17:53:13 2009 UTC
# Line 295  Line 295 
295            d <- dim(from)            d <- dim(from)
296            if(d[1] != (n <- d[2])) stop("non-square matrix")            if(d[1] != (n <- d[2])) stop("non-square matrix")
297            if(any(from[row(from) != col(from)] != 0))            if(any(from[row(from) != col(from)] != 0))
298                stop("has non-zero off-diagonal entries")                stop("matrix with non-zero off-diagonals cannot be coerced to diagonalMatrix")
299            x <- diag(from)            x <- diag(from)
300            if(is.logical(x)) {            if(is.logical(x)) {
301                cl <- "ldiMatrix"                cl <- "ldiMatrix"
302                uni <- all(x)                uni <- allTrue(x) ## uni := {is it unit-diagonal ?}
303            } else {            } else {
304                cl <- "ddiMatrix"                cl <- "ddiMatrix"
305                uni <- all(x == 1)                uni <- allTrue(x == 1)
306                storage.mode(x) <- "double"                storage.mode(x) <- "double"
307            } ## TODO: complex            } ## TODO: complex
308            new(cl, Dim = c(n,n), diag = if(uni) "U" else "N",            new(cl, Dim = c(n,n), diag = if(uni) "U" else "N",
# Line 319  Line 319 
319            x <- diag(from)            x <- diag(from)
320            if(is.logical(x)) {            if(is.logical(x)) {
321                cl <- "ldiMatrix"                cl <- "ldiMatrix"
322                uni <- all(x)                uni <- allTrue(x)
323            } else {            } else {
324                cl <- "ddiMatrix"                cl <- "ddiMatrix"
325                uni <- all(x == 1)                uni <- allTrue(x == 1)
326                storage.mode(x) <- "double"                storage.mode(x) <- "double"
327            }            } ## TODO: complex
328            new(cl, Dim = c(n,n), diag = if(uni) "U" else "N",            new(cl, Dim = c(n,n), diag = if(uni) "U" else "N",
329                x = if(uni) x[FALSE] else x)                x = if(uni) x[FALSE] else x)
330        })        })
# Line 929  Line 929 
929                if(any(x@Dim == 0)) FALSE                if(any(x@Dim == 0)) FALSE
930                else if(x@diag == "U") TRUE else any(x@x, ..., na.rm = na.rm)                else if(x@diag == "U") TRUE else any(x@x, ..., na.rm = na.rm)
931            })            })
932  setMethod("all",  cl, function (x, ..., na.rm) any(x@Dim == 0))  setMethod("all",  cl, function (x, ..., na.rm) {
933  setMethod("prod", cl, function (x, ..., na.rm) as.numeric(any(x@Dim == 0)))      n <- x@Dim[1]
934        if(n >= 2) FALSE
935        else if(n == 0 || x@diag == "U") TRUE
936        else all(x@x, ..., na.rm = na.rm)
937    })
938    setMethod("prod", cl, function (x, ..., na.rm) {
939        n <- x@Dim[1]
940        if(n >= 2) 0
941        else if(n == 0 || x@diag == "U") 1
942        else ## n == 1, diag = "N" :
943            prod(x@x, ..., na.rm = na.rm)
944    })
945    
946  setMethod("sum", cl,  setMethod("sum", cl,
947            function(x, ..., na.rm) {            function(x, ..., na.rm) {

Legend:
Removed from v.2331  
changed lines
  Added in v.2341

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