A file to create a triangle heatmap of investment performance

sp500_heatmap.R

#' @title S&P 500 heatmap
#' @author Daniel Egan
#' @description Creates real and nominal triangle heatmaps based on the S&P 500.
#' @details Last update 2012-06-01
### ----

library(quantmod)
library(RColorBrewer)

#Some useful matrix functions
flip.matrix <- function(x) {
  mirror.matrix(rotate180.matrix(x))
}

# Mirror matrix (left-right)
mirror.matrix <- function(x) {
  xx <- as.data.frame(x);
  xx <- rev(xx);
  xx <- as.matrix(xx);
  xx;
}

# Rotate matrix 180 clockworks
rotate180.matrix <- function(x) { 
  xx <- rev(x);
  dim(xx) <- dim(x);
  xx;
}


#Grab historic SP500 price data from yahoo
sp500<-getSymbols("^GSPC",from="1900-01-01",auto.assign=FALSE)
sp500mr<-monthlyReturn(Cl(sp500)) #Monthly returns
months<-length(sp500mr)
retmat<-matrix(NA,nrow=months,ncol=months)
for (i in 1:months) { #i = bought in
  for (j in i:months) { #j=sold in
    nmonths<-j-i
    # note - annualize the return over the holding period
    retmat[i,j]<-((((prod((sp500mr$monthly.returns[i:j]+1)))^(1/nmonths))^12)-1)*100
  }
}
diag(retmat)<- 0
retmat[lower.tri(retmat,diag=FALSE)]<- NA


retmat2<-matrix(NA,ncol=ncol(retmat),nrow=nrow(retmat))
retmat2[1,]<-retmat[1,]
for (i in 2:nrow(retmat2)){
  end<- (ncol(retmat)-i+1)
  retmat2[i,1:end]<-retmat[i,i:ncol(retmat)]
}
retmat[1:10,1:10]
retmat2[1:10,1:10]

names(retmat)<-row.names(as.data.frame(sp500mr))
row.names(retmat)<-row.names(as.data.frame(sp500mr))


#how many different colors, and what color scheme?
breaks<- seq(-50,50,5)
BW_RdGreyGreen<-colorRampPalette(c("red","grey","green"))


#Whattime period?
sp500mr_df<-as.data.frame(sp500mr)
sp500mr_df$date<-row.names(sp500mr_df)

#Set up time indicators
minx<-as.POSIXlt(min(sp500mr_df$date))
manx<-as.POSIXlt(max(sp500mr_df$date))
dlm<-as.numeric((manx-minx)/(365.25*5))


dates<-seq(1950,2010,5)
dl<-length(dates)
ranger<-seq(0,(1-(1/dl)),(1/dl))
ranger2<-seq(0,1,1/dlm)
length(ranger2)


#############################################
#Create graph
png(file="F://R//Heatmap//heatmap_ts.png", w=2000,h=2000,bg="white")
par(mar=c(2,10,15,1),bty="n")
image(t(flip.matrix(retmat)),breaks=breaks,col=BW_RdGreyGreen(length(breaks)-1),axes=FALSE,
      main="Year Sold",cex.main=4)
axis(3,at=ranger2,labels=dates,cex.axis=3)
abline(v=ranger2,lwd=3,col="white")
abline(a=1.016,b=-1,col="black",lwd=3)
text(ranger2,rev(ranger2),labels=dates,cex=4,pos=3)
text(.4,.4,labels="Year bought",cex=4,pos=3)
legtext=paste(">=",breaks,"%")
legtext[1]<-paste("<  ",breaks[2])
legtext<-rev(legtext)
text(0,.62,labels="Annualized Price Return of \nthe S&P500",cex=3,pos=4)
legend(0,0.6,
       legend=legtext, cex=3,
       fill=rev(BW_RdGreyGreen(length(breaks))),
       bty="n")
dev.off()

#Create holding period graph
png(file="F://R//Heatmap//heatmap_holdingperiod.png", w=2000,h=2000,bg="white")
par(mar=c(2,10,15,0),bty="n")
image(t(flip.matrix(retmat2)),breaks=breaks,col=BW_RdGreyGreen(length(breaks)-1),
      axes=FALSE, main="Holding Period (years)",cex.main=4,las=1)
axis(2,at=ranger2,labels=rev(dates),cex.axis=3,las=1)
axis(3,at=ranger2,labels=seq(0,60,5),cex.axis=3,las=1)
abline(v=ranger2,lwd=3,col="white")
abline(v=.02,lwd=3,col="black")
legtext=paste(">=",breaks,"%")
legtext[1]<-paste("<  ",breaks[2])
legtext<-rev(legtext)
text(0.85,0.5,labels="Annualized Price Return of \nthe S&P500",cex=3,pos=3)
legend(.85,.5,
       legend=legtext, cex=3,
       fill=rev(BW_RdGreyGreen(length(breaks))),
       bty="n")
dev.off()


#Time Series graph
retmat_ts<-retmat2[,-1]
png(file="F://R//Heatmap//ts_holdingperiod.png", w=500,h=500,bg="white")
par(mar=c(4.1,4.1,1,1),bty="L")
plot(retmat_ts[1,]~seq(1,ncol(retmat_ts)),type="l",col=1,
     #ylim=c(min(retmat_ts,na.rm=TRUE),max(retmat_ts,na.rm=TRUE)),
     ylim=c(-100,200),
     xlab="Holding period (months)",ylab="Annualized return")
  for (i in 2:nrow(retmat_ts)) {    
    end<-ncol(retmat_ts)-i
    lines(retmat_ts[i,seq(1:end)]~seq(1:end),type="l",col="light grey")
  }
  lines(retmat_ts[1,]~seq(1,ncol(retmat_ts)),type="l",col=1)
#abline(h=median(retmat_ts,na.rm=TRUE),col=2)
abline(h=0,col="black")
text(50,35,labels="Average annual returns from investing in January, 1950",col=1,pos=4)
dev.off()

axis(2,at=ranger2,labels=rev(dates),cex.axis=3,las=1)
axis(3,at=ranger2,labels=seq(0,60,5),cex.axis=3,las=1)