1. Download monthly equity market capitalization of 7 countries (see file: “Betting Against Beta Equity Factors Monthly.xlsx”): Australia, Canada, France, Germany, Japan, United Kingdom and United States from 1989/12 to 2021/12. Compute monthly equity market returns (in simple returns) based on market capitalization data.Show the first and final six rows of your computed return data across the selected 7 countries on Rmarkdown webpage.

library(knitr)
library(readxl)
library(SIT)
library(tidyquant)
library(quantmod)
library(xts)
library(lubridate)
library(ggplot2)
library(DT)
library(purrr)
data.capital <- read_excel("C:/Users/hiits/Downloads/Betting Against Beta Equity Factors Monthly.xlsx", sheet = "ME(t-1)", range = "A19:AD1165")

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

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

data.capital1 <- subset(data.capital, select = c(AUS,CAN,FRA,DEU,JPN,GBR,USA))


data.capital <- with(data.capital1, data.capital1[(date >= "1989-11-30" & date <= "2021-12-31")])



monthly.return <- na.omit(Return.calculate(data.capital, method = "discrete"))
head(monthly.return)
##                    AUS           CAN         FRA         DEU         JPN
## 1989-12-31 -0.02844410  0.0058178215  0.07914015  0.09570552  0.05097275
## 1990-01-31  0.03066617  0.0242062712  0.10677237  0.17590024  0.02123232
## 1990-02-28  0.01574424 -0.0631233515 -0.03985058  0.02206308 -0.04670123
## 1990-03-31 -0.06035407  0.0006305838 -0.02860599  0.00208093 -0.08398405
## 1990-04-30 -0.02950981 -0.0104092150  0.06771805  0.09567357 -0.17803619
## 1990-05-31 -0.08247848 -0.0819545270  0.04144222 -0.06148407 -0.01682893
##                    GBR         USA
## 1989-12-31  0.04729115  0.01203313
## 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
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

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.

#=================================================================

#=================================================================
# USING THE CAPITALIZATION VALUE IN #1 TO COMPUTE, WE CALL IT "data.capital"

head(data.capital)
##                 AUS      CAN      FRA      DEU     JPN      GBR     USA
## 1989-11-30 118886.2 169228.7 221160.6 251307.4 4045752 654042.9 3106749
## 1989-12-31 115504.6 170213.2 238663.2 275358.9 4251975 684973.3 3144133
## 1990-01-31 119046.7 174333.5 264145.9 323794.6 4342255 751921.9 3200716
## 1990-02-28 120921.0 163328.9 253619.5 330938.6 4139466 760768.4 2951340
## 1990-03-31 113622.9 163431.9 246364.5 331627.2 3791817 736363.8 2989625
## 1990-04-30 110269.9 161730.7 263047.8 363355.2 3116736 714183.1 3063896
price.sample <-data.capital['1993-01/2021-12']
head(price.sample)
##                 AUS      CAN      FRA      DEU     JPN      GBR     USA
## 1993-01-31 111923.5 180404.7 308296.8 298353.6 2375372 876237.6 4275176
## 1993-02-28 110970.5 179417.2 315297.1 305789.7 2356785 867615.4 4325890
## 1993-03-31 121477.2 191341.6 338224.1 321368.5 2470386 847107.6 4346053
## 1993-04-30 129116.8 201882.4 357599.4 331053.8 2848834 903275.3 4483180
## 1993-05-31 131599.0 214009.6 352510.0 328934.6 3330546 947970.7 4369090
## 1993-06-30 131020.4 223470.4 350187.8 342048.4 3508430 960866.8 4498663
data <- new.env()
data$prices = data$weight = data$execution.price = price.sample
data$execution.price[] <- NA
data$symbolnames <- colnames(data$prices)
prices <- data$prices
n <- ncol(prices)
names(data)
## [1] "prices"          "weight"          "symbolnames"     "execution.price"
data$weight <- ntop(prices, n)
head(data$weight)
##                  AUS       CAN       FRA       DEU       JPN       GBR
## 1993-01-31 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571
## 1993-02-28 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571
## 1993-03-31 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571
## 1993-04-30 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571
## 1993-05-31 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571
## 1993-06-30 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571 0.1428571
##                  USA
## 1993-01-31 0.1428571
## 1993-02-28 0.1428571
## 1993-03-31 0.1428571
## 1993-04-30 0.1428571
## 1993-05-31 0.1428571
## 1993-06-30 0.1428571
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   
plotbt.monthly.table(model$equal.weight$equity)

##      Jan     Feb     Mar     Apr     May     Jun     Jul     Aug     Sep    
## 1993 "   NA" "  0.4" "  4.5" "  6.5" "  3.6" "  2.4" " -1.1" "  3.1" "  7.0"
## 1994 "  7.4" "  6.5" " -1.3" " -3.5" "  2.4" " -0.3" " -1.7" "  4.3" "  3.8"
## 1995 "  1.1" " -2.6" "  2.0" "  4.4" "  3.1" "  0.4" " -0.4" "  5.9" " -1.9"
## 1996 "  1.5" "  2.8" "  1.3" "  1.0" "  3.3" "  0.6" " -0.4" " -2.3" "  2.1"
## 1997 " -0.6" " -0.8" "  1.8" " -0.7" "  0.8" "  5.2" "  3.9" "  3.8" " -5.4"
## 1998 "  1.0" "  4.1" "  6.2" "  3.5" "  0.8" " -0.5" "  1.1" " -0.7" "-13.4"
## 1999 "  2.4" "  4.4" " -3.4" "  4.2" "  6.6" " -4.3" "  5.8" "  1.6" "  0.5"
## 2000 "  9.4" " -4.1" "  4.3" "  3.6" " -5.7" " -3.6" "  6.1" " -1.8" "  2.7"
## 2001 "  3.3" "  2.4" " -7.5" " -7.4" "  8.0" " -1.6" " -1.6" " -2.5" " -2.9"
## 2002 "  0.4" " -2.6" "  0.3" "  4.9" " -0.1" "  2.1" " -4.3" " -9.1" " -1.9"
## 2003 " -2.4" " -1.4" " -1.9" " -1.0" "  9.6" "  6.5" "  3.3" "  1.6" "  2.4"
## 2004 "  7.1" "  1.5" "  2.3" "  0.9" " -3.9" "  0.5" "  2.6" " -2.4" "  0.1"
## 2005 "  3.9" " -1.4" "  4.2" " -1.9" " -3.3" "  0.6" "  2.1" "  3.8" "  1.4"
## 2006 "  3.9" "  6.7" " -0.4" "  2.7" "  4.7" " -4.0" " -0.6" "  0.2" "  2.5"
## 2007 "  2.7" "  0.4" "  1.3" "  2.5" "  4.4" "  2.9" "  0.0" " -1.9" " -2.2"
## 2008 " -1.5" " -8.7" "  1.7" " -2.6" "  4.8" "  2.3" " -6.8" " -3.4" " -3.7"
## 2009 "  5.3" " -9.9" " -9.4" "  8.1" " 12.5" " 11.6" "  0.0" "  9.6" "  4.4"
## 2010 "  1.7" " -4.4" "  0.7" "  6.2" " -0.5" "-10.9" " -2.8" "  8.9" " -3.7"
## 2011 "  8.5" "  2.2" "  4.3" " -1.7" "  4.8" " -2.9" " -1.2" " -1.6" " -8.3"
## 2012 " -2.1" "  6.5" "  5.0" " -0.6" " -1.4" "-11.3" "  4.6" "  1.5" "  2.6"
## 2013 "  2.4" "  4.8" " -0.6" "  0.7" "  3.4" " -2.0" " -4.1" "  5.4" " -1.1"
## 2014 "  1.6" " -3.7" "  5.0" " -0.2" "  0.8" "  1.5" "  2.0" " -1.9" "  0.8"
## 2015 " -2.0" " -1.4" "  6.1" " -2.3" "  3.5" " -1.3" " -2.5" "  0.9" " -7.0"
## 2016 " -1.9" " -6.3" " -1.0" "  7.6" "  2.7" " -1.3" " -2.7" "  5.4" " -0.5"
## 2017 "  2.9" "  3.0" "  1.6" "  1.9" "  1.5" "  1.7" "  0.8" "  2.9" "  0.0"
## 2018 "  2.5" "  4.5" " -4.8" " -1.6" "  1.7" " -0.7" " -1.1" "  2.0" " -1.1"
## 2019 " -6.0" "  7.4" "  2.5" " -0.4" "  2.7" " -4.8" "  5.6" " -0.7" " -2.6"
## 2020 "  3.2" " -1.7" " -9.7" "-17.0" " 10.1" "  5.2" "  3.6" "  3.8" "  6.0"
## 2021 "  6.0" " -1.0" "  3.2" "  2.6" "  4.4" "  2.8" " -0.6" "  0.6" "  1.4"
## Avg  "  2.2" "  0.3" "  0.6" "  0.7" "  2.9" " -0.1" "  0.3" "  1.3" " -0.6"
##      Oct     Nov     Dec     Year    MaxDD  
## 1993 " -1.4" "  4.6" " -4.1" " 28.0" " -4.1"
## 1994 " -3.2" "  2.2" " -3.7" " 12.6" " -4.7"
## 1995 "  1.2" " -0.9" "  2.8" " 15.6" " -2.6"
## 1996 "  2.7" "  1.9" "  6.9" " 23.3" " -2.7"
## 1997 "  5.5" " -4.9" "  0.1" "  8.4" " -5.4"
## 1998 "  0.7" "  9.3" "  5.9" " 17.4" "-14.0"
## 1999 "  0.9" "  5.0" "  5.3" " 32.2" " -4.3"
## 2000 " -6.5" " -3.7" " -5.1" " -5.8" "-16.9"
## 2001 "-10.4" "  3.4" "  4.6" "-13.2" "-24.1"
## 2002 "-10.4" "  4.9" "  3.6" "-12.8" "-23.4"
## 2003 "  3.0" "  7.3" "  1.7" " 31.8" " -6.6"
## 2004 "  4.2" "  4.0" "  6.4" " 25.3" " -3.9"
## 2005 "  3.8" " -4.0" "  3.5" " 12.8" " -5.1"
## 2006 " -0.5" "  4.7" "  2.6" " 24.3" " -4.5"
## 2007 "  6.1" "  5.0" " -5.2" " 16.5" " -5.2"
## 2008 "-14.4" "-21.7" " -6.8" "-48.3" "-48.3"
## 2009 "  5.5" " -2.1" "  3.6" " 43.0" "-18.4"
## 2010 " 10.4" "  4.0" " -2.7" "  5.0" "-13.8"
## 2011 "-11.0" " 10.8" " -4.5" " -3.0" "-23.0"
## 2012 "  2.7" "  1.3" "  1.2" "  9.1" "-13.1"
## 2013 "  6.5" "  3.6" "  0.3" " 20.2" " -6.0"
## 2014 " -5.2" " -0.5" "  0.8" "  0.7" " -6.7"
## 2015 " -4.5" "  7.3" " -0.5" " -4.5" "-13.8"
## 2016 "  1.0" " -2.3" " -0.7" " -0.7" " -9.0"
## 2017 "  2.5" "  1.4" "  1.2" " 23.4" "  0.0"
## 2018 "  0.1" " -8.5" " -0.6" " -8.0" "-14.1"
## 2019 "  2.2" "  2.7" "  1.8" " 10.1" " -6.0"
## 2020 " -3.2" " -3.0" " 14.1" "  7.4" "-26.3"
## 2021 " -3.0" "  3.4" " -4.1" " 16.2" " -4.1"
## Avg  " -0.5" "  1.2" "  1.0" "  9.9" "-11.4"

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. #MVP portfolio

#=================================================================
# RESET DATASET TO USE FOR MVP
price.sample <- data.capital['1993-01/2021-12']
data$prices <- price.sample 
data$weight <- price.sample 
data$execution.price <- price.sample
data$execution.price[] <- NA 
prices <- data$prices

#create constraints
constraints = new.constraints(n, lb=-Inf, ub=+Inf)
constraints = add.constraints(rep(1,n), 1, type = '=', constraints)

ret = prices / mlag(prices) -1

#compute MVA weight for each month 
weight = coredata(prices)
weight[] = NA
nrow(prices)
## [1] 348
## [1] 279
hist <- na.omit(ret[1:36,])

for( i in 36 : (dim(weight)[1]) )  {
  #using 36 historical monthly returns
  hist = ret[ (i- 36 +1):i, ]
  hist = na.omit(hist)
  #create historical input assumptions
  ia = create.historical.ia(hist, 12)
  s0 = apply(coredata(hist),2,sd)     
  ia$cov = cor(coredata(hist), use='complete.obs',method='pearson') * (s0 %*% t(s0))
  
  weight[i,] = min.risk.portfolio(ia, constraints)
}
data$weight[] = weight 


ia = create.historical.ia(hist, 12)
s0 = apply(coredata(hist), 2, sd)
ia$cov = cor(coredata(hist), use = 'complete.obs', method = 'pearson') * (s0%*%t(s0))
weight[36,] = min.risk.portfolio(ia, constraints)
weight[36,]
##         AUS         CAN         FRA         DEU         JPN         GBR 
## -0.35823831  0.17407419 -0.06296579  0.09496884  1.07543769 -0.04756360 
##         USA 
##  0.12428697
model$min.var.monthly <- bt.run(data, trade.summary = T)
## 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

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

#=================================================================

###Plot 2 strategies side by side

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)

3. Similar to homework 9 (reference file: Black_Literman_model_SIT.R and website:(https://systematicinvestor.wordpress.com/2011/11/16/black-litterman-mo el/),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:

#=================================================================
#3 Updating required parameter inputs conditional on the new data
#--------------------------------------------------------------------------

#Load up required function
# 1. Load up aa.test.create.ia.country()
aa.test.create.ia.country <- function(dates = '1988::2014')
{
  # load.packages('quantmod,quadprog')
  symbols = spl('EWA,EWC,EWQ,EWG,EWJ,EWU,SPY')
  symbol.names = spl('Australia, Canada, France, German, Japan, UK, USA')
  getSymbols(symbols, from = '1980-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)
}

# 2. 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)
  }
}

3.1 Visualize Market Capitalization History

#Updating required parameter inputs conditional on the new data
#--------------------------------------------------------------------------

hist.caps <- with(data.capital1, data.capital1[(date >= "1988-01-31" & date <= "2021-12-31")])
hist.caps.weight = hist.caps/rowSums(hist.caps)

#a. Plot Transition of Market Cap Weights in time 

plot.transition.map(hist.caps.weight, index(hist.caps.weight), xlab='', name='Market Capitalization Weight History')

#b. Plot History for each Country's Market Cap

layout( matrix(1:9, nrow = 3, byrow=T) )
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])
}

3.2 Compute Risk Aversion, prepare Black-Litterman input assumptions

ia = aa.test.create.ia.country()

#a. 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
layout( matrix(c(1,1,2,3), nrow=2, byrow=T) )
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)

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)       
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)
}

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

#--------------------------------------------------------------------------
# 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)    

# 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)