Can I make multiple assignments within a given case_when true clause?

Viewed 233

Update: Apparently this feature is now planned for dplyr, as discussed here: https://github.com/tidyverse/dplyr/pull/6145

In SQL one can assign multiple variables - say var1 and var2 - when a given case is verified, with a construction like

case when condition then var1 = x, var2 = y

Does dplyr::case_when (or anything else in the tidyverse) support this useful feature), and if so, how?!

Note that in the example below, var1, var2 and var3 have exactly the same test conditions, i.e. Species == "setosa", and the degenerate case TRUE. I want to reduce this redundancy by not repeating the conditions: one call to case_when (or similar), albeit with different eval_on_true expressions for var1, var2 and var3, respectively. Obviously redundancy is not a problem here in this example, but my case_when's get very large and complex in real life examples.

library(tidyverse)

# create example data
set.seed(1337)
data <- iris %>%
  sample_n(5) %>%
  select(Petal.Length, Petal.Width, Species) %>%
  as_tibble()
data
#> # A tibble: 5 × 3
#>   Petal.Length Petal.Width Species   
#>          <dbl>       <dbl> <fct>     
#> 1          5.5         1.8 virginica 
#> 2          5           1.9 virginica 
#> 3          1.5         0.2 setosa    
#> 4          5.9         2.3 virginica 
#> 5          4.1         1.3 versicolor
data %>%
  mutate(var1 = case_when(Species == "setosa" ~ "green", TRUE ~ "blue"),
         var2 = case_when(Species == "setosa" ~ Petal.Length * 99, TRUE ~ Petal.Length),
         var3 = case_when(Species == "setosa" ~ as.Date("2002-12-01"), TRUE ~ as.Date("2003-12-02")))
#> # A tibble: 5 × 6
#>   Petal.Length Petal.Width Species    var1   var2 var3      
#>          <dbl>       <dbl> <fct>      <chr> <dbl> <date>    
#> 1          5.5         1.8 virginica  blue    5.5 2003-12-02
#> 2          5           1.9 virginica  blue    5   2003-12-02
#> 3          1.5         0.2 setosa     green 148.  2002-12-01
#> 4          5.9         2.3 virginica  blue    5.9 2003-12-02
#> 5          4.1         1.3 versicolor blue    4.1 2003-12-02

Created on 2022-02-09 by the reprex package (v2.0.1)

3 Answers

If we want to create new columns by multiplying a single column with different values, one tidyverse approach is to use imap (by default the default .y is the sequence if we pass unnamed elements) to loop over the multiplier values, return a single column with transmute and then bind those columns with the original data

library(purrr)
library(dplyr)
library(stringr)
imap_dfc(c(10, 99), ~ data %>% 
   transmute(!! str_c('var', .y) := 
   case_when(Species == "setosa"~ Petal.Length * .x, 
              TRUE ~ Petal.Length))) %>% 
   bind_cols(data, .)

-output

# A tibble: 5 × 7
  Sepal.Length Sepal.Width Petal.Length Petal.Width Species     var1  var2
         <dbl>       <dbl>        <dbl>       <dbl> <fct>      <dbl> <dbl>
1          6.4         3.1          5.5         1.8 virginica    5.5   5.5
2          6.3         2.5          5           1.9 virginica    5     5  
3          5.3         3.7          1.5         0.2 setosa      15   148. 
4          6.8         3.2          5.9         2.3 virginica    5.9   5.9
5          5.7         2.8          4.1         1.3 versicolor   4.1   4.1

The problem with case_when is that accepts a value whose length is either nrow or 1. Therefore, you have to trick case_when by producing a list of nrow 1-row dataframes. The accessor function lod (defined below) constructs a list of 1-row dataframes:

lod <- function(...) {
  args <- list(...)
  do.call(function(...) mapply(data.frame, ..., SIMPLIFY = FALSE), args)
}

lod(x = 1:4, y = letters[1:4])

[[1]]
  x y
1 1 a

[[2]]
  x y
1 2 b

[[3]]
  x y
1 3 c

[[4]]
  x y
1 4 d

Then write your case_when statement, using lod to group variables, as follows:

data |>
  mutate(case_when(Species == "setosa" ~
                     lod(var1 = "green",
                         var2 = Petal.Length * 99,
                         var3 = as.Date("2002-12-01")),
                   TRUE ~
                     lod(var1 = "blue",
                         var2 = Petal.Length,
                         var3 = as.Date("2003-12-02"))) |>
         bind_rows())

+ # A tibble: 5 x 6
  Petal.Length Petal.Width Species    var1   var2 var3      
         <dbl>       <dbl> <fct>      <chr> <dbl> <date>    
1          5.5         1.8 virginica  blue    5.5 2003-12-02
2          5           1.9 virginica  blue    5   2003-12-02
3          1.5         0.2 setosa     green 148.  2002-12-01
4          5.9         2.3 virginica  blue    5.9 2003-12-02
5          4.1         1.3 versicolor blue    4.1 2003-12-02

The final bind_rows is required for mutate to accept the new variables.

Maybe this helps:

library(tidyverse)

# create example data
set.seed(1337)
data <- iris %>%
  sample_n(5) %>%
  as_tibble()
data
#> # A tibble: 5 x 5
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width Species   
#>          <dbl>       <dbl>        <dbl>       <dbl> <fct>     
#> 1          6.4         3.1          5.5         1.8 virginica 
#> 2          6.3         2.5          5           1.9 virginica 
#> 3          5.3         3.7          1.5         0.2 setosa    
#> 4          6.8         3.2          5.9         2.3 virginica 
#> 5          5.7         2.8          4.1         1.3 versicolor

data %>%
  mutate(
    sepal_size = case_when(
      Sepal.Length > 6 & Sepal.Width > 3 ~ "big",
      Sepal.Width > 3 ~ "medium",
      TRUE ~ "small"
    ),
    petal_size = case_when(
      Petal.Length > 5 ~ "big",
      TRUE ~ "small"
    ),
    is_fancy = TRUE
  )
#> # A tibble: 5 x 8
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width Species    sepal_size
#>          <dbl>       <dbl>        <dbl>       <dbl> <fct>      <chr>     
#> 1          6.4         3.1          5.5         1.8 virginica  big       
#> 2          6.3         2.5          5           1.9 virginica  small     
#> 3          5.3         3.7          1.5         0.2 setosa     medium    
#> 4          6.8         3.2          5.9         2.3 virginica  big       
#> 5          5.7         2.8          4.1         1.3 versicolor small     
#> # … with 2 more variables: petal_size <chr>, is_fancy <lgl>

Created on 2022-02-08 by the reprex package (v2.0.1) To do the reverse, you can do:

iris %>%
  mutate(
    selected = Species == "setosa",
    var1 = ifelse(selected, Petal.Length * 99, Petal.Length),
    var2 = ifelse(selected, as.Date("2002-12-01"), as.Date("2003-12-02"))
  )
Related