Portfolio Optimization, Tangency Portfolio, CML with shorts not allowed.

The functions in the previous post have been updated to put in the additional constraints that no portfolio weights can be negative, that is short selling is not allowed.

setwd("C:/Users/admin/Desktop/Data Analytics/QuantitativeFinance/QFLabs")
getwd()

library(ggplot2)
library(quadprog)

GetData20 <- function(CSVfile){
  baseData <- read.csv(CSVfile)
  N0 <- ncol(baseData)
  Close <- baseData[, 3:N0]
  logRet1 <- log(head(Close, -1) / tail(Close, -1))
  return(logRet1)
}

PlotData20 <- function(logRet1){
  Retn <- colMeans(logRet1)
  Risk <- diag(var(logRet1))
  RiskReturn <- as.data.frame(t(rbind(Retn,Risk)))
  plot1 <- ggplot(data = RiskReturn,aes(x = Risk, y = Retn) )
  plot1 <- plot1 + geom_point()
  plot1 <- plot1 + xlab("Risk / Variance") + ylab("Daily Returns") + ggtitle("Risk/Returns")
  plot1
}

rOptPort20 <- function(hRets,pRet, Shorts = TRUE){
  Dmat <- 2*cov(hRets)
  dvec <- rep(0,ncol(hRets))
  if (Shorts){
    ##message("Shorts : TRUE")    ## Shorts are allowed
    Amat <- cbind(rep(1,ncol(hRets)),colMeans(hRets))
    bvec <- c(1,pRet)
  } else {
    ##message("Shorts = FALSE")    ## Shorts are not allowed
    Amat <- cbind(rep(1,ncol(hRets)),colMeans(hRets),diag(1,nrow = ncol(hRets)))
    bvec <- c(1,pRet,rep(0,ncol(hRets)))
  }
  result = tryCatch({
    solve.QP(Dmat = Dmat, dvec = dvec, Amat = Amat, bvec = bvec, meq =2)
  }, warning = function(w){
    message("warning : ",pRet)
    return(NULL)
  }, error = function(w){
    message("infeasible : ", pRet)
    return(NULL)
  }, finally = {
  }
  )
  if (!is.null(result)){
    wP <- result$solution
    varP <- result$value
    
  }
  else{
    wP <- "error"
    varP <- "error"
  }
  retList <- list(wP,varP)
  names(retList) <- c("wP","varP")
  return(retList)
}

EFMinVar20 <- function(hRets, minRet, maxRet,Shorts = FALSE){
  smuP <- seq(minRet,maxRet,length=50)
  svarP <- sapply(smuP,function(x) rOptPort20(hRets,x,Shorts)$varP)
  EffF <- as.data.frame(cbind(smuP,svarP))
  EffF0 <- as.data.frame(EffF[EffF$svarP != "error",])
  EffF0 <- as.data.frame(apply(EffF0, 2, FUN = function(x) as.numeric(as.character(x))))
  minVar <- min(EffF0$svarP)
  L <- EffF0$svarP == minVar
  minRet <- EffF0[L,]$smuP
  minPoint <- as.data.frame(cbind(minRet,minVar))
  minVarwP <- rOptPort20(hRets,minRet,Shorts)$wP
  rList <-list(EffF0,minPoint,minVarwP)
  names(rList) <- c("EFF","minPoint","wP")
  return(rList)
}

EFMinVar20Plot <- function(list1){
  
  ealred  <- "#7D110C"
  
  plot2 <- ggplot(data = list1$EFF,aes(x = svarP, y = smuP) )
  plot2 <- plot2 + geom_point()
  plot2 <- plot2 + geom_point(data = list1$minPoint, aes(x = minVar,y = minRet),color = "red", size=3)
  plot2 <- plot2 + xlab("Variance") + ylab("Returns") + ggtitle("Efficient Frontier - MinVar")
  plot2
}

EFSharpe20 <- function(hRets, minRet, maxRet,RF, Shorts = FALSE){
  smuP <- seq(minRet,maxRet,length=50)
  svarP <- sapply(smuP,function(x) rOptPort20(hRets,x,Shorts)$varP)
  EffF <- as.data.frame(cbind(smuP,svarP))
  EffF0 <- as.data.frame(EffF[EffF$svarP != "error",])
  EffF0 <- as.data.frame(apply(EffF0, 2, FUN = function(x) as.numeric(as.character(x))))
  sharpe <- (EffF0$smuP-RF)/EffF0$svarP
  EFF <- as.data.frame(cbind(EffF0,sharpe,RF))
  L <- EFF$sharpe == max(EFF$sharpe)
  maxSharpe <- EFF[L,]
  wTP <- rOptPort20(hRets,maxSharpe$smuP,Shorts)$wP
  rList <-list(EFF,maxSharpe,wTP)
  names(rList) <- c("EFF","maxSharpe","wTP")
  return(rList)
}

EFSharpe20Plot <- function(list1){
  
  
  plot2 <- ggplot(data = list1$EFF,aes(x = svarP, y = smuP) )
  plot2 <- plot2 + geom_point()
  plot2 <- plot2 + geom_point(data = list1$maxSharpe, aes(x = svarP,y = smuP),colour = "red", pch =24, size=3)
  plot2 <- plot2 + geom_point(data = list1$maxSharpe, aes(x = 0,y = RF),color = "red", pch =24, size=3)
  plot2 <- plot2 + xlab("Variance") + ylab("Returns") + ggtitle("Efficient Frontier - Sharpe")
  plot2 <- plot2 + geom_abline(intercept = (list1$maxSharpe)$RF, slope = (list1$maxSharpe)$sharpe, colour = "red")
  plot2
}

#Testing

logRet <- GetData20("US5.csv")
##logRet <- GetData20("India5.csv")
PlotData20(logRet)

## Shorts = FALSE

z10 <- EFMinVar20(logRet,-0.0005,0.0002, Shorts = FALSE)
z10$wP
cminRet <- (z10$minPoint)$minRet
cminRet
z11 <- rOptPort20(logRet,cminRet,Shorts = FALSE)
z11$wP
EFMinVar20Plot(z10)
cminRet <- (z10$minPoint)$minRet
maxR <- cminRet + max(0.001,cminRet+ 2*abs(cminRet))
z10a <- EFMinVar20(logRet,cminRet, maxR, Shorts = FALSE)
EFMinVar20Plot(z10a)

z12 <- EFSharpe20(logRet,cminRet,maxR,0.0001,Shorts = FALSE)
z12$wTP
sum(z12$wTP)
(z12$maxSharpe)$smuP
(z12$maxSharpe)$svarP
maxSharpeRet <- (z12$maxSharpe)$smuP
EFSharpe20Plot(z12)

After the data is downloaded from the web and stored in  CSV file as explained in an earlier post. define the functions and test the program as follows :

> logRet <- GetData20("US5.csv")
> ##logRet <- GetData20("India5.csv")
> PlotData20(logRet)

Unlike the case were shorts are allowed, in this case, not every desired portfolio return is feasibile when shorts are not allowed. Here we search through a range of returns from -0.0005 to + 0.0002 and detect which return gives us the minimum variance. The means that are infeasible are flagged as sucn and ignored.
> z10 <- EFMinVar20(logRet,-0.0005,0.0002, Shorts = FALSE)
infeasible : -5e-04
.....
infeasible : -0.000242857142857143

Dataframe z10 contains the range of feasible returns and the corresponding variance. The portofolio weights are printed out as follows. The first one though technically negative is very, very small.
> z10$wP
[1] -1.386988e-17  4.295438e-02  1.356919e-01  4.977252e-01  3.236285e-01

we note the return achieved at the point of minimum variance
> cminRet <- (z10$minPoint)$minRet
> cminRet
[1] 0.0001285714

> EFMinVar20Plot(z10)

The efficient frontier is plotted, but this is not very useful because the range of returns that we have taken are "below" the minvariance point.

So in the next few lines, we have defined a range of returns that goes above, or higher than, the return for minimum variance

> cminRet <- (z10$minPoint)$minRet
> maxR <- cminRet + max(0.001,cminRet+ 2*abs(cminRet))
> z10a <- EFMinVar20(logRet,cminRet, maxR, Shorts = FALSE)
infeasible : 0.000761224489795919
.......
infeasible : 0.00112857142857143
> EFMinVar20Plot(z10a)

Next we identify the maximum Sharpe ratio, identify the tangency portfolio and draw the capital market line. Note that the risk free rate is 0.0001

> z12 <- EFSharpe20(logRet,cminRet,maxR,0.0001,Shorts = FALSE)
infeasible : 0.000761224489795919
....
infeasible : 0.00112857142857143
> z12$wTP
[1]  2.515328e-01  0.000000e+00 -1.456853e-17  7.484672e-01 -6.938894e-18
> sum(z12$wTP)
[1] 1
> (z12$maxSharpe)$smuP
[1] 0.0005163265
> (z12$maxSharpe)$svarP
[1] 0.0002621069
> maxSharpeRet <- (z12$maxSharpe)$smuP
> EFSharpe20Plot(z12)

Please note that by setting SHORTS = TRUE, this set of functions should be able to recreate the results given in the previous post.

-------------------------------------------------------------------------------------------
These programs can be run on StatAce, the free hosted R environment and get the same result.

Portfolio Optimisation, Tangency Portfolio and CML -- shorts allowed

I wish I could document this better, but let me get the code out first. The data used by the program shown in this post is available in a CSV file that can be created in the manner shown in an earlier post.

setwd("C:/Users/admin/Desktop/Data Analytics/QuantitativeFinance/QFLabs")
getwd()
##baseData <- read.csv("US5.csv")
baseData <- read.csv("India5.csv")
N0 <- ncol(baseData)
Close <- baseData[, 3:N0]
logRet <- log(head(Close, -1) / tail(Close, -1))
Retn <- colMeans(logRet)
Risk <- diag(var(logRet))
RiskReturn <- as.data.frame(t(rbind(Retn,Risk)))

library(ggplot2)

plot1 <- ggplot(data = RiskReturn,aes(x = Risk, y = Retn) )
plot1 <- plot1 + geom_point()
plot1 <- plot1 + xlab("Risk / Variance") + ylab("Daily Returns") + ggtitle("Risk/Returns")
plot1

# using portfolio.optim 
library(tseries)
w0 <- portfolio.optim(as.matrix(logRet),pm = 0.005,shorts = TRUE,riskless= FALSE)
w0$pw
sum(w0$pw)

# understanding the code

library(quadprog)

# the basic function that calculates the min variance portfolio with NO SHORTS

rOptPort10 <- function(hRets,pRet){
  Dmat <- 2*cov(hRets)
  dvec <- rep(0,ncol(hRets))
  Amat <- cbind(rep(1,ncol(hRets)),colMeans(hRets))
  bvec <- c(1,pRet)
  result <- solve.QP(Dmat = Dmat, dvec = dvec, Amat = Amat, bvec = bvec, meq =2)
  wP <- result$solution
  varP <- result$value
  retList <- list(wP,varP)
  names(retList) <- c("wP","varP")
  return(retList)
}

# testing out the function with expected return

z <- rOptPort10(logRet,0.005)

z$wP
z$varP
sum(z$wP)

# here we create the Efficient Frontier for a given range of returns

EFMinVar10 <- function(hRets, minRet, maxRet){
  smuP <- seq(minRet,maxRet,length=50)
  svarP <- sapply(smuP,function(x) rOptPort10(hRets,x)$varP)
  EffF <- as.data.frame(cbind(smuP,svarP))  
  minVar <- min(EffF$svarP)
  L <- EffF$svarP == minVar
  minRet <- EffF[L,]$smuP
  minPoint <- as.data.frame(cbind(minRet,minVar))
  minVarwP <- rOptPort10(hRets,minRet)$wP
  rList <-list(EffF,minPoint,minVarwP)
  names(rList) <- c("EFF","minPoint","wP")
  return(rList)
}

# We use the above function to get the points of the Efficient Frontier
# and numerically detect the point of minimum variance

z10 <- EFMinVar10(logRet,-0.005,.005)
z10$wp
cminRet <- (z10$minPoint)$minRet
z11 <- rOptPort10(logRet,cminRet)
z11$wP

# This function plots the Efficient Frontier and showing the point of minimum variance

EFMinVar10Plot <- function(list1){
  
  plot2 <- ggplot(data = list1$EFF,aes(x = svarP, y = smuP) )
  plot2 <- plot2 + geom_point()
  plot2 <- plot2 + geom_point(data = list1$minPoint, aes(x = minVar,y = minRet),color = "red", size=3)
  plot2 <- plot2 + xlab("Variance") + ylab("Returns") + ggtitle("Efficient Frontier - MinVar")
  plot2
}

EFMinVar10Plot(z10)
cminRet <- (z10$minPoint)$minRet 

z10a <- EFMinVar10(logRet,min(0,cminRet),0.001)
EFMinVar10Plot(z10a)


# This function calculates the Max Sharpe Ratio
# and the Tangency Portfolio weights

EFSharpe10 <- function(hRets, minRet, maxRet,RF){
  smuP <- seq(minRet,maxRet,length=50)
  svarP <- sapply(smuP,function(x) rOptPort10(hRets,x)$varP)
  sharpe <- (smuP-RF)/svarP
  EFF <- as.data.frame(cbind(smuP,svarP,sharpe,RF))
  L <- EFF$sharpe == max(EFF$sharpe)
  maxSharpe <- EFF[L,]
  wTP <- rOptPort10(hRets,maxSharpe$smuP)$wP
  rList <-list(EFF,maxSharpe,wTP)
  names(rList) <- c("EFF","maxSharpe","wTP")
  return(rList)
}

z11 <- EFSharpe10(logRet,min(0,cminRet),0.001,0.0001)
z11$wTP
sum(z11$wTP)
(z11$maxSharpe)$smuP
(z11$maxSharpe)$svarP
maxSharpeRet <- (z11$maxSharpe)$smuP

# This function plots the Efficient Fronter and shows
# The Tangency Point and the Capital Market Line

EFSharpe10Plot <- function(list1){
 
  
  plot2 <- ggplot(data = list1$EFF,aes(x = svarP, y = smuP) )
  plot2 <- plot2 + geom_point()
  plot2 <- plot2 + geom_point(data = list1$maxSharpe, aes(x = svarP,y = smuP),colour = "red", pch =24, size=3)
  plot2 <- plot2 + geom_point(data = list1$maxSharpe, aes(x = 0,y = RF),color = "red", pch =24, size=3)
  plot2 <- plot2 + xlab("Variance") + ylab("Returns") + ggtitle("Efficient Frontier - Sharpe")
  plot2 <- plot2 + geom_abline(intercept = (list1$maxSharpe)$RF, slope = (list1$maxSharpe)$sharpe, colour = "red")
  plot2
}

EFSharpe10Plot(z11)

---

DONT PANIC ! This 20 minute video will explain what this code is doing


What does negative weights mean ? It means short selling. So what is short selling ? Let us explain.

If you have a Rs 100 you can invest Rs 80 in Stock A and Rs 20 in Stock B and so the weights are (0.8, 0.2). Note that the weights add up to 1.

 But through a process known as short selling, you could sell Rs 80 worth of Stock B [ that you do not have, at the moment ] get Rs 80. To this you add the Rs 100 that you have and invest Rs 180 [ Rs 100 + Rs 80 ] in Stock A. In this case your weights are (180,-80) or (1.8 and -0.8) and you would note that weights add up to 1 again.

Why would you do short selling ? There are many reasons. For example, you may believe that Stock A will give you very high returns. Also if you sell "short", that is sell shares that you do not have, you will have to, at some point in future, or in the next "period" buy the shares from the market and deliver it to the person to whom you had sold the shares.