Soft deprecate this case_when() behavior instead

Author: DavisVaughan

NEWS.md

@@ -1,6 +1,33 @@
 # dplyr (development version)
 
-* `case_when()` now determines the output size from only the LHS inputs, rather than from both the LHS and RHS inputs. This allows the legacy behavior of `TRUE ~` to continue to work, while improving `case_when()`'s safety by guarding against some silent confusing failure cases (#7082).
+* In `case_when()`, supplying all size 1 LHS inputs along with a size >1 RHS input is now soft-deprecated. This is an improper usage of `case_when()` that should instead be a series of if statements, like:
+
+  ```
+  # Scalars!
+  code <- 1L
+  flavor <- "vanilla"
+
+  # Previously
+  case_when(
+    code == 1L && flavor == "chocolate" ~ x,
+    code == 1L && flavor == "vanilla" ~ y,
+    code == 2L && flavor == "vanilla" ~ z,
+    .default = default
+  )
+
+  # Now
+  if (code == 1L && flavor == "chocolate") {
+    x
+  } else if (code == 1L && flavor == "vanilla") {
+    y
+  } else if (code == 2L && flavor == "vanilla") {
+    z
+  } else {
+    default
+  }
+  ```
+
+  The recycling behavior that allows this style of `case_when()` to work is unsafe, and can result in silent bugs that we'd like to guard against with an error in the future (#7082).
 
 * The following vector functions have gotten significantly faster and use much less memory due to a rewrite in C via vctrs (#7723):
 

R/case-when.R

@@ -163,17 +163,15 @@ case_when <- function(..., .default = NULL, .ptype = NULL, .size = NULL) {
   conditions <- args$lhs
   values <- args$rhs
 
-  # Unfortunate historical behavior patch:
-  #
-  # `case_when()`'s formula interface finds the common size of all LHS inputs.
-  # This is what allows `TRUE ~` to work. Unfortunately, this has caused a lot
-  # of confusion over the years when `TRUE ~` isn't involved (#7082) and we wish
-  # that we could enforce that all LHS inputs must be the same size (without
-  # recycling).
-  #
-  # Additionally, for `case_when()`, the LHS common size is the size that each
-  # RHS value must recycle to.
-  .size <- vec_size_common(!!!conditions, .size = .size)
+  .size <- case_when_size_common(
+    conditions = conditions,
+    values = values,
+    size = .size
+  )
+
+  # Only recycle `conditions`. Expect that `vec_case_when()` requires all
+  # `conditions` to be the same size, but can efficiently recycle `values`
+  # at the C level without extra allocations.
   conditions <- vec_recycle_common(!!!conditions, .size = .size)
 
   vec_case_when(
@@ -189,6 +187,148 @@ case_when <- function(..., .default = NULL, .ptype = NULL, .size = NULL) {
   )
 }
 
+# Size common computation for `case_when()`
+#
+# `case_when()`'s formula interface historically finds the common size of ALL
+# inputs. This is not good, ideally it would force all LHS inputs to have the
+# same size (with no recycling), and then recycle all RHS inputs to that size
+# inferred from the LHS. That is how `vec_case_when()` works.
+#
+# We can't change this easily for two reasons:
+#
+# - `TRUE ~` must continue to work for legacy reasons, so at the very least all
+#   LHS inputs must be recycled against each other. We are okay with this.
+#
+# - Many packages (60+) use `case_when()` with scalar LHSs but vector RHSs,
+#   requiring that all inputs by recycled against each other. This usage should
+#   be replaced with a series of if statements. This is a highly inefficient use
+#   of `case_when()` because each scalar LHS has to be recycled to the size
+#   determined from the RHS, which is a big waste of memory and time. This
+#   behavior can also allow real bugs to slip through silently (#7082), which is
+#   bad. To combat this case, we specially detect this and throw a deprecation
+#   warning.
+#
+# There are four cases to consider:
+#
+# 1. `size_conditions == 1, size_values == 1`
+#
+#    Fine, use size 1
+#
+# 2. `size_conditions == 1, size_values != 1`
+#
+#    Use `size_values` for historical reasons, but warn against this. This is
+#    people doing off-label usage of `case_when()` when they should be using a
+#    series of if statements.
+#
+# 3. `size_conditions != 1, size_values == 1`
+#
+#    Fine, use `size_conditions`
+#
+# 4. `size_conditions != 1, size_values != 1`
+#
+#    If `size_conditions == size_values`, good to go, else throw an error by
+#    recalling `vec_size_common()` with all inputs.
+case_when_size_common <- function(
+  conditions,
+  values,
+  size,
+  ...,
+  user_env = caller_env(2),
+  error_call = caller_env()
+) {
+  # These error if there are any size incompatibilites within LHS and RHS inputs,
+  # but not across LHS and RHS inputs
+  size_conditions <- vec_size_common(
+    !!!conditions,
+    .size = size,
+    .call = error_call
+  )
+  size_values <- vec_size_common(
+    !!!values,
+    .size = size,
+    .call = error_call
+  )
+
+  if (size_conditions == 1L && size_values == 1L) {
+    return(1L)
+  }
+
+  if (size_conditions == 1L && size_values != 1L) {
+    warn_case_when_scalar_lhs_vector_rhs(
+      env = error_call,
+      user_env = user_env
+    )
+    return(size_values)
+  }
+
+  if (size_conditions != 1L && size_values == 1L) {
+    return(size_conditions)
+  }
+
+  if (size_conditions != 1L && size_values != 1L) {
+    if (size_conditions == size_values) {
+      return(size_conditions)
+    }
+
+    # Errors
+    vec_size_common(
+      !!!conditions,
+      !!!values,
+      .size = size,
+      .call = error_call
+    )
+
+    abort("`vec_size_common()` should have errored.", .internal = TRUE)
+  }
+
+  abort("All cases should have been covered.", .internal = TRUE)
+}
+
+warn_case_when_scalar_lhs_vector_rhs <- function(
+  env,
+  user_env
+) {
+  what <- I(
+    "Calling `case_when()` with size 1 LHS inputs and size >1 RHS inputs"
+  )
+
+  details <- no_cli_wrapping(paste(
+    sep = "\n",
+    "This `case_when()` statement can result in subtle silent bugs and is very inefficient.",
+    "",
+    "  Please use a series of if statements instead:",
+    "",
+    "  ```",
+    "  # Previously",
+    "  case_when(scalar_lhs1 ~ rhs1, scalar_lhs2 ~ rhs2, .default = default)",
+    "",
+    "  # Now",
+    "  if (scalar_lhs1) {",
+    "    rhs1",
+    "  } else if (scalar_lhs2) {",
+    "    rhs2",
+    "  } else {",
+    "    default",
+    "  }",
+    "  ```"
+  ))
+
+  lifecycle::deprecate_soft(
+    when = "1.2.0",
+    what = what,
+    details = details,
+    env = env,
+    user_env = user_env
+  )
+}
+
+# Suppress cli wrapping https://cli.r-lib.org/reference/inline-markup.html#wrapping
+no_cli_wrapping <- function(x) {
+  x <- gsub(" ", "\u00a0", x, fixed = TRUE)
+  x <- gsub("\n", "\f", x, fixed = TRUE)
+  x
+}
+
 case_formula_evaluate <- function(args, default_env, dots_env, error_call) {
   # `case_when()`'s formula interface compacts `NULL`s
   args <- compact_null(args)

tests/testthat/_snaps/case-when.md

@@ -35,6 +35,25 @@
     Code
       case_when(1 ~ NULL)
     Condition
+      Warning:
+      Calling `case_when()` with size 1 LHS inputs and size >1 RHS inputs was deprecated in dplyr 1.2.0.
+      i This `case_when()` statement can result in subtle silent bugs and is very inefficient.
+      
+        Please use a series of if statements instead:
+      
+        ```
+        # Previously
+        case_when(scalar_lhs1 ~ rhs1, scalar_lhs2 ~ rhs2, .default = default)
+      
+        # Now
+        if (scalar_lhs1) {
+          rhs1
+        } else if (scalar_lhs2) {
+          rhs2
+        } else {
+          default
+        }
+        ```
       Error in `case_when()`:
       ! `..1 (right)` must be a vector, not `NULL`.
 
@@ -66,57 +85,14 @@
       Caused by error:
       ! oh no!
 
-# only LHS sizes are consulted to compute the output size (#7082)
-
-    Code
-      x <- 1
-      case_when(x == 1 ~ "a", x == 2 ~ character(), .default = "other")
-    Condition
-      Error in `case_when()`:
-      ! `..2 (right)` must have size 1, not size 0.
-
----
-
-    Code
-      case_when(TRUE ~ 1:3, FALSE ~ 4:6)
-    Condition
-      Error in `case_when()`:
-      ! `..1 (right)` must have size 1, not size 3.
-
----
-
-    Code
-      case_when(NA ~ 1:3, TRUE ~ 4:6)
-    Condition
-      Error in `case_when()`:
-      ! `..1 (right)` must have size 1, not size 3.
-
----
-
-    Code
-      x <- 1:3
-      my_scalar_condition <- is.double(x)
-      case_when(my_scalar_condition ~ x, TRUE ~ 4:6)
-    Condition
-      Error in `case_when()`:
-      ! `..1 (right)` must have size 1, not size 3.
-
----
-
-    Code
-      case_when(TRUE ~ integer(), FALSE ~ integer())
-    Condition
-      Error in `case_when()`:
-      ! `..1 (right)` must have size 1, not size 0.
-
 # case_when() give meaningful errors
 
     Code
       (expect_error(case_when(c(TRUE, FALSE) ~ 1:3, c(FALSE, TRUE) ~ 1:2)))
     Output
-      <error/vctrs_error_assert_size>
+      <error/vctrs_error_incompatible_size>
       Error in `case_when()`:
-      ! `..1 (right)` must have size 2, not size 3.
+      ! Can't recycle `..1 (right)` (size 3) to match `..2 (right)` (size 2).
     Code
       (expect_error(case_when(c(TRUE, FALSE) ~ 1, c(FALSE, TRUE, FALSE) ~ 2, c(FALSE,
         TRUE, FALSE, NA) ~ 3)))
@@ -125,11 +101,11 @@
       Error in `case_when()`:
       ! Can't recycle `..1 (left)` (size 2) to match `..2 (left)` (size 3).
     Code
-      (expect_error(case_when(50 ~ 1:3)))
+      (expect_error(case_when(51:53 ~ 1:3)))
     Output
       <error/rlang_error>
       Error in `case_when()`:
-      ! `..1 (left)` must be a logical vector, not the number 50.
+      ! `..1 (left)` must be a logical vector, not an integer vector.
     Code
       (expect_error(case_when(paste(50))))
     Output
@@ -161,3 +137,61 @@
       Error in `case_when()`:
       ! Case 1 (`~1:2`) must be a two-sided formula.
 
+# Using scalar LHS with vector RHS is deprecated (#7082)
+
+    Code
+      x <- 1:5
+      y <- 6:10
+      code <- 1L
+      sex <- "M"
+      expect_identical(case_when(code == 1L && sex == "M" ~ x, code == 1L && sex ==
+        "F" ~ y, code == 1L && sex == "M" ~ x + 1L, .default = 0L), x)
+    Condition
+      Warning:
+      Calling `case_when()` with size 1 LHS inputs and size >1 RHS inputs was deprecated in dplyr 1.2.0.
+      i This `case_when()` statement can result in subtle silent bugs and is very inefficient.
+      
+        Please use a series of if statements instead:
+      
+        ```
+        # Previously
+        case_when(scalar_lhs1 ~ rhs1, scalar_lhs2 ~ rhs2, .default = default)
+      
+        # Now
+        if (scalar_lhs1) {
+          rhs1
+        } else if (scalar_lhs2) {
+          rhs2
+        } else {
+          default
+        }
+        ```
+
+---
+
+    Code
+      x <- 1
+      case_when(x == 1 ~ "a", x == 2 ~ character(), .default = "other")
+    Condition
+      Warning:
+      Calling `case_when()` with size 1 LHS inputs and size >1 RHS inputs was deprecated in dplyr 1.2.0.
+      i This `case_when()` statement can result in subtle silent bugs and is very inefficient.
+      
+        Please use a series of if statements instead:
+      
+        ```
+        # Previously
+        case_when(scalar_lhs1 ~ rhs1, scalar_lhs2 ~ rhs2, .default = default)
+      
+        # Now
+        if (scalar_lhs1) {
+          rhs1
+        } else if (scalar_lhs2) {
+          rhs2
+        } else {
+          default
+        }
+        ```
+    Output
+      character(0)
+