vustx forward and back

vustx forward and back.r

require(quantmod)
require(PerformanceAnalytics)
require(latticeExtra)
require(grid)
require(reshape)

tckr <- "VUSTX"
getSymbols(tckr, 
	from="1900-01-01", to=format(Sys.Date(),"%Y-%m-%d"),
	adjust = TRUE)

roc.back <- ROC(VUSTX[,4], n=200)
#code from http://stackoverflow.com/questions/4472691/calculate-returns-over-period-of-time
#lag never seems to work in reverse so I used this for forward returns
hold <- 200
f <- function(x) log(tail(x, 1)) - log(head(x, 1)) 
roc.forward <- as.xts(rollapply(as.vector(VUSTX[,4]), FUN=f, width=hold+1, align="left", na.pad=T),index(VUSTX))

roc.df <- as.data.frame(cbind(index(roc.back),coredata(roc.back),coredata(roc.forward)),stringsAsFactors=FALSE)
colnames(roc.df) <- c("date","back","forward")

roc.melt <- melt(roc.df,id.vars=1)
#get date as date rather than integer
roc.melt[,1] <- as.Date(roc.melt[,1])
colnames(roc.melt) <- c("date","forwardback","roc")

#get all forward negative returns
roc.meltneg <- cbind(roc.melt[,1:2],ifelse(roc.melt[,3] < 0 & roc.melt[,2]== "forward",1,0) * roc.melt[,3])
#get all forward positive returns
roc.meltpos <- cbind(roc.melt[,1:2],ifelse(roc.melt[,3] > 0 & roc.melt[,2]== "forward",1,0) * roc.melt[,3])
colnames(roc.meltneg) <- c("date","forwardback","roc")
colnames(roc.meltpos) <- c("date","forwardback","roc")

#scatter plot of forward and back 200 day returns
plot(roc.df[,2:3],main="Vanguard US Long Treasury (VUSTX)
	200 Day Rate of Change Forward and Back")
abline(lm(roc.df[,3]~roc.df[,2]),col="blue",lwd=2)
#do linear regression on just those with back 200 day roc > 20%
#abline(lm(roc.df[which(roc.df[,2]>0.2),3]~roc.df[which(roc.df[,2]>0.2),2]),col="red",lwd=3)
abline(h=0,col="grey70")
abline(v=0.2,col="grey70")
text(x=0.23, y=-0.04, "200 day forward
	when back > 20%", col="red",
	cex = 0.9, adj=0)
points(roc.df[which(roc.df[,2]>0.2),2:3],col="red")

#practice with lattice and grid for another look
titletext <-  "Vanguard US Long Treasury (VUSTX)
	200 Day Rate of Change Forward and Back"
latticePlot <- xyplot(roc~date,  data=roc.melt[which(roc.melt[,2]=="back"),], type="l",
	auto.key=list(lwd=3,lty="solid",pch="n",text="back",y = .8, corner = c(0, 0)),
	par.settings = theEconomist.theme(box = "transparent"),
	lattice.options = theEconomist.opts()) +
	
	xyplot(roc~date, groups=forwardback , data=roc.meltneg[which(roc.meltneg[,2]=="forward"),],
	origin=0,
	par.settings = simpleTheme(col = "red", border="red",alpha=0.3) ,
	panel = panel.xyarea)  +
	
	xyplot(roc~date, groups=forwardback , data=roc.meltpos[which(roc.meltneg[,2]=="forward"),],
	origin=0,
	par.settings = simpleTheme(col = "green", border="green",alpha=0.3) ,
	panel = panel.xyarea)

#borrowed heavily from http://www.stat.auckland.ac.nz/~paul/Talks/Rgraphics.pdf
dev.new()
pushViewport(viewport(layout=grid.layout(2,1,
	heights = c(unit(0.10,"npc"),unit(0.95,"npc")))))
pushViewport(viewport(layout.pos.row=1))
grid.rect(gp=gpar(fill="azure3",col="azure3"))
grid.text(titletext, x=unit(1,"cm"),
	y=unit(0.90,"npc") ,
	just=c("left","top"))
popViewport()
pushViewport(viewport(layout.pos.row=2))
print(latticePlot,newpage=FALSE)
popViewport(2)


#chart.Correlation(roc.df[which(roc.df[,2] > 0.2),])