Created
August 30, 2012 14:20
-
-
Save timelyportfolio/3529477 to your computer and use it in GitHub Desktop.
plot.xts scattered smothered covered chunked and diced
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#integrate 2 Google Summer of Code 2012 Projects | |
#plot.xts and PerformanceAnalytics both received very nice additions | |
#wish I knew the exact link but believe this section came from stackoverflow | |
#this allows you to work with the code straight from r-forge SVN | |
## If you want to source() a bunch of files, something like | |
## the following may be useful: | |
#path="C:\\Program Files\\R\\R-2.15.1\\sandbox\\svnsource\\returnanalytics\\pkg\\PerformanceAnalytics\\r" | |
#sourceDir <- function(path, trace = TRUE, ...) { | |
# for (nm in list.files(path, pattern = "\\.[RrSsQq]$")) { | |
# if(trace) cat(nm,":") | |
# source(file.path(path, nm), ...) | |
# if(trace) cat("\n") | |
# } | |
#} | |
#sourceDir(path) | |
require(RColorBrewer) | |
require(quantmod) | |
require(xtsExtra) | |
getSymbols("^GSPC",from="1890-01-01") | |
sp500.monthly <- GSPC[endpoints(GSPC, "months"),4] | |
roc <- ROC(sp500.monthly, type = "discrete", n = 1) | |
n = 10 #set n for number of periods; this is 10 for 10 months | |
roc.ma <- lag(ifelse(sp500.monthly > runMean(sp500.monthly, n = n), 1, 0), k = 1) * roc | |
returns <- merge(roc, roc.ma) | |
returns <- as.xts(apply(returns, MARGIN = 2, na.fill, fill = 0), order.by = index(returns)) | |
colnames(returns) <- c("SP500.buyhold", "SP500.ma") | |
charts.PerformanceSummary(returns, ylog = TRUE) | |
sr <- SharpeRatio.annualized(returns) | |
ir <- InformationRatio(returns, returns[,1]) | |
applyacross <- function(x,rollFun=Omega,width=12,by=1,Rb,...) { | |
if(missing(Rb)) { #add this so we can also use for InformationRatio | |
result <- apply.rolling(x,FUN=rollFun,width,by,...) | |
} else { | |
result <- apply.rolling(x,FUN=rollFun,width,by,Rb=Rb,...) | |
} | |
result <- merge(x,result)[,2] #merge to pad with NA and then get second column | |
colnames(result) <- colnames(x) | |
return(result) | |
} | |
stat = "SharpeRatio.annualized" #ES, KellyRatio, Omega, skewness, kurtosis, VaR, SharpeRatio, CalmarRatio | |
width = 36 | |
sharpe.rolling <- as.xts(matrix(unlist(lapply(returns,FUN=applyacross,rollFun=get(stat),width=width)),byrow=FALSE,nrow=NROW(returns)), order.by = index(returns)) | |
sharpe.rolling <- as.xts(apply(sharpe.rolling,MARGIN=2,FUN=na.fill,fill=0),order.by=index(sharpe.rolling)) | |
colnames(sharpe.rolling) <- colnames(returns) | |
plot.xts(sharpe.rolling,screens=1) | |
plot.xts(sharpe.rolling[,2] - sharpe.rolling[,1],screens=1) | |
plot(x=coredata(sharpe.rolling[,1]),y=coredata(sharpe.rolling[,2]),pch=19, | |
col=ifelse(sharpe.rolling[,2]>0,"green","red")) | |
abline(lm(SP500.ma ~ SP500.buyhold, data=as.data.frame(sharpe.rolling))) | |
text(x=coredata(sharpe.rolling[,1]),y=coredata(sharpe.rolling[,2]),labels=format(as.Date(index(sharpe.rolling)),"%Y"),cex=0.5, pos = 2 ) | |
plot(lm(SP500.ma ~ SP500.buyhold, data=as.data.frame(sharpe.rolling)),which=2) | |
stat = "InformationRatio" | |
#this allows multiple columns if we have more than one index or comparison | |
ir.rolling <- as.xts(matrix(unlist(lapply(returns,FUN=applyacross,rollFun=get(stat),width=width,Rb=returns[,1])),byrow=FALSE,nrow=NROW(returns)), order.by = index(returns)) | |
colnames(ir.rolling) <- colnames(returns) | |
#could also do this if we only have one column | |
#ir.rolling <- apply.rolling(returns[,2],FUN=InformationRatio,width=width,by=1,Rb=returns[,1]) | |
plot.xts(na.omit(merge(ir.rolling[,2],ROC(sp500.monthly,type="discrete",n=36))),screens=1) | |
plot(x=coredata(ROC(sp500.monthly,type="discrete",n=36)),y=coredata(ir.rolling[,2]), | |
pch=19, | |
col=ifelse(ir.rolling[,2]>0,"green","red"), | |
las=1) | |
abline(h=0) | |
abline(v=0) | |
plot(x = coredata(sharpe.rolling[,1]),y=coredata(ir.rolling[,2]), | |
pch = 19, | |
col = ifelse(ir.rolling[,2]>0,"green","red"), | |
las = 1) | |
abline(h=0) | |
abline(lm(coredata(ir.rolling[,2])~coredata(sharpe.rolling[,1]))) | |
plot(lm(coredata(ir.rolling[,2])~coredata(sharpe.rolling[,1])))#,which=2) | |
#use the new ProspectRatio function in PerfomranceAnalytics | |
stat = "ProspectRatio" #ES, KellyRatio, Omega, skewness, kurtosis, VaR, SharpeRatio, CalmarRatio | |
width = 36 | |
pr.rolling <- as.xts(matrix(unlist(lapply(returns,FUN=applyacross,rollFun=get(stat),width=width,MAR=0.025)),byrow=FALSE,nrow=NROW(returns)), order.by = index(returns)) | |
pr.rolling <- as.xts(apply(pr.rolling,MARGIN=2,FUN=na.fill,fill=0),order.by=index(pr.rolling)) | |
colnames(pr.rolling) <- colnames(returns) | |
#set up horizon plot functionality | |
horizon.panel <- function(index,x,...) { | |
#get some decent colors from RColorBrewer | |
#we will use colors on the edges so 2:4 for red and 7:9 for blue | |
require(RColorBrewer) | |
col.brew <- brewer.pal(name="RdBu",n=10) | |
#ease this reference later | |
n=NROW(x) | |
#clean up NA with either of the two methods below | |
#x[which(is.na(x),arr.ind=TRUE)[,1], | |
# unique(which(is.na(x),ar.ind=TRUE)[,2])] <- 0 | |
x <- apply(x,MARGIN=2,FUN=na.fill,fill=0) | |
#get number of bands for the loop | |
#limit to 3 | |
nbands = 3 | |
#first tried this but will not work since each series needs to have same number of bands | |
#min(4,ceiling(max(abs(coredata(x)))/horizonscale)) | |
par(usr=c(index[1],par("usr")[2],origin,horizonscale)) | |
for (i in 1:nbands) { | |
#draw positive | |
polygon( | |
c(index[1], index, index[n]), | |
c(origin, coredata(x) - (i-1) * horizonscale,origin), | |
col=col.brew[length(col.brew)-nbands+i-1], | |
border=NA | |
) | |
#draw negative | |
polygon( | |
c(index[1], index, index[n]), | |
c(origin, -coredata(x) - (i-1) * horizonscale,origin), | |
col=col.brew[nbands-i+1], | |
border=NA | |
) | |
} | |
#delete trash drawn below origin that we keep so no overlap between positive and negative | |
polygon( | |
c(index[1], index, index[n]), | |
c(origin, -ifelse(coredata(x)==origin,horizonscale*5,abs(coredata(x))),origin), | |
col=par("bg"), | |
border=NA | |
) | |
#draw a line at the origin | |
abline(h=origin,col="black") | |
#draw line at top of plot or otherwise polygons will cover boxes | |
abline(h=par("usr")[4],col="black") | |
#mtext("ProspectRatio Difference", side = 3, adj = 0.02, line = -1.5, cex = 0.75) | |
} | |
horizonscale = 0.25 | |
origin = 0 | |
#trying this to color sections or color lines based on sharpe | |
rle.sharpe <- rle(as.vector(sharpe.rolling[,2]>sharpe.rolling[,1])) | |
dates <- index(returns)[cumsum(rle.sharpe$lengths)] | |
start.i=ifelse(na.omit(rle.sharpe$values)[1],2,1) | |
#png("plotxts with everything and ProspectRatio.png",height=600, width=640) | |
plot.xts(merge(log(cumprod(1+returns)),Drawdowns(returns),pr.rolling[,2] - pr.rolling[,1]), | |
screens = c(1,1,2,2,3), #since 2 columns for cumul and drawdown repeat screens | |
layout.screens = c(1,1,1,1,2,2,3), #make screen 1 4/7 of total 2 2/7 and 3 (horizon) 1/7 | |
col = brewer.pal(9,"Blues")[c(5,8)], #get two blues that will look ok | |
lwd = c(1.5,2), #line width; will do smaller 1.5 for benchmark buy/hold | |
las = 1, #do not rotate y axis labels | |
ylim = matrix(c(0,5,-0.55,0,origin,horizonscale),byrow=TRUE,ncol=2), #plot.xts accepts ylim in matrix form; print matrix to see how it works | |
auto.legend = TRUE, #let plot.xts do the hard work on the legend | |
legend.loc = c("topleft",NA, NA), #just do legend on the first screen | |
legend.pars = list(bty = "n", horiz=TRUE), #make legend box transparent and legend horizontal | |
panel = c(default.panel,default.panel,horizon.panel), #specify panels for each screen | |
main = NA, #will do title later so we have more control | |
#log="y", #log scale does not work with blocks | |
blocks = list(start.time=dates[seq(start.i,NROW(dates),2)], #overlay blocks in which 36-mo sharpe ratio of ma exceeds buy/hold | |
end.time=dates[-1][seq(start.i,NROW(dates),2)],col="gray90")) #darkolivegreen2")) | |
title(main = "Strategy Comparison on S&P 500 - Buy Hold versus Moving Average", adj = 0.05, line = -1.5, outer = TRUE, cex.main = 1.1, font.main = 3) | |
#dev.off() |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment