Final Project IPA

Question 1.

Download monthly equity market capitalization of 7 countries Compute monthly equity market returns (in simple returns) based on market capitalization data.

{r. include = FALSE, message = FALSE} install.packages('SIT', repos = NULL, type='source')

Betting_Against_Beta_Equity_Factors_Monthly_1_ <- read_excel("Betting Against Beta Equity Factors Monthly (1).xlsx", 
                                                             sheet = "ME(t-1)", range = "A19:AD1165")
data  <- Betting_Against_Beta_Equity_Factors_Monthly_1_  ########

date <- as.Date(data$DATE, "%m/%d/%Y")


Betting_Against_Beta_Equity_Factors_Monthly_1_ <- xts(coredata(Betting_Against_Beta_Equity_Factors_Monthly_1_[, -1]), order.by = date)

stockpr = subset(Betting_Against_Beta_Equity_Factors_Monthly_1_, select = c(AUS,CAN,FRA,DEU,JPN,GBR,USA) )
stockpr2 <- with(stockpr, stockpr[(date >= "1989-12-31" & date <= "2021-12-31")])

monthly.return <- na.omit(Return.calculate(stockpr2, method = "discrete"))

head(monthly.return)

##                    AUS           CAN          FRA          DEU         JPN
## 1990-01-31  0.03066617  0.0242062712  0.106772375  0.175900236  0.02123232
## 1990-02-28  0.01574424 -0.0631233515 -0.039850578  0.022063077 -0.04670123
## 1990-03-31 -0.06035407  0.0006305838 -0.028605990  0.002080930 -0.08398405
## 1990-04-30 -0.02950981 -0.0104092150  0.067718048  0.095673570 -0.17803619
## 1990-05-31 -0.08247848 -0.0819545270  0.041442220 -0.061484068 -0.01682893
## 1990-06-30  0.09444762  0.0728235944  0.002914819  0.005735468  0.15212730
##                    GBR         USA
## 1990-01-31  0.09773906  0.01799629
## 1990-02-28  0.01176512 -0.07791268
## 1990-03-31 -0.03207884  0.01297222
## 1990-04-30 -0.03012199  0.02484288
## 1990-05-31 -0.06753591 -0.02987430
## 1990-06-30  0.13266871  0.08571573

tail(monthly.return)

##                     AUS          CAN           FRA          DEU           JPN
## 2021-07-31 -0.007808452 -0.004923728 -0.0159977640 -0.005650794  6.743379e-05
## 2021-08-31 -0.006427044 -0.005186644  0.0148548942  0.012951049 -1.218586e-02
## 2021-09-30  0.019011675  0.001517633 -0.0004440893  0.015669145  2.783157e-02
## 2021-10-31 -0.024477429 -0.023212521 -0.0501314877 -0.052374557  1.671376e-02
## 2021-11-30  0.041072770  0.068697882  0.0495422303  0.022591338 -3.342947e-02
## 2021-12-31 -0.058206115 -0.046620684 -0.0319030400 -0.047759221 -3.347900e-02
##                     GBR          USA
## 2021-07-31 -0.033224039  0.026827519
## 2021-08-31  0.025475826  0.009958025
## 2021-09-30  0.006104884  0.026998156
## 2021-10-31 -0.036415768 -0.040433011
## 2021-11-30  0.023093370  0.066567980
## 2021-12-31 -0.054600574 -0.016133549

Question 2.1.

Compute the equal-weighted portfolio returns EACH month starting from 1993/01 to 2021/12. Denote this strategy as the Benchmark portfolio and create its backtesting report using SIT package.

stockpr3 <- with(stockpr, stockpr[(date >= "1993-01-31" & date <= "2021-12-31")])

#convert returns into price (data market value of equity)
#stockpr3 <- cumprod(stockpr3 + 1)*100
#head(stockpr3)
data <- new.env()
#create 4 required input elements in data
data$prices <- stockpr3
data$weight <- stockpr3
data$execution.price <- stockpr3
data$execution.price[] <- NA
data$symbolnames <- colnames(data$prices)
prices <- data$prices
n = ncol(prices)

data$weight = ntop(prices, n)

model <-list()
model$equal.weight <- bt.run(data, trade.summary=T)

## Latest weights :
##              AUS   CAN   FRA   DEU   JPN   GBR   USA
## 2021-12-31 14.29 14.29 14.29 14.29 14.29 14.29 14.29
## 
## Performance summary :
##  CAGR    Best    Worst   
##  8.2 14.1    -21.7

capital = 100000
data$weight[] = (capital / prices) * data$weight
equal.weight = bt.run(data, type='share')

## Latest weights :
##              AUS   CAN   FRA   DEU   JPN   GBR   USA
## 2021-12-31 14.29 14.29 14.29 14.29 14.29 14.29 14.29
## 
## Performance summary :
##  CAGR    Best    Worst   
##  8.2 14.1    -21.7

head(equal.weight$ret)

##                    AUS
## 1993-01-31 0.000000000
## 1993-02-28 0.003976969
## 1993-03-31 0.044861517
## 1993-04-30 0.065207441
## 1993-05-31 0.035969320
## 1993-06-30 0.024251503

bt.detail.summary(model$equal.weight)

plotbt.monthly.table(model$equal.weight$equity)

strategy.performance.snapshoot(model, T)

## NULL

Question 2.2.

Compute MVP portfolio returns by rebalancing EACH month starting from 1993/01 to 2021/12.

Use in-sample data range of previous 36 months to compute covariance matrix. Denote this strategy as the MVP portfolio and create its backtesting report using SIT.

data$prices <- stockpr3
data$weight <- stockpr3
data$execution.price <- stockpr3
data$execution.price[] <- NA
prices <- data$prices

constraints = new.constraints(n, lb = -Inf, ub = +Inf)

# SUM x.i = 1
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)        

ret = prices / mlag(prices) - 1
weight = coredata(prices)
weight[] = NA
i = 36
for (i in 36:dim(weight)[1]) {
  hist = ret[ (i- 36 +1):i, ]
  hist = na.omit(hist)
  ia = create.historical.ia(hist, 12)
  ia$cov = cov(coredata(hist))
  weight[i,] = min.risk.portfolio(ia, constraints)
}

data$weight[] = weight   
capital = 100000
data$weight[] = (capital / prices) * data$weight
min.var = bt.run(data, type='share', capital=capital)

## Latest weights :
##               AUS   CAN   FRA   DEU    JPN   GBR  USA
## 2021-12-31 -33.98 21.66 -8.95 15.53 107.47 -4.46 2.72
## 
## Performance summary :
##  CAGR    Best    Worst   
##  4.5 11.4    -15.9

model$min.var.monthly <- bt.run(data, trade.summary = T)

## Latest weights :
##             AUS  CAN   FRA  DEU  JPN   GBR  USA
## 2021-12-31 -1.8 0.72 -0.26 0.53 1.56 -0.12 0.01
## 
## Performance summary :
##  CAGR    Best    Worst   
##  -0.1    1.1 -1.5

sum(as.numeric(weight[36,])*as.numeric(ret[37,]))

## [1] 0.0318602

model$min.var.monthly$ret[37, ]

##                    AUS
## 1996-01-31 0.005077245

Question2.3.

Plot both strategies side by side and compare their performance and comment.

plotbt.custom.report.part1(model$min.var.monthly, model$equal.weight)

layout(1:2)
plotbt.transition.map(model$min.var.monthly$weight)
legend('topright', legend = 'min.var.monthly', bty = 'n')
plotbt.transition.map(model$equal.weight$weight)
legend('topright', legend = 'equal weight', bty = 'n')

strategy.performance.snapshoot(model, T)

## NULL

model <- rev(model)
plotbt.custom.report(model)

Similar to homework 9 (reference file: Black_Literman_model_SIT.R and website: (https://systematicinvestor.wordpress.com/2011/11/16/black-litterman-model/), update the annual data from 1988-2021 based on the enclosed excel file from AQR. By updating required parameter inputs conditional on the new data, show your answers to the following questions:

Question3.1

Visualize Market Capitalization History: ### a. Plot Transition of Market Cap Weights in time ### b. Plot History for each Country’s Market Cap

stockpr4 <- with(stockpr, stockpr[(date >= "1988-01-31" & date <= "2021-12-31")])

hist.caps = stockpr4
hist.caps.weight = hist.caps/rowSums(hist.caps)

# Plot Transition of Market Cap Weights in time
plot.transition.map(hist.caps.weight, index(hist.caps.weight), xlab='', name='Market Capitalization Weight History')

# Plot History for each Country's Market Cap
layout( matrix(1:9, nrow = 3, byrow=T) )

Question 3.2.

Compute Risk Aversion, prepare Black-Litterman input assumptions ### a. compute Risk Aversion ### b. comoute implied equilibrium returns

col = plota.colors(ncol(hist.caps))
for(i in 1:ncol(hist.caps)) {
  plota(hist.caps[,i], type='l', lwd=5, col=col[i], main=colnames(hist.caps)[i])
}

aa.test.create.ia.country <- function(dates = '1990::2021')
{
  # load.packages('quantmod,quadprog')
  symbols = spl('EWA,EWC,EWQ,EWG,EWJ,EWU,SPY')
  symbol.names = spl('Australia, Canada, France, Germany, Japan, UK, USA')
  getSymbols(symbols, from = '1991-01-01', auto.assign = TRUE)
  hist.prices = merge(EWA,EWC,EWQ,EWG,EWJ,EWU,SPY)
  period.ends = endpoints(hist.prices, 'months')
  hist.prices = Ad(hist.prices)[period.ends, ]
  colnames(hist.prices) = symbol.names
  annual.factor = 12
  hist.prices = na.omit(hist.prices[dates])
  hist.returns = na.omit( ROC(hist.prices, type = 'discrete') )
  ia = create.historical.ia(hist.returns, annual.factor)
  return(ia)
}

# 3. Load up efficient frontier plotting function:
plot.ef <- function(
  ia,
  efs,
  portfolio.risk.fn = portfolio.risk,
  transition.map = TRUE,
  layout = NULL
)
{
  risk.label = as.character(substitute(portfolio.risk.fn))
  n = ia$n
  x = match.fun(portfolio.risk.fn)(diag(n), ia)
  y = ia$expected.return
  xlim = range(c(0, x,
                 max( sapply(efs, function(x) max(match.fun(portfolio.risk.fn)(x$weight,ia))) )
  ), na.rm = T)
  ylim = range(c(0, y,
                 min( sapply(efs, function(x) min(portfolio.return(x$weight,ia))) ),
                 max( sapply(efs, function(x) max(portfolio.return(x$weight,ia))) )
  ), na.rm = T)
  x = 100 * x
  y = 100 * y
  xlim = 100 * xlim
  ylim = 100 * ylim
  if( !transition.map ) layout = T
  if( is.null(layout) ) layout(1:2)
  par(mar = c(4,3,2,1), cex = 0.8)
  plot(x, y, xlim = xlim, ylim = ylim,
       xlab='', ylab='', main=paste(risk.label, 'vs Return'), col='black')
  mtext('Return', side = 2,line = 2, cex = par('cex'))
  mtext(risk.label, side = 1,line = 2, cex = par('cex'))
  grid();
  text(x, y, ia$symbols,    col = 'blue', adj = c(1,1), cex = 0.8)
  for(i in len(efs):1) {
    ef = efs[[ i ]]
    x = 100 * match.fun(portfolio.risk.fn)(ef$weight, ia)
    y = 100 * ef$return
    lines(x, y, col=i)
  }
  plota.legend(sapply(efs, function(x) x$name), 1:len(efs))
  if(transition.map) {
    plot.transition.map(efs[[i]]$weight, x, risk.label, efs[[i]]$name)
  }
}

# Use reverse optimization to compute the vector of equilibrium returns
bl.compute.eqret <- function(
  risk.aversion,  # Risk Aversion
  cov,        # Covariance matrix
  cap.weight,     # Market Capitalization Weights
  risk.free = 0   # Rsik Free Interest Rate
)
{
  return( risk.aversion * cov %*% cap.weight +  risk.free)    
}

#--------------------------------------------------------------------------
# Compute Risk Aversion, prepare Black-Litterman input assumptions
#--------------------------------------------------------------------------
ia = aa.test.create.ia.country()

# compute Risk Aversion
risk.aversion = bl.compute.risk.aversion( ia$hist.returns$` USA` )

# the latest market capitalization weights
cap.weight = last(hist.caps.weight) 

# create Black-Litterman input assumptions  
ia.bl = ia
ia.bl$expected.return = bl.compute.eqret( risk.aversion, ia$cov, as.vector(cap.weight) )

# Plot market capitalization weights and implied equilibrium returns
par(mfrow = c(3, 3))
layout( matrix(1:8, nrow = 2) )

pie(coredata(cap.weight), paste(colnames(cap.weight), round(100*cap.weight), '%'), 
    main = paste('Country Market Capitalization Weights for', format(index(cap.weight),'%b %Y'))
    , col=plota.colors(ia$n))

plot.ia(ia.bl, T)

Question 3.3

Plot the Efficient Frontiers for traditional Markowitz and Black-Litterman model.

#--------------------------------------------------------------------------
# Create Efficient Frontier(s)
#--------------------------------------------------------------------------
n = ia$n

# -1 <= x.i <= 1
constraints = new.constraints(n, lb = 0, ub = 1)

# SUM x.i = 1
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)        

# Create efficient frontier(s)
ef.risk = portopt(ia, constraints, 50, 'Historical', equally.spaced.risk = T)

## 
## Attaching package: 'corpcor'

## The following object is masked from 'package:SIT':
## 
##     cov.shrink

## 
## Attaching package: 'kernlab'

## The following object is masked from 'package:purrr':
## 
##     cross

## The following object is masked from 'package:ggplot2':
## 
##     alpha

## The following object is masked from 'package:SIT':
## 
##     cross

ef.risk.bl = portopt(ia.bl, constraints, 50, 'Black-Litterman', equally.spaced.risk = T)

# Plot multiple Efficient Frontiers and Transition Maps
layout( matrix(1:4, nrow = 2) )
plot.ef(ia, list(ef.risk), portfolio.risk, T, T)            
plot.ef(ia.bl, list(ef.risk.bl), portfolio.risk, T, T)

##

bl.compute.posterior <- function(
    mu,         # Equilibrium returns
    cov,        # Covariance matrix
    pmat=NULL,  # Views pick matrix
    qmat=NULL,  # Views mean vector
    tau=0.025   # Measure of uncertainty of the prior estimate of the mean returns
)
{
  out = list()    
  omega = diag(c(1,diag(tau * pmat %*% cov %*% t(pmat))))[-1,-1]
  
  temp = solve(solve(tau * cov) + t(pmat) %*% solve(omega) %*% pmat)  
  out$cov = cov + temp
  
  out$expected.return = temp %*% (solve(tau * cov) %*% mu + t(pmat) %*% solve(omega) %*% qmat)
  return(out)
}
#--------------------------------------------------------------------------
# Create Views
#--------------------------------------------------------------------------
temp = matrix(rep(0, n), nrow = 1)
colnames(temp) = ia$symbols

# Relative View
# Japan will outperform UK by 2%
temp[,' Japan'] = 1
temp[,' UK'] = -1

pmat = temp
qmat = c(0.02)

# Absolute View
# Australia's expected return is 12%
temp[] = 0
# temp[,'Australia'] = 1
temp[,1] = 1
pmat = rbind(pmat, temp)    
qmat = c(qmat, 0.12)

# Compute posterior distribution parameters
post = bl.compute.posterior(ia.bl$expected.return, ia$cov, pmat, qmat, tau = 0.025 )

# Create Black-Litterman input assumptions with Views   
ia.bl.view = ia.bl
ia.bl.view$expected.return = post$expected.return
ia.bl.view$cov = post$cov
ia.bl.view$risk = sqrt(diag(ia.bl.view$cov))

# Create efficient frontier(s)
ef.risk.bl.view = portopt(ia.bl.view, constraints, 50, 'Black-Litterman + View(s)', equally.spaced.risk = T)

Question 3.4

Based on the same assumptions of file, i.e., tau and views, compute the Black-Litterman posterior expected returns across 7 countries.

# Plot multiple Efficient Frontiers and Transition Maps
layout( matrix(1:4, nrow = 2) )
plot.ef(ia.bl, list(ef.risk.bl), portfolio.risk, T, T)          
plot.ef(ia.bl.view, list(ef.risk.bl.view), portfolio.risk, T, T)