Passing variables though hierarchy of functions in Rstudio

I am facing a problem when passing arguments though nested functions.The basic objective is to minimize a quadratic function subject to a parametrized constraint, where the parameter is a. Here is my R code.

library(MASS)
library(NlcOptim)
#####



#### constraint functions
constraints=function(x){
f = NULL
f = rbind(f,a *sum(x)-1) # parameter is here
g = NULL
return(list(ceq=f,c=g))
}

#### objective function
objective =function(x){
return( x[1]^2 + x[2]^2 )  
}

# function to carry out the optimization
minimize_quadratic = function(a) {

x0= rep(0.5, 2) # initial guess on the simplex

 
#### minimize

result <- solnl(x0, objfun=objective, 
confun = constraints )

return(result)
}

When applying the function as follows, every is fine.

a = -6
optimum <- minimize_quadratic(a)

The issue is when calling the function minimize_quadratic within another function, where the parameter a is defined within the function

function_within_function <- function() {
a = -6
temp = minimize_quadratic(a)
return(temp)
}

One gets an error message, stating that a is not found. How to get around this issue? The key problem here is that the function solnl does not seem to accept argument, thus creating a function contraints(x,a) will not help. I suspect that making the argument a global instead of local may solve the issue. Thanks in advance for the help.

Solution

You can make a functional (function that returns a function) to generate the constraint function with the proper a value. You can find a very good introduction here. Like this (cleaning up the code of unnecessary NULL and return() statements too).

constr_gen = function(a) {
  function(x) {
    list(ceq = a * sum(x) - 1, c = NULL)
  }
}

objective = function(x) {
  sum(x^2)
}

minimize_quadratic = function(a) {
  x0 = rep(0.5, 2) # initial guess on the simplex
  #### minimize
  NlcOptim::solnl(x0, objfun = objective, confun = constr_gen(a))
}

a = -6
result_1 = minimize_quadratic(a)

function_within_function <- function() {
  a = -6
  minimize_quadratic(a)
}

result_2 = function_within_function()

identical(result_1, result_2)
# [1] TRUE