函数列表:仅将附加参数应用于可以接受它的函数

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

^{创建于 2020-02-16 由 reprex 软件包 (v0.3.0(}

Answer 1

> 1(问题尚不清楚length的预期输出是什么，但如果问题是如何删除 NA，而不管函数是否采用na.rm参数，那么只需先删除 NA。

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

2(允许函数具有任意变化参数的另一种可能性如下。 每个函数都定义为一个简单的公式，其中包含任何适当的参数。 这使用 gsubfn 中的fn$将公式转换为函数。

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(这是(2(的变体，它要求你写function这个词，但同样灵活：

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(另一种变体是使用功能包中的Curry：

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))
}

Answer 2

我不确定这是否是最安全的方法，但您可以使用tryCatch其中如果出现错误，则返回f(x)没有任何其他参数。

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

Answer 3

您也可以尝试从purrrpartial，但不确定您是否打算这样做。您可能还想从咕噜声中安全、安静地检查，它们在某些情况下可能有用

func_factory <- function(x){
partial(x, na.rm=T)
}
show_stats <- function(x) {
funs <- list(mean = func_factory(mean), 
sd = func_factory(sd), n = length)
lapply(funs, function(f) f(x))
}
show_stats(x)

输出：

> show_stats(x)
$mean
[1] 5.5
$sd
[1] 3.02765
$n
[1] 11
>