SCM Repository

[matrix] Diff of /pkg/R/Auxiliaries.R
 [matrix] / pkg / R / Auxiliaries.R

Diff of /pkg/R/Auxiliaries.R

revision 1349, Mon Aug 7 09:05:42 2006 UTC revision 1357, Tue Aug 8 16:26:38 2006 UTC
# Line 88  Line 88
88  ## ----  "*sy" and "*tr" which have "undefined" lower or upper part  ## ----  "*sy" and "*tr" which have "undefined" lower or upper part
89  isPacked <- function(x)  isPacked <- function(x)
90  {  {
91      ## Is 'x' a packed (dense) matrix ?      ## Is 'x' a packed (dense) matrix ? -- gives also TRUE for sparse
92      is(x,"Matrix") && !is.null(x@x) && length(x@x) < prod(dim(x))      is(x,"Matrix") && !is.null(x@x) && length(x@x) < prod(dim(x))
93  }  }
94
# Line 372  Line 372
372  as_geClass <- function(x, cl) {  as_geClass <- function(x, cl) {
373      if     (extends(cl, "diagonalMatrix")  && isDiagonal(x))      if     (extends(cl, "diagonalMatrix")  && isDiagonal(x))
374          as(x, cl)          as(x, cl)
375      else if(extends(cl, "symmetricMatrix") &&  isSymmetric(x))      else if(extends(cl, "symmetricMatrix") &&  isSymmetric(x)) {
376            kind <- .M.kind(x)
377          as(x, class2(cl, kind, do.sub= kind != "d"))          as(x, class2(cl, kind, do.sub= kind != "d"))
378      else if(extends(cl, "triangularMatrix") && isTriangular(x))      } else if(extends(cl, "triangularMatrix") && isTriangular(x))
379          as(x, cl)          as(x, cl)
380      else      else
381          as(x, paste(.M.kind(x), "geMatrix", sep=''))          as(x, paste(.M.kind(x), "geMatrix", sep=''))
# Line 465  Line 466
466  }  }
467
468  .is.diagonal <- function(object) {  .is.diagonal <- function(object) {
469        ## "matrix" or "denseMatrix" (but not "diagonalMatrix")
470      d <- dim(object)      d <- dim(object)
471      if(d[1] != (n <- d[2])) FALSE      if(d[1] != (n <- d[2])) FALSE
472      else all(object[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)] == 0)      else if(is.matrix(object))
473            ## requires that "vector-indexing" works for 'object' :
474            all(object[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)] == 0)
475        else ## "denseMatrix" -- packed or unpacked
476            if(is(object, "generalMatrix")) # "dge", "lge", ...
477                all(object@x[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)] == 0)
478            else { ## "dense" but not {diag, general}, i.e. triangular or symmetric:
479                ## -> has 'uplo'  differentiate between packed and unpacked
480
481    ### .......... FIXME ...............
482
483                packed <- isPacked(object)
484                if(object@uplo == "U") {
485                } else { ## uplo == "L"
486                }
487
488    ### very cheap workaround
489                all(as.matrix(object)[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)]
490                    == 0)
491  }  }
492    }
493
494
495  diagU2N <- function(x)  diagU2N <- function(x)
496  {  {

Legend:
 Removed from v.1349 changed lines Added in v.1357