#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


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

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

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.

industry.price.sample2<- po_industry.price['200001/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] 243
hist <- na.omit(ret[1:36,])
cov(hist)
##              NoDur        Durbl       Manuf        Enrgy         HiTec
## NoDur 0.0015539102 0.0007194911 0.001130782 0.0012501637  0.0002601378
## Durbl 0.0007194911 0.0066643726 0.003057027 0.0015040372  0.0054870962
## Manuf 0.0011307819 0.0030570272 0.002653465 0.0018767149  0.0038832466
## Enrgy 0.0012501637 0.0015040372 0.001876715 0.0032636472  0.0016404575
## HiTec 0.0002601378 0.0054870962 0.003883247 0.0016404575  0.0171053115
## Telcm 0.0008424610 0.0033625038 0.001998102 0.0011766155  0.0075119465
## Shops 0.0012227082 0.0031549157 0.002094729 0.0017354530  0.0038752628
## Hlth  0.0009065494 0.0004477979 0.001117506 0.0008479132  0.0019627974
## Utils 0.0011740029 0.0014196482 0.001453641 0.0025960251 -0.0003676423
## Other 0.0012865867 0.0029508923 0.002304101 0.0022750642  0.0038516545
##               Telcm        Shops         Hlth         Utils       Other
## NoDur  0.0008424610 0.0012227082 0.0009065494  0.0011740029 0.001286587
## Durbl  0.0033625038 0.0031549157 0.0004477979  0.0014196482 0.002950892
## Manuf  0.0019981016 0.0020947289 0.0011175065  0.0014536407 0.002304101
## Enrgy  0.0011766155 0.0017354530 0.0008479132  0.0025960251 0.002275064
## HiTec  0.0075119465 0.0038752628 0.0019627974 -0.0003676423 0.003851654
## Telcm  0.0067056821 0.0028179788 0.0013695088 -0.0002146346 0.002553862
## Shops  0.0028179788 0.0029924173 0.0007851265  0.0010346933 0.002387774
## Hlth   0.0013695088 0.0007851265 0.0022531753  0.0010324338 0.001030770
## Utils -0.0002146346 0.0010346933 0.0010324338  0.0036954133 0.001838559
## Other  0.0025538624 0.0023877740 0.0010307697  0.0018385587 0.003086157
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.66526132  0.19863448 -0.15486802  0.17158565  0.03321687  0.01353708 
##       Shops        Hlth       Utils       Other 
## -0.02330141  0.31185499  0.02205644 -0.23797740
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.03340824
model$min.var.monthly$ret[37, ]
##            NoDur
## 2003-01-31    -1

Question 1:Based on HW05, you have to recalculate MVP portfolio returns with additional conditiion which requires all weights to be greater than zero (non-negative weights) in portfolio rebalancing. Plot three strategies side by side.

hist <- ret[1:36, ]
hist <- na.omit(hist)
ia <- create.historical.ia(hist, 12)
weight = min.risk.portfolio(ia, constraints)     
hist <- ret[2:37, ]
hist <- na.omit(hist)
ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[3:38, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[4:39, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[5:40, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[6:41, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[7:42, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[8:43, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)
weight = min.risk.portfolio(ia, constraints)
hist <- ret[9:44, ]
hist <- na.omit(hist)
data$weight[] = weight   
capital = 100000
data$weight[] = (capital / prices) * data$weight
min.var.positive = bt.run(data, type='share', capital=capital)
## Latest weights :
##            NoDur Durbl Manuf Enrgy HiTec Telcm Shops   Hlth  Utils  Other
## 2020-03-31 23.32 -9.13 53.44 53.13 59.79 -2.18 25.09 -41.72 -13.58 -48.16
## 
## Performance summary :
##  CAGR    Best    Worst   
##  5.4 27.7    -32.6   
plotbt.custom.report.part1(model$equal.weight, min.var.positive)

2. Use the function: plotbt.strategy.sidebyside to show the summary of performance of three strategies: equal weighting, MVP and MVP with constraints of allowing only positive weights. Note: you just need to use monthly data to generate the results.

plotbt.strategy.sidebyside(model$equal.weight, model$min.var.monthly, min.var.positive)
## 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

3. Please explain the meaning of the risk measures: a. Sharpeb. DVRc. MaxDDd. AvgDDe. VaRf. CVaRHint: you can google for the meaning of those terms. You can also check the function bt.detail.summary for the details of calculations.

  1. Sharpe

Sharpe Ratio measures excess returns per unit of volatility, where we take the standard deviation to represent portfolio volatility. Sharpe Ratio is the mean of the excess monthly returns above the risk-free rate, divided by the standard deviation of the excess monthly returns above the risk-free rate.

  1. DVR

Deviation risk measure: is a function that is used to measure financial risk, and it differs from general risk measurements. Risk measurement is primarily used in the finance industry to measure the movement and volatility of an investment. C) MaxDD

A maximum drawdown (MaxDD) is the maximum observed loss from a peak to a trough of a portfolio, before a new peak is attained. Maximum drawdown is an indicator of downside risk over a specified time period. MaxDD = (Trough Value−Peak Value)/Peak Value

  1. AvgDD

The average drawdown: up to time T is the time average of drawdowns that have occurred up to time T e) VaR

Where, Rp = Return of the portfolio.

Z= Z value for level of confidence in a one-tailed test.

σ = Standard Deviation of the portfolio.

Vp= Value of the portfolio

  1. CVaR

Conditional Value at Risk (CVaR), also known as the expected shortfall, is a risk assessment measure that quantifies the amount of tail risk an investment portfolio has.Conditional value at risk is used in portfolio optimization for effective risk management.

CVaR is derived by taking a weighted average of the “extreme” losses in the tail of the distribution of possible returns, beyond the value at risk (VaR) cutoff point.