add na.rm to utils.clean; see #210

lgatto · Jun 20, 2017 · b6cafc2 · b6cafc2
1 parent cdfd21f
commit b6cafc2
Show file tree

Hide file tree

Showing 2 changed files with 53 additions and 5 deletions.
diff --git a/R/utils.R b/R/utils.R
@@ -112,6 +112,7 @@ utils.removePrecMz_list <- function(object,
 #'
 #' @param x \code{numeric}, vector to be cleaned
 #' @param all \code{logical}, should all zeros be removed?
+#' @param na.rm \code{logical}, should NAs removed before looking for zeros?
 #' @return logical vector, \code{TRUE} for keeping the value
 #' @note The return value for \code{NA} is always \code{FALSE}.
 #' @examples
@@ -121,16 +122,37 @@ utils.removePrecMz_list <- function(object,
 #'        FALSE, FALSE)
 #' stopifnot(utils.clean(x) == r)
 #' @noRd
-utils.clean <- function(x, all=FALSE) {
-  notZero <- x != 0 & !is.na(x)
+utils.clean <- function(x, all=FALSE, na.rm=FALSE) {
+  notNA <- !is.na(x)
+  notZero <- x != 0 & notNA
 
   if (all) {
     notZero
+  } else if (na.rm) {
+    notNA[notNA] <- utils.enableNeighbours(notZero[notNA])
+    notNA
   } else {
-    notZero | c(notZero[-1], FALSE) | c(FALSE, notZero[-length(notZero)])
+    utils.enableNeighbours(notZero)
   }
 }
 
+#' Switch FALSE to TRUE in the direct neighborhod of TRUE.
+#' (used in utils.clean)
+#'
+#' @param x logical
+#' @return logical
+#' @examples
+#' x <- c(TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
+#'        FALSE, FALSE)
+#' r <- c(TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
+#'        FALSE, FALSE)
+#' stopifnot(utils.enableNeighbours(x) == r)
+#' @noRd
+utils.enableNeighbours <- function(x) {
+  stopifnot(is.logical(x))
+  x | c(x[-1], FALSE) | c(FALSE, x[-length(x)])
+}
+
 zoom <- function(x, w = 0.05) {
     new("ReporterIons",
         mz = x,

diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R
@@ -285,13 +285,16 @@ test_that("clean utils", {
               c(0, 0, 0, 1, 0, 0, 1, 0, 0, 0),
               c(0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0),
               c(0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0),
-              c(1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0))
+              c(1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0),
+              c(1, NA, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, NA, 1, 0, 0, 0))
     a <- list(c(FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE),
               c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE,
                 FALSE),
               c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE,
                 FALSE, FALSE), c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE,
                 FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE),
+              c(TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE,
+                TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE),
               c(TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE,
                 TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE))
     b <- list(c(FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE),
@@ -301,17 +304,40 @@ test_that("clean utils", {
                 FALSE, FALSE),
               c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE,
                 TRUE, TRUE, TRUE, FALSE, FALSE),
+              c(TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
+                TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE),
               c(TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
                 TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE))
-
+    d <- list(c(FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE),
+              c(FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE,
+                FALSE),
+              c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE,
+                FALSE, FALSE),
+              c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE,
+                TRUE, TRUE, TRUE, FALSE, FALSE),
+              c(TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
+                TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE),
+              c(TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
+                TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE))
     for (i in seq(along=x)) {
       expect_identical(MSnbase:::utils.clean(x[[i]], all=TRUE), a[[i]],
                        label=paste0("all=TRUE, i=", i))
       expect_identical(MSnbase:::utils.clean(x[[i]], all=FALSE), b[[i]],
                        label=paste0("all=FALSE, i=", i))
+      expect_identical(MSnbase:::utils.clean(x[[i]], na.rm=TRUE), d[[i]],
+                       label=paste0("na.rm=TRUE, i=", i))
     }
 })
 
+test_that("enableNeighbours utils", {
+    expect_error(MSnbase:::utils.enableNeighbours(1:10))
+    expect_error(MSnbase:::utils.enableNeighbours(LETTERS[1:10]))
+    expect_equal(MSnbase:::utils.enableNeighbours(c(FALSE, TRUE, FALSE)),
+                 rep(TRUE, 3))
+    expect_equal(MSnbase:::utils.enableNeighbours(c(FALSE, TRUE, FALSE, FALSE)),
+                 c(rep(TRUE, 3), FALSE))
+})
+
 test_that("getBpParam", {
     ## Testing the global MSnbase option PARALLEL_THRESH
     orig_val <- options()$MSnbase$PARALLEL_THRESH