Midterm Test
110035105 - NGUYEN THI BICH HOA
2022-04-18
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.numericlibrary(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':
##
## closep_load(quantmod, quadprog,lpSolve)
p_load(xts)
p_load(TTR)
X10_Industry_Portfolios <- read_excel("C:/Users/CTY REDSTAR/Downloads/10_Industry_Portfolios.xlsx", range = "A12:K1160")## New names:
## * `` -> `...1`str(X10_Industry_Portfolios)## tibble [1,148 x 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.0347industry.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.64weight[] <- 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 NAprices <- 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.0294hist <- 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 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.
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.64weight[] <- 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 NAprices <- 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.0294hist <- 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)
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.
plotbt.strategy.sidebyside(models$equal.weight, min.var, min.var.positive)
Question 3: Explain the meaning of the risk measures: a.Sharpeb.DVRc.MaxDDd.AvgDDe.VaRf.CVaR
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. Fomula of Sharpe Ratio: Sharpe Ratio = (Rp-Rf)/σp
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.
MaxDD: 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. Formula of Maximum Drawdown: MaxDD = (Trough Value−Peak Value)/Peak Value
AvgDD: The Average Drawdown up to time T is the time average of drawdowns that have occurred up to time T Formula of Average Drawdown: AvgDD = (1/T) multiplied by the integral of a function D(t) with respect to a real variable t on an interval [0, T]
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.
CVaR: Conditional Value-at-Risk 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 VaR cutoff point. Formula of CVaR: CVaR = [1/(1-c)] multiplied by the integral of a function xp(x) with respect to a real variable x on an interval [-1, VaR]