Add 'is_na' criterion. 'when' now accepts any values and try to conve…

…rt it to criterion

NAMESPACE

@@ -481,6 +481,7 @@ export(is.labelled)
 export(is.with_caption)
 export(is_max)
 export(is_min)
+export(is_na)
 export(items)
 export(keep)
 export(key)

R/criteria_functions.R

@@ -291,8 +291,7 @@ thru = function(lower, upper){
 #' @rdname criteria
 when = function(x) {
     if(is.criterion(x)) return(x)
-    if(is.function(x)) return(as.criterion(x))
-    is.logical(x) || stop("'when' - argument should be logical, criterion or function.")
+    if(!is.logical(x)) return(as.criterion(x))
 
     x = x & !is.na(x) # always FALSE when NA
     as.criterion(function(y) {
@@ -439,6 +438,18 @@ not_na = function(x){
 
 class(not_na) = union("criterion", class(not_na))
 
+#' @export
+#' @rdname criteria
+is_na = function(x){
+    if(missing(x)){
+        is_na
+    } else {
+        is.na(x)
+    }    
+}
+
+class(is_na) = union("criterion", class(is_na))
+
 #' @export
 #' @rdname criteria
 other = function(x){

tests/testthat/test_criteria_functions.R

@@ -34,9 +34,16 @@ logi_crit = when(c(TRUE, FALSE, FALSE, TRUE))
 expect_identical(logi_crit(1:4), c(TRUE, FALSE, FALSE, TRUE))
 expect_identical(when(is.numeric)(c(1,2,3)), TRUE)
 expect_identical(when(is.numeric)(TRUE), FALSE)
+expect_identical(when(1:2)(1:3), c(TRUE, TRUE, FALSE))
 expect_identical(when(not_na)(1), TRUE)
 expect_identical(when(not_na)(NA), FALSE)
 
+expect_identical(when(is_na)(1), FALSE)
+expect_identical(when(is_na)(NA), TRUE)
+expect_identical(when(is_na())(1), FALSE)
+expect_identical(when(is_na())(NA), TRUE)
+expect_identical(is_na(1), FALSE)
+expect_identical(is_na(NA), TRUE)
 
 fun_crit = as.criterion(function(x) x>2)