curly curly tidy оценочное программирование с несколькими входами и настраиваемой функцией по столбцам - PullRequest
Новая
       111

curly curly tidy оценочное программирование с несколькими входами и настраиваемой функцией по столбцам

4 голосов
/ 05 августа 2020

Мой вопрос похож на этот вопрос , но мне нужно применить более сложную функцию по столбцам, и я не могу понять, как применить предложенное Лайонелом решение к настраиваемой функции с помощью глагола с ограниченной областью действия, например filter_at() или эквивалент filter() + across(). Не похоже, что был введен оператор "superstache" / {{{}}}.

Вот непрограммированный пример того, что я хочу сделать (не использует NSE): 

library(dplyr)
library(magrittr)

foo <- tibble(group = c(1,1,2,2,3,3),
              a = c(1,1,0,1,2,2),
              b = c(1,1,2,2,0,1))

foo %>%
  group_by(group) %>%
  filter_at(vars(a,b), any_vars(n_distinct(.) != 1)) %>%
  ungroup
#> # A tibble: 4 x 3
#>   group     a     b
#>   <dbl> <dbl> <dbl>
#> 1     2     0     2
#> 2     2     1     2
#> 3     3     2     0
#> 4     3     2     1

Я еще не нашел эквивалента этой строки filter_at с filter + across(), но, поскольку новые (i sh) функции tidyeval предшествуют dplyr 1.0, я предполагаю, что проблема может быть решена в стороне. Вот моя попытка создать запрограммированную версию, в которой переменные фильтрации поставляются пользователем с точками: 

my_function <- function(data, ..., by) {
  dots <- enquos(..., .named = TRUE)
  
  helperfunc <- function(arg) {
    return(any_vars(n_distinct(arg) != length(arg)))
  }
  
  dots <- lapply(dots, function(dot) call("helperfunc", dot))
  
  data %>%
    group_by({{ by }}) %>%
    filter(!!!dots) %>%
    ungroup
}

foo %>%
  my_function(a, b, group)
#> Error: Problem with `filter()` input `..1`.
#> x Input `..1` is named.
#> i This usually means that you've used `=` instead of `==`.
#> i Did you mean `a == helperfunc(a)`?

Мне бы очень хотелось, если бы был способ просто подключить оператор NSE внутри vars() аргумент в filter_at и не должен делать все эти дополнительные вызовы (я предполагаю, что это то, что делает функция {{{}}}?)

Ответы [ 3 ]

4 голосов
/ 05 августа 2020

Вот способ использования across() для достижения этой цели, описанный в vignette("colwise"). 

my_function <- function(data, vars, by) {
  
  data %>%
    group_by({{ by }}) %>%
    filter(n_distinct(across({{ vars }}, ~ .x)) != 1) %>%
    ungroup()
  
}
 
foo %>%
  my_function(c(a, b), by = group)

# A tibble: 4 x 3
  group     a     b
  <dbl> <dbl> <dbl>
1     2     0     2
2     2     1     2
3     3     2     0
4     3     2     1
3 голосов
/ 05 августа 2020

Может быть, я неправильно понимаю, в чем проблема, но стандартный шаблон пересылка точек , похоже, здесь работает нормально: 

my_function <- function(data, ..., by) {
  data %>%
    group_by({{ by }}) %>%
    filter_at(vars(...), any_vars(n_distinct(.) != 1)) %>%
    ungroup
}

foo %>%
  my_function( a, b, by=group )     # works
1 голос
/ 05 августа 2020

Вариант с across

my_function <- function(data, by, ...) {
 
  dots <- enquos(..., .named = TRUE)
  nm1 <- purrr::map_chr(dots, rlang::as_label) 
     
     
  data %>%
    dplyr::group_by({{ by }}) %>%
    dplyr::mutate(across(nm1, ~ n_distinct(.) !=1, .names = "{col}_ind")) %>%
    dplyr::ungroup() %>% 
    dplyr::filter(dplyr::select(., ends_with('ind')) %>% purrr::reduce(`|`)) %>%
    dplyr::select(-ends_with('ind'))
    
    
}

my_function(foo, group, a, b)
# A tibble: 4 x 3
#  group     a     b
#  <dbl> <dbl> <dbl>
#1     2     0     2
#2     2     1     2
#3     3     2     0
#4     3     2     1

Или с filter/across

foo %>%
   group_by(group) %>%
   filter(any(!across(c(a,b), ~ n_distinct(.) == 1)))
# A tibble: 4 x 3
# Groups:   group [2]
#  group     a     b
#  <dbl> <dbl> <dbl>
#1     2     0     2
#2     2     1     2
#3     3     2     0
#4     3     2     1
...