## NOTE 2025-04-30 AL: actually all comparisons for summarize_uncertainty are ## "fake", and should be labelled as such - but since it's the way of ## corroborating our results that we have, I classify them as ## "results correct" comparisons. # QUANTITATIVE TEST ############################################################ ## RR ########################################################################### ### SINGLE EXPOSURE ############################################################# testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_rr_increment|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) bestcost_pm_copd_with_summary_uncertainty <- healthiar::attribute_health( exp_central = 8.85, exp_lower = data$mean_concentration - 1, exp_upper = data$mean_concentration + 1, cutoff_central = 5, 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) - 5000, bhd_upper = (data$incidents_per_100_000_per_year/1E5*data$population_at_risk) + 5000, rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179, rr_increment = 10, erf_shape = "log_linear" ) testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = bestcost_pm_copd_with_summary_uncertainty, n_sim = 100, seed = 122 )$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(1318, 639, 2239) ) }) testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_ar_function|iteration_FALSE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "roadnoise_HA_Lden_Stavanger_Bergen_.rds")) data$GEO_ID <- factor(data$GEO_ID, levels = unique(data$GEO_ID)) data <- data.frame( GEO_ID = levels(data$GEO_ID), exp_central = tapply(data$average_cat, data$GEO_ID, mean), pop_exp = tapply(data$ANTALL_PER, data$GEO_ID, sum), population = tapply(data$totpop, data$GEO_ID, unique) ) data <- data["Bergen",] erf_df <- data.frame( dB = seq(30, 85, by = 0.5) ) # Compute AR using the quadratic formula erf_df$AR <- 78.9270 - 3.1162 * erf_df$dB + 0.0342 * erf_df$dB^2 # Create a function using spline interpolation over the data spline_fun <- splinefun( x = erf_df$dB, y = erf_df$AR, method = "natural" ) ## healthiar FUNCTION CALL results_noise_ha <- healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exp_central, exp_lower = data$exp_central-5, exp_upper = data$exp_central+5, population = data$totpop, pop_exp = data$pop_exp, geo_id_micro = data$GEO_ID, geo_id_macro = "Norway", erf_eq_central = spline_fun, dw_central = 0.02, duration_central = 1, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") ) results_noise_ha_summarised <- healthiar::summarize_uncertainty(results_noise_ha, n_sim = 10, seed = 123) # Assuming SD of 47 and 70, and normal distribution expected_impacts <-c(#283, 191,375 , 2 try: 398, 261 , 535 350.0, 288.0, 507.0) ## COMPARE ONLY THE IMPACT_ROUNDED VECTOR testthat::expect_equal( object = results_noise_ha_summarised$uncertainty_detailed$uncertainty_by_geo_id_micro$impact_rounded, expected = expected_impacts ) }) ## ASSESSOR: ## Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## Bergen highly annoyance ## INPUT DATA DETAILS: ## Add here input data details: defined own function with spline interpolation, summarised the categories ## to the average and checked the +and- 5dB on the exposure. ## Assumed also a SD from the results_noise_ha object testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_ar_formula|iteration_FALSE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "roadnoise_HA_Lden_Stavanger_Bergen_.rds")) data$GEO_ID <- factor(data$GEO_ID, levels = unique(data$GEO_ID)) data <- data.frame( GEO_ID = levels(data$GEO_ID), exp_central = tapply(data$average_cat, data$GEO_ID, mean), pop_exp = tapply(data$ANTALL_PER, data$GEO_ID, sum), population = tapply(data$totpop, data$GEO_ID, unique) ) data <- data["Bergen",] ## healthiar FUNCTION CALL results_noise_ha <- healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exp_central, exp_lower = data$exp_central-5, exp_upper = data$exp_central+5, population = data$totpop, pop_exp = data$pop_exp, 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") ) results_noise_ha_summarised <- healthiar::summarize_uncertainty(results_noise_ha, n_sim = 100,seed = 123) # Assuming SD of 47 and 70, and normal distribution # from results_noise_ha expected_impacts <- c(#283, 209,385 , 349.0, 247.0, 506.0) ## COMPARE ONLY THE IMPACT_ROUNDED VECTOR testthat::expect_equal( object = results_noise_ha_summarised$uncertainty_detailed$uncertainty_by_geo_id_micro$impact_rounded, expected = expected_impacts ) }) ## ASSESSOR: ## Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## Bergen highly annoyance ## INPUT DATA DETAILS: ## Add here input data details: defined own function with spline interpolation, summarised the categories ## to the average and checked the +and- 5dB on the exposure. ## Assumed also a SD from the results_noise_ha object #### ITERATION ################################################################# testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_rr_increment|iteration_True|", { summary_uncertainty_small_iteration <- healthiar::attribute_health( exp_central = c(8, 7.5), exp_lower = c(7, 6.2), exp_upper = c(9, 8.1), cutoff_central = 5, cutoff_lower = 4, cutoff_upper = 6, bhd_central = c(1E5, 1E5), bhd_lower = c(5E4, 5E4), bhd_upper = c(2E5, 2E5), 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") ) testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = summary_uncertainty_small_iteration, n_sim = 100, seed = 123 )$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(2853, 936, 6531, 2943, 875, 7232) ) }) testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_rr_increment|iteration_TRUE|", { bestcost_pm_copd_geo_short <- healthiar::attribute_health( exp_central = runif_with_seed(1E1, 8.0, 9.0, 1), exp_lower = runif_with_seed(1E1, 8.0, 9.0, 1)-0.1, exp_upper = runif_with_seed(1E1, 8.0, 9.0, 1)+0.1, cutoff_central = 5, bhd_central = runif_with_seed(1E1, 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:1E1, geo_id_macro = c(rep("CH", 5), rep("DE", 5)), info = "PM2.5_copd") testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = bestcost_pm_copd_geo_short, n_sim = 100 )$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(16001, 7422, 22292, 16989, 7855, 23587) ) }) testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_ar_function|iteration_TRUE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "roadnoise_HA_Lden_Stavanger_Bergen_.rds")) data$GEO_ID <- factor(data$GEO_ID, levels = unique(data$GEO_ID)) data <- data.frame( GEO_ID = levels(data$GEO_ID), exp_central = tapply(data$average_cat, data$GEO_ID, mean), pop_exp = tapply(data$ANTALL_PER, data$GEO_ID, sum), population = tapply(data$totpop, data$GEO_ID, unique) ) erf_df <- data.frame( dB = seq(30, 85, by = 0.5) ) # Compute AR using the quadratic formula erf_df$AR <- 78.9270 - 3.1162 * erf_df$dB + 0.0342 * erf_df$dB^2 # Create a function using spline interpolation over the data spline_fun <- splinefun( x = erf_df$dB, y = erf_df$AR, method = "natural" ) ## healthiar FUNCTION CALL results_noise_ha <- healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exp_central, exp_lower = data$exp_central-5, exp_upper = data$exp_central+5, population = data$totpop, pop_exp = data$pop_exp, geo_id_micro = data$GEO_ID, geo_id_macro = "Norway", erf_eq_central = spline_fun, dw_central = 0.02, duration_central = 1, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance") ) results_noise_ha_summarised <- healthiar::summarize_uncertainty(results_noise_ha, n_sim = 10, seed = 123) # Assuming SD of 47 and 70, and normal distribution expected_impacts <-c(291.0, 228.0, 453.0, 357.0, 280.0, 479.0) ## COMPARE ONLY THE IMPACT_ROUNDED VECTOR testthat::expect_equal( object = results_noise_ha_summarised$uncertainty_detailed$uncertainty_by_geo_id_micro$impact_rounded, expected = expected_impacts ) }) ## ASSESSOR: ## Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## Stavanger and Bergen highly annoyance ## INPUT DATA DETAILS: ## Add here input data details: defined own function with spline interpolation, summarised the categories ## to the average and checked the +and- 5dB on the exposure. ## Assumed also a SD from the results_noise_ha object testthat::test_that("results correct |pathway_uncertainty|exp_single|erf_ar_formula|iteration_TRUE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION data <- base::readRDS(testthat::test_path("data", "roadnoise_HA_Lden_Stavanger_Bergen_.rds")) data$GEO_ID <- factor(data$GEO_ID, levels = unique(data$GEO_ID)) data <- data.frame( GEO_ID = levels(data$GEO_ID), exp_central = tapply(data$average_cat, data$GEO_ID, mean), pop_exp = tapply(data$ANTALL_PER, data$GEO_ID, sum), population = tapply(data$totpop, data$GEO_ID, unique) ) ## healthiar FUNCTION CALL results_noise_ha <- healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exp_central, exp_lower = data$exp_central-5, exp_upper = data$exp_central+5, population = data$totpop, pop_exp = data$pop_exp, 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") ) results_noise_ha_summarised <- healthiar::summarize_uncertainty(results_noise_ha, n_sim = 100,seed = 123) # Assuming SD of 47 and 70, and normal distribution expected_impacts <-c(287.0, 201.0, 418.0, 378.0, 276.0, 536.0) ## COMPARE ONLY THE IMPACT_ROUNDED VECTOR testthat::expect_equal( object = results_noise_ha_summarised$uncertainty_detailed$uncertainty_by_geo_id_micro$impact_rounded, expected = expected_impacts ) }) ## ASSESSOR: ## Liliana Vázquez, NIPH ## ASSESSMENT DETAILS: ## Bergen highly annoyance ## INPUT DATA DETAILS: ## Add here input data details: defined own function with spline interpolation, summarised the categories ## to the average and checked the +and- 5dB on the exposure. ## Assumed also a SD from the results_noise_ha object #### YLD ######################################################################## testthat::test_that("results correct yld |pathway_uncertainty|exp_single|erf_rr_increment|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) bestcost_pm_yld_singlebhd_with_summary_uncertainty <- healthiar::attribute_health( exp_central = 8.85, exp_lower = data$mean_concentration - 1, exp_upper = data$mean_concentration + 1, cutoff_central = 5, 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) - 5000, bhd_upper = (data$incidents_per_100_000_per_year/1E5*data$population_at_risk) + 5000, rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179, rr_increment = 10, erf_shape = "log_linear", # dw_central = 0.9, dw_lower = 0.88, dw_upper = 0.93, dw_central = 0.5, dw_lower = 0.25, dw_upper = 0.75, duration_central = 1 ) testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = bestcost_pm_yld_singlebhd_with_summary_uncertainty, n_sim = 100, seed = 122 )$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(706, 230, 1309) ) }) ### EXPOSURE DISTRIBUTION ####################################################### testthat::test_that("results correct |pathway_uncertainty|exp_dist|erf_rr_increment|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)) bestcost_noise_ihd_expDist <- 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_lower = 1.08 - 0.02, rr_upper = 1.08 + 0.02, rr_increment = 10, erf_shape = "log_linear", info = data.frame(pollutant = "road_noise", outcome = "YLD")) testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = bestcost_noise_ihd_expDist, n_sim = 100, seed = 122)$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(1146, 910, 1478) ) }) ### YLD ######################################################################### testthat::test_that("results correct yld |pathway_uncertainty|exp_dist|erf_ar_formula|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)) bestcost_noise_ha_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", dw_central = 0.5, dw_lower = 0.25, dw_upper = 0.75, duration_central = 1, duration_lower = 0.1, duration_upper = 10, info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance")) testthat::expect_equal( object = summarize_uncertainty( output_attribute = bestcost_noise_ha_ar, n_sim = 100, seed = 122)$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(171674, 2430, 614420) ) }) # COMPARE ######## testthat::test_that("results correct |pathway_uncertainty_compare|exp_dist|erf_ar_formula|iteration_TRUE|", { rr_scenario_1 <- healthiar::attribute_health( exp_central = 8, exp_lower = 7, exp_upper = 9, cutoff_central = 5, cutoff_lower = 4, cutoff_upper = 6, bhd_central = 1E5, bhd_lower = 5E4, bhd_upper = 2E5, rr_central = 1.118, rr_lower = 1.060, rr_upper = 1.179, rr_increment = 10, erf_shape = "log_linear") rr_scenario_2 <- healthiar::attribute_mod( output_attribute = rr_scenario_1, exp_central = 7.5, exp_lower = 6.2, exp_upper = 8.1) rr_comparison <- healthiar::compare( output_attribute_scen_1 = rr_scenario_1, output_attribute_scen_2 = rr_scenario_2, approach_comparison = "delta") testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = rr_comparison, n_sim = 100, seed = 122)$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(545.0, 171, 1107) ) }) ## ITERATION ####### testthat::test_that("summary uncertainty comparison iteration", { scen_1_singlebhd_rr_geo <- healthiar::attribute_health( approach_risk = "relative_risk", 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)) comparison_iteration <- healthiar::compare( output_attribute_scen_1 = scen_1_singlebhd_rr_geo, output_attribute_scen_2 = scen_2_singlebhd_rr_geo) testthat::expect_equal( object = healthiar::summarize_uncertainty( output_attribute = comparison_iteration, n_sim = 100)$uncertainty_main$impact_rounded, expected = # Results on 2025-10-29; no comparison study c(1113, 418, 1729) ) }) # ERROR OR WARNING ######## ## ERROR ######### testthat::test_that("error_if_erf_eq |pathway_uncertainty|exp_dist|erf_ar_formula|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)) bestcost_noise_ha_ar_with_erf_eq <- 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", erf_eq_lower = "78.9270-3.1162*c+0.034*c^2", erf_eq_upper = "78.9270-3.1162*c+0.04*c^2", info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance"), ) testthat::expect_error( object = summarize_uncertainty( bestcost_noise_ha_ar_with_erf_eq, n_sim = 1000), regexp = "Sorry, the summary of uncertainty for erf_eq_... is not currently supported." ) }) testthat::test_that("error_if_erf_eq |pathway_uncertainty|exp_dist|erf_ar_formula|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)) bestcost_noise_ha_ar_iteration_with_erf_eq <- healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = c(data$exposure_mean, data$exposure_mean + 5, data$exposure_mean + 10), pop_exp = c(data$population_exposed_total, data$population_exposed_total + 0.1, data$population_exposed_total + 0.2), erf_eq_central = "78.9270-3.1162*c+0.0342*c^2", erf_eq_lower = "78.9270-3.1162*c+0.034*c^2", erf_eq_upper = "78.9270-3.1162*c+0.04*c^2", geo_id_micro = rep(1:3, each = 5), geo_id_macro = rep("CH", 3*5), info = data.frame(pollutant = "road_noise", outcome = "highly_annoyance"), ) testthat::expect_error( object = summarize_uncertainty( bestcost_noise_ha_ar_iteration_with_erf_eq, n_sim = 100), regexp = "Sorry, the summary of uncertainty for erf_eq_... is not currently supported.") }) testthat::test_that("error_if_uncertainty_in_exposure_distribution |pathway_uncertainty|exp_dist|erf_ar_formula|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)) bestcost_noise_ha_ar_with_summary_uncertainty <- healthiar::attribute_health( approach_risk = "absolute_risk", exp_central = data$exposure_mean, exp_lower = data$exposure_mean - 1, exp_upper = data$exposure_mean + 1, 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") ) testthat::expect_error( object = summarize_uncertainty( output_attribute = bestcost_noise_ha_ar_with_summary_uncertainty, n_sim = 100, seed = 122)$uncertainty_main$impact_rounded, regexp = "Sorry, the summary of uncertainty for exp_... in exposure distributions is not currently supported." ) }) testthat::test_that("error_if_no_uncertainty |pathway_uncertainty|exp_single|erf_rr_increment|iteration_FALSE|", { data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds")) bestcost_pm_copd_with_summary_uncertainty <- healthiar::attribute_health( exp_central = 8.85, cutoff_central = 5, bhd_central = data$incidents_per_100_000_per_year/1E5*data$population_at_risk, rr_central = 1.060, rr_increment = 10, erf_shape = "log_linear" ) testthat::expect_error( object = healthiar::summarize_uncertainty( output_attribute = bestcost_pm_copd_with_summary_uncertainty, n_sim = 100 ), regexp = "Please enter an assessment with uncertainty (..._lower and ..._upper) in any argument.", fixed = TRUE ) }) testthat::test_that("error_if_erf_eq_rr_function |pathway_uncertainty|exp_dist|erf_rr_function|iteration_FALSE|", { ## IF APPLICABLE: LOAD INPUT DATA BEFORE RUNNING THE FUNCTION 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") bestcost_pm_copd_with_summary_uncertainty <- 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 exp_lower = NULL, exp_upper = NULL, cutoff_central = 0, cutoff_lower = NULL, cutoff_upper = NULL, bhd_central = 29908, #COPD mortality in Germany 2016 bhd_lower = NULL, bhd_upper = NULL, ) testthat::expect_error( object = healthiar::summarize_uncertainty( output_attribute = bestcost_pm_copd_with_summary_uncertainty, n_sim = 100, seed = 122 )$uncertainty_main$impact_rounded, regexp = "Sorry, the summary of uncertainty for erf_eq_... is not currently supported." ) }) ## 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 ## WARNING #########