Sequential Quadratic Programming in R to find optimal weights of an Equally-Weighted Risk Contribution Portfolio

Question

Introduction to the problem

I am trying to write down a code in R so to obtain the weights of an Equally-Weighted Contribution (ERC) Portfolio. As some of you may know, the portfolio construction was presented by Maillard, Roncalli and Teiletche.

Skipping technicalities, in order to find the optimal weights of an ERC portfolio one needs to solve the following Sequential Quadratic Programming problem:

with:

Suppose we are analysing N assets. In the above formulas, we have that x is a (N x 1) vector of portfolio weights and Σ is the (N x N) variance-covariance matrix of asset returns.

What I have done so far

Using the function slsqp of the package nloptr which solves SQP problems, I would like to solve the above minimisation problem. Here is my code. Firstly, the objective function to be minimised:

ObjFuncERC <- function (x, Sigma) {
sum <- 0
R <- Sigma %*% x
    for (i in 1:N) {
        for (j in 1:N) {
            sum <- sum + (x[i]*R[i] - x[j]*R[j])^2
        }
    }
}

Secondly, the starting point (we start by an equally-weighted portfolio):

x0 <- matrix(1/N, nrow = N, ncol = 1)

Then, the equality constraint (weights must sum to one, that is: sum of the weights minus one equal zero):

heqERC <- function (x) {
    h <- numeric(1)
    h[1] <- (t(matrix(1, nrow = N, ncol = 1)) %*% x) - 1
    return(h)
}

Finally, the lower and upper bounds constraints (weights cannot exceed one and cannot be lower than zero):

lowerERC <- matrix(0, nrow = N, ncol = 1)
upperERC <- matrix(1, nrow = N, ncol = 1)

So that the function which should output optimal weights is:

slsqp(x0 = x0, fn = ObjFuncERC, Sigma = Sigma, lower = lowerERC, upper = upperERC, heq = heqERC)

Unfortunately, I do not know how to share with you my variance-covariance matrix (which takes name Sigma and is a (29 x 29) matrix, so that N = 29) so to reproduce my result, still you can simulate one.

The output error

Running the above code yields the following error:

Error in nl.grad(x, fn) : 
Function 'f' must be a univariate function of 2 variables.

I have no idea what to do guys. Probably, I have misunderstood how things must be written down in order for the function slsqp to understand what to do. Can someone help me understand how to fix the problem and get the result I want?

---

UPDATE ONE: as pointed out by @jogo in the comments, I have updated the code, but it still produces an error. The code and the error above are now updated.

---

UPDATE 2: as requested by @jaySf, here is the full code that allows you to reproduce my error.

## ERC Portfolio Test
# Preliminary Operations
rm(list=ls())
require(quantmod)
require(nloptr)

# Load Stock Data in R through Yahoo! Finance
stockData <- new.env()
start <- as.Date('2014-12-31')
end <- as.Date('2017-12-31')
tickers <-c('AAPL','AXP','BA','CAT','CSCO','CVX','DIS','GE','GS','HD','IBM','INTC','JNJ','JPM','KO','MCD','MMM','MRK','MSFT','NKE','PFE','PG','TRV','UNH','UTX','V','VZ','WMT','XOM')
getSymbols.yahoo(tickers, env = stockData, from = start, to = end, periodicity = 'monthly')

# Create a matrix containing the price of all assets
prices <- do.call(cbind,eapply(stockData, Op))
prices <- prices[-1, order(colnames(prices))]
colnames(prices) <- tickers

# Compute Returns
returns <- diff(prices)/lag(prices)[-1,]

# Compute variance-covariance matrix 
Sigma <- var(returns)
N <- 29

# Set up the minimization problem
ObjFuncERC <- function (x, Sigma) {
sum <- 0
R <- Sigma %*% x
    for (i in 1:N) {
        for (j in 1:N) {
            sum <- sum + (x[i]*R[i] - x[j]*R[j])^2
        }
    }
}


x0 <- matrix(1/N, nrow = N, ncol = 1)


heqERC <- function (x) {
    h <- numeric(1)
    h[1] <- t(matrix(1, nrow = N, ncol = 1)) %*% x - 1
}

lowerERC <- matrix(0, nrow = N, ncol = 1)
upperERC <- matrix(1, nrow = N, ncol = 1)

slsqp(x0 = x0, fn = ObjFuncERC, Sigma = Sigma, lower = lowerERC, upper = upperERC, heq = heqERC)

Answer 1

I spotted several mistakes in your code. For instance, ObjFuncERC is not returning any value. You should use the following instead:

# Set up the minimization problem
ObjFuncERC <- function (x, Sigma) {
  sum <- 0
  R <- Sigma %*% x
  for (i in 1:N) {
    for (j in 1:N) {
      sum <- sum + (x[i]*R[i] - x[j]*R[j])^2
    }
  }
  sum
}

heqERC doesn't return anything too, I also changed your function a bit

heqERC <- function (x) {
    sum(x) - 1
}

I made those changes and tried slsqp without lower and upper and it worked. Still, another thing to consider is that you set lowerERC and upperERC as matrices. Use the following instead:

lowerERC <- rep(0,N)
upperERC <- rep(1,N) 

Hope this helps.