From 849bc4bc175c7c9addd2811245f4f9513890ae66 Mon Sep 17 00:00:00 2001
From: Gregory Demin <gdemin@gmail.com>
Date: Sun, 15 Nov 2020 23:24:30 +0300
Subject: [PATCH] Add 'is_na' criterion. 'when' now accepts any values and try
 to convert it to criterion

---
 NAMESPACE                                |  1 +
 R/criteria_functions.R                   | 15 +++++++++++++--
 man/criteria.Rd                          |  3 +++
 tests/testthat/test_criteria_functions.R |  7 +++++++
 4 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 12622db..2cf237b 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/criteria_functions.R b/R/criteria_functions.R
index ef365ec..9e792de 100644
--- a/R/criteria_functions.R
+++ b/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){
diff --git a/man/criteria.Rd b/man/criteria.Rd
index 78f7e6c..acc87d1 100644
--- a/man/criteria.Rd
+++ b/man/criteria.Rd
@@ -34,6 +34,7 @@
 \alias{to}
 \alias{items}
 \alias{not_na}
+\alias{is_na}
 \alias{other}
 \alias{and}
 \alias{or}
@@ -110,6 +111,8 @@ items(...)
 
 not_na(x)
 
+is_na(x)
+
 other(x)
 
 and(...)
diff --git a/tests/testthat/test_criteria_functions.R b/tests/testthat/test_criteria_functions.R
index 014966b..0d197e0 100644
--- a/tests/testthat/test_criteria_functions.R
+++ b/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)