edited MilWALKeeWalks.Rmd again

This commit is contained in:
Ben Varick 2025-09-24 11:12:16 -07:00
parent fe8063e802
commit ac3decc6fb
Signed by: ben
SSH key fingerprint: SHA256:jWnpFDAcacYM5aPFpYRqlsamlDyKNpSj3jj+k4ojtUo

View file

@ -254,7 +254,9 @@ hex_crashes <- st_join(hexgrid,
hex_crashes <- st_as_sf(left_join(hexgrid, hex_crashes), crs = 4326)
hex_crashes <- hex_crashes %>%
mutate(lastyearchange = (lastyear - prior/yearsforprior)/(prior/yearsforprior))
mutate(prioryearlyaverage = prior/yearsforprior) %>%
mutate(lastyearchangepercent = (lastyear - prioryearlyaverage)/prioryearlyaverage,
lastyearchangecrashes = lastyear - prioryearlyaverage)
hex_crashes_points <- st_centroid(hex_crashes)
@ -289,7 +291,9 @@ hex_crashes_small <- st_join(hexgrid_small,
hex_crashes_small <- st_as_sf(left_join(hexgrid_small, hex_crashes_small), crs = 4326)
hex_crashes_small <- hex_crashes_small %>%
mutate(lastyearchange = (lastyear - prior/yearsforprior)/(prior/yearsforprior))
mutate(prioryearlyaverage = prior/yearsforprior) %>%
mutate(lastyearchangepercent = (lastyear - prioryearlyaverage)/prioryearlyaverage,
lastyearchangecrashes = lastyear - prioryearlyaverage)
hex_crashes_small_points <- st_centroid(hex_crashes_small)
@ -339,7 +343,7 @@ ggmap(basemap) +
geom_sf(data = hex_crashes_points %>% filter(is.double(total), !is.na(total)),
inherit.aes = FALSE,
aes(size = total,
fill = lastyearchange),
fill = lastyearchangepercent),
linewidth = 0,
shape = 21,
color = "black") +
@ -379,9 +383,9 @@ ggmap(basemap) +
axis.ticks=element_blank(),
plot.caption = element_text(color = "grey", size = 8)) +
# add crash locations
geom_sf(data = hex_crashes %>% mutate(lastyearchange = (lastyear - prior/yearsforprior)),
geom_sf(data = hex_crashes,
inherit.aes = FALSE,
aes(fill = lastyearchange),
aes(fill = lastyearchangecrashes),
alpha = 0.5) +
scale_size_area() +
scale_fill_gradient2(
@ -389,7 +393,7 @@ ggmap(basemap) +
mid = "white",
high = "red",
midpoint = 0,
# limits = c(-2, 2),
# limits = c(-20, 20),
# oob = scales::squish
) # + geom_sf(data = projects_2023, inherit.aes = FALSE)
@ -429,11 +433,11 @@ ggmap(basemap) +
# add crash locations
geom_sf(data = hex_crashes %>% filter(ID %in% highlighted_areas),
inherit.aes = FALSE,
aes(fill = lastyearchange),
aes(fill = lastyearchangepercent),
alpha = 0.5) +
geom_sf_text(data = hex_crashes_points %>% filter(ID %in% highlighted_areas),
inherit.aes = FALSE,
aes(label = paste0(ifelse(lastyearchange > 0, "+",""),round(lastyearchange * 100, 0), "%")),
aes(label = paste0(ifelse(lastyearchangepercent > 0, "+",""),round(lastyearchangepercent * 100, 0), "%")),
size = 3) +
scale_size_area() +
scale_fill_gradient2(
@ -482,11 +486,10 @@ ggmap(basemap) +
plot.caption = element_text(color = "grey", size = 8)) +
#add hexagons
new_scale_fill() +
geom_sf(data = hex_crashes_small %>%
mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>%
filter(!is.na(lastyearchange)),
geom_sf(data = hex_crashes_small %>%
filter(!is.na(lastyearchangecrashes)),
inherit.aes = FALSE,
aes(fill = lastyearchange),
aes(fill = lastyearchangecrashes),
alpha = 0.5) +
scale_size_area() +
scale_fill_gradient2(
@ -494,8 +497,8 @@ ggmap(basemap) +
mid = "white",
high = "red",
midpoint = 0,
# limits = c(-2, 2),
# oob = scales::squish
# limits = c(-10, 10),
# oob = scales::squish,
name = "Crashes last year\ncompared to previous average") +
# add crash locations
new_scale_fill() +
@ -513,7 +516,7 @@ ggmap(basemap) +
fill = ped_inj_name),
shape = 23,
size = 3) +
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))# + geom_sf(data = projects_2023, inherit.aes = FALSE)
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/",
"milwaukee_map_zoomchange.png"),
@ -523,7 +526,89 @@ ggsave(file = paste0("figures/MilWALKee_Walks/",
units = "in",
create.dir = TRUE)
##highland ave
bbox <- c(left = -87.967,
bottom = 43.043,
right = -87.944,
top = 43.051)
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
ggmap(basemap) +
labs(title = paste0("Crashes between cars and pedestrians"),
subtitle = paste0(str_to_title(focus_county),
" County | ",
min(year(TOPS_data$date), na.rm = TRUE),
" - ",
max(year(TOPS_data$date), na.rm = TRUE)),
caption = paste0("crash data from UW TOPS lab - retrieved ",
strftime(retrieve_date, format = "%m/%Y"),
"\nper direction of the WisDOT Bureau of Transportation Safety",
"\nbasemap from StadiaMaps and OpenStreetMap Contributers"),
x = NULL,
y = NULL,
size = paste0("Total crashes"),
fill = paste0("last 12 months\ncompared to previous\n", yearsforprior, " years")) +
theme(axis.text=element_blank(),
axis.ticks=element_blank(),
plot.caption = element_text(color = "grey", size = 8)) +
# add crash locations
new_scale_fill() +
geom_point(data = TOPS_data_filtered %>%
filter(year == 2025) %>%
#filter(ped_inj %in% c("K", "A", "B")) %>%
filter(vulnerable_role %in% "Pedestrian") %>%
filter(longitude >= as.double(bbox[1]),
latitude >= as.double(bbox[2]),
longitude <= as.double(bbox[3]),
latitude <= as.double(bbox[4])) %>%
arrange(ped_inj_name),
aes(x = longitude,
y = latitude,
fill = ped_inj_name),
shape = 23,
size = 3) +
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))
bbox <- c(left = -87.910,
bottom = 43.032,
right = -87.896,
top = 43.044)
basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
ggmap(basemap) +
labs(title = paste0("Crashes between cars and pedestrians"),
subtitle = paste0(str_to_title(focus_county),
" County | ",
min(year(TOPS_data$date), na.rm = TRUE),
" - ",
max(year(TOPS_data$date), na.rm = TRUE)),
caption = paste0("crash data from UW TOPS lab - retrieved ",
strftime(retrieve_date, format = "%m/%Y"),
"\nper direction of the WisDOT Bureau of Transportation Safety",
"\nbasemap from StadiaMaps and OpenStreetMap Contributers"),
x = NULL,
y = NULL,
size = paste0("Total crashes"),
fill = paste0("last 12 months\ncompared to previous\n", yearsforprior, " years")) +
theme(axis.text=element_blank(),
axis.ticks=element_blank(),
plot.caption = element_text(color = "grey", size = 8)) +
# add crash locations
new_scale_fill() +
geom_point(data = TOPS_data_filtered %>%
filter(year != 2025) %>%
#filter(ped_inj %in% c("K", "A", "B")) %>%
filter(vulnerable_role %in% "Pedestrian") %>%
filter(longitude >= as.double(bbox[1]),
latitude >= as.double(bbox[2]),
longitude <= as.double(bbox[3]),
latitude <= as.double(bbox[4])) %>%
arrange(ped_inj_name),
aes(x = longitude,
y = latitude,
fill = ped_inj_name),
shape = 23,
size = 3) +
scale_fill_manual(values = setNames(injury_severity$color, injury_severity$InjSevName), name = paste0("Crashes ", previousyearstring))
```