Q1. Download 10 industry portfolio returns (average value-weighted monthly returns) from Fama French data library
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
Q2. 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.
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
industry.price <- cumprod(industry10.xts + 1) * 100
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)
data$weight = ntop(prices, n)
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.16
##
## $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.26
##
## $Trade$Worst.Trade
## [1] 2.82
##
## $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.4" " 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.3" " 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.4" " 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.1" " -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.3"
## 2015 " 7.5" " 0.1" " -2.6" " -2.1" " -9.6"
## 2016 " -2.5" " 4.1" " 2.3" " 13.6" " -4.6"
## 2017 " 1.1" " 3.1" " 1.2" " 17.1" " -0.4"
## 2018 " -5.9" " 2.4" " -9.4" " -6.6" "-12.7"
## 2019 " 1.8" " 2.7" " 3.2" " 26.5" " -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)
strategy.performance.snapshoot(model, T)
## NULL
Q3. 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
weight = coredata(prices)
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.002685589 0.0031264040 0.0027455365 0.0016696292 0.0028778276
## Telcm Shops Hlth Utils Other
## NoDur 0.0017668626 0.0019450789 0.0018416884 0.0010232296 0.0026855890
## Durbl 0.0018447953 0.0023318059 0.0017548098 0.0005581837 0.0031264040
## Manuf 0.0016564809 0.0021759463 0.0014296222 0.0004420217 0.0027455365
## Enrgy 0.0006054559 0.0009590672 0.0008141687 0.0008509661 0.0016696292
## HiTec 0.0025618044 0.0029925739 0.0022549636 -0.0002352291 0.0028778276
## Telcm 0.0031609629 0.0019758794 0.0017254924 0.0007095876 0.0024311382
## Shops 0.0019758794 0.0027099090 0.0016117981 0.0001668012 0.0026364336
## Hlth 0.0017254924 0.0016117981 0.0030028115 0.0006338419 0.0024284531
## Utils 0.0007095876 0.0001668012 0.0006338419 0.0018215490 0.0007836532
## Other 0.0024311382 0.0026364336 0.0024284531 0.0007836532 0.0038375472
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.2951571 0.1349109 0.4207823 0.1024089 -0.1688881 0.1284388 0.5338466
## Hlth Utils Other
## 0.3668139 0.4642208 -0.6873770
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.52 13.49 42.08 10.24 -16.89 12.84 53.38 36.68 46.42 -68.74
##
## Performance summary :
## CAGR Best Worst
## 7.8 9.5 -13.8
sum(as.numeric(weight[36,])*as.numeric(ret[37,]))
## [1] 0.009339288
model$min.var.monthly$ret[37, ]
## NoDur
## 2000-01-31 0.009339288
