finaldraft
5 QUESTIONS
What is the correlation between population density and transportation across rice, Dakota, and Hennepin counties?
What are the general transportation habits in Rice/Dakota/Hennepin counties?
Do income levels affect transportation habits across Rice County? How does this connection compare to Dakota and Hennepin counties?
What is the connection between housing status and transportation habits? (rent/own and the connection between that and transportation habits)?
How do income levels affect transportation use/methods/expenses?
Data Wrangling
Loading Census Data and Basic Packages
# load the packages
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── 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 errorslibrary(tidycensus)
library(robotstxt)
library(rvest)##
## Attaching package: 'rvest'
##
## The following object is masked from 'package:readr':
##
## guess_encodinglibrary(httr2)
library(forcats)
library(plotly)##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutlibrary(httr)##
## Attaching package: 'httr'
##
## The following object is masked from 'package:plotly':
##
## configlibrary(dplyr)
library(tibble)
library(readr)
library(DT)
library(sf)## Linking to GEOS 3.13.1, GDAL 3.10.2, PROJ 9.5.1; sf_use_s2() is TRUEAccessing the API
#link my census api key
my_key <- readLines("census_api_key.txt")
census_api_key(my_key)
# access census data
acs_vars <- load_variables(2023, "acs5", cache = TRUE)
acs_vars |>
filter(str_detect(concept, "Means of Transportation to Work by Tenure"))
## # A tibble: 42 × 4
## name label concept geography
## <chr> <chr> <chr> <chr>
## 1 B08137_001 Estimate!!Total: Means … tract
## 2 B08137_002 Estimate!!Total:!!Householder lived in owner-oc… Means … tract
## 3 B08137_003 Estimate!!Total:!!Householder lived in renter-o… Means … tract
## 4 B08137_004 Estimate!!Total:!!Car, truck, or van - drove al… Means … tract
## 5 B08137_005 Estimate!!Total:!!Car, truck, or van - drove al… Means … tract
## 6 B08137_006 Estimate!!Total:!!Car, truck, or van - drove al… Means … tract
## 7 B08137_007 Estimate!!Total:!!Car, truck, or van - carpoole… Means … tract
## 8 B08137_008 Estimate!!Total:!!Car, truck, or van - carpoole… Means … tract
## 9 B08137_009 Estimate!!Total:!!Car, truck, or van - carpoole… Means … tract
## 10 B08137_010 Estimate!!Total:!!Public transportation (exclud… Means … tract
## # ℹ 32 more rows# load in our variables
variables_to_load = c("B08537_002", "B08537_003", "B08537_004", "B08537_005", "B08537_006", "B08537_007", "B08537_008", "B08537_009", "B08537_010", "B08537_011", "B08537_012", "B08537_013", "B08537_014", "B08537_015", "B08537_016", "B08537_017", "B08537_018", "B08537_019", "B08537_020", "B08537_021")
# call the data
acs_mn_2023 <- tidycensus::get_acs(
year = 2023,
state = "MN",
geography = "county",
variables = variables_to_load,
output = "wide",
survey = "acs5",
geometry = TRUE
)
## | | | 0% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 10% | |======= | 11% | |======== | 11% | |======== | 12% | |========= | 13% | |========== | 14% | |========== | 15% | |=========== | 15% | |=========== | 16% | |============ | 17% | |============= | 19% | |============== | 20% | |=============== | 21% | |=============== | 22% | |================ | 22% | |================ | 23% | |================= | 24% | |================= | 25% | |================== | 25% | |================== | 26% | |=================== | 26% | |=================== | 27% | |=================== | 28% | |==================== | 28% | |==================== | 29% | |===================== | 30% | |====================== | 31% | |====================== | 32% | |======================= | 32% | |======================= | 33% | |======================== | 34% | |========================= | 35% | |========================= | 36% | |========================== | 37% | |=========================== | 38% | |=========================== | 39% | |============================ | 39% | |============================ | 40% | |============================ | 41% | |============================= | 41% | |============================= | 42% | |============================== | 42% | |============================== | 43% | |=============================== | 44% | |=============================== | 45% | |================================ | 45% | |================================ | 46% | |================================= | 46% | |================================= | 47% | |================================== | 48% | |================================== | 49% | |=================================== | 49% | |=================================== | 50% | |=================================== | 51% | |==================================== | 52% | |===================================== | 53% | |====================================== | 54% | |====================================== | 55% | |======================================= | 55% | |======================================= | 56% | |======================================== | 57% | |======================================== | 58% | |========================================= | 58% | |========================================= | 59% | |========================================== | 60% | |=========================================== | 61% | |=========================================== | 62% | |============================================ | 63% | |============================================= | 64% | |============================================= | 65% | |============================================== | 65% | |============================================== | 66% | |=============================================== | 66% | |=============================================== | 67% | |================================================ | 68% | |================================================ | 69% | |================================================= | 69% | |================================================= | 70% | |================================================= | 71% | |================================================== | 71% | |================================================== | 72% | |=================================================== | 72% | |=================================================== | 73% | |==================================================== | 74% | |===================================================== | 75% | |===================================================== | 76% | |====================================================== | 77% | |====================================================== | 78% | |======================================================= | 78% | |======================================================= | 79% | |======================================================== | 79% | |======================================================== | 80% | |======================================================== | 81% | |========================================================= | 81% | |========================================================= | 82% | |========================================================== | 82% | |========================================================== | 83% | |=========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 86% | |============================================================= | 87% | |============================================================= | 88% | |============================================================== | 88% | |============================================================== | 89% | |=============================================================== | 89% | |=============================================================== | 90% | |=============================================================== | 91% | |================================================================ | 91% | |================================================================ | 92% | |================================================================= | 93% | |================================================================== | 94% | |================================================================== | 95% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 97% | |==================================================================== | 98% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 99% | |======================================================================| 100%
# select just our three counties
counties <- c(
"Rice County, Minnesota",
"Dakota County, Minnesota",
"Hennepin County, Minnesota"
)
# make the name just the county name
acs_mn_2023 <- acs_mn_2023 |>
mutate(
name = str_remove(NAME, ", Minnesota"),
name = str_remove(name, " County")
) |>
filter(NAME %in% counties)
# trying to call it
variables_to_load = c("B08537_002E", "B08537_003E", "B08537_004E", "B08537_005E", "B08537_006E", "B08537_007E", "B08537_008E", "B08537_009E", "B08537_010E", "B08537_011E", "B08537_012E", "B08537_013E", "B08537_014E", "B08537_015E", "B08537_016E", "B08537_017E", "B08537_018E", "B08537_019E", "B08537_020E", "B08537_021E", "B01003_001E", "B19013_001E")
variables_string <- paste(c("NAME", variables_to_load), collapse = ",")
county_data_request <- request("https://api.census.gov/data") |>
req_url_path_append("2020") |>
req_url_path_append("acs") |>
req_url_path_append("acs5") |>
req_url_query(get = variables_string,
`for` = I("county:*"),
key = my_key,
.multi = "comma")
county_data <- req_perform(county_data_request)Making a Table by County with Census Information
county_table <- county_data |>
resp_body_json(simplifyVector = TRUE) |>
janitor::row_to_names(1) |>
as_tibble()
# select just our three counties
counties <- c(
"Rice County, Minnesota",
"Dakota County, Minnesota",
"Hennepin County, Minnesota"
)
# make the name just the county name
county_table <- county_table |>
filter(NAME %in% counties) |>
mutate(
name = str_remove(NAME, ", Minnesota"),
name = str_remove(name, " County")
) |>
mutate(
`Total Homeowners` = as.numeric(B08537_002E),
`Total Renters` = as.numeric(B08537_003E),
`Drivers: Total` = as.numeric(B08537_004E),
`Drivers: Owners` = as.numeric(B08537_005E),
`Drivers: Renters` = as.numeric(B08537_006E),
`Carpool: Total` = as.numeric(B08537_007E),
`Carpool: Owners` = as.numeric(B08537_008E),
`Carpool: Renters` = as.numeric(B08537_009E),
`Public Transit: Total` = as.numeric(B08537_010E),
`Public Transit: Owners` = as.numeric(B08537_011E),
`Public Transit: Renters` = as.numeric(B08537_012E),
`Walk: Total` = as.numeric(B08537_013E),
`Walk: Owners` = as.numeric(B08537_014E),
`Walk: Renters` = as.numeric(B08537_015E),
`Other: Total` = as.numeric(B08537_016E),
`Other: Owners` = as.numeric(B08537_017E),
`Other: Renters` = as.numeric(B08537_018E),
`WFH: Total` = as.numeric(B08537_019E),
`WFH: Owners` = as.numeric(B08537_020E),
`WFH: Renters` = as.numeric(B08537_021E),
`Total Population` = as.numeric(B01003_001E),
`Median Household Income` = as.numeric(B19013_001E)
) |>
select(!1:23)
# Calculate Population Density - MN.gov
densities <- c(806, 2298, 139)
county_table <- county_table %>%
mutate(`Population Density` = densities)
# Calculate % of Homeowners vs Renters per County Manually
county_table <- county_table %>%
mutate(
`% Homeowners` = (`Total Homeowners` / `Total Population`) * 100,
`% Renters` = (`Total Renters` / `Total Population`) * 100
)
datatable(county_table)Demographics: Total Population, Homeowners, and Renters per County
Total Population
ggplot(county_table, aes(x = name, y = `Total Population`)) +
geom_col(aes(fill = name), show.legend = FALSE) +
labs(
title = "Total Population of Rice, Dakota, and Hennepin Counties, MN",
x = "County",
y = "Total Population (2023)"
) +
theme_minimal() +
theme(strip.text = element_text(face = "bold")) +
scale_fill_viridis_d()
### Number of Renters vs. Owners per County
renters_vs_owners <- county_table %>%
select(name, `% Homeowners`, `% Renters`) %>%
pivot_longer(cols = starts_with("%"),
names_to = "Housing Status",
values_to = "Percent")
renters_vs_owners_plot <- ggplot(renters_vs_owners, aes(x = name, y = Percent, fill = `Housing Status`, text = paste0("Percent: ", round(Percent, 1), "%"))) +
geom_col() +
labs(
title = "Homeownership vs Renting by County",
x = "County",
y = "Percent of Population",
fill = "Housing Status",
) +
coord_flip() +
theme_minimal() +
scale_fill_viridis_d()
ggplotly(renters_vs_owners_plot, tooltip = "text")Basic Transportation Information per County - MNCompass
Reading the Data as CSV files (original websites are Javascript, not html)
dakota_county_data <- read_csv("data/dakota_county_data.csv")
rice_county_data <- read_csv("data/rice_county_data.csv")
hennepin_county_data <- read_csv("data/hennepin_county_data.csv")Tidying the Data
dakota_data_clean <- dakota_county_data %>%
mutate(Section = if_else(is.na(Count) & is.na(Percent), Category, NA_character_)
) %>%
fill(Section) %>%
filter(!(is.na(Count) & is.na(Percent))) %>%
select(Section, Category, Count, Percent)
rice_data_clean <- rice_county_data %>%
mutate(Section = if_else(is.na(Count) & is.na(Percent), Category, NA_character_)
) %>%
fill(Section) %>%
filter(!(is.na(Count) & is.na(Percent))) %>%
select(Section, Category, Count, Percent)
hennepin_data_clean <- hennepin_county_data %>%
mutate(Section = if_else(is.na(Count) & is.na(Percent), Category, NA_character_)
) %>%
fill(Section) %>%
filter(!(is.na(Count) & is.na(Percent))) %>%
select(Section, Category, Count, Percent)
Graphing Transportation Habits by County
Rice County, MN
rice_data_clean %>%
filter(Category != "Total workers age 16+ (not home based)") %>%
filter(Category != "Workers (16 years and older)") %>%
ggplot(aes(x = Category, y = Count, fill = Section)) +
geom_col(show.legend = FALSE) +
facet_wrap(~ Section, ncol = 1, scales = "free_x") +
labs(
title = "Counts by Category within Each Section - Rice County",
x = NULL,
y = "Count"
) +
theme_minimal() +
theme(strip.text = element_text(face = "bold")) +
scale_fill_viridis_d()
Dakota County, MN
dakota_data_clean %>%
filter(Category != "Total workers age 16+ (not home based)") %>%
filter(Category != "Workers (16 years and older)") %>%
ggplot(aes(x = Category, y = Count, fill = Section)) +
geom_col(show.legend = FALSE) +
facet_wrap(~ Section, ncol = 1, scales = "free_x") +
labs(
title = "Counts by Category within Each Section - Dakota County",
x = NULL,
y = "Count"
) +
theme_minimal() +
theme(strip.text = element_text(face = "bold")) +
scale_fill_viridis_d()
Hennepin County, MN
hennepin_data_clean %>%
filter(Category != "Total workers age 16+ (not home based)") %>%
filter(Category != "Workers (16 years and older)") %>%
ggplot(aes(x = Category, y = Count, fill = Section)) +
geom_col(show.legend = FALSE) +
facet_wrap(~ Section, ncol = 1, scales = "free_x") +
labs(
title = "Counts by Category within Each Section - Hennepin County",
x = NULL,
y = "Count"
) +
theme_minimal() +
theme(strip.text = element_text(face = "bold")) +
scale_fill_viridis_d()
Widen Data - Merge with Census Information
rice_data_clean <- rice_data_clean %>%
mutate(name = "Rice")
dakota_data_clean <- dakota_data_clean %>%
mutate(name = "Dakota")
hennepin_data_clean <- hennepin_data_clean %>%
mutate(name = "Hennepin")rice_data_clean_wide <- rice_data_clean %>%
select(Category, Count, name) %>%
pivot_wider(names_from = Category, values_from = Count)
dakota_data_clean_wide <- dakota_data_clean %>%
select(Category, Count, name) %>%
pivot_wider(names_from = Category, values_from = Count)
hennepin_data_clean_wide <- hennepin_data_clean %>%
select(Category, Count, name) %>%
pivot_wider(names_from = Category, values_from = Count)
county_transportation_combined <-bind_rows(rice_data_clean_wide, dakota_data_clean_wide, hennepin_data_clean_wide)
county_census_and_transport_data <- left_join(county_table, county_transportation_combined, by = "name")Calculating Percentages
county_census_and_transport_data <- county_census_and_transport_data %>%
mutate(
`% Drivers - Owners` = (`Drivers: Owners` / `Total Homeowners`) * 100,
`% Drivers - Renters` = (`Drivers: Renters` / `Total Renters`) * 100,
`% Public Transit - Owners` = (`Public Transit: Owners` / `Total Homeowners`) * 100,
`% Public Transit - Renters` = (`Public Transit: Renters` / `Total Renters`) * 100,
`% Walk - Owners` = (`Walk: Owners` / `Total Homeowners`) * 100,
`% Walk - Renters` = (`Walk: Renters` / `Total Renters`) * 100,
`% Carpool - Owners` = (`Carpool: Owners` / `Total Homeowners`) * 100,
`% Carpool - Renters` = (`Carpool: Renters` / `Total Renters`) * 100,
`% WFH - Owners` = (`WFH: Owners` / `Total Homeowners`) * 100,
`% WFH - Renters` = (`WFH: Renters` / `Total Renters`) * 100,
`% Driving` = (`Drivers: Total` / `Total Population`) * 100,
`% Public Transit` = (`Public Transit: Total` / `Total Population`) * 100,
`% Walking` = (`Walk: Total` / `Total Population`) * 100,
`% Carpool` = (`Carpool: Total` / `Total Population`) * 100,
`% Work From Home` = (`WFH: Total` / `Total Population`) * 100
)
datatable(county_census_and_transport_data)Graphing Trends
Median Household Income and Transportation Habits Across Counties
county_transport_modes <- county_census_and_transport_data %>%
select(name, `Median Household Income`, `% Driving`, `% Public Transit`, `% Walking`, `% Carpool`, `% Work From Home`) %>%
pivot_longer(cols = starts_with("%"), names_to = "Mode", values_to = "Percent")
ggplot(county_transport_modes, aes(x = `Median Household Income`, y = Percent, color = Mode, shape = name)) +
geom_point(size = 2.6, alpha = 0.6) +
labs(
title = "Transportation Mode Usage vs Median Household Income per County",
x = "Median Household Income (USD)",
y = "Percent Using Mode (%)",
color = "Transportation Mode",
shape = "County"
) +
theme_minimal() +
scale_color_viridis_d()
ggplot(county_transport_modes, aes(x = `Median Household Income`, y = Percent, color = Mode, shape = name)) +
geom_point(size = 2.6, alpha = 0.9) +
geom_smooth(aes(group = Mode), method = "lm", se = FALSE, linetype = "dashed") +
labs(
title = "Transportation Mode Usage vs Median Household Income per County",
x = "Median Household Income (USD)",
y = "Percent Using Mode (%)",
color = "Transportation Mode",
shape = "County"
) +
theme_minimal()+
facet_wrap(~ Mode) +
scale_color_viridis_d()
Population Density and Transportation
county_pop_density <- county_census_and_transport_data %>%
select(name, `Population Density`, `% Driving`, `% Public Transit`, `% Walking`, `% Carpool`, `% Work From Home`) %>%
pivot_longer(cols = starts_with("%"), names_to = "Mode", values_to = "Percent")
ggplot(county_pop_density, aes(x = `Population Density`, y = Percent, color = Mode, shape = name)) +
geom_point(size = 2.6, alpha = 0.6) +
labs(
title = "Transportation Mode Usage vs Population Density",
x = "Population Density (people per square mile)",
y = "Percent Using Mode (%)",
color = "Transportation Mode",
shape = "County") +
theme_minimal() +
scale_color_viridis_d()
county_pop_density <- county_census_and_transport_data %>%
select(name, `Population Density`, `% Driving`, `% Public Transit`, `% Walking`, `% Carpool`, `% Work From Home`) %>%
pivot_longer(cols = starts_with("%"), names_to = "Mode", values_to = "Percent")
ggplot(county_pop_density, aes(x = `Population Density`, y = Percent, color = Mode, shape = name)) +
geom_point(size = 2.6, alpha = 0.9) +
geom_smooth(aes(group = Mode), method = "lm", se = FALSE, linetype = "dashed") +
facet_wrap(~ Mode) +
labs(
title = "Transportation Mode Usage vs Population Density",
x = "Population Density (people per square mile)",
y = "Percent Using Mode (%)",
color = "Transportation Mode",
shape = "County") +
theme_minimal() +
scale_color_viridis_d()
Housing Status and Transportation Habits
housing_transport <- county_census_and_transport_data %>%
select(name, starts_with("% Drivers"), starts_with("% Public Transit"), starts_with("% Walk"), starts_with("% Carpool"), starts_with("% WFH")) %>%
pivot_longer(
cols = -name,
names_to = c("Mode", "Housing"),
names_sep = " - ",
values_to = "Percent"
) %>%
filter(!is.na(Housing), Housing != "NA")
housing_transport_plot <- ggplot(housing_transport, aes(x = fct_reorder(Mode, Percent), y = Percent, fill = Housing, text = paste0("Percent Using Transport Mode: ", round(Percent, 1), "%"))) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
facet_wrap(~ name) +
labs(
title = "Transportation Mode Usage by Housing Status Across Counties",
x = "Transportation Mode",
y = "Percent of Housing Group Using Transportation Mode",
fill = "Housing Status"
) +
theme_minimal() +
theme(axis.text.x = element_text(hjust = 1)) +
coord_flip() +
scale_fill_viridis_d()
ggplotly(housing_transport_plot, tooltip = "text")housing_transport <- housing_transport %>%
mutate(Mode = fct_reorder(Mode, Percent))
stacked_housing_transport <- ggplot(housing_transport, aes(x = Housing, y = Percent, fill = Mode, text = paste0("Percent Using Transport Mode: ", round(Percent, 1), "%"))) +
geom_col(width = 0.7, position = "stack") +
facet_wrap(~ name, ncol = 1) +
labs(
title = "Transportation Mode Usage by Housing Status Across Counties",
x = "Transportation Mode",
y = "Percent of Housing Group Using Transportation Mode",
fill = "Housing Status"
) +
theme_minimal() +
theme(axis.text.x = element_text(hjust = 1)) +
coord_flip() +
scale_fill_viridis_d()
ggplotly(stacked_housing_transport, tooltip = "text")#read in stops data from NTAD .csv locally downloaded
stops_data <- read_csv("data/NTAD_National_Transit_Map_Stops_6633473857343365838.csv",
col_types = list(
download_date = col_date(format = "%m/%e/%Y")
))
# filter out na
stops_data <- stops_data |>
filter(!is.na(stop_lat), !is.na(stop_lon)) |>
st_as_sf(coords = c("stop_lon", "stop_lat"), crs = 4326)#trying a new way to read in location data
#https://walker-data.com/census-r/mapping-census-data-with-r.html
options(tigris_use_cache = TRUE)
county_boundaries <- get_acs(
geography = "county",
variables = "B19013_001",
state = "MN",
year = 2023,
geometry = TRUE
)
# select just our three counties
counties <- c(
"Rice County, Minnesota",
"Dakota County, Minnesota",
"Hennepin County, Minnesota"
)
# make the name just the county name
county_boundaries <- county_boundaries |>
filter(NAME %in% counties) |>
mutate(
name = str_remove(NAME, ", Minnesota"),
name = str_remove(name, " County")
)
# https://r-spatial.github.io/sf/reference/st_join.html and https://r-spatial.github.io/sf/reference/st_as_sf.html
county_boundaries <- st_transform(county_boundaries, crs = 4326)
# spatial join
county_stops <- st_join(stops_data, county_boundaries, join = st_within)
county_stops <- county_stops |>
filter(!is.na(name))# make a leaflet
library(leaflet)
leaflet(county_stops) |>
addTiles() |>
addCircleMarkers(
radius = 0.5,
color = "red") |>
addPolygons(
data = county_boundaries,
color = "black",
fill = FALSE,
label = ~name
)