R code for comet charts

README.md

Data is from CDC's wonder dataset

This is code illustrates how to create a "comet chart" in R. See this research paper for more information about comet charts: http://research.google.com/pubs/pub42901.html

cometchart.R

datafile <- 'Desktop/data.csv'
title <- 'Comet Chart for Fetal Death Rate Data'
weightTitle <- 'log of Number of Babies born'
valueTitle <- 'log of Fetal Death Rate (deaths out of 500 births)'
# note that color is based on change in weight/size metric

df <- read.csv(datafile)

valuesToPoints <- function(startweight, endweight, startvalue, endvalue, thisid){
  a <- endweight - startweight
  b <- endvalue - startvalue
  dist <- sqrt(a * a + b * b)
  halfWidth <- dist / 16
  cometDF <- data.frame(
    id = rep(thisid, each = 3),
    values = rep(a, each = 3),
    x = c(startweight, halfWidth / dist * b + endweight, -halfWidth / dist * b + endweight),
    y = c(startvalue, -halfWidth / dist * a + endvalue, halfWidth / dist * a + endvalue)
  )
  return(cometDF)
}

dataToPoints <- function(data, id){
  return(valuesToPoints(log(data$startweight), log(data$endweight), log(data$startvalue), log(data$endvalue), id))
}

dataToPlot <- dataToPoints(df[1,], .1)
for (i in 2:nrow(df)){dataToPlot <- rbind(dataToPlot, dataToPoints(df[i,], i))}
(p <- ggplot(dataToPlot, aes(x=x, y=y)) + geom_polygon(aes(fill=values, group=id)) + ggtitle(title) + xlab(weightTitle) + ylab(valueTitle) + scale_fill_gradient2(high = 'blue', mid='#636363', low='orange', guide = guide_legend(title = "change in size metric")))

cometchartR.png

data.csv