diff --git a/R/MilWALKeeWalks.Rmd b/R/MilWALKeeWalks.Rmd index 64ff37b..37d0615 100644 --- a/R/MilWALKeeWalks.Rmd +++ b/R/MilWALKeeWalks.Rmd @@ -708,7 +708,7 @@ TOPS_data <- TOPS_data %>% mutate(trickortreat = ifelse(date %in% trickortreatda ``` ## Halloween -```{r exploreHalloween, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +```{r Halloween, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ggplot(data = TOPS_data_filtered %>% # filter(ped_inj %in% c("K", "A", "B")) %>% # filter(ped_age <=18) %>% @@ -775,7 +775,7 @@ ggsave(filename = paste0("figures/MilWALKee_Walks/", "halloween_wday.png"), ``` ## Trucks -```{r exploreTrucks, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +```{r Trucks, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} TOPS_data_filtered %>% filter(ped_age < 18) %>% filter(nonvuln_vehicletype != "Other") %>% @@ -809,6 +809,125 @@ ggsave(filename = paste0("figures/MilWALKee_Walks/", "trucks_injsev.png"), units = "in", create.dir = TRUE) +``` +## seasonality +```{r seasonality, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +TOPS_data_filtered %>% +# filter(ped_inj %in% c("K", "A", "B")) %>% + filter(ped_age >= 18) %>% + filter(vulnerable_role == "Pedestrian", + year != year_max, + MUNINAME == "MILWAUKEE") %>% + mutate(date_yearagnostic = ymd(paste("2025", month(date, label = FALSE), mday(date)))) %>% + mutate(week = week(date_yearagnostic), + weekdate = floor_date(date_yearagnostic, unit = "weeks", week_start = 3)) %>% + group_by(weekdate) %>% + summarize(average = n()/(year_max - year_min + 1)) %>% +ggplot() + + geom_col(aes(x = weekdate, + y = average), + fill = "darkorange3") + + scale_x_date(minor_breaks = "month", date_labels = "%b", expand = expansion(mult = c(0,0))) + + scale_y_continuous() + + labs(title = paste0("Car crashes involving pedestrians - Adults"), + subtitle = paste0("City of Milwaukee | ", year_min, " - ", year_max - 1), + x = NULL, + y = "Average crashes per week", + fill = "Days with\nTrick-or-Treating", + caption = paste0("crash data from UW TOPS lab - retrieved ", + strftime(retrieve_date, format = "%m/%Y"), + "\nper direction of the WisDOT Bureau of Transportation Safety")) + + theme(plot.caption = element_text(color = "grey")) +ggsave(filename = paste0("figures/MilWALKee_Walks/", "MKEadultweek.png"), + device = png, + height = 8.5, + width = 11, + units = "in", + create.dir = TRUE) +hex_crashes_small <- st_join(hexgrid_small, + st_as_sf(TOPS_data_filtered %>% + filter(vulnerable_role %in% "Pedestrian", + ped_age >= 18, + MUNINAME == "MILWAUKEE") %>% + #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)) %>% + mutate(dateyearagnostic = ymd(paste("2025", month(date, label = FALSE), mday(date)))) %>% + filter(dateyearagnostic >= ymd("2025-10-01"), + dateyearagnostic <= ymd("2025-10-14")) %>% + mutate(octoberfest = ifelse(dateyearagnostic <= ymd("2025-10-7"), + "TRUE", + "FALSE")) %>% + group_by(ID, octoberfest) %>% + summarise(count = n(), .groups = 'drop') %>% + st_drop_geometry() %>% + pivot_wider(id_cols = ID, names_from = octoberfest, values_from = count) %>% + mutate(across(-ID, ~ replace_na(., 0))) %>% + mutate(total = rowSums(dplyr::select(., -ID), na.rm = TRUE)) + +hex_crashes_small <- st_as_sf(left_join(hexgrid_small, hex_crashes_small), crs = 4326) + +hex_crashes_small <- hex_crashes_small %>% + mutate(octoberfestchange = `TRUE` - `FALSE`) +# Map of high increase areas +ggmap(basemap) + + labs(title = paste0("Car crashes involving 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 hexagons + new_scale_fill() + + geom_sf(data = hex_crashes_small %>% + filter(!is.na(octoberfestchange)), + inherit.aes = FALSE, + aes(fill = octoberfestchange), + alpha = 0.5) + + scale_size_area() + + scale_fill_gradient2( + low = "darkgreen", + mid = "white", + high = "red", + midpoint = 0, +# limits = c(-10, 10), +# oob = scales::squish, + 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", "B")) %>% + filter(date > ymd("2024-09-20"), + date < ymd("2024-10-10")) %>% + 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))# + geom_sf(data = projects_2023, inherit.aes = FALSE) ``` \ No newline at end of file