Get data

We will use the acs packaged to access the U.S. Census Bureau’s American Community Survey (ACS) API and get data. Note for this to work for you you’ll need to get an API key from the U.S. Census Bureau.

The latest data from the ACS is for 2016 (in my talk I’ll use more recent data from other sources). Let’s access the 1-year estimates and gather data on metropolitan stastical area (MSA) median household income and median house values. For other ways to visualize these kinds of data see this post from last year.

#####################################################################################
## Load libraries ----
#####################################################################################
library(acs)
library(scales)
library(tidyverse)
library(viridis)

#####################################################################################
## Get data ----
#####################################################################################

#install your key
api.key.install(key="YOUR_API_KEY")

# Get metros
geo <- geo.make(msa='*')

# housing values table B25077

hv <- acs.fetch(endyear=2016, span=1, geography=geo, table.number="B25077")

# income table B19013
inc <- acs.fetch(endyear=2016, span=1, geography=geo, table.number="B19013")

# Population Table B25008
pop <- acs.fetch(endyear=2016, span=1, geography=geo, table.number="B25008")


df.acs <- data.frame(area=hv@geography$NAME,        # MSA name
                     pop=unname(pop@estimate[,1]), # Metro Population 
                     hvalue=unname(hv@estimate),   # Median Housing value
                     inc=unname(inc@estimate)      # Median Household Income

                     ) %>% 
  mutate(ratio=hvalue/inc) %>%                     # create ratio of house value to income
  arrange(-pop)                                    # sort (descending) by population

Let’s look at the first few rows…

knitr::kable(head(df.acs))

knitr::kable(summary(df.acs %>% select(-area)))

When we compare the median house price to the median household income, ratio, we see that there’s quite a bit of variation across MSAs.

Make the chart

In order to make the chart we need to use (abuse?) the ggplot2 sec.axis function along with the rescale() function from the scales package.

What we will do is map the ratio, median income, and median price stasitics to a 0 to 100 scale. Then we’ll invert the mapping to label the points.

df.acs2 <- df.acs[6,]   # just get row 6, Washington D.C.

maxp <- max(df.acs$hvalue)
maxr <- max(df.acs$ratio)
minr <- min(df.acs$ratio)

df.plot <- df.acs2 %>% 
  mutate(p=rescale(hvalue,to=c(0,100), from=c(0,maxp)),
         i=rescale(inc, to=c(0,100), from=c(0,maxp)),
         r=rescale(ratio, to=c(0,100), from=c(minr,maxr))
  )
knitr::kable(df.plot %>% select(-area))

Now our price (hvalue), income (inc), and ratio (ratio) stats are mapped to a 0 to 100 scale (p,i,r respectively).

To draw the spotlight we need a triangle that goes from r to p and i. We’ll put r on the left at x value 1 and the values i and r on the right at value 2 (the particular values are arbitrary). In order to create the points we’ll double up the x values using the expand function.

df.plot2 <- 
  df.plot %>% 
  group_by(area) %>%
  expand(x=c(0,1,2),r,p,i) %>%
  mutate(y=case_when(
    x == 0 ~ r,
    x == 1 ~ p,
    x == 2 ~ i)  ) %>% 
  mutate(x=ifelse(x==0,1,2)) %>% 
  ungroup()

knitr::kable(df.plot2 %>% select(-area))

Now we simply draw our point (for the spotlight source) and the triangle (for the cone of light). And style. I’m using a dark theme, but it could be even darker.

# add back some fields we dropped wiht expand() above
df.plot2<- left_join(df.plot2, df.acs2, by="area")

  ggplot(data=df.plot2, 
        aes(color=area,fill=area,group=area))+
  geom_polygon(aes(x=x,y=y),alpha=0.5, color=NA,fill="white")+
  geom_point(aes(x=1,y=r,size=4), color="white")+
  scale_fill_viridis(discrete=TRUE)+
  theme_dark()+
  theme(legend.position="none")+
    facet_wrap(~area,ncol=1)+
  scale_x_continuous(labels=c("Ratio","$ House Value/Income"), breaks=c(1,2), limits=c(0.65,2.15))+
  scale_y_continuous(name="Ratio", 
                     breaks=seq(0,100,10),
                     limits=c(0,100),
                     labels=format(round(seq(minr,maxr,length.out=11),1),nsmall=1),
                     # Note that we'll invert the scale for the labels (switching to and from)
                     sec.axis=sec_axis(~rescale(., to=c(0,maxp),
                                                from=c(0,100)),
                                                breaks=seq(0,maxp,length.out=11),
                                       name="Median House Value/Median Household Income, 2016 $",
                                       labels=round(seq(0,maxp/1000,length.out=11),0))
                     )+
  geom_text(data= . %>% filter(x==1),
            aes(label=round(ratio,1), x=0.92,y=y),
            hjust=1, color="white", size=3)+
  geom_text(data= . %>% filter(y==p),
            aes(label=paste0("house value:\n",round(hvalue/1000,0)), x=2.05,y=y),
            hjust=0, color="white", size=3)+
  geom_text(data= . %>% filter(y==i),
            aes(label=paste0("income:\n",round(inc/1000,0)), x=2.05,y=y),
            hjust=0, color="white", size=3)+
    theme(plot.caption=element_text(hjust=0))+
  labs(x="", title="Spotlight on housing affordability",
       caption="@lenkiefer Source: 2016 American Community Survey 1-year estimates\ninspired by http://krisztinaszucs.com/my-product/hollywood/")

Finally, we can create a function and try out some additional styling. The original viz used a restrained black/white and gray color scheme. I don’t understand colors, but that doesn’t stop me from experimenting so I’ll try out a viridis palette.

plotf <- function(df.acs2= df.acs[1:10,]){

maxp <- max(df.acs2$hvalue)
maxr <- max(df.acs2$ratio)
minr <- min(df.acs2$ratio)

df.plot <- df.acs2 %>% 

  mutate(r=rescale(ratio, to=c(0,100), from=c(minr,maxr)),
         p=rescale(hvalue,to=c(0,100), from=c(0,maxp)),
         i=rescale(inc, to=c(0,100), from=c(0,maxp))
  )

df.plot2 <- 
  df.plot %>% 
  group_by(area) %>%
  expand(x=c(0,1,2),r,p,i) %>%
  mutate(y=case_when(
    x == 0 ~ r,
    x == 1 ~ p,
    x == 2 ~ i)  ) %>% 
  mutate(x=ifelse(x==0,1,2))

df.plot2<- left_join(df.plot2, df.acs2, by="area")

g1<-


ggplot(data=df.plot2, 
       aes(color=area,fill=area,group=area))+
  geom_polygon(aes(x=x,y=y),alpha=0.35, color=NA)+
  geom_point(aes(x=1,y=r,size=4), color="white")+
  theme_dark()+
  scale_fill_viridis(discrete=TRUE)+
  theme(legend.position="none")+#facet_wrap(~area)+
  scale_x_continuous(labels=c("Ratio","$ Income/House Value"), breaks=c(1,2), limits=c(0.65,2.15))+
  scale_y_continuous(name="Ratio: Median House Value to Median Household Income", 
                     breaks=seq(0,100,10),
                     limits=c(0,100),
                     labels=format(round(seq(minr,maxr,length.out=11),1),nsmall=1),
                     sec.axis=sec_axis(~rescale(., to=c(0,maxp),
                                                from=c(0,100)),
                                       breaks=seq(0,maxp,length.out=11),
                                       labels=round(seq(0,maxp/1000,length.out=11),0),
                                       name="Median House Value/Median Household Income, 2016 $")
  )+
  ggrepel::geom_text_repel(data= . %>% filter(x==1),
            aes(#label=paste0(gsub("(.*),.*", "\\1", area),"\nratio: ",round(ratio,1)), 
              label=paste0(gsub("(.*),.*", "\\1", area)), 
                x=0.97,y=y),
            hjust=1, color="white", size=3)+
  theme(plot.caption=element_text(hjust=0))+
  labs(x="", title="Spotlight on housing affordability",
       caption="@lenkiefer Source: 2016 American Community Survey 1-year estimates\ninspired by http://krisztinaszucs.com/my-product/hollywood/")
            
return(g1)
}

plotf()