Bugfix

R/rowCounts.R

@@ -175,7 +175,11 @@ rowAlls <- function(x, value=TRUE, na.rm=FALSE, dim.=dim(x), ...) {
     counts <- .Call("rowCounts", x, dim., value, 0L, na.rm, hasNAs, PACKAGE="matrixStats")
     as.logical(counts)
   } else {
-    rowAlls(x == value, na.rm=na.rm, dim.=dim., ...)
+    if (is.na(value)) {
+      rowAlls(is.na(x), na.rm=na.rm, dim.=dim., ...)
+    } else {
+      rowAlls(x == value, na.rm=na.rm, dim.=dim., ...)
+    }
   }
 }
 
@@ -186,7 +190,11 @@ colAlls <- function(x, value=TRUE, na.rm=FALSE, dim.=dim(x), ...) {
     counts <- .Call("colCounts", x, dim., value, 0L, na.rm, hasNAs, PACKAGE="matrixStats")
     as.logical(counts)
   } else {
-    colAlls(x == value, na.rm=na.rm, dim.=dim., ...)
+    if (is.na(value)) {
+      colAlls(is.na(x), na.rm=na.rm, dim.=dim., ...)
+    } else {
+      colAlls(x == value, na.rm=na.rm, dim.=dim., ...)
+    }
   }
 }
 
@@ -198,7 +206,11 @@ allValue <- function(x, value=TRUE, na.rm=FALSE, ...) {
     counts <- .Call("count", x, value, 0L, na.rm, hasNAs, PACKAGE="matrixStats")
     as.logical(counts)
   } else {
-    allValue(x == value, na.rm=na.rm, ...)
+    if (is.na(value)) {
+      allValue(is.na(x), na.rm=na.rm, ...)
+    } else {
+      allValue(x == value, na.rm=na.rm, ...)
+    }
   }
 }
 
@@ -211,7 +223,11 @@ rowAnys <- function(x, value=TRUE, na.rm=FALSE, dim.=dim(x), ...) {
     counts <- .Call("rowCounts", x, dim., value, 1L, na.rm, hasNAs, PACKAGE="matrixStats")
     as.logical(counts)
   } else {
-    rowAnys(x == value, na.rm=na.rm, dim.=dim., ...)
+    if (is.na(value)) {
+      rowAnys(is.na(x), na.rm=na.rm, dim.=dim., ...)
+    } else {
+      rowAnys(x == value, na.rm=na.rm, dim.=dim., ...)
+    }
   }
 }
 
@@ -222,7 +238,11 @@ colAnys <- function(x, value=TRUE, na.rm=FALSE, dim.=dim(x), ...) {
     counts <- .Call("colCounts", x, dim., value, 1L, na.rm, hasNAs, PACKAGE="matrixStats")
     as.logical(counts)
   } else {
-    colAnys(x == value, na.rm=na.rm, dim.=dim., ...)
+    if (is.na(value)) {
+      colAnys(is.na(x), na.rm=na.rm, dim.=dim., ...)
+    } else {
+      colAnys(x == value, na.rm=na.rm, dim.=dim., ...)
+    }
   }
 }
 
@@ -234,7 +254,11 @@ anyValue <- function(x, value=TRUE, na.rm=FALSE, ...) {
     counts <- .Call("count", x, value, 1L, na.rm, hasNAs, PACKAGE="matrixStats")
     as.logical(counts)
   } else {
-    anyValue(x == value, na.rm=na.rm, ...)
+    if (is.na(value)) {
+      anyValue(is.na(x), na.rm=na.rm, ...)
+    } else {
+      anyValue(x == value, na.rm=na.rm, ...)
+    }
   }
 }
 

src/rowCounts_TYPE-template.h

@@ -101,7 +101,7 @@ void METHOD_NAME(X_C_TYPE *x, R_xlen_t nrow, R_xlen_t ncol, X_C_TYPE value, int
       for (jj=0; jj < ncol; jj++) {
         for (ii=0; ii < nrow; ii++) {
           /* Skip? */
-          if (ans[ii]) {
+          if (ans[ii] && ans[ii] != NA_INTEGER) {
             kk++;
 	  } else {
             xvalue = x[kk++];

tests/rowAllAnys.R

@@ -1,11 +1,19 @@
 library("matrixStats")
 
 rowAlls_R <- function(x, value=TRUE, na.rm=FALSE, ...) {
-  apply((x == value), MARGIN=1L, FUN=all, na.rm=na.rm)
+  if (is.na(value)) {
+    apply(is.na(x), MARGIN=1L, FUN=all, na.rm=na.rm)
+  } else {
+    apply((x == value), MARGIN=1L, FUN=all, na.rm=na.rm)
+  }
 }
 
 rowAnys_R <- function(x, value=TRUE, na.rm=FALSE, ...) {
-  apply((x == value), MARGIN=1L, FUN=any, na.rm=na.rm)
+  if (is.na(value)) {
+    apply(is.na(x), MARGIN=1L, FUN=any, na.rm=na.rm)
+  } else {
+    apply((x == value), MARGIN=1L, FUN=any, na.rm=na.rm)
+  }
 }
 
 rowAnyMissings_R <- function(x, ...) {
@@ -103,6 +111,22 @@ for (na.rm in c(FALSE, TRUE)) {
 }
 
 
+all_R <- function(x, value=TRUE, ...) {
+  if (is.na(value)) {
+    all(is.na(x), ...)
+  } else {
+    all(x == value, ...)
+  }
+}
+
+any_R <- function(x, value=TRUE, ...) {
+  if (is.na(value)) {
+    any(is.na(x), ...)
+  } else {
+    any(x == value, ...)
+  }
+}
+
 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 # Data type: character (not sure if this should be supported)
 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -111,33 +135,46 @@ x[2,] <- "g"
 x[2:4,3:4] <- NA_character_
 
 # Row/column counts
-value <- "g"
-for (na.rm in c(FALSE, TRUE)) {
-  ## All
-  r0 <- rowAlls_R(x, value=value, na.rm=na.rm)
-  r1 <- rowAlls(x, value=value, na.rm=na.rm)
-  r2 <- colAlls(t(x), value=value, na.rm=na.rm)
-  stopifnot(identical(r1, r0))
-  stopifnot(identical(r2, r1))
-
-  for (rr in seq_len(nrow(x))) {
-    c0 <- all((x[rr,] == value), na.rm=na.rm)
-    c <- allValue(x[rr,], value=value, na.rm=na.rm)
-    stopifnot(identical(c,r1[rr]))
-    stopifnot(identical(c,c0))
+for (value in c("g", NA_character_)) {
+  for (na.rm in c(FALSE, TRUE)) {
+    ## All
+    r0 <- rowAlls_R(x, value=value, na.rm=na.rm)
+    r1 <- rowAlls(x, value=value, na.rm=na.rm)
+    r2 <- colAlls(t(x), value=value, na.rm=na.rm)
+    stopifnot(identical(r1, r0))
+    stopifnot(identical(r2, r1))
+
+    for (rr in seq_len(nrow(x))) {
+      c0 <- all_R(x[rr,], value, na.rm=na.rm)
+      c <- allValue(x[rr,], value=value, na.rm=na.rm)
+      stopifnot(identical(c,r1[rr]))
+      stopifnot(identical(c,c0))
+    }
+
+    ## Any
+    r0 <- rowAnys_R(x, value=value, na.rm=na.rm)
+    r1 <- rowAnys(x, value=value, na.rm=na.rm)
+    r2 <- colAnys(t(x), value=value, na.rm=na.rm)
+    stopifnot(identical(r1, r0))
+    stopifnot(identical(r2, r1))
+
+    for (rr in seq_len(nrow(x))) {
+      c0 <- any_R(x[rr,], value, na.rm=na.rm)
+      c <- anyValue(x[rr,], value=value, na.rm=na.rm)
+      stopifnot(identical(c,c0))
+      stopifnot(identical(c,r1[rr]))
+    }
   }
+}
 
-  ## Any
-  r0 <- rowAnys_R(x, value=value, na.rm=na.rm)
-  r1 <- rowAnys(x, value=value, na.rm=na.rm)
-  r2 <- colAnys(t(x), value=value, na.rm=na.rm)
-  stopifnot(identical(r1, r0))
-  stopifnot(identical(r2, r1))
 
-  for (rr in seq_len(nrow(x))) {
-    c0 <- any((x[rr,] == value), na.rm=na.rm)
-    c <- anyValue(x[rr,], value=value, na.rm=na.rm)
-    stopifnot(identical(c,c0))
-    stopifnot(identical(c,r1[rr]))
-  }
-}
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# NA 0 test
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+x <- matrix(0, nrow=3, ncol=3)
+x[1,] <- c(NA, NA, 0)
+x[3,] <- c(1, 0, 1)
+
+r0 <- rowAnys_R(x, value=0)
+r1 <- rowAnys(x, value=0)
+stopifnot(identical(r0, r1))