# SCM Repository

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

# Diff of /pkg/R/Auxiliaries.R

revision 1571, Sat Sep 16 21:03:12 2006 UTC revision 1575, Mon Sep 18 14:47:40 2006 UTC
# Line 5  Line 5
5
6  ## Need to consider NAs ;  "== 0" even works for logical & complex:  ## Need to consider NAs ;  "== 0" even works for logical & complex:
7  is0  <- function(x) !is.na(x) & x == 0  is0  <- function(x) !is.na(x) & x == 0
8    isN0 <- function(x)  is.na(x) | x != 0
9  all0 <- function(x) !any(is.na(x)) && all(x == 0)  all0 <- function(x) !any(is.na(x)) && all(x == 0)
10
11  allTrue  <- function(x) !any(is.na(x)) && all(x)  allTrue  <- function(x) !any(is.na(x)) && all(x)
# Line 165  Line 166
166      invisible(x)# as print() S3 methods do      invisible(x)# as print() S3 methods do
167  }  }
168
169    nonFALSE <- function(x) {
170        ## typically used for lMatrices:  (TRUE,NA,FALSE) |-> (TRUE,FALSE)
171        if(any(ix <- is.na(x))) x[ix] <- TRUE
172        x
173    }
174
175    nz.NA <- function(x, na.value) {
176        ## Non-Zeros of x
177        ## na.value: TRUE: NA's give TRUE, they are not 0
178        ##             NA: NA's are not known ==> result := NA
179        ##          FALSE: NA's give FALSE, could be 0
180        stopifnot(is.logical(na.value) && length(na.value) == 1)
181        if(is.na(na.value)) x != 0
182        else  if(na.value)  isN0(x)
183        else                x != 0 & !is.na(x)
184    }
185
186  ### FIXME? -- make this into a generic function (?)  ### FIXME? -- make this into a generic function (?)
187  nnzero <- function(x) {  nnzero <- function(x, na.counted = NA) {
188        ## na.counted: TRUE: NA's are counted, they are not 0
189        ##               NA: NA's are not known (0 or not) ==>  result := NA
190        ##            FALSE: NA's are omitted before counting
191      cl <- class(x)      cl <- class(x)
192      if(!extends(cl, "Matrix"))      if(!extends(cl, "Matrix"))
193          sum(x != 0)          sum(nz.NA(x, na.counted))
194      else if(extends(cl, "sparseMatrix"))      else if(extends(cl, "sparseMatrix"))
195          ## NOTA BENE: The number of *structural* non-zeros {could have other '0'}!          ## NOTA BENE: The number of *structural* non-zeros {could have other '0'}!
196         switch(.sp.class(cl),         switch(.sp.class(cl),
# Line 177  Line 198
198                 "TsparseMatrix" = length(x@i),                 "TsparseMatrix" = length(x@i),
199                 "RsparseMatrix" = length(x@j))                 "RsparseMatrix" = length(x@j))
200      else ## denseMatrix      else ## denseMatrix
201          sum(as_geClass(x)@x != 0)          sum(nz.NA(as_geClass(x, cl)@x, na.counted))
202  }  }
203
204  ## For sparseness handling  ## For sparseness handling
# Line 186  Line 207
207  non0ind <- function(x) {  non0ind <- function(x) {
208
209      if(is.numeric(x))      if(is.numeric(x))
210          return(if((n <- length(x))) (0:(n-1))[x != 0] else integer(0))          return(if((n <- length(x))) (0:(n-1))[isN0(x)] else integer(0))
211      ## else      ## else
212      stopifnot(is(x, "sparseMatrix"))      stopifnot(is(x, "sparseMatrix"))
213      non0.i <- function(M) {      non0.i <- function(M) {

Legend:
 Removed from v.1571 changed lines Added in v.1575