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

edited MilWALKeeWalks.Rmd

Browse source
This commit is contained in:
Ben Varick 2025-09-23 13:16:17 -07:00
parent 8ffee34eeb
commit fe8063e802
Signed by: ben
SSH key fingerprint: SHA256:jWnpFDAcacYM5aPFpYRqlsamlDyKNpSj3jj+k4ojtUo
1 changed files with 38 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

58
R/MilWALKeeWalks.Rmd
View file

@ -220,22 +220,27 @@ county_populations <- get_estimates(geography = "county",
filter(variable == "POPESTIMATE") %>% filter(variable == "POPESTIMATE") %>%
mutate(County = str_to_upper(str_replace(NAME, " County, Wisconsin", ""))) mutate(County = str_to_upper(str_replace(NAME, " County, Wisconsin", "")))
county_populations <- st_transform(county_populations, crs = 4326) %>% filter(County %in% focus_county) county_populations <- st_transform(county_populations, crs = 4326) %>% filter(County %in% focus_county)
```
## make hex grids and join with crash data ----
```{r hexgrids, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
hexgrid <- rowid_to_column(st_transform(st_as_sf(st_make_grid(st_transform(county_populations, crs = 32616), hexgrid <- rowid_to_column(st_transform(st_as_sf(st_make_grid(st_transform(county_populations, crs = 32616),
cellsize = 3000, cellsize = 3000,
what = 'polygons', what = 'polygons',
square = FALSE square = FALSE
)), crs = 4326), "ID") )), crs = 4326), "ID")
yearsforprior <- 8 yearsforprior <- 7
hex_crashes <- st_join(hexgrid, hex_crashes <- st_join(hexgrid,
st_as_sf(TOPS_data_filtered %>% st_as_sf(TOPS_data_filtered %>%
filter(vulnerable_role %in% "Pedestrian") %>% filter(vulnerable_role %in% "Pedestrian") %>%
#filter(ped_inj %in% c("A", "K", "B")) %>%
filter(!is.na(latitude)), filter(!is.na(latitude)),
coords = c("longitude", "latitude"), coords = c("longitude", "latitude"),
crs = 4326), crs = 4326),
join = st_contains) %>% join = st_contains) %>%
filter(!is.na(year)) %>% filter(!is.na(year)) %>%
filter(date >= (max(date) - (365 * yearsforprior))) %>% filter(date > (max(date) - (365 * (yearsforprior + 1)))) %>%
mutate(lastyear = ifelse((date <= max(date) - 365), mutate(lastyear = ifelse((date <= max(date) - 365),
"prior", "prior",
"lastyear")) %>% "lastyear")) %>%
@ -264,12 +269,13 @@ hexgrid_small <- rowid_to_column(st_transform(st_as_sf(st_make_grid(st_transform
hex_crashes_small <- st_join(hexgrid_small, hex_crashes_small <- st_join(hexgrid_small,
st_as_sf(TOPS_data_filtered %>% st_as_sf(TOPS_data_filtered %>%
filter(vulnerable_role %in% "Pedestrian") %>% filter(vulnerable_role %in% "Pedestrian") %>%
#filter(ped_inj %in% c("A", "K", "B")) %>%
filter(!is.na(latitude)), filter(!is.na(latitude)),
coords = c("longitude", "latitude"), coords = c("longitude", "latitude"),
crs = 4326), crs = 4326),
join = st_contains) %>% join = st_contains) %>%
filter(!is.na(year)) %>% filter(!is.na(year)) %>%
filter(date >= (max(date) - (365 * yearsforprior))) %>% filter(date > (max(date) - (365 * (yearsforprior + 1)))) %>%
mutate(lastyear = ifelse((date <= max(date) - 365), mutate(lastyear = ifelse((date <= max(date) - 365),
"prior", "prior",
"lastyear")) %>% "lastyear")) %>%
@ -290,6 +296,17 @@ hex_crashes_small_points <- st_centroid(hex_crashes_small)
``` ```
```{r previousyearstring, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
previousyearstring <- paste0(format(max(TOPS_data_filtered$date, na.rm = TRUE) - 365 + 1, "%m/%Y"), " - ", format(max(TOPS_data_filtered$date, na.rm = TRUE), "%m/%Y"))
```
```{r importprojects, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
projects_2024 <- read_sf(dsn = "data/MilWALKeeWalks/projects_2024.kml")
projects_2023 <- read_sf(dsn = "data/MilWALKeeWalks/projects_2023.kml")
```
```{r MilwaukeeMaps, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r MilwaukeeMaps, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# get basemap # get basemap
bbox <- st_bbox(county_populations) bbox <- st_bbox(county_populations)
@ -304,9 +321,9 @@ ggmap(basemap) +
labs(title = paste0("Crashes between cars and pedestrians"), labs(title = paste0("Crashes between cars and pedestrians"),
subtitle = paste0(str_to_title(focus_county), subtitle = paste0(str_to_title(focus_county),
" County | ", " County | ",
min(year(TOPS_data$date), na.rm = TRUE), year(min(TOPS_data_filtered$date, na.rm = TRUE)),
" - ", " - ",
max(year(TOPS_data$date), na.rm = TRUE)), year(max(TOPS_data_filtered$date, na.rm = TRUE))),
caption = paste0("crash data from UW TOPS lab - retrieved ", caption = paste0("crash data from UW TOPS lab - retrieved ",
strftime(retrieve_date, format = "%m/%Y"), strftime(retrieve_date, format = "%m/%Y"),
"\nper direction of the WisDOT Bureau of Transportation Safety", "\nper direction of the WisDOT Bureau of Transportation Safety",
@ -314,7 +331,7 @@ ggmap(basemap) +
x = NULL, x = NULL,
y = NULL, y = NULL,
size = paste0("Total crashes"), size = paste0("Total crashes"),
fill = paste0("last 12 months\ncompared to previous\n", yearsforprior, " years")) + fill = paste0(previousyearstring, "\ncompared to\nprevious years")) +
theme(axis.text=element_blank(), theme(axis.text=element_blank(),
axis.ticks=element_blank(), axis.ticks=element_blank(),
plot.caption = element_text(color = "grey", size = 8)) + plot.caption = element_text(color = "grey", size = 8)) +
@ -349,9 +366,7 @@ ggmap(basemap) +
labs(title = paste0("Crashes between cars and pedestrians"), labs(title = paste0("Crashes between cars and pedestrians"),
subtitle = paste0(str_to_title(focus_county), subtitle = paste0(str_to_title(focus_county),
" County | ", " County | ",
min(year(TOPS_data$date), na.rm = TRUE), previousyearstring),
" - ",
max(year(TOPS_data$date), na.rm = TRUE)),
caption = paste0("crash data from UW TOPS lab - retrieved ", caption = paste0("crash data from UW TOPS lab - retrieved ",
strftime(retrieve_date, format = "%m/%Y"), strftime(retrieve_date, format = "%m/%Y"),
"\nper direction of the WisDOT Bureau of Transportation Safety", "\nper direction of the WisDOT Bureau of Transportation Safety",
@ -359,7 +374,7 @@ ggmap(basemap) +
x = NULL, x = NULL,
y = NULL, y = NULL,
size = paste0("Total crashes"), size = paste0("Total crashes"),
fill = "Crashes in the last 12 months\ncompared to previous average") + fill = "Crashes in the last year\ncompared to previous average") +
theme(axis.text=element_blank(), theme(axis.text=element_blank(),
axis.ticks=element_blank(), axis.ticks=element_blank(),
plot.caption = element_text(color = "grey", size = 8)) + plot.caption = element_text(color = "grey", size = 8)) +
@ -376,7 +391,7 @@ ggmap(basemap) +
midpoint = 0, midpoint = 0,
# limits = c(-2, 2), # limits = c(-2, 2),
# oob = scales::squish # oob = scales::squish
) ) # + geom_sf(data = projects_2023, inherit.aes = FALSE)
ggsave(file = paste0("figures/MilWALKee_Walks/", ggsave(file = paste0("figures/MilWALKee_Walks/",
"milwaukee_map_crashchange.png"), "milwaukee_map_crashchange.png"),
@ -390,7 +405,8 @@ highlighted_areas <- hex_crashes %>%
mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>% mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>%
filter(prior > 100, filter(prior > 100,
(lastyearchange > 5 | (lastyearchange > 5 |
lastyearchange < -1)) %>% pull(ID) lastyearchange < -2)) %>% pull(ID)
highlighted_areas <- c(62, 69, 78, 85)
ggmap(basemap) + ggmap(basemap) +
labs(title = paste0("Crashes between cars and pedestrians\nselect areas of the county"), labs(title = paste0("Crashes between cars and pedestrians\nselect areas of the county"),
@ -425,7 +441,7 @@ ggmap(basemap) +
mid = "white", mid = "white",
high = "red", high = "red",
midpoint = 0, midpoint = 0,
limits = c(-2, 2), limits = c(-1, 1),
oob = scales::squish, oob = scales::squish,
labels = scales::percent labels = scales::percent
) )
@ -438,7 +454,7 @@ ggsave(file = paste0("figures/MilWALKee_Walks/",
units = "in", units = "in",
create.dir = TRUE) create.dir = TRUE)
bbox <- st_bbox(st_union(hexgrid %>% filter(ID %in% c(78, 85, 94)))) bbox <- st_bbox(st_union(hexgrid %>% filter(ID %in% highlighted_areas)))
bbox <- c(left = as.double(bbox[1]), bbox <- c(left = as.double(bbox[1]),
bottom = as.double(bbox[2]), bottom = as.double(bbox[2]),
right = as.double(bbox[3]), right = as.double(bbox[3]),
@ -466,7 +482,9 @@ ggmap(basemap) +
plot.caption = element_text(color = "grey", size = 8)) + plot.caption = element_text(color = "grey", size = 8)) +
#add hexagons #add hexagons
new_scale_fill() + new_scale_fill() +
geom_sf(data = hex_crashes_small %>% mutate(lastyearchange = (lastyear - prior/yearsforprior)), geom_sf(data = hex_crashes_small %>%
mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>%
filter(!is.na(lastyearchange)),
inherit.aes = FALSE, inherit.aes = FALSE,
aes(fill = lastyearchange), aes(fill = lastyearchange),
alpha = 0.5) + alpha = 0.5) +
@ -478,12 +496,12 @@ ggmap(basemap) +
midpoint = 0, midpoint = 0,
# limits = c(-2, 2), # limits = c(-2, 2),
# oob = scales::squish # oob = scales::squish
name = "Crashes last year compared to previous average") + name = "Crashes last year\ncompared to previous average") +
# add crash locations # add crash locations
new_scale_fill() + new_scale_fill() +
geom_point(data = TOPS_data_filtered %>% geom_point(data = TOPS_data_filtered %>%
filter(date >= max(TOPS_data_filtered$date) - 365) %>% filter(date > max(TOPS_data_filtered$date) - 365) %>%
#filter(ped_inj %in% c("K", "A")) %>% #filter(ped_inj %in% c("K", "A", "B")) %>%
filter(vulnerable_role %in% "Pedestrian") %>% filter(vulnerable_role %in% "Pedestrian") %>%
filter(longitude >= as.double(bbox[1]), filter(longitude >= as.double(bbox[1]),
latitude >= as.double(bbox[2]), latitude >= as.double(bbox[2]),
@ -495,7 +513,7 @@ ggmap(basemap) +
fill = ped_inj_name), fill = ped_inj_name),
shape = 23, shape = 23,
size = 3) + size = 3) +
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = "Crash Severity") scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))# + geom_sf(data = projects_2023, inherit.aes = FALSE)
ggsave(file = paste0("figures/MilWALKee_Walks/", ggsave(file = paste0("figures/MilWALKee_Walks/",
"milwaukee_map_zoomchange.png"), "milwaukee_map_zoomchange.png"),