rm(list=ls())
#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)
# library(readr)
Data <- read.csv("Data.csv")
head(Data)
## Date NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 1 192607 1.45 15.55 4.69 -1.18 2.90 0.83 0.11 1.77 7.04 2.16
## 2 192608 3.97 3.68 2.81 3.47 2.66 2.17 -0.71 4.25 -1.69 4.38
## 3 192609 1.14 4.80 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.85
## 5 192611 5.20 -0.19 4.10 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.40
#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.
nrow(Data)
## [1] 1125
con = gzcon(url('https://github.com/systematicinvestor/SIT/raw/master/sit.gz', 'rb'))
source(con)
close(con)
# install.packages(rlang)
#install.packages(pacman)
library(pacman)
library(xts)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Registered S3 method overwritten by 'xts':
## method from
## as.zoo.xts zoo
#install.packages(xts)
p_load(quantmod, quadprog, lpSolve)
date <- seq(as.Date("1926-08-01"), length=1125, by="1 month") -1
Data <- xts(coredata(Data[, -1])/100, order.by = date)
head(Data)
## 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
Data.price <- cumprod(Data + 1) *100
head(Data.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
Data.1 <- Data.price['199912/202003']
head(Data.1)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops
## 1999-12-31 237112.8 301061.0 196892.3 223807.9 618354.6 291768.6 255894.3
## 2000-01-31 225802.6 298441.8 181160.6 225822.1 589230.1 279981.1 227157.4
## 2000-02-29 211825.4 274715.6 173479.4 213537.4 696352.1 269929.8 218389.1
## 2000-03-31 228220.7 303588.3 187982.3 239717.1 723858.0 290363.5 247391.2
## 2000-04-30 224067.0 331730.9 189786.9 234970.7 646477.6 267424.8 236827.6
## 2000-05-31 240244.7 287876.1 187110.9 257151.9 576399.4 239585.8 230433.2
## Hlth Utils Other
## 1999-12-31 644583.7 55424.06 89859.46
## 2000-01-31 693314.3 58610.94 85689.98
## 2000-02-29 673346.8 54355.79 79708.82
## 2000-03-31 675232.2 57492.12 90963.70
## 2000-04-30 710681.9 61861.52 87861.84
## 2000-05-31 738682.8 64274.12 90901.86
#to create equal weight
#we need 5 inputs :
data <- new.env()
data$prices <- Data.1
data$weight <- Data.1
data$execution.price <- data$prices
data$execution.price[] <- NA
data$symbolnames <- colnames(data$prices)
prices <- data$prices
n <- ncol(prices)
data$weight <- ntop(prices, n)
#method 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
#method 2
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
#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.
prices.2 <- Data.price["199701/202003"]
head(prices.2)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops
## 1997-01-31 202490.4 191292.0 125769.0 165710.3 186257.1 101685.70 121842.3
## 1997-02-28 210772.2 191961.5 126787.8 156281.4 172399.5 104004.13 125595.0
## 1997-03-31 199980.7 184398.2 122045.9 164423.7 162831.4 96099.82 123974.9
## 1997-04-30 210359.7 188657.8 128563.1 164505.9 176102.1 98540.75 126714.7
## 1997-05-31 222749.9 201241.3 138603.9 176564.2 193958.9 105083.86 134368.3
## 1997-06-30 230613.0 209089.7 145825.2 178877.1 196557.9 109056.03 141113.6
## Hlth Utils Other
## 1997-01-31 379668.2 45784.85 59192.40
## 1997-02-28 383237.0 45523.88 60731.40
## 1997-03-31 354877.5 44267.42 57154.33
## 1997-04-30 376737.9 43652.10 60143.50
## 1997-05-31 402770.5 45297.79 63902.46
## 1997-06-30 438576.8 46683.90 67334.03
tail(prices.2)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## 2019-10-31 1463702 621091.9 1062418.4 743365.6 1404956 455592.0 1310897 3018307
## 2019-11-30 1496342 638482.4 1098009.5 752509.0 1476750 463564.8 1339737 3178277
## 2019-12-31 1548415 671364.3 1113711.0 799917.1 1531832 469266.7 1357957 3284114
## 2020-01-31 1542376 711109.0 1079520.1 704167.0 1581464 459505.9 1370179 3224672
## 2020-02-29 1408035 658913.6 986897.2 596218.2 1471078 432211.3 1276870 3043123
## 2020-03-31 1247097 509340.2 820210.3 390045.9 1325294 374165.3 1178806 2881533
## Utils Other
## 2019-10-31 358932.3 278642.3
## 2019-11-30 351502.4 292462.9
## 2019-12-31 365351.6 299452.8
## 2020-01-31 383473.0 295380.3
## 2020-02-29 345624.2 266462.5
## 2020-03-31 300727.6 216047.8
data$prices <- prices.2
data$weight <- prices.2
data$execution.price <-prices.2 * NA
prices.3 <- data$prices
# Create Constraints
#*****************************************************************
constraints = new.constraints(n, lb = -Inf, ub = +Inf)
# SUM x.i = 1
constraints = add.constraints(rep(1, n), 1, type = '=', constraints)
ret = prices.3 / mlag(prices) - 1
weight = coredata(prices.3)
weight[] = NA
nrow(prices.3)
## [1] 279
hist <- na.omit(ret[1:36,])
cov(hist)
## NoDur Durbl Manuf Enrgy HiTec
## NoDur 0.0016404657 0.0007069172 0.0013045727 0.0012482727 0.0002766077
## Durbl 0.0007069172 0.0065133071 0.0030994922 0.0015503356 0.0052896175
## Manuf 0.0013045727 0.0030994922 0.0029752026 0.0019617135 0.0040592288
## Enrgy 0.0012482727 0.0015503356 0.0019617135 0.0033391237 0.0017922229
## HiTec 0.0002766077 0.0052896175 0.0040592288 0.0017922229 0.0168690721
## Telcm 0.0008491338 0.0032253793 0.0020862306 0.0012373550 0.0073262503
## Shops 0.0013868583 0.0030578080 0.0023807928 0.0017300386 0.0037600881
## Hlth 0.0007697315 0.0003594804 0.0009048168 0.0008885056 0.0018036838
## Utils 0.0010969652 0.0015043611 0.0013648506 0.0026570313 -0.0002615917
## Other 0.0013518406 0.0028319887 0.0024663729 0.0023239853 0.0037941659
## Telcm Shops Hlth Utils Other
## NoDur 0.0008491338 0.0013868583 0.0007697315 0.0010969652 0.0013518406
## Durbl 0.0032253793 0.0030578080 0.0003594804 0.0015043611 0.0028319887
## Manuf 0.0020862306 0.0023807928 0.0009048168 0.0013648506 0.0024663729
## Enrgy 0.0012373550 0.0017300386 0.0008885056 0.0026570313 0.0023239853
## HiTec 0.0073262503 0.0037600881 0.0018036838 -0.0002615917 0.0037941659
## Telcm 0.0065823291 0.0027415031 0.0012504809 -0.0001643024 0.0025272156
## Shops 0.0027415031 0.0032279802 0.0004610245 0.0009212440 0.0024406072
## Hlth 0.0012504809 0.0004610245 0.0023774438 0.0012220088 0.0009128341
## Utils -0.0001643024 0.0009212440 0.0012220088 0.0038001473 0.0018514397
## Other 0.0025272156 0.0024406072 0.0009128341 0.0018514397 0.0031256521
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.678634254 0.206620180 -0.209579994 0.168581892 0.034939397 -0.006892715
## Shops Hlth Utils Other
## 0.014612073 0.324051433 -0.019662453 -0.191304067
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 140803527 65891363 98689725 59621820 147107768 43221127 127686955
## Hlth Utils Other
## 2020-03-31 304312265 34562422 26646253
##
## Performance summary :
## CAGR Best Worst
## -100 0 -100
#data$weight[] = weight
#capital = 100000
#data$weight[] = (capital / prices) * data$weight
# to verify the default do.lag = 1 day
sum(as.numeric(weight[36,])*as.numeric(ret[37,]))
## [1] -0.01513485
model$min.var.monthly$ret[37, ]
## NoDur
## 2000-01-31 -1
#4. Plot both strategies side by side and compare their performance and comment.
#Publish your results in RPubs and upload your link.
plotbt.custom.report.part1(model$min.var.monthly, model$equal.weight)
## Warning in xy.coords(x, y, xlabel, ylabel, log): 278 y values <= 0 omitted from
## logarithmic plot
## Warning in plot.window(...): nonfinite axis limits [GScale(-inf,0.642875,2, .);
## log=1]
#
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)
## Warning in plot.window(...): nonfinite axis limits [GScale(-inf,0.642875,2, .);
## log=1]
## Warning in max(mret, na.rm = T): no non-missing arguments to max; returning -Inf
## Warning in min(mret, na.rm = T): no non-missing arguments to min; returning Inf
## NULL
model <- rev(model)
plotbt.custom.report(model)
## Warning in xy.coords(x, y, xlabel, ylabel, log): 278 y values <= 0 omitted from
## logarithmic plot
## Warning in plot.window(...): nonfinite axis limits [GScale(-inf,0.642875,2, .);
## log=1]
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in min(iequity/cummax(iequity) - 1, na.rm = T): no non-missing arguments
## to min; returning Inf
## Warning in max(mret, na.rm = T): no non-missing arguments to max; returning -Inf
## Warning in min(mret, na.rm = T): no non-missing arguments to min; returning Inf
## Warning in max(mret, na.rm = T): no non-missing arguments to max; returning -Inf
## Warning in min(mret, na.rm = T): no non-missing arguments to min; returning Inf
