Midterm
2022-04-17
library(readr)
industry10 <- read_table("/cloud/home/10_Industry_Portfolios.txt")##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## Date = col_double(),
## NoDur = col_double(),
## Durbl = col_double(),
## Manuf = col_double(),
## Enrgy = col_double(),
## HiTec = col_double(),
## Telcm = col_double(),
## Shops = col_double(),
## Hlth = col_double(),
## Utils = col_double(),
## Other = col_double()
## )library(pacman)
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':
##
## closep_load(quantmod, quadprog, lpSolve)
p_load(xts)
p_load(TTR)
a =nrow(industry10)
date <- seq(as.Date('1926-08-01'), length = a, by = '1 month') - 1
industry10 <- xts(industry10[-1]/100, order.by = date)
head(industry10)## 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.0347class(industry10)## [1] "xts" "zoo" #convert into price
industry.price <- cumprod(industry10 + 1)*100
head(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.7169industry.price.sample <- industry.price['1999-12/2020-03']
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$symbolnames : asset names
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"#assign equal weights to 10 assets
data$weight <-ntop(prices, n)
head(data$weight)## NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 1999-12-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 2000-01-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 2000-02-29 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 2000-03-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 2000-04-30 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1
## 2000-05-31 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1#create a list model
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 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# reset sample data range
industry.price.sample <- industry.price['1997-01/2020-03']
data$prices <- industry.price.sample
data$weight <- industry.price.sample
data$execution.price <- industry.price.sample
data$execution.price[] <- NA
prices <- data$prices
#create constraints
constraints = new.constraints(n, lb=-Inf, ub=+Inf)
constraints = add.constraints(rep(1,n), 1, type = '=', constraints)
ret = prices / mlag(prices) -1
#compute MVA weight for each month
weight = coredata(prices)
weight[] = NA
nrow(prices)## [1] 279hist <- na.omit(ret[1:36,])
for( i in 36 : (dim(weight)[1]) ) {
#using 36 historical monthly returns
hist = ret[ (i- 36 +1):i, ]
hist = na.omit(hist)
#create historical input assumptions
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
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.15197372 -0.20732075 -0.16919479 -0.19652168 0.14949635 0.21743951
## Shops Hlth Utils Other
## -0.05734666 0.53390386 0.50403534 0.07353509sum(weight[36,])## [1] 1model$min.var.monthly <- bt.run(data, trade.summary = T)## 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
## 6.1 8.8 -15.6 sum(as.numeric(weight[36,])*as.numeric(ret[37,]))## [1] 0.06560644model$min.var.monthly$ret[37, ]## NoDur
## 2000-01-31 0.00983317plotbt.custom.report.part1(model$min.var.monthly, model$equal.weight)
layout(1:2)
plotbt.transition.map(model$min.var.monthly$weight)
legend('topright', legend = 'min.var.monthly', bty = 'n')
plotbt.transition.map(model$equal.weight$weight)
legend('topright', legend = 'equal weight', bty = 'n')
strategy.performance.snapshoot(model, T)
## NULLmodel <- rev(model)
plotbt.custom.report(model)
The meanings of different risk measure To overcome the limitations of
the variance as risk measure, a number of alternative risk measures have
been proposed, we have other risk measures
Sharpe: Sharpe ratio is the measure of risk-adjusted return of a financial portfolio. A portfolio with a higher Sharpe ratio is considered superior relative to its peers.
DVR: Deviation risk measure is a function to quantify financial risk (and not necessarily downside risk) in a different method than a general risk measure. Deviation risk measures generalize the concept of standard deviation.
MaxDD: Maximum drawdown is a measure of an asset’s largest price drop from a peak to a trough. Maximum drawdown is considered to be an indicator of downside risk, with large MDDs suggesting that down movements could be volatile. While MDD measures the largest loss, it does not account for the frequency of losses, not the size of any gains.
AvgDD: The average drawdown is the time average of drawdowns that have occurred up to time. A drawdown is how much an investment or trading account is down from the peak before it recovers back to the peak. Drawdowns are a measure of downside volatility. A drawdown and loss aren’t necessarily the same thing. Most traders view a drawdown as a peak-to-trough metric, while losses typically refer to the purchase price relative to the current or exit price.
VaR: Value at Risk is a statistical measure used to assess the level of risk associated with a portfolio or company. The VaR measures the maximum potential loss with a degree of confidence for a specified period.
CVaR: Conditional value at risk is derived from the value at risk for a portfolio or investment.The use of CVaR as opposed to just VaR tends to lead to a more conservative approach in terms of risk exposure.(CVaR) attempts to address the shortcomings of the VaR model, which is a statistical technique used to measure the level of financial risk within a firm or an investment portfolio over a specific time frame.CVaR is the expected loss if that worst-case threshold is ever crossed. CVaR, in other words, quantifies the expected losses that occur beyond the VaR breakpoint.