diff --git a/R/MilWALKeeWalks.Rmd b/R/MilWALKeeWalks.Rmd index 77a9b2e..3aba142 100644 --- a/R/MilWALKeeWalks.Rmd +++ b/R/MilWALKeeWalks.Rmd @@ -220,22 +220,27 @@ county_populations <- get_estimates(geography = "county", filter(variable == "POPESTIMATE") %>% mutate(County = str_to_upper(str_replace(NAME, " County, Wisconsin", ""))) 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), cellsize = 3000, what = 'polygons', square = FALSE )), crs = 4326), "ID") -yearsforprior <- 8 +yearsforprior <- 7 hex_crashes <- st_join(hexgrid, st_as_sf(TOPS_data_filtered %>% filter(vulnerable_role %in% "Pedestrian") %>% + #filter(ped_inj %in% c("A", "K", "B")) %>% filter(!is.na(latitude)), coords = c("longitude", "latitude"), crs = 4326), join = st_contains) %>% filter(!is.na(year)) %>% - filter(date >= (max(date) - (365 * yearsforprior))) %>% + filter(date > (max(date) - (365 * (yearsforprior + 1)))) %>% mutate(lastyear = ifelse((date <= max(date) - 365), "prior", "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, st_as_sf(TOPS_data_filtered %>% filter(vulnerable_role %in% "Pedestrian") %>% + #filter(ped_inj %in% c("A", "K", "B")) %>% filter(!is.na(latitude)), coords = c("longitude", "latitude"), crs = 4326), join = st_contains) %>% filter(!is.na(year)) %>% - filter(date >= (max(date) - (365 * yearsforprior))) %>% + filter(date > (max(date) - (365 * (yearsforprior + 1)))) %>% mutate(lastyear = ifelse((date <= max(date) - 365), "prior", "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} # get basemap bbox <- st_bbox(county_populations) @@ -304,9 +321,9 @@ 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)), + year(min(TOPS_data_filtered$date, na.rm = TRUE)), + " - ", + year(max(TOPS_data_filtered$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", @@ -314,7 +331,7 @@ ggmap(basemap) + x = NULL, y = NULL, 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(), axis.ticks=element_blank(), plot.caption = element_text(color = "grey", size = 8)) + @@ -349,9 +366,7 @@ 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)), + previousyearstring), caption = paste0("crash data from UW TOPS lab - retrieved ", strftime(retrieve_date, format = "%m/%Y"), "\nper direction of the WisDOT Bureau of Transportation Safety", @@ -359,7 +374,7 @@ ggmap(basemap) + x = NULL, y = NULL, 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(), axis.ticks=element_blank(), plot.caption = element_text(color = "grey", size = 8)) + @@ -376,7 +391,7 @@ ggmap(basemap) + midpoint = 0, # limits = c(-2, 2), # oob = scales::squish - ) + ) # + geom_sf(data = projects_2023, inherit.aes = FALSE) ggsave(file = paste0("figures/MilWALKee_Walks/", "milwaukee_map_crashchange.png"), @@ -390,7 +405,8 @@ highlighted_areas <- hex_crashes %>% mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>% filter(prior > 100, (lastyearchange > 5 | - lastyearchange < -1)) %>% pull(ID) + lastyearchange < -2)) %>% pull(ID) +highlighted_areas <- c(62, 69, 78, 85) ggmap(basemap) + labs(title = paste0("Crashes between cars and pedestrians\nselect areas of the county"), @@ -425,7 +441,7 @@ ggmap(basemap) + mid = "white", high = "red", midpoint = 0, - limits = c(-2, 2), + limits = c(-1, 1), oob = scales::squish, labels = scales::percent ) @@ -438,7 +454,7 @@ ggsave(file = paste0("figures/MilWALKee_Walks/", units = "in", 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]), bottom = as.double(bbox[2]), right = as.double(bbox[3]), @@ -466,7 +482,9 @@ 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)), + geom_sf(data = hex_crashes_small %>% + mutate(lastyearchange = (lastyear - prior/yearsforprior)) %>% + filter(!is.na(lastyearchange)), inherit.aes = FALSE, aes(fill = lastyearchange), alpha = 0.5) + @@ -478,12 +496,12 @@ ggmap(basemap) + midpoint = 0, # limits = c(-2, 2), # oob = scales::squish - name = "Crashes last year compared to previous average") + + name = "Crashes last year\ncompared to previous average") + # add crash locations new_scale_fill() + geom_point(data = TOPS_data_filtered %>% - filter(date >= max(TOPS_data_filtered$date) - 365) %>% - #filter(ped_inj %in% c("K", "A")) %>% + filter(date > max(TOPS_data_filtered$date) - 365) %>% + #filter(ped_inj %in% c("K", "A", "B")) %>% filter(vulnerable_role %in% "Pedestrian") %>% filter(longitude >= as.double(bbox[1]), latitude >= as.double(bbox[2]), @@ -495,7 +513,7 @@ ggmap(basemap) + fill = ped_inj_name), shape = 23, 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/", "milwaukee_map_zoomchange.png"),