# QUANTITATIVE TEST ############################################################ ## RR ########################################################################### ### SINGLE EXPOSURE ############################################################# testthat::test_that("result correct |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", exp_central = data$mean_concentration, cutoff_central = data$cut_off_value, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, rr_central = data$relative_risk, rr_increment = 10, erf_shape = "log_linear", info = paste0(data$pollutant,"_", data$evaluation_name) )$health_main$impact_rounded, expected = # airqplus_pm_copd data |> dplyr::select(estimated_number_of_attributable_cases_central)|> base::as.numeric() ) }) testthat::test_that("zero effect if exp lower than cutoff |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = 4, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear" )$health_main$impact_rounded, expected = 0 ) }) # Multiple age and sex groups testthat::test_that("result correct |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = rep("relative_risk", 4), age = c("below_50", "below_50", "50_plus", "50_plus"), sex = c("male", "female", "male", "female"), exp_central = base::rep(data$mean_concentration, 4), cutoff_central = base::rep(data$cut_off_value, 4), bhd_central = base::rep(data$incidents_per_100_000_per_year/1E5*data$population_at_risk, 4), rr_central = base::rep(data$relative_risk, 4), rr_increment = base::rep(10, 4), erf_shape = base::rep("log_linear", 4), info = base::paste0(data$pollutant,"_", data$evaluation_name) )$health_main$impact_rounded, expected = # airqplus_pm_copd data$estimated_number_of_attributable_cases_central * 4 ) }) testthat::test_that("result correct |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, exp_lower = 8, exp_upper = 9, cutoff_central = data$cut_off_value, cutoff_lower = data$cut_off_value - 1, cutoff_upper = data$cut_off_value + 1, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, bhd_lower = 25000, bhd_upper = 35000, rr_central = data$relative_risk, rr_lower = data$relative_risk_lower, rr_upper = data$relative_risk_upper, rr_increment = 10, erf_shape = "log_linear", info = paste0(data$pollutant,"_", data$evaluation_name) )$health_main$impact_rounded, expected = # airqplus_pm_copd data |> dplyr::select(estimated_number_of_attributable_cases_central, estimated_number_of_attributable_cases_lower, estimated_number_of_attributable_cases_upper)|> base::as.numeric() ) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, exp_lower = data$mean_concentration - 1, exp_upper = data$mean_concentration + 1, cutoff_central = data$cut_off_value, cutoff_lower = data$cut_off_value - 1, cutoff_upper = data$cut_off_value + 1, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, bhd_lower = data$incidents_per_100_000_per_year/1E5*data$population_at_risk - 1, bhd_upper = data$incidents_per_100_000_per_year/1E5*data$population_at_risk + 1, rr_central = data$relative_risk, rr_lower = data$relative_risk_lower, rr_upper = data$relative_risk_upper, rr_increment = 10, erf_shape = "log_linear", info = paste0(data$pollutant,"_", data$evaluation_name) )$health_detailed$results_raw$impact_rounded, expected = # Results on 2025-06-12; no comparison study c(3502, 1353, 5474, 4344, 1695, 6729, 2633, 1007, 4154, 3502, 1353, 5474, 4344, 1695, 6728, 2633, 1007, 4153, 3502, 1353, 5474, 4345, 1695, 6729, 2633, 1007, 4154, 2633, 1007, 4154, 3502, 1353, 5474, 1736, 658, 2764, 2633, 1007, 4153, 3502, 1353, 5474, 1736, 658, 2764, 2633, 1007, 4154, 3502, 1353, 5474, 1736, 658, 2764, 4344, 1695, 6729, 5161, 2032, 7921, 3502, 1353, 5474, 4344, 1695, 6728, 5161, 2032, 7921, 3502, 1353, 5474, 4345, 1695, 6729, 5161, 2032, 7921, 3502, 1353, 5474) ) }) testthat::test_that("detailed result the same |fake_rr|erf_log_lin|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, exp_lower = data$mean_concentration - 1, exp_upper = data$mean_concentration + 1, cutoff_central = data$cut_off_value, cutoff_lower = data$cut_off_value - 1, cutoff_upper = data$cut_off_value + 1, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, bhd_lower = data$incidents_per_100_000_per_year/1E5*data$population_at_risk - 1, bhd_upper = data$incidents_per_100_000_per_year/1E5*data$population_at_risk + 1, rr_central = data$relative_risk, rr_lower = data$relative_risk_lower, rr_upper = data$relative_risk_upper, rr_increment = 10, erf_shape = "log_linear", info = paste0(data$pollutant,"_", data$evaluation_name) )$health_detailed$results_raw$impact_rounded, expected = # Results on 2025-06-12; no comparison study c(3502, 1353, 5474, 4344, 1695, 6729, 2633, 1007, 4154, 3502, 1353, 5474, 4344, 1695, 6728, 2633, 1007, 4153, 3502, 1353, 5474, 4345, 1695, 6729, 2633, 1007, 4154, 2633, 1007, 4154, 3502, 1353, 5474, 1736, 658, 2764, 2633, 1007, 4153, 3502, 1353, 5474, 1736, 658, 2764, 2633, 1007, 4154, 3502, 1353, 5474, 1736, 658, 2764, 4344, 1695, 6729, 5161, 2032, 7921, 3502, 1353, 5474, 4344, 1695, 6728, 5161, 2032, 7921, 3502, 1353, 5474, 4345, 1695, 6729, 5161, 2032, 7921, 3502, 1353, 5474) ) }) testthat::test_that("no error rr_no_error|erf_log_lin|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_no_error( object = healthiar::attribute_health( exp_central = data$mean_concentration, exp_lower = 8, exp_upper = 9, cutoff_central = data$cut_off_value, cutoff_lower = data$cut_off_value - 1, cutoff_upper = data$cut_off_value + 1, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, bhd_lower = 25000, bhd_upper = 35000, rr_central = data$relative_risk, rr_lower = data$relative_risk_lower, rr_upper = data$relative_risk_upper, rr_increment = 10, erf_shape = "log_linear", info = paste0(data$pollutant,"_", data$evaluation_name) ) ) }) testthat::test_that("number of rows in detailed results correct |meta_rr|erf_log_lin|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, exp_lower = 8, exp_upper = 9, cutoff_central = data$cut_off_value, cutoff_lower = data$cut_off_value - 1, cutoff_upper = data$cut_off_value + 1, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, bhd_lower = 25000, bhd_upper = 35000, rr_central = data$relative_risk, rr_lower = data$relative_risk_lower, rr_upper = data$relative_risk_upper, rr_increment = 10, erf_shape = "log_linear", info = paste0(data$pollutant,"_", data$evaluation_name) )$health_detailed$results_raw |> base::nrow(), expected = 3^4 # CI's in 4 input variables ) }) testthat::test_that("results the same |pathway_rr|erf_function|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, cutoff_central = data$cut_off_value, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, erf_eq_central = # GBD2019 ERF for PM and lower respiratory infections stats::splinefun( x = c(600,500,400,300,200,150,130,110,90,70,50,30,25,20,15,10,5,0), y = c(2.189,2.143,2.098,2.052,1.909,1.751,1.68,1.607,1.533,1.453,1.357,1.238,1.204,1.168,1.129,1.089,1.046, 1), method = "natural"), info = paste0(data$pollutant,"_", data$evaluation_name) )$health_main$impact_rounded, expected = c(1057) # Results on 10 October 2024 (with cutoff = 5 = data$cut_off_value); no comparison study ) }) testthat::test_that("results the same |pathway_rr|erf_function|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, cutoff_central = 0, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, erf_eq_central = # GBD2019 ERF for PM and lower respiratory infections stats::splinefun( x = c(600,500,400,300,200,150,130,110,90,70,50,30,25,20,15,10,5,0), y = c(2.189,2.143,2.098,2.052,1.909,1.751,1.68,1.607,1.533,1.453,1.357,1.238,1.204,1.168,1.129,1.089,1.046, 1), method = "natural"), info = paste0(data$pollutant,"_", data$evaluation_name))$health_main$impact_rounded, expected = c(2263) # Results on 10 October 2024 (with cutoff = 0); no comparison study ) }) testthat::test_that("results the same |pathway_rr|erf_function|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$mean_concentration, cutoff_central = data$cut_off_value, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, erf_eq_central = # GBD2019 ERF for PM and lower respiratory infections stats::approxfun( x = c(600,500,400,300,200,150,130,110,90,70,50,30,25,20,15,10,5,0), y = c(2.189,2.143,2.098,2.052,1.909,1.751,1.68,1.607,1.533,1.453,1.357,1.238,1.204,1.168,1.129,1.089,1.046, 1), method = "linear"), info = paste0(data$pollutant,"_", data$evaluation_name) )$health_main$impact_rounded, expected = c(1052) # Results on 10 October 2024 (with cutoff = 5); no comparison study ) }) testthat::test_that("results correct |pathway_rr|erf_function|exp_single|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "LMU_O3_COPD_mort_2016.rds")) erf <- splinefun(data$x, data$y, method="natural") erf_l <- splinefun(data$x, data$y_l, method="natural") erf_u <- splinefun(data$x, data$y_u, method="natural") testthat::expect_equal( ## healthiar FUNCTION CALL object = healthiar::attribute_health( erf_eq_central = erf, erf_eq_lower = erf_l, erf_eq_upper = erf_u, prop_pop_exp = 1, exp_central = 84.1, # exposure distribution for ozone cutoff_central = 0, bhd_central = 29908, #COPD mortality in Germany 2016 )$health_main$impact_rounded, ## RESULT(S) FROM THE COMPARISON ASSESSMENT YOU SELECTED expected = c(319,243,386) ) ## ASSESSOR: Susanne Breitner-Busch, LMU Munich ## ASSESSMENT DETAILS: https://www.umweltbundesamt.de/publikationen/quantifizierung-der-krankheitslast-verursacht-durch#:~:text=Beschrieben%20werden%20die%20gesundheitlichen%20Effekte%20in%20der%20deutschen,f%C3%BCr%20die%20Jahre%202007%20-%202016%20quantifiziert%20wurden. ## INPUT DATA DETAILS: Modelled ozone exposure, real COPD mortality data from Germany, 2016 }) testthat::test_that("results the same |fake_rr|erf_lin_log|exp_single|iteration_FALSE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = 20, cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "linear_log", bhd_central = 10)$health_main$impact, expected = 0.927071 # Results on 08 August 2024 (ChatGPT); no comparison study ) }) testthat::test_that("results the same |fake_rr|erf_log_log|exp_single|iteration_FALSE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = 20, cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "log_log", bhd_central = 10)$health_main$impact, expected = 0.936215963 # Results on 08 August 2024 (ChatGPT); no comparison study ) }) #### ITERATION ################################################################## testthat::test_that("results the same |fake_rr|erf_log_lin|exp_single|iteration_TRUE|", { bestcost_pm_mortality_a <- healthiar::attribute_health( exp_central = 8.1, cutoff_central = 0, bhd_central = 1000, rr_central = 1.063, rr_increment = 10, erf_shape = "log_linear", population = 1E5) bestcost_pm_mortality_b <- healthiar::attribute_mod( output_attribute = bestcost_pm_mortality_a, exp_central = 7.1, bhd_central = 2000, population = 2E5) testthat::expect_equal( object = healthiar::attribute_health( exp_central = c(8.1, 7.1), cutoff_central = 0, bhd_central = c(1000, 2000), rr_central = 1.063, rr_increment = 10, erf_shape = "log_linear", population = c(1E5, 2E5), geo_id_micro = c("a", "b"))$health_main$impact|>base::round(4), expected = c(48.2825, 84.9003) # Results on 30 April 2025; no comparison study ) }) testthat::test_that("results the same |fake_rr|erf_log_lin|exp_single|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = runif_with_seed(1E2, 8.0, 9.0, 1), exp_lower = runif_with_seed(1E2, 8.0, 9.0, 1)-0.1, exp_upper = runif_with_seed(1E2, 8.0, 9.0, 1)+0.1, cutoff_central = 5, bhd_central = runif_with_seed(1E2, 25000, 35000, 1), bhd_lower = runif_with_seed(1E2, 25000, 35000, 1) - 1000, bhd_upper = runif_with_seed(1E2, 25000, 35000, 1) + 1000, rr_central = 1.369, rr_lower = 1.124, rr_upper = 1.664, rr_increment = 10, erf_shape = "log_linear", population = rep(1E6, 1E2), geo_id_micro = 1:1E2, geo_id_macro = rep("CH", 1E2), info = "PM2.5_copd")$health_main$impact_rounded, expected = c(317577, 122363, 497741) # Results on 30 April 2025; no comparison study ) }) ## no cutoff testthat::test_that("results correct |pathway_rr|erf_log_lin|exp_single|iteration_TRUE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "mort_pm25_sect_2021.rds")) testthat::expect_equal( ## healthiar FUNCTION CALL object = healthiar::attribute_health( approach_risk = "relative_risk", erf_shape = "log_linear", rr_central = 1.118, rr_increment = 10.0, exp_central = data$PM25, cutoff_central = 0, bhd_central = data$VALUE_BASELINE, geo_id_micro = data$CS01012020 )$health_main$impact_rounded, ## RESULT(S) FROM THE COMPARISON ASSESSMENT YOU SELECTED expected = base::round(data$VALUE) ) ## ASSESSOR: Arno Pauwels, SCI ## ASSESSMENT DETAILS: All-cause mortality attributable to PM2.5, by census tract (iteration) ## INPUT DATA DETAILS: Modelled exposure, real mortality data from Belgium, 2021 }) ## with cutoff testthat::test_that("results correct |pathway_rr|erf_log_lin|exp_single|iteration_TRUE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "mort_pm25_sect_2021_cutoff.rds")) testthat::expect_equal( ## healthiar FUNCTION CALL object = healthiar::attribute_health( approach_risk = "relative_risk", erf_shape = "log_linear", rr_central = 1.118, rr_increment = 10.0, exp_central = data$PM25, cutoff_central = 2.5, bhd_central = data$VALUE_BASELINE, geo_id_micro = data$CS01012020 )$health_main$impact_rounded, ## RESULT(S) FROM THE COMPARISON ASSESSMENT YOU SELECTED expected = base::round(data$VALUE) ) ## ASSESSOR: Arno Pauwels, SCI ## ASSESSMENT DETAILS: All-cause mortality attributable to PM2.5, by census tract (iteration) WITH CUTOFF ## INPUT DATA DETAILS: Modelled exposure, real mortality data from Belgium, 2021 }) testthat::test_that("results correct |pathway_rr|erf_function|exp_single|iteration_TRUE|", { data <- base::readRDS(testthat::test_path("data", "LMU_O3_COPD_mort_2016.rds")) erf<-splinefun(data$x, data$y, method="natural") erf_l<-splinefun(data$x, data$y_l, method="natural") erf_u<-splinefun(data$x, data$y_u, method="natural") testthat::expect_equal( ## healthiar FUNCTION CALL object = healthiar::attribute_health( erf_eq_central = erf, erf_eq_lower = erf_l, erf_eq_upper = erf_u, prop_pop_exp = 1, exp_central = c(82.6,88.7,84.1), # exposure distribution for ozone cutoff_central = 0, bhd_central = c(27001,31064,29908), #COPD mortality in Germany 2016 geo_id_micro = c("2014","2015","2016") )$health_main$impact_rounded, ## RESULT(S) FROM THE COMPARISON ASSESSMENT YOU SELECTED expected = c(280,213,339,355,270,430,319,243,386) ) ## ASSESSOR: Susanne Breitner-Busch, LMU Munich ## ASSESSMENT DETAILS: https://www.umweltbundesamt.de/publikationen/quantifizierung-der-krankheitslast-verursacht-durch#:~:text=Beschrieben%20werden%20die%20gesundheitlichen%20Effekte%20in%20der%20deutschen,f%C3%BCr%20die%20Jahre%202007%20-%202016%20quantifiziert%20wurden. ## INPUT DATA DETAILS: Modelled ozone exposure, real COPD mortality data from Germany, 2016 }) testthat::test_that("results the same |fake_rr|erf_lin_log|exp_single|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( geo_id_micro = c("a", "b"), exp_central = c(20, 20), cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "linear_log", bhd_central = c(10, 10))$health_detailed$results_raw$impact, expected = c(0.927071, 0.927071) # Results on 08 August 2024 (ChatGPT); no comparison study ) }) testthat::test_that("results the same |fake_rr|erf_log_log|exp_single|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( geo_id_micro = c("a", "b"), exp_central = c(20, 20), cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "log_log", bhd_central = c(10, 10))$health_detailed$results_raw$impact, expected = c(0.936215963, 0.936215963) # Results on 06 August 2024 (ChatGPT); no comparison study ) }) #### YLD ######################################################################## testthat::test_that("results the same prevalence-based YLD (duration_central=1) |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { testthat::expect_equal( object = 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 )$health_main$impact_rounded, expected = c(525, 277, 768) # Result on 16 May 2024; no comparison study ) }) testthat::test_that("results the same incidence-based YLD (duration_central > 1) |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { testthat::expect_equal( object = 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 = 5, duration_lower = 2, duration_upper = 10 )$health_main$impact_rounded, expected = c(2627, 1386, 3839) # # Result on 2025-01-28; no comparison study ) }) testthat::test_that("results the same prevalence-based YLD |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { testthat::expect_equal( object = 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, )$health_main$impact_rounded, expected = c(525, 277, 768) # Result on 16 May 2024; no comparison study ) }) testthat::test_that("detailed results the same prevalence-based YLD |pathway_rr|erf_log_lin|exp_single|iteration_FALSE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = 8.85, exp_lower = 8.85 - 1, exp_upper = 8.85 + 1, cutoff_central = 5, cutoff_lower = 5 - 1, cutoff_upper = 5 + 1, 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, )$health_detailed$results_raw$impact |> round(), # 2025-04-02 Round at the end to obtain rounded results expected = # Result on 2025-06-12; no comparison study c(525, 277, 768, 105, 55, 154, 1051, 555, 1536, 658, 348, 959, 132, 70, 192, 1317, 697, 1919, 391, 206, 573, 78, 41, 115, 782, 412, 1146, 391, 206, 573, 78, 41, 115, 782, 412, 1146, 525, 277, 768, 105, 55, 154, 1051, 555, 1536, 255, 134, 375, 51, 27, 75, 511, 268, 750, 658, 348, 959, 132, 70, 192, 1317, 697, 1919, 790, 419, 1148, 158, 84, 230, 1579, 838, 2296, 525, 277, 768, 105, 55, 154, 1051, 555, 1536) ) }) ### EXPOSURE DISTRIBUTION ####################################################### testthat::test_that("results correct with cutoff |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) ## With prop_pop_exp testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$exposure_mean, prop_pop_exp = data$prop_exposed, cutoff_central = min(data$exposure_mean), bhd_central = data$gbd_daly[1], rr_central = 1.08, rr_increment = 10, erf_shape = "log_linear", info = data.frame(pollutant = "road_noise", outcome = "YLD") )$health_main$impact_rounded, expected = data_raw |> dplyr::filter(exposure_category %in% "Total exposed")|> dplyr::select(daly)|> dplyr::pull() |> base::round() ) }) testthat::test_that("results the same no cutoff |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$exposure_mean, prop_pop_exp = data$prop_exposed, bhd_central = data$gbd_daly[1], cutoff_central = 0, rr_central = 1.08, rr_increment = 10, erf_shape = "log_linear", info = data.frame(pollutant = "road_noise", outcome = "YLD") )$health_main$impact_rounded, expected = 29358 # Results on 2025-01-20; no comparison study ) }) testthat::test_that("results correct |pathway_rr|erf_function|exp_dist|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "LMU_O3_COPD_mort_2016.rds")) erf <- splinefun(data$x, data$y, method="natural") erf_l <- splinefun(data$x, data$y_l, method="natural") erf_u <- splinefun(data$x, data$y_u, method="natural") testthat::expect_equal( ## healthiar FUNCTION CALL object = healthiar::attribute_health( erf_eq_central = erf, erf_eq_lower = erf_l, erf_eq_upper = erf_u, prop_pop_exp = data$Population.affected, exp_central = data$Mean.O3, # exposure distribution for ozone cutoff_central = 0, bhd_central = 29908, #COPD mortality in Germany 2016 )$health_main$impact_rounded, ## RESULT(S) FROM THE COMPARISON ASSESSMENT YOU SELECTED expected = c(313,238,379) ) ## ASSESSOR: Susanne Breitner-Busch, LMU Munich ## ASSESSMENT DETAILS: https://www.umweltbundesamt.de/publikationen/quantifizierung-der-krankheitslast-verursacht-durch#:~:text=Beschrieben%20werden%20die%20gesundheitlichen%20Effekte%20in%20der%20deutschen,f%C3%BCr%20die%20Jahre%202007%20-%202016%20quantifiziert%20wurden. ## INPUT DATA DETAILS: Modelled ozone exposure, real COPD mortality data from Germany, 2016 }) testthat::test_that("results correct |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "LMU_O3_COPD_mort_2016.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", erf_shape = "log_linear", rr_central = 1.037, #pooled ozone effect estimate of the studies Lim et al. 2019, Kazemiparkouhi et al. 2019, Turner et al. 2016 rr_lower = 1.028, rr_upper = 1.045, rr_increment = 10, prop_pop_exp = data$Population.affected, exp_central = data$Mean.O3, # exposure distribution for ozone cutoff_central = 65, bhd_central = 29908, #COPD mortality in Germany 2016 )$health_main$impact_rounded, expected = c(2007,1537,2415) ) ## ASSESSOR: Susanne Breitner-Busch, LMU Munich ## ASSESSMENT DETAILS: https://www.umweltbundesamt.de/publikationen/quantifizierung-der-krankheitslast-verursacht-durch#:~:text=Beschrieben%20werden%20die%20gesundheitlichen%20Effekte%20in%20der%20deutschen,f%C3%BCr%20die%20Jahre%202007%20-%202016%20quantifiziert%20wurden. ## INPUT DATA DETAILS: Modelled ozone exposure, real COPD mortality data from Germany, 2016 }) testthat::test_that("results the same |fake_rr|erf_lin_log|exp_dist|iteration_FALSE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = c(20, 20), prop_pop_exp = c(0.5, 0.5), cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "linear_log", bhd_central = c(10))$health_main$impact, expected = 0.927071 # Results on 08 August 2024 (ChatGPT); no comparison study ) }) testthat::test_that("results the same |fake_rr|erf_log_log|exp_dist|iteration_FALSE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = c(20, 20), prop_pop_exp = c(0.5, 0.5), cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "log_log", bhd_central = 10)$health_main$impact, expected = 0.936215963 # Results on 06 August 2024 (ChatGPT); no comparison study ) }) #### ITERATION ################################################################## testthat::test_that("results the same no cutoff |pathway_rr|erf_log_lin|exp_dist|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( exp_central = base::rep(c(5, 6, 7, 8, 9), times = 3), cutoff_central = 5, prop_pop_exp = c(c(0.1, 0.3, 0.2, 0.2, 0.2), c(0.2, 0.2, 0.3, 0.1, 0.2), c(0.2, 0.2, 0.2, 0.1, 0.3)), bhd_central = rep(runif_with_seed(3,1E4,1E5,1), each = 5), rr_central = 1.08, rr_increment = 10, erf_shape = "log_linear", geo_id_micro = rep(1:3, each = 5), geo_id_macro = rep("ch", each = 5 * 3) )$health_detailed$results_raw$impact_rounded, expected = base::round(c(545, 634, 991)) # Results on 2025-06-24; no comparison study ) }) testthat::test_that("results correct |pathway_rr|erf_function|exp_dist|iteration_TRUE|", { data <- base::readRDS(testthat::test_path("data", "LMU_O3_COPD_mort_2015_2016.rds")) data <- data |> dplyr::slice(-1) erf <- splinefun(data$x[1:21], data$y[1:21], method="natural") erf_l <- splinefun(data$x[1:21], data$y_l[1:21], method="natural") erf_u <- splinefun(data$x[1:21], data$y_u[1:21], method="natural") testthat::expect_equal( object = healthiar::attribute_health( erf_eq_central = erf, erf_eq_lower = erf_l, erf_eq_upper = erf_u, prop_pop_exp = data$Population.affected, exp_central = data$Mean.O3, # exposure distribution for ozone cutoff_central = 0, bhd_central = data$bhd, #COPD mortality in Germany 2015 and 2016 geo_id_micro = data$X, )$health_main$impact_rounded, expected = c(350,267,424,313,238,379) ) ## ASSESSOR: Susanne Breitner-Busch, LMU Munich ## ASSESSMENT DETAILS: https://www.umweltbundesamt.de/publikationen/quantifizierung-der-krankheitslast-verursacht-durch#:~:text=Beschrieben%20werden%20die%20gesundheitlichen%20Effekte%20in%20der%20deutschen,f%C3%BCr%20die%20Jahre%202007%20-%202016%20quantifiziert%20wurden. ## INPUT DATA DETAILS: Modelled ozone exposure, real COPD mortality data from Germany, 2016 }) testthat::test_that("results the same |fake_rr|erf_lin_log|exp_dist|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( geo_id_micro = c("a", "a", "b", "b"), exp_central = c(20, 20, 20, 20), prop_pop_exp = c(0.5, 0.5, 0.5, 0.5), cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "linear_log", bhd_central = c(10, 10, 10, 10))$health_main$impact, expected = c(0.927071, 0.927071) # Results on 08 August 2024 (ChatGPT); no comparison study ) }) testthat::test_that("results the same |fake_rr|erf_log_log|exp_dist|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( geo_id_micro = c("a", "a", "b", "b"), exp_central = c(20, 20, 20, 20), prop_pop_exp = c(0.5, 0.5, 0.5, 0.5), cutoff_central = 5, rr_central = 1.08, rr_increment = 10, erf_shape = "log_log", bhd_central = c(10, 10, 10, 10))$health_main$impact, expected = c(0.936215963, 0.936215963) # Results on 06 August 2024 (ChatGPT); no comparison study ) }) #### USER-DEFINED ERF FUNCTION ############################################### testthat::test_that("results the same mrbrt with cutoff |pathway_rr|erf_function|exp_dist|iteration_FALSE|", { data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$exposure_mean, prop_pop_exp = data$prop_exposed, cutoff_central = min(data$exposure_mean), bhd_central = data$gbd_daly[1], erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_lower = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_upper = stats::splinefun( x = data_erf$exposure, y = data_erf$mean + 0.01, method = "natural"), info = data.frame(pollutant = "road_noise", outcome = "YLD") )$health_main$impact_rounded, expected = c(1637, 1637, 2450) # Results on 2025-01-20 ; no comparison study ) }) testthat::test_that("results the same mrbrt no cutoff |pathway_rr|erf_function|exp_dist|iteration_FALSE|", { data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) testthat::expect_equal( object = healthiar::attribute_health( exp_central = data$exposure_mean, cutoff_central = 0, prop_pop_exp = data$prop_exposed, bhd_central = data$gbd_daly[1], erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_lower = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_upper = stats::splinefun( x = data_erf$exposure, y = data_erf$mean + 0.01, method = "natural"), info = data.frame(pollutant = "road_noise", outcome = "YLD") )$health_main$impact_rounded, expected = c(32502, 32502, 32828) # Results on 2025-01-20 ; no comparison study ) }) testthat::test_that("results the same mrbrt with cutoff |fake_rr|erf_function|exp_dist|iteration_FALSE|", { data_pop <- base::readRDS(testthat::test_path("data", "pop_data_norway.rds")) data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", exp_central = data_pop$Concentration, prop_pop_exp = data_pop$Viken, cutoff_central = 5, bhd_central = 4500, erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural") )$health_main$impact_rounded, expected = c(32) # Results on 19 Dec 2024; no comparison study ) }) testthat::test_that("results the same mrbrt no cutoff |fake_rr|erf_function|exp_dist|iteration_FALSE|", { data_pop <- base::readRDS(testthat::test_path("data", "pop_data_norway.rds")) data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", exp_central = data_pop$Concentration, cutoff_central = 0, prop_pop_exp = data_pop$Viken, bhd_central = 4500, erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural") )$health_main$impact_rounded, expected = c(249) # Results on 2025-01-17; no comparison study ) }) testthat::test_that("results the same mrbrt with cutoff |fake_rr|erf_function|exp_dist|iteration_FALSE|", { data_pop <- base::readRDS(testthat::test_path("data", "pop_data_norway.rds")) data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", exp_central = data_pop$Concentration, prop_pop_exp = data_pop$Viken, cutoff_central = 0, bhd_central = 4500, erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural") )$health_main$impact_rounded, expected = c(249) # Results on 2025-01-17 ; no comparison study ) }) testthat::test_that("results the same mrbrt with cutoff |fake_rr|erf_function|exp_dist|iteration_FALSE|", { data_pop <- base::readRDS(testthat::test_path("data", "pop_data_norway.rds")) data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", exp_central = data_pop$Concentration, prop_pop_exp = data_pop$Viken, cutoff_central = 5, cutoff_lower = 5 - 1, cutoff_upper = 5 + 1, bhd_central = 4500, bhd_lower = 4500 - 1000, bhd_upper = 4500 + 1000, erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_lower = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_upper = stats::splinefun( x = data_erf$exposure, y = data_erf$mean + 0.01, method = "natural") )$health_main$impact_rounded, expected = c(32,32,76) # Results on 19 Dec 2024 ; no comparison study ) }) testthat::test_that("results the same |fake_rr|erf_function|exp_dist|iteration_FALSE|", { data_pop <- base::readRDS(testthat::test_path("data", "pop_data_norway.rds")) data_erf <- base::readRDS(testthat::test_path("data", "mrbrt_stroke.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "relative_risk", exp_central = data_pop$Concentration, cutoff_central = 5, cutoff_lower = 5 - 1, cutoff_upper = 5 + 1, prop_pop_exp = data_pop$Viken, bhd_central = 4500, bhd_lower = 4500 - 1000, bhd_upper = 4500 + 1000, erf_eq_central = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_lower = stats::splinefun( x = data_erf$exposure, y = data_erf$mean, method = "natural"), erf_eq_upper = stats::splinefun( x = data_erf$exposure, y = data_erf$mean + 0.01, method = "natural") )$health_main$impact_rounded, expected = c(32,32,76) # Results on 28 May 2025 ; no comparison study ) }) ## AR ########################################################################### testthat::test_that("results correct |pathway_ar|erf_formula|exp_dist|iteration_FALSE|", { base::load(testthat::test_path("data", "input_data_for_testing_Rpackage.Rdata")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) testthat::expect_equal( object = 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", id = 1:5) )$health_main$impact_rounded, expected = data_raw |> dplyr::filter(exposure_category %in% "Total exposed")|> dplyr::select(number)|> dplyr::pull() |> base::round() ) ## Single exposure value testthat::expect_equal( object = 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") )$health_detailed$results_raw |> dplyr::slice_head() |> dplyr::select(impact) |> dplyr::pull() |> base::round(), expected = data_raw |> dplyr::filter(exposure_category %in% "55-59")|> dplyr::select(number)|> dplyr::slice_head() |> dplyr::pull() |> base::round() ) }) testthat::test_that("results correct |pathway_ar|erf_formula|exp_dist|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "roadnoise_ha_Lden_StavangerandVicinity.rds")) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$average_cat, population = unique(data$totpop), pop_exp = data$ANTALL_PER, erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_main$impact_rounded, expected = c(14136) ) ## ASSESSOR: Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## INPUT DATA DETAILS: }) ### ITERATION ################################################################### testthat::test_that("no error ar iteration", { testthat::expect_no_error( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = c(runif_with_seed(5,8,10,1), runif_with_seed(5,8,10,2), runif_with_seed(5,8,10,3)), pop_exp = c( runif_with_seed(1,5E3,1E4,1) * runif_with_seed(5,0,1,1), # total pop * proportion pop exposed runif_with_seed(1,5E3,1E4,2) * runif_with_seed(5,0,1,2), runif_with_seed(1,5E3,1E4,3) * runif_with_seed(5,0,1,3) ), erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", geo_id_micro = rep(1:3, 5), info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance")) ) }) testthat::test_that("detailed results the same fake_ar|erf_formula|exp_dist|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = c(runif_with_seed(5,8,10,1), runif_with_seed(5,8,10,2), runif_with_seed(5,8,10,3)), pop_exp = c( runif_with_seed(1,5E3,1E4,1) * runif_with_seed(5,0,1,1), # total pop * proportion pop exposed runif_with_seed(1,5E3,1E4,2) * runif_with_seed(5,0,1,2), runif_with_seed(1,5E3,1E4,3) * runif_with_seed(5,0,1,3) ), erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", geo_id_micro = rep(1:3, 5), info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_detailed$results_raw$impact |> base::round(), expected = c(921, 1278, 1932, 2967, 704, 605, 2191, 1810, 551, 2877, 543, 2458, 1219, 1043, 1869) # Results on 2025-02-05; no comparison study ) }) testthat::test_that("detailed results the same fake_ar|erf_formula|exp_dist|iteration_TRUE|", { testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = c(runif_with_seed(5,9,10,1), runif_with_seed(5,9,10,2), runif_with_seed(5,9,10,3)), exp_lower = c(runif_with_seed(5,7,8,1), runif_with_seed(5,7,8,2), runif_with_seed(5,7,8,3)), exp_upper = c(runif_with_seed(5,11,12,1), runif_with_seed(5,11,12,2), runif_with_seed(5,11,12,3)), pop_exp = c( runif_with_seed(1,5E3,1E4,1) * runif_with_seed(5,0,1,1), # total pop * proportion pop exposed runif_with_seed(1,5E3,1E4,2) * runif_with_seed(5,0,1,2), runif_with_seed(1,5E3,1E4,3) * runif_with_seed(5,0,1,3) ), erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", geo_id_micro = rep(1:3, 5), info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_detailed$results_raw$impact |> base::round(), expected = # Results on 2025-01-20; no comparison study c(890, 976, 809, 1241, 1361, 1128, 1893, 2077, 1720, 2954, 3242, 2682, 678, 743, 617, 583, 639, 530, 2160, 2370, 1962, 1774, 1946, 1611, 530, 581, 482, 2870, 3150, 2605, 522, 573, 475, 2436, 2673, 2212, 1185, 1299, 1076, 1011, 1109, 919, 1834, 2012, 1666) ) }) testthat::test_that("results correct |pathway_ar|erf_formula|exp_dist|iteration_TRUE|", { data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) ## Convert data to long format following Ma-Loma's suggestion in #643 data <- data |> dplyr::select(-erf_percent,-number,-yld) |> tidyr::pivot_longer( cols = dplyr::starts_with("population_exposed_"), names_to = "region", values_to = "exposed" ) |> dplyr::mutate(region = base::strsplit(region, "_") |> purrr::map_chr(\(x) x[3])) |> dplyr::mutate(regionID = region |> base::as.factor() |> base::as.numeric()) testthat::expect_equal( object = healthiar::attribute_health( geo_id_micro = data$regionID, # geo_id_micro = rep(c("c","a","b"), times = 5), approach_risk = "absolute_risk", exp_central = data$exposure_mean, pop_exp = data$exposed, erf_eq_central = "78.9270-3.1162*c+0.0342*c^2")$health_main$impact_rounded, expected = c(150904, 23328, 174232) # Results from NIPH ) }) # Pathwway ID # pathway_ar-erf_formula-exp_dist-iteration_TRUE.R # Different number of exposure categories across geo_ids testthat::test_that("results correct pathway_ar|erf_formula|exp_dist|iteration_TRUE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "roadnoise_HA_Lden_Stavanger_Bergen_.rds")) testthat::expect_equal( ## healthiar FUNCTION CALL object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$average_cat, population = data$totpop, # prop_pop_exp = data$prop_pop_exp, pop_exp = data$ANTALL_PER, geo_id_micro = data$GEO_ID, geo_id_macro = "Norway", erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", dw_central = 0.02, duration_central = 1, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_detailed$results_by_geo_id_micro$impact_rounded, ## RESULT(S) FROM THE COMPARISON ASSESSMENT YOU SELECTED expected = c(283, 398 ) ) }) ## ASSESSOR: ## Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## Stavanger and Bergen highly annoyance ## INPUT DATA DETAILS: ## Add here input data details: data sources, measured vs. modeled, ... ### YLD ######################################################################### ## Using only the pop_exp argument testthat::test_that("results correct prevalence-based YLD |pathway_ar|erf_formula|exp_dist|iteration_FALSE|", { base::load(testthat::test_path("data", "input_data_for_testing_Rpackage.Rdata")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) niph_noise_ha_input <- niph_noise_ha_excel |> dplyr::filter(!is.na(niph_noise_ha_excel$exposure_mean)) testthat::expect_equal( object = 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", dw_central = 0.5, dw_lower = 0.1, dw_upper = 1, duration_central = 1, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_main$impact_rounded, expected = data_raw |> dplyr::filter(exposure_category %in% "Total exposed")|> dplyr::select(number)|> dplyr::pull() |> base::round() / 2 # With dw_central = 0.5 & duration_central = 1 the expected results are half of those we would obtain without dw & duration arguments ) }) ## Using the prop_pop_exp and pop_exp arguments in combination testthat::test_that("results correct prevalence-based YLD |pathway_ar|erf_formula|exp_dist|iteration_FALSE|", { base::load(testthat::test_path("data", "input_data_for_testing_Rpackage.Rdata")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) niph_noise_ha_input <- niph_noise_ha_excel |> dplyr::filter(!is.na(niph_noise_ha_excel$exposure_mean)) testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exposure_mean, pop_exp = data$population_exposed_total, # For prop_pop_exp case, this vector is summed in the background to get total pop exposed, which is then combined with prop_pop_exp to get the number exposed per exp category) erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", dw_central = 0.5, dw_lower = 0.1, dw_upper = 1, duration_central = 1, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_main$impact_rounded, expected = data_raw |> dplyr::filter(exposure_category %in% "Total exposed")|> dplyr::select(number)|> dplyr::pull() |> base::round() / 2 # With dw_central = 0.5 & duration_central = 1 the expected results are half of those we would obtain without dw & duration arguments ) }) testthat::test_that("results correct |pathway_ar|erf_formula|exp_dist|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "Bergen_HA_og_HSD.rds")) totalpop_Bergen <- 269189 testthat::expect_equal( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = as.numeric(gsub(",",".",data$Lden..dB..middle.point)), population = totalpop_Bergen, pop_exp = as.numeric(gsub(",",".",data$Bergen.)), erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", dw_central = 0.02, dw_lower = 0.01, dw_upper = 0.12, duration_central = 1, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") )$health_detailed$results_by_geo_id_micro$impact_rounded, expected = c(398, 199, 2388) ) ## ASSESSOR: Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## INPUT DATA DETAILS: }) # ERROR OR WARNING ######## ## ERROR ######### testthat::test_that("error if geo_id_macro but no geo_id_micro", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 6, prop_pop_exp = 1, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear", geo_id_macro = c("a", "b")), regexp = "If you do not pass a value for geo_id_micro, you cannot use geo_id_macro." ) }) testthat::test_that("error if rr lower than 0", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 6, cutoff_central = 5, bhd_central = 1000, rr_central = -1.05, rr_increment = 10, erf_shape = "log_linear"), regexp = "The values in the following arguments must be higher than 0: rr_central." ) }) ## NOTE 2025-08-08: the two error message tests for log-log and log-lin have been commented out, as with the new ERFs it's no problem to calculate RR's for exp=0 or when exp <= cutoff; once we've settled on these new ERFs remove these error messages # testthat::test_that("error if cutoff higher than exposure when erf_shape == log_log", { # # error <- "if the exposure-response function shape is log-log or linear-log then the values of cutoff_central, cutoff_lower and cutoff_upper must be lower than the values of exposure_central, exposure_lower and exposure_upper. please adjust." # # ## cutoff_central > exp_central # testthat::expect_error( # object = # healthiar::attribute_health( # exp_central = 4, cutoff_central = 5, # exp_lower = NULL, cutoff_lower = NULL, # exp_upper = NULL, cutoff_upper = NULL, # bhd_central = 1000, # rr_central = 1.05, # rr_increment = 10, # erf_shape = "log_log"), # regexp = error) # # ## cutoff_upper > exp_upper # testthat::expect_error( # object = # healthiar::attribute_health( # exp_central = 3, cutoff_central = 1, # exp_lower = 2, cutoff_lower = 0, # exp_upper = 5, cutoff_upper = 7, # bhd_central = 1000, # rr_central = 1.05, # rr_increment = 10, # erf_shape = "log_log"), # regexp = error) # # ## cutoff_lower == exp_lower # testthat::expect_error( # object = # healthiar::attribute_health( # exp_central = 3, # exp_lower = 2, # exp_upper = 5, # cutoff_central = 2, # cutoff_lower = 0, # cutoff_upper = 4, # bhd_central = 1000, # rr_central = 1.05, # rr_increment = 10, # erf_shape = "log_log"), # regexp = error) # }) # # testthat::test_that("error if cutoff higher than exposure when erf_shape == linear_log", { # # error <- "if the exposure-response function shape is log-log or linear-log then the values of cutoff_central, cutoff_lower and cutoff_upper must be lower than the values of exposure_central, exposure_lower and exposure_upper. please adjust." # # ## cutoff_central > exp_central # testthat::expect_error( # object = # healthiar::attribute_health( # exp_central = 4, cutoff_central = 5, # exp_lower = NULL, cutoff_lower = NULL, # exp_upper = NULL, cutoff_upper = NULL, # bhd_central = 1000, # rr_central = 1.05, # rr_increment = 10, # erf_shape = "linear_log"), # regexp = error) # # ## cutoff_upper > exp_upper # testthat::expect_error( # object = # healthiar::attribute_health( # exp_central = 3, cutoff_central = 1, # exp_lower = 2, cutoff_lower = 0, # exp_upper = 5, cutoff_upper = 7, # bhd_central = 1000, # rr_central = 1.05, # rr_increment = 10, # erf_shape = "linear_log"), # regexp = error) # # ## cutoff_lower == exp_lower # testthat::expect_error( # object = # healthiar::attribute_health( # exp_central = 3, # exp_lower = 2, # exp_upper = 5, # cutoff_central = 2, # cutoff_lower = 0, # cutoff_upper = 4, # bhd_central = 1000, # rr_central = 1.05, # rr_increment = 10, # erf_shape = "linear_log"), # regexp = error) # # }) testthat::test_that("error if dw higher than 1", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 4, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, dw_central = 1.1, erf_shape = "log_linear"), regexp = "The values in the following arguments must not be higher than 1: dw_central.") }) testthat::test_that("error if not lower>central>upper", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 4, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_lower = 1.10, rr_upper = 1.20, rr_increment = 10, erf_shape = "log_linear"), regexp = "rr_central must be higher than rr_lower and lower than rr_upper." ) }) testthat::test_that("error if only lower or upper", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 4, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_upper = 1.20, rr_increment = 10, erf_shape = "log_linear"), regexp = "Either both, rr_lower and rr_upper, or none of them must entered, but not only one.") }) testthat::test_that("error if numeric argument is not numeric", { testthat::expect_error( object = healthiar::attribute_health( exp_central = "hi", cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear"), regexp = "The following arguments should be numeric: exp_central", # Use fixed because otherwise the brackets regexp give an error in the test fixed = TRUE ) }) testthat::test_that("error if numeric argument is not numeric", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 6, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "hello"), regexp = "For erf_shape, please, type (between quotation marks) one of these options: linear, log_linear, log_log, linear_log.", # Use fixed = TRUE because brackets in the message fixed = TRUE ) }) testthat::test_that("error if sum(prop_pop_exp) higher than 1", { testthat::expect_error( object = healthiar::attribute_health( exp_central = c(6,7,8), prop_pop_exp = c(0.2,0.5,0.8), cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear"), regexp = "The sum of values in prop_pop_exp cannot be higher than 1 for each geo unit.") }) testthat::test_that("error if pop_exp and rr |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) ## With pop_exp testthat::expect_error( object = healthiar::attribute_health( exp_central = data$exposure_mean, pop_exp = data$population_exposed_total, cutoff_central = min(data$exposure_mean), bhd_central = data$gbd_daly[1], rr_central = 1.08, rr_increment = 10, erf_shape = "log_linear", info = data.frame(pollutant = "road_noise", outcome = "YLD") )$health_main$impact_rounded, regexp = "The argument pop_exp is aimed for absolute risk. Use prop_pop_exp instead.") }) testthat::test_that("error if prop_pop_exp and ar |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { base::load(testthat::test_path("data", "input_data_for_testing_Rpackage.Rdata")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) testthat::expect_error( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exposure_mean, prop_pop_exp = data$population_exposed_total/sum(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") ), regexp = "The argument prop_pop_exp is aimed for relative risk. Use pop_exp instead." ) }) testthat::test_that("error if pop_exp and prop_pop_exp |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) ## With pop_exp testthat::expect_error( object = healthiar::attribute_health( exp_central = data$exposure_mean, pop_exp = data$population_exposed_total, cutoff_central = min(data$exposure_mean), bhd_central = data$gbd_daly[1], rr_central = 1.08, rr_increment = 10, erf_shape = "log_linear", info = data.frame(pollutant = "road_noise", outcome = "YLD") )$health_main$impact_rounded, regexp = "The argument pop_exp is aimed for absolute risk. Use prop_pop_exp instead." ) }) testthat::test_that("error if rr and erf_eq", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 6, prop_pop_exp = 1, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear", erf_eq_central = "78.9270-3.1162*c+0.0342*c^2"), regexp = "The argument rr_central cannot be used together with the argument erf_eq_central (either one or the other but not both).", fixed = TRUE) }) testthat::test_that("error if multi geo units but different length of geo-depending arguments", { testthat::expect_error( object = healthiar::attribute_health( exp_central = c(6, 2, 3), prop_pop_exp = 1, cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear", geo_id_micro = c("a", "b")), regexp = "Not clear what is the maximal length of your arguments: 3, 2. Check: exp_central, geo_id_micro.") }) testthat::test_that("error if info has incompatible length |pathway_rr|erf_log_lin|exp_dist|iteration_FALSE|", { data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ihd_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) ## With pop_exp testthat::expect_error( object = healthiar::attribute_health( exp_central = data$exposure_mean, pop_exp = data$prop_exposed, cutoff_central = min(data$exposure_mean), bhd_central = data$gbd_daly[1], rr_central = 1.08, rr_increment = 10, erf_shape = "log_linear", info = data.frame(id = 1:20) )$health_main$impact_rounded, regexp = "All function arguments must have the same length (here 6) or length 1. Check: info.", fix = TRUE ) }) testthat::test_that("error if length of exp lower than length of prop pop", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 6, prop_pop_exp = c(0.5, 0.5), cutoff_central = 5, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear"), regexp = "All function arguments must have the same length (here 1) or length 1. Check: prop_pop_exp.", # To prevent not passed test because of the brackets fix = TRUE ) }) ## WARNING ######### testthat::test_that("warning if absolute risk and cutoff", { base::load(testthat::test_path("data", "input_data_for_testing_Rpackage.Rdata")) data_raw <- base::readRDS(testthat::test_path("data", "niph_noise_ha_excel.rds")) data <- data_raw |> dplyr::filter(!is.na(data_raw$exposure_mean)) testthat::expect_warning( object = healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exposure_mean, cutoff_central = 5, 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") ), regexp = "For absolute risk, the value of cutoff_central is not considered; cutoff_central is defined by the exposure-response function." ) }) testthat::test_that("error if multi geo units but different length of geo-depending arguments", { testthat::expect_warning( object = healthiar::attribute_health( exp_central = 6, prop_pop_exp = 1, bhd_central = 1000, rr_central = 1.05, rr_increment = 10, erf_shape = "log_linear"), regexp = "You entered no value for cutoff_central. Therefore, 0 has been assumed as default. Be aware that this can determine your results.") }) testthat::test_that("error if erf_eq is not function or string", { testthat::expect_error( object = healthiar::attribute_health( exp_central = 6, prop_pop_exp = 1, cutoff_central = 5, bhd_central = 1000, erf_eq_central = c(1)), regexp = "erf_eq_central must be a function or a character string." , fixed = TRUE) })