cumul growth of dollar

cumul growth of dollar.r

#trying to get a better growth of a $1 chart
#using lattice or PerformanceAnalytics
require(quantmod)
require(reshape)
require(lattice)
require(latticeExtra)

#get Vanguard US Total Bond Fund vbmfx
getSymbols("VBMFX",from="1990-01-01",to=Sys.Date(),adjust=TRUE)
#get Vanguard SP500 Fund vfinx
getSymbols("VFINX",from="1990-01-01",to=Sys.Date(),adjust=TRUE)

perf <- na.omit(merge(monthlyReturn(VBMFX[,4]),monthlyReturn(VFINX[,4])))
colnames(perf) <- c("VBMFX","VFINX")

perf.cumul <- rbind(c(index(perf)[1]-30,1,1),as.data.frame(cbind(index(perf),apply(1+perf[,1:2],MARGIN=2,FUN=cumprod))))
perf.cumul[,1] <- as.Date(perf.cumul[,1])
perf.cumul.melt <- melt(perf.cumul,id.vars=1)
colnames(perf.cumul.melt) <- c("date","index","growth1")

mycolors <- c("indianred4","deepskyblue3","deepskyblue4")

#add alpha to colors
addalpha <- function(cols,alpha=180) {
  rgbcomp <- col2rgb(cols)
  rgbcomp[4] <- alpha
  return(rgb(rgbcomp[1],rgbcomp[2],rgbcomp[3],rgbcomp[4],maxColorValue=255))
}
mycolors.alpha <- apply(as.matrix(mycolors),MARGIN=1,FUN=addalpha,alpha=220)

ylimits<-c(pretty(c(min(perf.cumul.melt$growth1),
                    max(perf.cumul.melt$growth1))),as.numeric(round(last(perf.cumul[order(last(perf.cumul)[2:3])+1]),2)))
ylabels<-c(ylimits[1:(length(ylimits)-2)],colnames(perf.cumul)[order(last(perf.cumul)[2:3])+1])

#p1<-
  xyplot(growth1~date,groups=index,data=perf.cumul.melt,
       type="l",lwd=4, col=mycolors.alpha,
       #function to customize the axes
       #would like a bottom axis for the dates
       #then a left axis for numeric labels
       #no top axis
       #and a right axis that labels the end points with the instrument/asset
       axis=function (side = c("top", "bottom", "left", "right"), scales, 
                      components, ..., labels = c("default", "yes", "no"), ticks = c("default", 
                      "yes", "no"), line.col){
         side <- match.arg(side)
         labels <- match.arg(labels)
         ticks <- match.arg(ticks)
         axis.text <- trellis.par.get("axis.text")                         
         #for debugging
         #print(side)
         #for debugging
         #print(components)
         if(side == "top") return() #no top axis
         if(side %in% c("bottom","right")){
           if (side == "right") { #want just the last 2 components of the y
             components[["right"]]<-components[["left"]]
             n<-length(components[["right"]]$ticks$at)
             components[["right"]]$ticks$at <- components[["right"]]$ticks$at[(n-1):n]
             components[["right"]]$labels$at <- components[["right"]]$labels$at[(n-1):n]
             components[["right"]]$labels$labels <- components[["right"]]$labels$labels[(n-1):n]
             #for some reason need to draw the horizontal grid lines in the r side section
             comp.list <- components[["left"]]
             #draw a horizontal grid line at each of the y numeric labels
             panel.refline(h = comp.list$ticks$at[1:(n-2)])
             #draw a solid horizontal line for the x axis
             lims <- current.panel.limits()
             panel.abline(h = lims$y[1], col = axis.text$col)
           }
           #draw the axis ticks and labels for bottom and right
           axis.default(side, scales = scales, components = components, 
                        ..., labels = labels, ticks = ticks, line.col = axis.text$col)
         }
           #due to the use of y(left) components to specify right
          #will need a separate function to draw the left y with just numeric labels
           if(side =="left"){
            #numeric labels in this instance are all y except for the last 2
            comp.list<-components
            n<-length(comp.list[["left"]]$ticks$at)
            comp.list[["left"]]$ticks$at <- comp.list[["left"]]$ticks$at[1:(n-2)]
            comp.list[["left"]]$labels$at <- comp.list[["left"]]$labels$at[1:(n-2)]
            comp.list[["left"]]$labels$labels <- comp.list[["left"]]$labels$labels[1:(n-2)]
            axis.default(side, scales = scales, components = comp.list, 
              ..., labels = labels, ticks = ticks, line.col = axis.text$col)
             }           
       },
       par.settings=theEconomist.theme(box="transparent"),
       #specify y to be both numbers and the text labels so y axis width is automated
       #this is helpful to make sure the right axis has room to label the end points
       scales=list(y=list(alternating=3,at=ylimits,labels=ylabels)),
       xlab=NULL,
       ylab=NULL,
       main=paste("Cumulative Growth Since ",format(index(perf)[1],"%B %Y"),sep=""))

require(PerformanceAnalytics)
par(oma=c(0,2,0,0))
par(mar=c(4,2,4,6))
chart.CumReturns(perf,colorset=mycolors.alpha,lwd=4,
                main=NA,xlab=NA,ylab=NA,wealth.index=TRUE,xaxis=FALSE)
#add left justified title
title(main=paste("Cumulative Growth Since ",format(index(perf)[1],"%B %Y"),sep=""),
        adj=0,outer=TRUE,line=-2,font.main=1)
#add bottom x axis with dates formatted as years
axis(side=1,
     at=c(1,which(format(index(perf),"%Y-%m")%in%format(pretty(index(perf)),"%Y-%m"))),
     labels=c(format(index(perf)[1],"%Y"),format(pretty(index(perf)),"%Y")),tick=FALSE,cex.axis=0.9)
#add labels for endpoints on right axis
axis(side=4,
     at=Return.cumulative(perf)+1,
     labels=colnames(perf),tick=FALSE,cex.axis=0.85,line=-1.5,las=1)
#add points for endpoints
points(x=rep(NROW(perf),2),y=as.numeric(Return.cumulative(perf)+1),
        pch=19,cex=1.2,col=mycolors.alpha)