# Load required packages
required_pkgs <- c("PerformanceAnalytics", "quantmod", "pbapply", "data.table")
new_pkgs <- required_pkgs[!(required_pkgs %in% installed.packages()[, "Package"])]
if(length(new_pkgs)) install.packages(new_pkgs)
lapply(required_pkgs, require, character.only = TRUE)
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Loading required package: pbapply
## Loading required package: data.table
##
## Attaching package: 'data.table'
## The following objects are masked from 'package:xts':
##
## first, last
## The following objects are masked from 'package:zoo':
##
## yearmon, yearqtr
## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] TRUE
# 1. Download data
e <- new.env()
tickers <- c("AMZN","BIDU","GLD","GOOGL","GS","IWM","NFLX","MMM","DIA","SPY")
getSymbols(tickers, from = "2003-01-01", env = e)
## [1] "AMZN" "BIDU" "GLD" "GOOGL" "GS" "IWM" "NFLX" "MMM" "DIA"
## [10] "SPY"
PRC <- do.call(merge, eapply(e, Ad)) # Adjusted prices
# 2. Add latest prices if necessary
if (last(index(PRC)) != Sys.Date()) {
last <- pblapply(as.list(gsub(".Adjusted", "", names(PRC))), getQuote)
PRC <- rbind(PRC, xts(coredata(t(rbindlist(last)$Last)), order.by = Sys.Date()))
}
NOM <- colnames(PRC) <- gsub(".Adjusted", "", names(PRC))
# 3. Momentum: 60-day ROC
MOMO60 <- round(ROC(PRC, n = 60, type = "discrete"), 4)
MOMO60 <- MOMO60["2003-03-31::"]
PRC <- PRC["2003-03-31::"]
# Show first few rows
print(head(MOMO60))
## GS GLD IWM GOOGL NFLX AMZN DIA BIDU MMM SPY
## 2003-03-31 -0.0209 NA -0.0736 NA 0.7773 0.3301 -0.0691 NA 0.0313 -0.0658
## 2003-04-01 -0.0091 NA -0.0560 NA 0.7523 0.2446 -0.0598 NA 0.0416 -0.0543
## 2003-04-02 -0.0066 NA -0.0483 NA 0.7874 0.2744 -0.0513 NA 0.0564 -0.0482
## 2003-04-03 -0.0032 NA -0.0428 NA 0.8232 0.2367 -0.0562 NA 0.0589 -0.0504
## 2003-04-04 0.0178 NA -0.0360 NA 0.7134 0.2474 -0.0332 NA 0.0715 -0.0308
## 2003-04-07 -0.0175 NA -0.0493 NA 0.6993 0.2503 -0.0505 NA 0.0436 -0.0475
# 4. Monthly selection points
indx <- seq(as.Date("2003-03-31"), length.out = 300, by = "4 weeks")
indx2 <- ifelse(!(indx %in% index(MOMO60)), paste(indx + 1), paste(indx))
SELECT <- MOMO60[paste(indx2)]
PRC2 <- PRC[paste(indx2)]
# Show dimensions or sample data
print(dim(SELECT))
## [1] 287 10
print(head(SELECT))
## GS GLD IWM GOOGL NFLX AMZN DIA BIDU MMM
## 2003-03-31 -0.0209 NA -0.0736 NA 0.7773 0.3301 -0.0691 NA 0.0313
## 2003-04-28 0.1369 NA 0.0765 NA 0.7546 0.3341 0.0753 NA 0.0287
## 2003-05-27 0.1318 NA 0.1881 NA 0.3261 0.5834 0.1125 NA 0.0112
## 2003-06-23 0.2102 NA 0.1944 NA -0.0106 0.2812 0.1142 NA -0.0106
## 2003-07-21 0.1097 NA 0.1691 NA 0.0686 0.4064 0.0855 NA 0.0903
## 2003-08-18 0.1644 NA 0.1634 NA 0.1000 0.3036 0.1017 NA 0.1568
## SPY
## 2003-03-31 -0.0658
## 2003-04-28 0.0916
## 2003-05-27 0.1282
## 2003-06-23 0.1334
## 2003-07-21 0.0796
## 2003-08-18 0.0777
# 5. Generate all 4-asset combinations
ASSETS4 <- combn(NOM, 4)
# Show number of combinations
print(dim(ASSETS4)) # Should be 4 x 210
## [1] 4 210
# 6. Define Momentum Strategy
MOMO <- function(x) {
y <- ASSETS4[, x]
S <- SELECT[, y]
SEQ <- as.numeric(apply(S, 1, which.max))
prc2 <- round(PRC2[, y], 2)
RETS <- CalculateReturns(prc2, method = "discrete")
ALL <- do.call(merge, lapply(as.list(1:ncol(RETS)), function(x) {
Lag(reclass(ifelse(SEQ == x, 1, 0), match.to = S) * RETS[, x])
}))
colnames(ALL) <- names(prc2)
ALL[is.na(ALL)] <- 0
EQT <- reclass(rowSums(ALL), match.to = ALL)
EQT[is.na(EQT)] <- 0
colnames(EQT) <- paste(names(prc2), collapse = "-")
EQT
}
# Run the function on the first combination and show output
example_result <- MOMO(1)
print(head(example_result))
## GS-GLD-IWM-GOOGL
## 2003-03-31 0.00000000
## 2003-04-28 0.00000000
## 2003-05-27 0.12551020
## 2003-06-23 0.08577263
## 2003-07-21 0.08661835
## 2003-08-18 0.04296161
# 7. Run strategy on all combinations
STRAT <- pblapply(as.list(1:ncol(ASSETS4)), function(x) MOMO(x))
AAA <- pblapply(STRAT, colSums)
# 8. Select top 10 combinations
df <- STRAT[order(sapply(AAA, "[[", 1))]
df <- df[(length(df) - 9):length(df)]
TOP10 <- do.call(merge, df)
print(head(TOP10)) # Show first few rows
## GOOGL.NFLX.DIA.BIDU GS.GOOGL.NFLX.BIDU GOOGL.NFLX.BIDU.MMM
## 2003-03-31 0.000000000 0.000000000 0.00000000
## 2003-04-28 0.000000000 0.000000000 0.00000000
## 2003-05-27 0.089655172 0.089655172 0.08965517
## 2003-06-23 0.025316456 0.025316456 0.02531646
## 2003-07-21 0.037249815 0.086618349 -0.04938272
## 2003-08-18 0.004109344 0.004880429 0.05263158
## GS.NFLX.AMZN.BIDU IWM.NFLX.AMZN.BIDU NFLX.AMZN.BIDU.MMM
## 2003-03-31 0.000000000 0.000000000 0.000000000
## 2003-04-28 0.000000000 0.000000000 0.000000000
## 2003-05-27 0.089655172 0.089655172 0.089655172
## 2003-06-23 0.191780822 0.191780822 0.191780822
## 2003-07-21 0.022988506 0.022988506 0.022988506
## 2003-08-18 -0.005617978 -0.005617978 -0.005617978
## NFLX.AMZN.BIDU.SPY GOOGL.NFLX.AMZN.BIDU NFLX.AMZN.DIA.BIDU
## 2003-03-31 0.000000000 0.000000000 0.000000000
## 2003-04-28 0.000000000 0.000000000 0.000000000
## 2003-05-27 0.089655172 0.089655172 0.089655172
## 2003-06-23 0.191780822 0.191780822 0.191780822
## 2003-07-21 0.022988506 0.022988506 0.022988506
## 2003-08-18 -0.005617978 -0.005617978 -0.005617978
## GLD.NFLX.AMZN.BIDU
## 2003-03-31 0.000000000
## 2003-04-28 0.000000000
## 2003-05-27 0.089655172
## 2003-06-23 0.191780822
## 2003-07-21 0.022988506
## 2003-08-18 -0.005617978
``` r
# 9. Performance summary of Top 10 momentum portfolios
library(PerformanceAnalytics)
charts.PerformanceSummary(TOP10, cex.legend = 0.6, colorset = rich10equal,
geometric = TRUE, main = "Top 10 Momentum Portfolios")
stats_top10 <- table.Stats(TOP10)
print(stats_top10) # Show the stats table below the plot
## GOOGL.NFLX.DIA.BIDU GS.GOOGL.NFLX.BIDU GOOGL.NFLX.BIDU.MMM
## Observations 287.0000 287.0000 287.0000
## NAs 0.0000 0.0000 0.0000
## Minimum -0.2156 -0.2156 -0.2156
## Quartile 1 0.0000 0.0000 0.0023
## Median 0.0555 0.0648 0.0585
## Arithmetic Mean 0.0807 0.0819 0.0827
## Geometric Mean 0.0737 0.0747 0.0757
## Quartile 3 0.1343 0.1376 0.1347
## Maximum 1.0086 1.0086 1.0086
## SE Mean 0.0076 0.0078 0.0077
## LCL Mean (0.95) 0.0657 0.0666 0.0676
## UCL Mean (0.95) 0.0957 0.0972 0.0978
## Variance 0.0168 0.0173 0.0168
## Stdev 0.1295 0.1314 0.1298
## Skewness 1.9317 1.7816 1.8658
## Kurtosis 8.9886 8.3251 8.7902
## GS.NFLX.AMZN.BIDU IWM.NFLX.AMZN.BIDU NFLX.AMZN.BIDU.MMM
## Observations 287.0000 287.0000 287.0000
## NAs 0.0000 0.0000 0.0000
## Minimum -0.2605 -0.2156 -0.2605
## Quartile 1 0.0000 0.0000 0.0048
## Median 0.0673 0.0648 0.0635
## Arithmetic Mean 0.0832 0.0839 0.0843
## Geometric Mean 0.0751 0.0762 0.0764
## Quartile 3 0.1443 0.1438 0.1433
## Maximum 1.0086 1.0086 1.0086
## SE Mean 0.0081 0.0080 0.0081
## LCL Mean (0.95) 0.0671 0.0681 0.0684
## UCL Mean (0.95) 0.0992 0.0996 0.1002
## Variance 0.0190 0.0184 0.0187
## Stdev 0.1380 0.1358 0.1368
## Skewness 1.5464 1.6751 1.5653
## Kurtosis 6.8450 7.2874 7.1458
## NFLX.AMZN.BIDU.SPY GOOGL.NFLX.AMZN.BIDU NFLX.AMZN.DIA.BIDU
## Observations 287.0000 287.0000 287.0000
## NAs 0.0000 0.0000 0.0000
## Minimum -0.2156 -0.2605 -0.2156
## Quartile 1 0.0014 0.0008 0.0004
## Median 0.0631 0.0659 0.0631
## Arithmetic Mean 0.0845 0.0846 0.0849
## Geometric Mean 0.0769 0.0766 0.0774
## Quartile 3 0.1438 0.1433 0.1438
## Maximum 1.0086 1.0086 1.0086
## SE Mean 0.0079 0.0081 0.0079
## LCL Mean (0.95) 0.0688 0.0686 0.0693
## UCL Mean (0.95) 0.1001 0.1005 0.1005
## Variance 0.0181 0.0188 0.0180
## Stdev 0.1346 0.1371 0.1342
## Skewness 1.7391 1.5609 1.7533
## Kurtosis 7.5639 7.0367 7.6410
## GLD.NFLX.AMZN.BIDU
## Observations 287.0000
## NAs 0.0000
## Minimum -0.1739
## Quartile 1 0.0040
## Median 0.0659
## Arithmetic Mean 0.0860
## Geometric Mean 0.0787
## Quartile 3 0.1402
## Maximum 1.0086
## SE Mean 0.0078
## LCL Mean (0.95) 0.0706
## UCL Mean (0.95) 0.1013
## Variance 0.0174
## Stdev 0.1318
## Skewness 1.8295
## Kurtosis 8.3242
# 10. Risk-return scatter
chart.RiskReturnScatter(TOP10, add.sharpe = c(1), Rf = 0.03 / sqrt(252),
colorset = rich10equal, xlim = c(0.45, 0.55), ylim = c(1.4, 1.75))
## Warning in rug(side = 2, returns, col = element.color): some values will be
## clipped
# 11. Best strategy details
AAA_top10 <- lapply(df, colSums) # re-calculate sums for just top 10
best_index <- which.max(sapply(AAA_top10, "[[", 1))
EQT <- df[[best_index]]
charts.PerformanceSummary(EQT, geometric = TRUE)
table.Stats(EQT)
## GLD-NFLX-AMZN-BIDU
## Observations 287.0000
## NAs 0.0000
## Minimum -0.1739
## Quartile 1 0.0040
## Median 0.0659
## Arithmetic Mean 0.0860
## Geometric Mean 0.0787
## Quartile 3 0.1402
## Maximum 1.0086
## SE Mean 0.0078
## LCL Mean (0.95) 0.0706
## UCL Mean (0.95) 0.1013
## Variance 0.0174
## Stdev 0.1318
## Skewness 1.8295
## Kurtosis 8.3242
table.Drawdowns(EQT)
## From Trough To Depth Length To Trough Recovery
## 1 2008-10-06 2008-12-01 2009-03-23 -0.3173 7 3 4
## 2 2004-08-16 2004-12-06 2005-05-23 -0.2490 11 5 6
## 3 2016-01-19 2016-02-16 2016-06-06 -0.1997 6 2 4
## 4 2021-04-05 2021-05-03 2021-08-23 -0.1963 6 2 4
## 5 2011-10-31 2012-01-23 2012-02-21 -0.1906 5 4 1