--- 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 = paste0("Crashes statewide - Wisconsin - 2017-", year(max(TOPS_data$date))), 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)) ```