Map
## Source: https://rud.is/books/30-day-map-challenge/
library(tidyverse)
library(sf)
library(readxl)
library(hrbrthemes)
library(albersusa)
## url = "https://www2.census.gov/programs-surveys/demo/tables/metro-micro/2015/commuting-flows-2015/table1.xlsx"
setwd("C:/Users/subas/Downloads")
counties_sf() %>%
st_transform(us_laea_proj) -> cmap
read_excel("table1.xlsx", skip=6) %>%
janitor::clean_names() %>%
select(
start_state_fips = state_fips_code_1,
start_county_fips = county_fips_code_2,
start_state = state_name_3,
start_county = county_name_4,
end_state_fips = state_fips_code_5,
end_county_fips = county_fips_code_6,
end_state = state_name_7,
end_county = county_name_8,
workers = workers_in_commuting_flow,
moe = margin_of_error
) %>%
mutate(end_state_fips = gsub("^0", "", end_state_fips)) -> xdf
glimpse(xdf)
## Observations: 139,435
## Variables: 10
## $ start_state_fips <chr> "01", "01", "01", "01", "01", "01", "01", "01", "...
## $ start_county_fips <chr> "001", "001", "001", "001", "001", "001", "001", ...
## $ start_state <chr> "Alabama", "Alabama", "Alabama", "Alabama", "Alab...
## $ start_county <chr> "Autauga County", "Autauga County", "Autauga Coun...
## $ end_state_fips <chr> "01", "01", "01", "01", "01", "01", "01", "01", "...
## $ end_county_fips <chr> "001", "013", "021", "043", "047", "051", "053", ...
## $ end_state <chr> "Alabama", "Alabama", "Alabama", "Alabama", "Alab...
## $ end_county <chr> "Autauga County", "Butler County", "Chilton Count...
## $ workers <dbl> 8828, 6, 504, 27, 296, 2186, 14, 271, 8, 79, 97, ...
## $ moe <dbl> 752, 10, 228, 44, 130, 486, 23, 142, 16, 108, 68,...
filter(xdf, start_state == "Texas", end_state != "Texas") %>%
filter(start_county_fips != end_county_fips) %>%
mutate(
start_fips = glue::glue("{start_state_fips}{start_county_fips}") %>%
as.character() %>%
factor(levels = levels(cmap$fips)),
end_fips = glue::glue("{end_state_fips}{end_county_fips}") %>%
as.character() %>%
factor(levels = levels(cmap$fips))
) -> me_start
glimpse(me_start)
## Observations: 3,491
## Variables: 12
## $ start_state_fips <chr> "48", "48", "48", "48", "48", "48", "48", "48", "...
## $ start_county_fips <chr> "001", "001", "001", "001", "001", "001", "001", ...
## $ start_state <chr> "Texas", "Texas", "Texas", "Texas", "Texas", "Tex...
## $ start_county <chr> "Anderson County", "Anderson County", "Anderson C...
## $ end_state_fips <chr> "05", "22", "22", "28", "40", "40", "47", "35", "...
## $ end_county_fips <chr> "091", "015", "033", "089", "117", "143", "157", ...
## $ end_state <chr> "Arkansas", "Louisiana", "Louisiana", "Mississipp...
## $ end_county <chr> "Miller County", "Bossier Parish", "East Baton Ro...
## $ workers <dbl> 2, 17, 21, 10, 7, 23, 4, 231, 7, 12, 20, 10, 3, 5...
## $ moe <dbl> 4, 28, 33, 15, 11, 33, 8, 101, 13, 20, 30, 15, 5,...
## $ start_fips <fct> 48001, 48001, 48001, 48001, 48001, 48001, 48001, ...
## $ end_fips <fct> 05091, 22015, 22033, 28089, 40117, 40143, 47157, ...
select(cmap, fips, geometry) %>%
mutate(geometry = st_centroid(geometry)) %>%
st_coordinates() %>%
as_tibble() %>%
bind_cols(
select(cmap, fips) %>%
as_tibble() %>%
select(-geometry)
) %>%
select(fips, lng = X, lat = Y) -> centers
glimpse(centers)
## Observations: 3,143
## Variables: 3
## $ fips <fct> 01001, 01009, 01017, 01021, 01033, 01045, 01051, 01065, 01079,...
## $ lng <dbl> 1253479.8, 1237658.1, 1363279.6, 1241407.0, 1114517.1, 1367007...
## $ lat <dbl> -1285059.8, -1124835.1, -1224657.2, -1251718.1, -1063167.5, -1...
ggplot() +
geom_point(data = centers, aes(lng, lat), size = 0.125) +
coord_sf(crs = us_laea_proj, datum = NA) +
labs(x = NULL, y = NULL) +
theme_ipsum_es(grid="")
count(me_start, start_county, wt=workers, sort=TRUE) %>%
mutate(lab = glue::glue("{gsub(' County', '', start_county)} ??? {scales::comma(n, accuracy=1)}")) -> labs
glimpse(labs)
## Observations: 227
## Variables: 3
## $ start_county <chr> "Harris County", "El Paso County", "Dallas County", "T...
## $ n <dbl> 11714, 11233, 7633, 6482, 5416, 4159, 3892, 3024, 2995...
## $ lab <glue> "Harris ??? 11,714", "El Paso ??? 11,233", "Dallas ??...
left_join(
me_start, centers,
by = c("start_fips"="fips")
) %>%
rename(start_lng = lng, start_lat = lat) %>%
left_join(centers, by = c("end_fips"="fips")) %>%
rename(end_lng = lng, end_lat = lat) %>%
left_join(labs, "start_county") %>%
mutate(lab = factor(lab, levels = labs$lab)) -> start
glimpse(start)
## Observations: 3,491
## Variables: 18
## $ start_state_fips <chr> "48", "48", "48", "48", "48", "48", "48", "48", "...
## $ start_county_fips <chr> "001", "001", "001", "001", "001", "001", "001", ...
## $ start_state <chr> "Texas", "Texas", "Texas", "Texas", "Texas", "Tex...
## $ start_county <chr> "Anderson County", "Anderson County", "Anderson C...
## $ end_state_fips <chr> "05", "22", "22", "28", "40", "40", "47", "35", "...
## $ end_county_fips <chr> "091", "015", "033", "089", "117", "143", "157", ...
## $ end_state <chr> "Arkansas", "Louisiana", "Louisiana", "Mississipp...
## $ end_county <chr> "Miller County", "Bossier Parish", "East Baton Ro...
## $ workers <dbl> 2, 17, 21, 10, 7, 23, 4, 231, 7, 12, 20, 10, 3, 5...
## $ moe <dbl> 4, 28, 33, 15, 11, 33, 8, 101, 13, 20, 30, 15, 5,...
## $ start_fips <fct> 48001, 48001, 48001, 48001, 48001, 48001, 48001, ...
## $ end_fips <fct> 05091, 22015, 22033, 28089, 40117, 40143, 47157, ...
## $ start_lng <dbl> 413167.2, 413167.2, 413167.2, 413167.2, 413167.2,...
## $ start_lat <dbl> -1452436, -1452436, -1452436, -1452436, -1452436,...
## $ end_lng <dbl> 570062.9, 601670.7, 857792.6, 935953.7, 296435.9,...
## $ end_lat <dbl> -1277426.0, -1345049.1, -1560264.3, -1317854.0, -...
## $ n <dbl> 84, 84, 84, 84, 84, 84, 84, 238, 238, 431, 431, 4...
## $ lab <fct> Anderson ??? 84, Anderson ??? 84, Anderson ??? 84...
ggplot() +
geom_sf(data = cmap, color = "grey", size = 0.05, fill = "grey") +
geom_curve(
data = start,
aes(
x = start_lng, y = start_lat, xend = end_lng, yend = end_lat,
color = workers
),
size = 0.15, arrow = arrow(type = "open", length = unit(5, "pt"))
) +
scale_color_distiller(
limits = range(start$workers), labels = scales::comma,
trans = "log10", palette = "Reds", direction = 1, name = "Worker\nOutflow"
) +
coord_sf(datum = NA, ylim = c(-2500000.0, 1500000)) +
facet_wrap(~lab) +
labs(
x = NULL, y = NULL
) +
theme(strip.text = element_text(color = "black"))
