R/helper_functions.R

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

#' Summary table of crashes and people
#'
#' Get a summary table of total people injured and killed and of total crashes
#' broken down by crash severity.
#' @param crash_df crash dataframe w/ c("TOTINJ", "TOTFATL")
#' @param group_by single variable to group by - the variable of each row
#'
#' @return table
#' @export
#'
#' @examples
#' \dontrun{aggregate_crashes_by_crshsvr_tot_inj(crash)}
aggregate_crashes_by_crshsvr_tot_inj <- function(crash_df, group_by = "year") {

  # if(sum(grepl("TOTINJ|TOTFATL", names(crash_df))) != 2) # if both in there, should be 2
  # {
  #   cat("Add TOTINJ or TOTFATL");
  # }

  inj_count <- crash_df |>
    dplyr::group_by(!!rlang::sym(group_by), .drop = FALSE) |>
    dplyr::summarise(`People injured` = sum(.data[["TOTINJ"]]),
              `People killed` = sum(.data[["TOTFATL"]]))

  crash_count <- crash_df |>
    dplyr::mutate(CRSHSVR = factor(.data[["CRSHSVR"]], levels = c("Fatal", "Injury", "Property Damage"))) |>
    dplyr::group_by(!!rlang::sym(group_by), .data[["CRSHSVR"]], .drop = FALSE) |>
    dplyr::count(name = "total_crashes")
    # dplyr::summarise(total_crashes = n(), .groups = "keep")

  dplyr::left_join(inj_count, crash_count, by = group_by) |>
    tidyr::pivot_wider(names_from = "CRSHSVR", values_from = "total_crashes") |>
    dplyr::mutate_if(is.integer, tidyr::replace_na, replace = 0) |>
    dplyr::mutate(`Total crashes` = .data[["Injury"]] + .data[["Property Damage"]] + .data[["Fatal"]])
}

#' Aggregate crash flag to the crash level
#'
#' @param persons_df  person dataframe
#' @param flag c("speed_flag", "distracted_flag", "teendriver_flag", "olderdriver_flag", "impaired_flag", "seatbelt_flag")
#'
#' @return df of crshnmbr and flag (=="Y")
find_person_flag <- function(persons_df, flag) {
  # error - couldn't find get(flag)
  # flag_list = persons_df[get(flag) == "Y" , c("CRSHNMBR")][!duplicated(CRSHNMBR)][, c(flag) := "Y"]
  # the dplyr way
  flag_list = persons_df |>
    dplyr::filter(!!rlang::sym(flag) == "Y") |>
    dplyr::select(.data[["CRSHNMBR"]],  dplyr::all_of(flag)) |>
    dplyr::distinct(.data[["CRSHNMBR"]], .keep_all = TRUE) #|> mutate(!!rlang::sym(flag) := "Y")
  return(flag_list)
}

#' Extract person flags and get to the crash level
#'
#' Get a df of crash numbers with crash flags at the crash level. This df can
#' full_join with a crash df. (df = full_join(crash, df, by = "CRSHNMBR"))
#' @param persons_df person dataframe
#' @param flag_list list of flags c("speed_flag", "distracted_flag", "teendriver_flag", "olderdriver_flag", "impaired_flag", "seatbelt_flag")
#'
#' @return df with crash numbers and crash flags
#' @export
#'
#' @examples \dontrun{persons_flags_to_crash(p, flag_list =  c("impaired_flag"))}
persons_flags_to_crash <-
  function(persons_df, flag_list = c("speed_flag")) {
    df = data.frame(CRSHNMBR = 0)
    for (i in 1:length(flag_list)) {
      df = dplyr::full_join(find_person_flag(persons_df, flag_list[i]), df, by = "CRSHNMBR")
    }
    # .data[["CRSHNMBR"]]
    df = df |>  dplyr::filter(.data[["CRSHNMBR"]] != 0) |> dplyr::mutate_if(is.character, tidyr::replace_na, replace = "N")
    return(df)
  }

# Count flags by selected variables
count_flags <- function(crash_df, flag, by = c("year")) {
  # crash_df[get(flags) %in% c("Yes", "Y"), .(crash_count = .N, flag_type = flags), by = by_variables]
  crash_df |>
    dplyr::filter(!!rlang::sym(flag) %in% c("Yes", "Y")) |>
    dplyr::group_by(dplyr::across({{ by }})) |>
    dplyr::count(name = "crash_count") |>
    dplyr::mutate(flag_type = flag)
}

#' Get crash count by crash flags
#'
#' Have a list of crash flags and this function will count each number of
#' crashes by crash flag, with the option to also count by other variables, such
#' as year.
#' @param crash_df crash dataframe
#' @param flag_list list of crash flags to count
#' @param by_variables variables to count by, c("year", "CRSHSVR")
#'
#' @return long df of crash counts
#' @export
#'
#' @examples \dontrun{count_crash_flags(df, person_flags_list)}
count_crash_flags <- function(crash_df, flag_list, by_variables = "year") {
  purrr::map_df(flag_list, count_flags, crash_df = crash_df, by = dplyr::all_of(by_variables)) #|> pivot_wider(names_from = flag_type, values_from = crash_count) |> data.table::setDT()
}

#' Helper functions for colors and factors
#'
#' Useful for charts. These return a list of color maps or factor levels. May
#' use unname().
#' @param type c("inj", "crshsvr", "wisinj", "crshsvr_color",
#'   "gender_color", "colors", "wisinj_color", "day_of_week", "newtime",
#'   "counties")
#'
#' @return character list
#' @export
#'
#' @examples
#' \dontrun{crash_helpers("wisinj_color")}
crash_helpers <- function(type) {
  if (type == "inj") {
    l = c("Killed", "Injured", "No Injury")
  }
  if (type == "crshsvr") {
    l = c("Fatal", "Injury", "Property Damage")
  }
  if (type == "wisinj") {
    l = c(
      "Fatal Injury",
      "Suspected Serious Injury",
      "Suspected Minor Injury",
      "Possible Injury",
      "No Injury"
    )
  }
  if (type == "crshsvr_color") {
    l = c(
      "Fatal" = red,
      "Injury" = light_blue,
      "Property Damage" = green
    )
  }
  if (type == "gender_color") {
    l = c("Female" = red,
          "Male" = light_blue,
          "Unknown" = yellow)
  }
  if (type == "colors") {
    l = c(
      light_blue = "#428BCA",
      blue = "#003087",
      green = "#4DB848",
      red = "#D50032",
      yellow = "#F9C218",
      dark_blue = "#1d4f81"
    )
  }
  # TODO change colors?
  if (type == "wisinj_color") {
    l = c(
      "No Apparent Injury" = green,
      "Suspected Minor Injury" = "#4AAECF",
      "Possible Injury" = "#58CEF5",
      "Suspected Serious Injury" = "#3D8DA8",
      "Fatal Injury" = "#265869"
    )
  }
  if (type == "day_of_week") {
    l = c("Sunday",
          "Monday",
          "Tuesday",
          "Wednesday",
          "Thursday",
          "Friday",
          "Saturday")
  }
  if (type == "newtime") {
    l = c(
      "12am",
      "1am",
      "2am",
      "3am",
      "4am",
      "5am",
      "6am",
      "7am",
      "8am",
      "9am",
      "10am",
      "11am",
      "12pm",
      "1pm",
      "2pm",
      "3pm",
      "4pm",
      "5pm",
      "6pm",
      "7pm",
      "8pm",
      "9pm",
      "10pm",
      "11pm"
    )
  }
  if (type == "counties") {
    l = c(
      "Adams",
      "Ashland",
      "Barron",
      "Bayfield",
      "Brown",
      "Buffalo",
      "Burnett",
      "Calumet",
      "Chippewa",
      "Clark",
      "Columbia",
      "Crawford",
      "Dane",
      "Dodge",
      "Door",
      "Douglas",
      "Dunn",
      "Eau Claire",
      "Florence",
      "Fond du Lac",
      "Forest",
      "Grant",
      "Green",
      "Green Lake",
      "Iowa",
      "Iron",
      "Jackson",
      "Jefferson",
      "Juneau",
      "Kenosha",
      "Kewaunee",
      "La Crosse",
      "Lafayette",
      "Langlade",
      "Lincoln",
      "Manitowoc",
      "Marathon",
      "Marinette",
      "Marquette",
      "Menominee",
      "Milwaukee",
      "Monroe",
      "Oconto",
      "Oneida",
      "Outagamie",
      "Ozaukee",
      "Pepin",
      "Pierce",
      "Polk",
      "Portage",
      "Price",
      "Racine",
      "Richland",
      "Rock",
      "Rusk",
      "St. Croix",
      "Sauk",
      "Sawyer",
      "Shawano",
      "Sheboygan",
      "Taylor",
      "Trempealeau",
      "Vernon",
      "Vilas",
      "Walworth",
      "Washburn",
      "Washington",
      "Waukesha",
      "Waupaca",
      "Waushara",
      "Winnebago",
      "Wood"
    )
  }
  return(l)
}