construction of horizon plot

construction of horizon plot in r.r

#look at steps in constructing a horizon plot version
#of http://www.mebanefaber.com/timing-model/
#do horizon of percent above or below 10 month / 200 day moving average

require(lattice)
require(latticeExtra)
require(quantmod)


#since we are focused on the horizon plot, let's just look at one stock
tckrs <- "VTI"

getSymbols(tckrs, from = "2006-12-31")
#do horizon of percent above or below 10 month or 200 day moving average
prices <- get(tckrs[1])[,6]
#remove comments below if you would like to look at more than one symbol
#for (i in 2:length(tckrs)) {
#  prices <- merge(prices,get(tckrs[i])[,4])
#}
colnames(prices) <- tckrs

#set n to desired moving average width; we'll do 200 
n=200

ma <- runMean(prices, n = n)
colnames(ma) <- paste(tckrs, ".MovAvg", sep = "")
xyplot(merge(prices,ma),
       col = c("black", "red"),
       lty = c(1,3),
       screens = 1,
       scales =  list(tck = c(1,0)),
       xlab = NULL,
       main = "VTI and 200-day Moving Average")

#but for timing system more interested in whether above or below
#get percent above or below
#we'll leave code to expand beyond one symbol
pctdiff <- (prices / apply(prices, MARGIN = 2, FUN = runMean, n = n) - 1)[n:NROW(prices),]

xyplot(pctdiff,
       col.line = "steelblue4", 
       scales =  list(tck = c(1,0)),       
       xlab = NULL)

xyplot(pctdiff,
       border = NA,
       col.line = "steelblue4", 
       scales =  list(tck = c(1,0)),       
       xlab = NULL,
       panel = function (...) {
         panel.xyarea(origin=0, ...)
         #draw horizontal lines at 10% to show where we will place bands
         panel.abline(h = seq(-0.4, 0.4, 0.10), col = "white", lwd = 2)
         #add black 0 axis back
         panel.abline(h = 0, col = "black")
       })

#takes a lot of height to represent so let's mirror the negative
#so we can cut height by 1/2
xyplot(pctdiff,
       #remove border around chart and axis lines
       par.settings = list(axis.line = list(col = NA),
                           strip.border = list(col = NA),
                           strip.background = list(col = NA)),
       border = NA,
       scales =  list(tck = c(1,0), #remove tick lines on top
                      y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
       xlab = NULL,
       #limit to max of absolute value since we will mirror the negative
       ylim = c(0,ceiling(max(abs(coredata(pctdiff)))*10)/10),
       panel = function (x, y, ...) {
         #do the positive values in blue
         panel.xyarea(x, ifelse(y > 0, y ,0), col.line = "steelblue4", origin=0, ...)
         #do the positive values in blue
         panel.xyarea(x, ifelse(y < 0, abs(y) ,0), col.line = "indianred3", origin=0, ...)
         #draw horizontal lines at 10% to show where we will place bands
         panel.abline(h = seq(-0.4, 0.4, 0.10), col = "white", lwd = 2)
         #add black 0 axis back
         panel.abline(h = 0, col = "black")
       })

#do same chart as above but draw box around bands
xyplot(pctdiff,
       #remove border around chart and axis lines
       par.settings = list(axis.line = list(col = NA),
                           strip.border = list(col = NA),
                           strip.background = list(col = NA)),
       border = NA,
       scales =  list(tck = c(1,0), #remove tick lines on top
                      y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
       xlab = NULL,
       #limit to max of absolute value since we will mirror the negative
       ylim = c(0,ceiling(max(abs(coredata(pctdiff)))*10)/10),
       panel = function (x, y, ...) {
         #do the positive values in blue
         panel.xyarea(x, ifelse(y > 0, y ,0), col.line = "steelblue4", origin=0, ...)
         #do the positive values in blue
         panel.xyarea(x, ifelse(y < 0, abs(y) ,0), col.line = "indianred3", origin=0, ...)
         #draw horizontal lines at 10% to show where we will place bands
         panel.abline(h = seq(-0.4, 0.4, 0.10), col = "white", lwd = 2)
         #add black 0 axis back
         panel.abline(h = 0, col = "black")
         panel.xblocks(x,abs(y)>0,height=0.128,col="white",border="black",alpha=0.3)
         panel.text(x=x[1],y=0.11,labels="band1", pos=4)
         panel.xblocks(x,abs(y)>0,height=0.228,col="white",border="black",alpha=0.25)
         panel.text(x=x[1],y=0.21,labels="band2", pos=4)
         panel.xblocks(x,abs(y)>0,height=0.328,col="white",border="black",alpha=0.2)
         panel.text(x=x[1],y=0.31,labels="band3", pos=4)
         panel.xblocks(x,abs(y)>0,height=0.428,col="white",border="black",alpha=0.15)
         panel.text(x=x[1],y=0.41,labels="band4", pos=4)
       })


#get 4 reds and 4 blues (one for each band)
reds <- brewer.pal("Reds", n=8)[4:8]
blues <- brewer.pal("Blues", n=8)[4:8]

#so let's start banding to use even less height
#for band1 so we will only show graph from 0 to 0.1
band1 <- xyplot(pctdiff,
       #remove border around chart and axis lines
       par.settings = list(axis.line = list(col = NA),
                           strip.border = list(col = NA),
                           strip.background = list(col = NA)),
       lattice.options = list(axis.padding = list(numeric = 0)),
       border = NA,
       scales =  list(tck = c(1,0), #remove tick lines on top
                      x = list(col.line="black"),
                      y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
       xlab = NULL,
       #limit y to band height; in this case 10%
       ylim = c(0,0.1),
       panel = function (x, y, ...) {
         #do the positive values in blue
         panel.xyarea(x, ifelse(y > 0, y ,0), col.line = blues[4], origin=0, alpha = 0.3, ...)
         #do the positive values in blue
         panel.xyarea(x, ifelse(y < 0, abs(y) ,0), col.line = reds[4], origin=0, alpha = 0.3, ...)
         #add black 0 axis back
         panel.abline(h = 0, col = "black")
       })
print(band1)

#we are missing all the values > 0.10
#we will draw band2 0.1 to 0.2 with a darker color

band2 <- xyplot(pctdiff,
       #remove border around chart and axis lines
       par.settings = list(axis.line = list(col = NA),
                           strip.border = list(col = NA),
                           strip.background = list(col = NA)),
       lattice.options = list(axis.padding = list(numeric = 0)),
       border = NA,
       scales =  list(tck = c(1,0), #remove tick lines on top
                      x = list(draw = FALSE),
                      y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
       xlab = NULL,
       #limit y to band height; in this case 10%
       ylim = c(0, 0.1),
       panel = function (x, y, ...) {
         #do the positive values in blue
         panel.xyarea(x, ifelse(y > 0.1, y - 0.1, 0), col.line = blues[4], origin=0, alpha = 0.5, ...)
         #do the positive values in blue
         panel.xyarea(x, ifelse(y < -0.1, abs(y) - 0.1, 0), col.line = reds[4], origin=0, alpha = 0.5, ...)
       })
print(band2)

#now we are missing all the values > 0.10 + 0.10
#we will draw band3 0.2 to 0.3 with a darker color

band3 <- xyplot(pctdiff,
                #remove border around chart and axis lines
                par.settings = list(axis.line = list(col = NA),
                                    strip.border = list(col = NA),
                                    strip.background = list(col = NA)),
                lattice.options = list(axis.padding = list(numeric = 0)),
                border = NA,
                scales =  list(tck = c(1,0), #remove tick lines on top
                               x = list(draw = FALSE),
                               y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
                xlab = NULL,
                #limit y to band height; in this case 10%
                ylim = c(0, 0.1),
                panel = function (x, y, ...) {
                  #do the positive values in blue
                  panel.xyarea(x, ifelse(y > 0.2, y - 0.2, 0), col.line = blues[4], origin=0, alpha = 0.7, ...)
                  #do the positive values in blue
                  panel.xyarea(x, ifelse(y < -0.2, abs(y) - 0.2, 0), col.line = reds[4], origin=0, alpha = 0.7, ...)
                })
print(band3)

#going to four bands is not recommended but for this example we will
band4 <- xyplot(pctdiff,
                #remove border around chart and axis lines
                par.settings = list(axis.line = list(col = NA),
                                    strip.border = list(col = NA),
                                    strip.background = list(col = NA)),
                lattice.options = list(axis.padding = list(numeric = 0)),
                border = NA,
                scales =  list(tck = c(1,0), #remove tick lines on top
                               x = list(draw = FALSE),
                               y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
                xlab = NULL,
                #limit y to band height; in this case 10%
                ylim = c(0, 0.1),
                panel = function (x, y, ...) {
                  #do the positive values in blue
                  panel.xyarea(x, ifelse(y > 0.3, y - 0.3, 0), col.line = blues[4], origin=0, alpha = 1, ...)
                  #do the positive values in blue
                  panel.xyarea(x, ifelse(y < -0.3, abs(y) - 0.3, 0), col.line = reds[4], origin=0, alpha = 1, ...)
                })
print(band4)

#combine all four bands/layers to one horizonplot
print(band1+band2+band3+band4)

#of course using the horizonplot function from latticeExtra
#makes this much easier
horizonplot(pctdiff,
            strip.left=FALSE,
            strip=FALSE,
            #remove border around chart and axis lines
            par.settings = list(axis.line = list(col = NA),
                                strip.border = list(col = NA),
                                strip.background = list(col = NA)),
            lattice.options = list(axis.padding = list(numeric = 0)),
            border = NA,
            scales =  list(tck = c(1,0), #remove tick lines on top
                           x = list(col.line="black"),
                           y = list(col.line="black", rot=0)),    #make ticks black and not rotated   
            xlab = NULL
)