Сопоставьте аргументы в ... с каждой функцией в итоге (.funs = funs (f1, f2), ...) - PullRequest
0 голосов
/ 28 февраля 2019

Мне нужно вычислить несколько квантилей из одного числового вектора и использовать для этого dplyr::summarise.Вот что у меня есть:

library(dplyr)
library(rlang)

quantiles <- function(data, group, ...){
  group <- enquo(group)
  value_vars <- quos(...)
  data %>%
    group_by(!!group) %>%
    summarise_at(vars(!!!value_vars), funs(
      median = median,
      q1 = quantile(., probs = 0.25),
      q3 = quantile(., probs = 0.75))
    ) %>%
    ungroup()
}
quantiles(data = iris, group = Species, Sepal.Length, Petal.Width)

Работает, но вызывает отсутствие видимой привязки для переменной '.' при проверке пакета.Поэтому я ищу способ избавиться от . в функции.Я могу заменить mutate_at на summarise_at, а затем суммировать с first, но это может стать довольно тяжелым:

quantiles <- function(data, group, ...){
  group <- enquo(group)
  value_vars <- quos(...)
  data %>%
    group_by(!!group) %>%
    mutate_at(vars(!!!value_vars), funs(median = median)) %>%
    mutate_at(vars(!!!value_vars), funs(q1 = quantile), probs = 0.25) %>%
    mutate_at(vars(!!!value_vars), funs(q3 = quantile), probs = 0.75) %>%
    summarise_at(vars(matches('(median|q1|q3)$')), first) %>%
    ungroup()
}
quantiles(data = iris, group = Species, Sepal.Length, Petal.Width)

edit: использовать purrr:map2

Я могу создать список функций с желаемыми значениями вторичного аргумента:

quantile_funs <- purrr::map2(
  .x = list(median = median, q1 = quantile, q3 = quantile),
  .y = list(NULL, 0.25, 0.75),
  .f = function(fun, arg){
    function(x) fun(x, probs = arg)
  }
)

quantiles <- function(data, group, ...){
  group <- enquo(group)
  value_vars <- quos(...)
  data %>%
    group_by(!!group) %>%
    summarise_at(vars(!!!value_vars), .funs = quantile_funs) %>%
    ungroup()
}
quantiles(data = iris, group = Species, Sepal.Length, Petal.Width)

Это работает хорошо, но благодаря удаче, поскольку mean имеет аргумент ..., который позволяет мне фактически выполнять mean(x, probs = NULL) пока у него нет аргумента probs.

Я попробовал следующее, но это не сработало:

quantile_funs <- purrr::map2(
  .x = list(median = median, q1 = quantile, q3 = quantile),
  .y = list(list(NULL = NULL), list(probs = 0.25), list(probs = 0.75)),
  .f = function(fun, arg){
    function(x) fun(x, splice(arg))
  }
)

1 Ответ

0 голосов
/ 28 февраля 2019

Вот одна опция, использующая функцию mapply:

library('data.table')
quantiles <- function(data, group, v.names, quantile = c(.25, 0.5, .75)){
  data <- as.data.table(data)
  gLevels <- levels(data[, get(group)])
  quantileDT <- as.data.table(
    expand.grid(v.name = v.names, grp = gLevels, quantile = quantile,
                stringsAsFactors = FALSE))
  quantileDT[, Value:= 
               mapply(function(v, g, q) quantile(data[get(group) == g, get(v)],  q),
                      v = v.name, 
                      g = grp, 
                      q = quantile)]

  dcast(quantileDT, grp ~ v.name + quantile, value.var = 'Value')
}

quantiles(data = iris, group = 'Species', v.names = c('Sepal.Length', 'Petal.Width'))

Возможно, возможно, понадобится некоторая очистка - например, использование data и quantile в качестве имен переменных не такая уж хорошая идея.Вот результат, который вы получите:

          grp Petal.Width_0.25 Petal.Width_0.5 Petal.Width_0.75 Sepal.Length_0.25 Sepal.Length_0.5 Sepal.Length_0.75
1:     setosa              0.2             0.2              0.3             4.800              5.0               5.2
2: versicolor              1.2             1.3              1.5             5.600              5.9               6.3
3:  virginica              1.8             2.0              2.3             6.225              6.5               6.9
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...