# Install necessary packages
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)
install.packages('curl', repos = 'http://cran.r-project.org')
## Installing package into 'C:/Users/HP/Documents/R/win-library/4.1'
## (as 'lib' is unspecified)
## package 'curl' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'curl'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying C:
## \Users\HP\Documents\R\win-library\4.1\00LOCK\curl\libs\x64\curl.dll to C:
## \Users\HP\Documents\R\win-library\4.1\curl\libs\x64\curl.dll: Permission denied
## Warning: restored 'curl'
##
## The downloaded binary packages are in
## C:\Users\HP\AppData\Local\Temp\Rtmpisp6jN\downloaded_packages
# Install Systematic Investor Toolbox (SIT) package
# firstly i install SIT.date
devtools::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 installation
library(curl)
## Using libcurl 7.64.1 with Schannel
curl_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 'C:/Users/HP/Documents/R/win-library/4.1'
## (as 'lib' is unspecified)
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("C:/Users/HP/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.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
# Question 1
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)
# Question 2
plotbt.strategy.sidebyside(models$equal.weight, min.var, min.var.positive)
# Question 3
###############################################################################
# a. Sharpe Ratio: 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.
# Formula and Calculation of Sharpe Ratio: Sharpe Ratio = (Rp-Rf)/σp
# where:
# Rp=return of portfolio
# Rf=risk-free rate
# σp=standard deviation of the portfolio’s excess return
###############################################################################
# b. Deviation Risk (DVR): DVR generalizes the concept of standard deviation, which is measures both the upside and downside risk.
###############################################################################
# c. Maximum Drawdown (MaxDD): 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.
# Formula and Calculation of Maximum Drawdown: MaxDD = (Trough Value−Peak Value)/Peak Value
###############################################################################
# d. Average Drawdown (AvgDD): The AvgDD up to time T is the time average of drawdowns that have occurred up to time T
# Formula and Calculation 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]
###############################################################################
# e. Value-at-Risk (VaR): VaR is a way to quantify the risk of potential losses for a firm or an investment. This metric can be computed in several ways, including the historical, variance-covariance, and Monte Carlo methods.
###############################################################################
# f. Conditional Value-at-Risk (CVaR): CVaR 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.
# Formula and Calculation 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]
# where:
# p(x)dx=the probability density of getting a return with value “x”
# c=the cut-off point on the distribution where the analyst sets the VaR breakpoint
# VaR=the agreed-upon VaR level
###############################################################################