Currently, I have two very similar wrappers around table and 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)

Since most code is duplicated, I wish to combine both wrappers into a single one. A simple solution is:

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)

However, can I specify default arguments depending of the function that is matched? i.e.:

• if fun = table, set useNA = "ifany";
• or if fun = xtabs, set na.action = NULL and addNA = TRUE.

In addtion, what is the "recommanded" way to restrict fun to only table and xtabs? I guess I have many ways to achieve this (stopifnot, if/else, switch, match.arg), but I am looking for good practice here.

CodePudding user response：

1) Try redefining table and xtabs in newfun. Ensure that fun is calling the local versions by converting it to character and using 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) Another approach is to have 3 functions, one for your version of table, one for your version of xtabs and then one to contain the common code which each of the others would call. That may be more straight forward than (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
}