##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(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)
#read.csv, read.table, read_csv
industry10 <- read.table("10_Industry_Portfolios_Wout_Div.txt", head = TRUE)
head(industry10)
## Date NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 1 192607 1.31 15.07 4.39 -1.30 2.84 0.83 -0.13 1.11 6.89 1.88
## 2 192608 3.70 3.09 2.46 3.13 2.37 2.17 -0.95 3.59 -2.07 4.00
## 3 192609 0.43 4.48 0.56 -3.86 -1.17 0.89 0.02 0.52 1.65 -0.15
## 4 192610 -1.47 -8.47 -3.92 -0.90 -4.64 -0.11 -2.54 -1.20 -2.88 -3.11
## 5 192611 4.92 -2.37 3.71 -0.62 4.46 1.63 5.90 4.78 3.31 1.65
## 6 192612 0.04 9.56 2.72 2.21 -0.83 0.51 0.43 -0.68 -0.67 2.52
date <- seq(as.Date("1926-08-01"), length = 1126, 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-11-30" "2019-12-31" "2020-01-31" "2020-02-29" "2020-03-31"
## [6] "2020-04-30"
class(date)
## [1] "Date"
#turn data into time series
industry10 <- xts(industry10[, -1]/100, order.by = date)
head(industry10)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## 1926-07-31 0.0131 0.1507 0.0439 -0.0130 0.0284 0.0083 -0.0013 0.0111
## 1926-08-31 0.0370 0.0309 0.0246 0.0313 0.0237 0.0217 -0.0095 0.0359
## 1926-09-30 0.0043 0.0448 0.0056 -0.0386 -0.0117 0.0089 0.0002 0.0052
## 1926-10-31 -0.0147 -0.0847 -0.0392 -0.0090 -0.0464 -0.0011 -0.0254 -0.0120
## 1926-11-30 0.0492 -0.0237 0.0371 -0.0062 0.0446 0.0163 0.0590 0.0478
## 1926-12-31 0.0004 0.0956 0.0272 0.0221 -0.0083 0.0051 0.0043 -0.0068
## Utils Other
## 1926-07-31 0.0689 0.0188
## 1926-08-31 -0.0207 0.0400
## 1926-09-30 0.0165 -0.0015
## 1926-10-31 -0.0288 -0.0311
## 1926-11-30 0.0331 0.0165
## 1926-12-31 -0.0067 0.0252
#convert returns into price
industry.price <- cumprod(industry10 + 1)*100
head(industry.price)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops
## 1926-07-31 101.3100 115.0700 104.3900 98.70000 102.84000 100.8300 99.87000
## 1926-08-31 105.0585 118.6257 106.9580 101.78931 105.27731 103.0180 98.92124
## 1926-09-30 105.5102 123.9401 107.5570 97.86024 104.04556 103.9349 98.94102
## 1926-10-31 103.9592 113.4424 103.3407 96.97950 99.21785 103.8205 96.42792
## 1926-11-30 109.0740 110.7538 107.1747 96.37823 103.64297 105.5128 102.11716
## 1926-12-31 109.1176 121.3418 110.0898 98.50819 102.78273 106.0509 102.55627
## Hlth Utils Other
## 1926-07-31 101.1100 106.8900 101.8800
## 1926-08-31 104.7398 104.6774 105.9552
## 1926-09-30 105.2845 106.4046 105.7963
## 1926-10-31 104.0211 103.3401 102.5060
## 1926-11-30 108.9933 106.7607 104.1974
## 1926-12-31 108.2521 106.0454 106.8231
##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 <- industry.price['1999-12/2020-03']
head(industry.price.sample)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops
## 1999-12-31 10894.032 7087.644 11453.96 9215.298 80347.88 6722.323 18316.96
## 2000-01-31 10367.850 7006.845 10533.06 9296.393 76563.49 6442.002 16256.30
## 2000-02-29 9713.639 6426.678 10070.66 8746.976 90459.77 6206.869 15620.68
## 2000-03-31 10428.563 7098.909 10895.45 9816.731 94014.83 6673.005 17684.17
## 2000-04-30 10233.549 7737.100 10993.50 9619.415 83955.25 6136.495 16925.52
## 2000-05-31 10958.084 6694.139 10822.01 10487.086 74837.71 5495.232 16460.07
## Hlth Utils Other
## 1999-12-31 47979.41 771.1645 4126.084
## 2000-01-31 51573.07 813.5014 3930.507
## 2000-02-29 50025.88 750.2110 3650.655
## 2000-03-31 50135.93 790.1973 4160.652
## 2000-04-30 52727.96 847.5656 4013.781
## 2000-05-31 54721.08 876.7218 4146.236
#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$symbolnames : asset names
data$prices = data$weight = 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"
#assign equal weights to 10 assets
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
#create a list model
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
## 4 11.8 -17.6
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
## 4 11.8 -17.6
head(equal.weight$ret)
## NoDur
## 1999-12-31 0.00000
## 2000-01-31 -0.02502
## 2000-02-29 -0.03220
## 2000-03-31 0.08241
## 2000-04-30 -0.00812
## 2000-05-31 -0.01248
bt.detail.summary(model$equal.weight)
## $System
## $System$Period
## [1] "Dec1999 - Mar2020"
##
## $System$Cagr
## [1] 4
##
## $System$Sharpe
## [1] 0.34
##
## $System$DVR
## [,1]
## NoDur 0.28
##
## $System$Volatility
## [1] 14.49
##
## $System$MaxDD
## [1] -49.78
##
## $System$AvgDD
## [1] -7.48
##
## $System$VaR
## 5%
## -7.22
##
## $System$CVaR
## [1] -9.98
##
## $System$Exposure
## [1] 99.59
##
##
## $Trade
## $Trade$Win.Percent
## [1] 90
##
## $Trade$Avg.Trade
## [1] 11.6
##
## $Trade$Avg.Win
## [1] 13.1
##
## $Trade$Avg.Loss
## [1] -2.3
##
## $Trade$Best.Trade
## [1] 25.53
##
## $Trade$Worst.Trade
## [1] -2.27
##
## $Trade$WinLoss.Ratio
## [1] 5.76
##
## $Trade$Avg.Len
## [1] 243
##
## $Trade$Num.Trades
## [1] 10
##
##
## $Period
## $Period$Win.Percent.Day
## [1] 61.9
##
## $Period$Best.Day
## [1] 11.8
##
## $Period$Worst.Day
## [1] -17.6
##
## $Period$Win.Percent.Month
## [1] 61.9
##
## $Period$Best.Month
## [1] 11.8
##
## $Period$Worst.Month
## [1] -17.6
##
## $Period$Win.Percent.Year
## [1] 68.2
##
## $Period$Best.Year
## [1] 31.1
##
## $Period$Worst.Year
## [1] -36.9
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.2" " 8.2" " -0.8" " -1.2" " 0.4" " -0.9" " 5.0" " -0.6"
## 2001 " 2.4" " -4.7" " -4.9" " 6.8" " 0.6" " -2.4" " -0.7" " -5.3" " -8.5"
## 2002 " -1.2" " -0.2" " 4.7" " -4.0" " -1.3" " -7.1" " -9.4" " 0.7" " -9.9"
## 2003 " -3.2" " -2.5" " 0.8" " 7.7" " 6.2" " 1.4" " 1.1" " 3.1" " -1.7"
## 2004 " 1.2" " 1.6" " -1.1" " -0.7" " 0.1" " 2.3" " -3.3" " -0.1" " 1.9"
## 2005 " -2.2" " 2.7" " -1.9" " -3.1" " 3.6" " 1.1" " 4.2" " -0.8" " 0.3"
## 2006 " 3.9" " -0.2" " 1.4" " 1.0" " -2.0" " 0.6" " 0.2" " 1.9" " 1.7"
## 2007 " 1.9" " -1.2" " 1.5" " 4.2" " 3.5" " -1.4" " -3.5" " 0.7" " 3.2"
## 2008 " -6.3" " -2.5" " -0.8" " 4.7" " 2.5" " -8.1" " -1.4" " 1.7" " -9.6"
## 2009 " -7.2" "-10.1" " 7.8" " 11.8" " 4.0" " 0.7" " 8.0" " 2.2" " 3.9"
## 2010 " -3.5" " 3.1" " 5.9" " 2.3" " -7.8" " -5.6" " 7.6" " -4.3" " 9.2"
## 2011 " 1.3" " 3.3" " 1.0" " 3.2" " -1.0" " -1.6" " -2.9" " -5.7" " -7.5"
## 2012 " 4.3" " 3.9" " 2.2" " -0.9" " -5.5" " 3.0" " 1.3" " 1.6" " 2.7"
## 2013 " 5.4" " 1.2" " 4.1" " 2.2" " 1.7" " -0.9" " 5.5" " -3.0" " 3.5"
## 2014 " -3.4" " 4.7" " 0.4" " 0.7" " 1.6" " 2.6" " -2.9" " 4.1" " -3.0"
## 2015 " -2.6" " 5.1" " -1.3" " 0.7" " 0.6" " -2.0" " 0.7" " -6.0" " -3.3"
## 2016 " -4.9" " 0.3" " 6.9" " 1.3" " 0.8" " 0.8" " 3.1" " -0.7" " 0.0"
## 2017 " 1.6" " 2.6" " 0.0" " 0.7" " 0.3" " 0.4" " 1.5" " -0.7" " 2.4"
## 2018 " 4.0" " -5.3" " -1.8" " 0.6" " 1.7" " 1.5" " 2.6" " 1.9" " 0.3"
## 2019 " 7.9" " 3.0" " 0.8" " 3.1" " -7.0" " 7.1" " 0.5" " -2.2" " 2.0"
## 2020 " -0.7" " -8.7" "-15.6" " NA" " NA" " NA" " NA" " NA" " NA"
## Avg " -0.2" " -0.3" " 0.9" " 2.1" " 0.1" " -0.4" " 0.6" " -0.3" " -0.6"
## Oct Nov Dec Year MaxDD
## 1999 " NA" " NA" " NA" " 0.0" " 0.0"
## 2000 " 0.0" " -5.9" " 3.1" " 0.8" " -6.5"
## 2001 " 1.9" " 6.3" " 2.0" " -7.5" "-18.3"
## 2002 " 6.5" " 5.8" " -4.6" "-19.7" "-27.7"
## 2003 " 5.4" " 1.3" " 5.8" " 27.7" " -5.6"
## 2004 " 1.3" " 4.5" " 3.2" " 11.2" " -3.4"
## 2005 " -3.2" " 2.7" " 0.0" " 2.9" " -5.0"
## 2006 " 4.0" " 2.0" " 0.7" " 16.2" " -2.0"
## 2007 " 2.0" " -4.1" " -0.5" " 6.1" " -4.8"
## 2008 "-17.6" " -6.8" " 1.4" "-36.9" "-37.8"
## 2009 " -1.9" " 5.6" " 3.2" " 29.1" "-16.6"
## 2010 " 4.0" " 0.9" " 6.2" " 17.6" "-12.9"
## 2011 " 11.4" " -0.6" " 0.8" " 0.6" "-17.3"
## 2012 " -1.0" " 0.6" " 0.9" " 13.7" " -6.3"
## 2013 " 3.9" " 2.0" " 2.1" " 31.1" " -3.0"
## 2014 " 2.5" " 2.0" " -0.3" " 9.0" " -3.4"
## 2015 " 7.3" " -0.1" " -2.8" " -4.3" "-10.3"
## 2016 " -2.6" " 3.8" " 2.1" " 11.0" " -4.9"
## 2017 " 1.0" " 2.9" " 1.0" " 14.6" " -0.7"
## 2018 " -6.0" " 2.1" " -9.6" " -8.7" "-13.3"
## 2019 " 1.6" " 2.4" " 3.0" " 23.6" " -7.0"
## 2020 " NA" " NA" " NA" "-23.5" "-23.5"
## Avg " 1.0" " 1.4" " 0.9" " 5.2" "-10.5"
plotbt.transition.map(model$equal.weight$weight)
strategy.performance.snapshoot(model, T)
## NULL
##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.
# reset sample data range
industry.price.sample <- industry.price['1997-01/2020-03']
data$prices <- industry.price.sample
data$weight <- industry.price.sample
data$execution.price <- industry.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] 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,]
## NoDur Durbl Manuf Enrgy HiTec Telcm
## 0.13425043 -0.21557799 -0.15448139 -0.19704381 0.13756911 0.22090569
## Shops Hlth Utils Other
## -0.04245075 0.52853879 0.50981042 0.07847949
sum(weight[36,])
## [1] 1
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 -1.64 -16.74 -15.26 -12.81 11.98 31.93 -15.02 37.17 56.55 23.83
##
## Performance summary :
## CAGR Best Worst
## 3.8 8.9 -15
sum(as.numeric(weight[36,])*as.numeric(ret[37,]))
## [1] 0.05960027
model$min.var.monthly$ret[37, ]
## NoDur
## 2000-01-31 0.007171878
##Plot both strategies side by side and compare their performance and comment.
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)
