diff --git a/R/MilWALKeeWalks.Rmd b/R/MilWALKeeWalks.Rmd index 3aba142..8d702bf 100644 --- a/R/MilWALKeeWalks.Rmd +++ b/R/MilWALKeeWalks.Rmd @@ -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)) ```