We will create a dashboard to visualize the housing market in the United States. We will use data on mortgage rates, housing opportunity index, and mortgage origination rates.
Revisions to the dashboard
Your turn:
Source code for the final dashboard
---title: "Housing Market at a Glance"format: dashboard: theme: [litera, custom.scss] orientation: columnslogo: logo.png---```{r}#| label: setup#| include: false# import packageslibrary(tidyverse)library(scales)library(plotly)library(sf)library(tigris)library(gt)library(geofacet)# set default ggplot2 themetheme_set(theme_minimal(base_family = "Atkinson Hyperlegible", base_size = 14))# import weekly mortgage interest ratesmortgages <- 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 pricemedian_housing <- read_csv("data/median-housing.csv") |> # clean columns for consistency mutate(DATE = mdy(DATE)) |> rename( date = DATE, price = MSPUS )# import housing opportunity indexhoi <- read_csv("data/hoi.csv") |> arrange(date) |> # clean columns for consistency mutate( hoi = hoi / 100, median_price = median_price * 1000 )# import mortgage origination rateorigin <- read_csv("data/mortgage-origination-state.csv")# join with states sf data frame for mappingorigin_sf <- states() |> shift_geometry() |> filter(STUSPS %in% state.abb) |> left_join(y = origin)``````{r}#| label: create-graphs#| include: false# mortgage rates over timemortgage_p <- mortgages |> pivot_longer( cols = starts_with("fixed"), names_to = "type", values_to = "rate" ) |> mutate( type = case_match( .x = type, "fixed_30" ~ "Fixed 30-year", "fixed_15" ~ "Fixed 15-year" ), tooltip = str_glue("Date: {date}<br>Rate: {label_percent(accuracy = 0.1)(rate)}<br>Type: {type}") ) |> ggplot(mapping = aes(x = date, y = rate, color = type)) + geom_line(mapping = aes(text = tooltip, group = type)) + scale_y_continuous(labels = label_percent()) + scale_color_viridis_d(end = 0.8, guide = guide_legend(reverse = TRUE)) + labs( title = "Interest Rates 15- and 30-Year", x = NULL, y = NULL, color = NULL ) + theme(legend.position = "top")# housing opportunity indexhoi_p <- hoi |> mutate(tooltip = str_glue("Date: {date}<br>HOI: {label_percent(accuracy = 0.1)(hoi)}")) |> ggplot(mapping = aes(x = date, y = hoi)) + geom_line(mapping = aes(text = tooltip, group = 1)) + scale_y_continuous(labels = label_percent()) + labs( title = "Housing Opportunity Index", subtitle = "Percentage of homes affordable to median-income families", x = NULL, y = NULL )# mortgage origination by state over time using geofacetorigin_state <- ggplot(data = origin, mapping = aes(x = date, y = mort_adj)) + geom_line() + scale_x_continuous(breaks = c(2000, 2020), labels = c("'00", "'20")) + facet_geo(facets = vars(NAME), labeller = label_wrap_gen(width = 15)) + labs( title = "Mortgage Originations per Capita", 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 maporigin_map <- origin_sf |> filter(date == max(date)) |> ggplot(mapping = aes(fill = mort_adj)) + geom_sf() + scale_fill_viridis_c(labels = label_percent()) + labs( title = "Mortgage Originations per Capita", subtitle = "Mortgages originated per 1,000 residents" )# mortgage origination by state - plotly maporigin_map_plotly <- origin |> # add hover text strings mutate(hover = str_glue("{NAME}: {label_number(accuracy = 0.1)(mort_adj)} per thousand residents in {date}")) |> # use built-in geographic data plot_geo(locationmode = "USA-states") |> # add choropleth layer add_trace( # type of chart type = "choropleth", # 2 letter abbreviations for each state locations = ~STUSPS, # variable to use for color shading z = ~mort_adj, # variable to use for animation frame = ~date, # tooltip text text = ~hover, # type of info to use for tooltip hover hoverinfo = "text", # choose a color scale colorscale = "Viridis", # fix the minimum and maximum of the colorbar to the entire time period zmin = min(origin$mort_adj), zmax = max(origin$mort_adj), # no separate borders between states marker = list(line = list( width = 0 )) ) |> # set layout options layout( # plot title title = "Mortgage Originations per Capita<br>Mortgages originated per thousand residents", # geographic info geo = list( scope = "usa", projection = list(type = "albers usa") ), # adjust font to match rest of site font = list( family = "Atkinson Hyperlegible" ) ) |> colorbar(title = "") |> # animation options animation_opts( # frame duration in milliseconds frame = 1000, ) |> animation_slider( currentvalue = list(prefix = "Year: ") )# median home pricesmedian_home_p <- median_housing |> mutate(tooltip = str_glue("Date: {date}<br>Price: {label_dollar()(price)}")) |> ggplot(mapping = aes(x = date, y = price)) + geom_line(mapping = aes(text = tooltip, group = 1)) + scale_y_continuous(labels = label_dollar(scale_cut = cut_short_scale())) + labs( title = "Median Home Prices", y = "Median Home Price\n(nominal)", x = NULL )```# Stats## Column {width="20%"}```{r}#| include: false# get most recent records for mortgage rates and home sale priceslast_row <- slice_tail(mortgages, n = 1)last_home_price <- slice_tail(hoi, 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: infolist( 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: infolist( 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: infolist( value = label_dollar(scale_cut = cut_short_scale())(last_home_price |> pull(median_price)))```## Column ```{r}#| title: "Mortgage Originations per Capita"#| height: 50%# plotly maporigin_map_plotly``````{r}#| title: Mortgage Interest Rates#| height: 50%# formatted table of weekly mortgage ratesmortgages |> 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 {.tabset width="40%"}```{r}#| title: "Housing Economics"# interest ratesmortgage_p |> # ensure correct column is used for tooltips ggplotly(tooltip = "text") |> # move legend - doesn't accept theme() values layout(legend = list(orientation = "v", x = 0.95, y = 0.95, traceorder = "reversed", xanchor = "right"))# housing opportunity indexggplotly(hoi_p, tooltip = "text")``````{r}#| title: "Median Price"# median sales priceggplotly(median_home_p, tooltip = "text")```# 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)- [Housing Opportunity Index](https://www.nahb.org/news-and-economics/housing-economics/indices/housing-opportunity-index)- [Median Home Prices](https://fred.stlouisfed.org/series/MSPUS)