|
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),]) |
I love the graphically representation of correlation. However, it would be nice to see how it would backtest. I have a website that allows for writing backtesters in R, and a couple other languages.
ReplyDeletecheers,
Joshua
Quantonomics.com