R/get_crash_times.R

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

#' Get crash hour (new db)
#'
#' Adds a new column that gives crash hour. For new db, NA are "Unk."
#' @param dataframe dataframe
#' @param time_column Time column
#' @param colname name of new column, "newtime"
#' @param combine_with_old combines newtime with old db
#'
#' @return A new column called \emph{newtime} with crash hour. i.e. "12am"
#' @export
#'
#' @examples
#' \dontrun{get_crash_times(crash17)}
get_crash_times <- function(dataframe, time_column = "CRSHTIME", colname = "newtime", combine_with_old = FALSE) {
  dataframe_time <-
  dataframe |> dplyr::mutate(!!colname := cut(
    # this finds crash time by hour
    .data[[time_column]],
    c(
      1,
      100,
      200,
      300,
      400,
      500,
      600,
      700,
      800,
      900,
      1000,
      1100,
      1200,
      1300,
      1400,
      1500,
      1600,
      1700,
      1800,
      1900,
      2000,
      2100,
      2200,
      2300,
      2400
    ),
    labels = 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"
    ),
    include.lowest = T
  ))
  if (combine_with_old == TRUE){
    both = dplyr::left_join(dataframe_time, old_crash_groups, by = "CRSHTIME_GROUP") |>
      dplyr::mutate(newtime_old = as.factor(.data$newtime_old))
    both[[colname]] = forcats::fct_na_value_to_level(both[[colname]], "Unk.")

    return(dplyr::mutate(both, newtime_both = ifelse(is.na( .data[[colname]]), as.character(.data$newtime_old), as.character( .data[[colname]])),
           newtime_both = as.factor(.data$newtime_both)))
  }

  dataframe_time[[colname]] = forcats::fct_na_value_to_level(dataframe_time[[colname]], "Unk.")
  return(dataframe_time)
}

format_time <- function(time) {
  t_minutes = time %% 100 # time - round(time, -2)
  t_hour = floor((time - t_minutes) / 100)

  time_hour = ifelse(t_hour <= 0, "00", t_hour)
  time_minutes = ifelse(
    t_minutes < 10,
    formatC(
      t_minutes,
      digits = 0,
      width = 2,
      format = "f",
      flag = "0"
    ),
    t_minutes
  )
  crsh_time = paste0(time_hour, ":", time_minutes)
  crsh_time = gsub("99:99|NA:NA", NA, crsh_time) # This time will be NA

  # add a leading 0
  ifelse(
    nchar(crsh_time) == 4,
    stringr::str_pad(crsh_time, 5, side = "left", pad = 0),
    crsh_time
  )
}

#' Convert CRSHTIME to time format (new db)
#'
#' Adds a column that formats time to hour:minute
#' @param dataframe a dataframe
#' @param crshtime column of time to convert from character to hsm, CRSHTIME
#' @param colname name of new column, i.e. "crsh_time"
#'
#' @return A new column called \emph{crsh_time} in format "01:01"
#' @export
#'
#' @examples
#' \dontrun{convert_time_to_hms(crash)}
convert_time_to_hms <- function(dataframe, crshtime = "CRSHTIME", colname = "crsh_time" ) {
  dataframe |> dplyr::mutate(!!colname := format_time(.data[[crshtime]]))
}

#' Get datetime from date and time columns
#'
#' Adds a column of datetime using date and crsh time (formatted via \emph{convert_time_to_hms()})
#' @param dataframe a dataframe
#' @param colname new column name
#' @param date_col date column in ymd
#' @param time_hour_col time column in hm or hms. May have to use format_time() function.
#' @param include_min if time_hour_col has minutes
#'
#' @return A new column called \emph{crsh_datetime} with POSIXt class
#' @export
#'
#' @examples
#' \dontrun{convert_to_datetime(crash, colname = "crsh_datetime")}
convert_to_datetime <-
  function(dataframe,
           colname = "crsh_datetime",
           date_col = "CRSHDATE",
           time_hour_col = "crsh_time",
           include_min = TRUE) {
    if (include_min == FALSE){
      dataframe |>  #ymd_hms
        dplyr::mutate(!!colname := lubridate::ymd_hms(paste0(
          .data[[date_col]], paste0(" ", .data[[time_hour_col]], ":00:00 UTC")
        )))}
    else {
      dataframe |> #ymd_hms
        dplyr::mutate(!!colname := lubridate::ymd_hms(paste0(
          .data[[date_col]], paste0(" ", .data[[time_hour_col]], ":00 UTC")
        )))
    }
  }