Passing a quoted function argument to a three-dots argument inside another function using base R

Question

I would like to pass quoted variables in the group argument of geom_col_wrap to the split_group function.

# I deleted the rest of the function for readability
geom_col_wrap = function(data, mapping, group, ...) {

  data |>
    split_group(group) 
}

# This function was based on the `tidytable` package
split_group = function(data, ...) {
  by_quote = as.list(substitute(...()))
  by = sapply(by_quote, deparse)

  split = vctrs::vec_split(data, data[c(by)])
  out = split[["val"]]
  names = do.call(paste, c(split[["key"]], sep = "_"))
  names(out) = names

  return(out)
}

split_group use substitute to quote variables, here is the problem. How can I make split_group recognize quote variables from group argument? I know it is easy to solve using rlang, but I need a R base solution.

split_group(mtcars, vs, am)
$`0_1`
                mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Mazda RX4      21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
Mazda RX4 Wag  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
...

$`1_1`
                mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Datsun 710     22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
Fiat 128       32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
...

$`1_0`
                mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
Valiant        18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
...

$`0_0`
                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb
Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
...

geom_col_wrap(
  mtcars,
  mapping = ggplot2::aes(x = cyl, y = hp, color = am),
  group = c(vs, am)
)

Error in `[.data.frame`(data, c(by)) : undefined columns selected

This error comes from as.list(substitute(...())). It does not unquoted the group argument. Why?

Note: I cannot use dots arg to solve the problem.

jay.sf · Answer 1 · 2022-11-05T18:43:43.987

Using the miraculous ...() chain, explanation is given here.

split_group <- \(x, ...)  split(x, x[, sapply(substitute(...()), as.character)])

split_group(mtcars, vs, am)
# $`0.0`
# mpg cyl  disp  hp drat   wt  qsec vs am gear carb
# Hornet Sportabout 18.7   8 360.0 175 3.15 3.44 17.02  0  0    3    2
# Duster 360        14.3   8 360.0 245 3.21 3.57 15.84  0  0    3    4
# Merc 450SE        16.4   8 275.8 180 3.07 4.07 17.40  0  0    3    3
# ...
# 
# $`1.0`
# mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
# Valiant        18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
# Merc 240D      24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
# ...
# 
# $`0.1`
# mpg cyl  disp  hp drat    wt  qsec vs am gear carb
# Mazda RX4      21   6 160.0 110 3.90 2.620 16.46  0  1    4    4
# Mazda RX4 Wag  21   6 160.0 110 3.90 2.875 17.02  0  1    4    4
# Porsche 914-2  26   4 120.3  91 4.43 2.140 16.70  0  1    5    2
# ...
# 
# $`1.1`
# mpg cyl  disp hp drat    wt  qsec vs am gear carb
# Datsun 710  22.8   4 108.0 93 3.85 2.320 18.61  1  1    4    1
# Fiat 128    32.4   4  78.7 66 4.08 2.200 19.47  1  1    4    1
# Honda Civic 30.4   4  75.7 52 4.93 1.615 18.52  1  1    4    2

Mark Fairbanks · Answer 2 · 2022-11-07T20:51:59.163

You basically need the base R version of rlang's {{ group }} or !!enquo(group) workflow. Which would be using substitute() to grab your group argument, and then using .(group) inside bquote().

However bquote() helps you build the expression, we then need to use eval() to evaluate your new expression.

Another thing - you're using deparse() in split_group() which would convert c(vs, am) to "c(vs, am)". Instead we'll need to mimic tidyselect so you can use c() style selection (that also still works without c() for a single column).

Put together it looks like this.

split_group = function(data, ...) {
  by_quote = as.list(substitute(...()))
  
  # Mimic tidyselect
  cols = as.list(seq_along(data))
  names(cols) = names(data)
  by = unlist(lapply(by_quote, eval, cols))

  split = vctrs::vec_split(data, data[c(by)])
  out = split[["val"]]
  names = do.call(paste, c(split[["key"]], sep = "_"))
  names(out) = names

  return(out)
}

geom_col_wrap = function(data, mapping, group, ...) {
  # Use substitute/bquote to "unquote" group arg inside split_group function
  # Much like using `{{ group }}` or `!!enquo(group)` in rlang
  group = substitute(group)
  eval(bquote(
    data |>
      split_group(.(group))
  ))
}

geom_col_wrap(
  mtcars,
  mapping = ggplot2::aes(x = cyl, y = hp, color = am),
  group = c(vs, am)
)
#> $`0_1`
#>                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#> Mazda RX4      21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
#> Mazda RX4 Wag  21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
#> Porsche 914-2  26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
#> Ford Pantera L 15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
#> Ferrari Dino   19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
#> Maserati Bora  15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
#> 
#> $`1_1`
#>                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#> Datsun 710     22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
#> Fiat 128       32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
#> Honda Civic    30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
#> Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
#> Fiat X1-9      27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
#> Lotus Europa   30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
#> Volvo 142E     21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2
#> 
#> $`1_0`
#>                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#> Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
#> Valiant        18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
#> Merc 240D      24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
#> Merc 230       22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
#> Merc 280       19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
#> Merc 280C      17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
#> Toyota Corona  21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
#> 
#> $`0_0`
#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2

Any reason you can't use rlang? vctrs depends on rlang so you're already sort of using it anyway.

Passing a quoted function argument to a three-dots argument inside another function using base R

2 Answers2