Переменные в качестве аргументов по умолчанию для функции, используя dplyr

Ответ 1

Вот мой возможный ответ, который я фактически использовал. Он в основном полагается на функцию, которая явно вводит любые значения функции по умолчанию в выражения объекта ленивых точек.

Полная функция (с комментариями) находится в конце этого ответа.

Ограничения:

• Вам нужно по крайней мере некоторые дополнительные трюки, чтобы сделать эту работу красивой (см. ниже).
• Он игнорирует примитивные функции, но я не думаю, что у них есть аргументы функции по умолчанию.
• Для генерических чисел S3 вместо этого следует использовать фактический метод. Например, seq.default вместо seq. Если целью является введение значений по умолчанию в ваши собственные функции, тогда это обычно не будет проблемой.

Например, эту функцию можно использовать следующим образом:

dots <- lazyeval::all_dots(a = ~x, b = ~lm(y ~ x, data = d))
add_defaults_to_dots(dots)

$a
<lazy>
  expr: x
  env:  <environment: R_GlobalEnv>

$b
<lazy>
  expr: lm(formula = y ~ x, data = d, subset = , weights = , na.action = ,  ...
  env:  <environment: R_GlobalEnv>

Мы можем решить проблему игрушек из вопроса несколькими способами. Помните новую функцию и идеальный вариант использования:

lag2 <- function(x, n = 1L, order_by = gear) lag(x, n = n, order_by = order_by)

mtcars %>%
  mutate(cyl_change = cyl != lag2(cyl))

• Используйте mutate_ с dots напрямую:

  dots <- lazyeval::all_dots(cyl_change = ~cyl != lag2(cyl), all_named = TRUE)
  dots <- add_defaults_to_dots(dots)
  mtcars %>% mutate_(.dots = dots)
  

• Переопределить mutate, чтобы включить добавление значений по умолчанию.

  mutate2 <- function(.data, ...) {
    dots <- lazyeval::lazy_dots(...)
    dots <- add_defaults_to_dots(dots)
    dplyr::mutate_(.data, .dots = dots)
  }
  
  mtcars %>% mutate2(cyl_change = cyl != lag2(cyl))
  

• Используйте S3-рассылку, чтобы сделать это по умолчанию для любого настраиваемого класса:

  mtcars2 <- mtcars
  class(mtcars2) <- c('test', 'data.frame')
  
  mutate_.test <- function(.data, ..., .dots) {
    dots <- lazyeval::all_dots(.dots, ..., all_named = TRUE)
    dots <- add_defaults_to_dots(dots)
    dplyr::mutate_(tibble::as_tibble(.data), .dots = dots)
  }
  mtcars2 %>% mutate(cyl_change = cyl != lag2(cyl))
  

В зависимости от варианта использования варианты 2 и 3 являются лучшими способами для этого. Вариант 3 фактически имеет полный предлагаемый вариант использования, но полагается на дополнительный класс S3.

Функции:

add_defaults_to_dots <- function(dots) {
  # A recursive function that continues to add defaults to lower and lower levels.
  add_defaults_to_expr <- function(expr) {
    # First, if a call is a symbol or vector, there is nothing left to do but
    # return the value (since it is not a function call).
    if (is.symbol(expr) | is.vector(expr) | class(expr) == "formula") {
      return(expr)
    }
    # If it is a function however, we need to extract it.
    fun <- expr[[1]]
    # If it is a primitive function (like `+`) there are no defaults, and we
    # should not manipulate that call, but we do need to use recursion for cases
    # like a + f(b).
    if (is.primitive(match.fun(fun))) {
      new_expr <- expr
    } else {
      # If we have an actual non-primitive function call, we formally match the
      # call, so abbreviated arguments and order reliance work.
      matched_expr <- match.call(match.fun(fun), expr, expand.dots = TRUE)
      expr_list <- as.list(matched_expr)
      # Then we find the default arguments:
      arguments <- formals(eval(fun))
      # And overwrite the defaults for which other values were supplied:
      given <- expr_list[-1]
      arguments[names(given)] <- given
      # And finally build the new call:
      new_expr <- as.call(c(fun, arguments))
    }
    # Then, for all function arguments we run the function recursively.
    new_arguments <- as.list(new_expr)[-1]
    null <- sapply(new_arguments, is.null)
    new_arguments[!null] <- lapply(new_arguments[!null], add_defaults_to_expr)
    new_expr <- as.call(c(fun, new_arguments))
    return(new_expr)
  }
  # For lazy dots supplied, separate the expression and environments.
  exprs <- lapply(dots, `[[`, 'expr')
  envrs <- lapply(dots, `[[`, 'env')
  # Add the defaults to the expressions.
  new_exprs <- lapply(exprs, add_defaults_to_expr)
  # Add back the correct environments.
  new_calls <- Map(function(x, y) {
    lazyeval::as.lazy(x, y)
  }, new_exprs, envrs)
  return(new_calls)
}

Ответ 2

Вот два подхода в data.table, однако я не считаю, что любой из них будет работать в dplyr в настоящее время.

В data.table все, что находится внутри j-expression (так же как второй аргумент [.data.table), сначала анализируется на пакет data.table, а не обычный R-парсер. В некотором смысле вы можете думать об этом как о отдельном парсере, живущем внутри обычного парсера языка, который равен R. Что делает этот парсер, он ищет, какие переменные вы использовали, которые являются фактически столбцами data.table, которые вы используете on, и все, что он находит, помещает его в среду j-expression.

Это означает, что вы должны позволить этому парсеру как-то знать, что gear будет использоваться или просто не будет частью среды. Ниже приведены две идеи для достижения этого.

"Простой" способ сделать это состоит в том, чтобы фактически использовать имя столбца в j-expression, где вы вызываете lag2 (в дополнение к некоторым обезьяньям внутри lag2):

dt = as.data.table(mtcars)

lag2 = function(x) lag(x, order_by = get('gear', sys.frame(4)))

dt[, newvar := {gear; lag2(cyl)}]
# or
dt[, newvar := {.SD; lag2(cyl)}]

Это решение имеет 2 нежелательных свойства: во-первых, я не уверен, насколько хрупким является sys.frame(4) - вы помещаете это в функцию или пакет, и я не знаю, что произойдет. Вы, вероятно, можете обойти его и выяснить правильную рамку, но это какая-то боль. Во-вторых - вам нужно указать конкретную переменную, в которой вы заинтересованы, в любом месте в выражении или сбросить все из них в среде с помощью .SD, снова в любом месте.

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

lag3 = quote(function(x) lag(x, order_by = gear))

dt[, newvar := eval(lag3)(cyl)]

Это не страдает от проблем другого решения с очевидным недостатком в том, что нужно вводить дополнительные eval.

Ответ 3

Это решение приближается:

Рассмотрим немного более легкий пример с игрушкой:

mtcars %>%
  mutate(carb2 = lag(carb, order_by = gear))

Мы по-прежнему используем аргумент lag и order_by, но не делаем никаких дальнейших вычислений с ним. Вместо того, чтобы придерживаться SE mutate, мы переключаемся на NSE mutate_ и делаем lag2 строят вызов функции как вектор символа.

lag2 <- function(x, n = 1, order_by = gear) {
  x <- deparse(substitute(x))
  order_by <- deparse(substitute(order_by))
  paste0('dplyr::lag(x = ', x, ', n = ', n, ', order_by = ', order_by, ')')
}

mtcars %>%
  mutate_(carb2 = lag2(carb))

Это дает нам идентичный результат выше.

Пример orginial toy может быть достигнут с помощью:

mtcars %>%
  mutate_(cyl_change = paste('cyl !=', lag2(cyl)))

Downsides:

• Мы должны использовать SE mutate_.
• Для расширенного использования, как в исходном примере, нам также нужно использовать paste.
• Это не особенно безопасно, т.е. не сразу видно, откуда должен прибыть gear. Назначение значений gear или carb в глобальной среде, похоже, в порядке, но я предполагаю, что в некоторых случаях могут возникать неожиданные ошибки. Использование формулы вместо символьного вектора было бы более безопасным, но для этого требуется, чтобы для нее была назначена правильная среда, и это все еще большой знак вопроса для меня.

Ответ 4

Это не изящно, так как для этого требуется дополнительный аргумент. Но, передавая весь кадр данных, мы получаем почти необходимое поведение

lag2 <- function(x, df, n = 1L, order_by = df[['gear']], ...) {
  lag(x, n = n, order_by = order_by, ...)
}

hack <- mtcars  %>%  mutate(cyl_change = cyl != lag2(cyl, .))
ans <- mtcars  %>%  mutate(cyl_change = cyl != lag(cyl, order_by = gear))
all.equal(hack, ans)
# [1] TRUE

• Нужно иметь возможность называть lag2 без необходимости передавать передачу.

Да, но вам нужно пройти ..

2. Нужно иметь возможность использовать lag2 в наборах данных, которые не называются mtcars (но у них есть механизм, как один из них).

Это работает.

3. Предпочтительно передача будет аргументом по умолчанию для функции, поэтому при необходимости она может быть изменена, но это не имеет решающего значения.

Это также работает:

hack_nondefault <- mtcars %>%  mutate(cyl_change = cyl != lag2(cyl, order_by = cyl))
ans_nondefault <- mtcars %>%  mutate(cyl_change = cyl != lag(cyl, order_by = cyl))
all.equal(hack_nondefault, ans_nondefault)
# [1] TRUE

Обратите внимание, что если вы вручную указали order_by, указание df на . больше не требуется, а использование становится идентичным оригиналу lag (что очень приятно).

Добавление

Кажется, трудно избежать использования SE mutate_, как в ответе OP, сделать какой-то простой хакер, как в моем ответе здесь, или сделать что-то более продвинутое, связанное с реверсивной техникой lazyeval::lazy_dots.

Доказательства:

1) dplyr::lag сам не использует никакое волшебство NSE

2) mutate просто вызывает mutate_(.data, .dots = lazyeval::lazy_dots(...))