Search code examples
rfunctioncallsubstitutiondo.call

How to create a function that returns a function with fixed parameters in R?


I have some R-function target with a lot of parameters:

target = function(b1,b2,l1,l2,l3,o1,o2) return((b1+b2+l1+l2+l3+o1+o2)^2)

Some parameters of target should be kept fixed (stored in the named vector fixed) and some parameters should be variable (their names are stored in the vector variable):

fixed = c(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5)

variable = c("o2","b2")

Now, I want to write a function f with the inputs fixed and variable that returns me the (not executed) function target with the parameters in fixed fixed at the values in fixed.

My results so far:

f = function(fixed, variable){
  
  ### create the new "target" function with fixed parameters
  target_new = function() {}
  
  ### create the arguments
  formals(target_new) = setNames(rep(list(bquote()), length(variable)), variable) 
  
  ### create the body
  body(target_new) = call("target",fixed,variable)
  
  ### return the new "target" function with fixed parameters
  return(target_new) 
}

I fail to create the body. It should work with a combination of do.call, call, substitute or deparse - does anyone know how?

The desired output of f(fixed = c(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5), variable = c("o2","b2")) is:

function (o2, b2) 
target(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5, o2 = o2, b2 = b2)

EDIT

Defining the body via

### create the body
arguments = c(paste(variable,"=",variable), paste(names(fixed),"=",fixed))
body(f) = call("target",arguments)

yields

function (o2, b2) 
target(c("b1 = 1", "l1 = 2", "l2 = 3", "l3 = 4", "o1 = 5", "o2 = o2", "b2 = b2"))

which is almost the desired output (except for the quotation marks and the c()).


Solution

  • You can use do.call and assign as.symbol to the variable.

    target <- function(b1,b2,l1,l2,l3,o1,o2) return((b1+b2+l1+l2+l3+o1+o2)^2)
    fixed <- c(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5)
    variable <- c("o2","b2")
    
    f <- function(fixed, variable) {
      target_new <- function() {}
      formals(target_new) <- setNames(rep(list(bquote()), length(variable)), variable) 
    
      for(i in variable) assign(i, as.symbol(i))
      body(target_new) <- do.call("call", unlist(list("target",  as.list(fixed), mget(variable))))
    
      target_new
    }
    
    f(fixed = c(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5), variable = c("o2","b2"))
    #function (o2, b2) 
    #target(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5, o2 = o2, b2 = b2)
    #<environment: 0x564b81f2ded8>
    
    f(fixed, variable)(3, 4)
    #[1] 484