Definiowanie nowej klasy funkcji w R

Question

Zmieniam klasę niektórych funkcji, które buduję w R, aby dodać atrybut opisu i ponieważ chcę używać generics S3, aby obsłużyć wszystko dla mnie. Zasadniczo mam strukturę jak

foo <- function(x) x + 1 

addFunction <- function(f, description) { 
    class(f) <- c("addFunction", "function") 
    attr(f, "description") <- description 
    f 
} 

foo <- addFunction(foo, "Add one") 

a następnie zrobić rzeczy jak

description <- function(x) UseMethod("description") 
description.default <- function(x) deparse(substitute(x)) 
description.addFunction <- function(x) attr(x, "description") 

Działa to dobrze, ale to nie jest tak elegancki. Zastanawiam się, czy możliwe jest zdefiniowanie nowej klasy funkcji, tak aby instancje tej klasy można było zdefiniować w składni podobnej do składni function. Innymi słowy, jest to możliwe do zdefiniowania addFunction takie, że foo generowany jest w następujący sposób:

foo <- addFunction(description = "Add one", x) { 
    x + 1 
} 

(lub coś podobnego, nie mam silne uczucia co gdzie atrybut powinien zostać dodany do funkcji)?

Dzięki za przeczytanie!

---

Aktualizacja: ja eksperymentowałem trochę więcej z ideą, ale naprawdę nie osiągnął jeszcze żadnych konkretnych rezultatów - więc jest to tylko przegląd moich obecnych (Aktualizacja) myśli na ten temat:

Próbowałem po prostu skopiować funkcję function(), nadając jej inną nazwę, a następnie manipulując nią później. Jednak to nie działa i chciałbym żadnych nakładów na co się tu dzieje:

> function2 <- `function` 
> identical(`function`, function2) 
[1] TRUE 
> function(x) x 
function(x) x 
> function2(x) x 
Error: unexpected symbol in "function2(x) x" 
> function2(x) 
Error: incorrect number of arguments to "function" 

Jak function() jest prymitywne funkcja Próbowałem patrząc na C-kod zdefiniowaniem więcej wskazówek. Byłem szczególnie zaintrygowany komunikatem o błędzie z połączenia function2(x). C-kodu bazowego function() jest

/* Declared with a variable number of args in names.c */ 
    SEXP attribute_hidden do_function(SEXP call, SEXP op, SEXP args, SEXP rho) 
{ 
    SEXP rval, srcref; 

    if (TYPEOF(op) == PROMSXP) { 
    op = forcePromise(op); 
    SET_NAMED(op, 2); 
    } 
    if (length(args) < 2) WrongArgCount("function"); 
    CheckFormals(CAR(args)); 
    rval = mkCLOSXP(CAR(args), CADR(args), rho); 
    srcref = CADDR(args); 
    if (!isNull(srcref)) setAttrib(rval, R_SrcrefSymbol, srcref); 
    return rval; 
    } 

i z tego wniosku, że z jakiegoś powodu, przynajmniej dwa z czterech argumentów call, op, args i rho są obecnie wymagane. Od podpisu do_function() Zgaduję, że cztery argumenty przekazane do do_function powinny być wywołaniem, obietnicą, listą argumentów, a następnie być może środowiskiem. Próbowałem wiele różnych kombinacji dla function2 (w tym utworzenie do dwóch z tych argumentów null), ale wciąż otrzymuję ten sam (nowy) komunikat o błędzie:

> function2(call("sum", 2, 1), NULL, list(x=NULL), baseenv()) 
Error: invalid formal argument list for "function" 
> function2(call("sum", 2, 1), NULL, list(x=NULL), NULL) 
Error: invalid formal argument list for "function" 

Ten komunikat o błędzie jest zwracany z C- funkcja CheckFormals(), które ja również spojrzał w górę:

/* used in coerce.c */ 
    void attribute_hidden CheckFormals(SEXP ls) 
{ 
    if (isList(ls)) { 
    for (; ls != R_NilValue; ls = CDR(ls)) 
     if (TYPEOF(TAG(ls)) != SYMSXP) 
     goto err; 
    return; 
    } 
    err: 
    error(_("invalid formal argument list for \"function\"")); 
    } 

nie jestem biegły w języku C w ogóle, więc od tej chwili nie jestem pewien, co robić dalej.

Więc to są moje zaktualizowane pytania:

• Dlaczego function i function2 nie zachowują się w ten sam sposób? Dlaczego muszę wywołać function2, używając innej składni, gdy są uznane za identyczne w R?
• Jakie są właściwe argumenty, aby function2([arguments]) rzeczywiście zdefiniować funkcję?

Answer 1

Niektóre słowa kluczowe w języku R, takie jak if i function mają specjalną składnię w sposobie wywoływania funkcji podstawowych. W razie potrzeby całkiem łatwo jest użyć if, np.

`if`(1 == 1, "True", "False") 

jest równoważna

if (1 == 1) { 
    "True" 
} else { 
    "False" 
} 

function jest trudniejsze. Na ten temat można uzyskać pomoc pod numerem a previous question.

Dla aktualnego problemu oto jedno rozwiązanie:

# Your S3 methods 
description <- function(x) UseMethod("description") 
description.default <- function(x) deparse(substitute(x)) 
description.addFunction <- function(x) attr(x, "description") 

# Creates the pairlist for arguments, handling arguments with no defaults 
# properly. Also brings in the description 
addFunction <- function(description, ...) { 
    args <- eval(substitute(alist(...))) 
    tmp <- names(args) 
    if (is.null(tmp)) tmp <- rep("", length(args)) 
    names(args)[tmp==""] <- args[tmp==""] 
    args[tmp==""] <- list(alist(x=)$x) 
    list(args = as.pairlist(args), description = description) 
} 

# Actually creates the function using the structure created by addFunction and the body 
`%{%` <- function(args, body) { 
    stopifnot(is.pairlist(args$args), class(substitute(body)) == "{") 
    f <- eval(call("function", args$args, substitute(body), parent.frame())) 
    class(f) <- c("addFunction", "function") 
    attr(f, "description") <- args$description 
    f 
} 

# Example. Note that the braces {} are mandatory even for one line functions 

foo <- addFunction(description = "Add one", x) %{% { 
    x + 1 
} 

foo(1) 
#[1] 2