tests/testthat/test-seqic_4.R

In traumar: Calculate Metrics for Trauma System Performance

# tests/testthat/test-seqic_indicator_4.R

testthat::test_that("seqic_indicator_4() correctly expects columns to be in the 'data'", {
  # Minimal valid data
  data <- tibble::tibble(
    id = as.character(1:8),
    trauma_level = c("I", "II", "III", "IV", "I", "II", "III", "IV"),
    ed_disp = c(
      "Operating Room",
      "Admitted",
      "Deceased/Expired",
      "Transferred",
      "Deceased/Expired",
      "Deceased/Expired",
      "Admitted",
      "Deceased/Expired"
    ),
    ed_los = c(120, 200, 5000, 180, 3000, 4321, 60, 4000),
    hosp_disp = c(
      "Deceased/Expired",
      "Deceased/Expired",
      "Deceased/Expired",
      "Discharged",
      "Deceased/Expired",
      "Deceased/Expired",
      "Discharged",
      "Deceased/Expired"
    ),
    hosp_los = c(3000, 4500, 1000, 200, 5000, 4400, 150, 3000),
    autopsy_done = c("Yes", "No", "No", NA, "Yes", "No", NA, "Yes")
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = FAKE,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    regexp = "It was not possible to validate"
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = trauma_level,
      ed_disposition = NOT_TRUE,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    regexp = "It was not possible to validate"
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = "something else",
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    regexp = "It was not possible to validate"
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = other_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    regexp = "It was not possible to validate"
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = a_fake_column,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    regexp = "It was not possible to validate"
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = error,
      autopsy = autopsy_done
    ),
    regexp = "It was not possible to validate"
  )

  testthat::expect_error(
    traumar::seqic_indicator_4(
      data = data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = FALSE
    ),
    regexp = "It was not possible to validate"
  )
})

testthat::test_that("seqic_indicator_4() input validation works as expected", {
  valid_data <- tibble::tibble(
    trauma_level = factor(rep("I", 2)),
    ed_disp = c("Deceased/Expired", "Deceased/Expired"),
    ed_los = c(3000, 4000),
    hosp_disp = c("Deceased/Expired", "Deceased/Expired"),
    hosp_los = c(4000, 5000),
    autopsy_done = c("Yes", "No"),
    id = c("1", "2"),
    group_var = c("A", "B")
  )

  # data must be data.frame or tibble
  expect_error(
    traumar::seqic_indicator_4(
      data = list(),
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "must be of class.*data.frame.*tibble"
  )

  # level must be character or factor
  bad_data <- valid_data |> dplyr::mutate(trauma_level = as.numeric(1:2))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "must be of class.*character.*factor"
  )

  # ed_disposition must be character or factor
  bad_data <- valid_data |> dplyr::mutate(ed_disp = as.numeric(1:2))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "ed_disposition.*character.*factor"
  )

  # hospital_disposition must be character or factor
  bad_data <- valid_data |> dplyr::mutate(hosp_disp = as.numeric(1:2))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "hospital_disposition.*character.*factor"
  )

  # ed_LOS must be numeric
  bad_data <- valid_data |> dplyr::mutate(ed_los = as.character(ed_los))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "ed_LOS.*numeric"
  )

  # hospital_LOS must be numeric
  bad_data <- valid_data |> dplyr::mutate(hosp_los = as.character(hosp_los))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "hospital_LOS.*numeric"
  )

  # autopsy must be character or factor
  bad_data <- valid_data |> dplyr::mutate(autopsy_done = as.numeric(1:2))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "autopsy.*character.*factor"
  )

  # unique_incident_id must be character, factor, or numeric
  bad_data <- valid_data |> dplyr::mutate(id = list(1, 2))
  expect_error(
    traumar::seqic_indicator_4(
      data = bad_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done
    ),
    "unique_incident_id.*character.*numeric.*factor"
  )

  # groups must be character vector and present in data
  expect_error(
    traumar::seqic_indicator_4(
      data = valid_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done,
      groups = list()
    ),
    ".*groups.*strings"
  )

  expect_error(
    traumar::seqic_indicator_4(
      data = valid_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done,
      groups = c("bad_col")
    ),
    "not valid columns in.*data"
  )

  # calculate_ci must be NULL, "wilson", or "clopper-pearson"
  expect_error(
    traumar::seqic_indicator_4(
      data = valid_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done,
      calculate_ci = "jackknife"
    ),
    "must be.*wilson.*clopper-pearson"
  )

  # included_levels must be character, factor, or numeric
  expect_error(
    traumar::seqic_indicator_4(
      data = valid_data,
      level = trauma_level,
      ed_disposition = ed_disp,
      ed_LOS = ed_los,
      hospital_disposition = hosp_disp,
      hospital_LOS = hosp_los,
      unique_incident_id = id,
      autopsy = autopsy_done,
      included_levels = list("I", "II")
    ),
    "included_levels.*character.*factor.*numeric"
  )
})

testthat::test_that("seqic_indicator_4 computes 4a and 4b correctly", {
  data <- tibble::tibble(
    id = as.character(1:8),
    trauma_level = c("I", "II", "III", "IV", "I", "II", "III", "IV"),
    ed_disp = c(
      "Operating Room",
      "Admitted",
      "Deceased/Expired",
      "Transferred",
      "Deceased/Expired",
      "Deceased/Expired",
      "Admitted",
      "Deceased/Expired"
    ),
    ed_los = c(120, 200, 5000, 180, 3000, 4321, 60, 4000),
    hosp_disp = c(
      "Deceased/Expired",
      "Deceased/Expired",
      "Deceased/Expired",
      "Discharged",
      "Deceased/Expired",
      "Deceased/Expired",
      "Discharged",
      "Deceased/Expired"
    ),
    hosp_los = c(3000, 4500, 1000, 200, 5000, 4400, 150, 3000),
    autopsy_done = c("Yes", "No", "No", NA, "Yes", "No", NA, "Yes")
  )

  result <- traumar::seqic_indicator_4(
    data = data,
    level = trauma_level,
    ed_disposition = ed_disp,
    ed_LOS = ed_los,
    hospital_disposition = hosp_disp,
    hospital_LOS = hosp_los,
    unique_incident_id = id,
    autopsy = autopsy_done
  )

  testthat::expect_s3_class(result, "tbl_df")
  testthat::expect_true(all(
    c(
      "numerator_4a",
      "denominator_4a",
      "seqic_4a",
      "numerator_4b",
      "denominator_4b",
      "seqic_4b"
    ) %in%
      names(result)
  ))
  testthat::expect_equal(result$numerator_4a, 3) # 3 had autopsy = "Yes"
  testthat::expect_equal(result$denominator_4a, 6) # 6 deaths
  testthat::expect_equal(result$numerator_4b, 3) # 3 long LOS and no autopsy
  testthat::expect_equal(result$denominator_4b, 4)
})

testthat::test_that("seqic_indicator_4 computes correctly with grouping", {
  data <- tibble::tibble(
    id = as.character(1:4),
    trauma_level = c("I", "II", "I", "II"),
    ed_disp = rep("Deceased/Expired", 4),
    ed_los = c(100, 100, 5000, 5000),
    hosp_disp = rep("Deceased/Expired", 4),
    hosp_los = c(100, 100, 5000, 5000),
    autopsy_done = c("Yes", "No", "No", "No"),
    hospital = c("A", "A", "B", "B")
  )

  result <- traumar::seqic_indicator_4(
    data = data,
    level = trauma_level,
    ed_disposition = ed_disp,
    ed_LOS = ed_los,
    hospital_disposition = hosp_disp,
    hospital_LOS = hosp_los,
    unique_incident_id = id,
    autopsy = autopsy_done,
    groups = "hospital"
  )

  testthat::expect_equal(nrow(result), 2)
  testthat::expect_equal(result$numerator_4a[result$hospital == "A"], 1)
  testthat::expect_equal(result$numerator_4b[result$hospital == "B"], 2)
})

testthat::test_that("seqic_indicator_4 returns confidence intervals", {
  data <- tibble::tibble(
    id = as.character(1:5),
    trauma_level = rep("I", 5),
    ed_disp = rep("Deceased/Expired", 5),
    ed_los = c(100, 100, 100, 5000, 5000),
    hosp_disp = rep("Deceased/Expired", 5),
    hosp_los = c(100, 100, 100, 5000, 5000),
    autopsy_done = c("Yes", "Yes", "No", "No", "No")
  )

  result <- traumar::seqic_indicator_4(
    data = data,
    level = trauma_level,
    ed_disposition = ed_disp,
    ed_LOS = ed_los,
    hospital_disposition = hosp_disp,
    hospital_LOS = hosp_los,
    unique_incident_id = id,
    autopsy = autopsy_done,
    calculate_ci = "wilson"
  )

  testthat::expect_true("lower_ci_4a" %in% names(result))
  testthat::expect_true("upper_ci_4b" %in% names(result))
  testthat::expect_type(result$lower_ci_4a, "double")
})