public

  • Download Gist
sharpe and ma tactical.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
require(lattice)
require(latticeExtra)
require(reshape2)
require(directlabels)
require(quantmod)
require(PerformanceAnalytics)
 
getSymbols("^GSPC",from="1900-01-01")
 
GSPC.monthly <- GSPC[endpoints(GSPC,"months"),4]
GSPC.roc <- ROC(GSPC.monthly,type="discrete",n=1)
 
#apply.rolling with SharpeRatio as FUN gives error
#so I started playing with variations of Sharpe
sharpe <- (apply.rolling(GSPC.roc+1,FUN=prod,width=12)-1)/(runMax(abs(GSPC.roc),n=3))
 
systems <- merge(GSPC.roc,
lag(ifelse(GSPC.monthly > runMean(GSPC.monthly,n=10),1,0))*GSPC.roc,
lag(ifelse(sharpe > runMean(sharpe,n=10),1,0))*GSPC.roc,
lag(ifelse(sharpe > 0,1,0))*GSPC.roc,
lag(ifelse(sharpe > lag(sharpe,k=6),1,0))*GSPC.roc)
colnames(systems) <- c("SP500","MovAvgPrice","MovAvgSharpe","Sharpe>0","Sharpe>6moPrior")
 
#publicize the fine work at http://tradeblotter.wordpress.com/2012/06/04/download-and-parse-edhec-hedge-fund-indexes/
#all code for next two charts comes from the post
#I deserve no credit
 
# Cumulative returns and drawdowns
par(cex.lab=.8) # should set these parameters once at the top
op <- par(no.readonly = TRUE)
layout(matrix(c(1, 2)), height = c(2, 1.3), width = 1)
par(mar = c(1, 4, 4, 2))
chart.CumReturns(systems, main = "S&P 500 with Tactical Overlays",
xaxis = FALSE, legend.loc = "topleft", ylab = "Cumulative Return",
#use colors from latticeExtra theEconomist theme so colors will be consistent
colorset= theEconomist.theme()$superpose.line$col, ylog=TRUE,
wealth.index=TRUE, cex.legend=.7, cex.axis=.6, cex.lab=.7)
abline(v=which(index(systems)=="1985-12-31"),col="red",lty=2)
text(x=which(index(systems)=="1985-12-31")+2,y=1,labels="Dividing Line in Result",adj=0,srt=90,cex=0.7,col="red")
par(mar = c(5, 4, 0, 2))
chart.Drawdown(systems, main = "", ylab = "Drawdown", colorset = theEconomist.theme()$superpose.line$col, cex.axis=.6, cex.lab=.7)
abline(v=which(index(systems)=="1985-12-31"),col="red",lty=2)
par(op)
 
 
 
 
# Generate charts of with ETL and VaR through time
#caution: this takes about 10 minutes to complete
par(mar=c(3, 4, 0, 2) + 0.1) #c(bottom, left, top, right)
charts.BarVaR(systems, p=(1-1/12), gap=36, main="", show.greenredbars=TRUE,
methods=c("ModifiedES", "ModifiedVaR"), show.endvalue=TRUE,
colorset=rep("Black",7), ylim=c(-.1,.15))
par(op)
 
 
#do a lattice density plot so we can look at the distributions
#of monthly changes for each approach
systems.df <- as.data.frame(cbind(index(systems),coredata(systems)))
systems.melt <- melt(systems.df,id.vars=1)
colnames(systems.melt) <- c("date","system","monthROC")
dp <- densityplot(~monthROC,groups=system,data=systems.melt,
par.settings = theEconomist.theme(box = "transparent"),
lattice.options = theEconomist.opts(),
ylim=c(0,125),
xlab=NULL,
main="Density Plot of Monthly Change in S&P 500 with Tactical Overlays")
direct.label(dp,top.bumptwice)
 
#density plot reveals very different distributions
#so get the skew and kurtosis for each approach
skew.kurtosis <- rbind(skewness(systems),kurtosis(systems))
skew.kurtosis.melt <- melt(cbind(rownames(skew.kurtosis),skew.kurtosis))
colnames(skew.kurtosis.melt) <- c("variable","system","value")
 
barchart(value~variable,group=system,data=skew.kurtosis.melt,
origin=0,
par.settings = theEconomist.theme(box = "transparent"),
lattice.options = theEconomist.opts(),
auto.key=list(space="right"),
ylab=NULL,
main="Skewness and Kurtosis of S&P 500 with Tactical Overlays")

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.