Extreme Bond Returns

[This article was first published on Timely Portfolio, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

20 years of data is nowhere near enough to satisfy my insatiable appetite for bigger datasets.  While I showed Record Long Term Treasury Returns with Vanguard’s US Long Treasury mutual fund, its 20 year life is not sufficient to give me comfort risking money.  What happens when we take the Moody’s AAA rate series dating back to 1919?

My opinion changes dramatically when I include 70 more years, and the opportunity is much less certain.

From TimelyPortfolio
From TimelyPortfolio
From TimelyPortfolio

R code from GIST:

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),])

To leave a comment for the author, please follow the link and comment on their blog: Timely Portfolio.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)