library(arrow); library(dplyr); library(sf)
##
## Attaching package: 'arrow'
## The following object is masked from 'package:utils':
##
## timestamp
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
## Linking to GEOS 3.13.0, GDAL 3.8.5, PROJ 9.5.1; sf_use_s2() is TRUE
core_medical_regex <- "Hospital|Emergency|Urgent Care|Planned Parenthood|Reproductive|General Practice|Family Medicine"
detroit_raw <- open_dataset("DetroitData") %>%
filter(toupper(CITY) %in% c("DETROIT", "HIGHLAND PARK")) %>%
select(LOCATION_NAME, LATITUDE, LONGITUDE, CATEGORY_TAGS, SUB_CATEGORY, STREET_ADDRESS) %>%
collect() %>%
filter(!is.na(LATITUDE) & !is.na(LONGITUDE))
clinics_sf <- detroit_raw %>%
filter(grepl(core_medical_regex, paste(LOCATION_NAME, CATEGORY_TAGS, SUB_CATEGORY), ignore.case = TRUE)) %>%
filter(!grepl("Mental Health|Psychiat|Dental|Dentist|Dermatology|Optometry", SUB_CATEGORY, ignore.case = TRUE)) %>%
mutate(Facility_Type = case_when(
grepl("Hospital", SUB_CATEGORY, ignore.case = TRUE) ~ "Hospital",
grepl("Urgent Care|Emergency", LOCATION_NAME, ignore.case = TRUE) ~ "Emergency/Urgent Care",
grepl("Planned Parenthood|Reproductive", LOCATION_NAME, ignore.case = TRUE) ~ "Specialized Clinic",
TRUE ~ "Primary Care"
)) %>%
group_by(STREET_ADDRESS) %>% slice(1) %>% ungroup() %>%
st_as_sf(coords = c("LONGITUDE", "LATITUDE"), crs = 4326) %>% st_transform(3857)
bus_sf <- detroit_raw %>%
filter(grepl("Bus", paste(CATEGORY_TAGS, SUB_CATEGORY), ignore.case = TRUE)) %>%
st_as_sf(coords = c("LONGITUDE", "LATITUDE"), crs = 4326) %>% st_transform(3857)
nearest_idx <- st_nearest_feature(clinics_sf, bus_sf)
clinics_sf$dist_m <- as.numeric(st_distance(clinics_sf, bus_sf[nearest_idx, ], by_element = TRUE))
clinics_sf$Access_Status <- ifelse(clinics_sf$dist_m > 400, "Transit Isolated", "Accessible")
table(clinics_sf$Facility_Type)
##
## Emergency/Urgent Care Hospital Primary Care
## 16 53 31
## Specialized Clinic
## 2
library(leaflet)
nearest_bus_pts <- bus_sf[st_nearest_feature(clinics_sf, bus_sf), ]
spider_lines <- st_sfc(lapply(1:nrow(clinics_sf), function(i) {
st_linestring(rbind(st_coordinates(st_transform(clinics_sf[i,], 4326)),
st_coordinates(st_transform(nearest_bus_pts[i,], 4326))))
}), crs = 4326) %>% st_sf()
clinics_4326 <- st_transform(clinics_sf, 4326)
bus_4326 <- st_transform(bus_sf, 4326)
spider_4326 <- st_transform(spider_lines, 4326)
target_colors <- c("#E31A1C", "#FF7F00", "#6A3D9A", "#1F78B4")
target_levels <- c("Hospital", "Emergency/Urgent Care", "Specialized Clinic", "Primary Care")
pal <- colorFactor(palette = target_colors, levels = target_levels)
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircleMarkers(
data = bus_4326,
radius = 1.5,
color = "#999999",
stroke = FALSE,
fillOpacity = 0.5,
group = "Bus Network"
) %>%
addCircleMarkers(
data = clinics_4326,
radius = ~sqrt(dist_m) * 0.8,
color = ~pal(Facility_Type),
fillOpacity = 0.7,
stroke = TRUE,
weight = 1,
popup = ~paste0("<b>", LOCATION_NAME, "</b><br>Dist: ", round(dist_m), "m"),
group = "Facilities"
) %>%
addPolylines(
data = spider_4326,
color = "#222222", # Very dark gray for maximum contrast
weight = 3, # Bold stroke
opacity = 0.8,
group = "Access Gaps"
) %>%
addLegend(
pal = pal,
values = target_levels,
title = "Facility Type",
position = "bottomright"
)
library(ggplot2)
ggplot() +
geom_sf(data = bus_sf, color = "gray90", size = 0.05, alpha = 0.3) +
geom_sf(data = clinics_sf, aes(size = dist_m, color = Facility_Type), alpha = 0.6) +
scale_size_area(
max_size = 8,
breaks = c(0, 250, 500, 1000), # Defines the specific ranges in the legend
labels = c("0m (Direct)", "250m", "500m (Isolated)", "1km+"),
name = "Walking Distance"
) +
scale_color_manual(
values = c("Hospital" = "#E31A1C",
"Emergency/Urgent Care" = "#FF7F00",
"Specialized Clinic" = "#6A3D9A",
"Primary Care" = "#1F78B4"),
name = "Facility Type"
) +
theme_minimal() +
guides(
color = guide_legend(override.aes = list(size = 5), order = 1),
size = guide_legend(override.aes = list(color = "gray40"), order = 2)
) +
labs(
title = "Detroit Healthcare: Transit Access Burden",
subtitle = "Analysis of core medical infrastructure relative to 6,000+ bus stops",
caption = "Distance calculated as straight-line meters to nearest transit node"
) +
theme(
text = element_text(face = "bold"),
panel.grid = element_blank(),
legend.position = "right",
plot.title = element_text(size = 16),
panel.background = element_rect(fill = "#fafafa", color = NA)
)
library(gt)
clinics_sf %>%
st_drop_geometry() %>%
group_by(Facility_Type) %>%
summarise(
Total = n(),
`Isolated Count` = sum(dist_m > 400),
`Access Rate (%)` = (sum(dist_m <= 400) / n()) * 100
) %>%
gt() %>%
tab_header(title = "Detroit Healthcare Transit Access Audit") %>%
fmt_number(columns = `Access Rate (%)`, decimals = 1) %>%
data_color(columns = `Access Rate (%)`, colors = scales::col_numeric(palette = "RdYlGn", domain = c(50, 100)))
## Warning: Since gt v0.9.0, the `colors` argument has been deprecated.
## • Please use the `fn` argument instead.
## This warning is displayed once every 8 hours.
| Detroit Healthcare Transit Access Audit |
| Facility_Type |
Total |
Isolated Count |
Access Rate (%) |
| Emergency/Urgent Care |
16 |
4 |
75.0 |
| Hospital |
53 |
14 |
73.6 |
| Primary Care |
31 |
1 |
96.8 |
| Specialized Clinic |
2 |
0 |
100.0 |
library(ggplot2)
detroit_colors <- c(
"Hospital" = "#E31A1C",
"Emergency/Urgent Care" = "#FF7F00",
"Specialized Clinic" = "#6A3D9A",
"Primary Care" = "#1F78B4"
)
ggplot(clinics_sf, aes(x = Facility_Type, y = dist_m, fill = Facility_Type)) +
geom_violin(alpha = 0.2, color = NA) +
geom_jitter(aes(color = Facility_Type), width = 0.25, alpha = 0.4, size = 1.2) +
geom_hline(yintercept = 400, linetype = "dashed", color = "#ff4e50", linewidth = 1.2) +
annotate("text", x = 0.6, y = 440, label = "400m Isolation Threshold",
color = "#ff4e50", fontface = "bold", hjust = 0) +
coord_cartesian(ylim = c(0, 1000)) +
scale_fill_manual(values = detroit_colors) +
scale_color_manual(values = detroit_colors) +
theme_minimal() +
theme(
legend.position = "none",
text = element_text(face = "bold"),
axis.text.x = element_text(size = 10),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank()
) +
labs(
title = "DETROIT HEALTHCARE ACCESS DISTRIBUTION",
subtitle = "Meters to nearest bus stop by high-stakes facility type",
y = "Distance (Meters)",
x = ""
)
