Relating house price trends to economic variables

We can relate house price trends to other economic variables. Let’s go back to the state data and plot the relationship between state house price appreciation and the unemployment rate. We’ll go get unemployment data from the U.S. Bureau of Labor Statistics.

# Download data big file
ur.data<-fread("https://download.bls.gov/pub/time.series/la/la.data.1.CurrentS")

# Download series ids

ur.series<-fread("https://download.bls.gov/pub/time.series/la/la.series")

# We'll subset data
ur.list<-ur.series[area_type_code =="A" &   #get states
                     measure_code == "3"  &   #get unemployment rate
                     seasonal == "S",         #get seasonally adjusted data
                   c("series_id","area_code","series_title"),
                   with=F]

## Get state names and area crosswalk
ur.area<-fread("https://download.bls.gov/pub/time.series/la/la.area",
               col.names=
                 c("area_type_code","area_code","area_text","display_level",
                   "selectable","sort_sequence","blank"))                   

## Warning in fread("https://download.bls.gov/pub/time.series/la/la.area", :
## Starting data input on line 2 and discarding line 1 because it has too
## few or too many items to be column names or data: area_type_code area_code
## area_text display_level selectable sort_sequence

# merge data
ur.dt<-merge(ur.data,ur.list,by="series_id",all.y=T)

#create data variable
ur.dt[,month:=as.numeric(substr(ur.dt$period,2,3))]
ur.dt$date<- as.Date(ISOdate(ur.dt$year,ur.dt$month,1) ) #set up date variable
ur.dt<-merge(ur.dt,ur.area[,c("area_text","area_code"),with=F],by="area_code")


# Load national unemployment rate using quantmod and FRED database
# helpful reference https://jeffreybreen.wordpress.com/tag/quantmod/
unrate = getSymbols('UNRATE',src='FRED', auto.assign=F) 

## 'getSymbols' currently uses auto.assign=TRUE by default, but will
## use auto.assign=FALSE in 0.5-0. You will still be able to use
## 'loadSymbols' to automatically load data. getOption("getSymbols.env")
## and getOption("getSymbols.auto.assign") will still be checked for
## alternate defaults.
## 
## This message is shown once per session and may be disabled by setting 
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details.

unrate.df = data.frame(date=time(unrate), coredata(unrate) )

# Drop some columns
ur.dt2<-ur.dt[,c("date","area_text","value"),with=F]

## rename variables
ur.dt2<-dplyr::rename(ur.dt2, state=area_text)
ur.dt2<-dplyr::rename(ur.dt2, ur=value)

# merge national unemploymnent 
ur.dt2<-merge(ur.dt2,unrate.df,by="date")
ur.dt2<-dplyr::rename(ur.dt2, ur.us=UNRATE)  #rename UNRATE to ur.us

# create variables for use in ribbon chart
ur.dt2[,up:=ifelse(ur>ur.us,ur,ur.us)]

## Warning in `[.data.table`(ur.dt2, , `:=`(up, ifelse(ur > ur.us, ur,
## ur.us))): Invalid .internal.selfref detected and fixed by taking a
## (shallow) copy of the data.table so that := can add this new column by
## reference. At an earlier point, this data.table has been copied by R (or
## been created manually using structure() or similar). Avoid key<-, names<-
## and attr<- which in R currently (and oddly) may copy the whole data.table.
## Use set* syntax instead to avoid copying: ?set, ?setnames and ?setattr.
## Also, in R<=v3.0.2, list(DT1,DT2) copied the entire DT1 and DT2 (R's list()
## used to copy named objects); please upgrade to R>v3.0.2 if that is biting.
## If this message doesn't help, please report to datatable-help so the root
## cause can be fixed.

ur.dt2[,down:=ifelse(ur<ur.us,ur,ur.us)]

# drop D.C. and Puerto Rico (so we can have 50 plots in small multiple)
ur.plot<-ur.dt2[! state %in% c("Puerto Rico","District of Columbia")]
ur.plot<-ur.dt2[! state %in% c("Puerto Rico")]

# Get list of states:
st.list<-unique(ur.plot$state)

#Add U.S. as it's own state (for use in animation)
ur.plot.us<-copy(ur.plot)[state=="Alabama"]
ur.plot.us[,state:="United States"]
ur.plot.us[,ur:=ur.us]
ur.plot.us[,up:=ur.us]
ur.plot.us[,down:=ur.us]
ur.plot2<-rbind(ur.plot,ur.plot.us)

Now with these data in hand, we can recreate the plot I described here, but with a geofacet layout.

    ggplot(data=ur.plot2,aes(x=date,y=ur))+
    geom_line(color="black")+
    geom_line(linetype=2,aes(y=ur.us))+
    geom_ribbon(aes(ymin=ur,ymax=down),fill="#d73027",alpha=0.5)+
    geom_ribbon(aes(ymin=ur,ymax=up),fill="#4575b4",alpha=0.5)+
    facet_wrap(~state,ncol=10,scales="free_x")+
    scale_y_continuous(limits=c(0,20))+
    theme_minimal()+
    theme(legend.position="top",
          plot.caption=element_text(hjust=0),
          plot.subtitle=element_text(face="italic"),
          plot.title=element_text(size=16,face="bold"))+
    labs(x="",y="",
         title="The state of U.S. jobs - Working out @hrbmstr's workout of @stiles' Viz",
         subtitle="Solid line is state unemployment rate, dotted line is U.S. average unemployment rate\nRed (blue) indicates the state level is higher (lower) than the national average",
         caption="@lenkiefer Data Source: U.S. Bureau of Labor Statistics\nViz based on https://rud.is/b/2017/01/18/workout-wednesday-redux-2017-week-3/,\nitself based on http://thedailyviz.com/2016/12/14/four-decades-of-state-unemployment-rates-in-small-multiples-part-2/")+
    geom_rug(aes(color=ifelse(ur>ur.us,"Worse","Same or Better")),sides="b")+
    scale_color_manual(values=c("#4575b4","#d73027"),name="Better or worse than U.S.")+
    scale_x_date(date_labels="%y",date_breaks="10 years")+
    facet_geo(~ state, grid = "us_state_grid2")

## Some values in the specified facet_geo column 'state' do not match
##   the 'name' column of the specified grid and will be removed:
##   United States

Ha ha! That’s a lot of fun. Now let’s combine the house price data with the unemployment data.

House price and unemployment

#####################################################################################
# add region crosswalk
#####################################################################################

region<-fread("data/region.txt")


#####################################################################################
# merge up data
#####################################################################################
ur.plot3<-merge(ur.plot2,select(region,statecode,statename),
                by.x="state",by.y="statename") %>%
  rename(statename=state)

dfhu<-merge(df.state,select(ur.plot3,-up,-down),
            by.x=c("geo","date"),by.y=c("statecode","date"))


ggplot(data=filter(dfhu,date==max(dfhu$date)),
       aes(x=ur,y=hpa,group=state,label=state))+
  geom_text(size=3,alpha=0.82)+
  theme_minimal()+
  scale_x_continuous()+
  scale_y_continuous(labels=percent)+
  scale_colour_gradient(low="red",high="blue",
                               name = "12-month percent change",
                               labels = percent  )+
  labs(y="12-month percent change in house prices", 
       x="Unemployment rate (percent)",
       title="House prices and unemployment",
       subtitle="June, 2017",
       caption="@lenkiefer Source: Freddie Mac house price index, U.S. Bureau of Labor Statistics")+
    theme(plot.title=element_text(size=18),
          plot.caption=element_text(size=7,hjust=0,vjust=1),
          legend.key.width=unit(1,"cm"),
          legend.position="top",
          panel.grid.major.y =element_blank())

This plot shows that in general, states with relatively higher unemployment rates tend to have lower house price growth.

Let’s see how the relationship evolves over time. We’ll trace out a pather using geom_path, first for just the state of California.

#####################################################################################
# make list of dates
#####################################################################################
dlist<-unique(filter(dfhu,year(date)>1999)$date)

#####################################################################################
# generate some functions (the utility will become apparent soon)
#####################################################################################

myf5<- function (s, slist="CA") { return(filter(dfhu, 
                                                date>as.Date("2000-11-01") &
                                                  date<=s & state %in% slist) )}

myplot5<-function(df3) {
  g<-
    ggplot(data=df3, 
           aes(x=ur,y=hpa,group=state,color=hpa1,label=state))+
    geom_point(data=filter(df3,date==max(df3$date)),size=2)+
    geom_path(aes(alpha=id))+
    guides(alpha=F,color=F)+
    theme_minimal()+
    geom_hline(yintercept=0,color="black",linetype=2)+
    geom_vline(xintercept=100,color="black",linetype=2)+
    scale_x_continuous(limits=c(0,15))+
    scale_y_continuous(labels=percent,limits=c(-.4,.4))+
    scale_colour_gradient(low="red",high="blue",name = "12-month percent change",
                          #limits=c(-.6,.6),
                          labels = percent  )+
    labs(y="12-month percent change in house prices", 
         x="Unemployment rate (percent)",
         title="House prices and unemployment",
         subtitle="December 2000 through June 2017",
         caption="@lenkiefer Source: Freddie Mac house price index, U.S. Bureau of Labor Statistics")+
    theme(plot.title=element_text(size=18),
          plot.caption=element_text(size=7,hjust=0,vjust=1),
          legend.key.width=unit(1,"cm"),
          legend.position="top",
          panel.grid.major.y =element_blank())+facet_wrap(~state)
  return(g) }

myplot5(myf5(dlist[210],"CA"))

## Warning: Removed 1 rows containing missing values (geom_vline).

Now let’s try it for several states:

st.list<- c("CA","TX","FL","NV","AZ","WA","CO","MI","NC")
myplot5(myf5(dlist[210],st.list))

## Warning: Removed 9 rows containing missing values (geom_vline).

Now let’s try to show it for all states.

ggplot(data=filter(dfhu, date>as.Date("2000-11-01")), 
       aes(x=ur,y=hpa,color=hpa1,label=state))+
  geom_path(aes(alpha=id))+
  
  guides(alpha=F,color=F)+
  theme_minimal()+
  geom_hline(yintercept=0,color="black",linetype=2)+
  geom_vline(xintercept=100,color="black",linetype=2)+
  scale_x_continuous(limits=c(0,15))+
  scale_y_continuous(labels=percent,limits=c(-.4,.4))+
  scale_colour_gradient(low="red",high="blue",name = "12-month percent change",
                        #limits=c(-.6,.6),
                        labels = percent  )+
  labs(y="12-month percent change in house prices", 
       x="Unemployment rate (percent)",
       title="House prices and unemployment",
       subtitle="December 2000 through June 2017",
       caption="@lenkiefer Source: Freddie Mac house price index, U.S. Bureau of Labor Statistics")+
  theme(plot.title=element_text(size=18),
        plot.caption=element_text(size=7,hjust=0,vjust=1),
        legend.key.width=unit(1,"cm"),
        legend.position="top",
        panel.grid.major.y =element_blank())+  # use facet_geo
  facet_geo(~ state, grid = "us_state_grid2")

## Warning: Removed 96 rows containing missing values (geom_vline).

The US

kandinsky(filter(df.us,year(date)>1999) %>% select(date,hpi))
  grid.text(label=paste("U.S. house price index Jan 2000 - Jun 2017\n@lenkiefer, made using R package Kandinsky"),
            gp=gpar(fontsize=12),
            x=.95,y=0.075,just="right")

Virginia, Texas, Ohio, Kentucky

kandinsky(filter(df.state, 
                   state %in% c("VA","TX","OH","KY")) %>% select(date,state,hpa))
  grid.text(label=paste("12-month percent change in house price index\nJan 1976 - Jun 2017\nVA, TX, OH, and KY\n@lenkiefer, made using R package Kandinsky"),
            gp=gpar(fontsize=12),
            x=.95,y=0.8,just="right")