added seasonality and vehicle type graphs

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)
 ```