lundi 17 août 2020

`if_else` condition on multiple (dynamically specified) columns

I am trying mutate a new column based on the values of multiple existing columns, such that if any of the columns equal the specified value, if_else evaluates to TRUE. I can do this using multiple comparison expressions in if_else, however this doesn't work since I need to dynamically specify the columns using quasiquotation. Reprex with explanatory comments below.

I would appreciate any suggestions on how to evaluate a comparison on multple, dynamically specified columns.

Thank you in advance for your help!

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

mtcars <- head(mtcars, 8)

# Desired output, using individual comparisons for each column
mtcars %>% 
  mutate(color = if_else(
    (gear == 4 | carb == 4), 
    "purple", 
    "green")
  )
#>    mpg cyl  disp  hp drat    wt  qsec vs am gear carb  color
#> 1 21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4 purple
#> 2 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4 purple
#> 3 22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1 purple
#> 4 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1  green
#> 5 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2  green
#> 6 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1  green
#> 7 14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4 purple
#> 8 24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2 purple

# Failed attempts to do comparisons on multiple columns
mtcars %>% 
  mutate(color = if_else(
    (gear|carb == 4), 
    "purple", 
    "green")
  )
#>    mpg cyl  disp  hp drat    wt  qsec vs am gear carb  color
#> 1 21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4 purple
#> 2 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4 purple
#> 3 22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1 purple
#> 4 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1 purple
#> 5 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2 purple
#> 6 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1 purple
#> 7 14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4 purple
#> 8 24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2 purple

mtcars %>% 
  mutate(color = if_else(
    (c(gear, carb) == 4), 
    "purple", 
    "green")
  )
#> Error: Problem with `mutate()` input `color`.
#> x Input `color` can't be recycled to size 8.
#> ℹ Input `color` is `if_else((c(gear, carb) == 4), "purple", "green")`.
#> ℹ Input `color` must be size 8 or 1, not 16.

# Using dynamically specified columns and quasiquotation
my_vars <- c("gear", "carb")

# Quasiquotation works with `select`, and `coalesce`
mtcars %>% select(!!!syms(my_vars))
#>                   gear carb
#> Mazda RX4            4    4
#> Mazda RX4 Wag        4    4
#> Datsun 710           4    1
#> Hornet 4 Drive       3    1
#> Hornet Sportabout    3    2
#> Valiant              3    1
#> Duster 360           3    4
#> Merc 240D            4    2
mtcars %>% mutate(any_value = coalesce(!!!syms(my_vars)))
#>    mpg cyl  disp  hp drat    wt  qsec vs am gear carb any_value
#> 1 21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4         4
#> 2 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4         4
#> 3 22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1         4
#> 4 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1         3
#> 5 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2         3
#> 6 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1         3
#> 7 14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4         3
#> 8 24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2         4

# Desired `mutate`: if any columns (via quasiquotation) == 4, then TRUE
mtcars %>% 
  mutate(color = if_else(
    any(!!!syms(my_vars) == 4), 
    "purple", 
    "green")
  )
#> Error in splice(dot_call(capture_dots, frame_env = frame_env, named = named, : 'list' object cannot be coerced to type 'double'

Created on 2020-08-17 by the reprex package (v0.3.0)

Aucun commentaire:

Enregistrer un commentaire