创建包装函数的最简单方法是什么?

时间:2015-05-06 19:45:57

标签: r

这应该是非常基本的,但我在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)
}

2 个答案:

答案 0 :(得分:2)

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

很抱歉,以下是我现在能想到的内容。

创建复合函数compose(),并在其中确定prop.table()的边距参数。

prop()中添加了特定功能( f g )。

然后可以添加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>

答案 1 :(得分:1)

我在之前的评论中遗漏了一个列表(),以下内容应该有效,

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>