R/get_crashflags_crash.R

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

#' Get driver flags - deer, crash location, lane departure, winter road
#'
#' This adds a column(s) of certain crash flags. Deer and crash location can be
#' for both old and new db. Crash location - old db doesn't include parking
#' lot/private property crashes. Lane departure and winter road is for new db
#' only. Must have \strong{c("CRSHTYPE", "ANMLTY")} for deer.
#' \strong{c("RLTNTRWY", "CRSHLOC", "INTTYPE",
#'   "INTDIS")} for crash location. \strong{c("CRSHTYPE", "MNRCOLL")} for lane departure. \strong{c("RDCOND")} for winter road.
#' @param crash_df crash df
#' @param flags c("deer","location","lanedeparture", "winterroad")
#'
#' @return Adds a column of selected flag(s) with \emph{deer_flag},
#'   \emph{lanedep_flag}, \emph{winterroad_flag}. ("Y" or "N").
#'   \emph{crash_location} with c("parking lot", "private property",
#'   "intersection", "non-intersection")
#' @export
#'
#' @examples
#' \dontrun{get_crash_flags(crash_df, flags = c("deer", "lanedeparture"))}
get_crash_flags <- function(crash_df,
                            flags) {
  if ("deer" %in% flags) {
    crash_df <- get_deerflag_crashes(crash_df)
  }
  if ("location" %in% flags) {
    crash_df <- get_crash_location(crash_df)
  }
  if ("lanedeparture" %in% flags) {
    crash_df <- get_lanedeparture_crashes(crash_df)
  }
  if ("winterroad" %in% flags) {
    crash_df <- get_winterroad(crash_df)
  }
  crash_df
}

get_winterroad <- function(crash_df) {
  winter = crash_df |> dplyr::select(dplyr::starts_with("RDCOND"), .data[["CRSHNMBR"]]) |>
    dplyr::filter(dplyr::if_any(
      .cols = dplyr::everything(),
      .fns = ~ .x %in% c("Ice", "Slush", "Snow")
    )) |> dplyr::select(.data[["CRSHNMBR"]]) |> dplyr::mutate(winterroad_flag = "Y")
  return(
    dplyr::left_join(crash_df, winter, by = "CRSHNMBR") |>

      dplyr::mutate(winterroad_flag = tidyr::replace_na(.data[["winterroad_flag"]], "N"))
  )

}

#' Get flag for deer crashes (old and new db)
#'
#' This finds if a crash involved a deer. Need \strong{CRSHTYPE} and
#' \strong{ANMLTY}.
#' @param crash_df crash dataframe
#'
#' @return A new column called \emph{deer_flag} ("Y" or "N")
#' @export
#' @examples
#' \dontrun{get_deerflag_crashes(crash)}
get_deerflag_crashes <- function(crash_df) {
  deer <- crash_df |> #filter deer crashes
    dplyr::select(dplyr::any_of(dplyr::starts_with(c("CRSHTYPE","ANMLTY"))), .data[["CRSHNMBR"]]) |>
    dplyr::filter(((
      .data[["CRSHTYPE"]] == "Non Domesticated Animal (Alive)" |
        .data[["CRSHTYPE"]] == "Non Domesticated Animal (Dead)"
    ) & dplyr::if_any(
      .cols = dplyr::everything(),
      .fns = ~ .x == "Deer"
    )
    ) | .data[["CRSHTYPE"]] == "DEER") |> dplyr::select(.data[["CRSHNMBR"]]) |> dplyr::mutate(deer_flag = "Y")
  return(dplyr::left_join(crash_df, deer, by = "CRSHNMBR") |>
           dplyr::mutate(deer_flag = tidyr::replace_na(.data[["deer_flag"]], "N")))
}

#' Find location of crash
#'
#' @param crash_df crash dataframe w/ c("RLTNTRWY", "CRSHLOC", "INTTYPE",
#'   "INTDIS")
#'
#'   Find if crash is intersection, non-intersection, parking lot, or private
#'   property.
#' @return A new column called \emph{crash_location}. This is for old and new
#'   db, but note that old db doesn't include parking lot/private property
#'   crashes.
#' @export
#'
#' @examples
#' \dontrun{get_crash_location(crash)}
get_crash_location <- function(crash_df) {
  dplyr::mutate(
    crash_df,
    crash_location = dplyr::case_when(
      .data[["RLTNTRWY"]] == "Non Trafficway - Parking Lot" ~ "parking lot",
      .data[["CRSHLOC"]] %in% c("Private Property", "Tribal Land") ~ "private property",
      .data[["INTTYPE"]] == "Not At Intersection" ~ "non-intersection",
      .data[["INTTYPE"]] != "" ~ "intersection",
      .data[["INTDIS"]] > 0 ~ "non-intersection",
      TRUE ~ "intersection"
    )
  )
}

#' Get flag for lane departure crashes (new db)
#'
#' This finds if a crash involves a lane departure. Need \strong{CRSHTYPE} and
#' \strong{MNRCOLL}.
#' @param crash_df crash dataframe
#'
#' @return A new column called \emph{lanedep_flag} ("Y" or "N")
#' @export
#' @examples
#' \dontrun{get_lanedeparture_crashes(crash)}
get_lanedeparture_crashes   <- function(crash_df) {
  lanedep_crshtypes = c(
    "Motor Veh Tran Other Rdwy",
    "Other Object - Not Fixed",
    "Traffic Sign Post",
    "Traffic Signal",
    "Utility Pole",
    "Lum Light Support",
    "Other Post, Pole or Support",
    "Tree",
    "Mailbox",
    "Guardrail Face",
    "Guardrail End",
    "Bridge Parapet End",
    "Bridge/Pier/Abut",
    "Impact Attenuator/Crash Cushion",
    "Overhead Sign Post",
    "Bridge Rail",
    "Culvert",
    "Ditch",
    "Curb",
    "Embankment",
    "Fence",
    "Other Fixed Object",
    "Overturn/Rollover",
    "Jackknife",
    "Cable Barrier",
    "Concrete Traffic Barrier",
    "Other Traffic Barrier",
    "Fire Hydrant",
    "Unknown"
  )
  lanedep_mnrcoll = c("Front To Front",
                      "Sideswipe/Same Direction",
                      "Sideswipe/Opposite Direction")
  lanedepflags <-
    crash_df |> dplyr::select("CRSHNMBR", "CRSHTYPE", "MNRCOLL") |> dplyr::filter(.data[["CRSHTYPE"]] %in% lanedep_crshtypes |
                                                                                    .data[["MNRCOLL"]] %in% lanedep_mnrcoll) |>
    dplyr::select("CRSHNMBR") |> dplyr::mutate(lanedep_flag = "Y")
  return(
    dplyr::left_join(crash_df, lanedepflags, by = "CRSHNMBR") |>
      dplyr::mutate(lanedep_flag = tidyr::replace_na(.data[["lanedep_flag"]], "N"))
  )
}