diff --git a/.Rhistory b/.Rhistory index e69de29..8e51e70 100644 --- a/.Rhistory +++ b/.Rhistory @@ -0,0 +1,4 @@ +library(tidyverse) +library(sf) +library(tmap) +remotes::install_github('r-tmap/tmap') diff --git a/figures/dynamic_crash_maps/dynamic_crash_map.html b/figures/dynamic_crash_maps/dynamic_crash_map.html index adae293..846338f 100644 --- a/figures/dynamic_crash_maps/dynamic_crash_map.html +++ b/figures/dynamic_crash_maps/dynamic_crash_map.html @@ -1,8 +1,8 @@ - + -leaflet + + - +
-
+
- - + + diff --git a/scripts/dynamic_crash_map.R b/scripts/dynamic_crash_map.R index fd0b2e5..ab44259 100644 --- a/scripts/dynamic_crash_map.R +++ b/scripts/dynamic_crash_map.R @@ -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) +