Application of Horizon Plots
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
for background please see prior posts Horizon Plot Already Available and Cubism Horizon Charts in R
Good visualization simplifies, and stories are better told with effective and pretty visualizations.
Although horizon plots are not immediately intuitive, I have embraced them as an extremely effective method of analyzing more than four series. I hope they become much more popular, so I can use them with much more confidence. If we look at a traditional cumulative growth chart on the managers dataset provided by PerformanceAnalytics, I get confused by too many lines and colors since there are 10 different series. While this chart works, it can be better.
 |
| From TimelyPortfolio |
We could panel the data, but I think this makes comparison even more difficult.
 |
| From TimelyPortfolio |
In this case and many others, horizon plots provide what I feel to be both a more attractive and effective visualization. Here is an example using latticeExtra’s horizonplot function with very little adjustment. You can detect both comovement or seasonality and can compare the amplitude simultaneously.
 |
| From TimelyPortfolio |
With a little additional formatting, we can get an ideal visualization-pretty and effective. The ability to scale well beyond 10 series offers power that we cannot obtain with a traditional line chart.
 |
| From TimelyPortfolio |
As another example, let’s look at how we can use horizon plots to monitor a moving average system similar to the Mebane Faber’s timing model. If you follow the link, you can see a decent visualization of the price and moving average. A horizon plot could accomplish this much more efficiently.
 |
| From TimelyPortfolio |
I personally like the mirrored horizon plot even better. Let’s incorporate that.
 |
| From TimelyPortfolio |
Please help me popularize these extremely powerful charts.
R code from GIST (do raw for copy/paste):
| require(lattice) | |
| require(latticeExtra) | |
| require(directlabels) | |
| require(reshape2) | |
| require(quantmod) | |
| require(PerformanceAnalytics) | |
| data(managers) | |
| managers[which(is.na(managers),arr.ind=TRUE)[,1], | |
| unique(which(is.na(managers),arr.ind=TRUE)[,2])] = 0 | |
| testprice <- cumprod(1+managers)-1 | |
| testdf <- as.data.frame(cbind(index(testprice),coredata(testprice)),stringsAsFactors=FALSE) | |
| testmelt <- melt(testdf,id.vars=1) | |
| colnames(testmelt) <- c("date","series","growth") | |
| testmelt[,"date"] <- as.Date(testmelt[,"date"]) | |
| #just plain old xyplot from xts package examples | |
| direct.label( | |
| xyplot(testprice, | |
| lwd=2, | |
| screens=1, | |
| col = c(brewer.pal(n=8,"Dark2")[1:6],brewer.pal(n=9,"PuBu")[5:9]), | |
| panel = function(x, y, ...) { | |
| panel.xyplot(x, y, ...) | |
| }, | |
| scales = list(tck = c(1,0), y = list(draw = TRUE,relation = "same", alternating = FALSE)), | |
| xlab = NULL, | |
| main="Performance Since 1996 or Inception"), | |
| list(last.bumpup,hjust=0.75, cex=0.8)) | |
| #get panel in row 1 and column 1, since only one panel because screens = 1 | |
| trellis.focus("panel", 1, 1, highlight = FALSE) | |
| panel.refline(h = pretty(coredata(testprice)), col = "gray70", lty = 3) | |
| #does not even qualify but here as another example | |
| xyplot(testprice, | |
| scales = list(tck = c(1,0), y = list(draw = TRUE,relation = "same", alternating = FALSE)), | |
| panel = function(x, y, ...) { | |
| panel.grid(col = "grey", lty = 3) | |
| panel.xyplot(x, y, ...) | |
| }, | |
| layout= c(1,NCOL(testprice))) | |
| xyplot(testprice, | |
| col = c(brewer.pal(n=8,"Dark2")[1:6],brewer.pal(n=9,"PuBu")[5:9]), | |
| screens = colnames(testprice), | |
| lwd = 3, | |
| strip = FALSE, strip.left = TRUE, | |
| scales = list(x = list(tck = c(1,0), alternating = FALSE), | |
| y = list(tck = c(0,1), draw = TRUE, relation = "same", alternating = 2)), | |
| panel = function(x, y, ...) { | |
| panel.refline(h = pretty(coredata(testprice)), col = "gray70", lty = 3) | |
| panel.xyplot(x, y, ...) | |
| }, | |
| main = "Performance Since 1996 or Inception") | |
| #first horizonplot with little adjustment | |
| horizonplot(testprice, horizonscale = 1, | |
| #turn off ticks on top and do not draw y ticks or axis | |
| scales = list(tck = c(1,0), y = list(draw = FALSE,relation = "same")), | |
| #draw strip on top | |
| strip=TRUE, | |
| #do not draw strip to left since we have strip = TRUE above | |
| strip.left=FALSE, | |
| #do standard horizon but also add horizontal white grid lines | |
| panel = function(x, ...) { | |
| panel.horizonplot(x, ...) | |
| #here we draw white horizontal grid | |
| #h = 3 means 3 lines so will divide into fourths | |
| #v = 0 will not draw any vertical grid lines | |
| panel.grid(h=3, v=0,col = "white", lwd=1,lty = 1) | |
| }, | |
| layout=c(1,ncol(testprice)), | |
| main = "Performance Since 1996 or Inception") | |
| ## amended from horizonplot example given in documentation | |
| horizonplot(testprice, | |
| scales = list(tck = c(1,0), y = list(draw = FALSE,relation = "same")), | |
| origin = 0, | |
| horizonscale = 1, | |
| colorkey = FALSE, | |
| panel = function(x, ...) { | |
| panel.horizonplot(x, ...) | |
| panel.grid(h=3, v=0,col = "white", lwd=1,lty = 3) | |
| }, | |
| ylab = list(rev(colnames(testprice)), rot = 0, cex = 0.8, pos = 3), | |
| xlab = NULL, | |
| par.settings=theEconomist.theme(box = "gray70"), | |
| strip.left = FALSE, | |
| layout = c(1,ncol(testprice)), | |
| main = "Performance Since 1996 or Inception") | |
| #horizon plot version of http://www.mebanefaber.com/timing-model/ | |
| #do horizon of percent above or below 10 month or 200 day moving average | |
| tckrs <- c("VTI","VEU","IEF","VNQ","DBC") | |
| getSymbols(tckrs, from = "2010-12-31") | |
| #do horizon of percent above or below 10 month or 200 day moving average | |
| prices <- get(tckrs[1])[,4] | |
| for (i in 2:length(tckrs)) { | |
| prices <- merge(prices,get(tckrs[i])[,4]) | |
| } | |
| colnames(prices) <- tckrs | |
| n=200 | |
| #get percent above or below | |
| pctdiff <- (prices / apply(prices, MARGIN = 2, FUN = runMean, n = n) - 1)[n:NROW(prices),] | |
| horizonplot(pctdiff, | |
| scales = list(tck = c(1,0), y = list(draw = FALSE,relation = "same")), | |
| origin = 0, | |
| horizonscale = 0.05, | |
| colorkey = FALSE, | |
| panel = function(x, ...) { | |
| panel.horizonplot(x, ...) | |
| panel.grid(h=3, v=0,col = "white", lwd=1,lty = 3) | |
| }, | |
| ylab = list(rev(colnames(prices)), rot = 0, cex = 0.8, pos = 3), | |
| xlab = NULL, | |
| par.settings=theEconomist.theme(box = "gray70"), | |
| strip.left = FALSE, | |
| layout = c(1,ncol(prices)), | |
| main = "Percent Above or Below 200 Days Moving Average") | |
| # for one more example, let's do a mirror horizon plot | |
| horizonplot.offset <- function(x,horizon.type="offset",horizonscale=0.05,title=NA,alpha=0.4){ | |
| #get the positive and negative plots for the offset chart | |
| #very similar to the mirror chart above | |
| #except the negative values will be moved to the top of y range | |
| #and inverted | |
| ppos<- | |
| xyplot(x,ylim=c(0,horizonscale),origin=0, | |
| par.settings=theEconomist.theme(box="transparent"), | |
| lattice.options=theEconomist.opts(), | |
| xlab=NULL,ylab=NULL, | |
| panel = function(x,y,...){ | |
| # | |
| for (i in 0:round(max(y)/horizonscale,0)) | |
| panel.xyarea(x,y=ifelse(y>0,y,NA)-(horizonscale * i),col="green",border="green",col.line="green",alpha=alpha,lwd=2, | |
| scales = list(y=list(draw=FALSE)),...) | |
| }, | |
| main=title) | |
| pneg <- | |
| xyplot(x,ylim=c(0,horizonscale),origin=horizonscale, | |
| panel=function(x, y ,...){ | |
| for (i in 0:round(min(y)/-horizonscale,0)) { | |
| panel.xyarea(x,y=horizonscale+ifelse(y<0,y,NA)+(horizonscale*i),col.line="red",border="red",col="red",lwd=2,alpha=alpha,...) | |
| } | |
| }) | |
| return(ppos+pneg) | |
| } | |
| horizonplot.offset(pctdiff, title = "Percent Difference from 200 Day Moving Average") |
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.