Midterm & HW5
Nominzul Jamiyansharav
2022-04-16
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.
require(pacman)## Loading required package: pacmanrequire(xts)## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericrequire(openxlsx)## Loading required package: openxlsxrequire(quantmod)## Loading required package: quantmod## Loading required package: TTR## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoorequire(devtools)## Loading required package: devtools## Loading required package: usethisdevtools::install_github('systematicinvestor/SIT.date')## Skipping install of 'SIT.date' from a github remote, the SHA1 (6263da60) has not changed since last install.
## Use `force = TRUE` to force installationrequire(curl)## Loading required package: curl## Using libcurl 7.68.0 with OpenSSL/1.1.1fcurl_download('https://github.com/systematicinvestor/SIT/raw/master/SIT.tar.gz', 'SIT',mode = 'wb',quiet=T)install.packages('SIT', repos = NULL, type='source')## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.1'
## (as 'lib' is unspecified)require(SIT)## Loading required package: SIT## Loading required package: SIT.date##
## Attaching package: 'SIT'## The following object is masked from 'package:TTR':
##
## DVI## The following object is masked from 'package:base':
##
## closerequire(ggplot2)## Loading required package: ggplot2p_load(quantmod, quadprog,lpSolve)
p_load(xts)
p_load(TTR)
require(readxl) ## Loading required package: readxlTable <- read_excel("10_Industry_Portfolios.xlsx")
str(Table) ## tibble [1,148 × 11] (S3: tbl_df/tbl/data.frame)
## $ Date : num [1:1148] 192607 192608 192609 192610 192611 ...
## $ NoDur: num [1:1148] 1.31 3.7 0.43 -1.47 4.92 0.04 -0.9 3.01 1.86 3.2 ...
## $ Durbl: num [1:1148] 15.07 3.09 4.48 -8.47 -2.37 ...
## $ Manuf: num [1:1148] 4.39 2.46 0.56 -3.92 3.71 2.72 -0.37 5.48 0.79 0.49 ...
## $ Enrgy: num [1:1148] -1.3 3.13 -3.86 -0.9 -0.62 2.21 1.08 0.98 -6.52 -5.39 ...
## $ HiTec: num [1:1148] 2.84 2.37 -1.17 -4.64 4.46 -0.83 -1.2 4.2 0.64 5.4 ...
## $ Telcm: num [1:1148] 0.83 2.17 0.89 -0.11 1.63 0.51 1.88 3.97 4.16 -2.13 ...
## $ Shops: num [1:1148] -0.13 -0.95 0.02 -2.54 5.9 0.43 -2.79 3.11 -0.58 3.82 ...
## $ Hlth : num [1:1148] 1.11 3.59 0.52 -1.2 4.78 -0.68 4.43 1.08 0.81 2.16 ...
## $ Utils: num [1:1148] 6.89 -2.07 1.65 -2.88 3.31 -0.67 -1.99 4.13 -0.06 1.46 ...
## $ Other: num [1:1148] 1.84 3.97 -0.15 -3.11 1.66 2.59 1.17 4.67 0.71 0.68 ...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"class(date) ## [1] "Date"Table <- xts(coredata(Table[, -1]/100), order.by = date)
head(Table)## 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.0184
## 1926-08-31 -0.0207 0.0397
## 1926-09-30 0.0165 -0.0015
## 1926-10-31 -0.0288 -0.0311
## 1926-11-30 0.0331 0.0166
## 1926-12-31 -0.0067 0.0259industry.price <- cumprod(Table+1)*100
industry.price.sample <- industry.price['1999-01/2020-03']data <- new.env()
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"data$weight <- ntop(prices, n)
head(data$weight)## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 1999-01-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 1999-02-28 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 1999-03-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 1999-04-30 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 1999-05-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 1999-06-30 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1models <- list()
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.3 12 -17.6 bt.detail.summary(equal.weight)## $System
## $System$Period
## [1] "Jan1999 - Mar2020"
##
## $System$Cagr
## [1] 4.34
##
## $System$Sharpe
## [1] 0.37
##
## $System$DVR
## [,1]
## NoDur 0.3
##
## $System$Volatility
## [1] 14.34
##
## $System$MaxDD
## [1] -49.8
##
## $System$AvgDD
## [1] -7.11
##
## $System$VaR
## 5%
## -7.09
##
## $System$CVaR
## [1] -9.96
##
## $System$Exposure
## [1] 99.61
##
##
## $Trade
## $Trade$Win.Percent
## [1] 90
##
## $Trade$Avg.Trade
## [1] 13.4
##
## $Trade$Avg.Win
## [1] 15
##
## $Trade$Avg.Loss
## [1] -0.5
##
## $Trade$Best.Trade
## [1] 28.81
##
## $Trade$Worst.Trade
## [1] -0.55
##
## $Trade$WinLoss.Ratio
## [1] 27.3
##
## $Trade$Avg.Len
## [1] 254
##
## $Trade$Num.Trades
## [1] 10
##
##
## $Period
## $Period$Win.Percent.Day
## [1] 61.6
##
## $Period$Best.Day
## [1] 12
##
## $Period$Worst.Day
## [1] -17.6
##
## $Period$Win.Percent.Month
## [1] 61.6
##
## $Period$Best.Month
## [1] 12
##
## $Period$Worst.Month
## [1] -17.6
##
## $Period$Win.Percent.Year
## [1] 68.2
##
## $Period$Best.Year
## [1] 31
##
## $Period$Worst.Year
## [1] -36.8industry.price.sample <- industry.price['1999-01/2020-03']
data$prices = data$execution.price = data$weight = industry.price.sample
data$execution.price[] <- NA
data$symbolnames <- colnames(prices)# Create Constraints
constraints = new.constraints(n, lb = -Inf, ub = +Inf)
constraints = add.constraints(rep(1, n), 1, type = "=", constraints)
weight <- coredata(prices)
head(weight)## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## [1,] 12515.21 8184.454 9480.261 7748.004 50265.03 5341.395 16864.06 50106.28
## [2,] 12029.62 7811.243 9278.331 7459.779 44489.58 5185.426 16606.04 50161.40
## [3,] 11758.95 7743.286 9706.062 8604.855 48266.74 5144.980 17066.03 51400.39
## [4,] 12195.21 8517.614 10606.785 9969.585 49405.84 5560.180 17153.07 48537.39
## [5,] 12352.52 8035.517 10252.518 9615.664 49060.00 5616.338 16647.05 47484.13
## [6,] 12361.17 8081.320 10708.755 9470.468 54800.02 5939.839 17947.19 49573.43
## Utils Other
## [1,] 875.6968 4026.183
## [2,] 839.1802 4022.560
## [3,] 821.3896 4116.688
## [4,] 877.5726 4387.566
## [5,] 933.2107 4216.889
## [6,] 889.7231 4346.348weight[] <- NA
prices <- data$prices
ret <- prices / mlag(prices) - 1
head(ret)## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## 1999-01-31 NA NA NA NA NA NA NA NA
## 1999-02-28 -0.0388 -0.0456 -0.0213 -0.0372 -0.1149 -0.0292 -0.0153 0.0011
## 1999-03-31 -0.0225 -0.0087 0.0461 0.1535 0.0849 -0.0078 0.0277 0.0247
## 1999-04-30 0.0371 0.1000 0.0928 0.1586 0.0236 0.0807 0.0051 -0.0557
## 1999-05-31 0.0129 -0.0566 -0.0334 -0.0355 -0.0070 0.0101 -0.0295 -0.0217
## 1999-06-30 0.0007 0.0057 0.0445 -0.0151 0.1170 0.0576 0.0781 0.0440
## Utils Other
## 1999-01-31 NA NA
## 1999-02-28 -0.0417 -0.0009
## 1999-03-31 -0.0212 0.0234
## 1999-04-30 0.0684 0.0658
## 1999-05-31 0.0634 -0.0389
## 1999-06-30 -0.0466 0.0307hist <- 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)#Minimum Variance
data$weight[] = weight
capital = 100000
data$weight[] = (capital / prices) * data$weight
min.var = bt.run(data, type='share', capital=capital)## Latest weights :
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 2020-03-31 3.28 29.41 3.28 29.41 3.28 29.41 3.28 29.41 3.28 29.41
##
## Performance summary :
## CAGR Best Worst
## -3.6 32.7 -36.9 plotbt.custom.report.part1(equal.weight,min.var)
Question 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.
industry.price.sample <- industry.price['1999-01/2020-03']
data$prices = data$execution.price = data$weight = industry.price.sample
data$execution.price[] <- NA
data$symbolnames <- colnames(prices)
constraints = new.constraints(n, lb = 0, ub = +Inf)
constraints = add.constraints(rep(1, n), 1, type = "=", constraints)
weight <- coredata(prices)
head(weight)## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## [1,] 12515.21 8184.454 9480.261 7748.004 50265.03 5341.395 16864.06 50106.28
## [2,] 12029.62 7811.243 9278.331 7459.779 44489.58 5185.426 16606.04 50161.40
## [3,] 11758.95 7743.286 9706.062 8604.855 48266.74 5144.980 17066.03 51400.39
## [4,] 12195.21 8517.614 10606.785 9969.585 49405.84 5560.180 17153.07 48537.39
## [5,] 12352.52 8035.517 10252.518 9615.664 49060.00 5616.338 16647.05 47484.13
## [6,] 12361.17 8081.320 10708.755 9470.468 54800.02 5939.839 17947.19 49573.43
## Utils Other
## [1,] 875.6968 4026.183
## [2,] 839.1802 4022.560
## [3,] 821.3896 4116.688
## [4,] 877.5726 4387.566
## [5,] 933.2107 4216.889
## [6,] 889.7231 4346.348weight[] <- NA
prices <- data$prices
ret <- prices / mlag(prices) - 1
head(ret)## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## 1999-01-31 NA NA NA NA NA NA NA NA
## 1999-02-28 -0.0388 -0.0456 -0.0213 -0.0372 -0.1149 -0.0292 -0.0153 0.0011
## 1999-03-31 -0.0225 -0.0087 0.0461 0.1535 0.0849 -0.0078 0.0277 0.0247
## 1999-04-30 0.0371 0.1000 0.0928 0.1586 0.0236 0.0807 0.0051 -0.0557
## 1999-05-31 0.0129 -0.0566 -0.0334 -0.0355 -0.0070 0.0101 -0.0295 -0.0217
## 1999-06-30 0.0007 0.0057 0.0445 -0.0151 0.1170 0.0576 0.0781 0.0440
## Utils Other
## 1999-01-31 NA NA
## 1999-02-28 -0.0417 -0.0009
## 1999-03-31 -0.0212 0.0234
## 1999-04-30 0.0684 0.0658
## 1999-05-31 0.0634 -0.0389
## 1999-06-30 -0.0466 0.0307hist <- 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.pos = bt.run(data, type='share', capital=capital)## Latest weights :
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 2020-03-31 1.41 17.8 1.41 17.8 1.41 17.8 1.41 17.8 1.41 17.8
##
## Performance summary :
## CAGR Best Worst
## 3.7 24.4 -27.4 plotbt.custom.report.part1(equal.weight, min.var, min.var.pos)
plotbt.strategy.sidebyside(equal.weight, min.var, min.var.pos)
Question 3.
#Please explain the meaning of the risk measures: a. Sharpeb. DVRc. MaxDDd. AvgDDe. VaRf. CVaR
#Sharpe : The Sharpe ratio adjusts a portfolio’s past performance—or expected future performance—for the excess risk that was taken by the investor.
#DVR : DVR is the R-squared metric, which considers both returns per unit of risk and the linear fit of the price trajectory. It is the product of the Sharpe ratio and the coefficient of determination.
#MaxDD : The maximum observed loss from a peak to a trough of a portfolio, before a new peak is attained.
#AvgDD : The time average of drawdowns that have occurred up to time.
#VaR : A statistic that quantifies the extent of possible financial losses within a firm, portfolio, or position over a specific time frame.
#CVaR : The extended risk measure of value-at-risk that quantifies the average loss over a specified time period.models<-list("Min.var" = min.var,
"Min.var.pos" = min.var.pos,
"Equal.weight" = equal.weight)
strategy.performance.snapshoot(models, control=list(comparison=T),
sort.performance=T) 