SCM Repository

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

[matrix] / pkg / R / Auxiliaries.R

Diff of /pkg/R/Auxiliaries.R

-revision 1547, Mon Sep 11 14:49:39 2006 UTC
+revision 1548, Mon Sep 11 22:13:07 2006 UTC
 Line 152
      invisible(x)# as print() S3 methods do
  }
+ ### FIXME? -- make this into a generic function (?)
+ nnzero <- function(x) {
+     cl <- class(x)
+     if(!extends(cl, "Matrix"))
+         sum(x != 0)
+     else if(extends(cl, "sparseMatrix"))
+         ## NOTA BENE: The number of *structural* non-zeros {could have other '0'}!
+        switch(.sp.class(cl),
+                "CsparseMatrix" = length(x@i),
+                "TsparseMatrix" = length(x@i),
+                "RsparseMatrix" = length(x@j))
+     else ## denseMatrix
+         sum(as_geClass(x)@x != 0)
+ }
  ## For sparseness handling
  ## return a 2-column (i,j) matrix of
  ## 0-based indices of non-zero entries  :
-Line 238
+Line 253
             "lgTMatrix" = as(as(x, "lgCMatrix"), "lgTMatrix"),
             "lsTMatrix" = as(as(x, "lsCMatrix"), "lsTMatrix"),
             "ltTMatrix" = as(as(x, "ltCMatrix"), "ltTMatrix"),
+            ## do we need this for "logical" ones, there's no sum() there!
+            "ngTMatrix" = as(as(x, "ngCMatrix"), "ngTMatrix"),
+            "nsTMatrix" = as(as(x, "nsCMatrix"), "nsTMatrix"),
+            "ntTMatrix" = as(as(x, "ntCMatrix"), "ntTMatrix"),
             ## otherwise:
             stop("not yet implemented for class ", class.x))
  }
-Line 317
+Line 336
      ## FIXME: treat 'factors' smartly {not for triangular!}
  }
+ ## -> ./ndenseMatrix.R :
+ n2d_Matrix <- function(from) {
+     stopifnot(is(from, "nMatrix"))
+     fixupDense(new(sub("^n", "d", class(from)),
+                    x = as.double(from@x),
+                    Dim = from@Dim, Dimnames = from@Dimnames),
+                from)
+     ## FIXME: treat 'factors' smartly {not for triangular!}
+ }
+ n2l_spMatrix <- function(from) {
+     stopifnot(is(from, "nMatrix"))
+     new(sub("^n", "l", class(from)),
+         ##x = as.double(from@x),
+         Dim = from@Dim, Dimnames = from@Dimnames)
+ }
  if(FALSE)# unused
  l2d_meth <- function(x) {
      cl <- class(x)
      as(callGeneric(as(x, sub("^l", "d", cl))), cl)
  }
- ## return "d" or "l" or "z"
+ ## return "d" or "l" or "n" or "z"
  .M.kind <- function(x, clx = class(x)) {
      if(is.matrix(x)) { ## 'old style matrix'
          if     (is.numeric(x)) "d"
-         else if(is.logical(x)) "l"
+         else if(is.logical(x)) "l" ## FIXME ? "n" if no NA ??
          else if(is.complex(x)) "z"
          else stop("not yet implemented for matrix w/ typeof ", typeof(x))
      }
      else if(extends(clx, "dMatrix")) "d"
+     else if(extends(clx, "nMatrix")) "n"
      else if(extends(clx, "lMatrix")) "l"
      else if(extends(clx, "zMatrix")) "z"
+     else if(extends(clx, "pMatrix")) "n" # permutation -> pattern
      else stop(" not yet be implemented for ", clx)
  }
-Line 362
+Line 399
  geClass <- function(x) {
      if     (is(x, "dMatrix")) "dgeMatrix"
      else if(is(x, "lMatrix")) "lgeMatrix"
+     else if(is(x, "nMatrix")) "ngeMatrix"
      else if(is(x, "zMatrix")) "zgeMatrix"
      else stop("general Matrix class not yet implemented for ",
                class(x))
-Line 382
+Line 420
      as(x, paste(.M.kind(x), .dense.prefixes[.M.shape(x)], "Matrix", sep=''))
  }
+ .sp.class <- function(x) { ## find and return the "sparseness class"
+     if(!is.character(x)) x <- class(x)
+     for(cl in paste(c("C","T","R"), "sparseMatrix", sep=''))
+         if(extends(x, cl))
+             return(cl)
+     ## else (should rarely happen)
+     as.character(NA)
+ }
  as_Csparse <- function(x) {
      as(x, paste(.M.kind(x), .sparse.prefixes[.M.shape(x)], "CMatrix", sep=''))
  }

 Legend:



Removed from v.1547
 


changed lines


 
Added in v.1548
 Legend:



Removed from v.1547
 


changed lines


 
Added in v.1548
-Removed from v.1547
+Added in v.1548

R-Forge@R-project.org	ViewVC Help
Powered by ViewVC 1.0.0