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

@@ -14,10 +14,12 @@ This is a series of RMarkdown files that generates maps of crashes between motor
 
 - Pre Process TOPS data `make TOPS_data_process`: This combines TOPS data exports from different years and reformats the data.
 - 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 summary csv files that summarize the crash data for a given municipality and county by age, sex, race. This script pulls in the TOPS data from a folder of csv’s that you’ve downloaded from the data retrieval tool. I recommend downloading the whole state and filtering the data with the script. You can edit the variables: municipality_focus, county_focus to adjust what city you're looking at. Line 50
+- 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
 - City maps - generates maps for cities in Wisconsin where pedestrian fatalities occur This script pulls in the TOPS data from a folder of csv’s that you’ve downloaded from the data retrieval tool. It also needs access to an API key for StadiaMaps to download all the basemap tiles. You can specify the cities by changing the focus parameters at line ~80
-- School Crash maps - 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. It took my computer 12 hours to generate all the maps for the state. The script that ends “parallel” runs it in parallel to speed this up. Use that script for bulk map generation, use the other one for generating the maps of a couple school districts. You can change what districts or counties or school types you are generating maps for by editing the variables at line 116 or so.
-- Dynamic Map: This takes the TOPS data and generates a dynamic map to host
+- Crash summaries - generates summary csv files that summarize the crash data for a given municipality and county by age, sex, race.