made markers larger in dynamic map

This commit is contained in:
Ben Varick 2024-04-06 21:22:01 -05:00
parent 0c5bd3444a
commit 6fdfaf6b4e
Signed by: ben
SSH Key Fingerprint: SHA256:jWnpFDAcacYM5aPFpYRqlsamlDyKNpSj3jj+k4ojtUo
2 changed files with 23 additions and 23 deletions

File diff suppressed because one or more lines are too long

View File

@ -35,7 +35,7 @@ TOPS_data <- TOPS_data %>%
year = as.factor(year(date))) year = as.factor(year(date)))
retrieve_date <- max(TOPS_data %>% filter(year %in% max(year(TOPS_data$date), na.rm = TRUE)) %>% pull(retreive_date)) retrieve_date <- max(TOPS_data %>% filter(year %in% max(year(TOPS_data$date), na.rm = TRUE)) %>% pull(retreive_date))
# Injury Severy Index and Color ----- # Injury Severy Index and Color -----
injury_severity <- data.frame(InjSevName = c("No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"), injury_severity <- data.frame(InjSevName = c("No apparent injury", "Possible Injury", "Suspected Minor Injury","Suspected Serious Injury","Fatality"),
@ -177,8 +177,8 @@ tag.map.subtitle <- tags$style(HTML("
wisconsin_crash_map <- wisconsin_crash_map <-
leaflet(options = leafletOptions(preferCanvas = TRUE)) %>% leaflet(options = leafletOptions(preferCanvas = TRUE)) %>%
# addControl(title, position = "topleft", className="map-title") %>% # addControl(title, position = "topleft", className="map-title") %>%
# addControl(subtitle, position = "bottomleft", className="map-subtitle") %>% # addControl(subtitle, position = "bottomleft", className="map-subtitle") %>%
addProviderTiles(providers$Stadia.AlidadeSmooth) %>% addProviderTiles(providers$Stadia.AlidadeSmooth) %>%
addMarkers(data = WI_schools, addMarkers(data = WI_schools,
lng=WI_schools$LON, lng=WI_schools$LON,
@ -187,33 +187,31 @@ wisconsin_crash_map <-
WI_schools$DISTRICT, " School District</br>", WI_schools$DISTRICT, " School District</br>",
WI_schools$SCHOOLTYPE), htmltools::HTML), WI_schools$SCHOOLTYPE), htmltools::HTML),
group = "Schools") %>% group = "Schools") %>%
groupOptions(group = "Schools", zoomLevels = 13:20) %>%
addCircleMarkers(data = Pedestrian_Crash_Data, addCircleMarkers(data = Pedestrian_Crash_Data,
lng=Pedestrian_Crash_Data$longitude, lng=Pedestrian_Crash_Data$longitude,
lat=Pedestrian_Crash_Data$latitude, lat=Pedestrian_Crash_Data$latitude,
fillColor=injury_severity_pal(Pedestrian_Crash_Data$PedestrianInjurySeverity), fillColor=injury_severity_pal(Pedestrian_Crash_Data$PedestrianInjurySeverity),
radius=3, radius=4,
stroke=TRUE, stroke=TRUE,
color = "black", color = "black",
weight = 1, weight = 1,
fillOpacity = 0.8, fillOpacity = 0.8,
label = lapply(paste0("<b>", Pedestrian_Crash_Data$CrashDate, "</b></br>", label = lapply(paste0("<b>", Pedestrian_Crash_Data$CrashDate, "</b></br>",
Pedestrian_Crash_Data$PedestrianInjurySeverity, "</br>", Pedestrian_Crash_Data$PedestrianInjurySeverity, "</br>",
"pedestrian age: ", Pedestrian_Crash_Data$PedestrianAge), htmltools::HTML), "pedestrian age: ", Pedestrian_Crash_Data$PedestrianAge), htmltools::HTML),
group = "Crash Points") %>% group = "Crash Points") %>%
addLegend(position = "bottomleft", labels = injury_severity$InjSevName, colors = injury_severity$color, group = "Crash Points", title = "Injury Severity") %>% 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_geom,
addCircleMarkers(data = County_Crash_geom, lng=County_Crash_geom$longitude,
lng=County_Crash_geom$longitude, lat=County_Crash_geom$latitude,
lat=County_Crash_geom$latitude, #fillColor=county_pal(County_Crash_geom$CrashesPerPopulation),
#fillColor=county_pal(County_Crash_geom$CrashesPerPopulation), radius=County_Crash_geom$value/20000,
radius=County_Crash_geom$value/20000, stroke = TRUE,
stroke = TRUE, color = "black",
color = "black", weight = 1,
weight = 1, fillOpacity = 0.5,
fillOpacity = 0.5, group = "Counties") %>%
group = "Counties") %>% addPolygons(data = County_Crash_geom,
addPolygons(data = County_Crash_geom,
color = "black", color = "black",
weight = 1, weight = 1,
fillColor=county_pal(County_Crash_geom$CrashesPerPopulation), fillColor=county_pal(County_Crash_geom$CrashesPerPopulation),
@ -224,7 +222,9 @@ wisconsin_crash_map <-
"average crashes/year per 100k residents: ", round(County_Crash_geom$CrashesPerPopulation,0)), htmltools::HTML), "average crashes/year per 100k residents: ", round(County_Crash_geom$CrashesPerPopulation,0)), htmltools::HTML),
group = "Counties") %>% group = "Counties") %>%
addLegend(position = "bottomleft", pal = county_pal, values = County_Crash_geom$CrashesPerPopulation, group = "Counties", title = "Circle size = county population<br><br>Color = Crashes/year</br>(normalized per 100k residents)") %>% addLegend(position = "bottomleft", pal = county_pal, values = County_Crash_geom$CrashesPerPopulation, group = "Counties", title = "Circle size = county population<br><br>Color = Crashes/year</br>(normalized per 100k residents)") %>%
# addLegendSize(position = "bottomright", color = "black", shape = "circle", values = County_Crash_geom$value, group = "Counties", title = "Total crashes") %>% # addLegendSize(position = "bottomright", color = "black", shape = "circle", values = County_Crash_geom$value, group = "Counties", title = "Total crashes") %>%
groupOptions(group = "Schools", zoomLevels = 13:20) %>%
groupOptions(group = "Crash Points", zoomLevels = 10:20) %>%
groupOptions(group ="Counties", zoomLevels = 1:9) groupOptions(group ="Counties", zoomLevels = 1:9)
saveWidget(wisconsin_crash_map, file = "figures/dynamic_crash_maps/wisconsin_crash_map.html", selfcontained = TRUE) saveWidget(wisconsin_crash_map, file = "figures/dynamic_crash_maps/wisconsin_crash_map.html", selfcontained = TRUE)