Mean Variance Optimisation Under Weights Constraints - r

Question

I would like to find the weights for the portfolio that maximises the sharpe ration for a 3 risky assets case. The sum of the weights of all assets should equal 2, the weight of asset1 is forced to 1 and all assets weights >=0 (i.e the problem would be to maximise the portfolio risk adjusted return by adjusting only the weights for asset asset 2 and 3 subject to them not being more than 1 and >=0). Is this the right way of programing the problem using quadprog ?
library(quadprog)
covmat <- matrix(c(3.235343e-02, -3.378191e-03, -1.544574e-05,
-3.378191e-03, 8.769166e-03, 1.951734e-06,
-1.544574e-05, 1.951734e-06, 2.186799e-06),3,3)
A <- rbind(c(1,1,1),diag(3))
b <- c(2,1,0,0) # those are the constraints, sum of weights are 2 and weights of asset1 = 1
c <- c(0,0.1,0.05) # those are the assets returns, asset1 hasd a zero return but I want him to have a 100% weight out of the available 200% in my problem
# solve QP model
solve.QP(covmat,dvec=c,Amat=t(A),bvec=b,meq=2)$solution

Answer 1

Solve.QP is not optimizing Sharpe ratio (SR). As explained in the help ?solve.QP, it is minimizing this function:
min(-d^T b + 1/2 b^T D b) with the constraints A^T b >= b_0.
If you want to maximize SR try this http://comisef.wikidot.com/tutorial%3atangencyportfolio
But apparently that is for optimization without restrictions.
Well, it is possible to optimize minimizing the risk for several given returns. In other words, identify a relevant segment of the efficient frontier (EF) with restrictions, and compute the Sharpe ratio (SR). The tangent obviously will be that portfolio that maximizes the SR.
Given your data and restrictions:
#Find EF
#Min variance portfolio
aMat <- cbind(rep(1,nrow(covmat)),diag(1,nrow(covmat)))
bVec <- c(2,1,0,0)
zeros <- array(0, dim = c(nrow(covmat),1))
solQP <- solve.QP(covmat, zeros, aMat, bVec, meq = 1)
# weights and return for minimum variance portfolio
w.mv <- solQP$solution
r.mv<-t(w.mv) %*% excret
#Identify tangent approximately
#for that find min var portfolio for a relevant sequence of returns
#adding a return restriction to the optimization
sret<-seq(r.mv,max(excret)*1.1,length.out =50) #the maximum by try and error
sret<-sort(unique(c(max(excret),sret)))
rp=array(r.mv,1)
sp=sqrt(t(w.mv) %*% covmat %*% w.mv)
wp=t(matrix(w.mv))
aMatt <- cbind(excret,aMat)
# solve min var for every given return
for (ri in sret[-1]){
bVect <- c(ri,bVec)
solQP <- solve.QP(covmat, zeros, aMatt, bVect, meq = 2)
wp=rbind(wp, solQP$solution)
rp<-c(rp,t(solQP$solution) %*% excret)
sp<-c(sp,sqrt(t(solQP$solution) %*% covmat %*% solQP$solution))
}
IS=rp/sp #sharpe index
cbind(wp,sp,rp,IS)
wp[which.max(IS),] #tangent
cbind(wp,sp,rp,IS)[which.max(IS),]
plot(c(sp,diag(covmat)^.5),c(rp,excret))
#As you can see in the plot you have a corner solution
(c.sol<-c(1,1,0))
c(st=sqrt(t(c.sol) %*% covmat %*% c.sol),
rt=t(c.sol) %*% excret,
ISt=t(c.sol) %*% excret/sqrt(t(c.sol) %*% covmat %*% c.sol))
The output will be:
> wp[which.max(IS),] #tangent
[1] 1.00000000 0.98339763 0.01660237
> cbind(wp,sp,rp,IS)[which.max(IS),]
sp rp
1.00000000 0.98339763 0.01660237 0.18490315 0.09916988
IS
0.53633418
> plot(c(sp,diag(covmat)^.5),c(rp,excret))
> (c.sol<-c(1,1,0))
[1] 1 1 0
> c(st=sqrt(t(c.sol) %*% covmat %*% c.sol),
+ rt=t(c.sol) %*% excret,
+ ISt=t(c.sol) %*% excret/sqrt(t(c.sol) %*% covmat %*% c.sol))
st rt ISt
0.1853813 0.1000000 0.5394288