edited dynamic map using leaflet
This commit is contained in:
parent
f746f410bc
commit
bea2ff435e
@ -0,0 +1,4 @@
|
|||||||
|
library(tidyverse)
|
||||||
|
library(sf)
|
||||||
|
library(tmap)
|
||||||
|
remotes::install_github('r-tmap/tmap')
|
File diff suppressed because one or more lines are too long
@ -1,6 +1,11 @@
|
|||||||
library(tidyverse)
|
library(tidyverse)
|
||||||
library(sf)
|
library(sf)
|
||||||
library(tmap)
|
library(tmap)
|
||||||
|
library(leaflet)
|
||||||
|
library(leaflegend)
|
||||||
|
library(RColorBrewer)
|
||||||
|
library(tidycensus)
|
||||||
|
library(htmltools)
|
||||||
|
|
||||||
## Load TOPS data ----
|
## Load TOPS data ----
|
||||||
## To load TOPS data for the whole state for crashes involving bikes and pedestrians):
|
## 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,
|
PedestrianInjurySeverity = ped_inj_name,
|
||||||
CrashDate = CRSHDATE,
|
CrashDate = CRSHDATE,
|
||||||
CrashTime = CRSHTIME,
|
CrashTime = CRSHTIME,
|
||||||
|
County = CNTYNAME,
|
||||||
Street = ONSTR,
|
Street = ONSTR,
|
||||||
CrossStreet = ATSTR) %>%
|
CrossStreet = ATSTR) %>%
|
||||||
mutate(PedestrianAge = ifelse(ROLE1 %in% c("BIKE", "PED"), age1, age2))
|
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)
|
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"
|
focus_county <- "DANE"
|
||||||
|
|
||||||
|
## generate map with tmap ----
|
||||||
|
tmap_mode("view")
|
||||||
|
|
||||||
Pedestrian_Crash_Data <- TOPS_geom %>%
|
Pedestrian_Crash_Data <- TOPS_geom %>%
|
||||||
# filter(CNTYNAME == focus_county) %>%
|
# filter(CNTYNAME == focus_county) %>%
|
||||||
select(all_of(focus_columns))
|
select(all_of(focus_columns))
|
||||||
@ -82,3 +90,96 @@ tm_basemap("Stadia.AlidadeSmooth") +
|
|||||||
tm_dots("PedestrianInjurySeverity", palette = injury_severity$color, popup.vars = focus_columns)
|
tm_dots("PedestrianInjurySeverity", palette = injury_severity$color, popup.vars = focus_columns)
|
||||||
|
|
||||||
tmap_save(file = "figures/dynamic_crash_maps/dynamic_crash_map.html")
|
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)
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user