默认参数取决于 R 中匹配的函数

Question

目前，我在 table 和 xtabs 周围有两个非常相似的包装器：

mytable <- function(..., useNA = "ifany") {
  tab <- table(..., useNA = useNA)
  # additional manipulations
  tab
}

mytable(warpbreaks[-1])

myxtabs <- function(..., na.action = NULL, addNA = TRUE) {
  tab <- xtabs(..., na.action = na.action, addNA = addNA)
  # same manipulations as in mytable
  tab
}

myxtabs(breaks ~ ., warpbreaks)

由于大多数代码都是重复的，我希望将两个包装器合并为一个。一个简单的解决方案是：

newfun <- function(..., fun) {
  fun <- match.fun(fun)
  tab <- fun(...)
  # same manipulations as in mytable
  tab
}

newfun(warpbreaks[-1], fun = table)
newfun(breaks ~ ., warpbreaks, fun = xtabs)

但是，我可以根据匹配的函数指定默认参数吗？即：

如果fun = table，设置useNA = "ifany"；
或者如果 fun = xtabs，设置 na.action = NULL 和 addNA = TRUE。

此外，将 fun 限制为仅 table 和 xtabs 的“推荐”方法是什么？我想我有很多方法可以实现这一点（stopifnot、if/else、switch、match.arg），但我正在寻找良好的实践。

Answer 1

1) 尝试在 newfun 中重新定义 table 和 xtabs。通过将其转换为字符并使用 do.call.

确保 fun 正在调用本地版本

newfun <- function(..., fun) {
  table <- function(x, ..., useNA = "ifany") base::table(x, ..., useNA = useNA)
  xtabs <- function(x, ..., na.action = NULL, addNA = NULL)
      stats::xtabs(x, ..., na.action = na.action, addNA = addNA)
  fun <- deparse(substitute(fun))
  do.call(fun, list(...))
}

newfun(warpbreaks[-1], fun = table)
newfun(breaks ~ ., warpbreaks, fun = xtabs)

2) 另一种方法是有 3 个函数，一个用于您的 table 版本，一个用于您的 xtabs 版本，然后一个包含公共代码其他每个人都会这样称呼。这可能比 (1) 更直接。

mytable <- function(..., useNA = "ifany") {
  tab <- table(..., useNA = useNA)
  other(tab)
  tab
}
  
myxtabs <- function(..., na.action = NULL, addNA = TRUE) {
  tab <- xtabs(..., na.action = na.action, addNA = addNA)
  other(tab)
  tab
}

other <- function(x) {
  # code
}

默认参数取决于 R 中匹配的函数

Default argument depending of the function matched in R

r

function

default-value