MORTGAGE RATES ARE LOW IN THE UNITED STATES. How low? Let’s take a look.
We’ll use R to plot a few visualizations of mortgage rates. We’ll also try out some of the nice features in the tibbletime package that help when working with time series data. For more on using tibbletime see this post and this one on making animated plots.
Since I was already called out for alleged chartcrimes, I’m going to go ahead and let loose here. We’ll go back to my dark theme. Halloween is getting close, if we modify our dark theme suitably we can have a spooky graph like this:
Data
We’ll get our mortgage rates data via the Saint Louis Federal Reserve’s FRED database. And if you followed my post from back in April you know what we can do if we combine FRED with the quantmod package. It gets even easier if we use tidyquant like we did here.
#####################################################################################
## Load libraries ##
#####################################################################################
library(tidyverse)
library(readxl)
library(tidyquant)
library(tibbletime)
library(ggridges)
library(viridis)
library(cowplot)
library(ggbeeswarm)
#####################################################################################
## Get mortgage data ##
# Can also get direct here: http://www.freddiemac.com/pmms/docs/historicalweeklydata.xls
#####################################################################################
df<- tq_get("MORTGAGE30US",get="economic.data",from="1971-04-01")
knitr::kable(tail(df))| date | price |
|---|---|
| 2017-09-14 | 3.78 |
| 2017-09-21 | 3.83 |
| 2017-09-28 | 3.83 |
| 2017-10-05 | 3.85 |
| 2017-10-12 | 3.91 |
| 2017-10-19 | 3.88 |
The variable price corresponds to the U.S. weekly average 30-year fixed mortgage rate in percentage points based on the Primary Mortgage Market Survey. Note: I work on the survey but the reflections here only represent my own views.
Time aggregations with tibbletime
Now that we have our data, let’s use tibbletime to wrangle a bit.
df <- as_tbl_time(df,index=date) %>%
mutate(year=year(date),
decade=paste0(year -year %% 10,"'s") # make decade variable
)
# summarize by month:
df.month <-
df %>% time_summarise(period = 1~m,
price=mean(price))
# summarize by year:
df.year<-
df %>% time_summarise(period = 1~y,
price=mean(price))
# summarize by decade:
df.d<-
df %>% mutate(d2=date) %>%
time_summarise(period = 10~y,
price=mean(price),
range=paste(year(min(d2)),year(max(d2)),sep="-"),
start_date="1970-01-01")
knitr::kable(df.d %>% mutate_if(is.numeric,round,2))| date | price | range |
|---|---|---|
| 1979-12-28 | 8.90 | 1971-1979 |
| 1989-12-29 | 12.71 | 1980-1989 |
| 1999-12-31 | 8.12 | 1990-1999 |
| 2009-12-31 | 6.29 | 2000-2009 |
| 2017-10-19 | 4.06 | 2010-2017 |
Dark theme
Let’s set up our dark theme:
extrafont::loadfonts(device="win") # needed for fonts (on windows, not sure about unix/mac)
theme_dark2 = function(base_size = 10, base_family = "Courier New") {
theme_grey(base_size = base_size, base_family = base_family) %+replace%
theme(
# Specify axis options
axis.line = element_blank(),
axis.text.x = element_text(size = base_size*0.8, color = "white", lineheight = 0.9),
axis.text.y = element_text(size = base_size*0.8, color = "white", lineheight = 0.9),
axis.ticks = element_line(color = "white", size = 0.2),
axis.title.x = element_text(size = base_size, color = "white", margin = margin(0, 10, 0, 0)),
axis.title.y = element_text(size = base_size, color = "white", angle = 90, margin = margin(0, 10, 0, 0)),
axis.ticks.length = unit(0.3, "lines"),
# Specify legend options
legend.background = element_rect(color = NA, fill = " gray10"),
legend.key = element_rect(color = "white", fill = " gray10"),
legend.key.size = unit(1.2, "lines"),
legend.key.height = NULL,
legend.key.width = NULL,
legend.text = element_text(size = base_size*0.8, color = "white"),
legend.title = element_text(size = base_size*0.8, face = "bold", hjust = 0, color = "white"),
legend.position = "none",
legend.text.align = NULL,
legend.title.align = NULL,
legend.direction = "vertical",
legend.box = NULL,
# Specify panel options
panel.background = element_rect(fill = " gray10", color = NA),
#panel.border = element_rect(fill = NA, color = "white"),
panel.border = element_blank(),
panel.grid.major = element_line(color = "grey35"),
panel.grid.minor = element_line(color = "grey20"),
panel.spacing = unit(0.5, "lines"),
# Specify facetting options
strip.background = element_rect(fill = "grey30", color = "grey10"),
strip.text.x = element_text(size = base_size*0.8, color = "white"),
strip.text.y = element_text(size = base_size*0.8, color = "white",angle = -90),
# Specify plot options
plot.background = element_rect(color = " gray10", fill = " gray10"),
plot.title = element_text(size = base_size*1.2, color = "white",hjust=0,lineheight=1.25,
margin=margin(2,2,2,2)),
plot.subtitle = element_text(size = base_size*1, color = "white",hjust=0, margin=margin(2,2,2,2)),
plot.caption = element_text(size = base_size*0.8, color = "white",hjust=0),
plot.margin = unit(rep(1, 4), "lines")
)
}Now let’s make some simple bar charts.
ggplot(data=df.month, aes(x=date,y=price,fill=price))+
geom_col()+
scale_fill_viridis(option="C")+
theme_dark2()+
labs(x="",y="",title="U.S. monthly average 30-year fixed mortgage rate (%)",
caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey through Oct 19, 2017")
ggplot(data=df.year, aes(x=date,y=price,fill=price,label=round(price,1)))+
geom_col()+
scale_fill_viridis(option="C")+
theme_dark2()+
labs(x="",y="",title="U.S. yearly average 30-year fixed mortgage rate (%)",
caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey through Oct 19, 2017")
ggplot(data=df.d, aes(x=range,y=price,fill=price,label=round(price,1)))+
geom_col()+
geom_text(color="white",size=6,vjust=0.9)+
scale_fill_viridis(option="C")+
theme_dark2()+
labs(x="",y="",title="U.S. decade average 30-year fixed mortgage rate (%)",
caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey through Oct 19, 2017")
We might also be interested in comparing the distribution of weekly rates by year or decade. Let’s do that with a more complex plot:
# Compare distributions
g.box<-
ggplot(data=df, aes(x=decade,y=price,color=price))+
geom_quasirandom(size=1,alpha=0.5)+
geom_boxplot(color="white",fill=NA)+
guides(color=F)+
scale_color_viridis(option="C")+
theme_dark2()+
labs(x="By Decade",y="30-year fixed mortgage rate (%)",
title="\n")
g.box2<-
ggplot(data=df, aes(x=year,y=price,color=price,group=year))+
geom_quasirandom(size=1.2,alpha=0.75)+
geom_boxplot(color="gray",fill=NA)+
guides(color=F)+
scale_color_viridis(option="C")+
theme_dark2()+
labs(x="By Year",y="30-year fixed mortgage rate (%)",
title="30-year fixed mortgage rates")
g.line<-
ggplot(data=df, aes(x=date,y=price,color=price,group=year,fill=price))+
geom_point(size=1.5,color="gray",alpha=0.25,shape=21)+
geom_path(size=1.1)+
guides(color=F)+
scale_color_viridis(option="C")+
scale_fill_viridis(option="C",name="Rate (%)")+
theme_dark2()+
scale_x_date(date_breaks="5 years",date_labels="%Y")+
labs(x="By Week",y="30-year fixed mortgage rate (%)",
caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey")+
theme(legend.position="none",plot.caption=element_text(hjust=0))
plot_grid(plot_grid(g.box2,g.box),g.line,ncol=1)
A spooky plot
How about if we want our spooky plot? We just have to run the following. Note we can use the time-based filtering tools from tibbletime to subset our data easiy. These utitlity functions have already saved me a lot of typing.
ggplot(data=df[2015~2017], aes(x=date,y=price,fill=price))+
geom_point(data=df[2015~2017],size=2,color="gray",alpha=0.5,shape=21,fill="orange")+
geom_line(color="orange",size=0.5)+
#geom_step(color="orange", size=1.1)+
theme_dark2(base_family="Chiller",base_size=20)+
labs(x="", y="",
title="30-year Fixed Mortgage Rate (%)",
subtitle="U.S. weekly average rates",
caption="@lenkiefer Source: Freddie Mac Primary Mortgage Market Survey")+
theme(plot.title=element_text(color="orange",face="bold",family="Chiller",size=24),
panel.border=element_blank(),
plot.subtitle=element_text(color="orange",face="italic",family="Chiller",size=20),
plot.caption=element_text(hjust=0,size=18))