Animated GIF Annual Correlation of 48 Industries for 50 Years

Inspired by http://blogs.reuters.com/felix-salmon/2012/08/06/chart-of-the-day-hft-edition/, I thought I would build on 48 Industries (Dendrogram Ordered) Over 50 Years, “Trend is Not Your Friend” Applied to 48 Industries, and 48 Industries Since 1963 with an animated GIF of annual correlation for the Kenneth French 48 Industry Data set.

From TimelyPortfolio

R code in GIST (do raw for copy/paste):

	#get very helpful Ken French data
	#for this project we will look at Industry Portfolios
	#http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/48_Industry_Portfolios_daily.zip
	require(latticeExtra)
	require(animation)
	require(PerformanceAnalytics)
	require(quantmod)
	#my.url will be the location of the zip file with the data
	my.url="http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/48_Industry_Portfolios_daily.zip"
	#this will be the temp file set up for the zip file
	my.tempfile<-paste(tempdir(),"\\frenchindustry.zip",sep="")
	#my.usefile is the name of the txt file with the data
	my.usefile<-paste(tempdir(),"\\48_Industry_Portfolios_daily.txt",sep="")
	download.file(my.url, my.tempfile, method="auto",
	quiet = FALSE, mode = "wb",cacheOK = TRUE)
	unzip(my.tempfile,exdir=tempdir(),junkpath=TRUE)
	#read space delimited text file extracted from zip
	french_industry <- read.table(file=my.usefile,
	header = TRUE, sep = "",
	as.is = TRUE,
	skip = 9, nrows=12211)
	#get dates ready for xts index
	datestoformat <- rownames(french_industry)
	datestoformat <- paste(substr(datestoformat,1,4),
	substr(datestoformat,5,6),substr(datestoformat,7,8),sep="-")
	#get xts for analysis
	french_industry_xts <- as.xts(french_industry[,1:NCOL(french_industry)],
	order.by=as.Date(datestoformat))
	#divide by 100 to get percent
	french_industry_xts <- french_industry_xts/100
	#delete missing data which is denoted by -0.9999
	french_industry_xts[which(french_industry_xts < -0.99,arr.ind=TRUE)[,1],
	unique(which(french_industry_xts < -0.99,arr.ind=TRUE)[,2])] <- 0
	#get a vector of the end of years
	evaldates <- endpoints(french_industry_xts,"years")
	saveGIF(
	for(i in 2:length(evaldates)) {
	#do correlation table
	ca <- cor(french_industry_xts[evaldates[i-1]:evaldates[i],])
	#replace na with 0
	ca[which(is.na(ca),arr.ind=TRUE)[,]] <- 0
	#get colors to use for heat map
	brew <- brewer.pal(name="RdBu",n=5)
	#get color ramp
	cc.brew <- colorRampPalette(brew)
	#apply color ramp
	cc <- cc.brew(nrow(ca))
	#do heatmap and sort by degree of correlation to VFINX (Vanguard S&P 500)
	#heatmap(ca,symm=TRUE,Rowv=NA,Colv=NA,col=cc,RowSideColors=cc,main="")
	#title(main=paste("Correlation Table\n",index(french_industry_xts)[evaldates[i]],sep=""),font.main=1,outer=TRUE,line=-2,cex.main=1.3)
	#do with dendrogram ordering
	heatmap(ca,symm=TRUE,col=cc,RowSideColors=cc,main="")
	title(main=paste("Correlation Table (Dendrogram Ordered)\n",index(french_industry_xts)[evaldates[i]],sep=""),font.main=1,outer=TRUE,line=-3,cex.main=1.3,adj=0)
	}
	)

view raw french industry animated correlation gif.r hosted with ❤ by GitHub