Introduction:

The

#######  R Script for Black-Litterman Model#######

rm(list=ls())
library("quadprog")
## Warning: package 'quadprog' was built under R version 3.2.3
library("MASS")
## Warning: package 'MASS' was built under R version 3.2.5
setwd("C:/Users/Pavan/Downloads/Tutorial_Files/")

#Loading the covariance matrix
cov<-read.csv("C_mat.csv",header=TRUE)
str(cov)
## 'data.frame':    8 obs. of  9 variables:
##  $ X  : Factor w/ 8 levels "IB","IDE","IEE",..: 4 1 5 6 7 8 2 3
##  $ UB : num  0.001005 0.001328 -0.000579 -0.000675 0.000121 ...
##  $ IB : num  0.00133 0.00728 -0.00131 -0.00061 -0.00224 ...
##  $ ULG: num  -0.000579 -0.001307 0.059852 0.027588 0.063497 ...
##  $ ULV: num  -0.000675 -0.00061 0.027588 0.029609 0.026572 ...
##  $ USG: num  0.000121 -0.002237 0.063497 0.026572 0.102488 ...
##  $ USV: num  0.000128 -0.000989 0.023036 0.021465 0.042744 ...
##  $ IDE: num  -0.000445 0.001442 0.032967 0.020697 0.039943 ...
##  $ IEE: num  -0.000437 -0.001535 0.048039 0.029854 0.065994 ...
covar<-as.matrix(cov[,2:9])
colnames(covar)<-c("UB","IB","ULG","ULV","USG","USV","IDE","IEE")
rownames(covar)<-c("UB","IB","ULG","ULV","USG","USV","IDE","IEE")

#Loading the Means of Assets
meanas<-read.csv("means.csv",header=TRUE)
meanas$AssetClass<-c("UB","IB","ULG","ULV","USG","USV","IDE","IEE")

Simple Mean variance method:

The Simple Mean variance method is implemented in below R-code and the effeicient frountier is plotted for the same method.

#######   R Script for simple mean variance optimization ####### 
#Define the QP
Dmat <- 2*covar
dvec <- rep(0,8)
Amat <- matrix(c(meanas$m,-meanas$m,rep(1,8),rep(-1,8),diag(length(meanas$m))),8,12)

# compute efficient frontier for eight stocks
varP=vector()
sigmaP=vector()
w1=vector()
w2=vector()
w3=vector()
w4=vector()
w5=vector()
w6=vector()
w7=vector()
w8=vector()

#Expected Returns 20 values
Rvals=seq(min(meanas$m)+0.1^10,max(meanas$m)-0.1^10,length.out=20);


for (i in 1:length(Rvals)) {
  R=Rvals[i]
  bvec <- c(R,-R,1,-1,0,0,0,0,0,0,0,0)
  qpSol=solve.QP(Dmat,dvec,Amat,bvec)
  varP[i]=qpSol$value
  sigmaP[i]=sqrt(varP[i])
  w1[i]=qpSol$solution[1];
  w2[i]=qpSol$solution[2];
  w3[i]=qpSol$solution[3];
  w4[i]=qpSol$solution[4];
  w5[i]=qpSol$solution[5];
  w6[i]=qpSol$solution[6];
  w7[i]=qpSol$solution[7];
  w8[i]=qpSol$solution[8];
}

#Portfolio weights
weightsoutput<-data.frame(w1,w2,w3,w4,w5,w6,w7,w8)
#Checking whether summation is equal to one
weightsum<-apply(weightsoutput,1,sum)

#Efficient frontier Plot 
plot(sigmaP,Rvals,type = 'l',lty = 1,lwd=3, xlab = 'Risk',ylab = 'Returns', main = 'Simple mean variance method',col = 'blue')

Black Litterman Model:

The Black Litterman model is implemented in R-code and it is shared below. The output of the Black Litterman model and the Simple Mean variance model are plotted in same graph and compared.

#######   R Script for Black-Litterman Optimization ####### 
q <- matrix(c(0.041,0.016,0.008),3,1)
P <- matrix(c(0,0,0,0,0,0,0,0, 0,0,0,0,0,0,-1,1, 0,0,-1,0,1,0,0,0 ), 3, 8, byrow = TRUE)
sigma <- matrix(c(0.000801,0,0, 0,0.009546,0, 0,0,0.000884), 3,3, byrow = TRUE)
tau = 0.25
pi <- as.matrix(meanas$m)

#Calculating the first term in BL method(Sum of weights = 1)
tau_cov= tau*covar
weight_1 = ginv(tau_cov)
P_transpose = t(P)
sigma_inv = ginv(sigma)
weight_2 <- P_transpose %*% sigma_inv %*% P
first_term_before_inv = weight_1 + weight_2
first_term = ginv(first_term_before_inv)

#Calculating te second term in BL method(Sum of weighted Pi and Q)
pi_component = weight_1 %*% pi
q_component = P_transpose %*% sigma_inv %*% q
second_term = pi_component + q_component

#Final BL matrix
BL_matrix = first_term %*% second_term

#Define the QP
Dmat_BL <- 2*covar
dvec_BL <- rep(0,8)
Amat_BL <- matrix(c(BL_matrix,-BL_matrix,rep(1,8),rep(-1,8),diag(length(BL_matrix))),8,12)

# compute efficient frontier for eight stocks
varP_BL=vector()
sigmaP_BL=vector()
w1_BL=vector()
w2_BL=vector()
w3_BL=vector()
w4_BL=vector()
w5_BL=vector()
w6_BL=vector()
w7_BL=vector()
w8_BL=vector()

#Expected Returns 20 values
Rvals_BL=seq(min(BL_matrix)+0.1^10,max(BL_matrix)-0.1^10,length.out=20);

for (i in 1:length(Rvals_BL)) {
  R=Rvals_BL[i]
  bvec_BL <- c(R,-R,1,-1,0,0,0,0,0,0,0,0)
  qpSol_BL=solve.QP(Dmat_BL,dvec_BL,Amat_BL,bvec_BL)
  varP_BL[i]=qpSol_BL$value
  sigmaP_BL[i]=sqrt(varP_BL[i])
  w1_BL[i]=qpSol$solution[1];
  w2_BL[i]=qpSol$solution[2];
  w3_BL[i]=qpSol$solution[3];
  w4_BL[i]=qpSol$solution[4];
  w5_BL[i]=qpSol$solution[5];
  w6_BL[i]=qpSol$solution[6];
  w7_BL[i]=qpSol$solution[7];
  w8_BL[i]=qpSol$solution[8];
}

#Portfolio weights
weightsoutput<-data.frame(w1,w2,w3,w4,w5,w6,w7,w8)
#Checking whether summation is equal to one
weightsum<-apply(weightsoutput,1,sum)

1: Plot of efficient frontier for two models:

The effecient frontiers of the two models is plotted in the same graph and are compared to see which one gives better returns.

#Efficient frontier Plot 
par(mfrow = c(1,1))
plot(sigmaP_BL,Rvals_BL,type = 'l',lty = 1,lwd=3, xlab = 'Risk',ylab = 'Returns', main = 'Visualization of Simple variance method Vs BL method',col = 'blue')
lines(sigmaP,Rvals,"l",lty = 1,lwd=3,col = 'red')
legend('topleft', c("Simple variance method","BL Method"), pch = 17,  col = c('red','blue'), text.col = c('red','blue'), cex = .6)

2: Visualization of fractions of each asset for two models:

For the eight assets from the US asset classes, each asset fraction is plotted for both Simple mean variance method and for Black Litterman model.

#Weights of portfolio assets vs expected returns in separate plots
par(mfrow = c(2,2))
plot(Rvals,w1,type = 'l', lty = 1,lwd=3, xlab ='' ,ylab = 'Weight' , main = 'US Bonds', col = 'red')
lines(Rvals_BL,w1,"l",lty = 1,lwd=3,col = 'blue')
plot(Rvals,w2,type = 'l', lty = 1,lwd=3,xlab ='Returns' ,ylab = 'Weight' , main = "Int'l Bonds", col = 'red')
lines(Rvals_BL,w2,"l",lty = 1,lwd=3,col = 'blue')
plot(Rvals,w3,type = 'l', lty = 1, lwd=3,xlab ='Returns' ,ylab = 'Weight' , main = "US Large Growth", col = 'red')
lines(Rvals_BL,w3,"l",lty = 1,lwd=3,col = 'blue')
plot(Rvals,w4,type = 'l', lty = 1,lwd=3, xlab ='Returns' ,ylab = 'Weight' , main = "US Large Value", col = 'red')
legend('topleft', c("Simple variance method","BL Method"), pch = 12,  col = c('red','blue'), text.col = c('red','blue'), cex = .6)
lines(Rvals_BL,w4,"l",lty = 1,lwd=3,col = 'blue')

plot(Rvals,w5,type = 'l', lty = 1,lwd=3, xlab ='Returns' ,ylab = 'Weight' , main = "US Small Growth", col = 'red')
lines(Rvals_BL,w5,"l",lty = 1,lwd=3,col = 'blue')
plot(Rvals,w6,type = 'l', lty = 1,lwd=3, xlab ='Returns' ,ylab = 'Weight' , main = "US Small Value", col = 'red')
lines(Rvals_BL,w6,"l",lty = 1,lwd=3,col = 'blue')
plot(Rvals,w7,type = 'l', lty = 1,lwd=3, xlab ='Returns' ,ylab = 'Weight' , main = "Int'l Dev Equity", col = 'red')
lines(Rvals_BL,w7,"l",lty = 1,lwd=3,col = 'blue')
plot(Rvals,w8,type = 'l', lty = 1,lwd=3, xlab ='Returns' ,ylab = 'Weight' , main = "Int'l Emerg Equity", col = 'red')
lines(Rvals_BL,w8,"l",lty = 1,lwd=3,col = 'blue')
legend('topleft', c("Simple variance method","BL Method"), pch = 12,  col = c('red','blue'), text.col = c('red','blue'), cex = .6)

3: Observations and Interpretations:

We observed that returns are higher for the same amount of risk as compared to simple mean variance model.

It is also observed for the data that US Bonds have least risk and low returs.