House Price Index

The house price index data we want is available via a flat text file on the FHFA webpage (large .csv file). We can use the data.table function data.table::fread() to read the data in. Then we’ll filter the file down to the quarterly purchase-only house price index for states and the United States.

# Load Libraries ---- 
library(data.table)
library(tidyverse)
library(ggridges) #for gradient shading
library(viridis)
library(bea.R)
library(tigris) # for maps
library(cowplot)
library(animation) #for animation
library(ggthemes)

# This gets all hpi data
df.hpi<-fread("https://www.fhfa.gov/DataTools/Downloads/Documents/HPI/HPI_master.csv")
# Take a look
knitr::kable(head(df.hpi))

There are several files detailing information about the house price index. Additional details can be found here.

We want to grab the traditional type, purchase-only flavor, quarterly frequency. We’ll set up two data.frames that are subsets of the large data. One for the United States and one for the states.

# get quarterly purchase-only index for the United States
df.usa <-df.hpi[frequency=="quarterly" & hpi_flavor=="purchase-only" & place_name==  "United States",][, hpa:=index_sa/shift(index_sa,4)-1][,date:=as.Date(ISOdate(yr,period*3,1))]

# get quarterly purchase-only state indices
df.st <- df.hpi[frequency=="quarterly" & hpi_flavor=="purchase-only" & level=="State",]
df.st <- df.st[,date:=as.Date(ISOdate(yr,period*3,1))]

# Drop D.C.
df.st <- df.st[place_name !="District of Columbia",]
df.st <- df.st[, place_namef:=factor(place_name)]

BEA data

Let’s set aside the house price data for now and go get income data from the BEA. We’ll use the bea.R package. In order for this to work for you, make sure you get an API key as detailed in the bea.R documentation. Once you have a key, you’ll then need to figure out what table you need and how to use the API. This example could help.

For example, per capita income estimates can be found in table SQ1.

beaKey  <- 'YOUR-API-KEY' #need a key from BEA
# get annual data for US
beaSpecs <- list(
  'UserID' = beaKey ,
  'Method' = 'GetData',
  'datasetname' = 'RegionalIncome',
  'GeoFIPS' = '00000',
  'TableName' = 'SA1',
  'Frequency' = 'A',
  'Year' = 'ALL',   # All available years
  'ResultFormat' = 'json',
  'LineCode' = '3'  # variable, line 3 corresponds to per capita income
)

us.pcA <- beaGet(beaSpecs, asWide=FALSE)   #query BEA, use a wide format
us.pcA <-  mutate(us.pcA, yr=substr(TimePeriod,1,4), qtr=2) %>% mutate(date=as.Date(ISOdate(as.numeric(yr),as.numeric(qtr)*3,1)))

# get quarterly data for US
beaSpecs <- list(
  'UserID' = beaKey ,
  'Method' = 'GetData',
  'datasetname' = 'RegionalIncome',
  'GeoFIPS' = '00000', #US
  'TableName' = 'SQ1',
  'Frequency' = 'Q', # quarterly frequency
  'Year' = 'ALL',
  'ResultFormat' = 'json',
  'LineCode' = '3'  # variable, line 3 corresponds to per capita income
)
us.pcQ <- beaGet(beaSpecs, asWide=FALSE) %>% filter(!is.na(DataValue))
us.pcQ <- mutate(us.pcQ, yr=substr(TimePeriod,1,4), qtr=substr(TimePeriod,6,6)) %>% mutate(date=as.Date(ISOdate(as.numeric(yr),as.numeric(qtr)*3,1)))

knitr::kable(tail(us.pcQ))  # prints header of table

To get the states, we need a list of state FIPS codes. I happen to have a text file here that has states FIPS codes and regions. Unfortunately this file only has 2 digit FIPS codes formatted as numbers. We need 5 digit numbers (padded left with a leading zero if less than 10 and 3 trailing zeros).

region <- fread("http://lenkiefer.com/img/charts_feb_20_2017/region.txt")
knitr::kable(head(region))

Now we can create a list and feed it to the beaSpecs list we created.

fips.list<- str_pad(region$fips*1000,5,"left","0")  #pad the fips numbers with leading and trailing zeros
# get state annual data
beaSpecs <- list(
  'UserID' = beaKey ,
  'Method' = 'GetData',
  'datasetname' = 'RegionalIncome',
  'GeoFIPS' = paste(fips.list,collapse=", "),  # convert our list into a coma separated string
  'TableName' = 'SA1',
  'Frequency' = 'A',
  'Year' = 'ALL',
  'ResultFormat' = 'json',
  'LineCode' = '3'
  
)

st.pcA <- beaGet(beaSpecs, asWide=FALSE) 
st.pcA <-  mutate(st.pcA, yr=substr(TimePeriod,1,4), qtr=2) %>% mutate(date=as.Date(ISOdate(as.numeric(yr),as.numeric(qtr)*3,1)))

# if we wanted quarterly data we could go to table SQ1:
# get state quarterly data
beaSpecs <- list(
  'UserID' = beaKey ,
  'Method' = 'GetData',
  'datasetname' = 'RegionalIncome',
  'GeoFIPS' = paste(fips.list,collapse=", "),
  'TableName' = 'SQ1',
  'Frequency' = 'A',
  'Year' = 'ALL',
  'ResultFormat' = 'json',
  'LineCode' = '3'
  
)

st.pcQ <- beaGet(beaSpecs, asWide=FALSE) %>% filter(!is.na(DataValue))
st.pcQ <- mutate(st.pcQ, yr=substr(TimePeriod,1,4), qtr=substr(TimePeriod,6,6)) %>% mutate(date=as.Date(ISOdate(as.numeric(yr),as.numeric(qtr)*3,1)))

Merge the data

Now we’re ready to merge the data. But we have a problem. The house price index data is quarterly, but the quarterly income series only goes back to 2010. If we want a longer time series we either have to interpolate the income data or somehow aggregate the house price index data. I choose the latter. The annual per capita income estimates are midyear, so I’ll take the Q2 house price index data and merge it to the annual per capita income estimates.

We also have a problem in that the state names have asterisks for Alaska and Hawaii. We’ll use gsub to get rid of the asterisks in the state names.

# get rid of astericks from Alaska and Hawaii
st.pcA$GeoName<- gsub("[*].*$","",st.pcA$GeoName)
st.pcQ$GeoName<- gsub("[*].*$","",st.pcQ$GeoName)

And now we are ready to join the data. Using a left assignment I might add.

# merge to df.usa q=2 for US data
dt.us <- left_join(filter(df.usa,period==2), select(us.pcA ,date,DataValue), by="date")  %>%
  mutate(hpi=index_sa/index_sa[yr==1991],
         inc=DataValue/DataValue[yr==1991]) %>% ungroup() %>% data.table() 

# for states join hpi (for Q2) with bea annual income
df.combined <- left_join(df.st %>% filter(period==2), st.pcA %>% select(Code,GeoName,GeoFips,CL_UNIT,date,DataValue), by=c("place_name"="GeoName","date"="date")) %>% data.table()
df.combined <- left_join(df.combined, region ,by=c("place_id"="statecode")) 

# compute values relative to 1991 Q4: 

df.combined %>% group_by(place_id) %>% mutate(hpi=index_sa/index_sa[yr==1991],
                                              inc=DataValue/DataValue[yr==1991]) %>%
  ungroup() %>% data.table() -> dt