函数列表：仅对可以使用它的函数应用附加参数

Question

我有一个函数列表，其中大部分都采用相同的附加参数 ( na.rm = TRUE)。

我想添加一个不接受此参数的函数 ( length)。是否可以将附加参数仅应用于可以使用它的函数？我想过使用...，但我不确定如何应用它，如果这可能的话。

我正在使用lapply，但对任何选项都感到满意，也超出了基础 R。

x <- c(1:10,NA)

# working example only with functions that take the extra argument

show_stats <- function(x) {
  funs <- list(mean = mean, sd = sd)
  lapply(funs, function(f) f(x, na.rm = TRUE))
}
show_stats(x) 
#> $mean
#> [1] 5.5
#> 
#> $sd
#> [1] 3.02765

# sadly not working, because length() only takes one argument
show_stats <- function(x) {
  funs <- list(mean = mean, sd = sd, n = length)
  lapply(funs, function(f) f(x, na.rm = TRUE))
}

show_stats(x)
#> Error in f(x, na.rm = TRUE): 2 arguments passed to 'length' which requires 1

^{由reprex 包(v0.3.0)于 2020 年 2 月 16 日创建}

Answer 1

1) The question is not clear on what is expected as output for length but if the question is how to remove the NAs regardless of whether the function takes an na.rm argument or not then just remove the NAs first.

show_stats2 <- function(x) {
  funs <- list(mean = mean, sd = sd, length = length)
  lapply(funs, function(f) f(na.omit(x)))
}

2) Another possibility which allows the functions to have arbitrarily varying arguments is the following. Each function is defined as a simple formula with whatever arguments are appropriate. This uses fn$ from gsubfn to transform a formula to a function.`

library(gsubfn)
show_stats3 <- function(x) {
  funs <- list(mean = ~ mean(x, na.rm = TRUE), 
               sd = ~ sd(x, na.rm = TRUE),
               length = ~ length(x))
  fn$lapply(funs, function(f) fn$identity(f)(x))
}

3) Here is a variation of (2) which requires that you write the word function but is similarly flexible:

show_stats4 <- function(x) {
  funs <- list(mean = function(x) mean(x, na.rm = TRUE), 
               sd = function(x) sd(x, na.rm = TRUE),
               length = length)
  lapply(funs, function(f) f(x))
}

4) Yet another variation is to use Curry from the functional package:

library(functional)
show_stats5 <- function(x) {
  funs <- list(mean = Curry(mean, na.rm = TRUE), 
               sd = Curry(sd, na.rm = TRUE),
               length = length)
  lapply(funs, function(f) f(x))
}