install.packages("PerformanceAnalytics")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)
install.packages("quantmod")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)
install.packages("pbapply")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)
install.packages("data.table")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)
# 1. Load Required Packages
require("PerformanceAnalytics")
## 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
require("quantmod")
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
require("pbapply")
## Loading required package: pbapply
require("data.table")
## 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
# 2. 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))
# 3. Update with Current Day Prices if Needed
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())
)
}
# 4. Clean Column Names
NOM <- colnames(PRC) <- gsub(".Adjusted", "", names(PRC))
# 5. Calculate 60-Day Momentum
MOMO60 <- round(ROC(PRC, n = 60, type = "discrete"), 4)
MOMO60 <- MOMO60["20030331::"]
PRC <- PRC["20030331::"]
# 6. Create Rebalancing Index Every 4 Weeks (300 dates)
indx <- seq(as.Date("2003-03-31"), length.out = 300, by = '4 weeks')
SELECT <- MOMO60[paste(indx)]
indx2 <- ifelse((indx %in% index(SELECT) == FALSE), paste(indx + 1), paste(indx))
SELECT <- MOMO60[paste(indx2)]
PRC2 <- PRC[paste(indx2)]
# 7. Generate All 4-Asset Combinations
ASSETS4 <- combn(NOM, 4)
# 8. Strategy Function
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, "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
}
# 9. Run Strategy on All Portfolios
STRAT <- pblapply(as.list(1:ncol(ASSETS4)), MOMO)
# 10. Get Top 10 Based on Performance
AAA <- pblapply(STRAT, colSums)
df <- STRAT[order(sapply(AAA, "[[", 1))]
df <- df[(length(df) - 9):length(df)]
TOP10 <- do.call(merge, df)
# 11. Plot & Stats
charts.PerformanceSummary(TOP10, cex.legend = 0.45, colorset = rich10equal, geometric = TRUE, main = "TOP 10")
table.Stats(TOP10)
## 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.9316 1.7816 1.8658
## Kurtosis 8.9883 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
chart.RiskReturnScatter(TOP10, add.sharpe = 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
# 12. Best Portfolio
AAA <- lapply(df, colSums)
EQT <- df[[which.max(AAA)]]
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
# 13. Helper Function to Inspect a Portfolio
getMOMO <- function(x) {
y <- as.character(strsplit(x, "-")[[1]])
S <- SELECT[, y]
SEQ <- as.numeric(apply(S, 1, which.max))
prc2 <- round(PRC2[, y], 2)
RETS <- CalculateReturns(prc2, "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) <- "MoMoRet"
cbind(prc2, SEQ, round(EQT, 4))
}
# Example Usage:
# getMOMO("AMZN-GS-IWM-SPY")