默认参数取决于 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。确保 fun 通过将其转换为字符并使用 do.call 来调用本地版本。

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
}