library(here) # manage file paths
library(socviz) # data and some useful functions
library(tidyverse) # your friend and mine
library(maps) # Some basic maps
library(ggforce) # ggplot extensions09 — Maps and Spatial Data
March 8, 2024
State-level; vote share; diverging; binned into four categories.
County level; winner only
County level vote share; diverging; binned into six categories
County level vote share; diverging continuous; purple midpoint
County level vote share; purple midpoint; county area deformed in proportion to population. By Mark Newman
Electoral college cartogram (NYT)
Pretty, Big, and Pretty Empty
Pretty, Big, and Pretty Empty
Aside: What the hell’s that?
Zoom and Enhance
Suprisingly, not a coding error on my part.
It’s the Transcontinental Railroad
Making its way through the Great Basin, America’s largest endorheic watershed. The checkerboard is a deliberate assignation of property rights along the borders of the railway line.
Still with us, too
Not identical, as Interstate 80 was able to go through some parts the railroad had to go around. OK, now back to scheduled programming.
Like this, with geom_polygon()
us_states |>
ggplot(mapping = aes(x = long,
y = lat,
group = group)) +
geom_polygon(fill = "white",
color = "black") +
labs(title = "This looks horrible")
We can show a fill, too, like any geom
us_states |>
ggplot(mapping = aes(x = long,
y = lat,
fill = region,
group = group)) +
geom_polygon(color = "black") +
guides(fill = "none") +
labs(title = "Still looks horrible",
caption = "Set fill = none
to stop ggplot from
producing a key
with 50 entries")
Fix the projection
us_states <- as_tibble(map_data("state"))
us_states |>
ggplot(mapping = aes(x = long,
y = lat,
fill = region,
group = group))
Fix the projection
us_states <- as_tibble(map_data("state"))
us_states |>
ggplot(mapping = aes(x = long,
y = lat,
fill = region,
group = group)) +
geom_polygon(color = "black")
Fix the projection
us_states <- as_tibble(map_data("state"))
us_states |>
ggplot(mapping = aes(x = long,
y = lat,
fill = region,
group = group)) +
geom_polygon(color = "black") +
guides(fill = "none")
Fix the projection
us_states <- as_tibble(map_data("state"))
us_states |>
ggplot(mapping = aes(x = long,
y = lat,
fill = region,
group = group)) +
geom_polygon(color = "black") +
guides(fill = "none") +
coord_map(projection = "albers",
lat0 = 39,
lat1 = 45)
U.S. Map Projections
A selection of projections
U.S. Map Projections
Albers is the standard
- Our U.S. Map again, now transformed
Choropleths
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = party,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
guides(fill = "none")
Add the theme function at the end
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = party,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
theme_map()
Fix the Party Colors
## Hex color codes for Democratic Blue and Republican Red
party_colors <- c("#2E74C0", "#CB454A")
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = party,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
scale_fill_manual(values = party_colors) +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
theme_map()
Continuous measures are gradients
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = pct_trump,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
labs(title = "Trump vote",
fill = "Percent") +
theme_map()
Fix the gradient with a scale function
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = pct_trump,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
scale_fill_gradient(low = "white",
high = "#CB454A") +
labs(title = "Trump vote") +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
labs(title = "Trump vote",
fill = "Percent") +
theme_map()
Some gradients are diverging
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = d_points,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
scale_fill_gradient2() +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
labs(title = "Winning Margins",
fill = "Percent") +
theme_map()
Purple America Map
us_states_elec |>
ggplot(mapping = aes(x = long,
y = lat,
fill = d_points,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
scale_fill_gradient2(low = "red",
mid = scales::muted("purple"),
high = "blue",
breaks = c(-25, 0, 25,
50, 75)) +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
labs(title = "Winning Margins",
fill = "Percent") +
theme_map()
Take a closer look at this, though.
Washington, DC
Purple America Map, without DC
us_states_elec |>
filter(region %nin% "district of columbia") |>
ggplot(mapping = aes(x = long,
y = lat,
fill = d_points,
group = group)) +
geom_polygon(color = "gray90",
size = 0.1) +
scale_fill_gradient2(low = "red",
mid = scales::muted("purple"),
high = "blue") +
coord_map(projection = "albers",
lat0 = 39, lat1 = 45) +
labs(title = "Winning Margins",
fill = "Percent") +
theme_map()
More balanced.
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group))
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1)
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed()
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Blues",
labels = c("0-10", "10-50", "50-100",
"100-500", "500-1,000",
"1,000-5,000", ">5,000"))
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Blues",
labels = c("0-10", "10-50", "50-100",
"100-500", "500-1,000",
"1,000-5,000", ">5,000")) +
labs(fill = "Population per\nsquare mile")
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Blues",
labels = c("0-10", "10-50", "50-100",
"100-500", "500-1,000",
"1,000-5,000", ">5,000")) +
labs(fill = "Population per\nsquare mile") +
kjhslides::kjh_theme_map()
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Blues",
labels = c("0-10", "10-50", "50-100",
"100-500", "500-1,000",
"1,000-5,000", ">5,000")) +
labs(fill = "Population per\nsquare mile") +
kjhslides::kjh_theme_map() +
guides(fill = guide_legend(nrow = 1))
County Population Density
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pop_dens,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Blues",
labels = c("0-10", "10-50", "50-100",
"100-500", "500-1,000",
"1,000-5,000", ">5,000")) +
labs(fill = "Population per\nsquare mile") +
kjhslides::kjh_theme_map() +
guides(fill = guide_legend(nrow = 1)) +
theme(legend.position = "bottom")
Population Density by County, binned
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group))
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1)
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed()
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Greens",
labels = c("0-2%", "2-5%", "5-10%",
"10-15%", "15-25%",
"25-50%", ">50%"))
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Greens",
labels = c("0-2%", "2-5%", "5-10%",
"10-15%", "15-25%",
"25-50%", ">50%")) +
labs(fill = "US Population, percent Black")
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Greens",
labels = c("0-2%", "2-5%", "5-10%",
"10-15%", "15-25%",
"25-50%", ">50%")) +
labs(fill = "US Population, percent Black") +
kjhslides::kjh_theme_map()
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Greens",
labels = c("0-2%", "2-5%", "5-10%",
"10-15%", "15-25%",
"25-50%", ">50%")) +
labs(fill = "US Population, percent Black") +
kjhslides::kjh_theme_map() +
guides(fill = guide_legend(nrow = 1))
Same again for Percent Black
county_full <- as_tibble(left_join(county_map, county_data, by = "id"))
county_full |>
ggplot(mapping = aes(x = long, y = lat,
fill = pct_black,
group = group)) +
geom_polygon(color = "gray70",
size = 0.1) +
coord_fixed() +
scale_fill_brewer(palette="Greens",
labels = c("0-2%", "2-5%", "5-10%",
"10-15%", "15-25%",
"25-50%", ">50%")) +
labs(fill = "US Population, percent Black") +
kjhslides::kjh_theme_map() +
guides(fill = guide_legend(nrow = 1)) +
theme(legend.position = "bottom")
Percent Black, by County, binned
Example: Reverse coding
Regular palette
Reverse-coded density
Comparison
Faceting works just as it would for any other kind of plot.
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted))
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50")
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50") +
geom_smooth(aes(group = region),
se = FALSE)
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50") +
geom_smooth(aes(group = region),
se = FALSE) +
ggrepel::geom_text_repel(
data = st_top,
mapping = aes(x = year,
y = adjusted,
label = abbr),
size = 3,
segment.color = NA,
nudge_x = 0.5)
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50") +
geom_smooth(aes(group = region),
se = FALSE) +
ggrepel::geom_text_repel(
data = st_top,
mapping = aes(x = year,
y = adjusted,
label = abbr),
size = 3,
segment.color = NA,
nudge_x = 0.5) +
coord_cartesian(c(min(opiates$year),
max(opiates$year) + 1))
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50") +
geom_smooth(aes(group = region),
se = FALSE) +
ggrepel::geom_text_repel(
data = st_top,
mapping = aes(x = year,
y = adjusted,
label = abbr),
size = 3,
segment.color = NA,
nudge_x = 0.5) +
coord_cartesian(c(min(opiates$year),
max(opiates$year) + 1)) +
labs(x = NULL,
y = "Rate per 100,000 population",
title = "State-Level Opiate Death
Rates by Region, 1999-2014")
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50") +
geom_smooth(aes(group = region),
se = FALSE) +
ggrepel::geom_text_repel(
data = st_top,
mapping = aes(x = year,
y = adjusted,
label = abbr),
size = 3,
segment.color = NA,
nudge_x = 0.5) +
coord_cartesian(c(min(opiates$year),
max(opiates$year) + 1)) +
labs(x = NULL,
y = "Rate per 100,000 population",
title = "State-Level Opiate Death
Rates by Region, 1999-2014") +
facet_wrap(~ reorder(region, adjusted,
na.rm = TRUE),
nrow = 1)
Opiates Time Series plot
st_top <- opiates |> filter(year == max(year), abbr != "DC") |>
group_by(region) |>
slice_max(order_by = adjusted, n = 2)
opiates |>
ggplot(aes(x = year,
y = adjusted)) +
geom_line(aes(group = state),
color = "gray50") +
geom_smooth(aes(group = region),
se = FALSE) +
ggrepel::geom_text_repel(
data = st_top,
mapping = aes(x = year,
y = adjusted,
label = abbr),
size = 3,
segment.color = NA,
nudge_x = 0.5) +
coord_cartesian(c(min(opiates$year),
max(opiates$year) + 1)) +
labs(x = NULL,
y = "Rate per 100,000 population",
title = "State-Level Opiate Death
Rates by Region, 1999-2014") +
facet_wrap(~ reorder(region, adjusted,
na.rm = TRUE),
nrow = 1)
Regional trends in opiate-related mortality.