rrlangnse

Bind symbol in user-defined function to environment internal to my function


I've tried to work my way through https://adv-r.hadley.nz/index.html, which seems like a great source, but I'm still stuck at the basics it seems.

I want to write a function "my_fun(boolex, probs)" which takes a user-defined expression "boolex" as input and evaluates it in an environment "e" internal to my_fun. I want to allow the user to write their own functions "user_fun" which should be able to call a function P(x) that is defined in "e", as it accesses arguments of my_fun that are not known to user_fun in advance.

Here's what I tried (this is a toy example, but the structure of what I want to achieve is there):


library(rlang)

my_fun <- function(boolex, probs){
  e <- env(caller_env(),
           .probs=probs,
           P=function(i){
             .probs[as.character(enexpr(i))]
           }
  )
  
  env_print(e)
  
  print(enexpr(boolex))
  
  eval(enexpr(boolex), e)
}



user_fun <- function(x, y){
  x>=P(y)
}


my_fun(
  user_fun(0.4, C), 
  c(A=0.1, B=0.2, C=0.3, D=0.4)
) 

However, I get the error that function P was not found. I'm guessing P in user_fun gets bound to P earlier, but even then I would expect it to be in caller_env() and available.

EDIT: I previously tried to set the closure environment of user_fun directly using something like

 fn_env(get(call_name(enexpr(boolex)))) <- current_env()

and specify P at the beginning of the body of my_fun(). This in itself does not seem to work, I guess the copy-on-modify semantics kick in somehow. But maybe something involving fn_env<- would be a more fruitful route?


Solution

  • Running boolex in a different environment won't also change the environment of the user_fun function. To do that pass the user_fun and its arguments as two separate arguments, a function and a list of arguments, so that we can access user_fun directly enabling us to to change its environment to a new environment e with P. No packages are used.

    my_fun <- function(fun, args, probs) {
      e <- new.env(parent = environment(fun))
      environment(fun) <- e
      e$P <- function(i) probs[i]
      do.call(fun, args)
    }
    
    user_fun <- function(x, y) x >= P(y)
    
    my_fun(user_fun, list(0.4, "C"), c(A = 0.1, B = 0.2, C = 0.3, D = 0.4))
    ##    C 
    ## TRUE 
    

    Added

    In a comment it is stated that there can be several functions and presumably any of them could reference P. In that case specify any such function in a separate argument, funs (a default is provided that assumes that the functions are defined in envir), and in my_fun create a proto object (which is an environment that automatically sets the environment of functions in it) containing all functions of interest.

    library(proto)
    
    my_fun <- function(expr, probs, funs, envir = parent.frame()) {
      s <- substitute(expr)
      if (missing(funs)) funs <- all.vars(s, functions = TRUE) |>
        mget(envir, mode = "function",  inherits = FALSE, ifnotfound = NA) |>
        Filter(f = is.function)
    
      .f <- function() {}
      body(.f) <- s
      funs$.f <- .f
      funs$P <- function(i) probs[[i]]
      funs$probs <- probs
      p <- as.proto(funs, parent = envir)
      p[[".f"]]()
    }
    
    user_fun <- user_fun2 <- function(x, y) x >= P(y)
    
    my_fun(user_fun(0.3, "C") + user_fun2(0.4, "B"), 
      probs = c(A = 0.1, B = 0.2, C = 0.3, D = 0.4))
    ## [1] 2