diff --git a/Makefile b/Makefile index 81dad75..c8b161f 100644 --- a/Makefile +++ b/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 diff --git a/R/dynamic_crash_map.Rmd b/R/dynamic_crash_map.Rmd index 9858966..0c38ed9 100644 --- a/R/dynamic_crash_map.Rmd +++ b/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} diff --git a/R/dynamic_crash_map_milwaukee.Rmd b/R/dynamic_crash_map_milwaukee.Rmd new file mode 100644 index 0000000..d6123ac --- /dev/null +++ b/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("", WI_schools$SCHOOL, " School
", + WI_schools$DISTRICT, " School District
", + 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("", str_to_title(replace_na(Pedestrian_Crash_Data$vulnerable_role, "")),"
", + Pedestrian_Crash_Data$CrashDate, "
", + Pedestrian_Crash_Data$PedestrianInjurySeverity, "
", + 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) +``` \ No newline at end of file diff --git a/README.md b/README.md index ee033cd..8cff4a5 100644 --- a/README.md +++ b/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 diff --git a/figures/dynamic_crash_maps/milwaukee_pedestrian_crash_map.html b/figures/dynamic_crash_maps/milwaukee_pedestrian_crash_map.html index 13166d5..63c201e 100644 --- a/figures/dynamic_crash_maps/milwaukee_pedestrian_crash_map.html +++ b/figures/dynamic_crash_maps/milwaukee_pedestrian_crash_map.html @@ -5254,9 +5254,9 @@ function asArray(value) {
-
+
- - + +