chart.* functions with plot.xts

plotxts version of chartTimeSeries.r

#work on porting chart.TimeSeries to plot.xts
#believe all these initial issues have been resolved
#issues:  no log scale y axis option so will have to handle
#         no legend functionality yet
#         shading of blocks not reaching bottom (sent to M Weylandt)
#         main does not automatically choose first column like chart.TimeSeries


require(PerformanceAnalytics)

#replicate example provided in chart.TimeSeries with plot.xts

# These are start and end dates, formatted as xts ranges.
 ## http://www.nber.org-cycles.html
 cycles.begin.dates<-c("1857-06",
                 "1860-10",
                 "1865-04",
                 "1869-06",
                 "1873-10",
                 "1882-03",
                 "1887-03",
                 "1890-07",
                 "1893-01",
                 "1895-12",
                 "1899-06",
                 "1902-09",
                 "1907-05",
                 "1910-01",
                 "1913-01",
                 "1918-08",
                 "1920-01",
                 "1923-05",
                 "1926-10",
                 "1929-08",
                 "1937-05",
                 "1945-02",
                 "1948-11",
                 "1953-07",
                 "1957-08",
                 "1960-04",
                 "1969-12",
                 "1973-11",
                 "1980-01",
                 "1981-07",
                 "1990-07",
                 "2001-03",
                 "2007-12"
                 )

cycles.end.dates<-c("1858-12",
                "1861-06",
                "1867-12",
                "1870-12",
                "1879-03",
                "1885-05",
                "1888-04",
                "1891-05",
                "1894-06",
                "1897-06",
                "1900-12",
                "1904-08",
                "1908-06",
                "1912-01",
                "1914-12",
                "1919-03",
                "1921-07",
                "1924-07",
                "1927-11",
                "1933-03",
                "1938-06",
                "1945-10",
                "1949-10",
                "1954-05",
                "1958-04",
                "1961-02",
                "1970-11",
                "1975-03",
                "1980-07",
                "1982-11",
                "1991-03",
                "2001-11",
                "2009-06"
                )
 # Event lists - FOR BEST RESULTS, KEEP THESE DATES IN ORDER
 risk.dates = c(
     "1987-10-19",
     "1994-02-01",
     "1997-07-01",
     "1998-08-17",
     "1998-09-23",
     "2000-07-01",
     "2011-09-11")
 risk.labels = c(
     "Black Monday",
     "Bond Crash",
     "Asian Crisis",
     "Russian Crisis",
     "LTCM",
     "Tech Bubble",
     "Sept 11")
 data(edhec)
 
 R=edhec[,1:3,drop=FALSE]
 Return.cumulative = cumprod(1+R) - 1
 Risk.drawdown = Drawdowns(R)
 plot.xts(Return.cumulative)  #using all the defaults
 plot.xts(Return.cumulative, screens=1, #screens=1 probably most appropriate for this application
          blocks = list(
            start.time=paste(cycles.begin.dates,"-01",sep=""),
            end.time=paste(cycles.end.dates,"-01",sep=""),
            col = "lightblue"),
          events = list(
            time = risk.dates,
            label = risk.labels,
            col = "red"), 
          lwd = 2,
          legend.loc = "bottomright", auto.legend=TRUE,
          main="EDHEC Style Indexes")
  plot.xts(Return.cumulative,
         screens=c(1,2,2), #plot 1st series in 1st panel and 2nd and 3rd series in 2nd panel
         layout.screens=c(1,2,2),  #just as an example change the layout so 1st panel is 1/3 of area and 2nd is bottom 2/3
         blocks = list(  #set up blocks for recessions
           start.time=paste(cycles.begin.dates,"-01",sep=""),
           end.time=paste(cycles.end.dates,"-01",sep=""),
           col = "lightblue"),
         events = list(  #add some event lines
           time = risk.dates,
           label = risk.labels,
           col = "purple"),  #don't know why you would use purple but in case you do
         lwd = 2,
         legend.loc = "bottomright", auto.legend=TRUE,
         main="EDHEC Style Indexes")

#for a little more advanced application we can start to do charts.PerformanceSummary style plot.xts 
first.panel  <- function(...) {
  mtext("Cumulative Return", side=1, adj=1, line=-3)
  default.panel(...)
  abline(h=pretty(c(par()$yaxp[1],par()$yaxp[2]),n=par()$yaxp[3]),col="gray60",lty=3)
  abline(h=0, col="black")
}

second.panel <-  function(...) {  
  mtext("Drawdown", side=1, adj=1, line=-2) 
  default.panel(...)
  #abline(h=0, col="black")
  abline(h=par()$usr[3], col="black")
  abline(h=pretty(c(par()$yaxp[1],par()$yaxp[2]),n=par()$yaxp[3]),col="gray60",lty=3)
}
require(RColorBrewer)

plot.xts(merge(Return.cumulative,Risk.drawdown),
         lwd = c(2,1,1), #do this to show how arguments are recycled
         col = brewer.pal(n=9,"PuBu")[c(8,4,6)],
         auto.grid = FALSE, #usually auto.grid works just fine but turn off for example purposes
         las = 1,yax.loc = "right",  # yax.loc could also be flip or left in this case
         screens = c(1,1,1,2,2,2),
         layout.screens = c(1,1,2),
         bty = "n",
         panel = c(first.panel,second.panel), #c(first.panel,"auto"), #panel cycles through by panel rather than each series
         ylab = NA, major.format = "%b %Y", minor.ticks = FALSE,
         legend.loc = c("topleft",NA), auto.legend = TRUE,
         legend.pars = list(bty = "n", horiz=TRUE),  #make legend box transparent
         cex.axis = 0.9, 
         main = NA)

title(main = "Performance Summary of EDHEC Indexes", adj = 0, outer = TRUE, line = -1.5)