Simplest way to create wrapper functions?

Question

This should be really basic but I'm totally new to defining functions in R.

Sometimes I want to define a function which simply consists of wrapping a base function in one or more other functions.

E.g., I wrote prop.table2 which basically accomplishes prop.table(table(...)).

The hitch that I see is that I also want my wrapper function to take the optional arguments of any of the subfunctions and pass them appropriately,

E.g.,

prop.table2(TABLE, useNA = "always", margin = 2) =
  prop.table(table(TABLE, useNA = "always"), margin = 2)

What's the simplest way to accomplish something like this (assuming there's no conflict in argument names, etc)? My baseline approach is to simply paste all of the optional arguments to each subfunction into the main function definition, i.e., defining:

prop.table2 <- function(..., exclude = if (useNA == "no") c(NA, NaN),
                        useNA = c("no", "ifany", "always"), dnn = list.names(...),
                        deparse.level = 1, margin = NULL)

---

Let's work from this example for concreteness:

dt <- data.table(id = sample(5, size = 100, replace = TRUE),
                 grp = letters[sample(4, size = 100, replace=TRUE)])

I want to replicate the following with my function:

dt[ , prop.table(table(grp, id, useNA = "always"), margin = 1)]

      id
grp             1          2          3          4          5       <NA>
  a    0.28571429 0.10714286 0.17857143 0.25000000 0.17857143 0.00000000
  b    0.12000000 0.28000000 0.08000000 0.12000000 0.40000000 0.00000000
  c    0.23076923 0.23076923 0.15384615 0.19230769 0.19230769 0.00000000
  d    0.23809524 0.19047619 0.23809524 0.28571429 0.04761905 0.00000000
  <NA>    

Here's where I'm at now, which still doesn't quite work; the idea was to split everything into those arguments which prop.table accepts and then pass the rest to table, but I'm still struggling.

prop.table2 <- function(...) {
  dots <- list(...)
  dots2 <- dots
  dots2[intersect(names(dots2), names(formals(prop.table)))] <- NULL
  dots3 <- dots2
  dots3[intersect(names(dots3), names(formals(table)))] <- NULL
  dots2[names(dots2) == ""] <- NULL
  prop.table(table(dots3, dots2), margin = list(...)$margin)
}
                                                          

Answer 1

You may use a functional with unspecified arguments (...). A functional is a higher order function that accepts a function as an argument (eg lapply()).

prop.table2 <- function(f, ...) {
  f(...)
}

a <- rep(c(NA, 1/0:3), 10)
table(round(a, 2), exclude = NULL)
#0.33  0.5    1  Inf <NA> 
#  10   10   10   10   10 

prop.table2(table, round(a, 2), exclude = NULL)
#0.33  0.5    1  Inf <NA> 
#  10   10   10   10   10 

@ MichaelChirico

Sorry that below is as much as I can think of at the moment.

A composite function is created, compose(), and the margin argument of prop.table() should be determined in it.

Specific functions (f and g) are added in prop().

Then additional arguments of table() can be added.

Note that, due to missing values, it'll cause an error if margin is set to be 2 as your example.

a <- rep(c(NA, 1/0:3), 10)

compose <- function(f, g, margin = NULL) {
    function(...) f(g(...), margin)
}
prop <- compose(prop.table, table)
prop(round(a, 2), exclude = NULL)

# 0.33  0.5    1  Inf <NA> 
# 0.2  0.2  0.2  0.2  0.2 

@MichaelChirico

Below is the second edit.

library(data.table)
set.seed(1237)
dt <- data.table(id=sample(5,size=100,replace=T),
                 grp=letters[sample(4,size=100,replace=T)])

compose <- function(f, g, margin = 1) {
    function(...) f(g(...), margin)
}
prop <- compose(prop.table, table)

dt[,prop(grp, id, useNA="always")]

#id
#grp           1          2          3          4          5       <NA>
#a    0.23529412 0.17647059 0.11764706 0.23529412 0.23529412 0.00000000
#b    0.11764706 0.29411765 0.05882353 0.17647059 0.35294118 0.00000000
#c    0.11538462 0.19230769 0.30769231 0.15384615 0.23076923 0.00000000
#d    0.34782609 0.13043478 0.13043478 0.17391304 0.21739130 0.00000000
#<NA>

Answer 2

I was missing a list() in my earlier comment, the following should work,

prop.table2 <- function(..., prop.param = list()) 
                 do.call(prop.table, c(list(table(...)), prop.param))

# with the example provided
library(data.table)
dt <- data.table(id=sample(5,size=100,replace=T),
                 grp=letters[sample(4,size=100,replace=T)])
dt[,prop.table2(grp,id,useNA="always",prop.param=list(margin=1))]
      id
grp             1          2          3          4          5       <NA>
  a    0.10714286 0.28571429 0.14285714 0.25000000 0.21428571 0.00000000
  b    0.09090909 0.18181818 0.30303030 0.15151515 0.27272727 0.00000000
  c    0.38095238 0.14285714 0.19047619 0.09523810 0.19047619 0.00000000
  d    0.11111111 0.22222222 0.44444444 0.16666667 0.05555556 0.00000000
  <NA> 

Edit: the OP suggests this modification based on previous answers to filter ... based on their names,

prop.table2 <- function(...){
  dots <- list(...)
  passed <- names(dots)
  # filter args based on prop.table's formals
  args <- passed %in% names(formals(prop.table))
  do.call('prop.table', c(list(do.call('table', dots[!args])), 
          dots[args]))
}

# with the example provided
library(data.table)
dt <- data.table(id=sample(5,size=100,replace=T),
                 grp=letters[sample(4,size=100,replace=T)])
dt[,prop.table2(grp,id,useNA="always",margin=1)]
      id
grp             1          2          3          4          5       <NA>
  a    0.10714286 0.28571429 0.14285714 0.25000000 0.21428571 0.00000000
  b    0.09090909 0.18181818 0.30303030 0.15151515 0.27272727 0.00000000
  c    0.38095238 0.14285714 0.19047619 0.09523810 0.19047619 0.00000000
  d    0.11111111 0.22222222 0.44444444 0.16666667 0.05555556 0.00000000
  <NA>