require("PerformanceAnalytics");require("quantmod");require("pbapply"); require("data.table")
## 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
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))
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))
MOMO60 <- round(ROC(PRC,n=60,type="discrete"),4)
MOMO60 <- MOMO60["20030331::"]
PRC <- PRC["20030331::"]
indx <- seq(as.Date("2003-03-31"), length.out = 300, by='4 weeks')
SELECT <- MOMO60[paste(indx)];dim(SELECT)
## [1] 261 10
indx2 <- ifelse((indx %in% index(SELECT) == FALSE), paste(indx+1),paste(indx))
SELECT <- MOMO60[paste(indx2)];dim(SELECT)
## [1] 287 10
PRC2 <- PRC[paste(indx2)];dim(SELECT)
## [1] 287 10
ASSETS4 <- combn(NOM,4)
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
}
STRAT <- pblapply(as.list(1:ncol(ASSETS4)), function(x) MOMO(x))
AAA <- pblapply(STRAT,colSums)
df <- STRAT[order(sapply(AAA,"[[",1))]
df <- df[(length(df)-9):length(df)]
TOP10 <- do.call(merge,df)
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.9881 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.6408
## 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 = 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
AAA <- lapply(df,colSums)
AAA[[which.max(AAA)]]
## GLD-NFLX-AMZN-BIDU
## 24.66992
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
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))
}