More Beautiful Growth of $1 Chart
[This article was first published on Timely Portfolio, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
With all my recent focus on reporting and visualization, you might think that I have the investments all figured out. Unfortunately, that is not the case, and I will resume more standard investment and systems posts soon. I did want to share what I think are two more beautiful Growth of a $1 visualizations. Although my lattice code is far from tight, I think the result is fairly good using and modifying some of the Economist style graphs offered in latticeExtra.
![]() |
From TimelyPortfolio |
With a little modification, the chart.CumReturns from PerformanceAnalytics can also look very similar. I will let you choose your favorite. However, the lattice version will much more likely appear in my reports.
![]() |
From TimelyPortfolio |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#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) |
To leave a comment for the author, please follow the link and comment on their blog: Timely Portfolio.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.