Простейший способ создания функций обертки?

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=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

я пропускал список() в моем предыдущем комментарии, должно работать,

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: ОП предлагает эту модификацию 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> 

Answer 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().

Специфические функции (F и г) добавляют в 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>