R+ggplot2 version of the "dumbbell" plot at http://census.gov/content/dam/Census/newsroom/releases/2015/cb15-158_graphic_acs_metro.jpg

ahealth.md

This hit #rstats today:

Has anyone made a dumbbell dot plot in #rstats, or better yet exported to @plotlygraphs using the API? https://t.co/rWUSpH1rRl

— Ken Davis (@ken_mke) October 23, 2015

<script async src="//platform.twitter.com/widgets.js" charset="utf-8"></script>

So, I figured it was worth a cpl mins to reproduce.

While the US gov did give the data behind the chart it was all the data and a pain to work with so I used WebPlotDigitizer to transcribe the points and then some data wrangling in R to clean it up and make it work well with ggplot2.

It is possible to make the top "dumbbell" legend in ggplot2 (but not by using a guide) and color the "All Metro Areas" text but that's an exercise left to the reader (totally doable and not much code, but not the point of the example).

geom_dumbbell.r

library(dplyr)
library(tidyr)
library(scales)
library(ggplot2)
library(ggalt) # devtools::install_github("hrbrmstr/ggalt")

health <- read.csv("zhealth.csv", stringsAsFactors=FALSE, 
                   header=FALSE, col.names=c("pct", "area_id"))

areas <- read.csv("zarea_trans.csv", stringsAsFactors=FALSE, header=TRUE)

health %>% 
  mutate(area_id=trunc(area_id)) %>% 
  arrange(area_id, pct) %>% 
  mutate(year=rep(c("2014", "2013"), 26),
         pct=pct/100) %>% 
  left_join(areas, "area_id") %>% 
  mutate(area_name=factor(area_name, levels=unique(area_name))) -> health

setNames(bind_cols(filter(health, year==2014), filter(health, year==2013))[,c(4,1,5)],
         c("area_name", "pct_2014", "pct_2013")) -> health


gg <- ggplot(health, aes(x=pct_2013, xend=pct_2014, y=area_name, group=area_name))
gg <- gg + geom_dumbbell(color="#a3c4dc", size=0.75, point.colour.l="#0e668b")
gg <- gg + scale_x_continuous(label=percent)
gg <- gg + labs(x=NULL, y=NULL)
gg <- gg + theme_bw()
gg <- gg + theme(plot.background=element_rect(fill="#f7f7f7"))
gg <- gg + theme(panel.background=element_rect(fill="#f7f7f7"))
gg <- gg + theme(panel.grid.minor=element_blank())
gg <- gg + theme(panel.grid.major.y=element_blank())
gg <- gg + theme(panel.grid.major.x=element_line())
gg <- gg + theme(axis.ticks=element_blank())
gg <- gg + theme(legend.position="top")
gg <- gg + theme(panel.border=element_blank())
gg

health.R

library(dplyr)
library(ggplot2)
library(scales)

health <- read.csv("zhealth.csv", stringsAsFactors=FALSE, 
                   header=FALSE, col.names=c("pct", "area_id"))

areas <- read.csv("zarea_trans.csv", stringsAsFactors=FALSE, header=TRUE)

health %>% 
  mutate(area_id=trunc(area_id)) %>% 
  arrange(area_id, pct) %>% 
  mutate(year=rep(c("2014", "2013"), 26),
         pct=pct/100) %>% 
  left_join(areas, "area_id") %>% 
  mutate(area_name=factor(area_name, levels=unique(area_name))) %>% 
  mutate(color=rep(c("#0e668b", "#a3c4dc"), 26),
         line_col="#a3c4dc") -> health

health[health$area_name=="All Metro Areas",]$color <- c("#bc1f31", "#e5b9a5")
health[health$area_name=="All Metro Areas",]$line_col <- "#e5b9a5"

gg <- ggplot(health)
gg <- gg + geom_path(aes(x=pct, y=area_name, group=area_id, color=line_col), size=0.75)
gg <- gg + geom_point(aes(x=pct, y=area_name, color=color), size=2.25)
gg <- gg + scale_color_identity()
gg <- gg + scale_x_continuous(label=percent)
gg <- gg + labs(x=NULL, y=NULL)
gg <- gg + theme_bw()
gg <- gg + theme(plot.background=element_rect(fill="#f7f7f7"))
gg <- gg + theme(panel.background=element_rect(fill="#f7f7f7"))
gg <- gg + theme(panel.grid.minor=element_blank())
gg <- gg + theme(panel.grid.major.y=element_blank())
gg <- gg + theme(panel.grid.major.x=element_line())
gg <- gg + theme(axis.ticks=element_blank())
gg <- gg + theme(legend.position="top")
gg <- gg + theme(panel.border=element_blank())
gg

output.md

zarea_trans.csv

zhealth.csv