In jacciz/wisdotcrashdatabase: A package used for internal WisDOT crash database pulls and analysis

knitr::opts_chunk$set(echo = FALSE, comment = NA, warning = FALSE, error = FALSE, message = FALSE, tidy = TRUE, fig.dim = c(7, 4), global.par = TRUE)

library(tidyverse)    # includes tidyr, tibble, lubridate, ggplots, dbplyr
library(ggtext)       # HTML for charts
library(data.table)   # db files are loaded as a data table, need this package
library(wisdotcrashdatabase)
library(janitor)      # make tabyl, adorn_totals
library(kableExtra)   # styling for HTML

source("C:/temp_code/functions_to_find_Intersection_crashes.R")
source("C:/temp_code/chart_formats.R")

# "CRSHNMBR", "CRSHDATE", "CNTYCODE" ,"CRSHSVR", "UNITNMBR", "ROLE","VEHTYPE","WISINJ"
file_loc = "C:/data/crashes_duck.duckdb" # location of crash database files to load
years = get_list_of_years("19", "21")

crsh <- import_db_data(
  file_loc,
  "crash",
  columns = c(
    "MUNICODE",
    "CRSHTIME",
    "ONSTR",
    "ATSTR",
    "ONHWY",
    "ATHWY",
    "BIKEFLAG",
    "PEDFLAG",
    "CRSHTYPE",
    "MNRCOLL",
    "TOTINJ",
    "TOTFATL",
    "LATDECDG",
    "LONDECDG"
  ),
  years = years,
  filter_by = "county:Dane"
)

persons <- 
import_db_data(
  file_loc,
  "person",
  columns = c("MUNICODE","DRVRFLAG", "HLMTUSE", "EYEPROT", "SFTYEQP", "SEX", "AGE", "ALCSUSP", "DRUGSUSP", "WISINJ",  "DRVRPC","STATNM", "DISTACT", "DRVRDS"),
  years = years,
  filter_by = "county:Dane")

drivers <- persons |> get_driver_flags(flags = c("distracted","speed","teen","older", "impaired", "aggressive"))

# Highways: ONHWY & ATHWY         Roads: ONSTR & ATSTR
segment <-
  crsh[CNTYCODE %in% county_to_find("Dane") &
         MUNICODE %in% muni_to_find("Albion", "Town")] #|>
  # find_by_intersection(., highway_names = "X|CX",
  #                      road_names = "CTH X|CURRIE RD")

segment <- crsh[CNTYCODE %in% county_to_find("Dane")] |>
  find_by_road(., highway_names = "TWIN LANE",
               road_names = "TWIN LANE")
segment[MUNICODE == "SUN PRAIRIE" & CRSHTYPE != "DEER" & ONHWY != "019" & ATHWY != "019" & ONHWY != "T"]

brown <- crsh[CNTYCODE %in% county_to_find("Brown")]

segment <- find_by_lat_long(brown, lower_left_lon = -88.165602, lower_left_lat =44.385666, upper_right_lon = -88.159122, upper_right_lat = 44.386333)# |> 
  # filter(ONHWY != "041", ATHWY != "041")

persons <- semi_join(persons, segment, by = "CRSHNMBR") |> get_age_groups()
drivers <- semi_join(drivers, segment, by = "CRSHNMBR") |> get_age_groups()

# Add person flags to crash df
m = wisdotcrashdatabase::persons_flags_to_crash(drivers, c("speed_flag", "distracted_flag", "teendriver_flag", "olderdriver_flag", "impaired_flag", "aggressiveflag"))
segment = full_join(segment, m, by = "CRSHNMBR")
# segment |> write.csv("town_of_albion_2017_2021.csv")

Map of fatal/injury crashes. Note: From 2017-2021, there were a total of r nrow(segment) crashes and r nrow(segment[CRSHSVR != "Property Damage"]) fatal/injury crashes.

map_data(segment[CRSHSVR != "Property Damage"])

by_crshsvr <-
  segment[, .N, by = c("year", "CRSHSVR")] |> pivot_wider(names_from = CRSHSVR,
                                                           values_from = N,
                                                           values_fill = 0) |> adorn_totals("col", name = "Total Crashes")
by_tot_injuries <-
  segment[, .(`Total Injuries` = sum(TOTINJ),
              `Total Fatalities` = sum(TOTFATL)), by = c("year")]
full_join(by_crshsvr, by_tot_injuries, by = "year") |> adorn_totals() |> chart_format("Crash history")

segment[ , .N, by = c("CRSHSVR", "MNRCOLL")][order(-N)] |> pivot_wider(names_from = CRSHSVR, values_from = N, values_fill = 0) |> chart_format("Manner of Collision")

drivers |> 
  select(year, CRSHNMBR, starts_with("DRVRPC")) |>
  mutate(across(where(is.logical), as.character)) |>
  pivot_longer(starts_with("DRVRPC")) |> 
  filter(value != '', value != "Unknown") |>
  mutate(
    value = ifelse(
      value == "Operated Motor Vehicle In Inattentive, Careless, Negligent, or Erratic Manner",
      "Operated Motor Vehicle In Negligent Manner",
      value
    )
  ) |> 
  group_by(value, .drop = FALSE) |>
  summarise(total=n()) |>
  arrange(-total) |> chart_format("Driver contributing circumstance (One crash may have multiple, especially if it involves more than one driver)")

persons_imp <-
  drivers |> filter(impaired_flag == "Y") |> group_by(year, .drop = FALSE) |> distinct(CRSHNMBR) |> summarise(Total = n()) 

alc <-
  bar_chart(persons_imp, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Crashes with a Alcohol/Drug\nImpaired Driver", y_label = scales::comma_format())

#speed
persons_speed <- drivers |> filter(speed_flag == "Y") |> group_by(year, .drop = FALSE) |> distinct(CRSHNMBR) |> summarise(Total = n())

#speed flag
speed <-
  bar_chart(persons_speed, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Speeding Crashes", y_label = scales::comma_format())
gridExtra::grid.arrange(alc, speed, ncol = 2)

#aggressive drivers
persons_agg <-
  drivers |> filter(aggressiveflag == "Y") |> group_by(year, .drop = FALSE) |> distinct(CRSHNMBR) |> summarise(Total = n()) 

agg <-
  bar_chart(persons_agg, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Crashes with an Aggressive Driver", y_label = scales::comma_format())

#distracted
persons_dist <- drivers |> filter(distracted_flag == "Y") |> group_by(year, .drop = FALSE) |> distinct(CRSHNMBR) |> summarise(Total = n())

#speed flag
dist <-
  bar_chart(persons_dist, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Crashes with Distracted Driver", y_label = scales::comma_format())

gridExtra::grid.arrange(agg, dist, ncol = 2)

persons_teen <-
  persons |> filter(age_group_5yr  %in% "15-19") |> group_by(year, .drop = FALSE) |> distinct(CRSHNMBR) |> summarise(Total = n())
teen <-
  bar_chart(persons_teen, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Teen Driver Crashes", y_label = scales::comma_format())

persons_older <-
  persons |> filter(age_group_5yr  %in% c("65-69", "70+")) |> group_by(year, .drop = FALSE) |> distinct(CRSHNMBR) |> summarise(Total = n())
older <-
  bar_chart(persons_older, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Older Driver Crashes", y_label = scales::comma_format())

gridExtra::grid.arrange(teen, older, ncol = 2)

crash_bike <-
  segment |> group_by(year, .drop = FALSE) |> filter(BIKEFLAG == "Y") |> summarise(Total = n())
bike <-
  bar_chart(crash_bike, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Bike Crashes", y_label = scales::comma_format())

crash_ped <-
  segment |> group_by(year, .drop = FALSE) |> filter(PEDFLAG == "Y") |> summarise(Total = n())
ped <-
  bar_chart(crash_ped, "year", "Total",bar_text_size = 3.5, base_size = 8, title = "Pedestrian Crashes", y_label = scales::comma_format())

gridExtra::grid.arrange(bike, ped, ncol = 2)

# https://cran.r-project.org/web/packages/kableExtra/vignettes/awesome_table_in_html.html#Overview
# crashes_new |> filter(CYCLFLAG == "Y") |> group_by(year = year(CRSHDATE), URBRURAL) |> summarise(count = n()) |> pivot_wider(names_from = URBRURAL, values_from = count) |> adorn_totals("col") |> kbl(caption = "Title") |> kable_styling()

  # WisDOT Colors
#   light_blue = "#428BCA",
#   blue = "#003087",
#   green = "#4DB848",
#   red = "#D50032",
#   yellow = "#F9C218"
  # Background blue - #1d4f81

  # Theme colors (same as WisDOT, more subtle)
  #   purple-blue = "#5a77db",
  #   blue = "#4fb9db",
  #   green = "#44dbae",
  #   red = "#Db7e65",
  #   yellow = "#dbb039"
  #   white = "rgb(255,255,255)"

jacciz/wisdotcrashdatabase documentation built on June 3, 2023, 2:26 a.m.