added seasonality and vehicle type graphs
This commit is contained in:
parent
d830526659
commit
7d88bd3d48
SSH key fingerprint:
SHA256:jWnpFDAcacYM5aPFpYRqlsamlDyKNpSj3jj+k4ojtUo
1 changed files with 121 additions and 2 deletions
|
|
@ -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)
|
||||
```
|
||||
Loading…
Add table
Add a link
Reference in a new issue