Nothing
tests/testthat/test-monetize.R
In healthiar: Quantifying and Monetizing Health Impacts Attributable to Exposure
# QUANTITATIVE TEST ############################################################
## RAW INPUT ###################################################################
### NO DISCOUNTING - NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect = 10711800000)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS:
# Monetization of PM and Ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS: Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_shape = "exponential",
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect =
106577000000
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS:
# Monetization of PM and Ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS: Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
### WITH DISCOUNT ################################################################
#### EXPONENTIAL ###############################################################
##### NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::discount(
impact = 2E4,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 20
)$monetization_main$monetized_impact_rounded,
expect =
base::round(11074) # Results on 2025-04-15; no comparison study
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
valuation = 1,
info = base::data.frame(year = c(2020:2025))
)$monetization_detailed$results_by_year$monetized_impact |> base::round(digits = 2),
expect =
c(800, 952.38,1088.44, 1295.76, 1480.86, 1567.05) # Results on 2025-03-04; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "exponential",
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect =
9240092777
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS:
# Monetization of PM and Ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS: Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "exponential",
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect =
91934256413
)
## RESULT(S) COMPARISON ASSESSMENT:
## 91934256413 $ (5 years)
## ASSESSOR:
## Iracy Pimenta
## ASSESSMENT DETAILS:
## Monetization of PM2.5 reduction policy on premature mortality in China with exponential discount rate
## INPUT DATA DETAILS:
## Example adapted from Chen et al (2015) data to 5 years policy, with discount rate = 0,03 and exponential function
## Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
## DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 2E4,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 20,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(11074) # Result on 2024-03-10; from ChatGPT
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 50,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(863) # Excel file from University of Porto "WP2_Examples.xlsx"
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::discount(
impact = 2E4,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 20
)$monetization_main$monetized_impact_rounded,
expect = 11074 # Result on 15 Jan 2025 ; no comparison study
)
})
##### INFLATION & GROWTH RATE ################################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
n_years = 5,
real_growth_rate = 0.08,
valuation = 1E3
)$monetization_main$monetized_impact |> base::round(digits = 2),
expect =
1469.33 # Results on 2026-03-02; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08,
valuation = 1E3
)$monetization_main$monetized_impact |> base::round(digits = 2),
expect =
783.53 # Results on 2025-03-04; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 1,
inflation_rate = 0.08,
valuation = 1080
)$monetization_main$monetized_impact |> base::round(digits = 2),
expect =
952.38 # Results on 2025-03-04; Excel sheet of Uni Porto
)
})
testthat::test_that("results the same |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
discount_rate = 0.04,
n_years = 5,
inflation_rate = 0.03,
real_growth_rate = 0.03,
valuation = 1E4
)$monetization_main$monetized_impact_rounded,
expect =
8219 # Results on 2025-03-10; ChatGPT
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "exponential",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
83505868243.71
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "exponential",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
8392975589.98
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
#### HARVEY ####################################################################
##### NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "hyperbolic_harvey_1986",
discount_rate = 0.05,
valuation = 1
)$monetization_detailed$results_by_year$monetized_impact |> base::round(digits = 2),
expect =
c(800, 965.94, 1135.86, 1399.55, 1660.83, 1828.62) # Results on 2025-04-15; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5
)$monetization_main$monetized_impact,
expect =
10151212470
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5
)$monetization_main$monetized_impact,
expect =
100999437198
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5
)$monetization_main$monetized_impact,
expect =
97444185252.79530
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
85261600000
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
##### INFLATION ################################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_hyp_harvey|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 1,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
102946596127.82300
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
97444185252.79530
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08)$monetization_main$monetized_impact,
expect = 9793882578.71)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
#### MAZUR #####################################################################
##### NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "hyperbolic_mazur_1987",
discount_rate = 0.05,
valuation = 1
)$monetization_detailed$results_by_year$monetized_impact |> base::round(digits = 2),
expect =
c(800, 952.38, 1090.91, 1304.35, 1500.00, 1600.00) # Results on 2025-04-15; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
9314608696
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
92675652174
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
85261600000.00000
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
#### INFLATION #####################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08)$monetization_main$monetized_impact,
expect = 8569440000)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
### WITH GROWTH BUT WITHOUT DISCOUNTING ###########
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
n_years = 5,
real_growth_rate = 0.08,
)$monetization_main$monetized_impact,
expect =
156596578441.11
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
n_years = 5,
real_growth_rate = 0.08,
)$monetization_main$monetized_impact,
expect =
15739148493.07
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
## HEALTHIAR INPUT ##############################################################
### ATTRIBUTE #################
#### NO DISCOUNTING ##############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <-
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,
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::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
valuation = 1000,
)$monetization_main$monetized_impact_rounded,
expect = # 1000 * airqplus_pm_copd
base::round(1000 * bestcost_pm_copd[["health_main"]]$impact)
)
})
#### DISCOUNTING #################################################################
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_geluft <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = data_mort$exp[2], #exp CH 2019
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2], # WHO AQG 2021
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
info = data_mort$pollutant[2],
min_age = if(is.na(data_mort$min_age[2])) NULL else data_mort$min_age[2])
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_yll_exp_single_year_lifetable_geluft,
discount_shape = "exponential",
discount_rate = 0.01,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(26101, 13670, 38432) # Result on 9 July 2025 ; no comparison study
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <-
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,
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::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(60416, 23343, 94436) # Result on 9 Jan 2025 ; no comparison study
)
})
##### WITH INFLATION #############################################################
testthat::test_that("results the same |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_equal(
object = healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
inflation_rate = 0.08,,
real_growth_rate = 0.08,
valuation = 1E3
)$monetization_main$monetized_impact_rounded,
expect =
c(2743879, 1060162, 4288935) # Results on 2025-04-15; no comparison study
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <-
healthiar::attribute_health(
exp_central = c(data$mean_concentration, data$mean_concentration+1),
cutoff_central = data$cut_off_value,
bhd_central = c(data$incidents_per_100_000_per_year/1E5*data$population_at_risk,
data$incidents_per_100_000_per_year/1E5*data$population_at_risk),
rr_central = data$relative_risk,
rr_lower = data$relative_risk_lower,
rr_upper = data$relative_risk_upper,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = c("city_a", "city_b"),
info = paste0(data$pollutant,"_", data$evaluation_name))
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.03,
inflation_rate = 0.02,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(54721, 21143, 85534, 67884, 26480, 105141) # Result on 9 March 2025 ; no comparison study
)
})
### COMPARE ##########################
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd_1 <-
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,
rr_central = data$relative_risk,
rr_lower = data$relative_risk_lower,
rr_upper = data$relative_risk_upper,
rr_increment = 10,
erf_shape = "log_linear")
bestcost_pm_copd_2 <-
healthiar::attribute_mod(
output_attribute = bestcost_pm_copd_1,
exp_central = data$mean_concentration-1)
comparison_delta <-
healthiar::compare(
bestcost_pm_copd_1,
bestcost_pm_copd_2,
approach_comparison = "delta"
)
comparison_pif <-
healthiar::compare(
bestcost_pm_copd_1,
bestcost_pm_copd_2,
approach_comparison = "pif"
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_delta,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c( 14997, 5963, 22778) # Result on 9 Jan 2025 ; no comparison study
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_pif,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(16402, 6165, 26336) # Result on 9 Jan 2025 ; no comparison study
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_1 <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = data_mort$exp[2], #exp CH 2019
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2], # WHO AQG 2021
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
info = data_mort$pollutant[2],
min_age = if(is.na(data_mort$min_age[2])) NULL else data_mort$min_age[2])
bestcost_pm_yll_exp_single_year_lifetable_2 <-
healthiar::attribute_mod(
bestcost_pm_yll_exp_single_year_lifetable_1,
exp_central = data_mort$exp[2]-1)
comparison_lifetable_delta <-
healthiar::compare(
bestcost_pm_yll_exp_single_year_lifetable_1,
bestcost_pm_yll_exp_single_year_lifetable_2,
approach_comparison = "delta"
)
comparison_lifetable_pif <-
healthiar::compare(
bestcost_pm_yll_exp_single_year_lifetable_1,
bestcost_pm_yll_exp_single_year_lifetable_2,
approach_comparison = "pif"
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_lifetable_delta,
discount_shape = "exponential",
discount_rate = 0.01,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(6752, 3543, 9923) # Result on 9 July 2025 ; no comparison study
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_lifetable_pif,
discount_shape = "exponential",
discount_rate = 0.01,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(6807, 3558, 10042) # Result on 9 July 2025 ; no comparison study
)
})
# ERROR OR WARNING ########
## ERROR #########
testthat::test_that("error if negative valuation", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
valuation = -10
),
regexp = "valuation must be higher than 0."
)
})
testthat::test_that("error if negative n_years", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_error(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = -5,
inflation_rate = 0.08,
valuation = 1E3
),
regexp = "n_years must be higher than 0."
)
})
testthat::test_that("error if discount_rate higher than 1", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 1.5,
n_years = 5,
valuation = 10
),
regexp = "discount_rate must be higher than 0 and lower than 1."
)
})
testthat::test_that("error if inflation higher than 1", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
valuation = 10,
inflation_rate = 1.15
),
regexp = "inflation_rate must be higher than 0 and lower than 1."
)
})
testthat::test_that("error if both impact and output_attribute are entered", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_error(
object =
healthiar::monetize(
impact = 1000,
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
inflation_rate = 0.08,
valuation = 1E3
),
regexp = "Enter a value for impact or for output_attribute but not both."
)
})
testthat::test_that("error if no right category", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exp",
discount_rate = 0.05,
valuation = 10
),
regexp = "Please, check spelling. discount_shape must have one of this values: exponential, hyperbolic_harvey_1986, hyperbolic_mazur_1987."
)
})
testthat::test_that("error if incompatible size of info", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
valuation = 10,
info = data.frame(id = 1:20)
),
regexp = "The info vector or data frame columns must have a length of 1 or the same length as impact."
)
})
testthat::test_that("errof if different year of analysis", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_1 <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = 8.85,
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2],
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
min_age = 20)
bestcost_pm_yll_exp_single_year_lifetable_2_error <-
healthiar::attribute_mod(
bestcost_pm_yll_exp_single_year_lifetable_1,
exp_central = 8.85-1, # New exposure
year_of_analysis = 2020, # different year --> error
)
comparison_lifetable_error <-
healthiar::compare(
bestcost_pm_yll_exp_single_year_lifetable_1,
bestcost_pm_yll_exp_single_year_lifetable_2_error,
approach_comparison = "delta"
)
testthat::expect_error(
object =
healthiar::monetize(
output_attribute = comparison_lifetable_error,
valuation = 1
)$monetization_main$monetized_impact_rounded,
regexp = "Please, enter the same year_of_analysis in both scenarios of the healthiar function compare. Otherwise, the monetization cannot be attributed to an intervention.",
)
})
testthat::test_that("errof if different bhd", {
attributable_health_impact_1 <-
healthiar::attribute_health(
exp_central = 8.85,
rr_central = 1.05,
rr_increment = 10,
cutoff_central = 0,
erf_shape = "linear",
bhd_central = 1E5)
attributable_health_impact_2_error <-
healthiar::attribute_mod(
attributable_health_impact_1,
exp_central = 9.85,
bhd_central = 2E5 # Different bhd --> error
)
comparison_single_bhd_error <-
healthiar::compare(
attributable_health_impact_1,
attributable_health_impact_2_error
)
testthat::expect_error(
object =
healthiar::monetize(
output_attribute = comparison_single_bhd_error,
valuation = 1
)$monetization_main$monetized_impact_rounded,
regexp = "Please, enter the same bhd_central in both scenarios of the healthiar function compare. Otherwise, the monetization cannot be attributed to an intervention.",
)
})
## WARNING #########
testthat::test_that("warning if no discount_rate but other discount arguments", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_warning(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
inflation_rate = 0.08,
valuation = 1E3
),
regexp = base::paste0("You entered some value in discount_rate,",
" but n_years is 0 (default value).",
" Therefore no discount is applied."),
# To match the messages fixed = TRUE.
# Otherwise, for some reason, testthat does not recognize the same text
fixed = TRUE
)
})
testthat::test_that("warning if user pass n_years with impact", {
testthat::expect_warning(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
valuation = 10
),
regexp = base::paste0(
"n_years is aimed for output_attribute (excluding life table)",
" and for impact (excluding vector form).",
" Therefore n_years is ignored here and the length of the vector impact is used instead."),
# To match the messages fixed = TRUE.
# Otherwise, for some reason, testthat does not recognize the same text
fixed = TRUE
)
})
testthat::test_that("warning if user pass n_years with life table", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_geluft <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = data_mort$exp[2], #exp CH 2019
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2], # WHO AQG 2021
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
info = data_mort$pollutant[2],
min_age = if(is.na(data_mort$min_age[2])) NULL else data_mort$min_age[2])
testthat::expect_warning(
object =
healthiar::monetize(
output_attribute = bestcost_pm_yll_exp_single_year_lifetable_geluft,
discount_shape = "exponential",
discount_rate = 0.01,
n_years = 5,
valuation = 1,
),
regexp = base::paste0(
"n_years is aimed for any output_attribute and for impact with single value (no vector).",
" Therefore n_years is ignored here and the length life table is used instead."),
# To match the messages fixed = TRUE.
# Otherwise, for some reason, testthat does not recognize the same text
fixed = TRUE
)
})
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 ############################################################
## RAW INPUT ###################################################################
### NO DISCOUNTING - NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect = 10711800000)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS:
# Monetization of PM and Ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS: Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_shape = "exponential",
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect =
106577000000
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS:
# Monetization of PM and Ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS: Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
### WITH DISCOUNT ################################################################
#### EXPONENTIAL ###############################################################
##### NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::discount(
impact = 2E4,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 20
)$monetization_main$monetized_impact_rounded,
expect =
base::round(11074) # Results on 2025-04-15; no comparison study
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
valuation = 1,
info = base::data.frame(year = c(2020:2025))
)$monetization_detailed$results_by_year$monetized_impact |> base::round(digits = 2),
expect =
c(800, 952.38,1088.44, 1295.76, 1480.86, 1567.05) # Results on 2025-03-04; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "exponential",
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect =
9240092777
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS:
# Monetization of PM and Ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS: Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "exponential",
n_years = 5
)$monetization_main$monetized_impact_rounded,
expect =
91934256413
)
## RESULT(S) COMPARISON ASSESSMENT:
## 91934256413 $ (5 years)
## ASSESSOR:
## Iracy Pimenta
## ASSESSMENT DETAILS:
## Monetization of PM2.5 reduction policy on premature mortality in China with exponential discount rate
## INPUT DATA DETAILS:
## Example adapted from Chen et al (2015) data to 5 years policy, with discount rate = 0,03 and exponential function
## Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
## DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 2E4,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 20,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(11074) # Result on 2024-03-10; from ChatGPT
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 50,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(863) # Excel file from University of Porto "WP2_Examples.xlsx"
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::discount(
impact = 2E4,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 20
)$monetization_main$monetized_impact_rounded,
expect = 11074 # Result on 15 Jan 2025 ; no comparison study
)
})
##### INFLATION & GROWTH RATE ################################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
n_years = 5,
real_growth_rate = 0.08,
valuation = 1E3
)$monetization_main$monetized_impact |> base::round(digits = 2),
expect =
1469.33 # Results on 2026-03-02; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08,
valuation = 1E3
)$monetization_main$monetized_impact |> base::round(digits = 2),
expect =
783.53 # Results on 2025-03-04; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 1,
inflation_rate = 0.08,
valuation = 1080
)$monetization_main$monetized_impact |> base::round(digits = 2),
expect =
952.38 # Results on 2025-03-04; Excel sheet of Uni Porto
)
})
testthat::test_that("results the same |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 1,
discount_shape = "exponential",
discount_rate = 0.04,
n_years = 5,
inflation_rate = 0.03,
real_growth_rate = 0.03,
valuation = 1E4
)$monetization_main$monetized_impact_rounded,
expect =
8219 # Results on 2025-03-10; ChatGPT
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "exponential",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
83505868243.71
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "exponential",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
8392975589.98
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
#### HARVEY ####################################################################
##### NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "hyperbolic_harvey_1986",
discount_rate = 0.05,
valuation = 1
)$monetization_detailed$results_by_year$monetized_impact |> base::round(digits = 2),
expect =
c(800, 965.94, 1135.86, 1399.55, 1660.83, 1828.62) # Results on 2025-04-15; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5
)$monetization_main$monetized_impact,
expect =
10151212470
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5
)$monetization_main$monetized_impact,
expect =
100999437198
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5
)$monetization_main$monetized_impact,
expect =
97444185252.79530
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
85261600000
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
##### INFLATION ################################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_hyp_harvey|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 1,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
102946596127.82300
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08
)$monetization_main$monetized_impact,
expect =
97444185252.79530
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_harvey|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_harvey_1986",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08)$monetization_main$monetized_impact,
expect = 9793882578.71)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
#### MAZUR #####################################################################
##### NO INFLATION #############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "hyperbolic_mazur_1987",
discount_rate = 0.05,
valuation = 1
)$monetization_detailed$results_by_year$monetized_impact |> base::round(digits = 2),
expect =
c(800, 952.38, 1090.91, 1304.35, 1500.00, 1600.00) # Results on 2025-04-15; Excel sheet of Uni Porto
)
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
9314608696
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.03,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
92675652174
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_FALSE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5
)$monetization_main$monetized_impact,
expect =
85261600000.00000
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
#### INFLATION #####################
testthat::test_that("results correct |pathway_monetization|discount_rate_TRUE|discount_shape_hyp_mazur|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
discount_rate = 0.05,
discount_shape = "hyperbolic_mazur_1987",
n_years = 5,
inflation_rate = 0.08,
real_growth_rate = 0.08)$monetization_main$monetized_impact,
expect = 8569440000)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
### WITH GROWTH BUT WITHOUT DISCOUNTING ###########
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 197000,
valuation = 541000,
n_years = 5,
real_growth_rate = 0.08,
)$monetization_main$monetized_impact,
expect =
156596578441.11
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_TRUE|", {
testthat::expect_equal(
object =
healthiar::monetize(
impact = 19800,
valuation = 541000,
n_years = 5,
real_growth_rate = 0.08,
)$monetization_main$monetized_impact,
expect =
15739148493.07
)
# ASSESSOR: Iracy Pimenta
# ASSESSMENT DETAILS: Monetization of PM2.5 and ozone reduction policy on premature mortality in China
# INPUT DATA DETAILS:Example adapted from Chen et al (2015). Paper title: Cost–Benefit Analysis of Reducing Premature Mortality
# DOI: https://doi.org/10.1007/s11270-015-2316-7
})
## HEALTHIAR INPUT ##############################################################
### ATTRIBUTE #################
#### NO DISCOUNTING ##############################################################
testthat::test_that("results correct |pathway_monetization|discount_rate_FALSE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <-
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,
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::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
valuation = 1000,
)$monetization_main$monetized_impact_rounded,
expect = # 1000 * airqplus_pm_copd
base::round(1000 * bestcost_pm_copd[["health_main"]]$impact)
)
})
#### DISCOUNTING #################################################################
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_geluft <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = data_mort$exp[2], #exp CH 2019
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2], # WHO AQG 2021
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
info = data_mort$pollutant[2],
min_age = if(is.na(data_mort$min_age[2])) NULL else data_mort$min_age[2])
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_yll_exp_single_year_lifetable_geluft,
discount_shape = "exponential",
discount_rate = 0.01,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(26101, 13670, 38432) # Result on 9 July 2025 ; no comparison study
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <-
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,
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::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(60416, 23343, 94436) # Result on 9 Jan 2025 ; no comparison study
)
})
##### WITH INFLATION #############################################################
testthat::test_that("results the same |pathway_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_equal(
object = healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
inflation_rate = 0.08,,
real_growth_rate = 0.08,
valuation = 1E3
)$monetization_main$monetized_impact_rounded,
expect =
c(2743879, 1060162, 4288935) # Results on 2025-04-15; no comparison study
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_TRUE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <-
healthiar::attribute_health(
exp_central = c(data$mean_concentration, data$mean_concentration+1),
cutoff_central = data$cut_off_value,
bhd_central = c(data$incidents_per_100_000_per_year/1E5*data$population_at_risk,
data$incidents_per_100_000_per_year/1E5*data$population_at_risk),
rr_central = data$relative_risk,
rr_lower = data$relative_risk_lower,
rr_upper = data$relative_risk_upper,
rr_increment = 10,
erf_shape = "log_linear",
geo_id_micro = c("city_a", "city_b"),
info = paste0(data$pollutant,"_", data$evaluation_name))
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.03,
inflation_rate = 0.02,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(54721, 21143, 85534, 67884, 26480, 105141) # Result on 9 March 2025 ; no comparison study
)
})
### COMPARE ##########################
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd_1 <-
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,
rr_central = data$relative_risk,
rr_lower = data$relative_risk_lower,
rr_upper = data$relative_risk_upper,
rr_increment = 10,
erf_shape = "log_linear")
bestcost_pm_copd_2 <-
healthiar::attribute_mod(
output_attribute = bestcost_pm_copd_1,
exp_central = data$mean_concentration-1)
comparison_delta <-
healthiar::compare(
bestcost_pm_copd_1,
bestcost_pm_copd_2,
approach_comparison = "delta"
)
comparison_pif <-
healthiar::compare(
bestcost_pm_copd_1,
bestcost_pm_copd_2,
approach_comparison = "pif"
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_delta,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c( 14997, 5963, 22778) # Result on 9 Jan 2025 ; no comparison study
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_pif,
discount_shape = "exponential",
discount_rate = 0.03,
n_years = 5,
valuation = 20
)$monetization_main$monetized_impact_rounded,
expect = c(16402, 6165, 26336) # Result on 9 Jan 2025 ; no comparison study
)
})
testthat::test_that("results the same |fake_monetization|discount_rate_TRUE|discount_shape_exponential|inflation_rate_FALSE|", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_1 <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = data_mort$exp[2], #exp CH 2019
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2], # WHO AQG 2021
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
info = data_mort$pollutant[2],
min_age = if(is.na(data_mort$min_age[2])) NULL else data_mort$min_age[2])
bestcost_pm_yll_exp_single_year_lifetable_2 <-
healthiar::attribute_mod(
bestcost_pm_yll_exp_single_year_lifetable_1,
exp_central = data_mort$exp[2]-1)
comparison_lifetable_delta <-
healthiar::compare(
bestcost_pm_yll_exp_single_year_lifetable_1,
bestcost_pm_yll_exp_single_year_lifetable_2,
approach_comparison = "delta"
)
comparison_lifetable_pif <-
healthiar::compare(
bestcost_pm_yll_exp_single_year_lifetable_1,
bestcost_pm_yll_exp_single_year_lifetable_2,
approach_comparison = "pif"
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_lifetable_delta,
discount_shape = "exponential",
discount_rate = 0.01,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(6752, 3543, 9923) # Result on 9 July 2025 ; no comparison study
)
testthat::expect_equal(
object =
healthiar::monetize(
output_attribute = comparison_lifetable_pif,
discount_shape = "exponential",
discount_rate = 0.01,
valuation = 1
)$monetization_main$monetized_impact_rounded,
expect = c(6807, 3558, 10042) # Result on 9 July 2025 ; no comparison study
)
})
# ERROR OR WARNING ########
## ERROR #########
testthat::test_that("error if negative valuation", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
valuation = -10
),
regexp = "valuation must be higher than 0."
)
})
testthat::test_that("error if negative n_years", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_error(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = -5,
inflation_rate = 0.08,
valuation = 1E3
),
regexp = "n_years must be higher than 0."
)
})
testthat::test_that("error if discount_rate higher than 1", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 1.5,
n_years = 5,
valuation = 10
),
regexp = "discount_rate must be higher than 0 and lower than 1."
)
})
testthat::test_that("error if inflation higher than 1", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
valuation = 10,
inflation_rate = 1.15
),
regexp = "inflation_rate must be higher than 0 and lower than 1."
)
})
testthat::test_that("error if both impact and output_attribute are entered", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_error(
object =
healthiar::monetize(
impact = 1000,
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
inflation_rate = 0.08,
valuation = 1E3
),
regexp = "Enter a value for impact or for output_attribute but not both."
)
})
testthat::test_that("error if no right category", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exp",
discount_rate = 0.05,
valuation = 10
),
regexp = "Please, check spelling. discount_shape must have one of this values: exponential, hyperbolic_harvey_1986, hyperbolic_mazur_1987."
)
})
testthat::test_that("error if incompatible size of info", {
testthat::expect_error(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
valuation = 10,
info = data.frame(id = 1:20)
),
regexp = "The info vector or data frame columns must have a length of 1 or the same length as impact."
)
})
testthat::test_that("errof if different year of analysis", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_1 <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = 8.85,
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2],
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
min_age = 20)
bestcost_pm_yll_exp_single_year_lifetable_2_error <-
healthiar::attribute_mod(
bestcost_pm_yll_exp_single_year_lifetable_1,
exp_central = 8.85-1, # New exposure
year_of_analysis = 2020, # different year --> error
)
comparison_lifetable_error <-
healthiar::compare(
bestcost_pm_yll_exp_single_year_lifetable_1,
bestcost_pm_yll_exp_single_year_lifetable_2_error,
approach_comparison = "delta"
)
testthat::expect_error(
object =
healthiar::monetize(
output_attribute = comparison_lifetable_error,
valuation = 1
)$monetization_main$monetized_impact_rounded,
regexp = "Please, enter the same year_of_analysis in both scenarios of the healthiar function compare. Otherwise, the monetization cannot be attributed to an intervention.",
)
})
testthat::test_that("errof if different bhd", {
attributable_health_impact_1 <-
healthiar::attribute_health(
exp_central = 8.85,
rr_central = 1.05,
rr_increment = 10,
cutoff_central = 0,
erf_shape = "linear",
bhd_central = 1E5)
attributable_health_impact_2_error <-
healthiar::attribute_mod(
attributable_health_impact_1,
exp_central = 9.85,
bhd_central = 2E5 # Different bhd --> error
)
comparison_single_bhd_error <-
healthiar::compare(
attributable_health_impact_1,
attributable_health_impact_2_error
)
testthat::expect_error(
object =
healthiar::monetize(
output_attribute = comparison_single_bhd_error,
valuation = 1
)$monetization_main$monetized_impact_rounded,
regexp = "Please, enter the same bhd_central in both scenarios of the healthiar function compare. Otherwise, the monetization cannot be attributed to an intervention.",
)
})
## WARNING #########
testthat::test_that("warning if no discount_rate but other discount arguments", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_copd.rds"))
bestcost_pm_copd <- healthiar::attribute_health(
exp_central = data$mean_concentration,
exp_lower = data$mean_concentration-0.5,
exp_upper = data$mean_concentration+0.5,
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_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::expect_warning(
object =
healthiar::monetize(
output_attribute = bestcost_pm_copd,
discount_shape = "exponential",
discount_rate = 0.05,
inflation_rate = 0.08,
valuation = 1E3
),
regexp = base::paste0("You entered some value in discount_rate,",
" but n_years is 0 (default value).",
" Therefore no discount is applied."),
# To match the messages fixed = TRUE.
# Otherwise, for some reason, testthat does not recognize the same text
fixed = TRUE
)
})
testthat::test_that("warning if user pass n_years with impact", {
testthat::expect_warning(
object =
healthiar::monetize(
impact = c(800, 1000, 1200, 1500, 1800, 2000),
discount_shape = "exponential",
discount_rate = 0.05,
n_years = 5,
valuation = 10
),
regexp = base::paste0(
"n_years is aimed for output_attribute (excluding life table)",
" and for impact (excluding vector form).",
" Therefore n_years is ignored here and the length of the vector impact is used instead."),
# To match the messages fixed = TRUE.
# Otherwise, for some reason, testthat does not recognize the same text
fixed = TRUE
)
})
testthat::test_that("warning if user pass n_years with life table", {
data <- base::readRDS(testthat::test_path("data", "airqplus_pm_deaths_yll.rds"))
data_mort <- base::readRDS(testthat::test_path("data", "input_data_mortality.rds"))
data_lifetable <- base::readRDS(testthat::test_path("data", "lifetable_withPopulation.rds"))
bestcost_pm_yll_exp_single_year_lifetable_geluft <-
healthiar::attribute_lifetable(
health_outcome = "yll",
approach_exposure = "single_year",
exp_central = data_mort$exp[2], #exp CH 2019
prop_pop_exp = 1,
cutoff_central = data_mort$cutoff[2], # WHO AQG 2021
rr_central = data_mort[2,"rr_central"],
rr_lower = data_mort[2,"rr_lower"],
rr_upper = data_mort[2,"rr_upper"],
rr_increment = 10,
erf_shape = "log_linear",
age_group = c(data_lifetable[["male"]]$age,
data_lifetable[["female"]]$age),
sex = base::rep(c("male", "female"), each = 100),
population = c(data_lifetable[["male"]]$population,
data_lifetable[["female"]]$population),
bhd_central = c(data[["pop"]]$number_of_deaths_male,
data[["pop"]]$number_of_deaths_female),
year_of_analysis = 2019,
info = data_mort$pollutant[2],
min_age = if(is.na(data_mort$min_age[2])) NULL else data_mort$min_age[2])
testthat::expect_warning(
object =
healthiar::monetize(
output_attribute = bestcost_pm_yll_exp_single_year_lifetable_geluft,
discount_shape = "exponential",
discount_rate = 0.01,
n_years = 5,
valuation = 1,
),
regexp = base::paste0(
"n_years is aimed for any output_attribute and for impact with single value (no vector).",
" Therefore n_years is ignored here and the length life table is used instead."),
# To match the messages fixed = TRUE.
# Otherwise, for some reason, testthat does not recognize the same text
fixed = TRUE
)
})
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.