nnzero.R
#### Number of "structural" non-zeros --- this is nnzmax() in Matlab
#### of effectively non-zero values = nnz() " "
## Our nnzero() is like Matlab's nnz() -- but more sophisticated because of NAs
## New: generic function instead of if(..) ... else if(..) ......
##
## na.counted: TRUE : NA's are counted, they are not 0
## NA : NA's are not known (0 or not) ==> result := NA
## FALSE: NA's are omitted before counting
## "Default" : for non-"Matrix" (e.g. classical matrices):
setMethod("nnzero", "ANY",
function(x, na.counted = NA) sum(nz.NA(x, na.counted)))
setMethod("nnzero", "diagonalMatrix",
function(x, na.counted = NA) sum(nz.NA(diag(x), na.counted)))
setMethod("nnzero", "pMatrix", function(x, na.counted = NA) x@Dim[1])
## other (not "pMatrix", not "diagonalMatrix") "sparseMatrix":
setMethod("nnzero", "sparseMatrix",
function(x, na.counted = NA)
{
d <- x@Dim
if(any(d == 0)) return(0L)
cl <- class(x)
## speedup:
cld <- getClassDef(cl)
n <- d[1]
iSym <- extends(cld, "symmetricMatrix")
iTri <- if(iSym) FALSE else extends(cld, "triangularMatrix")
nn <- switch(.sp.class(cl),
"CsparseMatrix" = x@p[d[2]+1L],# == length(x@i) only if not over-alloc.
"TsparseMatrix" = {
if(is_duplicatedT(x, di = d))
x <- .Call(Tsparse_to_Csparse, x, iTri)
length(x@i)
},
"RsparseMatrix" = x@p[n+1L])
if(!extends(cld, "nMatrix")) # <==> has 'x' slot : consider NAs in it:
nn <- sum(nz.NA(if(nn < length(x@x)) x@x[seq_len(nn)] else x@x,
na.counted))
if(iSym)
nn+nn - sum(nz.NA(diag(x), na.counted))
else if(iTri && x@diag == "U")
nn + n else nn
})
setMethod("nnzero", "denseMatrix",
function(x, na.counted = NA)
{
d <- x@Dim
if(any(d == 0)) return(0L)
cl <- class(x)
## speedup:
cld <- getClassDef(cl)
n <- d[1]
iSym <- extends(cld, "symmetricMatrix")
## dense, not diagonal: Can use 'x' slot;
if(iSym || extends(cld, "triangularMatrix")) {
## now !iSym <==> "triangularMatrix"
upper <- (x@uplo == "U")
if(length(x@x) < n*n) { ## packed symmetric | triangular
if(iSym) {
## indices of *diagonal* entries for packed :
iDiag <- cumsum(if(upper) 1:n else c(1L, if(n > 1)n:2))
## symmetric packed: count off-diagonals *twice*
2L* sum(nz.NA(x@x[-iDiag], na.counted)) +
sum(nz.NA(x@x[ iDiag], na.counted))
}
else ## triangular packed
sum(nz.NA(x@x, na.counted))
}
else {
## not packed, but may have "arbitrary"
## entries in the non-relevant upper/lower triangle
s <- sum(nz.NA(x@x[indTri(n, upper=upper)], na.counted))
(if(iSym) 2L * s else s) +
(if(!iSym && x@diag == "U")
n else sum(nz.NA(x@x[indDiag(n)], na.counted)))
}
}
else { ## dense general <--> .geMatrix
sum(nz.NA(x@x, na.counted))
}
})
## Working via sparse*:
setMethod("nnzero", "CHMfactor",
function(x, na.counted = NA)
nnzero(as(x,"sparseMatrix"), na.counted=na.counted))