Nothing
tests/testthat/test-compare.R
In healthiar: Quantifying and Monetizing Health Impacts Attributable to Exposure
# QUANTITATIVE TEST ############################################################
## RELATIVE RISK ################################################################
### DELTA #######################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"
)$health_main$impact_rounded,
expected =
c(774, 409, 1127) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
output_attribute_scen_1 <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 <-
healthiar::attribute_mod(
output_attribute = output_attribute_scen_1,
## What is different in scenario 2 compared to scenario 1
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"
)$health_main$impact_rounded,
expected =
c(774, 409, 1127) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("zero difference when scenarios are identical |meta_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"
)$health_main$impact_rounded,
expected =
c(0, 0, 0) # Results on 16 May 2024; no comparison study
)
})
#### ITERATION ##################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
scen_1_singlebhd_rr_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 20000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_rr_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_rr_geo,
# What is different in scenario 2 compared to scenario 1
exp_central = c(6, 6.5))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_rr_geo,
output_attribute_scen_2 = scen_2_singlebhd_rr_geo
)$health_main$impact_rounded,
expected =
c(1100, 582, 1603) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
scen_1_singlebhd_rr_geo_large <-
healthiar::attribute_health(
exp_central = c(runif_with_seed(100, 8.0, 9.0, 1)),
exp_lower = c(runif_with_seed(100, 8.0, 9.0, 1)-0.1),
exp_upper = c(runif_with_seed(100, 8.0, 9.0, 1)+0.1),
cutoff_central = 5,
bhd_central = c(runif_with_seed(100, 25000, 35000, 1)),
bhd_lower = c(runif_with_seed(100, 25000, 35000, 1)),
bhd_upper = c(runif_with_seed(100, 25000, 35000, 1)),
rr_central = 1.369,
rr_lower = 1.124,
rr_upper = 1.664,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = 1:100,
geo_id_macro = rep("CH", 100),
info = "PM2.5_mortality_2010")
scen_2_singlebhd_rr_geo_large <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_rr_geo_large,
exp_central = c(runif_with_seed(100, 8.0, 9.0, 2)),
exp_lower = c(runif_with_seed(100, 8.0, 9.0, 2)-0.1),
exp_upper = c(runif_with_seed(100, 8.0, 9.0, 2)+0.1))
testthat::expect_equal(
object =
comparison_singlebhd_rr_delta_geo <-
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_rr_geo_large,
output_attribute_scen_2 = scen_2_singlebhd_rr_geo_large
)$health_main$impact_rounded,
expected =
c(4166, 1656, 6330) # Result on 19 December 2024; no comparison study
)
})
#### YLD ########################################################################
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld
)$health_main$impact_rounded,
expected =
c(387, 205, 564) # Result on 16 May 2024; no comparison study
)
})
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo
)$health_main$impact_rounded,
expected =
c(591, 313, 861) # Result on 26 June 2024; no comparison study
)
})
##### ITERATION #################################################################
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo
)$health_main$impact_rounded,
expected =
c(591, 313, 861) # Result on 26 June 2024; no comparison study
)
})
### PIF #########################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(782, 412, 1146) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("results the same yld |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(391,206,573) # Result on 16 May 2024; no comparison study
)
})
#### ITERATION ##################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
scen_1_singlebhd_rr_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 20000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_rr_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_rr_geo,
# What is different in scenario 2 compared to scenario 1
exp_central = c(6, 6.5))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_rr_geo,
output_attribute_scen_2 = scen_2_singlebhd_rr_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(1114, 586, 1634) # Results on 19 June 2024; no comparison study
)
})
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(599, 315, 878) # Result on 20 June 2024; no comparison study
)
})
#### YLD ########################################################################
testthat::test_that("results the same yld |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
approach_comparison = "pif",
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld
)$health_main$impact_rounded,
expected =
c(391,206,573) # Result on 16 May 2024; no comparison study
)
})
##### ITERATION #################################################################
testthat::test_that("results the same yld |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
approach_comparison = "pif",
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo
)$health_main$impact_rounded,
expected =
c(599, 315, 878) # Result on 20 June 2024; no comparison study
)
})
## ABSOLUTE RISK ################################################################
## NOTE: no PIF option in AR pathway
### DELTA #######################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_dist|iteration_FALSE|", {
data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds"))
data <- data_raw |>
dplyr::filter(!is.na(data_raw$exposure_mean))
scen_1_singlebhd_ar <-
healthiar::attribute_health(
approach_risk = "absolute_risk",
exp_central = data$exposure_mean,
pop_exp = data$population_exposed_total,
erf_eq_central = "78.9270-3.1162*c+0.0342*c^2",
info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance"))
scen_2_singlebhd_ar <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_ar,
exp_central = c(50, 55, 60, 65, 75))
testthat::expect_equal(
object =
comparison_singlebhd_ar_delta <-
healthiar::compare(
scen_1_singlebhd_ar,
scen_2_singlebhd_ar
)$health_main$impact_rounded,
expected =
c(62531) # Result on 23 May 2024; no comparison study
)
})
#### YLD ########################################################################
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_dist|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
comparison_singlebhd_ar_delta <-
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld
)$health_main$impact_rounded,
expected =
c(387, 205, 564) # Result on 16 May 2024; no comparison study
)
})
#### ITERATION ##################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_dist|iteration_TRUE|", {
scen_1_singlebhd_ar_geo <-
healthiar::attribute_health(
approach_risk = "absolute_risk",
exp_central = c(c(57.5, 62.5, 67.5, 72.5, 77.5),
c(57, 62, 67, 72, 77)),# Fake values
population = rep(c(945200, 929800), each = 5),
pop_exp = c(c(387500, 286000, 191800, 72200, 7700),
c(380000, 280000, 190800, 72000, 7000)), # Fake values
erf_eq_central = "78.9270-3.1162*c+0.0342*c^2",
info = data.frame(pollutant = "road_noise",
outcome = "highly_annoyance",
year = 2020),
geo_id_micro = rep(c("a", "b"), each = 5),
geo_id_macro = rep("ch", each = 2*5)
)
scen_2_singlebhd_ar_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_ar_geo,
exp_central = c(c(50, 55, 60, 65, 75),
c(50.5, 55.5, 60.5, 65.5, 75.5)), # Fake values
info = data.frame(pollutant = "road_noise",
outcome = "highly_annoyance",
year = 2022))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_ar_geo,
output_attribute_scen_2 = scen_2_singlebhd_ar_geo
)$health_main$impact_rounded,
expected =
c(115869) # Results on 19 June 2024; no comparison study
)
})
## LIFETABLE ####################################################################
### YLL #########################################################################
#### DELTA ######################################################################
testthat::test_that("results correct yll |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable_test <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_yll_lifetable_test <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable_test,
exp_central = 6) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable_test,
output_attribute_scen_2 = scen_2_yll_lifetable_test
)$health_main$impact_rounded,
expected =
c(21301, 11159, 31358) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results correct yll |pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_yll_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 2*100)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable_geo,
output_attribute_scen_2 = scen_2_yll_lifetable_geo
)$health_main$impact_rounded,
expected =
c(32517, 17033, 47873) # Result on 7 July 2025; no comparison study to
)
})
#### PIF ########################################################################
testthat::test_that("results the same yll |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_yll_lifetable <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable,
exp_central = 6) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable,
output_attribute_scen_2 = scen_2_yll_lifetable,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(21353, 11173, 31471) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results the same yll |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_yll_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 2 * 100)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable_geo,
output_attribute_scen_2 = scen_2_yll_lifetable_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(32609, 17058, 48074) # Result on 7 July 2025; no comparison study to
)
})
### PREMATURE DEATHS ############################################################
#### DELTA ######################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_deaths_lifetable <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable,
output_attribute_scen_2 = scen_2_deaths_lifetable
)$health_main$impact_rounded,
expected =
c(1914, 1012, 2793) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results correct d|pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_deaths_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 2 * 100)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable_geo,
output_attribute_scen_2 = scen_2_deaths_lifetable_geo
)$health_main$impact_rounded,
expected =
c(2924, 1545, 4267) # Result on 7 July 2025; no comparison study to
)
})
#### PIF ########################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_deaths_lifetable <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable,
output_attribute_scen_2 = scen_2_deaths_lifetable,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(1934, 1017, 2836) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_deaths_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 100 * 2)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable_geo,
output_attribute_scen_2 = scen_2_deaths_lifetable_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(2959, 1555, 4343) # Result on 7 July 2025; no comparison study to
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = 6.167882,
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = 3.167488,
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = 231
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_dist|iteration_FALSE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(23.68696, 0),
cutoff_central = 0,
prop_pop_exp = c(0.2603914, 0.7396086),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(17.19273, 0),
cutoff_central = 0,
prop_pop_exp = c(0.1842342, 0.8157658),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = 226
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(6.848995, 6.565633, 6.167882),
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = c(650, 1200, 1000),
geo_id_micro = c('BR', 'FL', 'WA'))
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(3.125626, 2.948348, 3.167488),
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = c(650, 1200, 1000),
geo_id_micro = c('BR', 'FL', 'WA'))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = c(177, 325, 231)
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_dist|iteration_TRUE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(c(0, 26.79813), c(0, 25.89477), c(0, 23.68696)),
cutoff_central = 0,
prop_pop_exp = c(c(0.7444227, 0.2555773), c(0.7464495, 0.2535505), c(0.7396086, 0.2603914)),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = rep(c(650, 1200, 1000), each = 2),
geo_id_micro = rep(c('BR', 'FL', 'WA'), each = 2))
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(c(0, 19.22196), c(0, 17.91513), c(0, 17.19273)),
cutoff_central = 0,
prop_pop_exp = c(c(0.8373929, 0.1626071), c(0.8354269, 0.1645731), c(0.8157658, 0.1842342)),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = rep(c(650, 1200, 1000), each = 2),
geo_id_micro = rep(c('BR', 'FL', 'WA'), each = 2))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = c(173, 317, 226)
)
})
# ERROR OR WARNING ########
## ERROR #########
testthat::test_that("error if not the same arguments", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
exp_lower = 7.75,
exp_upper = 9,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"),
regexp = "The two scenarios must use the same arguments.")
})
testthat::test_that("error if common arguments with different value", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.15, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"),
regexp = "rr_central must be identical in both scenarios.")
})
testthat::test_that("error pif and different bhd", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 1000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"),
regexp = "For the PIF approach, bhd must be identical in both scenarios.")
})
testthat::test_that("error pif and absolute risk", {
data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds"))
data <- data_raw |>
dplyr::filter(!is.na(data_raw$exposure_mean))
scen_1_singlebhd_ar <-
healthiar::attribute_health(
approach_risk = "absolute_risk",
exp_central = data$exposure_mean,
pop_exp = data$population_exposed_total,
erf_eq_central = "78.9270-3.1162*c+0.0342*c^2",
info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance"))
scen_2_singlebhd_ar <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_ar,
exp_central = c(50, 55, 60, 65, 75))
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_ar,
output_attribute_scen_2 = scen_2_singlebhd_ar,
approach_comparison = "pif"),
regexp = "For the PIF approach, the absolute risk approach cannot be used.")
})
## WARNING #########
Try the healthiar package in your browser
Any scripts or data that you put into this service are public.
healthiar documentation built on March 12, 2026, 5:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# QUANTITATIVE TEST ############################################################
## RELATIVE RISK ################################################################
### DELTA #######################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"
)$health_main$impact_rounded,
expected =
c(774, 409, 1127) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
output_attribute_scen_1 <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 <-
healthiar::attribute_mod(
output_attribute = output_attribute_scen_1,
## What is different in scenario 2 compared to scenario 1
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"
)$health_main$impact_rounded,
expected =
c(774, 409, 1127) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("zero difference when scenarios are identical |meta_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"
)$health_main$impact_rounded,
expected =
c(0, 0, 0) # Results on 16 May 2024; no comparison study
)
})
#### ITERATION ##################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
scen_1_singlebhd_rr_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 20000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_rr_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_rr_geo,
# What is different in scenario 2 compared to scenario 1
exp_central = c(6, 6.5))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_rr_geo,
output_attribute_scen_2 = scen_2_singlebhd_rr_geo
)$health_main$impact_rounded,
expected =
c(1100, 582, 1603) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
scen_1_singlebhd_rr_geo_large <-
healthiar::attribute_health(
exp_central = c(runif_with_seed(100, 8.0, 9.0, 1)),
exp_lower = c(runif_with_seed(100, 8.0, 9.0, 1)-0.1),
exp_upper = c(runif_with_seed(100, 8.0, 9.0, 1)+0.1),
cutoff_central = 5,
bhd_central = c(runif_with_seed(100, 25000, 35000, 1)),
bhd_lower = c(runif_with_seed(100, 25000, 35000, 1)),
bhd_upper = c(runif_with_seed(100, 25000, 35000, 1)),
rr_central = 1.369,
rr_lower = 1.124,
rr_upper = 1.664,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = 1:100,
geo_id_macro = rep("CH", 100),
info = "PM2.5_mortality_2010")
scen_2_singlebhd_rr_geo_large <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_rr_geo_large,
exp_central = c(runif_with_seed(100, 8.0, 9.0, 2)),
exp_lower = c(runif_with_seed(100, 8.0, 9.0, 2)-0.1),
exp_upper = c(runif_with_seed(100, 8.0, 9.0, 2)+0.1))
testthat::expect_equal(
object =
comparison_singlebhd_rr_delta_geo <-
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_rr_geo_large,
output_attribute_scen_2 = scen_2_singlebhd_rr_geo_large
)$health_main$impact_rounded,
expected =
c(4166, 1656, 6330) # Result on 19 December 2024; no comparison study
)
})
#### YLD ########################################################################
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld
)$health_main$impact_rounded,
expected =
c(387, 205, 564) # Result on 16 May 2024; no comparison study
)
})
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo
)$health_main$impact_rounded,
expected =
c(591, 313, 861) # Result on 26 June 2024; no comparison study
)
})
##### ITERATION #################################################################
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo
)$health_main$impact_rounded,
expected =
c(591, 313, 861) # Result on 26 June 2024; no comparison study
)
})
### PIF #########################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(782, 412, 1146) # Results on 16 May 2024; no comparison study
)
})
testthat::test_that("results the same yld |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(391,206,573) # Result on 16 May 2024; no comparison study
)
})
#### ITERATION ##################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
scen_1_singlebhd_rr_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 20000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_rr_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_rr_geo,
# What is different in scenario 2 compared to scenario 1
exp_central = c(6, 6.5))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_rr_geo,
output_attribute_scen_2 = scen_2_singlebhd_rr_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(1114, 586, 1634) # Results on 19 June 2024; no comparison study
)
})
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(599, 315, 878) # Result on 20 June 2024; no comparison study
)
})
#### YLD ########################################################################
testthat::test_that("results the same yld |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
approach_comparison = "pif",
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld
)$health_main$impact_rounded,
expected =
c(391,206,573) # Result on 16 May 2024; no comparison study
)
})
##### ITERATION #################################################################
testthat::test_that("results the same yld |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
scen_1_singlebhd_yld_geo <-
healthiar::attribute_health(
exp_central = c(8.85, 8.0),
cutoff_central = 5,
bhd_central = c(25000, 25000),
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5,
duration_central = 1,
info = "PM2.5_yld_before",
geo_id_micro = c("a", "b"),
geo_id_macro = rep("ch", 2))
scen_2_singlebhd_yld_geo <-
attribute_mod(
output_attribute = scen_1_singlebhd_yld_geo,
exp_central = c(6, 6.5),
info = "PM2.5_yld_after")
testthat::expect_equal(
object =
healthiar::compare(
approach_comparison = "pif",
output_attribute_scen_1 = scen_1_singlebhd_yld_geo,
output_attribute_scen_2 = scen_2_singlebhd_yld_geo
)$health_main$impact_rounded,
expected =
c(599, 315, 878) # Result on 20 June 2024; no comparison study
)
})
## ABSOLUTE RISK ################################################################
## NOTE: no PIF option in AR pathway
### DELTA #######################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_dist|iteration_FALSE|", {
data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds"))
data <- data_raw |>
dplyr::filter(!is.na(data_raw$exposure_mean))
scen_1_singlebhd_ar <-
healthiar::attribute_health(
approach_risk = "absolute_risk",
exp_central = data$exposure_mean,
pop_exp = data$population_exposed_total,
erf_eq_central = "78.9270-3.1162*c+0.0342*c^2",
info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance"))
scen_2_singlebhd_ar <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_ar,
exp_central = c(50, 55, 60, 65, 75))
testthat::expect_equal(
object =
comparison_singlebhd_ar_delta <-
healthiar::compare(
scen_1_singlebhd_ar,
scen_2_singlebhd_ar
)$health_main$impact_rounded,
expected =
c(62531) # Result on 23 May 2024; no comparison study
)
})
#### YLD ########################################################################
testthat::test_that("results correct yld |pathway_compare|comp_appr_delta|exp_dist|iteration_FALSE|", {
scen_1_singlebhd_yld <-
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
dw_central = 0.5, dw_lower = 0.1, dw_upper = 1,
duration_central = 1, duration_lower = 0.5, duration_upper = 10)
scen_2_singlebhd_yld <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_yld,
exp_central = 6)
testthat::expect_equal(
object =
comparison_singlebhd_ar_delta <-
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_yld,
output_attribute_scen_2 = scen_2_singlebhd_yld
)$health_main$impact_rounded,
expected =
c(387, 205, 564) # Result on 16 May 2024; no comparison study
)
})
#### ITERATION ##################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_dist|iteration_TRUE|", {
scen_1_singlebhd_ar_geo <-
healthiar::attribute_health(
approach_risk = "absolute_risk",
exp_central = c(c(57.5, 62.5, 67.5, 72.5, 77.5),
c(57, 62, 67, 72, 77)),# Fake values
population = rep(c(945200, 929800), each = 5),
pop_exp = c(c(387500, 286000, 191800, 72200, 7700),
c(380000, 280000, 190800, 72000, 7000)), # Fake values
erf_eq_central = "78.9270-3.1162*c+0.0342*c^2",
info = data.frame(pollutant = "road_noise",
outcome = "highly_annoyance",
year = 2020),
geo_id_micro = rep(c("a", "b"), each = 5),
geo_id_macro = rep("ch", each = 2*5)
)
scen_2_singlebhd_ar_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_ar_geo,
exp_central = c(c(50, 55, 60, 65, 75),
c(50.5, 55.5, 60.5, 65.5, 75.5)), # Fake values
info = data.frame(pollutant = "road_noise",
outcome = "highly_annoyance",
year = 2022))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_ar_geo,
output_attribute_scen_2 = scen_2_singlebhd_ar_geo
)$health_main$impact_rounded,
expected =
c(115869) # Results on 19 June 2024; no comparison study
)
})
## LIFETABLE ####################################################################
### YLL #########################################################################
#### DELTA ######################################################################
testthat::test_that("results correct yll |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable_test <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_yll_lifetable_test <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable_test,
exp_central = 6) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable_test,
output_attribute_scen_2 = scen_2_yll_lifetable_test
)$health_main$impact_rounded,
expected =
c(21301, 11159, 31358) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results correct yll |pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_yll_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 2*100)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable_geo,
output_attribute_scen_2 = scen_2_yll_lifetable_geo
)$health_main$impact_rounded,
expected =
c(32517, 17033, 47873) # Result on 7 July 2025; no comparison study to
)
})
#### PIF ########################################################################
testthat::test_that("results the same yll |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_yll_lifetable <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable,
exp_central = 6) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable,
output_attribute_scen_2 = scen_2_yll_lifetable,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(21353, 11173, 31471) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results the same yll |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_yll_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "yll",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_yll_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_yll_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 2 * 100)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_yll_lifetable_geo,
output_attribute_scen_2 = scen_2_yll_lifetable_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(32609, 17058, 48074) # Result on 7 July 2025; no comparison study to
)
})
### PREMATURE DEATHS ############################################################
#### DELTA ######################################################################
testthat::test_that("results correct |pathway_compare|comp_appr_delta|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_deaths_lifetable <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable,
output_attribute_scen_2 = scen_2_deaths_lifetable
)$health_main$impact_rounded,
expected =
c(1914, 1012, 2793) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results correct d|pathway_compare|comp_appr_delta|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_deaths_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 2 * 100)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable_geo,
output_attribute_scen_2 = scen_2_deaths_lifetable_geo
)$health_main$impact_rounded,
expected =
c(2924, 1545, 4267) # Result on 7 July 2025; no comparison study to
)
})
#### PIF ########################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = 8.85, # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100),
age_group = base::rep(0:99, times = 2),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
year_of_analysis = 2019,
min_age = 20)
scen_2_deaths_lifetable <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable,
exp_central = 6)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable,
output_attribute_scen_2 = scen_2_deaths_lifetable,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(1934, 1017, 2836) # Result on 7 July 2025; no comparison study to
)
})
##### ITERATION #################################################################
testthat::test_that("results the same |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
scen_1_deaths_lifetable_geo <-
healthiar::attribute_lifetable(
health_outcome = "deaths",
exp_central = rep(c(8.85, 8.0), each = 2 * 100) , # Fake data just for testing purposes
prop_pop_exp = 1, # Fake data just for testing purposes
cutoff_central = 5, # PM2.5=5, WHO AQG 2021
rr_central = 1.118,
rr_lower = 1.060,
rr_upper = 1.179,
rr_increment = 10,
erf_shape = "log_linear",
approach_exposure = "single_year",
approach_newborns = "without_newborns",
sex = base::rep(c("male", "female"), each = 100, times = 2),
age_group = base::rep(0:99, times = 2*2),
bhd_central = base::rep(
c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
times = 2),
population = base::rep(
c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
times = 2),
year_of_analysis = 2019,
min_age = 20,
geo_id_micro = rep(c("a", "b"), each = 2* 100),
geo_id_macro = rep("ch", each = 2 * 2 * 100))
scen_2_deaths_lifetable_geo <-
healthiar::attribute_mod(
output_attribute = scen_1_deaths_lifetable_geo,
exp_central = rep(c(6, 6.5), each = 100 * 2)) # Fake data just for testing purposes
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_deaths_lifetable_geo,
output_attribute_scen_2 = scen_2_deaths_lifetable_geo,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected =
c(2959, 1555, 4343) # Result on 7 July 2025; no comparison study to
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_single|iteration_FALSE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = 6.167882,
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = 3.167488,
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = 231
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_dist|iteration_FALSE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(23.68696, 0),
cutoff_central = 0,
prop_pop_exp = c(0.2603914, 0.7396086),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(17.19273, 0),
cutoff_central = 0,
prop_pop_exp = c(0.1842342, 0.8157658),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = 1000)
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = 226
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_single|iteration_TRUE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(6.848995, 6.565633, 6.167882),
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = c(650, 1200, 1000),
geo_id_micro = c('BR', 'FL', 'WA'))
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(3.125626, 2.948348, 3.167488),
cutoff_central = 0,
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = c(650, 1200, 1000),
geo_id_micro = c('BR', 'FL', 'WA'))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = c(177, 325, 231)
)
})
testthat::test_that("results the same Sciensano tobacco example |pathway_compare|comp_appr_pif|exp_dist|iteration_TRUE|", {
data <- readRDS(testthat::test_path("data/rr_data.RDS"))
data <- subset(data, CAUSE == "Chronic obstructive pulmonary disease" & EXPOSURE == 'PACK_YEAR')
output_attribute_scen_1 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(c(0, 26.79813), c(0, 25.89477), c(0, 23.68696)),
cutoff_central = 0,
prop_pop_exp = c(c(0.7444227, 0.2555773), c(0.7464495, 0.2535505), c(0.7396086, 0.2603914)),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = rep(c(650, 1200, 1000), each = 2),
geo_id_micro = rep(c('BR', 'FL', 'WA'), each = 2))
output_attribute_scen_2 =
healthiar::attribute_health(
approach_risk = "relative_risk",
exp_central = c(c(0, 19.22196), c(0, 17.91513), c(0, 17.19273)),
cutoff_central = 0,
prop_pop_exp = c(c(0.8373929, 0.1626071), c(0.8354269, 0.1645731), c(0.8157658, 0.1842342)),
erf_eq_central = approxfun(data$UNITS, data$RR, rule = 2),
bhd_central = rep(c(650, 1200, 1000), each = 2),
geo_id_micro = rep(c('BR', 'FL', 'WA'), each = 2))
testthat::expect_equal(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"
)$health_main$impact_rounded,
expected = c(173, 317, 226)
)
})
# ERROR OR WARNING ########
## ERROR #########
testthat::test_that("error if not the same arguments", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
exp_lower = 7.75,
exp_upper = 9,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"),
regexp = "The two scenarios must use the same arguments.")
})
testthat::test_that("error if common arguments with different value", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.15, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "delta"),
regexp = "rr_central must be identical in both scenarios.")
})
testthat::test_that("error pif and different bhd", {
output_attribute_scen_1 =
healthiar::attribute_health(
exp_central = 8.85,
cutoff_central = 5,
bhd_central = 25000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2010")
output_attribute_scen_2 =
healthiar::attribute_health(
exp_central = 6,
cutoff_central = 5,
bhd_central = 1000,
approach_risk = "relative_risk",
erf_shape = "log_linear",
rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179,
rr_increment = 10,
info = "PM2.5_mortality_2020")
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = output_attribute_scen_1,
output_attribute_scen_2 = output_attribute_scen_2,
approach_comparison = "pif"),
regexp = "For the PIF approach, bhd must be identical in both scenarios.")
})
testthat::test_that("error pif and absolute risk", {
data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds"))
data <- data_raw |>
dplyr::filter(!is.na(data_raw$exposure_mean))
scen_1_singlebhd_ar <-
healthiar::attribute_health(
approach_risk = "absolute_risk",
exp_central = data$exposure_mean,
pop_exp = data$population_exposed_total,
erf_eq_central = "78.9270-3.1162*c+0.0342*c^2",
info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance"))
scen_2_singlebhd_ar <-
healthiar::attribute_mod(
output_attribute = scen_1_singlebhd_ar,
exp_central = c(50, 55, 60, 65, 75))
testthat::expect_error(
object =
healthiar::compare(
output_attribute_scen_1 = scen_1_singlebhd_ar,
output_attribute_scen_2 = scen_2_singlebhd_ar,
approach_comparison = "pif"),
regexp = "For the PIF approach, the absolute risk approach cannot be used.")
})
## WARNING #########
Try the healthiar package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.