library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(lubridate)
library(ggpattern)
library(patchwork)
#Problem 1: Bar and Dots.
#Loading data set:
rent_data <- read.csv("https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/pew_fig2_class_rent_change.csv")
head(rent_data)
## metro class_a class_b class_c total
## 1 Austin -2.6 -5.9 -11.4 -7.0
## 2 Denver -2.2 -3.1 -7.6 -4.2
## 3 San Antonio -2.4 -4.2 -7.4 -4.6
## 4 Raleigh -1.5 -2.5 -5.8 -3.5
## 5 Dallas-Ft. Worth -0.9 -2.8 -5.5 -3.1
## 6 Salt Lake City 1.3 -2.0 -5.5 -2.0
#Bar diagram
ggplot(pivot_longer(rent_data, class_a:total,
names_to = "class", values_to = "rent"),
aes(metro, rent, fill = class)) +
geom_col(position = "dodge") +
geom_hline(yintercept = 0) +
labs(title = "Average rent change in 2023-2024 in the 11th largest cities") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
#Comment: The main perceptual visualization tasks used with this figure are comparison, ranking, and magnitude estimation. Within the same city, I can compare the lengths of the bars to determine differences in rent changes among building classes and rank the classes from largest to smallest change. Across cities, I can compare the same building class to identify which cities have the largest or smallest rent changes. I can also use pattern identification to observe overall trends across different cities and building classes.
#Cleveland Plot
rent_long <- pivot_longer(
rent_data,
class_a:total,
names_to = "class",
values_to = "rent"
)
ggplot(rent_long, aes(rent, reorder(metro, rent), color = class)) +
geom_vline(xintercept = 0) +
geom_point(size = 3) +
labs(
title = "Average Rent Change in 2023-2024 in the 11th Largest Cities",
x = "Rent Change (%)",
y = "City",
color = "Class"
) +
theme_minimal()
#Bar Plot onto multiple axes:
ggplot(rent_long, aes(reorder(metro, rent), rent, fill = class)) +
geom_col() +
geom_hline(yintercept = 0) +
facet_wrap(~class, ncol = 2) +
coord_flip() +
labs(
title = "Average Rent Change in 2023-2024 in the 11th Largest Cities",
x = "City",
y = "Rent Change (%)"
) +
theme_minimal() +
theme(legend.position = "none")
#Cleveland dot plot
#Pros:
#Uses less visual space than the original bar chart. #Makes it easier to compare rent changes between the different building classes. #The zero reference line makes it easy to see which cities had increases or decreases. #The dots are less visually cluttered than many side-by-side bars. #Easier to identify the highest and lowest rent changes.
#Cons:
#The original bar chart is more familiar and intuitive for many readers. #It can be harder to judge the exact value of a dot compared with the length of a bar. #With many cities and classes, the dots can overlap or become crowded. #The different classes rely on color, which may be difficult for some viewers.
#Split bar plots / multiple axes
#Pros:
#Each building class has its own panel, making the individual patterns easier to see. #Less cluttered than putting all classes into one chart. #Bars make increases and decreases visually obvious. #It is easier to see the range of values within each building class.
#Cons:
#Comparing the same city across different classes is more difficult because the classes are separated into different panels. #The reader has to move back and forth between panels. #It takes more space than the Cleveland dot plot. #If the panels use different scales, comparisons can be misleading; using the same scale is generally better for direct comparison.
#Compared with the original Figure:
#The original Figure is useful because it presents all the information together and uses familiar bars, but it can become crowded when comparing many cities and building classes. The Cleveland dot plot is more efficient for making comparisons, while the split bar plots provide a clearer view of each building class individually.
#Problem 2: Fixing a Bad Figure
msa = read_csv("https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/MSA_permits_demography.csv")
## Rows: 1887 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Region, State, region
## dbl (9): cbsa, year, population, units_total, units_1, units_5plus, n_struct...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
zori = read_csv("https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/zori_lab1.csv")
## Rows: 51924 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Region, City, State
## dbl (3): cbsa, SizeRank, zori
## date (1): date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Lets make a bad figure
raw <- zori |>
mutate(year = year(date)) |>
group_by(cbsa,Region,year) |>
summarise(zori = mean(zori,na.rm=TRUE),.groups="drop")
p1 = msa |> filter(year == 2025,
population > 100000) |>
arrange(units_total) |> rename(RegionName = Region) |> left_join(raw,by=c('cbsa','year')) |> head(10) |>
ggplot(aes(RegionName,zori)) +
geom_col_pattern(pattern = "image",
pattern_filename="https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/skyscraper.png",
pattern_type = 'tile') +
labs(title = "Low Permit Metros") +
coord_cartesian(ylim = c(750, 3500)) +
theme(axis.text.y = element_blank()) +
theme(axis.text.x = element_blank()) +
theme(text = element_text(family = "Lobster Two", size = 20),
plot.title = element_text(family = "Lobster Two", size = 30, colour = "#1A9850"),
panel.grid.major = element_line(colour = "#1A9850"),
panel.border = element_rect(colour = "#1A9850", fill = NA, linewidth = 1.5))
p2 = msa |> filter(year == 2025,
population > 100000) |>
arrange(desc(units_total)) |> rename(RegionName = Region) |> left_join(raw,by=c('cbsa','year')) |> head(10) |>
ggplot(aes(RegionName,zori)) +
geom_col_pattern(pattern = "image",
pattern_filename="https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/skyscraper.png",
pattern_type = 'tile') +
labs(title="High Permit Metros") +
coord_cartesian(ylim = c(750, 3500)) +
theme(axis.text.y = element_blank()) +
theme(axis.text.x = element_blank()) +
theme(text = element_text(family = "Roboto Condensed", size = 20),
plot.title = element_text(family = "Roboto Condensed", face="bold", size = 30, colour = "#A50026"),
panel.grid.major = element_line(colour = "#A50026"),
panel.border = element_rect(colour = "#A50026", fill = NA, linewidth = 1.5))
p1 + p2
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## not found in Windows font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## not found in Windows font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## not found in Windows font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, : font
## family not found in Windows font database
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
#The figure has several problems with both its design and analysis. First, it compares only the 10 lowest- and 10 highest-permit metros, ignoring most of the data. It uses total housing units permitted rather than a population-adjusted measure, which can favor larger metros. More importantly, the permit variable is not actually shown in the graph; the bars represent ZORI/rent, making the title potentially misleading. The y-axis is truncated at 750 rather than starting at zero, which exaggerates differences in a bar chart. The x- and y-axis labels are also hidden, making it difficult to identify the cities or understand the values. The skyscraper images, decorative fonts, bright colors, gridlines, and borders add unnecessary visual clutter. Finally, the figure provides no statistical analysis or controls for other factors that affect rents, so it cannot support a causal conclusion that permitting levels affect rents. Overall, the figure prioritizes visual decoration over clear and accurate communication of the data.
#2(b)
#I recommend 3 final figures, using the full metropolitan-area data set rather than selecting only 10 high- and 10 low-permit metros.
#Figure -1: Some metropolitan areas experienced sharp rent increases
msa <- read_csv(
"https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/MSA_permits_demography.csv",
show_col_types = FALSE
)
zori <- read_csv(
"https://raw.githubusercontent.com/georgehagstrom/DATA608Fall2026/main/website/assignments/stories/data/story_1/zori_lab1.csv",
show_col_types = FALSE
)
rent_growth <- zori |>
mutate(year = year(date)) |>
filter(year %in% c(2021, 2025)) |>
group_by(cbsa, Region, year) |>
summarise(
rent = mean(zori, na.rm = TRUE),
.groups = "drop"
) |>
pivot_wider(
names_from = year,
values_from = rent,
names_prefix = "rent_"
) |>
mutate(
rent_growth = (rent_2025 - rent_2021) / rent_2021 * 100
)
rent_growth |>
filter(is.finite(rent_growth)) |>
slice_max(rent_growth, n = 15) |>
ggplot(aes(rent_growth, reorder(Region, rent_growth))) +
geom_point(size = 3) +
geom_vline(xintercept = 0) +
labs(
title = "Rent growth remains a major affordability challenge",
subtitle = "15 metropolitan areas with the largest increases, 2021–2025",
x = "Rent growth (%)",
y = "Metropolitan area"
) +
theme_minimal()
#The 15 metropolitan areas with the largest rent increases between 2021
and 2025 are displayed. Williston, ND has the largest increase, at
roughly 57%. Oxford, MS follows at about 55%. The remaining metros shown
experienced rent growth of approximately 36%–45%. Importantly, all 15
metros experienced positive rent growth; none are near the zero
line.
#Figure 2 — Rent growth has been substantial in the fastest-growing metros
permit_data <- msa |>
filter(year %in% 2021:2025, population > 100000) |>
group_by(cbsa, Region) |>
summarise(
permits = sum(units_total, na.rm = TRUE),
population = mean(population, na.rm = TRUE),
.groups = "drop"
) |>
mutate(
permits_per_1000 = permits / population * 1000
)
story_data <- permit_data |>
left_join(rent_growth, by = "cbsa") |>
filter(
is.finite(permits_per_1000),
is.finite(rent_growth)
)
ggplot(story_data,
aes(permits_per_1000, rent_growth)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE) +
labs(
title = "More housing permits are associated with slower rent growth",
subtitle = "Cumulative permits per 1,000 residents, 2021–2025",
x = "Housing units permitted per 1,000 residents",
y = "Rent growth, 2021–2025 (%)"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
#Figure 2 showing Metropolitan areas adding more housing relative to their population tend to experience slower rent growth.
#Figure 3 - Housing supply needs to keep pace with housing demand
demand_data <- msa |>
filter(year %in% 2021:2025, population > 100000) |>
group_by(cbsa, Region) |>
summarise(
permits = sum(units_total, na.rm = TRUE),
migration = sum(migration, na.rm = TRUE),
population = mean(population, na.rm = TRUE),
.groups = "drop"
) |>
mutate(
permits_per_1000 = permits / population * 1000,
migration_per_1000 = migration / population * 1000
) |>
left_join(rent_growth, by = "cbsa") |>
filter(
is.finite(migration_per_1000),
is.finite(rent_growth),
is.finite(permits_per_1000)
)
ggplot(
demand_data,
aes(
migration_per_1000,
rent_growth,
size = permits_per_1000
)
) +
geom_point(alpha = 0.6) +
geom_smooth(
aes(group = 1),
method = "lm",
se = FALSE,
linewidth = 1
) +
labs(
title = "Housing supply needs to keep pace with housing demand",
subtitle = "Larger points represent more permitted housing per 1,000 residents",
x = "Net migration per 1,000 residents, 2021–2025",
y = "Rent growth, 2021–2025 (%)",
size = "Permits per 1,000"
) +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## `geom_smooth()` using formula = 'y ~ x'
## Warning: The following aesthetics were dropped during statistical transformation: size.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
#Housing supply needs to keep pace with housing demand.
#I designed these three figures to tell a policy-focused story about the relationship between housing construction and rent growth. The first figure establishes the problem by showing how much rent growth varied across metropolitan areas between 2021 and 2025. The second figure directly examines the relationship between housing construction and rent growth using cumulative housing permits per 1,000 residents rather than raw permit counts. This normalization makes metropolitan areas of different sizes more comparable. I use all metropolitan areas meeting the population threshold rather than selecting only the highest- and lowest-permit metros, avoiding the selective comparison used in the original figure.
#The third figure incorporates migration to show that housing supply must be considered relative to housing demand. Metropolitan areas experiencing population inflows may require more new housing simply to accommodate additional demand. The figures therefore tell a progression from the problem of rent growth, to the association between increased housing production and slower rent growth, and finally to the role of demand. I use direct titles and subtitles so that the figures communicate the story with minimal explanatory text. The analysis demonstrates an association rather than causation, so the results should be interpreted as evidence that permitting and housing production may help moderate rent growth, rather than proof that permitting alone causes rents to decline.