Rlang: передать несколько групп с ... для сбора ()

Question

Допустим, я бы хотел вычислить mean, min и max для произвольного количества групп в пользовательской функции.

Данные игрушек выглядят так:

library(tidyverse)
df <- tibble(
  Gender = c("m", "f", "f", "m", "m", 
             "f", "f", "f", "m", "f"),
  IQ = rnorm(10, 100, 15),
  Other = runif(10),
  Test = rnorm(10),
  group2 = c("A", "A", "A", "A", "A",
             "B", "B", "B", "B", "B")
)

Чтобы достичь этого для двух групп (пол, группа2), я мог бы использовать

df %>% 
  gather(Variable, Value, -c(Gender, group2)) %>% 
  group_by(Gender, group2, Variable) %>% 
  summarise(mean = mean(Value), 
            min = min(Value), 
            max = max(Value)) 

, который можно интегрировать сновые curly-curly операторы из rlang с

descriptive_by <- function(data, group1, group2) {
  data %>% 
    gather(Variable, Value, -c({{ group1 }}, {{ group2 }})) %>% 
    group_by({{ group1 }}, {{ group2 }}, Variable) %>% 
    summarise(mean = mean(Value), 
              min = min(Value), 
              max = max(Value))
}

Обычно я предполагаю, что могу заменить указанные группы на ..., но, похоже, это не так

descriptive_by <- function(data, ...) {
  data %>% 
    gather(Variable, Value, -c(...)) %>% 
    group_by(..., Variable) %>% 
    summarise(mean = mean(Value), 
              min = min(Value), 
              max = max(Value))
}

, поскольку возвращает ошибку

Ошибка в map_lgl (.x, .p, ...): объект 'Gender' не найден

Answer 1

Вот одно из возможных решений, где ... передается group_by напрямую, а gather просто собирает числовые столбцы (так как я предполагаю, что он никогда не должен собирать нечисловые столбцы независимо от ввода...).

library(tidyverse)

set.seed(1)

## data
df <- tibble(
    Gender = c("m", "f", "f", "m", "m", 
        "f", "f", "f", "m", "f"),
    IQ = rnorm(10, 100, 15),
    Other = runif(10),
    Test = rnorm(10),
    group2 = c("A", "A", "A", "A", "A",
        "B", "B", "B", "B", "B")
)

## function
descriptive_by <- function(data, ...) {

  data %>% 
      gather(Variable, Value, names(select_if(., is.numeric))) %>% 
      group_by(..., Variable) %>% 
      summarise(mean = mean(Value), 
          min = min(Value), 
          max = max(Value))
}

descriptive_by(df, Gender, group2)
#> # A tibble: 12 x 6
#> # Groups:   Gender, group2 [4]
#>    Gender group2 Variable    mean      min     max
#>    <chr>  <chr>  <chr>      <dbl>    <dbl>   <dbl>
#>  1 f      A      IQ        95.1    87.5    103.   
#>  2 f      A      Other      0.432   0.212    0.652
#>  3 f      A      Test       0.464  -0.0162   0.944
#>  4 f      B      IQ       100.     87.7    111.   
#>  5 f      B      Other      0.281   0.0134   0.386
#>  6 f      B      Test       0.599   0.0746   0.919
#>  7 m      A      IQ       106.     90.6    124.   
#>  8 m      A      Other      0.442   0.126    0.935
#>  9 m      A      Test       0.457  -0.0449   0.821
#> 10 m      B      IQ       109.    109.     109.   
#> 11 m      B      Other      0.870   0.870    0.870
#> 12 m      B      Test      -1.99   -1.99    -1.99

Answer 2

Сложная часть состоит в том, чтобы выяснить, как отрицать переменные NSE (xxx против -xxx).Вот пример того, как я бы подошел к этому:

desc_by <- function(dat, ...) {

  drops <- lapply(enquos(...), function(d) call("-", d))

  dat %>% 
    gather(var, val, !!!drops) %>% 
    group_by(...) %>% 
    summarise_at(vars(val), funs(min, mean, max))

}

desc_by(head(iris), Species, Petal.Width)

# A tibble: 2 x 5
# Groups:   Species [1]
  Species Petal.Width   min  mean   max
  <fct>         <dbl> <dbl> <dbl> <dbl>
1 setosa          0.2   1.3  3.18   5.1
2 setosa          0.4   1.7  3.67   5.4

Вам все еще нужно использовать enquos и !!!, чтобы применить - к каждой переменной, но в противном случае ... можно использовать для группировки и т. д. без изменений.Таким образом, вам вообще не нужны новые операторы "усы" / вьющиеся-фигурные.