---
title: "Housing Market at a Glance"
format:
dashboard:
theme: [litera, custom-A.scss]
orientation: columns
mainfont: sans-serif
logo: logo.png
---
```{r}
#| label: setup
#| include: false
# import packages
library(tidyverse)
library(scales)
library(ggiraph)
library(sf)
library(tigris)
library(gt)
library(geofacet)
library(colorspace)
options(tigris_use_cache = TRUE)
# set default ggplot2 theme
theme_set(theme_minimal(base_family = "Atkinson Hyperlegible"))
# import weekly mortgage interest rates
mortgages <- read_csv("data/weekly_mortgage_rates.csv") |>
# clean columns for consistency
mutate(
fixed_30 = fixed_30 / 100,
fixed_15 = fixed_15 / 100
) |>
select(date, fixed_30, fixed_15)
# import median sale price and income gap
median_housing <- read_csv("data/price_to_income.csv")
# import mortgage origination rate
origin <- read_csv("data/mortgage-origination-state.csv")
# join with states sf data frame for mapping
origin_sf <- states() |>
shift_geometry() |>
filter(STUSPS %in% state.abb) |>
left_join(y = origin)
```
```{r}
#| label: create-graphs
#| include: false
# mortgage rates over time
mortgage_p <- mortgages |>
pivot_longer(
cols = starts_with("fixed"),
names_to = "type",
values_to = "rate"
) |>
mutate(
type = recode_values(
x = type,
"fixed_30" ~ "Fixed 30-year",
"fixed_15" ~ "Fixed 15-year"
),
tooltip = str_glue(
"Date: {label_date(format = '%B %d, %Y')(date)}<br>Rate: {label_percent(accuracy = 0.1)(rate)}<br>Type: {type}"
)
) |>
ggplot(mapping = aes(x = date, y = rate, color = type, group = type)) +
# keep the line static but add interactive points for tooltips
geom_line() +
geom_point_interactive(
mapping = aes(tooltip = tooltip, data_id = type),
# make the points invisible to avoid cluttering the graph, but still show tooltips on hover
size = 2,
alpha = 0
) +
scale_y_continuous(labels = label_percent()) +
scale_color_viridis_d(end = 0.8, guide = guide_legend(reverse = TRUE)) +
labs(
x = NULL,
y = NULL,
color = NULL
) +
theme(legend.position = "top")
# mortgage origination by state over time using geofacet
origin_state <- origin |>
mutate(
tooltip = str_glue(
"{NAME}: {label_date_short()(date)}<br>Mortgages originated per 1,000 residents: {label_comma(accuracy = 0.1)(mort_adj)}"
)
) |>
ggplot(mapping = aes(x = date, y = mort_adj)) +
# keep the line static but add interactive points for tooltips
geom_line() +
geom_point_interactive(
mapping = aes(tooltip = tooltip, data_id = NAME),
# make the points invisible to avoid cluttering the graph, but still show tooltips on hover
size = 2,
alpha = 0
) +
scale_x_continuous(breaks = c(2000, 2020), labels = c("'00", "'20")) +
scale_y_continuous(breaks = c(15, 30)) +
facet_geo(facets = vars(NAME), labeller = label_wrap_gen(width = 15)) +
labs(
subtitle = "Mortgages originated per 1,000 residents",
x = NULL,
y = NULL
) +
theme(
strip.text = element_text(size = rel(0.6))
)
# mortgage origination by state - ggplot2 and sf map
origin_map <- origin_sf |>
filter(date == max(date)) |>
ggplot(mapping = aes(fill = mort_adj)) +
geom_sf_interactive(
mapping = aes(
tooltip = str_glue(
"{NAME}: {label_number(accuracy = 0.1)(mort_adj)} per thousand residents"
)
)
) +
scale_fill_continuous_sequential(
palette = "viridis",
labels = label_comma(accuracy = 0.1),
rev = FALSE
) +
labs(
subtitle = "Mortgages originated per 1,000 residents",
fill = NULL
) +
theme(
panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank()
)
# median home prices
median_home_p <- median_housing |>
drop_na() |>
mutate(
tooltip_house = str_glue(
"Year: {label_date_short()(date)}<br>Median home sales price: {label_currency(accuracy = 1)(med_sales_price)}<br>Price-to-income ratio: {label_comma(accuracy = 0.1)(price_to_income)}"
),
tooltip_inc = str_glue(
"Year: {label_date_short()(date)}<br>Median household income: {label_currency(accuracy = 1)(med_income)}<br>Price-to-income ratio: {label_comma(accuracy = 0.1)(price_to_income)}"
)
) |>
ggplot(mapping = aes(x = date)) +
# housing price
geom_line(
mapping = aes(
y = med_sales_price,
color = "sales_price",
group = 1
)
) +
geom_point_interactive(
mapping = aes(
y = med_sales_price,
color = "sales_price",
tooltip = tooltip_house
),
size = 3
) +
# median income
geom_line(
mapping = aes(
y = med_income,
color = "income",
group = 1
)
) +
geom_point_interactive(
mapping = aes(
y = med_income,
color = "income",
tooltip = tooltip_inc
),
size = 3
) +
scale_y_continuous(labels = label_currency(scale_cut = cut_short_scale())) +
scale_color_discrete_qualitative(
labels = c(
"sales_price" = "Median Home Sales Price",
"income" = "Median Household Income"
),
guide = guide_legend(reverse = TRUE)
) +
labs(
x = NULL,
y = NULL,
color = NULL
) +
theme(legend.position = "top")
```
# Stats
## Column {width="20%"}
```{r}
#| include: false
# get most recent records for mortgage rates and home sale prices
last_row <- slice_tail(mortgages, n = 1)
last_home_price <- slice_tail(median_housing, n = 1)
```
```{r}
#| content: valuebox
#| title: !expr str_glue('Average annual rate for a 30-year fixed mortgage in {last_row |> pull(date) |> format(format = "%b. %Y")}')
#| icon: house-door
#| color: info
list(
value = label_percent(accuracy = 0.1)(last_row |> pull(fixed_30))
)
```
```{r}
#| content: valuebox
#| title: !expr str_glue('Average annual rate for a 15-year fixed mortgage in {last_row |> pull(date) |> format(format = "%b. %Y")}')
#| icon: house-door
#| color: info
list(
value = label_percent(accuracy = 0.1)(last_row |> pull(fixed_15))
)
```
```{r}
#| content: valuebox
#| title: !expr str_glue('National median home price in {last_home_price |> pull(date) |> format(format = "%b. %Y")}')
#| icon: currency-dollar
#| color: info
list(
value = label_currency(scale_cut = cut_short_scale())(
last_home_price |> pull(med_sales_price)
)
)
```
## Column
### Row {.tabset}
```{r}
#| title: "Mortgage Originations per Capita"
girafe(ggobj = origin_map)
```
```{r}
#| title: "Mortgage Originations Over Time"
girafe(ggobj = origin_state)
```
### Row
```{r}
#| title: Mortgage Interest Rates
# formatted table of weekly mortgage rates
mortgages |>
gt() |>
cols_label(
date = "Date",
fixed_30 = "Fixed 30-year rate",
fixed_15 = "Fixed 15-year rate"
) |>
fmt_percent(
columns = starts_with("fixed")
) |>
fmt_date(
columns = date,
date_style = "month_day_year"
) |>
sub_missing() |>
opt_interactive(
use_search = TRUE,
use_compact_mode = TRUE,
pagination_type = "jump"
)
```
## Column
```{r}
#| title: "Interest Rates 15- and 30-Year"
# interest rates
girafe(mortgage_p)
```
```{r}
#| title: "Price-to-income ratio for home purchases"
# income-housing gap
girafe(median_home_p)
```
# Data
- [Mortgage Interest Rates 15- and 30-Year](https://www.nahb.org/news-and-economics/housing-economics/national-statistics/weekly-mortgage-rates-15-and-30-year)
- [Median Home Prices](https://fred.stlouisfed.org/series/MSPUS)
- [Median Household Income](https://fred.stlouisfed.org/series/MEHOINUSA646N)