(Предварительная) подача переменных на фабрику функций и внутри

#r

#r

Вопрос:

Я читаю расширенный R Хэдли и пробую кое-что. Я пытаюсь создать lazy функцию закрытия, которая возвращает функцию с предоставленной data.frame в ее среде, а также использует with и может предоставить дополнительные аргументы функции позже.

 lazy <- function(dataframe, x) {
    function(FUN, x, ...) {
        with(dataframe, FUN(x = x, ...))
    }
}

lz_factory <- lazy(mtcars, "mpg")

lz_factory(mean)
lz_factory(cor, y="hp")
  

Итак, я ожидал, что фрейм данных является частью функциональной среды, которой он является ( browser см. Подтверждение). Однако имя переменной x не указано, и я не могу указать новую переменную y при использовании cor в качестве первого FUN аргумента. Это связано с передачей символа в функцию ( with ), которая использует нестандартную оценку (NSE). Я хочу, чтобы дядя Хэдли гордился мной, но мои поиски со eval parse substitute всеми возвращенными ошибками. Это означает, что я не совсем понимаю, как R обрабатывает вещи. Я знаю, почему это не работает (NSE), но не знаю, как заставить это работать. Вот ошибки:

 > lz_factory(mean)
Error in FUN(x = x, ...) : argument "x" is missing, with no default

> lz_factory(cor, y="hp")
Error in is.data.frame(x) : argument "x" is missing, with no default
  

Я думал, что смогу справиться с этим, используя замену, как показывает Хэдли ЗДЕСЬ, xyplot но это тоже был провал, как видно здесь:

 lazy <- function(dataframe, default) {
    function(FUN, x, ...) {
        if (missing(x)) x <- default
        eval(substitute(with(dataframe, FUN(x, ...))))
    }
}

lz_factory <- lazy(mtcars, "mpg")

lz_factory(mean)
lz_factory(cor, y="hp")


> lz_factory(mean)
[1] NA
Warning message:
In mean.default("mpg") : argument is not numeric or logical: returning NA

> lz_factory(cor, y="hp")
Error in cor("mpg", y = "hp") : 'x' must be numeric
  

Итак, как я могу заставить эту ленивую функцию работать, чтобы она:

  1. Создает свою собственную функцию с фреймом данных, заключенным в среду
  2. Позволяет мне указать x, если я хочу, а если нет, использует исходное значение по умолчанию
  3. Позволяет мне передавать неизвестные переменные в функцию, созданную lz_factory

Оптимально я бы хотел, чтобы эта функция работала with . Если это невозможно, было бы неплохо узнать, почему. И, наконец, если невозможно использовать with , как я могу заставить функцию работать?

Ответ №1:

Как насчет этой функции

 lazy <- function(dataframe, ...) {
    pdots <- substitute(list(...))
    if(is.null(names(pdots)) || names(pdots)[1]=="") {
        names(pdots)[2]<-"x"
    }
    function(FUN, ...) {
        dots <- substitute(list(...))[-1]
        if (is.null(dots$x)) {
            dots$x <- pdots$x
        }
        with(dataframe, do.call(FUN, as.list(dots)))
    }
}
  

Это позволяет использовать имена переменных в mtcars без кавычек. Например

 lz_factory <- lazy(mtcars, mpg)
lz_factory(mean)
# [1] 20.09062
lz_factory(mean, x=hp)
# [1] 146.6875
lz_factory(cor, y=hp)
# [1] -0.7761684
  

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

Комментарии:

1. Святой дым сложнее, чем я думал. Я чувствую себя менее плохо из-за того, что не получил его. Очень круто. Я немного задержу проверку, если у кого-то другой подход. Я понимаю ваш подход, но в настоящее время я бы не добрался туда самостоятельно.

2. @Tyler, ну, я, возможно, слишком усложнил это. Я не потратил много времени, пытаясь уменьшить его. Кроме того, не был уверен, действительно ли вы хотите передавать имена столбцов в виде строк или нет. Это может изменить некоторые substitute вызовы на get вызовы. Потому что даже в with , вы не можете использовать строки в качестве имен переменных.

Ответ №2:

Вот немного упрощенная версия функции @MrFlick:

 lazy <- function(df, x_var = NULL) {
  x <- substitute(x_var)

  function(FUN, ...) {
    call <- substitute(FUN(...))
    if (is.null(call$x) amp;amp; !is.null(x)) {
      call$x <- x
    }
    eval(call, df, parent.frame())
  }
}
  

Ключ в том, чтобы использовать больше возможностей substitute() и избегать with() прямого использования eval .

Комментарии:

1. Спасибо за ваше мышление. Я очень ценю это и получаю удовольствие и многому учусь у Advanced R