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.
library(pacman)
library(readxl)
library(xts)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(openxlsx)
library(SIT)
## Loading required package: SIT.date
## Loading required package: quantmod
## 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
p_load(quantmod, quadprog,lpSolve)
p_load(xts)
p_load(TTR)
X10_Industry_Portfolios <- read_excel("10_Industry_Portfolios.xlsx", range = "A12:K1160")
## New names:
## * `` -> ...1
str(X10_Industry_Portfolios)
## tibble [1,148 × 11] (S3: tbl_df/tbl/data.frame)
## $ ...1 : num [1:1148] 192607 192608 192609 192610 192611 ...
## $ NoDur: num [1:1148] 1.45 3.97 1.14 -1.24 5.2 0.82 -0.67 3.37 2.73 3.35 ...
## $ Durbl: num [1:1148] 15.55 3.68 4.8 -8.23 -0.19 ...
## $ Manuf: num [1:1148] 4.69 2.81 1.15 -3.63 4.1 3.74 -0.08 5.81 1.43 0.77 ...
## $ Enrgy: num [1:1148] -1.18 3.47 -3.39 -0.78 0.01 2.82 1.29 1.47 -6.01 -5.17 ...
## $ HiTec: num [1:1148] 2.9 2.66 -0.38 -4.58 4.71 -0.02 -1.13 4.45 1.45 5.4 ...
## $ Telcm: num [1:1148] 0.83 2.17 2.41 -0.11 1.63 1.99 1.88 3.97 5.56 -2.13 ...
## $ Shops: num [1:1148] 0.11 -0.71 0.21 -2.29 6.43 0.62 -2.55 3.61 -0.41 4.46 ...
## $ Hlth : num [1:1148] 1.77 4.25 0.69 -0.57 5.42 0.11 5.05 1.71 1.01 2.74 ...
## $ Utils: num [1:1148] 7.04 -1.69 2.04 -2.63 3.71 -0.17 -1.79 4.53 0.37 1.71 ...
## $ Other: num [1:1148] 2.13 4.35 0.29 -2.84 2.11 3.47 1.5 5.05 1.22 0.83 ...
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"
X10_Industry_Portfolios <- xts(coredata(X10_Industry_Portfolios[, -1]/100), order.by = date)
head(X10_Industry_Portfolios)
## 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
industry.price <- cumprod(X10_Industry_Portfolios+1)*100
industry.price.sample <- industry.price['2000-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)
models <- list()
models$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.4 12.2 -17.4
bt.detail.summary(models$equal.weight)
## $System
## $System$Period
## [1] "Jan2000 - Mar2020"
##
## $System$Cagr
## [1] 6.44
##
## $System$Sharpe
## [1] 0.5
##
## $System$DVR
## [,1]
## NoDur 0.43
##
## $System$Volatility
## [1] 14.48
##
## $System$MaxDD
## [1] -48.19
##
## $System$AvgDD
## [1] -6.74
##
## $System$VaR
## 5%
## -7.18
##
## $System$CVaR
## [1] -9.78
##
## $System$Exposure
## [1] 99.59
##
##
## $Trade
## $Trade$Win.Percent
## [1] 100
##
## $Trade$Avg.Trade
## [1] 24.5
##
## $Trade$Avg.Win
## [1] 24.5
##
## $Trade$Avg.Loss
## [1] NaN
##
## $Trade$Best.Trade
## [1] 45.54
##
## $Trade$Worst.Trade
## [1] 3.96
##
## $Trade$WinLoss.Ratio
## [1] NaN
##
## $Trade$Avg.Len
## [1] 242
##
## $Trade$Num.Trades
## [1] 10
##
##
## $Period
## $Period$Win.Percent.Day
## [1] 64.2
##
## $Period$Best.Day
## [1] 12.2
##
## $Period$Worst.Day
## [1] -17.4
##
## $Period$Win.Percent.Month
## [1] 64.2
##
## $Period$Best.Month
## [1] 12.2
##
## $Period$Worst.Month
## [1] -17.4
##
## $Period$Win.Percent.Year
## [1] 66.7
##
## $Period$Best.Year
## [1] 33.7
##
## $Period$Worst.Year
## [1] -35.4
#MVP PORTFOLIO
industry.price.sample <- industry.price['2000-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 = -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,] 225714.9 310742.6 182511.9 232129.6 583276.5 278737.4 228728.2 697114.0
## [2,] 211743.2 285821.0 175320.9 218991.1 689374.4 269065.2 220173.7 676758.2
## [3,] 228174.4 315975.1 188434.9 245467.1 716535.8 289298.9 249500.9 678788.5
## [4,] 224021.6 345329.2 191167.2 240754.1 639938.1 266531.1 238348.2 714628.6
## [5,] 240196.0 299607.6 187993.9 263722.1 570568.8 238731.9 231745.9 742856.4
## [6,] 245936.7 271174.9 185625.1 249612.9 644971.0 248734.8 226392.6 828433.4
## Utils Other
## [1,] 58684.70 84089.12
## [2,] 54424.19 78101.98
## [3,] 57564.47 89098.73
## [4,] 61939.37 86318.85
## [5,] 64355.00 89253.69
## [6,] 61291.70 86629.64
weight[] <- NA
head(weight)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## [1,] NA NA NA NA NA NA NA NA NA NA
## [2,] NA NA NA NA NA NA NA NA NA NA
## [3,] NA NA NA NA NA NA NA NA NA NA
## [4,] NA NA NA NA NA NA NA NA NA NA
## [5,] NA NA NA NA NA NA NA NA NA NA
## [6,] NA NA NA NA NA NA NA NA NA NA
prices <- data$prices
ret <- prices / mlag(prices) - 1
head(ret)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## 2000-01-31 NA NA NA NA NA NA NA NA
## 2000-02-29 -0.0619 -0.0802 -0.0394 -0.0566 0.1819 -0.0347 -0.0374 -0.0292
## 2000-03-31 0.0776 0.1055 0.0748 0.1209 0.0394 0.0752 0.1332 0.0030
## 2000-04-30 -0.0182 0.0929 0.0145 -0.0192 -0.1069 -0.0787 -0.0447 0.0528
## 2000-05-31 0.0722 -0.1324 -0.0166 0.0954 -0.1084 -0.1043 -0.0277 0.0395
## 2000-06-30 0.0239 -0.0949 -0.0126 -0.0535 0.1304 0.0419 -0.0231 0.1152
## Utils Other
## 2000-01-31 NA NA
## 2000-02-29 -0.0726 -0.0712
## 2000-03-31 0.0577 0.1408
## 2000-04-30 0.0760 -0.0312
## 2000-05-31 0.0390 0.0340
## 2000-06-30 -0.0476 -0.0294
hist <- na.omit(ret[1:36,])
for( i in 36 : (dim(weight)[1]) ) {
hist = ret[ (i- 36 +1):i, ]
hist = na.omit(hist)
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
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 -0.72 -16.3 -16.07 -12.18 13.28 31.46 -16.08 39.1 56.35 21.16
##
## Performance summary :
## CAGR Best Worst
## 8.1 8.8 -15.6
#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.
industry.price.sample <- industry.price['2000-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,] 225714.9 310742.6 182511.9 232129.6 583276.5 278737.4 228728.2 697114.0
## [2,] 211743.2 285821.0 175320.9 218991.1 689374.4 269065.2 220173.7 676758.2
## [3,] 228174.4 315975.1 188434.9 245467.1 716535.8 289298.9 249500.9 678788.5
## [4,] 224021.6 345329.2 191167.2 240754.1 639938.1 266531.1 238348.2 714628.6
## [5,] 240196.0 299607.6 187993.9 263722.1 570568.8 238731.9 231745.9 742856.4
## [6,] 245936.7 271174.9 185625.1 249612.9 644971.0 248734.8 226392.6 828433.4
## Utils Other
## [1,] 58684.70 84089.12
## [2,] 54424.19 78101.98
## [3,] 57564.47 89098.73
## [4,] 61939.37 86318.85
## [5,] 64355.00 89253.69
## [6,] 61291.70 86629.64
weight[] <- NA
head(weight)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## [1,] NA NA NA NA NA NA NA NA NA NA
## [2,] NA NA NA NA NA NA NA NA NA NA
## [3,] NA NA NA NA NA NA NA NA NA NA
## [4,] NA NA NA NA NA NA NA NA NA NA
## [5,] NA NA NA NA NA NA NA NA NA NA
## [6,] NA NA NA NA NA NA NA NA NA NA
prices <- data$prices
ret <- prices / mlag(prices) - 1
head(ret)
## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth
## 2000-01-31 NA NA NA NA NA NA NA NA
## 2000-02-29 -0.0619 -0.0802 -0.0394 -0.0566 0.1819 -0.0347 -0.0374 -0.0292
## 2000-03-31 0.0776 0.1055 0.0748 0.1209 0.0394 0.0752 0.1332 0.0030
## 2000-04-30 -0.0182 0.0929 0.0145 -0.0192 -0.1069 -0.0787 -0.0447 0.0528
## 2000-05-31 0.0722 -0.1324 -0.0166 0.0954 -0.1084 -0.1043 -0.0277 0.0395
## 2000-06-30 0.0239 -0.0949 -0.0126 -0.0535 0.1304 0.0419 -0.0231 0.1152
## Utils Other
## 2000-01-31 NA NA
## 2000-02-29 -0.0726 -0.0712
## 2000-03-31 0.0577 0.1408
## 2000-04-30 0.0760 -0.0312
## 2000-05-31 0.0390 0.0340
## 2000-06-30 -0.0476 -0.0294
hist <- na.omit(ret[1:36,])
for( i in 36 : (dim(weight)[1]) ) {
hist = ret[ (i- 36 +1):i, ]
hist = na.omit(hist)
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
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 0 0 0 0 0 22.98 0 24.53 52.49 0
##
## Performance summary :
## CAGR Best Worst
## 7.2 7.3 -13
library(ggplot2)
plotbt.custom.report.part1(models$equal.weight, min.var, 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.
#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(models$equal.weight, min.var, min.var.positive)
3. Please explain the meaning of the risk measures: a.Sharpe b.DVR c.MaxDD d.AvgDD e.VaR f.CVaR (Hint: you can google for the meaning of those terms. You can also check the function bt.detail.summary for the details of calculations.)
a.Sharpe: this ratio is the average return earned in excess of the risk-free rate per unit of volatility or total risk. Volatility is a measure of the price fluctuations of an asset or portfolio.
Sharpe's formular: Sharpe Ratio = (Rp-Rf)/σp
b.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: 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's formular: MaxDD = (Trough Value−Peak Value)/Peak Value
d.AvgDD: The average drawdown: up to time T is the time average of drawdowns that have occurred up to time T
e.VaR: Value at risk: is a statistic that quantifies the extent of possible financial losses within a firm, portfolio, or position over a specific time frame.
f.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. 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. Conditional value at risk is used in portfolio optimization for effective risk management.