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