bonds and buffett sharpe

bonds and buffett sharpe.r

require(quantmod)
require(PerformanceAnalytics)
require(xtsExtra)
require(RColorBrewer)

#unfortunately don't feel like fighting IP lawyers so I cannot share this index data
portfolio <- read.csv("C:\\Users\\Kent.TLEAVELL_NT\\Documents\\old\\R\\lbustruu with tbill.csv",stringsAsFactors=FALSE)
portfolio <- portfolio[2:NROW(portfolio),2:NCOL(portfolio)]
portfolio <- portfolio[,c(1,3,5)]

#since export has duplicate colnames we need to remove the .1 added
#colnames(portfolio) <- substr(colnames(portfolio),1,nchar(colnames(portfolio))-2)

len <- nchar(portfolio[,1])
xtsdate <- paste(substr(portfolio[,1],len-3,len),"-",
                 ifelse(len==9,"0",""),substr(portfolio[,1],1,len-8),"-01",sep="")
portfolio.xts <- xts(data.matrix(portfolio[,2:NCOL(portfolio)]),order.by=as.Date(xtsdate))
portfolio.xts <- portfolio.xts/100
portfolio.xts[1,]<-0

charts.RollingPerformance(portfolio.xts[,1],    #Barclays Aggregate
                          width = 60,             #rolling 5 year (60 months)
                          Rf = portfolio.xts[,2], #Barclays 3-month
                          main = "Barclays Aggregate Performance (Rolling 5 Year)")

getSymbols("SP500", src = "FRED")
getSymbols("GS10", src = "FRED")

require(RQuantLib)
GS10pricereturn<-GS10 
GS10pricereturn[1,1]<-0
colnames(GS10pricereturn)<-"US10yPrice"

for (i in 1:(NROW(GS10)-1)) {
  GS10pricereturn[i+1,1]<-FixedRateBondPriceByYield(yield=GS10[i+1,1]/100,issueDate=Sys.Date(), 
                                                    maturityDate= advance("UnitedStates/GovernmentBond", Sys.Date(), 10, 3),
                                                    rates=GS10[i,1]/100,period=2)[1]/100-1
} 
#total return will be the price return + yield/12 for one month
GS10totalreturn<-GS10pricereturn+lag(GS10,k=1)/12/100
colnames(GS10totalreturn)<-"US10yTotalReturn" 

#thanks to PerformanceAnalytics package for this handy rolling correlation calculation
rollcorr <- rollapplyr(na.omit(merge(ROC(SP500,n=1,type="discrete"),
                         GS10totalreturn)),
            width = 60,   #5 year rolling
            FUN = function(x) cor(x[, 1, drop = FALSE],
                                 x[, 2, drop = FALSE]),
            by = 1, 
            by.column = FALSE,
            na.pad = TRUE)

rollcorr[is.na(rollcorr)] <- 0  #change leading NAs to 0

custom.panel <- function (index, x, col, lwd, ...) {
  default.panel(index, ifelse(x > 0, x, 0), col = brewer.pal("Greens", n = 9)[7], lwd = 2, ...)
  default.panel(index, ifelse(x < 0, x, 0), col = brewer.pal("Reds",n = 9)[7], lwd = 2, ...)
  abline(h=pretty(c(par("yaxp")[1],par("yaxp")[2]),n=par("yaxp")[3]),col="gray60",lwd=0.5)
  abline (h = 0, col = "black", lwd = 2)
}

plot.xts(rollcorr,
         auto.grid = FALSE,   #turn off grid for more precise control
         bty = "n",            #turn off box because I like better
         las = 1,
         ylim = c(-1,1),
         main = NA,
         panel = custom.panel,    #use our customized panel
         type = "l",
         major.format = "%Y",
         minor.tick = FALSE,
         yaxs = "i",
         cex.axis = 0.8,
         lwd = 2,
         blocks = list(start.time = "2000-03-01", end.time = "2012-12-31"))

title(main = "Correlation of US 10y Bonds with S&P 500 (Rolling 5 Year)", outer = TRUE, line = -2, adj = 0.05)
mtext("Source: Federal Reserve Bank of St. Louis (FRED)", side = 1, cex = 0.7, font = 3, adj = 0.9, outer = TRUE, line = -2)

horizon.panel <- function(index,x,...) {
  #get some decent colors from RColorBrewer
  #we will use colors on the edges so 2:4 for red and 7:9 for blue
  require(RColorBrewer)
  col.brew <- brewer.pal(name="RdBu",n=10)
  #ease this reference later
  n=NROW(x)
  
  #clean up NA with either of the two methods below
  #x[which(is.na(x),arr.ind=TRUE)[,1],
  #          unique(which(is.na(x),ar.ind=TRUE)[,2])] <- 0
  x <- apply(x,MARGIN=2,FUN=na.fill,fill=0)
  #get number of bands for the loop
  #limit to 3
  nbands = 3
  #first tried this but will not work since each series needs to have same number of bands
  #min(4,ceiling(max(abs(coredata(x)))/horizonscale))
  par(usr=c(index[1],index[n],origin,horizonscale))
  for (i in 1:nbands) {
    #draw positive
    polygon(  
      c(index[1], index, index[n]),  
      c(origin, coredata(x) - (i-1) * horizonscale,origin),  
      col=col.brew[length(col.brew)-nbands+i-1],
      border=NA
    )
    #draw negative
    polygon(  
      c(index[1], index, index[n]),  
      c(origin, -coredata(x) - (i-1) * horizonscale,origin),  
      col=col.brew[nbands-i+1],
      border=NA
    )
  }
  
  #delete trash drawn below origin that we keep so no overlap between positive and negative
  polygon(  
    c(index[1], index, index[n]),  
    c(origin, -ifelse(coredata(x)==origin,horizonscale*5,abs(coredata(x))),origin),
    col=par("bg"),
    border=NA
  )
  
  #draw a line at the origin
  abline(h=origin,col="black")
}

horizonscale = 0.25
origin = 0

plot.xts(rollcorr,
         auto.grid = FALSE,   #turn off grid for more precise control
         bty = "n",            #turn off box because I like better
         las = 1,
         ylim = c(origin,horizonscale),
         main = NA,
         panel = horizon.panel,    #use our customized panel
         type = "l",
         major.format = "%Y",
         minor.tick = FALSE,
         yax.loc = "none",
         yaxt = "n", xaxt = "n",
         cex.axis = 0.6,
         lwd = 2)

title(main = "Correlation of US 10y Bonds with S&P 500 (Rolling 5 Year)", outer = TRUE, line = -2, adj = 0.05, cex = 0.7)
mtext("Source: Federal Reserve Bank of St. Louis (FRED)", side = 1, cex = 0.7, font = 3, adj = 0.9, outer = TRUE, line = -2)