require(pacman)
## Loading required package: pacman
require(xts)
## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
require(openxlsx)
## Loading required package: openxlsx
require(quantmod)
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
require(devtools)
## Loading required package: devtools
## Loading required package: usethis
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
require(curl)
## Loading required package: curl
## Using libcurl 7.68.0 with OpenSSL/1.1.1f
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 '/cloud/lib/x86_64-pc-linux-gnu-library/4.1'
## (as 'lib' is unspecified)
require(SIT)
## Loading required package: SIT
## Loading required package: SIT.date
## 
## Attaching package: 'SIT'
## The following object is masked from 'package:TTR':
## 
##     DVI
## The following object is masked from 'package:base':
## 
##     close
require(ggplot2)
## Loading required package: ggplot2
## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'ggplot2'
p_load(quantmod, quadprog,lpSolve)
p_load(xts)
p_load(TTR)
require(readxl) 
## Loading required package: readxl
Table <- read_excel("10_Industry_Portfolios.xlsx")
str(Table) 
## tibble [1,148 × 11] (S3: tbl_df/tbl/data.frame)
##  $ Date : num [1:1148] 192607 192608 192609 192610 192611 ...
##  $ NoDur: num [1:1148] 1.31 3.7 0.43 -1.47 4.92 0.04 -0.9 3.01 1.86 3.2 ...
##  $ Durbl: num [1:1148] 15.07 3.09 4.48 -8.47 -2.37 ...
##  $ Manuf: num [1:1148] 4.39 2.46 0.56 -3.92 3.71 2.72 -0.37 5.48 0.79 0.49 ...
##  $ Enrgy: num [1:1148] -1.3 3.13 -3.86 -0.9 -0.62 2.21 1.08 0.98 -6.52 -5.39 ...
##  $ HiTec: num [1:1148] 2.84 2.37 -1.17 -4.64 4.46 -0.83 -1.2 4.2 0.64 5.4 ...
##  $ Telcm: num [1:1148] 0.83 2.17 0.89 -0.11 1.63 0.51 1.88 3.97 4.16 -2.13 ...
##  $ Shops: num [1:1148] -0.13 -0.95 0.02 -2.54 5.9 0.43 -2.79 3.11 -0.58 3.82 ...
##  $ Hlth : num [1:1148] 1.11 3.59 0.52 -1.2 4.78 -0.68 4.43 1.08 0.81 2.16 ...
##  $ Utils: num [1:1148] 6.89 -2.07 1.65 -2.88 3.31 -0.67 -1.99 4.13 -0.06 1.46 ...
##  $ Other: num [1:1148] 1.84 3.97 -0.15 -3.11 1.66 2.59 1.17 4.67 0.71 0.68 ...
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"
Table <- xts(coredata(Table[, -1]/100), order.by = date)
head(Table)
##              NoDur   Durbl   Manuf   Enrgy   HiTec   Telcm   Shops    Hlth
## 1926-07-31  0.0131  0.1507  0.0439 -0.0130  0.0284  0.0083 -0.0013  0.0111
## 1926-08-31  0.0370  0.0309  0.0246  0.0313  0.0237  0.0217 -0.0095  0.0359
## 1926-09-30  0.0043  0.0448  0.0056 -0.0386 -0.0117  0.0089  0.0002  0.0052
## 1926-10-31 -0.0147 -0.0847 -0.0392 -0.0090 -0.0464 -0.0011 -0.0254 -0.0120
## 1926-11-30  0.0492 -0.0237  0.0371 -0.0062  0.0446  0.0163  0.0590  0.0478
## 1926-12-31  0.0004  0.0956  0.0272  0.0221 -0.0083  0.0051  0.0043 -0.0068
##              Utils   Other
## 1926-07-31  0.0689  0.0184
## 1926-08-31 -0.0207  0.0397
## 1926-09-30  0.0165 -0.0015
## 1926-10-31 -0.0288 -0.0311
## 1926-11-30  0.0331  0.0166
## 1926-12-31 -0.0067  0.0259
industry.price <- cumprod(Table+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)
head(data$weight)
##            NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 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
## 2000-06-30   0.1   0.1   0.1   0.1   0.1   0.1   0.1  0.1   0.1   0.1
models <- list()
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   
##  4.2 12  -17.6   
bt.detail.summary(equal.weight)
## $System
## $System$Period
## [1] "Jan2000 - Mar2020"
## 
## $System$Cagr
## [1] 4.23
## 
## $System$Sharpe
## [1] 0.36
## 
## $System$DVR
##       [,1]
## NoDur  0.3
## 
## $System$Volatility
## [1] 14.47
## 
## $System$MaxDD
## [1] -49.8
## 
## $System$AvgDD
## [1] -7.37
## 
## $System$VaR
##    5% 
## -7.33 
## 
## $System$CVaR
## [1] -9.96
## 
## $System$Exposure
## [1] 99.59
## 
## 
## $Trade
## $Trade$Win.Percent
## [1] 90
## 
## $Trade$Avg.Trade
## [1] 12.5
## 
## $Trade$Avg.Win
## [1] 14.1
## 
## $Trade$Avg.Loss
## [1] -1.6
## 
## $Trade$Best.Trade
## [1] 29.64
## 
## $Trade$Worst.Trade
## [1] -1.56
## 
## $Trade$WinLoss.Ratio
## [1] 9.04
## 
## $Trade$Avg.Len
## [1] 242
## 
## $Trade$Num.Trades
## [1] 10
## 
## 
## $Period
## $Period$Win.Percent.Day
## [1] 62.1
## 
## $Period$Best.Day
## [1] 12
## 
## $Period$Worst.Day
## [1] -17.6
## 
## $Period$Win.Percent.Month
## [1] 62.1
## 
## $Period$Best.Month
## [1] 12
## 
## $Period$Worst.Month
## [1] -17.6
## 
## $Period$Win.Percent.Year
## [1] 66.7
## 
## $Period$Best.Year
## [1] 31
## 
## $Period$Worst.Year
## [1] -36.8
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)
# Create Constraints
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,] 10361.406 7289.473 10635.79  9659.032 75890.75 6402.054 16511.95 51813.59
## [2,]  9707.601 6681.531 10200.79  9065.968 89672.51 6176.061 15886.15 50238.45
## [3,] 10423.052 7383.092 10947.48 10158.417 93196.64 6636.796 17991.07 50354.00
## [4,] 10228.141 8047.570 11099.65  9960.328 83224.60 6105.188 17183.27 52967.38
## [5,] 10952.293 6961.148 10898.75 10867.714 74186.41 5465.975 16698.70 54969.54
## [6,] 11177.910 6295.662 10753.80 10283.031 83852.90 5690.627 16302.94 61296.54
##         Utils    Other
## [1,] 814.7126 3860.051
## [2,] 751.3280 3580.197
## [3,] 791.3738 4078.561
## [4,] 848.8275 3946.416
## [5,] 878.0272 4074.279
## [6,] 832.7210 3950.421
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.0631 -0.0834 -0.0409 -0.0614  0.1816 -0.0353 -0.0379 -0.0304
## 2000-03-31  0.0737  0.1050  0.0732  0.1205  0.0393  0.0746  0.1325  0.0023
## 2000-04-30 -0.0187  0.0900  0.0139 -0.0195 -0.1070 -0.0801 -0.0449  0.0519
## 2000-05-31  0.0708 -0.1350 -0.0181  0.0911 -0.1086 -0.1047 -0.0282  0.0378
## 2000-06-30  0.0206 -0.0956 -0.0133 -0.0538  0.1303  0.0411 -0.0237  0.1151
##              Utils   Other
## 2000-01-31      NA      NA
## 2000-02-29 -0.0778 -0.0725
## 2000-03-31  0.0533  0.1392
## 2000-04-30  0.0726 -0.0324
## 2000-05-31  0.0344  0.0324
## 2000-06-30 -0.0516 -0.0304
hist <- ret[1:36, ]
hist <- na.omit(hist)
ia <- create.historical.ia(hist, 12)
weight = min.risk.portfolio(ia, constraints)     
hist <- ret[2:37, ]
hist <- na.omit(hist)
ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[3:38, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[4:39, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[5:40, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[6:41, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[7:42, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[8:43, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)
weight = min.risk.portfolio(ia, constraints)
hist <- ret[9:44, ]
hist <- na.omit(hist)
#Minimum Variance
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  24.3  -9.6 54.29 51.16 61.39 -3.33 22.22 -40.18 -12.79 -47.46
## 
## Performance summary :
##  CAGR    Best    Worst   
##  3.1 28.3    -32.9   
plotbt.custom.report.part1(equal.weight,min.var)

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,] 10361.406 7289.473 10635.79  9659.032 75890.75 6402.054 16511.95 51813.59
## [2,]  9707.601 6681.531 10200.79  9065.968 89672.51 6176.061 15886.15 50238.45
## [3,] 10423.052 7383.092 10947.48 10158.417 93196.64 6636.796 17991.07 50354.00
## [4,] 10228.141 8047.570 11099.65  9960.328 83224.60 6105.188 17183.27 52967.38
## [5,] 10952.293 6961.148 10898.75 10867.714 74186.41 5465.975 16698.70 54969.54
## [6,] 11177.910 6295.662 10753.80 10283.031 83852.90 5690.627 16302.94 61296.54
##         Utils    Other
## [1,] 814.7126 3860.051
## [2,] 751.3280 3580.197
## [3,] 791.3738 4078.561
## [4,] 848.8275 3946.416
## [5,] 878.0272 4074.279
## [6,] 832.7210 3950.421
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.0631 -0.0834 -0.0409 -0.0614  0.1816 -0.0353 -0.0379 -0.0304
## 2000-03-31  0.0737  0.1050  0.0732  0.1205  0.0393  0.0746  0.1325  0.0023
## 2000-04-30 -0.0187  0.0900  0.0139 -0.0195 -0.1070 -0.0801 -0.0449  0.0519
## 2000-05-31  0.0708 -0.1350 -0.0181  0.0911 -0.1086 -0.1047 -0.0282  0.0378
## 2000-06-30  0.0206 -0.0956 -0.0133 -0.0538  0.1303  0.0411 -0.0237  0.1151
##              Utils   Other
## 2000-01-31      NA      NA
## 2000-02-29 -0.0778 -0.0725
## 2000-03-31  0.0533  0.1392
## 2000-04-30  0.0726 -0.0324
## 2000-05-31  0.0344  0.0324
## 2000-06-30 -0.0516 -0.0304
hist <- ret[1:36, ]
hist <- na.omit(hist)
ia <- create.historical.ia(hist, 12)
weight = min.risk.portfolio(ia, constraints)     
hist <- ret[2:37, ]
hist <- na.omit(hist)
ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[3:38, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[4:39, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[5:40, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[6:41, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[7:42, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)

weight = min.risk.portfolio(ia, constraints)
hist <- ret[8:43, ]
hist <- na.omit(hist)

ia <- create.historical.ia(hist, 12)
weight = min.risk.portfolio(ia, constraints)
hist <- ret[9:44, ]
hist <- na.omit(hist)
data$weight[] = weight   
capital = 100000
data$weight[] = (capital / prices) * data$weight
min.var.pos = bt.run(data, type='share', capital=capital)
## Latest weights :
##            NoDur Durbl Manuf Enrgy HiTec Telcm Shops Hlth Utils Other
## 2020-03-31  2.64     0 35.33 44.67 17.36     0     0    0     0     0
## 
## Performance summary :
##  CAGR    Best    Worst   
##  3.6 15.7    -24.4   
plotbt.custom.report.part1(equal.weight, min.var, min.var.pos)

plotbt.strategy.sidebyside(equal.weight, min.var, min.var.pos)

#Sharpe : The Sharpe ratio adjusts a portfolio’s past performance—or expected future performance—for the excess risk that was taken by the investor.

#DVR : DVR is the R-squared metric, which considers both returns per unit of risk and the linear fit of the price trajectory. It is the product of the Sharpe ratio and the coefficient of determination.

#MaxDD : The maximum observed loss from a peak to a trough of a portfolio, before a new peak is attained.

#AvgDD : The time average of drawdowns that have occurred up to time.

#VaR : A statistic that quantifies the extent of possible financial losses within a firm, portfolio, or position over a specific time frame.

#CVaR : The extended risk measure of value-at-risk that quantifies the average loss over a specified time period.