Housing market at a glance

We will create a dashboard to visualize the housing market in the United States. We will use data on mortgage rates, household income, and mortgage origination rates.

Revisions to the dashboard

Your turn:

• Examine the structure of the dashboard. What are the major components? How are the graphs defined? The table? The valueboxes?
• Test out the static {ggplot2} charts in the dashboard. How effective are they? Do they look good at different browser window sizes? Can you change the figure dimensions to improve the readability?
• Adjust the dashboard to use a sans-serif font for the plots. Make that the default font for the dashboard.¹
• Which chart is more useful in the context of the dashboard: mortgage origination rates by state over time, or the map of mortgage origination rates by state for 2024? Why?
• Convert the {ggplot2} plots to {ggiraph} interactive plots. Make sure to adjust the {ggiraph} output as necessary to leverage the interactivity effectively. Update the tooltips so they all are directly usable by the reader.

Source code for the dashboard

Published dashboard

---
title: "Housing Market at a Glance"
format: 
  dashboard:
    theme: [litera, custom.scss]
    orientation: columns
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())

# 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)) +
  geom_line() +
  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 |>
  ggplot(mapping = aes(x = date, y = mort_adj)) +
  geom_line() +
  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() +
  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() |>
  ggplot(mapping = aes(x = date)) +
  # housing price
  geom_line(
    mapping = aes(
      y = med_sales_price,
      color = "sales_price",
      group = 1
    )
  ) +
  # median income
  geom_line(
    mapping = aes(
      y = med_income,
      color = "income",
      group = 1
    )
  ) +
  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"

origin_map
```

```{r}
#| title: "Mortgage Originations Over Time"

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
mortgage_p
```

```{r}
#| title: "Price-to-income ratio for home purchases"

# income-housing gap
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)

Acknowledgments

• Housing market dashboard is adapted from Housing Market at a Glance by Isabella Velásquez.

Footnotes

1. This should be applied whenever the dashboard uses a sans-serif font. You will still see the default serif font for items such as the value cards, but also feel free to try and change it.