#Load some required packages
library(SIT)
## Loading required package: SIT.date
## Loading required package: quantmod
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
##
## Attaching package: 'SIT'
## The following object is masked from 'package:TTR':
##
## DVI
## The following object is masked from 'package:base':
##
## close
library(quantmod)
library(quadprog)
library(lpSolve)
library(readxl)
library(xts)
library(openxlsx)
#read.csv, read.table, read_csv
#QUESTION 1: Download data 10 industry portfolio returns (average value-weighted monthly returns)
poindustry <- read_excel("Downloads/10_Industry_Portfolios.xlsx",
range = "A12:K1160")
head(poindustry)
## # A tibble: 6 × 11
## Date NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 192607 1.45 15.6 4.69 -1.18 2.9 0.83 0.11 1.77 7.04 2.13
## 2 192608 3.97 3.68 2.81 3.47 2.66 2.17 -0.71 4.25 -1.69 4.35
## 3 192609 1.14 4.8 1.15 -3.39 -0.38 2.41 0.21 0.69 2.04 0.29
## 4 192610 -1.24 -8.23 -3.63 -0.78 -4.58 -0.11 -2.29 -0.57 -2.63 -2.84
## 5 192611 5.2 -0.19 4.1 0.01 4.71 1.63 6.43 5.42 3.71 2.11
## 6 192612 0.82 9.89 3.74 2.82 -0.02 1.99 0.62 0.11 -0.17 3.47
#QUESTION2: 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 = 1148, 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] "2021-09-30" "2021-10-31" "2021-11-30" "2021-12-31" "2022-01-31"
## [6] "2022-02-28"
class(date)
## [1] "Date"
#turn data into time series
poindustry <- xts(coredata(poindustry[ , -1])/100, order.by = date)
head(poindustry)
## 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.0213
## 1926-08-31 -0.0169 0.0435
## 1926-09-30 0.0204 0.0029
## 1926-10-31 -0.0263 -0.0284
## 1926-11-30 0.0371 0.0211
## 1926-12-31 -0.0017 0.0347
#convert returns into price
po_industry.price <- cumprod(poindustry + 1)*100
head(po_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.1300
## 1926-08-31 106.0952 105.2310 106.5727
## 1926-09-30 106.8273 107.3777 106.8817
## 1926-10-31 106.2184 104.5537 103.8463
## 1926-11-30 111.9754 108.4326 106.0374
## 1926-12-31 112.0986 108.2483 109.7169
#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.
industry.price.sample <- po_industry.price['199912/202003']
head(industry.price.sample)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops
## 1999-12-31 237045.7 313469.8 199837.8 230036.3 612042.5 290291.0 258041.7
## 2000-01-31 225714.9 310742.6 182511.9 232129.6 583276.5 278737.4 228728.2
## 2000-02-29 211743.2 285821.0 175320.9 218991.1 689374.4 269065.2 220173.7
## 2000-03-31 228174.4 315975.1 188434.9 245467.1 716535.8 289298.9 249500.9
## 2000-04-30 224021.6 345329.2 191167.2 240754.1 639938.1 266531.1 238348.2
## 2000-05-31 240196.0 299607.6 187993.9 263722.1 570568.8 238731.9 231745.9
## Hlth Utils Other
## 1999-12-31 648236.9 55331.60 88226.97
## 2000-01-31 697114.0 58684.70 84089.12
## 2000-02-29 676758.2 54424.19 78101.98
## 2000-03-31 678788.5 57564.47 89098.73
## 2000-04-30 714628.6 61939.37 86318.85
## 2000-05-31 742856.4 64355.00 89253.69
#create required input parameters in using SIT package
data <- new.env()
#create 4 required input elements in data
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.3 12.2 -17.4
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.3 12.2 -17.4
head(equal.weight$ret)
## NoDur
## 1999-12-31 0.00000
## 2000-01-31 -0.02454
## 2000-02-29 -0.03013
## 2000-03-31 0.08281
## 2000-04-30 -0.00627
## 2000-05-31 -0.01093
bt.detail.summary(model$equal.weight)
## $System
## $System$Period
## [1] "Dec1999 - Mar2020"
##
## $System$Cagr
## [1] 6.28
##
## $System$Sharpe
## [1] 0.49
##
## $System$DVR
## [,1]
## NoDur 0.42
##
## $System$Volatility
## [1] 14.47
##
## $System$MaxDD
## [1] -48.19
##
## $System$AvgDD
## [1] -6.82
##
## $System$VaR
## 5%
## -7.16
##
## $System$CVaR
## [1] -9.78
##
## $System$Exposure
## [1] 99.59
##
##
## $Trade
## $Trade$Win.Percent
## [1] 100
##
## $Trade$Avg.Trade
## [1] 23.7
##
## $Trade$Avg.Win
## [1] 23.7
##
## $Trade$Avg.Loss
## [1] NaN
##
## $Trade$Best.Trade
## [1] 46.15
##
## $Trade$Worst.Trade
## [1] 3.41
##
## $Trade$WinLoss.Ratio
## [1] NaN
##
## $Trade$Avg.Len
## [1] 243
##
## $Trade$Num.Trades
## [1] 10
##
##
## $Period
## $Period$Win.Percent.Day
## [1] 63.9
##
## $Period$Best.Day
## [1] 12.2
##
## $Period$Worst.Day
## [1] -17.4
##
## $Period$Win.Percent.Month
## [1] 63.9
##
## $Period$Best.Month
## [1] 12.2
##
## $Period$Worst.Month
## [1] -17.4
##
## $Period$Win.Percent.Year
## [1] 68.2
##
## $Period$Best.Year
## [1] 33.7
##
## $Period$Worst.Year
## [1] -35.4
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.5" " -3.0" " 8.3" " -0.6" " -1.1" " 0.5" " -0.9" " 5.2" " -0.4"
## 2001 " 2.5" " -4.5" " -4.7" " 6.8" " 0.7" " -2.3" " -0.6" " -5.1" " -8.4"
## 2002 " -1.0" " 0.1" " 4.8" " -3.8" " -1.1" " -6.8" " -9.3" " 0.8" " -9.8"
## 2003 " -3.0" " -2.3" " 1.0" " 7.8" " 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.2" " 2.9" " -1.9" " -3.0" " 3.9" " 1.2" " 4.4" " -0.7" " 0.4"
## 2006 " 4.0" " 0.0" " 1.5" " 1.1" " -1.7" " 0.8" " 0.4" " 2.2" " 1.8"
## 2007 " 2.0" " -1.0" " 1.7" " 4.3" " 3.7" " -1.3" " -3.4" " 1.0" " 3.4"
## 2008 " -6.1" " -2.3" " -0.6" " 4.8" " 2.7" " -8.0" " -1.3" " 1.9" " -9.3"
## 2009 " -7.2" " -9.8" " 8.1" " 12.2" " 4.1" " 1.0" " 8.2" " 2.5" " 4.0"
## 2010 " -3.4" " 3.3" " 6.1" " 2.5" " -7.5" " -5.4" " 7.9" " -4.1" " 9.3"
## 2011 " 1.4" " 3.5" " 1.2" " 3.4" " -0.7" " -1.4" " -2.7" " -5.4" " -7.3"
## 2012 " 4.4" " 4.1" " 2.4" " -0.7" " -5.3" " 3.2" " 1.5" " 1.9" " 2.9"
## 2013 " 5.5" " 1.4" " 4.3" " 2.3" " 1.9" " -0.7" " 5.6" " -2.8" " 3.7"
## 2014 " -3.2" " 4.9" " 0.6" " 0.9" " 1.8" " 2.7" " -2.7" " 4.3" " -2.9"
## 2015 " -2.5" " 5.3" " -1.2" " 0.8" " 0.8" " -1.8" " 0.9" " -5.8" " -3.0"
## 2016 " -4.6" " 0.6" " 7.2" " 1.6" " 1.0" " 1.0" " 3.3" " -0.4" " 0.2"
## 2017 " 1.6" " 2.9" " 0.3" " 0.8" " 0.7" " 0.5" " 1.7" " -0.3" " 2.6"
## 2018 " 4.1" " -5.0" " -1.6" " 0.7" " 1.9" " 1.7" " 2.7" " 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.3" " 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.4" " -6.0"
## 2001 " 2.0" " 6.5" " 2.1" " -6.1" "-17.3"
## 2002 " 6.7" " 6.0" " -4.4" "-18.0" "-26.9"
## 2003 " 5.6" " 1.5" " 5.9" " 30.2" " -5.3"
## 2004 " 1.4" " 4.9" " 3.3" " 13.3" " -3.2"
## 2005 " -3.1" " 2.9" " 0.1" " 4.8" " -4.8"
## 2006 " 4.1" " 2.3" " 0.8" " 18.6" " -1.7"
## 2007 " 2.1" " -4.0" " -0.3" " 8.0" " -4.6"
## 2008 "-17.4" " -6.4" " 1.6" "-35.4" "-36.4"
## 2009 " -1.8" " 5.9" " 3.4" " 32.6" "-16.3"
## 2010 " 4.2" " 1.2" " 6.4" " 20.4" "-12.5"
## 2011 " 11.5" " -0.3" " 1.0" " 2.9" "-16.5"
## 2012 " -0.8" " 0.9" " 1.3" " 16.5" " -5.9"
## 2013 " 4.1" " 2.2" " 2.3" " 33.7" " -2.8"
## 2014 " 2.6" " 2.2" " -0.1" " 11.3" " -3.2"
## 2015 " 7.5" " 0.1" " -2.5" " -2.1" " -9.4"
## 2016 " -2.4" " 4.2" " 2.2" " 14.1" " -4.6"
## 2017 " 1.1" " 3.2" " 1.2" " 17.4" " -0.3"
## 2018 " -5.8" " 2.4" " -9.4" " -6.5" "-12.6"
## 2019 " 1.8" " 2.7" " 3.3" " 26.3" " -6.7"
## 2020 " NA" " NA" " NA" "-22.9" "-22.9"
## Avg " 1.2" " 1.6" " 1.1" " 7.3" "-10.0"
plotbt.transition.map(model$equal.weight$weight)
strategy.performance.snapshoot(model, T)
## NULL
#Question 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<- po_industry.price['199912/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] 244
hist <- na.omit(ret[1:36,])
cov(hist)
## NoDur Durbl Manuf Enrgy HiTec
## NoDur 0.0016426896 0.0007103215 0.0012625680 0.0012406606 0.0002742679
## Durbl 0.0007103215 0.0065279312 0.0029931503 0.0015152232 0.0052776749
## Manuf 0.0012625680 0.0029931503 0.0028307012 0.0018663417 0.0038281361
## Enrgy 0.0012406606 0.0015152232 0.0018663417 0.0032639065 0.0016543913
## HiTec 0.0002742679 0.0052776749 0.0038281361 0.0016543913 0.0167927731
## Telcm 0.0008522150 0.0032317586 0.0019651145 0.0011852076 0.0073171178
## Shops 0.0013861152 0.0030371153 0.0023003697 0.0017254577 0.0037485055
## Hlth 0.0007727769 0.0003602416 0.0008818431 0.0008697619 0.0017880602
## Utils 0.0010881583 0.0014842431 0.0013466002 0.0026010748 -0.0002969502
## Other 0.0013516045 0.0028563637 0.0023684873 0.0022746268 0.0037290817
## Telcm Shops Hlth Utils Other
## NoDur 0.000852215 0.0013861152 0.0007727769 0.0010881583 0.0013516045
## Durbl 0.003231759 0.0030371153 0.0003602416 0.0014842431 0.0028563637
## Manuf 0.001965114 0.0023003697 0.0008818431 0.0013466002 0.0023684873
## Enrgy 0.001185208 0.0017254577 0.0008697619 0.0026010748 0.0022746268
## HiTec 0.007317118 0.0037485055 0.0017880602 -0.0002969502 0.0037290817
## Telcm 0.006584241 0.0027406291 0.0012590837 -0.0001714410 0.0024780826
## Shops 0.002740629 0.0032190471 0.0004644387 0.0009176253 0.0024429393
## Hlth 0.001259084 0.0004644387 0.0023799446 0.0012029038 0.0008680077
## Utils -0.000171441 0.0009176253 0.0012029038 0.0037558150 0.0018113098
## Other 0.002478083 0.0024429393 0.0008680077 0.0018113098 0.0030776456
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
## 0.642219085 0.178186006 -0.120002214 0.146892031 0.026085875 0.009055721
## Shops Hlth Utils Other
## 0.015009517 0.308134442 0.009805765 -0.215386227
sum(weight[36,])
## [1] 1
model$min.var.monthly <- bt.run(data, trade.summary = T)
## Latest weights :
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops
## 2020-03-31 141645994 65587899 98527601 65494229 147304913 44919982 127166270
## Hlth Utils Other
## 2020-03-31 318521526 35715198 26411383
##
## Performance summary :
## CAGR Best Worst
## -100 0 -100
sum(as.numeric(weight[36,])*as.numeric(ret[37,]))
## [1] -0.0138826
model$min.var.monthly$ret[37, ]
## NoDur
## 2002-12-31 -1
#Question 4: Plot both strategies side by side and compare their performance and comment.
plotbt.custom.report.part1(model$min.var.monthly, model$equal.weight)
## Warning in xy.coords(x, y, xlabel, ylabel, log): 243 y values <= 0 omitted from
## logarithmic plot
## Warning in plot.window(...): nonfinite axis limits [GScale(-inf,0.649055,2, .);
## log=1]
layout(1:2)
plotbt.transition.map(model$min.var.monthly$weight)
