Nothing
# 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())
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.