Merge pull request #617 from yjunechoe/col_vals_expr-na_pass

Add `na_pass` argument to `col_vals_expr()`

Author: yjunechoe

NEWS.md

@@ -1,5 +1,7 @@
 # pointblank (development version)
 
+- Add `na_pass` to `col_vals_expr()` for finer control of `NA` values. Previously, `NA`s were ignored, but now they are caught as failures with the default `na_pass = FALSE`. As a safeguard, if an expression generates `NA` values while `na_pass` is not explicitly supplied, a warning is thrown. (#617)
+
 - Bugfix agents auto-generating a table label that was too long. They now get truncated (#614)
 
 - Bugfix agents not searching the formula environment when materializing `~ tbl` (#599)

R/col_vals_expr.R

@@ -68,6 +68,13 @@
 #' formally tested (so be mindful of this when using unsupported backends with
 #' **pointblank**).
 #'
+#' @section Missing Values:
+#'
+#' This validation function supports special handling of `NA` values. The
+#' `na_pass` argument will determine whether an `NA` value appearing in a test
+#' unit should be counted as a *pass* or a *fail*. The default of `na_pass =
+#' FALSE` means that any `NA`s encountered will accumulate failing test units.
+#'
 #' @section Preconditions:
 #'
 #' Providing expressions as `preconditions` means **pointblank** will preprocess
@@ -313,6 +320,7 @@ NULL
 col_vals_expr <- function(
     x,
     expr,
+    na_pass = FALSE,
     preconditions = NULL,
     segments = NULL,
     actions = NULL,
@@ -322,6 +330,11 @@ col_vals_expr <- function(
     active = TRUE
 ) {
 
+  # Mark if unspecified and resolve the default behavior at interrogate
+  if (missing(na_pass)) {
+    na_pass <- NA
+  }
+
   if (!inherits(expr, "call")) {
 
     if (rlang::is_formula(expr)) {
@@ -353,6 +366,7 @@ col_vals_expr <- function(
       create_agent(x, label = "::QUIET::") %>%
       col_vals_expr(
         expr = expr,
+        na_pass = na_pass,
         preconditions = preconditions,
         segments = segments,
         label = label,
@@ -400,6 +414,7 @@ col_vals_expr <- function(
         columns_expr = NA_character_,
         column = NA_character_,
         values = expr,
+        na_pass = na_pass,
         preconditions = preconditions,
         seg_expr = segments,
         seg_col = seg_col,
@@ -421,16 +436,23 @@ col_vals_expr <- function(
 expect_col_vals_expr <- function(
     object,
     expr,
+    na_pass = FALSE,
     preconditions = NULL,
     threshold = 1
 ) {
 
+  # Mark if unspecified and resolve the default behavior at interrogate
+  if (missing(na_pass)) {
+    na_pass <- NA
+  }
+
   fn_name <- "expect_col_vals_expr"
 
   vs <-
     create_agent(tbl = object, label = "::QUIET::") %>%
     col_vals_expr(
       expr = {{ expr }},
+      na_pass = na_pass,
       preconditions = {{ preconditions }},
       actions = action_levels(notify_at = threshold)
     ) %>%
@@ -476,14 +498,21 @@ expect_col_vals_expr <- function(
 test_col_vals_expr <- function(
     object,
     expr,
+    na_pass = FALSE,
     preconditions = NULL,
     threshold = 1
 ) {
 
+  # Mark if unspecified and resolve the default behavior at interrogate
+  if (missing(na_pass)) {
+    na_pass <- NA
+  }
+
   vs <-
     create_agent(tbl = object, label = "::QUIET::") %>%
     col_vals_expr(
       expr = {{ expr }},
+      na_pass = na_pass,
       preconditions = {{ preconditions }},
       actions = action_levels(notify_at = threshold)
     ) %>%

R/interrogate.R

@@ -2100,24 +2100,56 @@ interrogate_expr <- function(
   # Get the expression
   expr <- get_values_at_idx(agent = agent, idx = idx)
 
+  # Determine whether NAs should be allowed
+  na_pass <- get_column_na_pass_at_idx(agent = agent, idx = idx)
+
   # Create function for validating the `col_vals_expr()` step function
   tbl_val_expr <- function(
     table,
-    expr
+    expr,
+    na_pass
   ) {
 
     # Ensure that the input `table` is actually a table object
     tbl_validity_check(table = table)
 
     expr <- expr[[1]]
 
-    table %>%
-      dplyr::mutate(pb_is_good_ = !!expr) %>%
-      dplyr::filter(!is.na(pb_is_good_))
+    tbl <- table %>%
+      dplyr::mutate(pb_is_good_ = !!expr)
+
+    if (anyNA(tbl$pb_is_good_)) {
+
+      # Throw warning if `expr` results in `NA` values but `na_pass` was unset
+      if (is.na(na_pass)) {
+        warn(
+          paste(
+            "Expression generated `NA` value(s).",
+            "Edit the `expr` or specify `na_pass` (default is `FALSE`)."
+          ),
+          # "simpleWarning" lets it trickle up to the test/expect functions
+          class = "simpleWarning"
+        )
+        # Re-apply user-facing default of `na_pass = FALSE`
+        na_pass <- FALSE
+      }
+
+      tbl$pb_is_good_[is.na(tbl$pb_is_good_)] <- na_pass
+
+    }
+
+    tbl
+
   }
 
   # Perform rowwise validations for the column
-  pointblank_try_catch(tbl_val_expr(table = table, expr = expr))
+  pointblank_try_catch(
+    tbl_val_expr(
+      table = table,
+      expr = expr,
+      na_pass = na_pass
+    )
+  )
 }
 
 interrogate_specially <- function(

man/col_vals_expr.Rd

@@ -693,17 +693,17 @@ test_that("pointblank expectation function produce the correct results", {
   #
 
   expect_col_vals_expr(tbl, ~ a %% 1 == 0)
-  expect_col_vals_expr(tbl, ~ c %% 1 == 0)
+  expect_col_vals_expr(tbl, ~ c %% 1 == 0, na_pass = TRUE)
   expect_col_vals_expr(tbl, expr(a %% 1 == 0))
-  expect_col_vals_expr(tbl, expr(c %% 1 == 0))
+  expect_col_vals_expr(tbl, expr(c %% 1 == 0), na_pass = TRUE)
   expect_col_vals_expr(tbl, ~ case_when(
     b == 1 ~ a > 5 & c >= 1
-  ))
+  ), na_pass = TRUE)
   expect_col_vals_expr(tbl, expr(
     case_when(
       b == 1 ~ a > 5 & c >= 1
     )
-  ))
+  ), na_pass = TRUE)
 
   expect_success(expect_col_vals_expr(tbl, ~ a %% 1 == 0))
   expect_success(expect_col_vals_expr(tbl, ~ a %>% between(0, 10)))

tests/testthat/test-expectation_fns.R

@@ -2016,3 +2016,64 @@ test_that("Select validation steps can be `active` or not", {
       )
   )
 })
+
+test_that("col_vals_expr(na_pass) works as expected (#616)", {
+
+  agent <- small_table %>%
+    create_agent() %>%
+    col_vals_equal(c, 3) %>%
+    col_vals_expr(expr(c == 3), na_pass = FALSE) %>%
+    interrogate()
+
+  expect_identical(
+    agent$validation_set$tbl_checked[[1]][[1]],
+    agent$validation_set$tbl_checked[[2]][[1]]
+  )
+
+  agent <- small_table %>%
+    create_agent() %>%
+    col_vals_equal(c, 3, na_pass = TRUE) %>%
+    col_vals_expr(expr(c == 3), na_pass = TRUE) %>%
+    interrogate()
+
+  expect_identical(
+    agent$validation_set$tbl_checked[[1]][[1]],
+    agent$validation_set$tbl_checked[[2]][[1]]
+  )
+
+})
+
+test_that("col_vals_expr(na_pass) NA value handling (#617)", {
+
+  agent1 <- small_table %>%
+    create_agent() %>%
+    col_vals_expr(expr(c == 3)) %>%
+    interrogate()
+  expect_true(agent1$validation_set$eval_warning)
+
+  agent2 <- small_table %>%
+    create_agent() %>%
+    col_vals_expr(expr(c == 3), na_pass = FALSE) %>%
+    interrogate()
+  expect_false(agent2$validation_set$eval_warning)
+  expect_identical(
+    agent1$validation_set$tbl_checked,
+    agent2$validation_set$tbl_checked
+  )
+
+  # Warnings trickle up for test/expect functions
+  tbl <- data.frame(x = c(NA, 1))
+  expect_warning(
+    expect_false(
+      tbl %>%
+        test_col_vals_expr(expr(x == 1))
+    )
+  )
+  expect_warning(
+    expect_error(
+      tbl %>%
+        expect_col_vals_expr(expr(x == 1))
+    )
+  )
+
+})

tests/testthat/test-interrogate_with_agent.R

@@ -275,21 +275,21 @@ test_that("pointblank expectation functions produce the correct results", {
   #
 
   expect_true(test_col_vals_expr(tbl, ~ a %% 1 == 0))
-  expect_true(test_col_vals_expr(tbl, ~ c %% 1 == 0))
+  expect_true(test_col_vals_expr(tbl, ~ c %% 1 == 0, na_pass = TRUE))
   expect_true(test_col_vals_expr(tbl, expr(a %% 1 == 0)))
-  expect_true(test_col_vals_expr(tbl, expr(c %% 1 == 0)))
+  expect_true(test_col_vals_expr(tbl, expr(c %% 1 == 0), na_pass = TRUE))
 
   expect_true(
     test_col_vals_expr(tbl, ~ case_when(
       b == 1 ~ a > 5 & c >= 1
-    ))
+    ), na_pass = TRUE)
   )
   expect_true(
     test_col_vals_expr(tbl, expr(
       case_when(
         b == 1 ~ a > 5 & c >= 1
       )
-    ))
+    ), na_pass = TRUE)
   )
 
   expect_true(test_col_vals_expr(tbl, ~ a < 0, threshold = 1000))