Skip to content

Instantly share code, notes, and snippets.

@timelyportfolio
Created January 6, 2012 22:48
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save timelyportfolio/1572814 to your computer and use it in GitHub Desktop.
moodys aaa forward and back
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),])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment