Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
cumul growth of dollar
#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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment