From 07bc51e52527b147fa665e8ce480ff8d7aded081 Mon Sep 17 00:00:00 2001 From: Ben Varick Date: Fri, 2 Aug 2024 18:05:23 -0500 Subject: [PATCH] edited municipality maps, played around with census tract data --- scripts/dynamic_crash_map.R | 32 +++++++++++++++++++++++++++++++- scripts/municipality_maps.R | 12 ++++++++---- 2 files changed, 39 insertions(+), 5 deletions(-) diff --git a/scripts/dynamic_crash_map.R b/scripts/dynamic_crash_map.R index bb62923..6e0544c 100644 --- a/scripts/dynamic_crash_map.R +++ b/scripts/dynamic_crash_map.R @@ -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", diff --git a/scripts/municipality_maps.R b/scripts/municipality_maps.R index bd5918c..2797ca6 100644 --- a/scripts/municipality_maps.R +++ b/scripts/municipality_maps.R @@ -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,