R optimization using OPTIM

Question

I have a covariance matrix and vector of expected returns as my inputs. I have used optim to solve for the weights that maximize the portfolio's return/volatility. I like optim as you can create your own function which you enter into the optimization. I have checked the results against Excel's solver and it works fine.

For the next step I want to maximize the portfolio return for a given target volatility. I am struggling with this as optim only allows one to place constraints on the solved parameters (weights in my case) using method="L-BFGS-B"

I thought I could get around this by using IF statements in my function (which is going to be maximized) such that if the absolute difference between my portfolio volatility and my target volatility is more than a specific threshold, make the portfolio return = 0, otherwise use the calculated portfolio return. I’ve defined how to calculate the portfolio volatility and return in my function. I was hoping that as the optimizer solved the weights it would essentially discard all the solutions I don’t want as their returns would be zero. Unfortunately this didn’t happen.

This is my coding. Does anyone know how I can achieve this using optim or what I am doing wrong?

#generate data set
set.seed(1)
A <- runif(100);head(A)
B <- runif(100);head(B)
C <- runif(100);head(C)
D <- runif(100);head(D)

returns <- cbind(A,B,C,D)
cov(returns)


Weights <-cbind(0.25,0.25,0.25,0.25) #starting point is an equally weighted portfolio
EReturns <- cbind(0.0064,0.0045,-0.0050,0.0028);  #Expected Returns
VCV <- cov(returns) #Sample covariance matrix

TargetVol <- 0.01

OptWeightE <- function(Weights, ExpectedReturns, VCV, TargetVol){
  Weights <- abs(Weights)/sum(abs(Weights)) #ensures all the weights will be positive and sum to 100%
  PReturn <- Weights %*% t(EReturns)               
  PVol <- ((Weights %*% VCV) %*% Weights)^0.5
  if (abs(PVol- TargetVol) > 0.005) { 
    PReturn <- 0
  }
  if (abs(PVol - TargetVol) < 0.005) { 
    PReturn <- Weights %*% t(EReturns)
  }
  -PReturn #negative the default is to minimise
}

solE <- optim(par = Weights, fn =OptWeightE,ExpectedReturns = EReturns, VCV = VCV, TargetVol = 0.01)

optWE <- abs(solE$par)/sum(solE$par); optWE
sum(optWE)

optVolWE <- ((optWE %*% VCV) %*% t(optWE))^0.5; optVolWE
optRE <- optWE %*% t(EReturns); optRE

Answer 1

This is not a complete answer, just a few pointers regarding your code (can't post it as a comment, as I'm a new member, too):

1. This part can be omitted, as you have specified PReturn before:

   if (abs(PVol - TargetVol) < 0.005) {
   PReturn <- Weights %*% t(EReturns)
   }
   

2. In you optimization you don't specify any bounds on the weights. In particular, we can get negative weights and a total sum of the weights that exceeds 1 - rescaling doesn't correct that error.
   My suggestion is that you omit the part

   if (abs(PVol- TargetVol) > 0.005) { 
   PReturn <- 0
   }
   

   in the OptWeightE function and instead use another minimizing function that allows for the condition

   sum(Weights)=1
   

   in the optimization process. This can be done easily with the "solnp" function in the "Rsolnp" package.
   Here's the code for the solnp optimization:

   #generate data set
   set.seed(1)
   A <- runif(100);head(A)
   B <- runif(100);head(B)
   C <- runif(100);head(C)
   D <- runif(100);head(D)
   
   returns <- cbind(A,B,C,D)
   cov(returns)
   
   
   Weights <-c(0.25,0.25,0.25,0.25) #starting point is an equally weighted portfolio
   EReturns <- c(0.0064,0.0045,-0.0050,0.0028);  #Expected Returns
   VCV <- cov(returns) #Sample covariance matrix
   
   TargetVol <- 0.01
   
   OptWeightE <- function(Weights, ExpectedReturns, VCV, TargetVol){
     Weights <- abs(Weights)/sum(abs(Weights)) #ensures all the weights will be positive and sum to 100%
     PReturn <- sum(Weights*EReturns)               
     -PReturn #negative the default is to minimise
   }
   
   eqf<-function(Weights,ExpectedReturns,VCV,TargetVol)(sum(Weights))
   
   ineqf<-function(Weights,ExpectedReturns,VCV,TargetVol)
   {
       PVol <- ((Weights %*% VCV) %*% Weights)^0.5;
       return(PVol)
   }
   
   solE2<-solnp(pars=Weights, ExpectedReturns = EReturns, VCV = VCV,
   TargetVol = 0.01, fun=OptWeightE, LB=rep(0,4),UB=rep(1,4),
   ineqfun=ineqf, ineqUB=0.5, ineqLB=0, eqfun<-eqf, eqB=1)
   solE2$pars
   sum(solE2$pars)
   

The Matrix terminology wasn't necessary, so I replaced it with vectors.
The optimization problem is specified as:
$$\underset{weights}{\min} \text{OptWeightE, s.t.}$$ $$\text{sum(weights)}=1\text{ and}$$ $$0\le\text{PVol}\le0.5$$ This yields the result that the whole weight should be placed on the first factor (which has the highest expected return), if we take e.g. $0.5$ as an upper bound. $0.005$, as you wrote in your question, was not feasible for PVol.

What I did, was give you the optimization framework. Hence, what you have to do now, to get a valid result, is:
Check, whether you correctly specified your functions. So far PReturn simply is the vector product of weights and the EReturns. This puts all the weight in the factor with the highest expected return (here the first factor), which is clearly not what you intended.
Hope this helps.