moodys aaa forward and back

moodys aaa forward and back.r

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

getSymbols("AAA",src="FRED") # load Moody's AAA from Fed Fred 

#Fed monthly series of yields is the monthly average of daily yields
#set index to yyyy-mm-dd format rather than to.monthly mmm yyy for better merging later
index(AAA)<-as.Date(index(AAA))
AAApricereturn<-AAA

AAApricereturn[1,1]<-0
colnames(AAApricereturn)<-"PriceReturn-monthly avg AAA"
#use quantlib to price the AAA and BAA bonds from monthly yields
#AAA and BAA series are 20-30 year bonds so will advance date by 25 years
for (i in 1:(NROW(AAA)-1)) {
  AAApricereturn[i+1,1]<-FixedRateBondPriceByYield(yield=AAA[i+1,1]/100,issueDate=Sys.Date(), 
    maturityDate= advance("UnitedStates/GovernmentBond", Sys.Date(), 25, 3),
    rates=AAA[i,1]/100,period=2)[1]/100-1
} 

#total return will be the price return + yield/12 for one month
AAAtotalreturn<-AAApricereturn+lag(AAA,k=1)/12/100
colnames(AAAtotalreturn)<-"TotalReturn-monthly avg AAA" 
AAAtotalreturn[1,1] <- 0

AAAcumul <- as.xts(apply(AAAtotalreturn+1,MARGIN=2,cumprod))

#annual returns (12 months) of AAA
roc.back <- ROC(AAAcumul[,1],n=12,type="discrete")
#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 <- 12
f <- function(x) log(tail(x, 1)) - log(head(x, 1)) 
roc.forward <- as.xts(rollapply(as.vector(AAAcumul[,1]), FUN=f, width=hold+1, align="left", na.pad=T),index(AAAcumul[,1]))

roc.df <- as.data.frame(cbind(as.Date(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 12 month returns
plot(roc.df[,2:3],main="Moody's AAA Total Return
	12 Month 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 12 month 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, "12 month forward
	when back > 20%", col="red",
	cex = 0.9, adj=0)
points(roc.df[which(roc.df[,2]>0.2),2:3],col="red")

#seems like we might need to look by decade
#get green for positive and red for negative
colors <- ifelse(roc.df[which(roc.df[,2]>0.2),3] > 0, "green", "red")
dotplot(roc.df[which(roc.df[,2]>0.2),3]~substr(format(as.Date(roc.df[which(roc.df[,2]>0.2),1]),"%Y"),1,3),
	col=colors,
	main="Moody's AAA Total Return
	12 Month Rate of Change Forward
	by Decade when Back > 20%")


#practice with lattice and grid for another look
titletext <-  "Moody's AAA Total Return
	12 Month 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))
grid.rect(gp=gpar(col="azure3"))
print(latticePlot,newpage=FALSE)
popViewport(2)


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