Add .unmatched to case_when() (#7737)

* Add `.unmatched` to `case_when()`

* Regenerate snapshots with r-lib/vctrs#2063

Author: DavisVaughan

NEWS.md

@@ -1,5 +1,7 @@
 # dplyr (development version)
 
+* `case_when()` has gained a new `.unmatched` argument. For extra safety, set `.unmatched = "error"` rather than providing a `.default` when you believe that you've handled every possible case, and it will error if a case is left unhandled. The new `recode_values()` also has this argument (#7653).
+
 * New `rbind()` method for `rowwise_df` to avoid creating corrupt rowwise data frames (r-lib/vctrs#1935).
 
 * `case_match()` is now superseded by `recode_values()` and `replace_values()`.

R/case-when.R

@@ -60,6 +60,14 @@
 #'   `.default`. This typically involves some variation of `is.na(x) ~ value`
 #'   tailored to your usage of `case_when()`.
 #'
+#' @param .unmatched Handling of unmatched locations.
+#'
+#'   One of:
+#'
+#'   - `"default"` to use `.default` in unmatched locations.
+#'
+#'   - `"error"` to error when there are unmatched locations.
+#'
 #' @param .ptype An optional prototype declaring the desired output type. If
 #'   supplied, this overrides the common type of the RHS inputs.
 #'
@@ -116,6 +124,46 @@
 #'   .default = as.character(x)
 #' )
 #'
+#' # If you believe that you've covered every possible case, then set
+#' # `.unmatched = "error"` rather than supplying a `.default`. This adds an
+#' # extra layer of safety to `case_when()` and is particularly useful when you
+#' # have a series of complex expressions!
+#' set.seed(123)
+#' x <- sample(50)
+#'
+#' # Oops, we forgot to handle `50`
+#' try(case_when(
+#'   x < 10 ~ "ten",
+#'   x < 20 ~ "twenty",
+#'   x < 30 ~ "thirty",
+#'   x < 40 ~ "forty",
+#'   x < 50 ~ "fifty",
+#'   .unmatched = "error"
+#' ))
+#'
+#' case_when(
+#'   x < 10 ~ "ten",
+#'   x < 20 ~ "twenty",
+#'   x < 30 ~ "thirty",
+#'   x < 40 ~ "forty",
+#'   x <= 50 ~ "fifty",
+#'   .unmatched = "error"
+#' )
+#'
+#' # Note that `NA` is considered unmatched and must be handled with its own
+#' # explicit case, even if that case just propagates the missing value!
+#' x[c(2, 5)] <- NA
+#'
+#' case_when(
+#'   x < 10 ~ "ten",
+#'   x < 20 ~ "twenty",
+#'   x < 30 ~ "thirty",
+#'   x < 40 ~ "forty",
+#'   x <= 50 ~ "fifty",
+#'   is.na(x) ~ NA,
+#'   .unmatched = "error"
+#' )
+#'
 #' # `replace_when()` is useful when you're updating an existing vector,
 #' # rather than creating an entirely new one. Note the so-far unused "puppy"
 #' # factor level:
@@ -216,7 +264,13 @@ NULL
 
 #' @rdname case-and-replace-when
 #' @export
-case_when <- function(..., .default = NULL, .ptype = NULL, .size = NULL) {
+case_when <- function(
+  ...,
+  .default = NULL,
+  .unmatched = "default",
+  .ptype = NULL,
+  .size = NULL
+) {
   args <- eval_formulas(..., allow_empty_dots = FALSE)
   conditions <- args$lhs
   values <- args$rhs
@@ -236,6 +290,7 @@ case_when <- function(..., .default = NULL, .ptype = NULL, .size = NULL) {
     conditions = conditions,
     values = values,
     default = .default,
+    unmatched = .unmatched,
     ptype = .ptype,
     size = .size,
     conditions_arg = "",

man/case-and-replace-when.Rd

@@ -62,6 +62,75 @@
       Error in `case_when()`:
       ! Can't recycle `..1 (right)` (size 2) to size 3.
 
+# can't supply `.default` and `.unmatched`
+
+    Code
+      case_when(TRUE ~ 1, .default = 1, .unmatched = "error")
+    Condition
+      Error in `case_when()`:
+      ! Can't set `.default` when `unmatched = "error"`.
+
+# `.unmatched` is validated
+
+    Code
+      case_when(TRUE ~ 1, .unmatched = "foo")
+    Condition
+      Error in `case_when()`:
+      ! `unmatched` must be either "default" or "error", not "foo".
+
+---
+
+    Code
+      case_when(TRUE ~ 1, .unmatched = 1)
+    Condition
+      Error in `case_when()`:
+      ! `unmatched` must be a string, not the number 1.
+
+# `.unmatched` treats `FALSE` like an unmatched location
+
+    Code
+      case_when(c(TRUE, FALSE, TRUE) ~ 1, .unmatched = "error")
+    Condition
+      Error in `case_when()`:
+      ! Each location must be matched.
+      x Location 2 is unmatched.
+
+# `.unmatched` treats `NA` like an unmatched location
+
+    Code
+      case_when(c(TRUE, NA, TRUE) ~ 1, .unmatched = "error")
+    Condition
+      Error in `case_when()`:
+      ! Each location must be matched.
+      x Location 2 is unmatched.
+
+# `.unmatched` errors pluralize well
+
+    Code
+      case_when(x == "a" ~ 1, x == "b" ~ 2, x == "c" ~ 3, x == "e" ~ 4, .unmatched = "error")
+    Condition
+      Error in `case_when()`:
+      ! Each location must be matched.
+      x Location 4 is unmatched.
+
+---
+
+    Code
+      case_when(x == "a" ~ 1, x == "c" ~ 2, x == "e" ~ 3, .unmatched = "error")
+    Condition
+      Error in `case_when()`:
+      ! Each location must be matched.
+      x Locations 2 and 4 are unmatched.
+
+---
+
+    Code
+      case_when(x == 1 ~ "a", .unmatched = "error")
+    Condition
+      Error in `case_when()`:
+      ! Each location must be matched.
+      x Locations 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, ..., 99, and 100 are unmatched.
+
 # invalid type errors are correct (#6261) (#6206)
 
     Code

tests/testthat/_snaps/case-when.md

@@ -247,6 +247,74 @@ test_that("passes through `.size` correctly", {
   })
 })
 
+test_that("can't supply `.default` and `.unmatched`", {
+  # Probably overkill to add `unmatched_arg` just to get `.unmatched` instead
+  # of `unmatched`.
+  expect_snapshot(error = TRUE, {
+    case_when(TRUE ~ 1, .default = 1, .unmatched = "error")
+  })
+})
+
+test_that("`.unmatched` is validated", {
+  # Probably overkill to add `unmatched_arg` to `vec_case_when()` just to get
+  # `.unmatched` instead of `unmatched`
+  expect_snapshot(error = TRUE, {
+    case_when(TRUE ~ 1, .unmatched = "foo")
+  })
+  expect_snapshot(error = TRUE, {
+    case_when(TRUE ~ 1, .unmatched = 1)
+  })
+})
+
+test_that("`.unmatched` treats `FALSE` like an unmatched location", {
+  expect_snapshot(error = TRUE, {
+    case_when(
+      c(TRUE, FALSE, TRUE) ~ 1,
+      .unmatched = "error"
+    )
+  })
+})
+
+test_that("`.unmatched` treats `NA` like an unmatched location", {
+  expect_snapshot(error = TRUE, {
+    case_when(
+      c(TRUE, NA, TRUE) ~ 1,
+      .unmatched = "error"
+    )
+  })
+})
+
+test_that("`.unmatched` errors pluralize well", {
+  # One location
+  x <- letters[1:5]
+  expect_snapshot(error = TRUE, {
+    case_when(
+      x == "a" ~ 1,
+      x == "b" ~ 2,
+      x == "c" ~ 3,
+      x == "e" ~ 4,
+      .unmatched = "error"
+    )
+  })
+
+  # Two locations
+  x <- letters[1:5]
+  expect_snapshot(error = TRUE, {
+    case_when(
+      x == "a" ~ 1,
+      x == "c" ~ 2,
+      x == "e" ~ 3,
+      .unmatched = "error"
+    )
+  })
+
+  # Many locations
+  x <- 1:100
+  expect_snapshot(error = TRUE, {
+    case_when(x == 1 ~ "a", .unmatched = "error")
+  })
+})
+
 # `case_when()` errors ---------------------------------------------------------
 
 test_that("invalid type errors are correct (#6261) (#6206)", {