Przechwytywanie wyrażenia jako treść funkcji w R

Question

Próbuję napisać program, który pobiera wyrażenie jako dane wejściowe i zwraca funkcję z tym wyrażeniem, związanym jako jego treść.

caller <- function (expr, params) { 

    Function <- function (params, body, env = parent.frame()) { 
     # returns a function 

    } 

    Function(params, body = expr) 
} 

func <- caller (a + b, c('a', 'b')) 

func(1, 2) 
[1] 3 

mogę powiązać parametry dość łatwo, za pomocą coś jak

params <- c('a', 'b') 
f <- function() {} 
formals(f) <- structure(
    replicate(length(params), NULL), 
    names = params 
) 

Mam problemy wymyślanie sposób dynamicznie dodanie wyrażenia jako ciała. Próbowałem użyć substitute() i dostosowywanie make_function z biblioteki pryr, ale nie mogę w pełni sprawić, żeby wszystko działało. Moja najlepsza próba to:

body(f, parent.frame()) <- as.list(match.call())[-1]$body 

Nie mogłem tego użyć z substytutem. Wszelkie przemyślenia na temat wiązania ciała w taki sposób, aby najwyższy program działał zgodnie z oczekiwaniami?

Widziałem similar questions na SO, ale rozwiązania nie wydają się zaspokoić ten problem.

Answer 1

Oto rozwiązanie pozwalające na przyjmowanie parametrów bez wartości domyślnej. Łatwiej jest również przekazywać nazwy parametrów, ponieważ nie muszą być one ujęte w cudzysłowy.

Proszę sprawdzić komentarze w poniższym kodzie:

g <- function(...) 
{ 
    # Get the arguments as unevaluated expressions: 

    L <- as.list(substitute(list(...)))[-1] 

    # The first argument is the body expression (technically a call object): 

    expr <- L[[1]] 

    # If the expression is not enclosed in curly braces, let's force it: 

    if(as.character(expr[[1]]) != "{") expr <- call("{", expr) 

    # Drop the first argument: 

    L <- L[-1] 

    # Mark symbols to be used as names for missing parameters: 

    filter <- vapply(L, is.symbol, logical(1)) 

    params <- L 

    # The obscure expression "formals(function(x){})$x" returns a missing value, something really arcane ;-) : 

    params[filter] <- list(formals(function(x){})$x) 

    # Here the symbols are used as names: 

    names(params)[filter] <- vapply(L[filter], as.character, character(1)) 

    # Now the result: 

    f <- function(){} 

    formals(f) <- params 

    body(f) <- expr 

    # Just to make it nicier, let's define the enclosing environment as if the function were created outside g: 

    environment(f) <- parent.frame() 

    f 
} 

Niektóre testy:

> g(a+b, a, b=1) 
function (a, b = 1) 
{ 
    a + b 
} 


> f <- g({x <- a+b; x^2}, a, b) 
> f 
function (a, b) 
{ 
    x <- a + b 
    x^2 
} 
> f(2,3) 
[1] 25 
> f(1) 
Error in a + b : 'b' is missing 

> g(a+b, a=2, b=2)() 
[1] 4 

Answer 2

powiesz po prostu:

caller <- function(expr, params) { 
    f <- function() NULL 
    formals(f) <- structure(replicate(length(params), NULL), names=params) 
    body(f, envir=parent.frame()) <- substitute(expr) 
    f 
} 

To nie wykorzystuje wewnętrzną funkcję, które mogą być przyczyną problemów z substitute.

Należy zauważyć, że nie jestem pewien, czy to ustawienie środowiska zwracanej funkcji w wybrany sposób. Ustawia to środowisko, z którego wywołujesz caller.

Answer 3

Ciekawą alternatywą sposób określania argumentów funkcji jest użycie tego samego mechanizmu jak funkcja alist, który jest powszechnie używany w połączeniu z formals. To jak to jest zdefiniowane w pakiecie base:

alist <- function (...) as.list(sys.call())[-1L] 

to łatwo przystosowany do pracy z caller:

caller <- function(...) { 
    f <- function() NULL 
    formals(f) <- as.list(sys.call())[-(1:2)] 
    body(f, envir=parent.frame()) <- substitute(list(...))[[2]] 
    f 
} 

Pierwszy argument nadal określa ciało funkcji, a pozostałe argumenty działają dokładnie tak, jak w alist.

> func <- caller(a+b, a=, b=10) 
> func(1) 
[1] 11 
> func <- caller(a+b, a=, b=a) 
> func(10) 
[1] 20 

Można nawet tworzyć funkcje, które używają ...:

> func <- caller(c(...), ...=) 
> func("a", "b", "c") 
[1] "a" "b" "c"