Resummission Midterm Exam-Investment Portfolio Analysis
Name: Tran Viet Hung - ID: 110035102
4/20/2022
#Load some required packages
library(SIT)
library(quantmod)
library(quadprog)
library(lpSolve)
library(readxl)
library(xts)
library(openxlsx)#Download data
X10_Industry_Portfolios <- read_excel("Downloads/10_Industry_Portfolios.xlsx", range = "A12:K1160")
str(X10_Industry_Portfolios)## tibble [1,148 × 11] (S3: tbl_df/tbl/data.frame)
## $ Date : 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#turn data into time series
industry.price <- cumprod(X10_Industry_Portfolios+1)*100
industry.price.sample <- industry.price['2000-01/2020-03']
#create required input parameters in using SIT package
data <- new.env()
#create 3 required input elements in data
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"Compute Equal weight portfolio return
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.4Compute MVP portfolio returns by rebalancing EACH month starting from 2000/01 to 2020/03
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 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. Note: you just need to use monthly data to generate the results.
plotbt.strategy.sidebyside(models$equal.weight, min.var, min.var.positive)
Question 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.
a) 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.
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 (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
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 (VaR) is a statistic that quantifies the extent of possible financial losses within a firm, portfolio, or position over a specific time frame. Risk managers use VaR to measure and control the level of risk exposure. One can apply VaR calculations to specific positions or whole portfolios or use them to measure firm-wide risk exposure.
VAR= [Rp- (z) (??)] Vp
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
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.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.