It’s difficult to grasp what is happening to the entire S&P 500 all at once. A friend of mine who was a stellar technical analyst came up with an idea to view the S&P 500 as a packed array of boxes, organized by sector and with each stocks ‘box’ area scaled to market cap. Then each box was colour-coded by return for the month. The net result was something like this:
I recreated that image for the monthly economics report using the following code. The boxChartHelper function takes a data.frame holding the stocks and returns another data.frame with the co-ordinates for each area. The data frame should have a column named “size” which is used to scale the boxes. The plotBoxChart function takes a data.frame of stocks (with columns specifying their ticker, sector, size or market cap, and the colour you want the box) and plots it using base graphics.
I know: (1) Hadley Wickham could do it in 2 lines with ggplot2, and (2) this isn’t a box plot so the naming is terrible. I’m just putting it here for reference because some people wanted to know how I make the chart – hint: not in Excel.
boxChartHelper<-function(data, # data.frame holding data
left, right, bottom, top) {
if(is.na(sum(data$size))) browser()
# calc values
width = right - left
height = top - bottom
aspect = width/height # asp > 1, width bigger than height
# if there is only one row, set and leave
if (nrow(data)==1) {
data$left = left
data$right = right
data$left = left
data$top = top
data$bottom = bottom
return(data)
}
# if two rows, split by width
if (nrow(data)==2) {
if (aspect >= 1) { # split the width
data$top = top
data$bottom = bottom
width.1 = width*(data$size[1]/sum(data$size))
data$left = c(left, left+width.1)
data$right = c(left+width.1, right)
return(data)
} else { # split the height
data$left = left
data$right = right
height.1 = height*(data$size[1]/sum(data$size))
data$bottom = c(bottom, bottom + height.1)
data$top = c(bottom + height.1, top)
return(data)
}
}
# else, cut into two and recurse
data<-data[order(data$size, decreasing=TRUE),]
splitter <- c(TRUE, rep(FALSE, nrow(data)-1))
for(i in 2:nrow(data)) {
if(sum(data$size[splitter])/sum(data$size) > 0.5) break
splitter[i] <- TRUE
}
if (aspect >= 1) { # split the width
width.1 <- width*sum(data$size[splitter])/sum(data$size)
return(rbind(boxChartHelper(data[splitter,], left, left+width.1, bottom, top),
boxChartHelper(data[!splitter,], left+width.1, right, bottom, top)))
} else { # split the height
height.1 <- height*sum(data$size[splitter])/sum(data$size)
return(rbind(boxChartHelper(data[splitter,], left, right, bottom, bottom+height.1),
boxChartHelper(data[!splitter,], left, right, bottom+height.1, top)))
}
}
plotBoxChart<-function(data,
sec.col="Sector",
size.col="MarketCap",
change.col="Change",
colour.col="colour",
title=NULL,
bottom.space=4,
show.box.labels=FALSE) {
# make sure the data is okay
if (any(is.na(data[[sec.col]]))) stop("Error: NA Sectors")
if (any(is.na(data[[size.col]]))) stop("Error: NA Sizes")
if(!is.null(title)) title.space = 2 else title.space=0.25
par(mar=c(bottom.space,0.25,title.space,0.25), cex=1)
aspect=dev.size()[1]/dev.size()[2]
plot.new()
plot.window(xlim=c(0,100)*aspect, ylim=c(0,100), xaxs="i", yaxs="i")
if(!is.null(title)) title(main=title)
bounds <- c(par("usr"))
sec.data<-tapply(data[[size.col]], data[[sec.col]], sum)
sec.data<-as.data.frame(sec.data)
sec.data$sec <- rownames(sec.data)
names(sec.data) <- c("size", "section")
sec.data$change<-0
sec.data$left<-0
sec.data$right<-0
sec.data$top<-0
sec.data$bottom<-0
sec.data<-boxChartHelper(sec.data, bounds[1], bounds[2], bounds[3], bounds[4])
# map and plot individual stocks
for (i in 1:nrow(sec.data)) {
sec.name = sec.data$section[i]
stock.list <- data[data$Sector==sec.name,]
stock.list$left<-0
stock.list$right<-0
stock.list$top<-0
stock.list$bottom<-0
stock.list$size <- stock.list[[size.col]]
stock.list <- boxChartHelper(stock.list, sec.data$left[i],
sec.data$right[i],
sec.data$bottom[i],
sec.data$top[i])
sec.data$change[i] <- sum(stock.list[change.col] * stock.list$size)/
sum(stock.list$size)
# plot the results
for (j in 1:nrow(stock.list)) {
# draw the filled rectangle
rect(xleft=stock.list$left[j],
ybottom=stock.list$bottom[j],
xright=stock.list$right[j],
ytop=stock.list$top[j],
border="grey", lwd=0.25, col=stock.list$colour[j])
# draw the name of the stock
if(show.box.labels==TRUE) {
stock.text <- paste(stock.list$Ticker[j],"\n",format(stock.list[[change.col]][j], digits=2),"%",sep="")
stock.cex <- 0.75
box.width <- (stock.list$right[j] - stock.list$left[j])/2
box.height <- (stock.list$top[j] - stock.list$bottom[j])/2
# remove the ticker symbol if too small
if ((strheight(stock.text, cex=stock.cex) >= box.height * 0.98) ||
(strwidth(stock.text, cex=stock.cex) >= box.width * 0.98)) {
stock.text <- stock.list$Ticker[j]
}
# try one level smaller
if(strheight(stock.text,cex=stock.cex) >= box.height * 0.98) stock.cex <- 0.5
if(strwidth(stock.text,cex=stock.cex) >= box.width * 0.98) stock.cex <- 0.5
# draw if it fits
if ((strheight(stock.text, cex=stock.cex) < box.height * 0.99) &&
(strwidth(stock.text, cex=stock.cex) < box.width * 0.99)) {
text(x=mean(c(stock.list$left[j], stock.list$right[j])),
y=mean(c(stock.list$top[j], stock.list$bottom[j])) - strheight(stock.text, cex=stock.cex)/2,
labels=stock.text,
cex=stock.cex,
pos=3,
offset=0)
}
}
}
}
# plot the sections
for (i in 1:nrow(sec.data)) {
sec.width <- sec.data$right[i] - sec.data$left[i]
rect(xleft=sec.data$left[i],
ybottom=sec.data$bottom[i],
xright=sec.data$right[i],
ytop=sec.data$top[i],
border="black", lwd=3)
if (strwidth(sec.data$section[i], cex=1.5) > sec.width) {
label <- gsub(" ", "\n", sec.data$section[i])
} else {
label <- sec.data$section[i]
}
text(x=(sec.data$left[i]+sec.data$right[i])/2,
y=(sec.data$bottom[i]+sec.data$top[i])/2+strheight(label)/2,
labels=label, pos=1, offset=0, cex=1.5)
}
invisible(sec.data)
}
