创建包装函数的最简单方法？ [复制]

Question

这应该是非常基本的，但我对在 R 中定义函数完全陌生。

有时我想定义一个函数，它只是将一个基本函数包装在一个或多个其他函数中。

例如，我写了prop.table2，它基本上完成了prop.table(table(...))。

我看到的问题是我还希望我的包装函数获取任何子函数的可选参数并适当地传递它们，

例如，

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

完成这样的事情的最简单方法是什么（假设参数名称等没有冲突）？我的基线方法是将每个子函数的所有可选参数简单地粘贴到主函数定义中，即定义：

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

---

让我们从这个例子开始具体化：

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

我想用我的函数复制以下内容：

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>    

这就是我现在所处的位置，但它仍然无法正常工作；想法是将所有内容拆分为prop.table 接受的那些参数，然后将其余部分传递给table，但我仍在苦苦挣扎。

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

您可以使用带有未指定参数 (...) 的函数。函数是接受函数作为参数的高阶函数（例如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 

@迈克尔基里科

对不起，下面是我目前能想到的。

创建了一个复合函数compose()，prop.table()的margin参数应该在里面确定。

具体函数（f和g）添加在prop()中。

然后可以添加table()的附加参数。

请注意，由于缺少值，如果 margin 以您的示例设置为 2，则会导致错误。

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

以下是第二次编辑。

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

我在之前的评论中遗漏了一个 list()，以下应该可以工作，

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> 

编辑：OP 建议对 based on previous answers 进行此修改，以根据其名称过滤 ...，

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>