ben/wisconsin_crashes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

edited dynamic map using leaflet

Browse Source
This commit is contained in:
Ben Varick 2024-04-02 17:53:52 -05:00
parent f746f410bc
commit bea2ff435e
Signed by: ben
SSH Key Fingerprint: SHA256:758jG979jvr5HnQJl1AQ/NYTyzXRgnuoVM/yCR024sE
3 changed files with 115 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.Rhistory
View File

@ -0,0 +1,4 @@
library(tidyverse)
library(sf)
library(tmap)
remotes::install_github('r-tmap/tmap')

14
figures/dynamic_crash_maps/dynamic_crash_map.html
View File

File diff suppressed because one or more lines are too long

107
scripts/dynamic_crash_map.R
View File

@ -1,6 +1,11 @@
library(tidyverse)
library(sf)
library(tmap)
library(leaflet)
library(leaflegend)
library(RColorBrewer)
library(tidycensus)
library(htmltools)
## Load TOPS data ----
## To load TOPS data for the whole state for crashes involving bikes and pedestrians):
@ -62,6 +67,7 @@ TOPS_data <- TOPS_data %>%
PedestrianInjurySeverity = ped_inj_name,
CrashDate = CRSHDATE,
CrashTime = CRSHTIME,
County = CNTYNAME,
Street = ONSTR,
CrossStreet = ATSTR) %>%
mutate(PedestrianAge = ifelse(ROLE1 %in% c("BIKE", "PED"), age1, age2))
@ -69,10 +75,12 @@ TOPS_data <- TOPS_data %>%
TOPS_geom <- st_as_sf(TOPS_data %>% filter(!is.na(latitude)), coords = c("longitude", "latitude"), crs = 4326)
## generate map ----
tmap_mode("view")
focus_columns <- c("PedestrianInjurySeverity", "CrashDate", "CrashTime", "Street", "CrossStreet", "PedestrianAge")
focus_columns <- c("PedestrianInjurySeverity", "CrashDate", "CrashTime", "County", "Street", "CrossStreet", "PedestrianAge")
focus_county <- "DANE"
## generate map with tmap ----
tmap_mode("view")
Pedestrian_Crash_Data <- TOPS_geom %>%
# filter(CNTYNAME == focus_county) %>%
select(all_of(focus_columns))
@ -82,3 +90,96 @@ tm_basemap("Stadia.AlidadeSmooth") +
tm_dots("PedestrianInjurySeverity", palette = injury_severity$color, popup.vars = focus_columns)
tmap_save(file = "figures/dynamic_crash_maps/dynamic_crash_map.html")
# generate map with leaflet ----
Pedestrian_Crash_Data <- TOPS_data %>%
# filter(CNTYNAME == focus_county) %>%
select(c(all_of(focus_columns), "longitude", "latitude"))
injury_severity_pal <- colorFactor(palette = injury_severity$color, domain = injury_severity$InjSevName)
County_Crash_Data <- Pedestrian_Crash_Data %>%
group_by(County) %>%
summarise(TotalCrashes = n(),
longitude = mean(longitude, na.rm = TRUE),
latitude = mean(latitude, na.rm = TRUE))
# add population census data
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") %>%
filter(variable == "POPESTIMATE") %>%
mutate(County = str_to_upper(str_replace(NAME, " County, Wisconsin", "")))
County_Crash_Data <- left_join(County_Crash_Data, county_populations, join_by("County"))
County_Crash_Data <- County_Crash_Data %>%
mutate(CrashesPerPopulation = TotalCrashes/value.y*100000)
county_pal <- colorNumeric(palette = "YlOrRd", domain = c(min(County_Crash_Data$CrashesPerPopulation, na.rm = TRUE), max(County_Crash_Data$CrashesPerPopulation, na.rm = TRUE)))
#title style
tag.map.title <- tags$style(HTML("
.leaflet-control.map-title {
transform: translate(-50%,20%);
position: fixed !important;
left: 50%;
text-align: center;
padding-left: 10px;
padding-right: 10px;
background: rgba(255,255,255,0.75);
font-weight: bold;
font-size: 28px;
}
"))
title <- tags$div(
tag.map.title, HTML("Pedestrian Crashes")
)
tag.map.subtitle <- tags$style(HTML("
.leaflet-control.map-subtitle {
transform: translate(-50%,20%);
position: fixed !important;
left: 80%;
text-align: center;
padding-left: 10px;
padding-right: 10px;
background: rgba(255,255,255,0.75);
font-weight: regular;
font-size: 12px;
}
"))
subtitle <- tags$div(
tag.map.subtitle, HTML("data from UW TOPS lab\n2017-2023")
)
leaflet() %>%
addControl(title, position = "topleft", className="map-title") %>%
addControl(subtitle, position = "topleft", className="map-subtitle") %>%
addProviderTiles(providers$Stadia.AlidadeSmooth) %>%
addCircleMarkers(data = Pedestrian_Crash_Data,
lng=Pedestrian_Crash_Data$longitude,
lat=Pedestrian_Crash_Data$latitude,
fillColor=injury_severity_pal(Pedestrian_Crash_Data$PedestrianInjurySeverity),
radius=3,
stroke=TRUE,
color = "black",
weight = 1,
fillOpacity = 0.8,
group = "Crash Points") %>%
addLegend(position = "bottomleft", labels = injury_severity$InjSevName, colors = injury_severity$color, group = "Crash Points", title = "Injury Severity") %>%
groupOptions(group = "Crash Points", zoomLevels = 10:20) %>%
addCircleMarkers(data = County_Crash_Data,
lng=County_Crash_Data$longitude,
lat=County_Crash_Data$latitude,
fillColor=county_pal(County_Crash_Data$CrashesPerPopulation),
radius=County_Crash_Data$value.y/20000,
stroke = TRUE,
color = "black",
weight = 1,
fillOpacity = 0.7,
group = "Counties") %>%
addLegend(position = "bottomleft", pal = county_pal, values = County_Crash_Data$CrashesPerPopulation, group = "Counties", title = "Crashes per 100,000 residents") %>%
# addLegendSize(position = "bottomright", color = "black", shape = "circle", values = County_Crash_Data$value.y, group = "Counties", title = "Population of County") %>%
groupOptions(group ="Counties", zoomLevels = 1:9)