|
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") |