edited dynamic map using leaflet

.Rhistory

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

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 ----
+focus_columns <- c("PedestrianInjurySeverity", "CrashDate", "CrashTime", "County", "Street", "CrossStreet", "PedestrianAge")
-tmap_mode("view")
-focus_columns <- c("PedestrianInjurySeverity", "CrashDate", "CrashTime", "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)
+