Slopegraph

The slopegraph is a line plot with two points. In this case, the median price in 2015Q2 and in 2016Q2. We’ll arrange the dates on the x axis and have the price displayed on the y axis. We’ll use a logarithmic scale for the y axis, so the slopes of the lines will approximate the percentage change in the median price.

We’ll call out the United State median sales price by overlaying a red line on tope of gray lines representing each individual metro area. In the animation we’ll loop through each metro and update the histogram.

#Load some packages... 
library(data.table, warn.conflicts = FALSE, quietly=TRUE)
library(ggplot2, warn.conflicts = FALSE, quietly=TRUE)  #Using the development version for captions/subtitles
library(dplyr, warn.conflicts = FALSE, quietly=TRUE)
library(zoo, warn.conflicts = FALSE, quietly=TRUE)
library(ggthemes, warn.conflicts = FALSE, quietly=TRUE)
library(scales, warn.conflicts = FALSE, quietly=TRUE)
library(animation, warn.conflicts = FALSE, quietly=TRUE)
library(tidyr, warn.conflicts = FALSE, quietly=TRUE)
library(ggrepel, warn.conflicts = FALSE, quietly=TRUE)
library(tweenr, warn.conflicts = FALSE, quietly=TRUE)

#Load some data that looks like the image above:
ndata <- fread("data/nar2016q2.txt")
ndata$date<-as.Date(ndata$date, format="%m/%d/%Y")  #set dates
ndata<-transform(ndata, value = as.numeric(value))  #force value to be numeric
ndata[,myjust:=ifelse(id=="2016.II",0,1)]           #used to align text labels, left label right aligned, right label left aligned

#create the plot

g.slope<-ggplot(data=ndata[code=="US" & (id=="2015.II"|id=="2016.II") & type=="level",],
       aes(x=id,y=value,group=name,label=paste(" ",name,"\n",dollar(round(value,0)),"k ",sep="")))+
  #we need to group by metros, and create a label
  
  #create gray lines for each metro
  geom_path(data=ndata[code=="metro" & (id=="2015.II"|id=="2016.II") & type=="level"],color="gray",alpha=0.7)+
  geom_point(data=ndata[code=="metro" & (id=="2015.II"|id=="2016.II") & type=="level"],color="gray",alpha=0.7)+
  theme_minimal()+
  
  #create a red line for the U.S.
  geom_path(color="red")+geom_text(color="red",aes(hjust=myjust))+scale_y_log10(breaks=seq(100,1100,100))+
  geom_point(color="red",size=2)+
  labs(x="quarter",y="Median sales price (Ths $, log scale)",subtitle="Median sales price of existing single family home",
       caption="@lenkiefer Source: NAR each line a metro area",title="Change in house prices 2015Q2 to 2016Q2")+
 theme(plot.caption=element_text(size=10, hjust=0, margin=margin(t=15)))

g.slope

Create the histograms

In order to create the histograms we’re going to have build them ourselves. Our strategy will be to place each metro in a bin corresponding to a range of house prices (say from $75,000 to $100,000), and then count up how many metros are in each bin. So far, that’s just like a standard histogram. But as we’re going to draw a dot for each metro area, we have to assign a y axis value for each metro.

d<-ndata[code=="metro"& id=="2016.II" & type=="level" & value>0,]
myhist<-hist(d$value,plot=FALSE, breaks=seq(0,1100,25) ) #construct a histogram

N<-length(myhist$mids)  #how many bins in the histogram
d<-d[order(value),]  #sort the data by median house prices
i<-1
j<-1
myindex<-0  #initialize
d$counter<-0  #initialize y axis counter
g1<-ggplot(data=data.frame(x=myhist$mids[i],y=j),
          aes(x=x,y=y))+theme_minimal()
for (i in 1:N){
  for (j in 1:myhist$counts[i])
  {if (myhist$counts[i]>0){
    myindex<-myindex+1 #iterate counter
    d[myindex, counter:=j]  #set y = j
    d[myindex, vbin:=myhist$mids[i]]  # append bin value for this price
    g1<-g1+geom_point(data=data.frame(x=myhist$mids[i],y=j), aes(x=x,y=y),size=2,color="gray")}  #add dot to plot
  }}
g1<-g1+scale_x_continuous(limits=c(0,1150),breaks=seq(0,1100,100))+
  scale_y_continuous(limits=c(0,40))+
  labs(x="Median Sales Price of Existing Single-Family Homes (Ths $)",
       y="count of metros",
       title="Home sales price distribution 2016 Q2",
              caption="@lenkiefer Source: NAR each dot a metro area")+
 theme(plot.caption=element_text(size=10, hjust=0, margin=margin(t=15)))
g1

Combine the plots

Now we’ll used the multiplot function to combine the plots. We’ll also make another histogram so we can compare the distribution of median house sales prices in 2016Q2 to the distribution in 2015Q2.

source("code/multiplot.R") #include the multiplot function

#Recreate the histogram for 2015Q2:

d2<-ndata[code=="metro"& id=="2015.II" & type=="level" & value>0,]
myhist<-hist(d2$value,plot=FALSE, breaks=seq(0,1100,25) )
N<-length(myhist$mids)
g2<-ggplot()
d2<-d2[order(value),]
myindex<-0
d2$counter<-0
g2<-ggplot(data=data.frame(x=myhist$mids[i],y=j),
          aes(x=x,y=y))+theme_minimal()
for (i in 1:N){
  for (j in 1:myhist$counts[i])
  {if (myhist$counts[i]>0){
    myindex<-myindex+1
    d2[myindex, counter:=j]
    d2[myindex, vbin:=myhist$mids[i]]
    g2<-g2+geom_point(data=data.frame(x=myhist$mids[i],y=j), aes(x=x,y=y),size=2,color="gray")}
  }}



g2<-g2+scale_x_continuous(limits=c(0,1150),breaks=seq(0,1100,100))+
  scale_y_continuous(limits=c(0,40))+
  labs(x="Median Sales Price of Existing Single-Family Homes (Ths $)",
       y="count of metros",
       title="Home sales price distribution 2015 Q2")

#Create the multiplot 
#We use a matrix layout to make the slopegraph two units tall and the histograms 1 in a 2x2 layout:

multiplot(g2+theme(axis.text=element_text(size=6),axis.title=element_text(size=7)), #shrink axis text and labels
          g1+theme(axis.text=element_text(size=6),axis.title=element_text(size=7)),
          g.slope+labs(caption="@lenkiefer Source: NAR each dot/line a metro area"),layout=matrix(c(3,1,3,2), nrow=2, byrow=TRUE))

add animation

Now we want to highlight each individual metro area. To do so, we’ll construct an animated gif where we highlight each metro one at time. The code below generates the animated gif:

mlist<-unique(d$name)  #get a unique list of metros, ordered by median prices in 2016Q2

oopt = ani.options(interval = 0.3)
saveGIF({for (i in seq(1,length(mlist),1) ){
g3<-
  ggplot(data=ndata[name==mlist[i] & (id=="2015.II"|id=="2016.II") & type=="level",],
         aes(x=id,y=value,group=name,label=paste(" $",round(value,1),"k ",sep="")))+
  geom_path(data=ndata[code=="metro" & (id=="2015.II"|id=="2016.II") & type=="level"],color="gray",alpha=0.7)+
  geom_point(data=ndata[code=="metro" & (id=="2015.II"|id=="2016.II") & type=="level"],color="gray",alpha=0.7)+
  theme_minimal()+
  geom_path(color="red")+geom_text(color="red",aes(hjust=myjust))+scale_y_log10(breaks=seq(100,1100,100))+
  labs(x="quarter",y="Median sales price (Ths $, log scale)",subtitle=mlist[i],
       caption="@lenkiefer Source: NAR",title="Change in house prices 2015Q2 to 2016Q2")+
  theme(plot.subtitle=element_text(color="red"))+ theme(plot.caption=element_text(size=10, hjust=0,margin=margin(t=15)))+
  geom_point(color="red",size=2)

multiplot(g2+  geom_point(data=d2[name==mlist[i]],aes(x=vbin,y=counter),size=2,color="red")+
            labs(subtitle=mlist[i])+theme(plot.subtitle=element_text(color="red"))+
            theme(axis.text=element_text(size=6),axis.title=element_text(size=7)),
          g1+  geom_point(data=d[name==mlist[i]],aes(x=vbin,y=counter),size=2,color="red")+
            labs(subtitle=mlist[i])+theme(plot.subtitle=element_text(color="red"))+
            theme(axis.text=element_text(size=6),axis.title=element_text(size=7)) ,
          g3+theme(axis.text=element_text(size=6),axis.title=element_text(size=7))
          ,layout=matrix(c(3,1,3,2), nrow=2, byrow=TRUE))
ani.pause()
print(i)
}
},movie.name="nar dots 2016 q2 v2.gif",ani.width = 1000, ani.height = 650)

Run it and you get our plot: