In Iraices/PrecisePvsBoundedP: A suggestion for the quantification of precise and bounded probability to express epistemic uncertainty in scientific assessments

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%"
)

ppvsbp

The aim of ppvsbp package is to make available the code used in the paper " A suggestion for the quantification of precise and bounded probability to quantify epistemic uncertainty in scientific assessments"

This is a simplified version of an existing scientific assessment on the weekly intake dose of aluminium via consumption of cocoa and chocolate products done by BfR. The aim of the assessment was to estimate the 2017 average long-term aluminium intake (chronic toxicity) by consumption of chocolate and cocoa products in 2017 for infants from age 0.5 years to less than 5 years (which are not breastfed) in Germany for the 95th percentile of the specified population (in $\mu$g/(kg bw)/week). The results were compared with the tolerable weekly intake (TWI) of 1 mg/kg for aluminium.

This is a common type of scientific assessment where the assessment model contains several variables which are combined to estimate the probability that a child exceeds the tolerable weekly intake of aluminium from consuming chocolate products. ...

Installation

You can install the development version of ppvsbp from github with:

remotes::install_github('Iraices/PrecisePvsBoundedP')

Example

This example does the aluminium exposure assessment by precise probability derived by Bayesian analysis.

Let us estimate the frequency of exceeding the safety threshold for a random child

library(ppvsbp)
## Random child
TWI_pp <-
   unc_analysis_assessment(niter_ale = 10000, niter_epi = 10000,
             threshold = 1,
             suff_stat_concentration = data_assessment$log_concentration_ss_data,
             suff_stat_consumption = data_assessment$log_consumption_ss_data,
             consumption_change_vals_EKE = data_assessment$change_cons$vals,
             consumption_change_probs_EKE = data_assessment$change_cons$probs/100,
             consumers_info_sample_size = data_assessment$consumers_info_sample_size,
             concentration_mu0 = 3.5, concentration_v0 = 5,
             concentration_alpha0 = 1, concentration_beta0 = 1,
             sufficient_statistics_concentration = TRUE,
             consumption_mu0 = -3, consumption_v0 = 5,
             consumption_alpha0 = 1, consumption_beta0 = 1,
             sufficient_statistics_consumption = TRUE,
             consumption_event_alpha0 = 1,
             consumption_event_beta0 = 1)

## Expected frequency of exceeding the safety threshold
TWI_pp$expected_frequency_exceeding

## Highest posterior density interval of the frequency of exceeding the safety threshold
TWI_pp$hdi_frequency_exceeding

We can now visualize the results. Epistemic uncertainty has been characterized by a full probability distribution.

 ## Random child
  graph_pp(frequency_exceeding = TWI_pp$frequency_exceeding)

Now, let us estimate the frequency of exceeding the safety threshold by bounded probability derived by robust Bayesian analysis.

## Random child
lower_bound <-
    bound_frequency_exceeding_bp(obj_func_bp = obj_func_bp, maximize = FALSE,
       lower_parameters  = c(1, -5, -20),
       upper_parameters  = c(6, 1, -10),
       niter_ale = 5000, niter_epi = 5000, threshold = 1,
       suff_stat_concentration = data_assessment$log_concentration_ss_data,
       suff_stat_consumption = data_assessment$log_consumption_ss_data,
       consumption_change_vals_EKE = c(-15, 7.5),
       consumption_change_probs_EKE = c(0.25, 0.75),
       consumers_info_sample_size = data_assessment$consumers_info_sample_size,
       concentration_mu0 = 2.75,
       concentration_v0 = 5, concentration_alpha0 = 1, concentration_beta0 = 1,
       sufficient_statistics_concentration = TRUE,
       consumption_mu0 = -2.5,
       consumption_v0 = 5, consumption_alpha0 = 1, consumption_beta0 = 1,
       sufficient_statistics_consumption = TRUE,
       consumption_event_alpha0 = 1, consumption_event_beta0 = 1, percentile = NULL)


upper_bound <- 
   bound_frequency_exceeding_bp(obj_func_bp = obj_func_bp, maximize = TRUE,
       lower_parameters  = c(1, -5, -20),
       upper_parameters  = c(6, 1, -10),
       niter_ale = 5000, niter_epi = 5000, threshold = 1,
       suff_stat_concentration = data_assessment$log_concentration_ss_data,
       suff_stat_consumption = data_assessment$log_consumption_ss_data,
       consumption_change_vals_EKE = c(-15, 7.5),
       consumption_change_probs_EKE = c(0.25, 0.75),
       consumers_info_sample_size = data_assessment$consumers_info_sample_size,
       concentration_mu0 = 2.75,
       concentration_v0 = 5, concentration_alpha0 = 1, concentration_beta0 = 1,
       sufficient_statistics_concentration = TRUE,
       consumption_mu0 = -2.5,
       consumption_v0 = 5, consumption_alpha0 = 1, consumption_beta0 = 1,
       sufficient_statistics_consumption = TRUE,
       consumption_event_alpha0 = 1, consumption_event_beta0 = 1, percentile = NULL)

In the case of bounded probability derived by robust Bayesian analysis, epistemic uncertainty has been characterized by a probability box.

 ## Random child
graph_bp(lower_points = lower_bound$opt_freq$frequency_exceeding, 
         upper_points = upper_bound$opt_freq$frequency_exceeding)

Iraices/PrecisePvsBoundedP documentation built on Jan. 18, 2021, 11:32 p.m.