tests/testthat/test-prevent_equations.R

In preventr: An Implementation of the AHA PREVENT Equations

# Do some basic tests first, then test more fine-tuned/aggressively via snapshots
test_that("Base model works, female", {
  expect_equal(
    estimate_risk_partial(quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.147, 
        ascvd = 0.092, 
        heart_failure = 0.081,
        chd = 0.044, 
        stroke = 0.054, 
        model = "base", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.53, 
        ascvd = 0.354, 
        heart_failure = 0.39,
        chd = 0.198, 
        stroke = 0.221, 
        model = "base", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("HbA1c model works, female", {
  expect_equal(
    estimate_risk_partial(hba1c = 9.2, quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.165, 
        ascvd = 0.103, 
        heart_failure = 0.107,
        chd = 0.055, 
        stroke = 0.053, 
        model = "hba1c", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.541, 
        ascvd = 0.356, 
        heart_failure = 0.449,
        chd = 0.219, 
        stroke = 0.2, 
        model = "hba1c", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("UACR model works, female", {
  expect_equal(
    estimate_risk_partial(uacr = 92, quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.181, 
        ascvd = 0.111, 
        heart_failure = 0.105,
        chd = 0.055, 
        stroke = 0.065, 
        model = "uacr", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.565, 
        ascvd = 0.381, 
        heart_failure = 0.437,
        chd = 0.22, 
        stroke = 0.241, 
        model = "uacr", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("SDI model works, female", {
  expect_equal(
    estimate_risk_partial(zip = "14738", quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.127, 
        ascvd = 0.08, 
        heart_failure = 0.07,
        chd = 0.038, 
        stroke = 0.047, 
        model = "sdi", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.485, 
        ascvd = 0.322, 
        heart_failure = 0.358,
        chd = 0.179, 
        stroke = 0.202, 
        model = "sdi", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("Full model works, female", {
  expect_equal(
    estimate_risk_partial(hba1c = 9.2, uacr = 92, zip = "14738", quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.174, 
        ascvd = 0.105, 
        heart_failure = 0.114,
        chd = 0.056, 
        stroke = 0.056, 
        model = "full", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.534, 
        ascvd = 0.348, 
        heart_failure = 0.443,
        chd = 0.213, 
        stroke = 0.204, 
        model = "full", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("Base model works, male", {
  expect_equal(
    estimate_risk_partial(sex = "male", quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.163, 
        ascvd = 0.102, 
        heart_failure = 0.106,
        chd = 0.056, 
        stroke = 0.052, 
        model = "base", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.514, 
        ascvd = 0.349, 
        heart_failure = 0.424,
        chd = 0.216, 
        stroke = 0.197, 
        model = "base", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("HbA1c model works, male", {
  expect_equal(
    estimate_risk_partial(sex = "male", hba1c = 9.2, quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.187, 
        ascvd = 0.112, 
        heart_failure = 0.13,
        chd = 0.063, 
        stroke = 0.056, 
        model = "hba1c", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.524, 
        ascvd = 0.34, 
        heart_failure = 0.457,
        chd = 0.211, 
        stroke = 0.188, 
        model = "hba1c", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("UACR model works, male", {
  expect_equal(
    estimate_risk_partial(sex = "male", uacr = 92, quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.195, 
        ascvd = 0.123, 
        heart_failure = 0.13,
        chd = 0.066, 
        stroke = 0.063, 
        model = "uacr", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.535, 
        ascvd = 0.368, 
        heart_failure = 0.448,
        chd = 0.227, 
        stroke = 0.213, 
        model = "uacr", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("SDI model works, male", {
  expect_equal(
    estimate_risk_partial(sex = "male", zip = "14738", quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.143, 
        ascvd = 0.088, 
        heart_failure = 0.089,
        chd = 0.049, 
        stroke = 0.043, 
        model = "sdi", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.48, 
        ascvd = 0.317, 
        heart_failure = 0.384,
        chd = 0.199, 
        stroke = 0.171, 
        model = "sdi", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("Full model works, male", {
  expect_equal(
    estimate_risk_partial(sex = "male", hba1c = 9.2, uacr = 92, zip = "14738", quiet = TRUE),
    list(
      risk_est_10yr = dplyr::tibble(
        total_cvd = 0.191, 
        ascvd = 0.112, 
        heart_failure = 0.131,
        chd = 0.068, 
        stroke = 0.052, 
        model = "full", 
        over_years = 10,
        input_problems = NA_character_
      ),
      
      risk_est_30yr = dplyr::tibble(
        total_cvd = 0.513, 
        ascvd = 0.326, 
        heart_failure = 0.438,
        chd = 0.216, 
        stroke = 0.167, 
        model = "full", 
        over_years = 30,
        input_problems = NA_character_
      )
    )
  )
})

test_that("Age validation works", {
  expect_snapshot(nested_lapply("age", 29, 80))
})

test_that("Age validation works, extra wrong" , {
  expect_snapshot(nested_lapply("age", test_vals = "wrong_extended"))
})

# Because helper fxs test both sexes (and don't accept `sex` as an arg),
# need to test this input a bit differently
test_that("Sex validation works", {
  check_equations_partial_sans_sex <- function(sex, quiet) {
    res <- estimate_risk(
      age = 50,
      sex = sex,
      sbp = 160,
      bp_tx = TRUE,
      total_c = 200,
      hdl_c = 45,
      statin = FALSE,
      dm = TRUE,
      smoking = FALSE,
      egfr = 90,
      bmi = 35,
      hba1c = NULL,
      uacr = NULL,
      zip = NULL,
      model = NULL,
      time = "both",
      chol_unit = "mg/dL",
      quiet = quiet
    )
    
    list(
      res_10yr = res[["risk_est_10yr"]] |> dplyr::select(-input_problems),
      input_probs_10yr = res[["risk_est_10yr"]][["input_problems"]],
      res_30yr = res[["risk_est_30yr"]] |> dplyr::select(-input_problems),
      input_probs_10yr = res[["risk_est_30yr"]][["input_problems"]]
    )
  }
  
  # Chatty version
  expect_snapshot(
    lapply(
      test_vals_basic(), 
      function(x) check_equations_partial_sans_sex(x, FALSE)
    )
  )
  
  # Quiet version
  expect_snapshot(
    lapply(
      test_vals_basic(), 
      function(x) check_equations_partial_sans_sex(x, TRUE)
    )
  )
  
  # Chatty version, extra wrong
  expect_snapshot(
    lapply(
      test_vals_extended(), 
      function(x) check_equations_partial_sans_sex(x, FALSE)
    )
  )
  
  # Quiet version, extra wrong
  expect_snapshot(
    lapply(
      test_vals_extended(), 
      function(x) check_equations_partial_sans_sex(x, TRUE)
    )
  )
})

test_that("SBP validation works", {
  expect_snapshot(nested_lapply("sbp", 89, 181))
})

test_that("SBP validation works, extra wrong", {
  expect_snapshot(nested_lapply("sbp", test_vals = "wrong_extended"))
})

test_that("BP treatment validation works", {
  # Expect instance of testing 0 and FALSE (see `test_vals_basic()`)
  # to yield (identical) results given those are valid inputs in this case
  expect_snapshot(nested_lapply("bp_tx"))
})

test_that("BP treatment validation works, extra wrong", {
  expect_snapshot(nested_lapply("bp_tx", test_vals = "wrong_extended"))
})

test_that("Total cholesterol validation works", {
  expect_snapshot(nested_lapply("total_c", 129, 321, "mg/dL"))
  # For the following, expect additional problems with HDL-C given
  # default set to 45, but that's based on mg/dL, whereas the following
  # test uses mmol/L
  expect_snapshot(nested_lapply("total_c", 3.3, 8.3, "mmol/L"))
})

test_that("Total cholesterol validation works, extra wrong", {
  expect_snapshot(nested_lapply("total_c", test_vals = "wrong_extended"))
})

test_that("HDL-C validation works", {
  expect_snapshot(nested_lapply("hdl_c", 19, 101, "mg/dL"))
  # For the following, expect additional problems with total cholesterol given
  # default set to 200, but that's based on mg/dL, whereas the following
  # test uses mmol/L
  expect_snapshot(nested_lapply("hdl_c", 0.5, 2.6, "mmol/L"))
})

test_that("HDL-C validation works, extra wrong", {
  expect_snapshot(nested_lapply("hdl_c", test_vals = "wrong_extended"))
})

test_that("Statin validation works", {
  # Expect instance of testing 0 and FALSE (see `test_vals_basic()`)
  # to yield (identical) results given those are valid inputs in this case
  expect_snapshot(nested_lapply("statin"))
})

test_that("Statin validation works, extra wrong", {
  expect_snapshot(nested_lapply("statin", test_vals = "wrong_extended"))
})

test_that("Diabetes mellitus validation works", {
  # Expect instance of testing 0 and FALSE (see `test_vals_basic()`)
  # to yield (identical) results given those are valid inputs in this case
  expect_snapshot(nested_lapply("dm"))
})

test_that("Diabetes mellitus validation works, extra wrong", {
  expect_snapshot(nested_lapply("dm", test_vals = "wrong_extended"))
})

test_that("Smoking validation works", {
  # Expect instance of testing 0 and FALSE (see `test_vals_basic()`)
  # to yield (identical) results given those are valid inputs in this case
  expect_snapshot(nested_lapply("smoking"))
})

test_that("Smoking validation works, extra wrong", {
  expect_snapshot(nested_lapply("smoking", test_vals = "wrong_extended"))
})

test_that("eGFR validation works", {
  expect_snapshot(nested_lapply("egfr", 14, 141))
})

test_that("eGFR validation works, extra wrong", {
  expect_snapshot(nested_lapply("egfr", test_vals = "wrong_extended"))
})

test_that("BMI validation works", {
  expect_snapshot(nested_lapply("bmi", 18.4, 40))
})

test_that("BMI validation works, extra wrong", {
  expect_snapshot(nested_lapply("bmi", test_vals = "wrong_extended"))
})

# In contrast to when there are problems with required inputs,
# expect problems with optional predictors to still yield results
# (in this case, from the base model), with notification to the user
# about the problems with the optional inputs
# 
# Also, because optional variables are permitted to be empty, 
# any input that is functionally empty or missing -- such as `NULL`, 
# `numeric(0)`, `NA`, etc. -- will not be considered problematic and thus not 
# populate in the `input_problems` column
test_that("HbA1c validation works", {
  expect_snapshot(nested_lapply("hba1c", 4.4, 15.1))
})

test_that("HbA1c validation works, extra wrong", {
  expect_snapshot(nested_lapply("hba1c", test_vals = "wrong_extended"))
})

test_that("UACR validation works", {
  expect_snapshot(nested_lapply("uacr", 0.09, 25000.1))
})

test_that("UACR validation works, extra wrong", {
  expect_snapshot(nested_lapply("uacr", test_vals = "wrong_extended"))
})

test_that("Zip code validation works", {
  expect_snapshot(nested_lapply("zip"))
})

test_that("Zip code validation works, extra wrong", {
  expect_snapshot(nested_lapply("zip", test_vals = "wrong_extended"))
})

test_that("Model validation works", {
  expect_snapshot(nested_lapply("model"))
})

test_that("Model validation works, extra wrong", {
  expect_snapshot(nested_lapply("model", test_vals = "wrong_extended"))
})

# Because helper fxs don't expect `time` as an arg, test `time` a bit differently
test_that("Time validation works", {
  check_equations_partial_sans_sex_and_time <- function(sex, time, quiet) {
    res <- estimate_risk(
      age = 50,
      sex = sex,
      sbp = 160,
      bp_tx = TRUE,
      total_c = 200,
      hdl_c = 45,
      statin = FALSE,
      dm = TRUE,
      smoking = FALSE,
      egfr = 90,
      bmi = 35,
      hba1c = NULL,
      uacr = NULL,
      zip = NULL,
      model = NULL,
      time = time,
      chol_unit = "mg/dL",
      quiet = quiet
    )
    
    # Because only one NA tibble will be returned, index accordingly
    # (vs. time-specific indexing, when two tibbles are returned, one
    # for each time horizon)
    list(
      res = res |> dplyr::select(-input_problems),
      input_probs = res[["input_problems"]]
    )
  }
  
  # Chatty versions, basic
  expect_snapshot(
    lapply(
      test_vals_basic(), 
      function(x) check_equations_partial_sans_sex_and_time("f", x, FALSE)
    )
  )
  
  expect_snapshot(
    lapply(
      test_vals_basic(), 
      function(x) check_equations_partial_sans_sex_and_time("m", x, FALSE)
    )
  )
  
  # Quiet versions, basic
  expect_snapshot(
    lapply(
      test_vals_basic(), 
      function(x) check_equations_partial_sans_sex_and_time("f", x, TRUE)
    )
  )
  
  expect_snapshot(
    lapply(
      test_vals_basic(), 
      function(x) check_equations_partial_sans_sex_and_time("m", x, TRUE)
    )
  )
  
  # Chatty versions, extended
  expect_snapshot(
    lapply(
      test_vals_extended(), 
      function(x) check_equations_partial_sans_sex_and_time("f", x, FALSE)
    )
  )
  
  expect_snapshot(
    lapply(
      test_vals_extended(), 
      function(x) check_equations_partial_sans_sex_and_time("m", x, FALSE)
    )
  )
  
  # Quiet versions, basic
  expect_snapshot(
    lapply(
      test_vals_extended(), 
      function(x) check_equations_partial_sans_sex_and_time("f", x, TRUE)
    )
  )
  
  expect_snapshot(
    lapply(
      test_vals_extended(), 
      function(x) check_equations_partial_sans_sex_and_time("m", x, TRUE)
    )
  )
})

test_that("Cholesterol unit validation works", {
  expect_snapshot(nested_lapply("chol_unit"))
})

test_that("Cholesterol unit validation works, extra wrong", {
  expect_snapshot(nested_lapply("chol_unit", test_vals = "wrong_extended"))
})

# This is to test the centering, etc. to prep terms
# for use in the models
dat <- data.frame(
  age = 65,
  sex = "female",
  sbp = 160,
  bp_tx = 1,
  total_c = 200,
  hdl_c = 50,
  statin = 0,
  dm = 1,
  smoking = 0,
  egfr = 90,
  bmi = 35,
  hba1c = 8.5,
  uacr = 40,
  zip = "10001"
)

test_that("Preparation of terms works - Basic", {
  expect_snapshot(prep_terms(dat, "base"))
  expect_snapshot(prep_terms(dat, "hba1c"))
  expect_snapshot(prep_terms(dat, "uacr"))
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
})

test_that("Preparation of terms works - No BP tx", {
  dat$bp_tx <- FALSE
  
  expect_snapshot(prep_terms(dat, "base"))
  expect_snapshot(prep_terms(dat, "hba1c"))
  expect_snapshot(prep_terms(dat, "uacr"))
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
})

test_that("Preparation of terms works - No statin", {
  dat$statin <- FALSE
  
  expect_snapshot(prep_terms(dat, "base"))
  expect_snapshot(prep_terms(dat, "hba1c"))
  expect_snapshot(prep_terms(dat, "uacr"))
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
})

test_that("Preparation of terms works - No DM", {
  dat$dm <- FALSE
  
  expect_snapshot(prep_terms(dat, "base"))
  expect_snapshot(prep_terms(dat, "hba1c"))
  expect_snapshot(prep_terms(dat, "uacr"))
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
})

test_that("Preparation of terms works - Missing optional predictors", {
  # Test missing optional predictors
  dat$dm  <- TRUE
  dat$hba1c <- NA
  dat$uacr <- NA
  dat$zip <- NA
  
  expect_snapshot(prep_terms(dat, "hba1c"))
  expect_snapshot(prep_terms(dat, "uacr"))
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
})

test_that("Preparation of terms works - Other SDI categories", {
  # Test zip where SDI from 4-6
  dat$zip <- "44221"
  
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
  
  # Test zip where SDI from 1-3
  dat$zip <- "01005"
  
  expect_snapshot(prep_terms(dat, "sdi"))
  expect_snapshot(prep_terms(dat, "full"))
})

test_that("Base model 10-year risks give expected results", {
  expect_snapshot(
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = TRUE,
      smoking = 0,
      bmi = 35,
      egfr = 90,
      bp_tx = 1,
      statin = FALSE,
      time = "10yr"
    )
  )
})

test_that("UACR model 10-year risks give expected results", {
  expect_snapshot(
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = 1,
      smoking = FALSE,
      bmi = 35,
      egfr = 90,
      bp_tx = TRUE,
      statin = 0,
      uacr = 40,
      time = "10yr"
    )
  )
})

test_that("HbA1c model 10-year risks give expected results", {
  expect_snapshot(
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = 1,
      smoking = FALSE,
      bmi = 35,
      egfr = 90,
      bp_tx = TRUE,
      statin = 0,
      hba1c = 7.5,
      time = "10yr"
    )
  )
})

test_that("Zip model 10-year risks give expected results & SDI lookup works", {
  sdi_10yr_partial <- function(zip) {
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = TRUE,
      smoking = FALSE,
      bmi = 35,
      egfr = 90,
      bp_tx = TRUE,
      statin = FALSE,
      zip = zip,
      time = "10yr"
    )
  }
  
  # SDI of 3
  expect_snapshot(get_sdi("03883"))
  expect_snapshot(sdi_10yr_partial(zip = "03883")) 
  # SDI of 5
  expect_snapshot(get_sdi("49544"))
  expect_snapshot(sdi_10yr_partial(zip = "49544"))
  # SDI of 10
  expect_snapshot(get_sdi("49507")) 
  expect_snapshot(sdi_10yr_partial(zip = "49507"))
})

test_that("Full model 10-year risks give expected results", {
  expect_snapshot(
    check_equations_partial(
      age = 75,
      statin = TRUE,
      dm = 0,
      smoking = 1,
      hba1c = 7.5,
      uacr = 40,
      zip = "49507",
      time = "10yr"
    )
  )
})

test_that("Time as character vs. numeric works: Base model, 10-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 67,
    statin = TRUE,
    dm = 0,
    smoking = 1,
    time = "10yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 67,
    statin = TRUE,
    dm = 0,
    smoking = 1,
    time = "10",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 67,
    statin = TRUE,
    dm = 0,
    smoking = 1,
    time = 10,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("base", chr_version_1$model[["female"]])
  expect_identical("base", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: HbA1c model, 10-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 61,
    statin = TRUE,
    smoking = 1,
    hba1c = 9.9,
    time = "10yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 61,
    statin = TRUE,
    smoking = 1,
    hba1c = 9.9,
    time = "10",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 61,
    statin = TRUE,
    smoking = 1,
    hba1c = 9.9,
    time = 10,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("hba1c", chr_version_1$model[["female"]])
  expect_identical("hba1c", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: UACR model, 10-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    uacr = 40,
    time = "10yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    uacr = 40,
    time = "10",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    uacr = 40,
    time = 10,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("uacr", chr_version_1$model[["female"]])
  expect_identical("uacr", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: SDI model, 10-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    zip = "49507",
    time = "10yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    zip = "49507",
    time = "10",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    zip = "49507",
    time = 10,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("sdi", chr_version_1$model[["female"]])
  expect_identical("sdi", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: Full model, 10-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    hba1c = 7.5,
    uacr = 40,
    zip = "49507",
    time = "10yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    hba1c = 7.5,
    uacr = 40,
    zip = "49507",
    time = "10",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    hba1c = 7.5,
    uacr = 40,
    zip = "49507",
    time = 10,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("full", chr_version_1$model[["female"]])
  expect_identical("full", chr_version_1$model[["male"]])
})

test_that("Base model 30-year risks give expected results", {
  expect_snapshot(
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = TRUE,
      smoking = 0,
      bmi = 35,
      egfr = 90,
      bp_tx = 1,
      statin = FALSE,
      time = "30yr"
    )
  )
})

test_that("UACR model 30-year risks give expected results", {
  expect_snapshot(
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = 1,
      smoking = FALSE,
      bmi = 35,
      egfr = 90,
      bp_tx = TRUE,
      statin = 0,
      uacr = 40,
      time = "30yr"
    )
  )
})

test_that("HbA1c model 30-year risks give expected results", {
  expect_snapshot(
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = 1,
      smoking = FALSE,
      bmi = 35,
      egfr = 90,
      bp_tx = TRUE,
      statin = 0,
      hba1c = 7.5,
      time = "30yr"
    )
  )
})

test_that("Zip model 30-year risks give expected results & SDI lookup works", {
  sdi_30yr_partial <- function(zip) {
    check_equations(
      age = 50,
      total_c = 200,
      hdl_c = 45,
      sbp = 160,
      # Deliberately use variations of TRUE/1 and FALSE/0
      dm = TRUE,
      smoking = FALSE,
      bmi = 35,
      egfr = 90,
      bp_tx = TRUE,
      statin = FALSE,
      zip = zip,
      time = "30yr"
    )
  }
  
  # SDI of 3
  expect_snapshot(get_sdi("03883"))
  expect_snapshot(sdi_30yr_partial(zip = "03883")) 
  # SDI of 5
  expect_snapshot(get_sdi("49544"))
  expect_snapshot(sdi_30yr_partial(zip = "49544"))
  # SDI of 10
  expect_snapshot(get_sdi("49507")) 
  expect_snapshot(sdi_30yr_partial(zip = "49507"))
})

test_that("Full model 30-year risks give expected results", {
  expect_snapshot(
    check_equations_partial(
      age = 75,
      statin = TRUE,
      dm = 0,
      smoking = 1,
      hba1c = 7.5,
      uacr = 40,
      zip = "49507",
      time = "30yr"
    )
  )
})

test_that("Time as character vs. numeric works: Base model, 30-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 67,
    statin = TRUE,
    dm = 0,
    smoking = 1,
    time = "30yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 67,
    statin = TRUE,
    dm = 0,
    smoking = 1,
    time = "30",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 67,
    statin = TRUE,
    dm = 0,
    smoking = 1,
    time = 30,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("base", chr_version_1$model[["female"]])
  expect_identical("base", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: HbA1c model, 30-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 61,
    statin = TRUE,
    smoking = 1,
    hba1c = 9.9,
    time = "30yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 61,
    statin = TRUE,
    smoking = 1,
    hba1c = 9.9,
    time = "30",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 61,
    statin = TRUE,
    smoking = 1,
    hba1c = 9.9,
    time = 30,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("hba1c", chr_version_1$model[["female"]])
  expect_identical("hba1c", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: UACR model, 30-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    uacr = 40,
    time = "30yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    uacr = 40,
    time = "30",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    uacr = 40,
    time = 30,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("uacr", chr_version_1$model[["female"]])
  expect_identical("uacr", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: SDI model, 30-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    zip = "49507",
    time = "30yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    zip = "49507",
    time = "30",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    zip = "49507",
    time = 30,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("sdi", chr_version_1$model[["female"]])
  expect_identical("sdi", chr_version_1$model[["male"]])
})

test_that("Time as character vs. numeric works: Full model, 30-year", {
  
  chr_version_1 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    hba1c = 7.5,
    uacr = 40,
    zip = "49507",
    time = "30yr",
    quiet = TRUE
  )
  
  chr_version_2 <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    hba1c = 7.5,
    uacr = 40,
    zip = "49507",
    time = "30",
    quiet = TRUE
  )
  
  num_version <- check_equations_partial(
    age = 75,
    statin = TRUE,
    smoking = 1,
    hba1c = 7.5,
    uacr = 40,
    zip = "49507",
    time = 30,
    quiet = TRUE
  )
  
  expect_identical(chr_version_1, num_version)
  expect_identical(chr_version_1, chr_version_2)
  expect_identical("full", chr_version_1$model[["female"]])
  expect_identical("full", chr_version_1$model[["male"]])
})

test_that("Cholesterol unit abbreviation works", {
  
  mg_full <- check_equations_partial(chol_unit = "mg/dL", quiet = TRUE)
  mg_abbrev <- check_equations_partial(chol_unit = "mg", quiet = TRUE)
  
  mmol_abbrev <- check_equations_partial(
    chol_unit = "mmol", 
    total_c = 4,
    hdl_c = 1,
    quiet = TRUE
  )
  
  mmol_full <- check_equations_partial(
    chol_unit = "mmol/L", 
    total_c = 4,
    hdl_c = 1,
    quiet = TRUE
  )
  
  expect_identical(mg_full, mg_abbrev)
  expect_identical(mmol_abbrev, mmol_full)
})

test_that("Optional predictors are handled correctly, one optional predictor is valid", {
  
  # ... in terms of model selection and results
  
  # UACR model shold run
  uacr_okay_hba1c_not_zip_null <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 40,
      hba1c = 75,
      zip = NULL,
      quiet = TRUE
    )
  
  uacr_okay_hba1c_null_zip_not <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 40,
      hba1c = NULL,
      zip = "99999",
      quiet = TRUE
    )
  
  uacr_okay_others_not <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 40,
      hba1c = 75,
      zip = "99999",
      quiet = TRUE
    )
  
  uacr_model_by_itself <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 40,
      quiet = TRUE
    )
  
  # Review input problems
  expect_snapshot(
    list(
      uacr_okay_hba1c_not_zip_null = 
        uacr_okay_hba1c_not_zip_null$input_problems, 
      uacr_okay_hba1c_null_zip_not = 
        uacr_okay_hba1c_null_zip_not$input_problems, 
      uacr_okay_others_not = 
        uacr_okay_others_not$input_problems, 
      uacr_model_by_itself =
        uacr_model_by_itself$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  uacr_okay_hba1c_not_zip_null$input_problems <- 
    uacr_okay_hba1c_null_zip_not$input_problems <-
    uacr_okay_others_not$input_problems <-
    uacr_model_by_itself$input_problems <- 
    NULL
  
  expect_identical(uacr_okay_hba1c_not_zip_null, uacr_model_by_itself)
  expect_identical(uacr_okay_hba1c_null_zip_not, uacr_model_by_itself)
  expect_identical(uacr_okay_others_not, uacr_model_by_itself)
  expect_identical(unique(uacr_okay_hba1c_not_zip_null$model), "uacr")
  
  # HbA1c model shold run
  hba1c_okay_uacr_not_zip_null <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 4000000,
      hba1c = 7.5,
      zip = NULL,
      quiet = TRUE
    )
  
  hba1c_okay_uacr_null_zip_not <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = NULL,
      hba1c = 7.5,
      zip = "99999",
      quiet = TRUE
    )
  
  hba1c_okay_others_not <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 4000000,
      hba1c = 7.5,
      zip = "99999",
      quiet = TRUE
    )
  
  hba1c_model_by_itself <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      hba1c = 7.5,
      quiet = TRUE
    )
  
  # Review input problems
  expect_snapshot(
    list(
      hba1c_okay_uacr_not_zip_null = 
        hba1c_okay_uacr_not_zip_null$input_problems, 
      hba1c_okay_uacr_null_zip_not = 
        hba1c_okay_uacr_null_zip_not$input_problems, 
      hba1c_okay_others_not = 
        hba1c_okay_others_not$input_problems, 
      hba1c_model_by_itself =
        hba1c_model_by_itself$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  hba1c_okay_uacr_not_zip_null$input_problems <-
    hba1c_okay_uacr_null_zip_not$input_problems <-
    hba1c_okay_others_not$input_problems <-
    hba1c_model_by_itself$input_problems <- 
    NULL
  
  expect_identical(hba1c_okay_uacr_not_zip_null, hba1c_model_by_itself)
  expect_identical(hba1c_okay_uacr_null_zip_not, hba1c_model_by_itself)
  expect_identical(hba1c_okay_others_not, hba1c_model_by_itself)
  expect_identical(unique(hba1c_okay_uacr_not_zip_null$model), "hba1c")
  
  # SDI model should run
  zip_okay_uacr_not_hba1c_null <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 4000000,
      hba1c = NULL,
      zip = "49507",
      quiet = TRUE
    )
  
  zip_okay_uacr_null_hba1c_not <-
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = NULL,
      hba1c = 75,
      zip = "49507",
      quiet = TRUE
    )
  
  zip_okay_others_not <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      uacr = 4000000,
      hba1c = 75,
      zip = "49507",
      quiet = TRUE
    )
  
  zip_by_itself <- 
    check_equations_partial(
      age = 75,
      statin = TRUE,
      smoking = 1,
      zip = "49507",
      quiet = TRUE
    )
  
  # Review input problems
  expect_snapshot(
    list(
      zip_okay_uacr_not_hba1c_null = 
        zip_okay_uacr_not_hba1c_null$input_problems, 
      zip_okay_uacr_null_hba1c_not = 
        zip_okay_uacr_null_hba1c_not$input_problems, 
      zip_okay_others_not = 
        zip_okay_others_not$input_problems, 
      zip_by_itself =
        zip_by_itself$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  zip_okay_uacr_not_hba1c_null$input_problems <-
    zip_okay_uacr_null_hba1c_not$input_problems <-
    zip_okay_others_not$input_problems <-
    zip_by_itself$input_problems <- 
    NULL
  
  expect_identical(zip_okay_uacr_not_hba1c_null, zip_by_itself)
  expect_identical(zip_okay_uacr_null_hba1c_not, zip_by_itself)
  expect_identical(zip_okay_others_not, zip_by_itself)
  expect_identical(unique(zip_okay_uacr_not_hba1c_null$model), "sdi")
})

test_that("Optional predictors are handled correctly, two optional predictors are valid", {
  
  full_model_invalid_uacr <- 
    check_equations_partial(
      age = 45,
      statin = TRUE,
      sbp = 148,
      uacr = 4000000,
      hba1c = 7.5,
      zip = "49507",
      quiet = TRUE
    )
  
  full_model_uacr_null <-
    check_equations_partial(
      age = 45,
      statin = TRUE,
      sbp = 148,
      uacr = NULL,
      hba1c = 7.5,
      zip = "49507",
      quiet = TRUE
    )
  
  # Review input problems
  expect_snapshot(
    list(
      full_model_invalid_uacr = full_model_invalid_uacr$input_problems, 
      full_model_uacr_null = full_model_uacr_null$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  full_model_invalid_uacr$input_problems <-
    full_model_uacr_null$input_problems <- 
    NULL
  
  expect_identical(full_model_invalid_uacr, full_model_uacr_null)
  expect_identical(unique(full_model_invalid_uacr$model), "full")
  
  full_model_invalid_hba1c <- 
    check_equations_partial(
      age = 45,
      statin = TRUE,
      sbp = 148,
      uacr = 40,
      hba1c = 75,
      zip = "49507",
      quiet = TRUE
    )
  
  full_model_hba1c_null <- 
    check_equations_partial(
      age = 45,
      statin = TRUE,
      sbp = 148,
      uacr = 40,
      hba1c = NULL,
      zip = "49507",
      quiet = TRUE
    )
  
  # Review input problems
  expect_snapshot(
    list(
      full_model_invalid_hba1c = full_model_invalid_hba1c$input_problems, 
      full_model_hba1c_null = full_model_hba1c_null$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  full_model_invalid_hba1c$input_problems <-
    full_model_hba1c_null$input_problems <- 
    NULL
  
  expect_identical(full_model_invalid_hba1c, full_model_hba1c_null)
  expect_identical(unique(full_model_invalid_hba1c$model), "full")
  
  full_model_invalid_zip <- 
    check_equations_partial(
      age = 45,
      statin = TRUE,
      sbp = 148,
      uacr = 40,
      hba1c = 7.5,
      zip = "99999",
      quiet = TRUE
    )
  
  full_model_zip_null <-
    check_equations_partial(
      age = 45,
      statin = TRUE,
      sbp = 148,
      uacr = 40,
      hba1c = 7.5,
      zip = NULL,
      quiet = TRUE
    )
  
  # Review input problems
  expect_snapshot(
    list(
      full_model_invalid_zip = full_model_invalid_zip$input_problems, 
      full_model_zip_null = full_model_zip_null$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  full_model_invalid_zip$input_problems <-
    full_model_zip_null$input_problems <- 
    NULL
  
  expect_identical(full_model_invalid_zip, full_model_zip_null)
  expect_identical(unique(full_model_invalid_zip$model), "full")
})

test_that("Invalid UACR is same as no UACR, only optional is UACR", {
  
  invalid_uacr <- check_equations_partial(uacr = 4000000, quiet = TRUE)
  no_uacr <- check_equations_partial(uacr = NULL, quiet = TRUE)
  
  # Review input problems
  expect_snapshot(
    list(
      invalid_uacr = invalid_uacr$input_problems, 
      no_uacr = no_uacr$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  invalid_uacr$input_problems <- no_uacr$input_problems <- NULL
  
  expect_identical(invalid_uacr, no_uacr)
  expect_identical(unique(invalid_uacr$model), "base")
})

test_that("Invalid HbA1c is same as no HbA1c, only optional is HbA1c", {
  
  invalid_hba1c <- check_equations_partial(hba1c = 75, quiet = TRUE)
  no_hba1c <- check_equations_partial(hba1c = NULL, quiet = TRUE)
  
  # Review input problems
  expect_snapshot(
    list(
      invalid_hba1c = invalid_hba1c$input_problems, 
      no_hba1c = no_hba1c$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  invalid_hba1c$input_problems <- no_hba1c$input_problems <- NULL
  
  expect_identical(invalid_hba1c, no_hba1c)
  expect_identical(unique(invalid_hba1c$model), "base")
})

test_that("Invalid zip is same as no zip, only optional is zip", {
  
  invalid_zip <- check_equations_partial(zip = "99999", quiet = TRUE)
  no_zip <- check_equations_partial(zip = NULL, quiet = TRUE)
  
  # Review input problems
  expect_snapshot(
    list(
      invalid_zip = invalid_zip$input_problems, 
      no_zip = no_zip$input_problems
    )
  )
  
  # Set `input_problems` to NULL to avoid comparing it now
  invalid_zip$input_problems <- no_zip$input_problems <- NULL
  
  expect_identical(invalid_zip, no_zip)
  expect_identical(unique(invalid_zip$model), "base")
})

test_that("Enforcing strict optional input validation works", {
  
  empty_table <- dplyr::tibble(
    total_cvd = NA_real_,
    ascvd = NA_real_,
    heart_failure = NA_real_,
    chd = NA_real_,
    stroke = NA_real_,
    model = "none",
    over_years = NA_integer_
  )
  
  empty_list_of_tables <- list(
    risk_est_10yr = empty_table,
    risk_est_30yr = empty_table
  )
  
  remove_input_probs <- function(x) {
    lapply(x, function(x) dplyr::select(x, -input_problems))
  }
  
  get_input_probs <- function(x) {
    unique(vapply(x, function(x) dplyr::pull(x, input_problems), character(1)))
  }
  
  # Basic invalid input ----
  # UACR
  uacr <- estimate_risk_partial(
    uacr = 9000000, 
    optional_strict = TRUE, 
    quiet = TRUE
  )
  uacr_input_problems <- get_input_probs(uacr)
  uacr_remove_input_problems <- remove_input_probs(uacr)
  
  # HbA1c
  hb1ac <- estimate_risk_partial(
    hba1c = 75, 
    optional_strict = TRUE,
    quiet = TRUE
  )
  hb1ac_input_problems <- get_input_probs(hb1ac)
  hb1ac_remove_input_problems <- remove_input_probs(hb1ac)
  
  # ZIP
  zip <- estimate_risk_partial(
    zip = "99999", 
    optional_strict = TRUE,
    quiet = TRUE
  )
  zip_input_problems <- get_input_probs(zip)
  zip_remove_input_problems <- remove_input_probs(zip)
  
  # UACR and HbA1c
  uacr_hba1c <- estimate_risk_partial(
    uacr = 9000000, 
    hba1c = 75, 
    optional_strict = TRUE,
    quiet = TRUE
  )
  uacr_hba1c_input_problems <- get_input_probs(uacr_hba1c)
  uacr_hba1c_remove_input_problems <- remove_input_probs(uacr_hba1c)
  
  # UACR and ZIP
  uacr_zip <- estimate_risk_partial(
    uacr = 9000000, 
    zip = "99999", 
    optional_strict = TRUE,
    quiet = TRUE
  )
  uacr_zip_input_problems <- get_input_probs(uacr_zip)
  uacr_zip_remove_input_problems <- remove_input_probs(uacr_zip)
  
  # HbA1c and ZIP
  hba1c_zip <- estimate_risk_partial(
    hba1c = 75, 
    zip = "99999", 
    optional_strict = TRUE,
    quiet = TRUE
  )
  hba1c_zip_input_problems <- get_input_probs(hba1c_zip)
  hba1c_zip_remove_input_problems <- remove_input_probs(hba1c_zip)

  # UACR, HbA1c, and ZIP
  uacr_hba1c_zip <- estimate_risk_partial(
    uacr = 9000000, 
    hba1c = 75, 
    zip = "99999", 
    optional_strict = TRUE,
    quiet = TRUE
  )
  uacr_hba1c_zip_input_problems <- get_input_probs(uacr_hba1c_zip)
  uacr_hba1c_zip_remove_input_problems <- remove_input_probs(uacr_hba1c_zip)
  
  # More complex invalid input ----
  # UACR
  uacr_complex <- estimate_risk_partial(
    uacr = list(a = list(b = data.frame(a = "apple", b = TRUE)), b = 5), 
    optional_strict = TRUE, 
    quiet = TRUE
  )
  uacr_input_problems_complex <- get_input_probs(uacr_complex)
  uacr_remove_input_problems_complex <- remove_input_probs(uacr_complex)
  
  # HbA1c
  hb1ac_complex <- estimate_risk_partial(
    hba1c = matrix(12, 3, 4), 
    optional_strict = TRUE,
    quiet = TRUE
  )
  hb1ac_input_problems_complex <- get_input_probs(hb1ac_complex)
  hb1ac_remove_input_problems_complex <- remove_input_probs(hb1ac_complex)
  
  # ZIP
  zip_complex <- estimate_risk_partial(
    zip = c("01011", "22222", "99999"), 
    optional_strict = TRUE,
    quiet = TRUE
  )
  zip_input_problems_complex <- get_input_probs(zip_complex)
  zip_remove_input_problems_complex <- remove_input_probs(zip_complex)
  
  # UACR and HbA1c
  uacr_hba1c_complex <- estimate_risk_partial(
    uacr = list(a = list(b = data.frame(a = "apple", b = TRUE)), b = 5), 
    hba1c = data.frame(a = 75, b = "potato"), 
    optional_strict = TRUE,
    quiet = TRUE
  )
  uacr_hba1c_input_problems_complex <- get_input_probs(uacr_hba1c_complex)
  uacr_hba1c_remove_input_problems_complex <- remove_input_probs(uacr_hba1c_complex)
  
  # UACR and ZIP
  uacr_zip_complex <- estimate_risk_partial(
    uacr = list(a = list(b = data.frame(a = "apple", b = TRUE)), b = 5), 
    zip = c("01011", "22222", "99999"), 
    optional_strict = TRUE,
    quiet = TRUE
  )
  uacr_zip_input_problems_complex <- get_input_probs(uacr_zip_complex)
  uacr_zip_remove_input_problems_complex <- remove_input_probs(uacr_zip_complex)
  
  # HbA1c and ZIP
  hba1c_zip_complex <- estimate_risk_partial(
    hba1c = data.frame(a = 75, b = "potato"), 
    zip = c("01011", "22222", "99999"), 
    optional_strict = TRUE,
    quiet = TRUE
  )
  hba1c_zip_input_problems_complex <- get_input_probs(hba1c_zip_complex)
  hba1c_zip_remove_input_problems_complex <- remove_input_probs(hba1c_zip_complex)
  
  # UACR, HbA1c, and ZIP
  uacr_hba1c_zip_complex <- estimate_risk_partial(
    uacr = list(a = list(b = data.frame(a = "apple", b = TRUE)), b = 5), 
    hba1c = data.frame(a = 75, b = "potato"), 
    zip = c("01011", "22222", "99999"), 
    optional_strict = TRUE,
    quiet = TRUE
  )
  uacr_hba1c_zip_input_problems_complex <- get_input_probs(uacr_hba1c_zip_complex)
  uacr_hba1c_zip_remove_input_problems_complex <- remove_input_probs(uacr_hba1c_zip_complex)
  
  # Review input problems
  expect_snapshot(
    list(
      uacr = uacr_input_problems,
      hb1ac = hb1ac_input_problems,
      zip = zip_input_problems,
      uacr_hba1c = uacr_hba1c_input_problems,
      uacr_zip = uacr_zip_input_problems,
      hba1c_zip = hba1c_zip_input_problems,
      uacr_hba1c_zip = uacr_hba1c_zip_input_problems,
      uacr_complex = uacr_input_problems_complex,
      hb1ac_complex = hb1ac_input_problems_complex,
      zip_complex = zip_input_problems_complex,
      uacr_hba1c_complex = uacr_hba1c_input_problems_complex,
      uacr_zip_complex = uacr_zip_input_problems_complex,
      hba1c_zip_complex = hba1c_zip_input_problems_complex,
      uacr_hba1c_zip_complex = uacr_hba1c_zip_input_problems_complex
    )
  )
  
  expect_equal(uacr_remove_input_problems, empty_list_of_tables)
  expect_equal(hb1ac_remove_input_problems, empty_list_of_tables)
  expect_equal(zip_remove_input_problems, empty_list_of_tables)
  expect_equal(uacr_hba1c_remove_input_problems, empty_list_of_tables)
  expect_equal(uacr_zip_remove_input_problems, empty_list_of_tables)
  expect_equal(hba1c_zip_remove_input_problems, empty_list_of_tables)
  expect_equal(uacr_hba1c_zip_remove_input_problems, empty_list_of_tables)
  expect_equal(uacr_remove_input_problems_complex, empty_list_of_tables)
  expect_equal(hb1ac_remove_input_problems_complex, empty_list_of_tables)
  expect_equal(zip_remove_input_problems_complex, empty_list_of_tables)
  expect_equal(uacr_hba1c_remove_input_problems_complex, empty_list_of_tables)
  expect_equal(uacr_zip_remove_input_problems_complex, empty_list_of_tables)
  expect_equal(hba1c_zip_remove_input_problems_complex, empty_list_of_tables)
  expect_equal(uacr_hba1c_zip_remove_input_problems_complex, empty_list_of_tables)
})

test_that("Additional checks of results, for good measure", {
  # At this point, given how the package is written (e.g., to ensure
  # full concordance between coefficients and term prep), with tests
  # thus far, further testing is essentially superfluous, but more tests
  # never hurt anyone :-)
  expect_snapshot(
    check_equations_partial(
      age = 67, statin = FALSE, 
      hba1c = 9
    )
  )
  
  expect_snapshot(
    check_equations_partial(
      age = 67, statin = TRUE, 
      uacr = 1000
    )
  )
  
  expect_snapshot(
    check_equations_partial(
      age = 71, statin = TRUE, 
      hba1c = 9, uacr = 1000
    )
  )
  
  expect_snapshot(
    check_equations_partial(
      age = 71, statin = TRUE, 
      hba1c = 9, uacr = 1000, zip = "49507"
    )
  )
  
  expect_snapshot(
    check_equations_partial(
      age = 71, sbp = 145, bp_tx = 0, 
      hba1c = 6.7, uacr = 10, zip = NA
    )
  )
  
  res_v1 <- check_equations_partial(
    age = 35, sbp = 145, bp_tx = 1, 
    uacr = 10, zip = NA, quiet = TRUE
  )
  
  res_v2 <- check_equations_partial(
    age = 35, sbp = 145, bp_tx = 1, 
    uacr = 10, quiet = TRUE
  )
  
  identical_res <- identical(res_v1, res_v2)
  
  expect_snapshot(res_v1)
  expect_snapshot(res_v2)
  expect_true(identical_res)
})

test_that("warning for 30-year risk with age > 59 works", {
  expect_warning(
    estimate_risk(
      age = 63,
      sex = "f",
      sbp = 120,
      bp_tx = FALSE,
      total_c = 200,
      hdl_c = 50,
      statin = FALSE,
      dm = FALSE,
      smoking = FALSE,
      egfr = 68,
      bmi = 22
    ),
    "Estimating 30-year risk in people > 59 years of age is questionable"
  )
  
  # Note setting `quiet = TRUE` to suppress the warning in these tests
  # to permit testing the output without {testthat} reporting a warning
  # during the tests
  expect_equal(
    estimate_risk(
      age = 63,
      sex = "f",
      sbp = 120,
      bp_tx = FALSE,
      total_c = 200,
      hdl_c = 50,
      statin = FALSE,
      dm = FALSE,
      smoking = FALSE,
      egfr = 68,
      bmi = 22,
      time = 30,
      quiet = TRUE
    )$input_problems,
    "Warning: Estimating 30-year risk in people > 59 years of age is questionable"
  )
  
  # Note setting `quiet = TRUE` (see above)
  expect_equal(
    estimate_risk(
      age = 63,
      sex = "f",
      sbp = 120,
      bp_tx = FALSE,
      total_c = 200,
      hdl_c = 50,
      statin = FALSE,
      dm = FALSE,
      smoking = FALSE,
      egfr = 68,
      bmi = 22,
      hba1c = 200,
      time = 30,
      quiet = TRUE
    )$input_problems,
    paste0(
      "Warning: Estimating 30-year risk in people > 59 years of age is questionable; ",
      "`hba1c` entered as 200, but must be between 4.5 and 15 (so set to NULL)"
    )
  )
})

test_that("app() function works", {
  # This is really just a dummy test
  expect_null(app())
})