305 lines
13 KiB
Text
305 lines
13 KiB
Text
---
|
|
title: "Crash Data Summaries"
|
|
output:
|
|
html_document:
|
|
toc: true
|
|
toc_depth: 5
|
|
toc_float:
|
|
collapsed: false
|
|
smooth_scroll: true
|
|
editor_options:
|
|
chunk_output_type: console
|
|
---
|
|
|
|
|
|
# Input Data & Configuration
|
|
|
|
## Libraries
|
|
```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
date()
|
|
rm(list=ls())
|
|
library(tidyverse)
|
|
library(RColorBrewer)
|
|
library(tidycensus)
|
|
library(ggrepel)
|
|
library(leaflet)
|
|
```
|
|
|
|
## Load TOPS data
|
|
```{r loadTOPS, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
load(file = "data/TOPS/TOPS_data.Rda")
|
|
load(file = "data/TOPS/vuln_roles.Rda")
|
|
load(file = "data/TOPS/retrieve_date.Rda")
|
|
load(file = "data/TOPS/injury_severity.Rda")
|
|
injury_severity_pal <- colorFactor(palette = injury_severity$color, levels = injury_severity$InjSevName)
|
|
|
|
```
|
|
|
|
## Set parameters
|
|
```{r parameters, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
county_focus <- c("DANE")
|
|
municipality_focus <- c("MADISON")
|
|
injury_severy_focus <- c("A", "K", "B")
|
|
```
|
|
|
|
## build data summaries for city
|
|
```{r citysummaries, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
|
|
data_summary <- list(NULL)
|
|
# crashes by year that resulted in a pedestrian fatality or severe injury
|
|
data_summary[["crash_by_year"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
group_by(MUNINAME, year, vulnerable_role, ped_inj_name) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by race of pedestrian/bicyclist for focus year
|
|
data_summary[["crash_by_race"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
group_by(MUNINAME, vulnerable_role, ped_inj_name, vulnerable_race) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by race of driver that resulted in a pedestrian fatality or severe injury
|
|
data_summary[["crash_by_driver_race"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_race = ifelse(ROLE1 %in% c("DR"), race_name1, ifelse(ROLE2 %in% c("DR"), race_name2, NA))) %>%
|
|
group_by(MUNINAME, year, vulnerable_role, ped_inj_name, driver_race) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by age of pedestrian/bicyclist
|
|
data_summary[["crash_by_age"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(vulnerable_age = ifelse(ROLE1 %in% vuln_roles, age1, ifelse(ROLE2 %in% vuln_roles, age2, NA))) %>%
|
|
group_by(MUNINAME, year, vulnerable_role, ped_inj_name, vulnerable_age) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by age of driver that resulted in a severe injury or fatality of a pedestrian/bicyclist
|
|
data_summary[["crash_by_driver_age"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_age = ifelse(ROLE1 %in% c("DR"), age1, ifelse(ROLE2 %in% c("DR"), age2, NA))) %>%
|
|
group_by(MUNINAME, year, vulnerable_role, ped_inj_name, driver_age) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by sex of pedestrian/bicyclist
|
|
data_summary[["crash_by_sex"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(vulnerable_sex = ifelse(ROLE1 %in% vuln_roles, SEX1, ifelse(ROLE2 %in% vuln_roles, SEX1, NA))) %>%
|
|
group_by(MUNINAME, year, vulnerable_role, ped_inj_name, vulnerable_sex) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by sex of driver that resulted in a severe injury or fatality of a pedestrian/bicyclist
|
|
data_summary[["crash_by_driver_sex"]] <- TOPS_data %>%
|
|
filter(MUNINAME %in% municipality_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_sex = ifelse(ROLE1 %in% c("DR"), SEX1, ifelse(ROLE2 %in% c("DR"), SEX2, NA))) %>%
|
|
group_by(MUNINAME, year, vulnerable_role, ped_inj_name, driver_sex) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
## export csv files for city ----
|
|
|
|
# make directories for city summaries
|
|
city_directory <- paste0("data_summaries/city/",municipality_focus,"/")
|
|
ifelse(!dir.exists(city_directory), dir.create(city_directory), "Folder exists already")
|
|
|
|
for(table_name in as.vector(names(data_summary[-1]))) {
|
|
write_csv(data_summary[[table_name]], file = paste0(city_directory, municipality_focus, "-", table_name, ".csv"))
|
|
}
|
|
```
|
|
|
|
|
|
## build data summaries for county ----
|
|
```{r countysummaries, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
|
|
data_summary <- list(NULL)
|
|
|
|
# crashes by year that resulted in a pedestrian fatality or severe injury
|
|
data_summary[["crash_by_year"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
group_by(CNTYNAME, year, vulnerable_role, ped_inj_name) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by race of pedestrian/bicyclist for focus year
|
|
data_summary[["crash_by_race"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
group_by(CNTYNAME, vulnerable_role, ped_inj_name, vulnerable_race) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by race of driver that resulted in a pedestrian fatality or severe injury
|
|
data_summary[["crash_by_driver_race"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_race = ifelse(ROLE1 %in% c("DR"), race_name1, ifelse(ROLE2 %in% c("DR"), race_name2, NA))) %>%
|
|
group_by(CNTYNAME, year, vulnerable_role, ped_inj_name, driver_race) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by age of pedestrian/bicyclist
|
|
data_summary[["crash_by_age"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(vulnerable_age = ifelse(ROLE1 %in% vuln_roles, age1, ifelse(ROLE2 %in% vuln_roles, age2, NA))) %>%
|
|
group_by(CNTYNAME, year, vulnerable_role, ped_inj_name, vulnerable_age) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by age of driver that resulted in a severe injury or fatality of a pedestrian/bicyclist
|
|
data_summary[["crash_by_driver_age"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_age = ifelse(ROLE1 %in% c("DR"), age1, ifelse(ROLE2 %in% c("DR"), age2, NA))) %>%
|
|
group_by(CNTYNAME, year, vulnerable_role, ped_inj_name, driver_age) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by sex of pedestrian/bicyclist
|
|
data_summary[["crash_by_sex"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(vulnerable_sex = ifelse(ROLE1 %in% vuln_roles, SEX1, ifelse(ROLE2 %in% vuln_roles, SEX1, NA))) %>%
|
|
group_by(CNTYNAME, year, vulnerable_role, ped_inj_name, vulnerable_sex) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
# crashes by sex of driver that resulted in a severe injury or fatality of a pedestrian/bicyclist
|
|
data_summary[["crash_by_driver_sex"]] <- TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_sex = ifelse(ROLE1 %in% c("DR"), SEX1, ifelse(ROLE2 %in% c("DR"), SEX2, NA))) %>%
|
|
group_by(CNTYNAME, year, vulnerable_role, ped_inj_name, driver_sex) %>%
|
|
summarise(count = n_distinct(DOCTNMBR))
|
|
|
|
## export csv files for county ----
|
|
|
|
# make directories for county summaries
|
|
|
|
county_directory <- paste0("data_summaries/county/",county_focus,"/")
|
|
ifelse(!dir.exists(county_directory), dir.create(county_directory), "Folder exists already")
|
|
|
|
|
|
for(table_name in as.vector(names(data_summary[-1]))) {
|
|
write_csv(data_summary[[table_name]], file = paste0("data_summaries/county/", county_focus, "/", county_focus, "_", table_name, ".csv"))
|
|
}
|
|
```
|
|
|
|
|
|
## Make figures for county summaries
|
|
```{r countysummaryfigures, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
data_summary[["crash_by_age"]] %>%
|
|
filter(vulnerable_age < 18,
|
|
year != 2025) %>%
|
|
group_by(year, ped_inj_name) %>%
|
|
summarise(count = sum(count)) %>%
|
|
ggplot() +
|
|
geom_col(aes(x = year,
|
|
y = count,
|
|
fill = ped_inj_name)) +
|
|
scale_fill_manual(values = injury_severity_pal(injury_severity %>% filter(code %in% injury_severy_focus) %>% pull(InjSevName))) +
|
|
labs(title = paste0("Pedestrian & bicyclists under 18yo killed or injured in ", str_to_title(county_focus), " county"),
|
|
x = "Year",
|
|
y = "Total crashes",
|
|
fill = "Injury Severity",
|
|
caption = paste0("crash data from UW TOPS lab - retrieved ",
|
|
strftime(retrieve_date, format = "%m/%Y"),
|
|
" per direction of the WisDOT Bureau of Transportation Safety")) +
|
|
theme(plot.caption = element_text(color = "grey"))
|
|
ggsave(file = paste0(county_directory, county_focus, "_youth_crashes.pdf"),
|
|
height = 8.5,
|
|
width = 11,
|
|
units = "in")
|
|
|
|
TOPS_data %>%
|
|
filter(CNTYNAME %in% county_focus) %>%
|
|
filter(year == 2024) %>%
|
|
filter(ped_inj %in% "K") %>%
|
|
mutate(vulnerable_age = ifelse(ROLE1 %in% vuln_roles, age1, ifelse(ROLE2 %in% vuln_roles, age2, NA))) %>%
|
|
filter(vulnerable_age < 18)
|
|
|
|
```
|
|
|
|
## Make figures for statewide summaries
|
|
```{r statesummary, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
|
TOPS_data %>%
|
|
filter(!is.na(vulnerable_role)) %>%
|
|
filter(vulnerable_role == "Pedestrian") %>%
|
|
mutate(driver_vehtype = ifelse(ROLE1 %in% c("DR"), VEHTYPE1, ifelse(ROLE2 %in% c("DR"), VEHTYPE2, NA))) %>%
|
|
filter(driver_vehtype %in% c("CAR", "SUV", "UT TRK")) %>%
|
|
group_by(vulnerable_role, ped_inj_name, driver_vehtype) %>%
|
|
summarise(count = n_distinct(DOCTNMBR)) %>%
|
|
pivot_wider(names_from = driver_vehtype, values_from = count) %>%
|
|
ungroup() %>%
|
|
mutate(total = (CAR + SUV + `UT TRK`)) %>%
|
|
mutate(car_percent = CAR/total * 100,
|
|
suv_percent = SUV/total * 100,
|
|
pickup_percent = `UT TRK`/total * 100) %>%
|
|
select(vulnerable_role, ped_inj_name, car_percent, suv_percent, pickup_percent) %>%
|
|
mutate(Car = car_percent, SUV = suv_percent, "Pickup Truck" = pickup_percent) %>%
|
|
pivot_longer(cols = c(Car, SUV, "Pickup Truck")) %>%
|
|
ggplot(aes(x = ped_inj_name,
|
|
y = value,
|
|
fill = name)) +
|
|
geom_col(position = position_stack()) +
|
|
geom_text(aes(label = paste0(round(value, 1), "%")),
|
|
position = position_stack(vjust = 0.5)) +
|
|
theme(axis.text.x = element_text(angle = 30, hjust = 1),
|
|
plot.caption = element_text(color = "grey")) +
|
|
scale_y_continuous(expand = expansion(mult = c(0, 0))) +
|
|
labs(title = "Impact of type of vehicle on severity of injury",
|
|
subtitle = "Crashes statewide - Wisconsin",
|
|
y = "Percent of crashes",
|
|
x = "Severity of injury",
|
|
fill = "Type of vehicle",
|
|
caption = paste0("crash data from UW TOPS lab - retrieved ",
|
|
strftime(retrieve_date, format = "%m/%Y"),
|
|
" per direction of the WisDOT Bureau of Transportation Safety"))
|
|
ggsave(file = paste0("figures/crash_summaries/state/", "VehType_InjSev.pdf"),
|
|
height = 8.5,
|
|
width = 11,
|
|
units = "in")
|
|
|
|
|
|
TOPS_data %>%
|
|
filter(!is.na(vulnerable_role)) %>%
|
|
filter(vulnerable_role == "Pedestrian") %>%
|
|
filter(ped_inj %in% injury_severy_focus) %>%
|
|
mutate(driver_vehtype = ifelse(ROLE1 %in% c("DR"), VEHTYPE1, ifelse(ROLE2 %in% c("DR"), VEHTYPE2, NA))) %>%
|
|
filter(driver_vehtype %in% c("CAR", "SUV", "UT TRK")) %>%
|
|
group_by(vulnerable_role, driver_vehtype, year) %>%
|
|
summarise(count = n_distinct(DOCTNMBR)) %>%
|
|
pivot_wider(names_from = driver_vehtype, values_from = count) %>%
|
|
ungroup() %>%
|
|
mutate(total = (CAR + SUV + `UT TRK`)) %>%
|
|
mutate(car_percent = CAR/total * 100,
|
|
suv_percent = SUV/total * 100,
|
|
pickup_percent = `UT TRK`/total * 100) %>%
|
|
select(year, vulnerable_role, car_percent, suv_percent, pickup_percent) %>%
|
|
pivot_longer(cols = c(car_percent, suv_percent, pickup_percent)) %>%
|
|
ggplot() +
|
|
geom_line(aes(x = as.double(as.character(year)),
|
|
y = value,
|
|
color = name))
|
|
|
|
TOPS_data %>%
|
|
filter(!is.na(vulnerable_role)) %>%
|
|
filter(vulnerable_role == "Pedestrian") %>%
|
|
filter(ped_inj %in% "K") %>%
|
|
mutate(driver_vehtype = ifelse(ROLE1 %in% c("DR"), VEHTYPE1, ifelse(ROLE2 %in% c("DR"), VEHTYPE2, NA))) %>%
|
|
filter(driver_vehtype %in% c("CAR", "SUV", "UT TRK")) %>%
|
|
group_by(vulnerable_role, driver_vehtype, year) %>%
|
|
summarise(count = n_distinct(DOCTNMBR)) %>%
|
|
pivot_wider(names_from = driver_vehtype, values_from = count) %>%
|
|
ungroup() %>%
|
|
mutate(total = (CAR + SUV + `UT TRK`)) %>%
|
|
mutate(car_percent = CAR/total * 100,
|
|
suv_percent = SUV/total * 100,
|
|
pickup_percent = `UT TRK`/total * 100) %>%
|
|
select(year, vulnerable_role, car_percent, suv_percent, pickup_percent) %>%
|
|
pivot_longer(cols = c(car_percent, suv_percent, pickup_percent)) %>%
|
|
ggplot() +
|
|
geom_line(aes(x = as.double(as.character(year)),
|
|
y = value,
|
|
color = name))
|
|
|
|
```
|