tests/testthat/helper-create-mock-data.R

In rfars: Download and Analyze Crash Data

# Helper functions to create mock FARS data for testing

#' Create a minimal mock FARS object for testing
#'
#' @return A FARS object with all expected structure but minimal data
create_mock_fars <- function() {

  # Create minimal flat data
  flat <- data.frame(
    year = c(2020, 2020, 2020, 2021, 2021),
    state = factor(c("Virginia", "Virginia", "Maryland", "Virginia", "Maryland")),
    st_case = c(100001, 100002, 200001, 100001, 200001),
    id = c(2020100001, 2020100002, 2020200001, 2021100001, 2021200001),
    veh_no = c(1, 1, 1, 1, 1),
    per_no = c(1, 1, 1, 1, 1),
    county = c(51, 51, 24, 51, 24),
    city = c(100, 200, 300, 100, 300),
    lon = c(-77.5, -77.6, -76.6, -77.5, -76.6),
    lat = c(38.0, 38.1, 39.3, 38.0, 39.3),
    month = factor(c("January", "February", "March", "January", "February")),
    rur_urb = factor(c("Rural", "Urban", "Urban", "Rural", "Urban")),
    per_typ = factor(c(
      "Driver of a Motor Vehicle In-Transport",
      "Pedestrian",
      "Bicyclist",
      "Driver of a Motor Vehicle In-Transport",
      "Passenger of a Motor Vehicle In-Transport"
    )),
    inj_sev = factor(c(
      "Fatal Injury (K)",
      "Fatal Injury (K)",
      "Suspected Serious Injury (A)",
      "Fatal Injury (K)",
      "Suspected Minor Injury (B)"
    )),
    age = c("25", "45", "32", "68", "12"),
    speedrel = factor(c("Yes", "No", "No", "No", "Yes")),
    body_typ = factor(c(
      "Passenger Car",
      NA,
      NA,
      "Single-unit straight truck or Cab-Chassis (GVWR > 26,000 lbs.)",
      "Passenger Car"
    )),
    alc_res = c("0.15", "0.00", "0.00", "0.00", "0.00"),
    dr_drink = factor(c("Yes", NA, NA, "No", NA)),
    drugs = factor(c("No", NA, NA, "Yes", NA)),
    hit_run = factor(c("No", "Yes", "No", "No", "No")),
    rollover = factor(c("No Rollover", "No Rollover", "Rollover - Tripped", "No Rollover", "No Rollover")),
    tow_veh = factor(c(NA, NA, NA, "One Trailing Unit", NA)),
    stringsAsFactors = FALSE
  )

  # Create multi_acc data
  multi_acc <- data.frame(
    state = factor(c("Virginia", "Virginia", "Maryland")),
    st_case = as.character(c(100001, 100002, 200001)),
    name = factor(c("weather1", "weather1", "crashrf")),
    value = factor(c("Clear", "Rain", "Police Pursuit Involved")),
    year = factor(c(2020, 2020, 2020)),
    stringsAsFactors = FALSE
  )

  # Create multi_veh data
  multi_veh <- data.frame(
    state = factor(c("Virginia", "Virginia", "Maryland")),
    st_case = as.character(c(100001, 100002, 200001)),
    veh_no = c(1, 1, 1),
    name = factor(c("drdistract", "drdistract", "mdrdstrd")),
    value = factor(c("Looked But Did Not See", "Not Distracted", "Talking or Listening to Cellular Phone")),
    year = factor(c(2020, 2020, 2020)),
    stringsAsFactors = FALSE
  )

  # Create multi_per data
  multi_per <- data.frame(
    state = factor(c("Virginia", "Virginia", "Maryland")),
    st_case = as.character(c(100001, 100002, 200001)),
    veh_no = c(1, 1, 1),
    per_no = c(1, 1, 1),
    name = factor(c("race", "race", "personrf")),
    value = factor(c("White", "Black or African American", "None")),
    year = factor(c(2020, 2020, 2020)),
    stringsAsFactors = FALSE
  )

  # Create events data
  events <- data.frame(
    state = factor(c("Virginia", "Virginia", "Maryland", "Virginia")),
    st_case = as.character(c(100001, 100002, 200001, 100001)),
    veh_no = c(1, 1, 1, 1),
    veventnum = c(1, 1, 1, 2),
    vnumber1 = c(0, 0, 0, 2),
    vnumber2 = c(0, 0, 0, 0),
    soe = factor(c(
      "Motor Vehicle In-Transport",
      "Pedestrian",
      "Ran Off Roadway - Right",
      "Tree (Standing Only)"
    )),
    year = factor(c(2020, 2020, 2020, 2020)),
    stringsAsFactors = FALSE
  )

  # Create codebook data
  codebook <- data.frame(
    source = factor(c("FARS", "FARS", "FARS")),
    file = factor(c("accident", "vehicle", "person")),
    name_ncsa = factor(c("STATE", "VEH_NO", "PER_NO")),
    name_rfars = factor(c("state", "veh_no", "per_no")),
    label = factor(c("State Number", "Vehicle Number", "Person Number")),
    value = c("51", "1", "1"),
    value_label = c("Virginia", "Vehicle 1", "Person 1"),
    stringsAsFactors = FALSE
  )

  # Create FARS object
  fars_obj <- list(
    flat = flat,
    multi_acc = multi_acc,
    multi_veh = multi_veh,
    multi_per = multi_per,
    events = events,
    codebook = codebook
  )

  class(fars_obj) <- c("list", "FARS")

  return(fars_obj)
}


#' Create a minimal mock GESCRSS object for testing
#'
#' @return A GESCRSS object with all expected structure but minimal data
create_mock_gescrss <- function() {

  # Create minimal flat data with weights
  flat <- data.frame(
    year = c(2020, 2020, 2021),
    casenum = c(100001, 100002, 100001),
    id = c(2020100001, 2020100002, 2021100001),
    veh_no = c(1, 1, 1),
    per_no = c(1, 1, 1),
    region = factor(c("South", "Northeast", "South")),
    urbanicity = factor(c("urban area", "rural area", "urban area")),
    per_typ = factor(c(
      "Driver of a Motor Vehicle In-Transport",
      "Pedestrian",
      "Driver of a Motor Vehicle In-Transport"
    )),
    inj_sev = factor(c(
      "Fatal Injury (K)",
      "Suspected Serious Injury (A)",
      "Suspected Minor Injury (B)"
    )),
    weight = c(1000, 1500, 1200),
    stringsAsFactors = FALSE
  )

  # Create simplified multi files
  multi_acc <- data.frame(
    casenum = as.character(c(100001, 100002)),
    name = factor(c("weather", "weather")),
    value = factor(c("Clear", "Rain")),
    year = factor(c(2020, 2020)),
    stringsAsFactors = FALSE
  )

  multi_veh <- data.frame(
    casenum = as.character(c(100001, 100002)),
    veh_no = c(1, 1),
    name = factor(c("drdistract", "drdistract")),
    value = factor(c("Not Distracted", "Talking to Passenger")),
    year = factor(c(2020, 2020)),
    stringsAsFactors = FALSE
  )

  multi_per <- data.frame(
    casenum = as.character(c(100001, 100002)),
    veh_no = c(1, 1),
    per_no = c(1, 1),
    name = factor(c("race", "race")),
    value = factor(c("White", "Hispanic or Latino")),
    year = factor(c(2020, 2020)),
    stringsAsFactors = FALSE
  )

  events <- data.frame(
    casenum = as.character(c(100001, 100002)),
    veh_no = c(1, 1),
    veventnum = c(1, 1),
    soe = factor(c("Motor Vehicle In-Transport", "Pedestrian")),
    year = factor(c(2020, 2020)),
    stringsAsFactors = FALSE
  )

  codebook <- data.frame(
    source = factor(c("GESCRSS", "GESCRSS")),
    file = factor(c("accident", "vehicle")),
    name_ncsa = factor(c("CASENUM", "VEH_NO")),
    name_rfars = factor(c("casenum", "veh_no")),
    label = factor(c("Case Number", "Vehicle Number")),
    value = c("100001", "1"),
    value_label = c("Case 100001", "Vehicle 1"),
    stringsAsFactors = FALSE
  )

  # Create GESCRSS object
  gescrss_obj <- list(
    flat = flat,
    multi_acc = multi_acc,
    multi_veh = multi_veh,
    multi_per = multi_per,
    events = events,
    codebook = codebook
  )

  class(gescrss_obj) <- c("list", "GESCRSS")

  return(gescrss_obj)
}


#' Create a simple data frame for testing helper functions
create_test_df <- function() {
  data.frame(
    year = c(2020, 2020, 2021),
    st_case = c(100001, 100002, 100001),
    veh_no = c(1, 2, 1),
    per_no = c(1, 1, 1),
    original_var = c(1, 2, 3),
    imputed_var = c(1, 999, 3),
    stringsAsFactors = FALSE
  )
}