From 185829df8bc444b1f53a6a15a69bbee22d716d7e Mon Sep 17 00:00:00 2001 From: Ben Varick Date: Tue, 6 Aug 2024 13:40:55 -0500 Subject: [PATCH] edited school_maps to correct color bug) --- .../wisconsin_pedestrian_crash_map.html | 6 ++-- .../wisconsin_pedestrian_crash_map_es.html | 6 ++-- ...sconsin_pedestrian_crash_map_es_title.html | 6 ++-- .../wisconsin_pedestrian_crash_map_title.html | 6 ++-- scripts/dynamic_crash_map.R | 36 +++++++++++++++++++ scripts/school_maps.R | 8 +++-- 6 files changed, 53 insertions(+), 15 deletions(-) diff --git a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map.html b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map.html index e4493ad..bffedf3 100644 --- a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map.html +++ b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map.html @@ -5254,9 +5254,9 @@ function asArray(value) {
-
+
- - + + diff --git a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es.html b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es.html index a1a89ed..62ee3d1 100644 --- a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es.html +++ b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es.html @@ -5254,9 +5254,9 @@ function asArray(value) {
-
+
- - + + diff --git a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es_title.html b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es_title.html index 3bf346f..54f0427 100644 --- a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es_title.html +++ b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_es_title.html @@ -5254,9 +5254,9 @@ function asArray(value) {
-
+
- - + + diff --git a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_title.html b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_title.html index 2766ab6..b7e75e2 100644 --- a/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_title.html +++ b/figures/dynamic_crash_maps/wisconsin_pedestrian_crash_map_title.html @@ -5254,9 +5254,9 @@ function asArray(value) {
-
+
- - + + diff --git a/scripts/dynamic_crash_map.R b/scripts/dynamic_crash_map.R index 6e0544c..102e7aa 100644 --- a/scripts/dynamic_crash_map.R +++ b/scripts/dynamic_crash_map.R @@ -178,6 +178,30 @@ Census_Crash_geom <- st_join(tract_data, census_pal <- colorNumeric(palette = "YlOrRd", domain = c(min(Census_Crash_geom$CrashesPerPopulation, na.rm = TRUE), 3000)) +# ---- Municipality data + +city_data <- st_transform(get_decennial( + geography = "place", + variables = "P1_001N", # Total population variable for 2020 census + state = state, + year = census_year, + geometry = TRUE +), +crs = 4326) + +Place_Crash_geom <- st_join(city_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, NAME) %>% + summarize(crash_count = n()) %>% + filter(value > 500) %>% + mutate(CrashesPerPopulation = crash_count/(value/100000)) + +place_pal <- colorNumeric(palette = "YlOrRd", domain = c(min(Place_Crash_geom$CrashesPerPopulation, na.rm = TRUE), max(Place_Crash_geom$CrashesPerPopulation, na.rm = TRUE))) + #---- make map @@ -247,9 +271,21 @@ wisconsin_crash_map <- "average crashes/year per 100k residents: ", round(County_Crash_geom$CrashesPerPopulation,0)), htmltools::HTML), group = "Counties") %>% addLegend(position = "bottomleft", pal = county_pal, values = County_Crash_geom$CrashesPerPopulation, group = "Counties", title = "Crashes/year
(normalized per 100k residents)") %>% +# addPolygons(data = Place_Crash_geom, +# color = "black", +# weight = 1, +# fillColor=place_pal(Place_Crash_geom$CrashesPerPopulation), +# fillOpacity = 0.6, +# label = lapply(paste0("", str_to_title(Place_Crash_geom$NAME), "
", +# "population: ", format(Place_Crash_geom$value, nsmall=0, big.mark=","), "
", +# "average crashes per year: ", round(Place_Crash_geom$crash_count,0), "
", +# "average crashes/year per 100k residents: ", round(Place_Crash_geom$CrashesPerPopulation,0)), htmltools::HTML), +# group = "Places") %>% +# addLegend(position = "bottomleft", pal = place_pal, values = Place_Crash_geom$CrashesPerPopulation, group = "Places", title = "Crashes/year
(normalized per 100k residents)") %>% groupOptions(group = "Schools", zoomLevels = 13:20) %>% groupOptions(group = "Crash Points", zoomLevels = 10:20) %>% groupOptions(group ="Counties", zoomLevels = 1:9) +# groupOptions(group = "Places", zoomLevels = 10:12) wisconsin_crash_map diff --git a/scripts/school_maps.R b/scripts/school_maps.R index e302dd0..dcfdc75 100644 --- a/scripts/school_maps.R +++ b/scripts/school_maps.R @@ -53,6 +53,8 @@ injury_severity <- data.frame(InjSevName = c("Injury severity unknown", "No appa code = c(NA, "O", "C", "B", "A", "K"), color = c("grey", "#fafa6e", "#edc346", "#d88d2d", "#bd5721", "#9b1c1c")) +injury_severity_pal <- colorFactor(palette = injury_severity$color, levels = injury_severity$InjSevName) + TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(INJSVR1 == code)) %>% mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>% rename(InjSevName1 = InjSevName) @@ -146,10 +148,10 @@ school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24. county_focus <- c("DANE") #school_type_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus)) %>% pull(SCHOOLTYPE)) -school_type_focus <- c("High School") +school_type_focus <- c("Elementary School") #district_focus <- unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus), SCHOOLTYPE %in% school_type_focus, !is.na(DISTRICT_NAME)) %>% pull(DISTRICT_NAME)) -district_focus <- c("Monona Grove") +district_focus <- c("Madison Metropolitan") school_number <- length(unique(WI_schools %>% filter(CTY_DIST %in% str_to_title(county_focus), SCHOOLTYPE %in% school_type_focus, @@ -359,7 +361,7 @@ for(district in district_focus) { fill = ped_inj_name), shape = 23, size = 3) + - scale_fill_manual(values = injury_severity$color, name = "Crash Severity") + + scale_fill_manual(values = injury_severity_pal(injury_severity$color), name = "Crash Severity") + # add walk boundary new_scale_color() + new_scale_fill() +