18 August 2016

AUGUST IS ALMOST OVER, and it’s nearly back to school season. And that means one thing. No, not that we’re about to get a chance to watch the #1 NCAA football program of all time dominate the gridiron (though that’s awesome too). No, it’s data release season! A data swarm is on its way.

From American Community Survey to the American Housing Survey to the annual Home Mortgage Disclosure Act Data many statistical data releases come out in September and October.

In preparation for all these data releases I’ve been firing up the viz terminal and getting my statistical software all stretched out. Good news is, there’s all kind of great innovations coming out to help me. Bad news is there’s so much to keep up with. In this post I’m going to try out some new techniques and work on some fundamentals.

Data wrangling with R

Out of expediency I’ve often used Excel for mundane data wrangling tasks (see here for an example), but I’ve been meaning to use R more.

Fortunately I’ve gotten some help to jump start me. @jkregenstein, who works at Rstudio reached out to me and offered me some R code (see here for house prices example and here for credit panel example from Jonathan) to accomplish what I was doing with Excel.

I’m going to try to build from Jonathan’s examples and work out my data wrangling skills with an example using negative equity estimates from Zillow.

Wrangling some data

Zillow publishes a negative equity report that tracks what proportion of homeowners currently are “underwater” or owe more on their mortgage than what their home is currently worth. See a write-up of their latest release from Zillow Chief Economist @SvenjaGudell here. Note that the firm CoreLogic also has a report. The two reports are slightly different due to different underlying data and different, but similar, methodologies. Because the Zillow data is available in a handy .csv format downloadable from their website I’m going to use the Zillow data.

The Zillow data is not tidy, but it’s not too far from it. It’s a good version to practice on. Downloading the data you get a .csv file that looks like this when viewed in Excel. Note Zillow released the 2016Q2 report today, but the latest available data at time of writing is the 2016Q1 report

zillow data

In the data file there are several descriptive columns and then the actual data showing the proportion of homeowners underwater according to Zillow’s calculations starting in the 13th column (M in the spreadsheet). We’ll want to tidy this column by gathering all the data columns (from columns 13 to 32 or column M to AF).

My standard approach with this would be to use the Excel pivot table wizard to gather the columns like so (from my house price data wrangling post):

FMHPI 6

But tidying these data in R is pretty easy.

Here’s how I would have gone about it:

#load libraries
library(readr)
library(dplyr)
library(tidyr)
library(lubridate)
library(stringr)
library(readxl)
library(ggplot2)
library(ggrepel)
library(ggthemes)
library(scales)
library(zoo)
library(data.table)

#zdata<-fread("http://files.zillowstatic.com/research/public/NegativeEquity_2016Q1_Public.csv")

# Here's how I would have done it by brut(ish) force
z2<-data.table(gather(zdata,dateq,"neg",13:32))
z2[,year:=as.numeric(substring(dateq,1,4))]
z2[,month:=as.numeric(substring(dateq,6,6))]
z2$date<- as.Date(ISOdate(z2$year,z2$month,1) )  #this converts year and month characters to R dates

But after reading Jonathan’s code examples I see that I can try a slightly different approach to get to the same place.

##manipulate and create new variables
zdata_wrangled <-zdata  %>% 
  gather(dateq,"neg",13:32) %>%
  #create a column called year and month by separating the zillow date column
  separate(dateq,into=c("year","quarter"),sep="Q",convert=T,remove=F) %>%
  #create dates
  mutate(
    date= as.Date(ISOdate(year,quarter*3,1) )
  ) %>% data.table()

Okay let’s use these data for something

Let’s examine trends in negative equity by state using these data. Once again we’ll use the R packaged tweenr and animate to make an animated gif. See my earlier post about tweenr for an introduction to tweenr, and more examples here and here.

USID<-unique(z3[RegionType=="Country"]$RegionID)   #get the US region ID
regions<-unique(z3[RegionType=="State"]$RegionID)  #get a list of state IDs

#add the "US" at the top and the bottomw of the list of states 
r2<-c(USID,regions,USID)

# function to create list of data sets from our data (by state)
myf<-function(r){
  z.out<-z3[RegionType %in% c("Country","State") & RegionID==r, list(RegionName,date,neg)]
  z.out %>% map_if(is.character, as.factor) %>% as.data.frame() ->z.out
  return(z.out)
  }
myf(regions[1])
# use lapply to generate the list of data sets:
my.list2<-lapply(r2,myf)

# Apply tweenr:
tf <- tween_states(my.list2, tweenlength= 2, statelength=3, ease=rep('cubic-in-out',51),nframes=300)
dtf<-data.table(tf)  # Make tweenr output a data table 

oopt = ani.options(interval = 0.15)
saveGIF({for (i in 1:max(tf$.frame)) {
# create the animation
g<-
  ggplot(data=dtf,aes(x=date,y=neg,group=RegionName,label=RegionName))+
  geom_path(data=z3[RegionID %in% r2,],aes(x=date,y=neg),color="gray",alpha=0.3)  +
  scale_y_continuous(labels=percent)+
  geom_line(data=dtf[.frame==i,],color="red",size=1.1)+
  #add % at end
  geom_text(data=dtf[date==max(dtf$date) & .frame==i],aes(label=percent(neg)),
            nudge_y=.025,nudge_x=10, color="red")+
  #add point at line end:
  geom_point(data=dtf[date==max(dtf$date) & .frame==i],size=2, color="red")+
  #style:
  theme_minimal()+  theme(plot.title=element_text(face="bold",size=12))+
  theme(plot.caption=element_text(hjust=0))+
  theme(plot.subtitle=element_text(color="red"))+
  #labels:
  labs(y="Percent of homeowners underwater", x="",
       caption="@lenkiefer Source: Zillow Negative Equity Report (2016Q1)",
       subtitle=unique(dtf[.frame==i]$RegionName),
       title="Negative Equity by State")
print(g)
ani.pause()
print(i)
}
},movie.name="zillow neg equity 2016Q1.gif",ani.width = 500, ani.height = 350)

Which yields:

neg equity gif

Swarms and swarms

I spend a lot of time looking at the annual Home Mortgage Disclosure Act (HMDA) data. The publicly available data is a great source of information for what’s happened in the mortgage market in the past year. The data are only available with a lag. In September/October we’ll get the 2015 data.

The data are housed over at the Consumer Financial Protection Bureau webpage. They have a public API, but I haven’t seen anything written on using R with it. But they do have a nice summary file generator, which can be quite handy. But for this exercise we’ll work with the loan level data.

For this exercise we’re going to work with mortgage loan origination records from the 2014 HMDA data.

Every year there are a lot of mortgages originated. Some have even said that this year (2016) the total market will top $2 Trillion in originated mortgages. In 2014 there were over 5 million mortgage loans originated for 1-4 family dwellings and manufactured housing. For the following examples I downloaded a loan-level file including all 5 million + observations from the CFPB website. To make things marginally faster I restricted myself to conventional loans, bringing the raw count down to about 4 million loans.

Beeswarm plots

Yesterday @hadleywickham commented on how he was enjoying the ggbeeswarm package which allows you to make beeswarm plots (or column scatter plots or violin scatter plots) in R with ggplot2.

I like to look at distributions in different ways, so I thought I would try them out. I was not disappointed, especially when I combined it with tweenr.

For this example, I’m going to use the beeswarm package to generate beeswarm plots shows the distribution of loan amount across states broken out by purchase and refinance loans. And we’ll use tweenr to animate the transitions.

HMDA Swarm

Making the plot

I’ve pulled down a .csv file from the CFPB website that containes all the conventional purchase and refinance 1-4 family dwelling and manufactured housing mortgage originations in 2014. This link will take you to the CFPB webpage where you can download the file. It is about 2.6 GB so I wouldn’t recommend opening in Excel. Though I have done such a thing in the past.

But I’m not here to talk about the past (that’s a story for another post). I’m here to talk about beeswarms.

library('ggbeeswarm')  #load the ggbeeswarm package
library('viridis')     # viridis for colors
mydata <- fread("~/data/hmda/hmda_lar.csv")  #load the .csv file data tables do well.


#let's only keep important columns
mydata<-mydata[,list(state_name,loan_purpose_name,loan_type_name,loan_amount_000s)]
mydata$upb<-as.numeric(mydata$loan_amount_000s)*1000

#subset data for smaller version:
mydata2<-mydata[ loan_type_name %in% c("Conventional") & state_name !="", ]  #my original query included non-conventional (e.g. FHA, VA, or RHS loans)

rm(mydata)  #drop unecessary data

#convert characters to factors for tweenr

mydata2 %>% map_if(is.character, as.factor) %>% as_data_frame -> mydata2

myf <- function(mystate){
  my.out<-mydata2[state_name==mystate,list(upb,loan_purpose_name,loan_type_name,state_name)][sample(.N,3000)]
  #The data is huge, so I only want to sample 3000 loans.  Plotting millions of points isn't very useful.

    my.out %>% map_if(is.character, as.factor) %>% as.data.frame() ->my.out  #need to convert characters to factors for tweenr
  return(data.frame(my.out))}

#I want to order states by total loan origination Unpaid Principal Balance (upb)
#Calinfornia goes first
st.sums1<-mydata2[, list(upb=sum(as.numeric(loan_amount_000s))/1e6),by=state_name] 

st.list<-as.character(unique(st.sums1[order(-upb)]$state_name))  #unique list of states
my.list<-lapply(c(st.list[1:51],st.list[1]),myf) 

# tween
tf <- tween_states(my.list, tweenlength= 3, statelength=2, ease=rep('cubic-in-out',24),nframes=300)
tf<-data.table(tf)

#a plot for the function
myplot<-function(i){
  g<-
    ggplot(tf[.frame==i & upb>0],
           aes(y=loan_purpose_name,x=upb/1000,color=loan_purpose_name))+
    theme_minimal()+    
    theme(plot.title=element_text(size=14))+theme(plot.caption=element_text(hjust=0,vjust=1,margin=margin(t=10)))+
    theme(plot.margin=unit(c(0.25,0.25,0.25,0.25),"cm"))+
    geom_quasirandom(alpha=0.35,size=.7)+  #I like the quasirandom beeswarm option
    scale_color_viridis(discrete=T,option="D",end=0.5)+  #use viridis color package, it's great!
    theme(legend.justification=c(0,0), legend.position="none")+
    # use a log scale
    scale_x_log10(limits=c(10,2500),label=dollar,breaks=c(10,25,50,100,250,500,1000,2000))+ 
    #labels
    labs(x="Loan Amount (Ths $, log scale)",
         y="Loan Purpose",title="Distribution of conventional mortgage loan amount",
         subtitle=paste(unique(tf[.frame==i]$state),"in 2014"),
        caption="@lenkiefer Source: CFPB, FFIEC, Home Mortgage Disclosure Act (HMDA) data\nEach dot represents one originated loan. (3,000 loans randomly sampled for plot)\nIncludes only Conventional purchase and refinance loans for 1-4 family dwellings and manufactured housing.")
   return(g)  }

# make the movie

library(animation)
oopt = ani.options(interval = 0.2)
saveGIF({for (i in 1:max(tf$.frame)) {
  g<-myplot(i)
  print(g)
  ani.pause()
  print(i)
}
},movie.name="HMDA loan amounts v3.gif",ani.width = 740, ani.height = 450)