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

user_15157768 0
Viewed 119

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

do.call call r substitution function
1 Answers

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
user_104885040
Related