r - 创建包装函数的最简单方法？

Question

这个问题在这里已经有了答案:





Passing along ellipsis arguments to two different functions? [duplicate]

(1 个回答)


6年前关闭。




这应该是非常基本的，但我对在 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=T),
               grp=letters[sample(4,size=100,replace=T)])

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

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() 的边距参数应该在其中确定。

在 prop() 中添加了特定函数(f 和 g) .

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

请注意，由于缺少值，如果将边距设置为 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>