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.