added Milwaukee crash map to RMarkdown

Makefile

@@ -9,6 +9,9 @@ schoolmaps_PDFs: R/schoolmaps_PDFs.Rmd
 crashmaps_dynamic: R/dynamic_crash_map.Rmd
 	R -e 'library("rmarkdown"); old_path <- Sys.getenv("PATH"); Sys.setenv(PATH = paste(old_path, "/usr/local/bin", sep = ":")); rmarkdown::render(knit_root_dir = "../", output_dir = "./html", input = "./R/dynamic_crash_map.Rmd", output_file = "./html/dynamic_crash_map.html")'
 
+crashmaps_dynamic_milwaukee: R/dynamic_crash_map_milwaukee.Rmd
+	R -e 'library("rmarkdown"); old_path <- Sys.getenv("PATH"); Sys.setenv(PATH = paste(old_path, "/usr/local/bin", sep = ":")); rmarkdown::render(knit_root_dir = "../", output_dir = "./html", input = "./R/dynamic_crash_map_milwaukee.Rmd", output_file = "./html/dynamic_crash_map_milwaukee.html")'
+
 osrm-data:
 	cd ./docker/osrm/; wget https://download.geofabrik.de/north-america/us/wisconsin-latest.osm.pbf -O ./data-raw/wisconsin-latest.osm.pbf
 	cd ./docker/osrm/; docker run --rm -t -v "./data-foot:/data" -v "./data-raw/wisconsin-latest.osm.pbf:/data/wisconsin-latest.osm.pbf" osrm/osrm-backend osrm-extract -p /opt/foot.lua /data/wisconsin-latest.osm.pbf

R/dynamic_crash_map.Rmd

@@ -90,8 +90,6 @@ Pedestrian_Crash_Data <- TOPS_data %>%
 ```
 
 
-
-
 ## Load Census data
 ```{r censusdata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
 

R/dynamic_crash_map_milwaukee.Rmd

@@ -0,0 +1,166 @@
+---
+title: "Dynamic Crash Map - Milwaukee"
+output:
+  html_document:
+    toc: true
+    toc_depth: 5
+    toc_float:
+      collapsed: false
+      smooth_scroll: true
+editor_options:
+  chunk_output_type: console
+---
+
+
+# Input Data & Configuration
+
+## Libraries
+```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+date()
+rm(list=ls())
+library(tidyverse)
+library(sf)
+library(leaflet)
+library(RColorBrewer)
+library(tidycensus)
+library(htmltools)
+library(magick)
+library(htmlwidgets)
+library(MASS)
+library(raster)
+Sys.setenv(LANG = "en-US.UTF-8")
+focus_county <- "MILWAUKEE"
+```
+
+## Load TOPS data
+```{r loadTOPS, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+load(file = "data/TOPS/TOPS_data.Rda")
+load(file = "data/TOPS/vuln_roles.Rda")
+load(file = "data/TOPS/retrieve_date.Rda")
+load(file = "data/TOPS/injury_severity.Rda")
+injury_severity_pal <- colorFactor(palette = injury_severity$color, levels = injury_severity$InjSevName)
+
+```
+
+## Mutate TOPS_data
+```{r mutateTOPS, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+TOPS_data <- TOPS_data %>% 
+  mutate(Year = year,
+         PedestrianInjurySeverity = ped_inj_name,
+         CrashDate = CRSHDATE,
+         CrashTime = CRSHTIME,
+         County = CNTYNAME,
+         Street = ONSTR,
+         CrossStreet = ATSTR) %>%
+  mutate(PedestrianAge = ifelse(ROLE1 %in% vuln_roles, age1, age2))
+
+
+TOPS_geom <- st_as_sf(TOPS_data %>% filter(!is.na(latitude)), coords = c("longitude", "latitude"), crs = 4326)
+```
+
+## load school locations ----
+```{r loadschooldata, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+WI_schools <- st_read(dsn = "data/Schools/Wisconsin_Public_Schools_-5986231931870160084.gpkg")
+WI_schools <- WI_schools %>% 
+  filter(is.double(LAT),
+         LAT > 0) %>%
+  select("SCHOOL", "DISTRICT", "SCHOOLTYPE", "LAT", "LON")
+
+school_translate <- data.frame(en = c("Elementary School", "High School", "Combined Elementary/Secondary School", "Middle School", "Junior High School"),
+                               es = c("Escuela primaria", "Escuela secundaria", "Escuela primaria/secundaria combinada", "Escuela secundaria", "Escuela secundaria"))
+
+WI_schools <- WI_schools %>%
+  mutate(SCHOOLTYPE_es <- school_translate$es[match(WI_schools$SCHOOLTYPE, school_translate$en)])
+
+WI_schools <- WI_schools %>% filter(COUNTY %in% str_to_title(focus_county))
+```
+
+### Load school symbol
+```{r loadschoolicon, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+school_symbol <- makeIcon(iconUrl = "icons/school_FILL0_wght400_GRAD0_opsz24.png",
+                          iconWidth = 24,
+                          iconHeight = 24,
+                          iconAnchorX = 12,
+                          iconAnchorY = 12)
+```
+
+## Pull certain columns
+```{r pullcolumns, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+
+focus_columns <- c("PedestrianInjurySeverity", "CrashDate", "CrashTime", "County", "Street", "CrossStreet", "PedestrianAge", "Year", "vulnerable_role", "vulnerable_role_es")
+
+Pedestrian_Crash_Data <- TOPS_data %>% 
+  filter(CNTYNAME == focus_county,
+         !is.na(latitude)) %>%
+  dplyr::select(all_of(c(focus_columns, "longitude", "latitude")))
+```
+
+# generate density map ----
+```{r density, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+crash_density <- kde2d(Pedestrian_Crash_Data$longitude, Pedestrian_Crash_Data$latitude, n = 200)
+crash_density <- raster(crash_density)
+crash_density <- cut(crash_density, breaks = 10)
+crash_density_poly <- rasterToPolygons(crash_density, dissolve = T)
+
+density_pal <- colorNumeric(palette = "YlOrRd", domain = c(min(crash_density_poly$layer, na.rm = TRUE), max(crash_density_poly$layer, na.rm = TRUE)))
+```
+
+
+## add county census data ----
+```{r countycensus, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+census_api_key(key = substr(read_file(file = "api_keys/census_api_key"), 1, 40))
+county_populations <- get_estimates(geography = "county", year = 2022, product = "population", state = "Wisconsin", geometry = TRUE) %>%
+  filter(variable == "POPESTIMATE") %>%
+  mutate(County = str_to_upper(str_replace(NAME, " County, Wisconsin", "")))
+county_populations <- st_transform(county_populations, crs = 4326) %>% filter(County %in% focus_county)
+```
+
+## Generate map
+```{r generatemap, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+milwaukee_crash_map <- 
+  leaflet(options = leafletOptions(preferCanvas = TRUE)) %>%
+  addProviderTiles(providers$Stadia.AlidadeSmooth) %>%
+  addPolygons(data = county_populations,
+              color = "black",
+              weight = 1,
+              fill = FALSE,
+              group = "County Lines") %>%
+  addPolygons(data = crash_density_poly,
+              color = "black",
+              weight = 0,
+              opacity = 0.9,
+              group = "Heat Map",
+              fillColor = density_pal(crash_density_poly$layer))%>%
+  addMarkers(data = WI_schools,
+             lng=WI_schools$LON,
+             lat = WI_schools$LAT,
+             icon = school_symbol,
+             label = lapply(paste0("<b>", WI_schools$SCHOOL, " School</b></br>",
+                                   WI_schools$DISTRICT, " School District</br>",
+                                   WI_schools$SCHOOLTYPE), htmltools::HTML),
+             group = "Schools") %>%
+  addCircleMarkers(data = Pedestrian_Crash_Data,
+                   lng=Pedestrian_Crash_Data$longitude,
+                   lat=Pedestrian_Crash_Data$latitude,
+                   fillColor=injury_severity_pal(Pedestrian_Crash_Data$PedestrianInjurySeverity),
+                   radius=4,
+                   stroke=TRUE,
+                   color = "black",
+                   weight = 1,
+                   fillOpacity = 0.8,
+                   label = lapply(paste0("<b>", str_to_title(replace_na(Pedestrian_Crash_Data$vulnerable_role, ""))," </b><br>",
+                                         Pedestrian_Crash_Data$CrashDate, "</br>",
+                                         Pedestrian_Crash_Data$PedestrianInjurySeverity, "</br>",
+                                         replace_na(Pedestrian_Crash_Data$vulnerable_role, ""), " age: ", ifelse(!is.na(Pedestrian_Crash_Data$PedestrianAge), Pedestrian_Crash_Data$PedestrianAge, "unknown age")), htmltools::HTML),
+                   group = "Crash Points") %>%
+  addLegend(position = "bottomleft", labels = injury_severity$InjSevName, colors = injury_severity$color, group = "Crash Points", title = "Injury Severity") %>%
+  groupOptions(group = "Schools", zoomLevels = 15:20) %>%
+  groupOptions(group = "Crash Points", zoomLevels = 13:20) %>%
+  groupOptions(group = "County Lines", zoomLevels = 5:20) %>%
+  groupOptions(group = "Heat Map", zoomLevels = 5:13)
+
+  
+milwaukee_crash_map
+
+saveWidget(milwaukee_crash_map, file = "figures/dynamic_crash_maps/milwaukee_pedestrian_crash_map.html", selfcontained = TRUE)
+```

README.md

@@ -16,6 +16,8 @@ This is a series of RMarkdown files that generates maps of crashes between motor
 - OpenStreetMap Routing Machine `make osrm`: this downloads the most recent OpenStreetMap data for Wisconsin, and starts docker containers to run the OpenStreetMap Routing Machine to calculate IsoDistances.
 - School Crash Maps `make schoolpdfs`: generates maps of all the schools in Wisconsin and where cars are hitting kids This script pulls in the TOPS data from a folder of csv’s that you’ve downloaded from the data retrieval tool. It also draws the walk boundary around each school, this is done with a OpenStreetMap routing engine that is running in a docker container. It also needs access to an API key for StadiaMaps to download all the basemap tiles. I recommend downloading the whole state and filtering the data with the script. You can edit file `parameters/run_parameters` to choose what county, school type, and district to generate maps for
 - Dynamic Map `make crashmaps_dynamic`: This takes the TOPS data and generates dynamic leaflet maps to host on our website. It generates 4 maps: without a title (for in a frame), and with a title, in both English and Spanish.
+- Milwaukee Specific map `crashmaps_dynamic_milwaukee`: generate a web map for Milwaukee that includes more fine-grained visualizations of crash densities.
+
 
 ## R Scripts
 I'm working to move these to RMarkdown files