edited municipality maps, played around with census tract data
This commit is contained in:
parent
cba47e7bdd
commit
07bc51e525
@ -129,6 +129,7 @@ Pedestrian_Crash_Data <- TOPS_data %>%
|
||||
select(c(all_of(focus_columns), "longitude", "latitude"))
|
||||
|
||||
County_Crash_Data <- Pedestrian_Crash_Data %>%
|
||||
filter(PedestrianInjurySeverity %in% c("Fatality", "Suspected Serious Injury", "Suspected Minor Injury")) %>%
|
||||
group_by(County, Year) %>%
|
||||
summarise(TotalCrashes = n(),
|
||||
longitude = mean(longitude, na.rm = TRUE),
|
||||
@ -151,6 +152,35 @@ County_Crash_geom$CrashesPerPopulation[is.na(County_Crash_geom$CrashesPerPopulat
|
||||
|
||||
county_pal <- colorNumeric(palette = "YlOrRd", domain = c(min(County_Crash_geom$CrashesPerPopulation, na.rm = TRUE), max(County_Crash_geom$CrashesPerPopulation, na.rm = TRUE)))
|
||||
|
||||
# ---- census block data
|
||||
census_year <- 2020
|
||||
state <- "WI"
|
||||
|
||||
tract_data <- st_transform(get_decennial(
|
||||
geography = "tract",
|
||||
variables = "P1_001N", # Total population variable for 2020 census
|
||||
state = state,
|
||||
year = census_year,
|
||||
geometry = TRUE
|
||||
),
|
||||
crs = 4326)
|
||||
|
||||
Census_Crash_geom <- st_join(tract_data,
|
||||
st_as_sf(Pedestrian_Crash_Data %>% filter(PedestrianInjurySeverity %in% c("Fatality", "Suspected Serious Injury", "Suspected Minor Injury"),
|
||||
latitude > 0),
|
||||
coords = c("longitude", "latitude"),
|
||||
crs = 4326),
|
||||
join = st_contains) %>%
|
||||
group_by(GEOID, value) %>%
|
||||
summarize(crash_count = n()) %>%
|
||||
filter(value > 0) %>%
|
||||
mutate(CrashesPerPopulation = crash_count/(value/100000))
|
||||
|
||||
census_pal <- colorNumeric(palette = "YlOrRd", domain = c(min(Census_Crash_geom$CrashesPerPopulation, na.rm = TRUE), 3000))
|
||||
|
||||
|
||||
#---- make map
|
||||
|
||||
#title style
|
||||
tag.map.title <- tags$style(HTML("
|
||||
.leaflet-control.map-title {
|
||||
@ -220,7 +250,7 @@ wisconsin_crash_map <-
|
||||
groupOptions(group = "Schools", zoomLevels = 13:20) %>%
|
||||
groupOptions(group = "Crash Points", zoomLevels = 10:20) %>%
|
||||
groupOptions(group ="Counties", zoomLevels = 1:9)
|
||||
|
||||
|
||||
wisconsin_crash_map
|
||||
|
||||
saveWidget(wisconsin_crash_map, file = "figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map.html",
|
||||
|
@ -117,10 +117,12 @@ school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.
|
||||
|
||||
#county_focus <- str_to_upper(unique(WI_schools %>% pull(CTY_DIST)))
|
||||
#county_focus <- c("DANE")
|
||||
county_focus <- c("DANE")
|
||||
county_focus <- "Dane"
|
||||
|
||||
municipality_focus <- c("Monona", "Verona", "Fitchburg")
|
||||
municipality_geom <- st_read("data/WI_Cities,_Towns_and_Villages_January_2024.geojson")
|
||||
#municipality_focus <- c("Mcfarland")
|
||||
#municipality_focus <- c("Monona", "Fitchburg")
|
||||
municipality_focus <- municipality_geom %>% filter(CNTY_NAME == county_focus) %>% pull(MCD_NAME)
|
||||
|
||||
for(municipality in municipality_focus) {
|
||||
|
||||
@ -131,8 +133,10 @@ for(municipality in municipality_focus) {
|
||||
readRDS(file_drawer("index.rds"))
|
||||
file_drawer("index.rds")
|
||||
|
||||
municipality_filtered <- municipality_geom %>% filter(CNTY_NAME == county_focus, MCD_NAME == municipality) %>% pull(geometry)
|
||||
|
||||
# create bounding box from school, 5km away.
|
||||
bbox_poly <- st_transform(st_buffer(municipality_geom %>% filter(MCD_NAME == municipality) %>% pull(geometry), 1000), crs = 4326)
|
||||
bbox_poly <- st_transform(st_buffer(municipality_filtered, 1000), crs = 4326)
|
||||
bbox <- st_bbox(bbox_poly)
|
||||
bbox <- c(left = as.double(bbox[1]),
|
||||
bottom = as.double(bbox[2]),
|
||||
@ -185,7 +189,7 @@ for(municipality in municipality_focus) {
|
||||
shape = 23,
|
||||
size = 3) +
|
||||
scale_fill_manual(values = injury_severity$color, name = "Crash Severity") +
|
||||
geom_sf(data = municipality_geom %>% filter(MCD_NAME == municipality),
|
||||
geom_sf(data = municipality_filtered,
|
||||
inherit.aes = FALSE,
|
||||
color = 'black',
|
||||
fill = NA,
|
||||
|
Loading…
x
Reference in New Issue
Block a user