Используя dplyr и lazyeval с '...'

Упрощение редактирования:

Это сводится к следующему:

df = data.frame(a = 1:10)

#example function that takes optional arguments
mymean <- function(x, w = 1, s = 0) { s + mean(w * x) }

summarize_(df, m = "mean(a)")
#>     m
#> 1 5.5

summarize_(df, m = "mymean(a)")
#> Error: could not find function "mymean"

В соответствии с `vignette ( "nse" ) summaryize должен быть задан синтаксис формулы при использовании нестандартных функций суммирования.

В конечном счете, я хочу, чтобы иметь возможность summarize_ обертывать такую функцию:

my_summary <- function(df, x, ...) {
  summarize_(df, 
             m = "mean(a)",
             wm = "mymean(a, ...)" #gives error 
}

#Partial working function
my_summary <- function(df, x, ...) {
  summarize_(df, 
             m = "mean(a)", #works
             wm1 = interp(mymean(a), a = as.name(x) #works but doesn't  allow ... 
             wm2 = interp(mymean(a, b), 
                          .values=list(a = as.name(x),
                                       b = quote(...)),  #doesn't work
             wm3 = interp(mymean(a, ...), a = as.name(x) #doesn't work
}

Рабочая функция позволила бы мне позвонить:

my_summary(df, a)
#> 5.5

my_summary(df, a, w=5, s=2)
#> 29.5

Ответ 1

Поскольку проблема передается функции ..., одно решение состоит в том, чтобы построить вызов через call и do.call (да, оба):

library(dplyr)

df = data.frame(a = 1:10)

mymean = function(x, w = 1, s = 0)
    s + mean(w * x)

my_summary = function (df, x, ...) {
    x = as.name(substitute(x))
    mycall = do.call(call, c('mymean', quote(x), list(...)))
    summarize_(df,
               m = lazyeval::interp(~mean(x), x = x),
               w = lazyeval::lazy_(mycall, environment()))
}

my_summary(df, a)
#>     m   w
#> 1 5.5 5.5
my_summary(df, a, w = 5, s = 2)
#>     m    w
#> 1 5.5 29.5

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

Ответ 2

Эта очень хакерская, ужасная функция выполняет трюк, но что, если mymean содержит много необязательных аргументов?

mymean <- function(x, w=1, s = 0) { s + mean(w * x) }

my_summarize <- function(df, x, ...) {
  vlist = list(...)
  vlist_names = names(vlist)
  if ("w" %in% vlist_names & "s" %in% vlist_names) {
    res = summarize_(df, m = interp(~mymean(a, w=b, s=c), 
                                    .values = list(a = as.name(x),
                                                   b = vlist$w,
                                                   c = vlist$s)))
  }
  else if ("w" %in% vlist_names) {
    res = summarize_(df, m = interp(~mymean(a, w=b), 
                                    .values = list(a = as.name(x),
                                                   b = vlist$w)))
  }
  else if ("s" %in% vlist_names) {
    res = summarize_(df, m = interp(~mymean(a, s=c), 
                                    .values = list(a = as.name(x),
                                                   c = vlist$s)))
  }
  else {
    res = summarize_(df, m = interp(~mymean(a), a = as.name(x)))
  }
  res    
}


df = data.frame(a = 1:10)

my_summarize(df, "a")
#>     m
#> 1 5.5
my_summarize(df, "a", s=5)
#>      m
#> 1 10.5
my_summarize(df, "a", w=2)
#>    m
#> 1 11
my_summarize(df, "a", w=2, s=5)
#>    m
#> 1 16