library(pacman)
p_load(quantmod, quadprog, lpSolve)
library(SIT)
## Loading required package: SIT.date
## 
## Attaching package: 'SIT'
## The following object is masked from 'package:TTR':
## 
##     DVI
## The following object is masked from 'package:base':
## 
##     close

1. Download 10 industry portfolio returns (average value-weighted monthly returns) from Fama French data library (http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/data_library.html)

industry10 <- read.table("10_Industry_Portfolios.txt",header = T)
str(industry10)
## 'data.frame':    1125 obs. of  11 variables:
##  $ Date : int  192607 192608 192609 192610 192611 192612 192701 192702 192703 192704 ...
##  $ NoDur: num  1.45 3.97 1.14 -1.24 5.2 0.82 -0.67 3.37 2.73 3.35 ...
##  $ Durbl: num  15.55 3.68 4.8 -8.23 -0.19 ...
##  $ Manuf: num  4.69 2.81 1.15 -3.63 4.1 3.74 -0.08 5.81 1.43 0.77 ...
##  $ Enrgy: num  -1.18 3.47 -3.39 -0.78 0.01 2.82 1.29 1.47 -6.01 -5.17 ...
##  $ HiTec: num  2.9 2.66 -0.38 -4.58 4.71 -0.02 -1.13 4.45 1.45 5.4 ...
##  $ Telcm: num  0.83 2.17 2.41 -0.11 1.63 1.99 1.88 3.97 5.56 -2.13 ...
##  $ Shops: num  0.11 -0.71 0.21 -2.29 6.43 0.62 -2.55 3.61 -0.41 4.46 ...
##  $ Hlth : num  1.77 4.25 0.69 -0.57 5.42 0.11 5.05 1.71 1.01 2.74 ...
##  $ Utils: num  7.04 -1.69 2.04 -2.63 3.71 -0.17 -1.79 4.53 0.37 1.71 ...
##  $ Other: num  2.16 4.38 0.29 -2.85 2.11 3.4 1.51 5.06 1.27 0.86 ...
nrow(industry10)
## [1] 1125

2. Compute equal weight portfolio returns EACH month starting from 2000/01 to 2020/03. Denote this strategy as the Benchmark portfolio and create its backtesting report using SIT.

#Convert data into time series

date <- seq(as.Date("1926-08-01"), length=1125, by="1 month") - 1
head(date)
## [1] "1926-07-31" "1926-08-31" "1926-09-30" "1926-10-31" "1926-11-30"
## [6] "1926-12-31"
tail(date)
## [1] "2019-10-31" "2019-11-30" "2019-12-31" "2020-01-31" "2020-02-29"
## [6] "2020-03-31"
industry10.xts <- xts(coredata(industry10[ , -1])/100, order.by= date)
head(industry10.xts)
##              NoDur   Durbl   Manuf   Enrgy   HiTec   Telcm   Shops    Hlth
## 1926-07-31  0.0145  0.1555  0.0469 -0.0118  0.0290  0.0083  0.0011  0.0177
## 1926-08-31  0.0397  0.0368  0.0281  0.0347  0.0266  0.0217 -0.0071  0.0425
## 1926-09-30  0.0114  0.0480  0.0115 -0.0339 -0.0038  0.0241  0.0021  0.0069
## 1926-10-31 -0.0124 -0.0823 -0.0363 -0.0078 -0.0458 -0.0011 -0.0229 -0.0057
## 1926-11-30  0.0520 -0.0019  0.0410  0.0001  0.0471  0.0163  0.0643  0.0542
## 1926-12-31  0.0082  0.0989  0.0374  0.0282 -0.0002  0.0199  0.0062  0.0011
##              Utils   Other
## 1926-07-31  0.0704  0.0216
## 1926-08-31 -0.0169  0.0438
## 1926-09-30  0.0204  0.0029
## 1926-10-31 -0.0263 -0.0285
## 1926-11-30  0.0371  0.0211
## 1926-12-31 -0.0017  0.0340

#Convert into prices

industry.price <- cumprod(industry10.xts + 1) * 100
head(industry.price)
##               NoDur    Durbl    Manuf     Enrgy    HiTec    Telcm     Shops
## 1926-07-31 101.4500 115.5500 104.6900  98.82000 102.9000 100.8300 100.11000
## 1926-08-31 105.4776 119.8022 107.6318 102.24905 105.6371 103.0180  99.39922
## 1926-09-30 106.6800 125.5527 108.8696  98.78281 105.2357 105.5007  99.60796
## 1926-10-31 105.3572 115.2198 104.9176  98.01231 100.4159 105.3847  97.32694
## 1926-11-30 110.8358 115.0008 109.2192  98.02211 105.1455 107.1025 103.58506
## 1926-12-31 111.7446 126.3744 113.3040 100.78633 105.1245 109.2338 104.22728
##                Hlth    Utils    Other
## 1926-07-31 101.7700 107.0400 102.1600
## 1926-08-31 106.0952 105.2310 106.6346
## 1926-09-30 106.8273 107.3777 106.9438
## 1926-10-31 106.2184 104.5537 103.8959
## 1926-11-30 111.9754 108.4326 106.0882
## 1926-12-31 112.0986 108.2483 109.6952
tail(industry.price)
##              NoDur    Durbl     Manuf    Enrgy   HiTec    Telcm   Shops    Hlth
## 2019-10-31 1463095 621102.2 1062337.6 743284.1 1401530 456178.2 1308805 3011501
## 2019-11-30 1495137 638493.1 1098032.1 752426.5 1472727 464206.9 1337337 3173218
## 2019-12-31 1547915 671375.4 1114173.2 799829.3 1526776 469916.7 1356193 3280156
## 2020-01-31 1542033 711120.9 1079745.2 704089.8 1576702 460095.4 1367992 3221769
## 2020-02-29 1407414 658924.6  987427.0 596152.8 1468698 432719.7 1275516 3040061
## 2020-03-31 1245702 509348.7  820946.8 389824.3 1324472 374778.6 1178832 2878026
##               Utils    Other
## 2019-10-31 357598.7 279495.3
## 2019-11-30 350089.1 293302.3
## 2019-12-31 364057.7 300253.6
## 2020-01-31 381969.3 296380.3
## 2020-02-29 344230.7 267335.0
## 2020-03-31 299411.9 216808.7
industry.price.sample <- industry.price['199912/202003']

data <- new.env()
data$prices <- industry.price.sample
data$weight <- industry.price.sample
data$execution.price <- industry.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)
##            NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 1999-12-31   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
## 2000-01-31   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
## 2000-02-29   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
## 2000-03-31   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
## 2000-04-30   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
## 2000-05-31   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
model <-list()
model$equal.weight = bt.run(data, trade.summary=T)
## Latest weights :
##            NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 2020-03-31    10    10    10    10    10    10    10   10    10    10
## 
## Performance summary :
##  CAGR    Best    Worst   
##  6.2 12  -17.5   
capital = 100000
data$weight[] = (capital / prices) * data$weight
equal.weight = bt.run(data, type='share')
## Latest weights :
##            NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 2020-03-31    10    10    10    10    10    10    10   10    10    10
## 
## Performance summary :
##  CAGR    Best    Worst   
##  6.2 12  -17.5   
head(equal.weight$ret)
##               NoDur
## 1999-12-31  0.00000
## 2000-01-31 -0.02404
## 2000-02-29 -0.03021
## 2000-03-31  0.08384
## 2000-04-30 -0.00699
## 2000-05-31 -0.01062
bt.detail.summary(model$equal.weight)
## $System
## $System$Period
## [1] "Dec1999 - Mar2020"
## 
## $System$Cagr
## [1] 6.2
## 
## $System$Sharpe
## [1] 0.49
## 
## $System$DVR
##       [,1]
## NoDur 0.42
## 
## $System$Volatility
## [1] 14.5
## 
## $System$MaxDD
## [1] -48.17
## 
## $System$AvgDD
## [1] -7.02
## 
## $System$VaR
##    5% 
## -7.07 
## 
## $System$CVaR
## [1] -9.8
## 
## $System$Exposure
## [1] 99.59
## 
## 
## $Trade
## $Trade$Win.Percent
## [1] 100
## 
## $Trade$Avg.Trade
## [1] 23.2
## 
## $Trade$Avg.Win
## [1] 23.2
## 
## $Trade$Avg.Loss
## [1] NaN
## 
## $Trade$Best.Trade
## [1] 44.02
## 
## $Trade$Worst.Trade
## [1] 2.83
## 
## $Trade$WinLoss.Ratio
## [1] NaN
## 
## $Trade$Avg.Len
## [1] 243
## 
## $Trade$Num.Trades
## [1] 10
## 
## 
## $Period
## $Period$Win.Percent.Day
## [1] 63.5
## 
## $Period$Best.Day
## [1] 12
## 
## $Period$Worst.Day
## [1] -17.5
## 
## $Period$Win.Percent.Month
## [1] 63.5
## 
## $Period$Best.Month
## [1] 12
## 
## $Period$Worst.Month
## [1] -17.5
## 
## $Period$Win.Percent.Year
## [1] 68.2
## 
## $Period$Best.Year
## [1] 33.8
## 
## $Period$Worst.Year
## [1] -35.5
plotbt.monthly.table(model$equal.weight$equity)

##      Jan     Feb     Mar     Apr     May     Jun     Jul     Aug     Sep    
## 1999 "   NA" "   NA" "   NA" "   NA" "   NA" "   NA" "   NA" "   NA" "   NA"
## 2000 " -2.4" " -3.0" "  8.4" " -0.7" " -1.1" "  0.5" " -0.8" "  5.2" " -0.5"
## 2001 "  2.6" " -4.5" " -4.8" "  6.9" "  0.8" " -2.3" " -0.6" " -5.1" " -8.4"
## 2002 " -1.1" "  0.0" "  4.8" " -3.9" " -1.1" " -6.9" " -9.3" "  0.9" " -9.8"
## 2003 " -3.0" " -2.3" "  0.9" "  7.9" "  6.4" "  1.5" "  1.3" "  3.3" " -1.6"
## 2004 "  1.3" "  1.8" " -1.0" " -0.6" "  0.3" "  2.4" " -3.2" "  0.2" "  2.0"
## 2005 " -2.1" "  2.9" " -1.8" " -3.0" "  3.8" "  1.2" "  4.3" " -0.6" "  0.4"
## 2006 "  4.0" "  0.0" "  1.6" "  1.1" " -1.8" "  0.8" "  0.3" "  2.1" "  1.8"
## 2007 "  2.0" " -1.0" "  1.7" "  4.3" "  3.7" " -1.2" " -3.4" "  1.0" "  3.4"
## 2008 " -6.2" " -2.3" " -0.6" "  4.8" "  2.7" " -8.0" " -1.3" "  1.9" " -9.4"
## 2009 " -7.1" " -9.8" "  8.2" " 12.0" "  4.3" "  0.9" "  8.2" "  2.5" "  4.1"
## 2010 " -3.4" "  3.3" "  6.1" "  2.4" " -7.5" " -5.4" "  7.8" " -4.1" "  9.3"
## 2011 "  1.4" "  3.5" "  1.2" "  3.4" " -0.8" " -1.4" " -2.7" " -5.5" " -7.3"
## 2012 "  4.4" "  4.2" "  2.4" " -0.7" " -5.3" "  3.2" "  1.5" "  1.9" "  2.9"
## 2013 "  5.5" "  1.4" "  4.3" "  2.3" "  2.0" " -0.7" "  5.6" " -2.8" "  3.7"
## 2014 " -3.2" "  4.9" "  0.6" "  0.8" "  1.8" "  2.7" " -2.7" "  4.3" " -2.9"
## 2015 " -2.5" "  5.4" " -1.2" "  0.8" "  0.8" " -1.9" "  0.8" " -5.8" " -3.1"
## 2016 " -4.6" "  0.6" "  7.2" "  1.4" "  1.0" "  0.9" "  3.3" " -0.4" "  0.2"
## 2017 "  1.7" "  2.9" "  0.2" "  0.8" "  0.6" "  0.5" "  1.7" " -0.5" "  2.6"
## 2018 "  4.1" " -5.1" " -1.6" "  0.7" "  1.9" "  1.7" "  2.8" "  2.1" "  0.4"
## 2019 "  8.1" "  3.2" "  1.0" "  3.2" " -6.7" "  7.2" "  0.6" " -2.0" "  2.1"
## 2020 " -0.6" " -8.5" "-15.4" "   NA" "   NA" "   NA" "   NA" "   NA" "   NA"
## Avg  " -0.1" " -0.1" "  1.1" "  2.2" "  0.3" " -0.2" "  0.7" " -0.1" " -0.5"
##      Oct     Nov     Dec     Year    MaxDD  
## 1999 "   NA" "   NA" "   NA" "  0.0" "  0.0"
## 2000 "  0.1" " -5.7" "  3.2" "  2.5" " -6.1"
## 2001 "  2.1" "  6.5" "  2.1" " -6.0" "-17.4"
## 2002 "  6.7" "  6.0" " -4.4" "-18.3" "-27.0"
## 2003 "  5.6" "  1.5" "  5.9" " 30.2" " -5.3"
## 2004 "  1.4" "  4.9" "  3.4" " 13.4" " -3.2"
## 2005 " -3.0" "  2.9" "  0.1" "  4.9" " -4.7"
## 2006 "  4.1" "  2.3" "  0.8" " 18.4" " -1.8"
## 2007 "  2.1" " -3.9" " -0.3" "  8.0" " -4.6"
## 2008 "-17.5" " -6.6" "  1.7" "-35.5" "-36.5"
## 2009 " -1.8" "  5.9" "  3.4" " 32.7" "-16.2"
## 2010 "  4.2" "  1.2" "  6.4" " 20.3" "-12.5"
## 2011 " 11.5" " -0.4" "  0.9" "  2.8" "-16.6"
## 2012 " -0.8" "  0.9" "  1.2" " 16.4" " -6.0"
## 2013 "  4.0" "  2.2" "  2.3" " 33.8" " -2.8"
## 2014 "  2.6" "  2.2" " -0.1" " 11.2" " -3.2"
## 2015 "  7.5" "  0.1" " -2.6" " -2.2" " -9.6"
## 2016 " -2.5" "  4.1" "  2.3" " 13.6" " -4.6"
## 2017 "  1.1" "  3.1" "  1.2" " 17.1" " -0.5"
## 2018 " -5.9" "  2.4" " -9.4" " -6.6" "-12.7"
## 2019 "  1.7" "  2.7" "  3.2" " 26.4" " -6.7"
## 2020 "   NA" "   NA" "   NA" "-23.0" "-23.0"
## Avg  "  1.2" "  1.6" "  1.1" "  7.3" "-10.1"
plotbt.transition.map(model$equal.weight$weight)
legend('topright', legend = 'equal weight', bty = 'n')

strategy.performance.snapshoot(model, T)

## NULL

3. Compute MVP portfolio returns by rebalancing EACH month starting from 2000/01 to 2020/03. Use in-sample data range of 36 months to compute covariance matrix. Denote this strategy as the MVP portfolio and create its backtesting report using SIT.

industry.price.sample2<- industry.price['199701/202003']
data$prices <- industry.price.sample2
data$weight <- industry.price.sample2
data$execution.price <- industry.price.sample2

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
head(ret)
##              NoDur   Durbl   Manuf   Enrgy   HiTec   Telcm   Shops    Hlth
## 1997-01-31      NA      NA      NA      NA      NA      NA      NA      NA
## 1997-02-28  0.0409  0.0035  0.0081 -0.0569 -0.0744  0.0228  0.0308  0.0094
## 1997-03-31 -0.0512 -0.0394 -0.0374  0.0521 -0.0555 -0.0760 -0.0129 -0.0740
## 1997-04-30  0.0519  0.0231  0.0534  0.0005  0.0815  0.0254  0.0221  0.0616
## 1997-05-31  0.0589  0.0667  0.0781  0.0733  0.1014  0.0664  0.0604  0.0691
## 1997-06-30  0.0353  0.0390  0.0521  0.0131  0.0134  0.0378  0.0502  0.0889
##              Utils   Other
## 1997-01-31      NA      NA
## 1997-02-28 -0.0057  0.0260
## 1997-03-31 -0.0276 -0.0589
## 1997-04-30 -0.0139  0.0523
## 1997-05-31  0.0377  0.0624
## 1997-06-30  0.0306  0.0537
weight = coredata(prices)
head(weight)
##         NoDur    Durbl    Manuf    Enrgy    HiTec     Telcm    Shops     Hlth
## [1,] 202589.8 191273.4 125768.1 165710.3 186237.0 101825.93 121840.3 379713.9
## [2,] 210875.7 191942.9 126786.8 156281.4 172381.0 104147.56 125593.0 383283.2
## [3,] 200078.8 184380.3 122045.0 164423.7 162813.9  96232.34 123972.9 354920.2
## [4,] 210462.9 188639.5 128562.2 164505.9 176083.2  98676.65 126712.7 376783.3
## [5,] 222859.2 201221.8 138602.9 176564.2 193938.0 105228.78 134366.1 402819.0
## [6,] 230726.1 209069.4 145824.1 178877.1 196536.8 109206.42 141111.3 438629.7
##         Utils    Other
## [1,] 45784.85 59247.35
## [2,] 45523.88 60787.78
## [3,] 44267.42 57207.38
## [4,] 43652.10 60199.33
## [5,] 45297.79 63955.77
## [6,] 46683.90 67390.19
weight[] = NA
nrow(prices)
## [1] 279
hist <- na.omit(ret[1:36,])
cov(hist)
##             NoDur        Durbl        Manuf        Enrgy         HiTec
## NoDur 0.002523804 0.0022334202 0.0019781888 0.0009392060  0.0014745720
## Durbl 0.002233420 0.0036223990 0.0024800944 0.0016398492  0.0027875514
## Manuf 0.001978189 0.0024800944 0.0027611554 0.0017120826  0.0029538526
## Enrgy 0.000939206 0.0016398492 0.0017120826 0.0036359262  0.0021717405
## HiTec 0.001474572 0.0027875514 0.0029538526 0.0021717405  0.0075008503
## Telcm 0.001766863 0.0018447953 0.0016564809 0.0006054559  0.0025618044
## Shops 0.001945079 0.0023318059 0.0021759463 0.0009590672  0.0029925739
## Hlth  0.001841688 0.0017548098 0.0014296222 0.0008141687  0.0022549636
## Utils 0.001023230 0.0005581837 0.0004420217 0.0008509661 -0.0002352291
## Other 0.002685733 0.0031265522 0.0027456359 0.0016694513  0.0028777161
##              Telcm        Shops         Hlth         Utils        Other
## NoDur 0.0017668626 0.0019450789 0.0018416884  0.0010232296 0.0026857334
## Durbl 0.0018447953 0.0023318059 0.0017548098  0.0005581837 0.0031265522
## Manuf 0.0016564809 0.0021759463 0.0014296222  0.0004420217 0.0027456359
## Enrgy 0.0006054559 0.0009590672 0.0008141687  0.0008509661 0.0016694513
## HiTec 0.0025618044 0.0029925739 0.0022549636 -0.0002352291 0.0028777161
## Telcm 0.0031609629 0.0019758794 0.0017254924  0.0007095876 0.0024311435
## Shops 0.0019758794 0.0027099090 0.0016117981  0.0001668012 0.0026365665
## Hlth  0.0017254924 0.0016117981 0.0030028115  0.0006338419 0.0024283634
## Utils 0.0007095876 0.0001668012 0.0006338419  0.0018215490 0.0007834905
## Other 0.0024311435 0.0026365665 0.0024283634  0.0007834905 0.0038377078
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 ,]
##      NoDur      Durbl      Manuf      Enrgy      HiTec      Telcm      Shops 
## -0.2950686  0.1349125  0.4207692  0.1023813 -0.1689032  0.1284183  0.5338743 
##       Hlth      Utils      Other 
##  0.3667386  0.4641752 -0.6872975
sum(weight[36,])
## [1] 1
data$weight[] = weight
model$min.var.monthly <- bt.run(data, trade.summary = T)
## Latest weights :
##             NoDur Durbl Manuf Enrgy  HiTec Telcm Shops  Hlth Utils  Other
## 2020-03-31 -29.51 13.49 42.08 10.24 -16.89 12.84 53.39 36.67 46.42 -68.73
## 
## Performance summary :
##  CAGR    Best    Worst   
##  7.8 9.5 -13.8   
plotbt.transition.map(model$min.var.monthly$weight)
legend('topright', legend = 'min.var.monthly', bty = 'n')

sum(as.numeric(weight[36,])*as.numeric(ret[37,]))
## [1] 0.009322282
model$min.var.monthly$ret[37, ]
##                  NoDur
## 2000-01-31 0.009322282

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

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

# Comment: The equal weight strategy only had a small better performance than minimum variance monthly for a short period of time during early 2000s. However, the minimum variance monthly outperforms the equal weight strategy between the year 2000 and 2020 despite the financial shock of 2008 and 2009. During 2020, the performance of both strategies becomes weaker because of the pandemic. The minimum variance outperforms equal weight strategy because of the asset set, applied optimization model, and volatility or return forecast window size.

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)

#