R中的序贯二次规划，以找到同等加权风险贡献组合的最优权重

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.

我试图在R中写下代码,以获得同等加权贡献(ERC)投资组合的权重。正如你们中的一些人可能知道的那样,投资组合建设由Maillard,Roncalli和Teiletche提出。

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

跳过技术细节,为了找到ERC组合的最佳权重,需要解决以下顺序二次规划问题:

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.

假设我们正在分析N个资产。在上面的公式中,我们得到x是投资组合权重的(N×1)向量,Σ是资产收益的(N×N)方差 - 协方差矩阵。

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:

使用解决SQP问题的软件包nloptr的函数slsqp,我想解决上面的最小化问题。这是我的代码。首先,要最小化的目标函数:

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):

然后,等式约束(权重必须总和为1,即:权重之和减去一等于零):

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):

最后,下限和上限约束(权重不能超过1且不能低于零):

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.

不幸的是,我不知道如何与你分享我的方差 - 协方差矩阵(它取名为Sigma并且是一个(29 x 29)矩阵,因此N = 29)所以为了重现我的结果,你仍然可以模拟一个。

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?

我不知道该怎么做。可能我误解了必须写下来的东西才能让slsqp函数理解该怎么做。有人可以帮助我了解如何解决问题并获得我想要的结果吗?

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.

更新一:正如@jogo在评论中指出的那样,我已经更新了代码,但它仍然会产生错误。现在更新了上面的代码和错误。

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

更新2:根据@jaySf的要求,这里是完整的代码,允许您重现我的错误。

## 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)

1 个解决方案

#1

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

我在你的代码中发现了几个错误。例如,ObjFuncERC没有返回任何值。您应该使用以下代码:

# 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也没有返回任何东西,我也改变了你的功能

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:

我做了这些更改并尝试了没有下部和上部的slsqp并且它起作用了。另外,要考虑的另一件事是将lowerERC和upperERC设置为矩阵。请改用以下内容:

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

Hope this helps.

希望这可以帮助。

#1