edited school_maps to correct color bug)

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</br>(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("<b>", str_to_title(Place_Crash_geom$NAME), "</b></br>",
+#                                    "population: ", format(Place_Crash_geom$value, nsmall=0, big.mark=","), "<br>",
+#                                    "average crashes per year: ", round(Place_Crash_geom$crash_count,0), "</br>",
+#                                    "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</br>(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
 

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() +