housing-market-index-2025.md

rlang::check_required(c(
  "patchwork",
  "readxl",
  "tidyverse",
  "pak",
  "showtext",
  "systemfonts",
  "sysfonts"
))
pak::pak("jrosell/ggdark") # forked to fix some issues
#> ℹ Loading metadata database
#> ✔ Loading metadata database ... done
#> 
#> 
#> 
#> ℹ No downloads are needed
#> ✔ 1 pkg + 16 deps: kept 16 [4.7s]

library(tidyverse)
library(patchwork)
library(ggdark)
library(showtext)
#> Loading required package: sysfonts
#> Loading required package: showtextdb

path_font <- systemfonts::system_fonts() |>
  dplyr::filter(grepl("Roboto", family)) |>
  dplyr::filter(grepl("/Roboto-Regular.ttf", path)) |>
  pull(path) |>
  head(1)
if (length(path_font) == 0) {
  rlang::abort("Install Roboto font.")
}

sysfonts::font_add("Roboto", regular = path_font)
showtext::showtext_auto()

# 1. We download the "Table 2: NAHB/Wells Fargo National HMI – History" from https://www.nahb.org/news-and-economics/housing-economics/indices/housing-market-index
file_url <- "https://www.nahb.org/-/media/NAHB/news-and-economics/docs/housing-economics/hmi/2025-08/t2-national-hmi-history-202508.xls?rev=d0b42e2331d5449a8b9aae6460a9b4b2&hash=DEB3C8761740C02CACB12150D9E18009"
# Backup: file_url <- ""https://github.com/jrosell/tidy-data/raw/refs/heads/master/data/t2-national-hmi-history-202508.xls""
tmp_file <- tempfile(fileext = ".xls")
download.file(
  url = file_url,
  destfile = tmp_file,
  mode = "wb"
)
# 2. We prepared the data for the plot.
df <- readxl::read_excel(tmp_file, skip = 2) |>
  rename("Year" = 1) |>
  pivot_longer(-Year, values_to = "hmi", names_to = "month") |>
  transmute(date = anytime::anydate(paste0(Year, " ", month)), hmi) |>
  mutate(
    dash_text = if_else(
      date == anytime::anydate("2025-08-01"),
      paste0(date, ": ", hmi),
      ""
    ),
    dash_hmi = hmi[date == anytime::anydate("2025-08-01")],
  ) |>
  filter(!is.na(hmi)) |>
  glimpse()
#> New names:
#> • `` -> `...1`
#> Rows: 488
#> Columns: 4
#> $ date      <date> 1985-01-01, 1985-02-01, 1985-03-01, 1985-04-01, 1985-05-01,…
#> $ hmi       <dbl> 50, 58, 54, 49, 51, 54, 58, 58, 56, 59, 58, 57, 57, 55, 57, …
#> $ dash_text <chr> "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", …
#> $ dash_hmi  <dbl> 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, …

gradient <- c("#356CA0", "#3E8E5E", "#BFAF44", "#C77638", "#A12D2D")

# 3. We build the plot.
p1 <- df |>
  ggplot() +
  geom_linerange(
    aes(x = date, ymin = hmi, ymax = 50, color = hmi),
    linewidth = 1.07
  ) +
  geom_hline(aes(yintercept = dash_hmi), linetype = 2, color = "white") +
  geom_text(
    aes(x = as.Date("2017-01-01"), y = 35, label = dash_text),
    color = "white"
  ) +
  theme_dark() +
  dark_theme_minimal() +
  labs(
    title = "Housing Market Index",
    subtitle = "Values >50 Indicate positive sentiment",
    x = ""
  ) +
  theme(
    legend.position = "bottom",
    legend.box = "horizontal",
    legend.title = element_text(margin = margin(r = 50)),
    plot.title = element_text(size = 24),
    axis.title.y = element_blank(),
    text = element_text(family = "Roboto"),
    plot.background = element_rect(fill = "black", color = NA)
  ) +
  scale_color_gradientn(
    colours = gradient,
    name = "Housing Market Index (>50 indicates positive sentiment)"
  ) +
  list()
p2 <- df |>
  ggplot() +
  geom_tile(aes(x = date, y = 1, fill = hmi, color = hmi)) +
  dark_theme_minimal() +
  theme(
    legend.position = "none",
    axis.title = element_blank(),
    axis.text.y = element_blank(),
    text = element_text(family = "Roboto"),
    plot.background = element_rect(fill = "black", color = NA)
  ) +
  scale_fill_gradientn(colors = gradient) +
  scale_color_gradientn(colors = gradient) +
  list()

p <- p1 / p2 + plot_layout(heights = c(5, 1))

# 4. We save and print the plot.

output_file <- "hmi.png"
output_file |>
  ggsave(
    plot = p,
    width = 297,
    height = 210,
    units = "mm",
    dpi = 72
  )
output_file |>
  png::readPNG() |>
  grid::grid.raster()

^{Created on 2025-09-16 with reprex v2.1.1.9000}