bayestestR/0000755000176200001440000000000014414032242012373 5ustar liggesusersbayestestR/NAMESPACE0000644000176200001440000004560614413221117013625 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(as.data.frame,bayestestR_mediation) S3method(as.data.frame,density) S3method(as.double,bayesfactor_inclusion) S3method(as.double,bayesfactor_models) S3method(as.double,bayesfactor_parameters) S3method(as.double,bayesfactor_restricted) S3method(as.double,map_estimate) S3method(as.double,p_direction) S3method(as.double,p_map) S3method(as.double,p_rope) S3method(as.double,p_significance) S3method(as.double,rope) S3method(as.list,bayestestR_ci) S3method(as.list,bayestestR_eti) S3method(as.list,bayestestR_hdi) S3method(as.list,bayestestR_si) S3method(as.logical,bayesfactor_restricted) S3method(as.matrix,bayesfactor_models) S3method(as.numeric,bayesfactor_inclusion) S3method(as.numeric,bayesfactor_models) S3method(as.numeric,bayesfactor_parameters) S3method(as.numeric,bayesfactor_restricted) S3method(as.numeric,map_estimate) S3method(as.numeric,p_direction) S3method(as.numeric,p_map) S3method(as.numeric,p_significance) S3method(bayesfactor_inclusion,BFBayesFactor) S3method(bayesfactor_inclusion,bayesfactor_models) S3method(bayesfactor_models,BFBayesFactor) S3method(bayesfactor_models,blavaan) S3method(bayesfactor_models,brmsfit) S3method(bayesfactor_models,default) S3method(bayesfactor_models,stanreg) S3method(bayesfactor_parameters,bayesfactor_models) S3method(bayesfactor_parameters,blavaan) S3method(bayesfactor_parameters,brmsfit) S3method(bayesfactor_parameters,data.frame) S3method(bayesfactor_parameters,draws) S3method(bayesfactor_parameters,emmGrid) S3method(bayesfactor_parameters,emm_list) S3method(bayesfactor_parameters,numeric) S3method(bayesfactor_parameters,rvar) S3method(bayesfactor_parameters,sim) S3method(bayesfactor_parameters,sim.merMod) S3method(bayesfactor_parameters,stanreg) S3method(bayesfactor_restricted,blavaan) S3method(bayesfactor_restricted,brmsfit) S3method(bayesfactor_restricted,data.frame) S3method(bayesfactor_restricted,draws) S3method(bayesfactor_restricted,emmGrid) S3method(bayesfactor_restricted,emm_list) S3method(bayesfactor_restricted,rvar) S3method(bayesfactor_restricted,stanreg) S3method(bci,BFBayesFactor) S3method(bci,BGGM) S3method(bci,MCMCglmm) S3method(bci,bamlss) S3method(bci,bayesQR) S3method(bci,bcplm) S3method(bci,blavaan) S3method(bci,blrm) S3method(bci,brmsfit) S3method(bci,data.frame) S3method(bci,draws) S3method(bci,emmGrid) S3method(bci,emm_list) S3method(bci,get_predicted) S3method(bci,mcmc) S3method(bci,mcmc.list) S3method(bci,numeric) S3method(bci,rvar) S3method(bci,sim) S3method(bci,sim.merMod) S3method(bci,stanfit) S3method(bci,stanreg) S3method(check_prior,blavaan) S3method(check_prior,brmsfit) S3method(check_prior,stanreg) S3method(ci,BFBayesFactor) S3method(ci,BGGM) S3method(ci,MCMCglmm) S3method(ci,bamlss) S3method(ci,bcplm) S3method(ci,blavaan) S3method(ci,blrm) S3method(ci,brmsfit) S3method(ci,data.frame) S3method(ci,draws) S3method(ci,emmGrid) S3method(ci,emm_list) S3method(ci,get_predicted) S3method(ci,mcmc) S3method(ci,mcmc.list) S3method(ci,numeric) S3method(ci,rvar) S3method(ci,sim) S3method(ci,sim.merMod) S3method(ci,stanfit) S3method(ci,stanreg) S3method(cwi,data.frame) S3method(describe_posterior,BFBayesFactor) S3method(describe_posterior,BGGM) S3method(describe_posterior,MCMCglmm) S3method(describe_posterior,bamlss) S3method(describe_posterior,bayesQR) S3method(describe_posterior,bcplm) S3method(describe_posterior,blavaan) S3method(describe_posterior,blrm) S3method(describe_posterior,brmsfit) S3method(describe_posterior,data.frame) S3method(describe_posterior,default) S3method(describe_posterior,double) S3method(describe_posterior,draws) S3method(describe_posterior,effectsize_std_params) S3method(describe_posterior,emmGrid) S3method(describe_posterior,emm_list) S3method(describe_posterior,get_predicted) S3method(describe_posterior,mcmc) S3method(describe_posterior,mcmc.list) S3method(describe_posterior,numeric) S3method(describe_posterior,rvar) S3method(describe_posterior,sim) S3method(describe_posterior,sim.merMod) S3method(describe_posterior,stanfit) S3method(describe_posterior,stanmvreg) S3method(describe_posterior,stanreg) S3method(describe_prior,BFBayesFactor) S3method(describe_prior,BGGM) S3method(describe_prior,bamlss) S3method(describe_prior,bcplm) S3method(describe_prior,blavaan) S3method(describe_prior,brmsfit) S3method(describe_prior,draws) S3method(describe_prior,rvar) S3method(describe_prior,stanreg) S3method(diagnostic_draws,brmsfit) S3method(diagnostic_posterior,blavaan) S3method(diagnostic_posterior,brmsfit) S3method(diagnostic_posterior,default) S3method(diagnostic_posterior,stanfit) S3method(diagnostic_posterior,stanmvreg) S3method(diagnostic_posterior,stanreg) S3method(effective_sample,MCMCglmm) S3method(effective_sample,blavaan) S3method(effective_sample,brmsfit) S3method(effective_sample,default) S3method(effective_sample,stanfit) S3method(effective_sample,stanmvreg) S3method(effective_sample,stanreg) S3method(equivalence_test,BFBayesFactor) S3method(equivalence_test,bamlss) S3method(equivalence_test,bayesQR) S3method(equivalence_test,bcplm) S3method(equivalence_test,blavaan) S3method(equivalence_test,blrm) S3method(equivalence_test,brmsfit) S3method(equivalence_test,data.frame) S3method(equivalence_test,default) S3method(equivalence_test,draws) S3method(equivalence_test,emmGrid) S3method(equivalence_test,emm_list) S3method(equivalence_test,mcmc) S3method(equivalence_test,mcmc.list) S3method(equivalence_test,numeric) S3method(equivalence_test,rvar) S3method(equivalence_test,sim) S3method(equivalence_test,sim.merMod) S3method(equivalence_test,stanfit) S3method(equivalence_test,stanreg) S3method(estimate_density,BGGM) S3method(estimate_density,MCMCglmm) S3method(estimate_density,bamlss) S3method(estimate_density,bayesQR) S3method(estimate_density,bcplm) S3method(estimate_density,blavaan) S3method(estimate_density,blrm) S3method(estimate_density,brmsfit) S3method(estimate_density,data.frame) S3method(estimate_density,default) S3method(estimate_density,draws) S3method(estimate_density,emmGrid) S3method(estimate_density,emm_list) S3method(estimate_density,grouped_df) S3method(estimate_density,mcmc) S3method(estimate_density,mcmc.list) S3method(estimate_density,numeric) S3method(estimate_density,rvar) S3method(estimate_density,stanfit) S3method(estimate_density,stanreg) S3method(eti,BFBayesFactor) S3method(eti,BGGM) S3method(eti,MCMCglmm) S3method(eti,bamlss) S3method(eti,bayesQR) S3method(eti,bcplm) S3method(eti,blavaan) S3method(eti,blrm) S3method(eti,brmsfit) S3method(eti,data.frame) S3method(eti,default) S3method(eti,draws) S3method(eti,emmGrid) S3method(eti,emm_list) S3method(eti,get_predicted) S3method(eti,mcmc) S3method(eti,mcmc.list) S3method(eti,numeric) S3method(eti,rvar) S3method(eti,sim) S3method(eti,sim.merMod) S3method(eti,stanfit) S3method(eti,stanreg) S3method(format,bayesfactor_inclusion) S3method(format,bayesfactor_models) S3method(format,bayesfactor_parameters) S3method(format,bayesfactor_restricted) S3method(format,bayestestR_eti) S3method(format,bayestestR_hdi) S3method(format,bayestestR_si) S3method(format,describe_posterior) S3method(format,map_estimate) S3method(format,p_direction) S3method(format,p_map) S3method(format,p_rope) S3method(format,p_significance) S3method(format,point_estimate) S3method(hdi,BFBayesFactor) S3method(hdi,BGGM) S3method(hdi,MCMCglmm) S3method(hdi,bamlss) S3method(hdi,bayesQR) S3method(hdi,bcplm) S3method(hdi,blavaan) S3method(hdi,blrm) S3method(hdi,brmsfit) S3method(hdi,data.frame) S3method(hdi,default) S3method(hdi,draws) S3method(hdi,emmGrid) S3method(hdi,emm_list) S3method(hdi,get_predicted) S3method(hdi,mcmc) S3method(hdi,mcmc.list) S3method(hdi,numeric) S3method(hdi,rvar) S3method(hdi,sim) S3method(hdi,sim.merMod) S3method(hdi,stanfit) S3method(hdi,stanreg) S3method(map_estimate,BGGM) S3method(map_estimate,bamlss) S3method(map_estimate,bayesQR) S3method(map_estimate,bcplm) S3method(map_estimate,blavaan) S3method(map_estimate,blrm) S3method(map_estimate,brmsfit) S3method(map_estimate,data.frame) S3method(map_estimate,draws) S3method(map_estimate,emmGrid) S3method(map_estimate,emm_list) S3method(map_estimate,get_predicted) S3method(map_estimate,mcmc) S3method(map_estimate,mcmc.list) S3method(map_estimate,numeric) S3method(map_estimate,rvar) S3method(map_estimate,stanfit) S3method(map_estimate,stanreg) S3method(mcse,blavaan) S3method(mcse,brmsfit) S3method(mcse,stanfit) S3method(mcse,stanreg) S3method(mediation,brmsfit) S3method(mediation,stanmvreg) S3method(model_to_priors,brmsfit) S3method(p_direction,BFBayesFactor) S3method(p_direction,BGGM) S3method(p_direction,MCMCglmm) S3method(p_direction,bamlss) S3method(p_direction,bayesQR) S3method(p_direction,bcplm) S3method(p_direction,blavaan) S3method(p_direction,blrm) S3method(p_direction,brmsfit) S3method(p_direction,data.frame) S3method(p_direction,default) S3method(p_direction,draws) S3method(p_direction,emmGrid) S3method(p_direction,emm_list) S3method(p_direction,get_predicted) S3method(p_direction,mcmc) S3method(p_direction,mcmc.list) S3method(p_direction,numeric) S3method(p_direction,parameters_model) S3method(p_direction,rvar) S3method(p_direction,sim) S3method(p_direction,sim.merMod) S3method(p_direction,stanfit) S3method(p_direction,stanreg) S3method(p_map,BFBayesFactor) S3method(p_map,BGGM) S3method(p_map,MCMCglmm) S3method(p_map,bamlss) S3method(p_map,bayesQR) S3method(p_map,bcplm) S3method(p_map,blavaan) S3method(p_map,blrm) S3method(p_map,brmsfit) S3method(p_map,data.frame) S3method(p_map,draws) S3method(p_map,emmGrid) S3method(p_map,emm_list) S3method(p_map,mcmc) S3method(p_map,mcmc.list) S3method(p_map,numeric) S3method(p_map,rvar) S3method(p_map,sim) S3method(p_map,sim.merMod) S3method(p_map,stanfit) S3method(p_map,stanreg) S3method(p_rope,BFBayesFactor) S3method(p_rope,BGGM) S3method(p_rope,MCMCglmm) S3method(p_rope,bamlss) S3method(p_rope,bcplm) S3method(p_rope,blavaan) S3method(p_rope,blrm) S3method(p_rope,brmsfit) S3method(p_rope,data.frame) S3method(p_rope,default) S3method(p_rope,draws) S3method(p_rope,emmGrid) S3method(p_rope,emm_list) S3method(p_rope,mcmc) S3method(p_rope,mcmc.list) S3method(p_rope,numeric) S3method(p_rope,rvar) S3method(p_rope,sim) S3method(p_rope,sim.merMod) S3method(p_rope,stanfit) S3method(p_rope,stanreg) S3method(p_significance,BFBayesFactor) S3method(p_significance,BGGM) S3method(p_significance,MCMCglmm) S3method(p_significance,bamlss) S3method(p_significance,bayesQR) S3method(p_significance,bcplm) S3method(p_significance,blavaan) S3method(p_significance,blrm) S3method(p_significance,brmsfit) S3method(p_significance,data.frame) S3method(p_significance,default) S3method(p_significance,draws) S3method(p_significance,emmGrid) S3method(p_significance,emm_list) S3method(p_significance,mcmc) S3method(p_significance,mcmc.list) S3method(p_significance,numeric) S3method(p_significance,parameters_simulate_model) S3method(p_significance,rvar) S3method(p_significance,stanfit) S3method(p_significance,stanreg) S3method(p_to_bf,default) S3method(p_to_bf,numeric) S3method(plot,bayesfactor_models) S3method(plot,bayesfactor_parameters) S3method(plot,bayestestR_eti) S3method(plot,bayestestR_hdi) S3method(plot,bayestestR_mediation) S3method(plot,bayestestR_si) S3method(plot,describe_posterior) S3method(plot,equivalence_test) S3method(plot,estimate_density) S3method(plot,estimate_density_df) S3method(plot,map_estimate) S3method(plot,overlap) S3method(plot,p_direction) S3method(plot,p_significance) S3method(plot,point_estimate) S3method(plot,rope) S3method(point_estimate,BFBayesFactor) S3method(point_estimate,BGGM) S3method(point_estimate,MCMCglmm) S3method(point_estimate,bamlss) S3method(point_estimate,bayesQR) S3method(point_estimate,bcplm) S3method(point_estimate,blavaan) S3method(point_estimate,blrm) S3method(point_estimate,brmsfit) S3method(point_estimate,data.frame) S3method(point_estimate,default) S3method(point_estimate,draws) S3method(point_estimate,emmGrid) S3method(point_estimate,emm_list) S3method(point_estimate,get_predicted) S3method(point_estimate,matrix) S3method(point_estimate,mcmc) S3method(point_estimate,mcmc.list) S3method(point_estimate,numeric) S3method(point_estimate,rvar) S3method(point_estimate,sim) S3method(point_estimate,sim.merMod) S3method(point_estimate,stanfit) S3method(point_estimate,stanreg) S3method(print,bayesfactor_inclusion) S3method(print,bayesfactor_models) S3method(print,bayesfactor_models_matrix) S3method(print,bayesfactor_parameters) S3method(print,bayesfactor_restricted) S3method(print,bayestestR_eti) S3method(print,bayestestR_hdi) S3method(print,bayestestR_mediation) S3method(print,bayestestR_si) S3method(print,describe_posterior) S3method(print,equivalence_test) S3method(print,map_estimate) S3method(print,overlap) S3method(print,p_direction) S3method(print,p_map) S3method(print,p_rope) S3method(print,p_significance) S3method(print,p_to_pseudo_bf) S3method(print,point_estimate) S3method(print,rope) S3method(print,sexit) S3method(print_html,bayesfactor_inclusion) S3method(print_html,bayesfactor_models) S3method(print_html,bayesfactor_parameters) S3method(print_html,bayesfactor_restricted) S3method(print_html,bayestestR_eti) S3method(print_html,bayestestR_hdi) S3method(print_html,bayestestR_si) S3method(print_html,describe_posterior) S3method(print_html,map_estimate) S3method(print_html,p_direction) S3method(print_html,p_map) S3method(print_html,p_rope) S3method(print_html,p_significance) S3method(print_html,point_estimate) S3method(print_md,bayesfactor_inclusion) S3method(print_md,bayesfactor_models) S3method(print_md,bayesfactor_parameters) S3method(print_md,bayesfactor_restricted) S3method(print_md,bayestestR_eti) S3method(print_md,bayestestR_hdi) S3method(print_md,bayestestR_si) S3method(print_md,describe_posterior) S3method(print_md,map_estimate) S3method(print_md,p_direction) S3method(print_md,p_map) S3method(print_md,p_rope) S3method(print_md,p_significance) S3method(print_md,point_estimate) S3method(rope,BFBayesFactor) S3method(rope,BGGM) S3method(rope,MCMCglmm) S3method(rope,bamlss) S3method(rope,bayesQR) S3method(rope,bcplm) S3method(rope,blavaan) S3method(rope,blrm) S3method(rope,brmsfit) S3method(rope,data.frame) S3method(rope,default) S3method(rope,draws) S3method(rope,emmGrid) S3method(rope,emm_list) S3method(rope,mcmc) S3method(rope,mcmc.list) S3method(rope,numeric) S3method(rope,rvar) S3method(rope,sim) S3method(rope,sim.merMod) S3method(rope,stanfit) S3method(rope,stanreg) S3method(rope_range,data.frame) S3method(rope_range,default) S3method(rope_range,mlm) S3method(sensitivity_to_prior,stanreg) S3method(sexit_thresholds,BFBayesFactor) S3method(sexit_thresholds,MixMod) S3method(sexit_thresholds,bayesQR) S3method(sexit_thresholds,brmsfit) S3method(sexit_thresholds,default) S3method(sexit_thresholds,feis) S3method(sexit_thresholds,felm) S3method(sexit_thresholds,fixest) S3method(sexit_thresholds,gee) S3method(sexit_thresholds,geeglm) S3method(sexit_thresholds,glm) S3method(sexit_thresholds,glmmTMB) S3method(sexit_thresholds,gls) S3method(sexit_thresholds,hurdle) S3method(sexit_thresholds,lm) S3method(sexit_thresholds,lme) S3method(sexit_thresholds,merMod) S3method(sexit_thresholds,mixed) S3method(sexit_thresholds,mlm) S3method(sexit_thresholds,stanreg) S3method(sexit_thresholds,wbm) S3method(sexit_thresholds,zeroinfl) S3method(si,blavaan) S3method(si,brmsfit) S3method(si,data.frame) S3method(si,draws) S3method(si,emmGrid) S3method(si,emm_list) S3method(si,get_predicted) S3method(si,numeric) S3method(si,rvar) S3method(si,stanfit) S3method(si,stanreg) S3method(simulate_prior,bcplm) S3method(simulate_prior,blavaan) S3method(simulate_prior,brmsfit) S3method(simulate_prior,stanreg) S3method(spi,BFBayesFactor) S3method(spi,BGGM) S3method(spi,MCMCglmm) S3method(spi,bamlss) S3method(spi,bayesQR) S3method(spi,bcplm) S3method(spi,blavaan) S3method(spi,blrm) S3method(spi,brmsfit) S3method(spi,data.frame) S3method(spi,default) S3method(spi,emmGrid) S3method(spi,emm_list) S3method(spi,get_predicted) S3method(spi,mcmc) S3method(spi,mcmc.list) S3method(spi,numeric) S3method(spi,sim) S3method(spi,sim.merMod) S3method(spi,stanfit) S3method(spi,stanreg) S3method(unupdate,blavaan) S3method(unupdate,brmsfit) S3method(unupdate,brmsfit_multiple) S3method(unupdate,stanreg) S3method(update,bayesfactor_models) S3method(weighted_posteriors,BFBayesFactor) S3method(weighted_posteriors,blavaan) S3method(weighted_posteriors,brmsfit) S3method(weighted_posteriors,data.frame) S3method(weighted_posteriors,stanreg) export(area_under_curve) export(auc) export(bayesfactor) export(bayesfactor_inclusion) export(bayesfactor_models) export(bayesfactor_parameters) export(bayesfactor_pointnull) export(bayesfactor_restricted) export(bayesfactor_rope) export(bayesian_as_frequentist) export(bcai) export(bci) export(bf_inclusion) export(bf_models) export(bf_parameters) export(bf_pointnull) export(bf_restricted) export(bf_rope) export(bic_to_bf) export(check_prior) export(ci) export(contr.bayes) export(contr.equalprior) export(contr.equalprior_deviations) export(contr.equalprior_pairs) export(contr.orthonorm) export(convert_bayesian_as_frequentist) export(convert_p_to_pd) export(convert_pd_to_p) export(cwi) export(density_at) export(describe_posterior) export(describe_prior) export(diagnostic_draws) export(diagnostic_posterior) export(distribution) export(distribution_beta) export(distribution_binom) export(distribution_binomial) export(distribution_cauchy) export(distribution_chisq) export(distribution_chisquared) export(distribution_custom) export(distribution_gamma) export(distribution_gaussian) export(distribution_mixture_normal) export(distribution_nbinom) export(distribution_normal) export(distribution_poisson) export(distribution_student) export(distribution_student_t) export(distribution_t) export(distribution_tweedie) export(distribution_uniform) export(effective_sample) export(equivalence_test) export(estimate_density) export(eti) export(hdi) export(map_estimate) export(mcse) export(mediation) export(model_to_priors) export(overlap) export(p_direction) export(p_map) export(p_pointnull) export(p_rope) export(p_significance) export(p_to_bf) export(p_to_pd) export(pd) export(pd_to_p) export(point_estimate) export(print_html) export(print_md) export(reshape_draws) export(reshape_iterations) export(rnorm_perfect) export(rope) export(rope_range) export(sensitivity_to_prior) export(sexit) export(sexit_thresholds) export(si) export(simulate_correlation) export(simulate_difference) export(simulate_prior) export(simulate_simpson) export(simulate_ttest) export(spi) export(unupdate) export(weighted_posteriors) importFrom(insight,print_html) importFrom(insight,print_md) bayestestR/README.md0000644000176200001440000005243214413221117013660 0ustar liggesusers # bayestestR [![DOI](https://joss.theoj.org/papers/10.21105/joss.01541/status.svg)](https://doi.org/10.21105/joss.01541) [![status](https://tinyverse.netlify.com/badge/bayestestR)](https://CRAN.R-project.org/package=bayestestR) [![lifecycle](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://lifecycle.r-lib.org/articles/stages.html) ***Become a Bayesian master you will*** ------------------------------------------------------------------------ :warning: We changed the default the CI width! Please make an [informed decision](https://easystats.github.io/bayestestR/articles/credible_interval.html) and set it explicitly (`ci = 0.89`, `ci = 0.95` or anything else that you decide) :warning: ------------------------------------------------------------------------ Existing R packages allow users to easily fit a large variety of models and extract and visualize the posterior draws. However, most of these packages only return a limited set of indices (e.g., point-estimates and CIs). **bayestestR** provides a comprehensive and consistent set of functions to analyze and describe posterior distributions generated by a variety of models objects, including popular modeling packages such as **rstanarm**, **brms** or **BayesFactor**. You can reference the package and its documentation as follows: - Makowski, D., Ben-Shachar, M. S., & Lüdecke, D. (2019). *bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework*. Journal of Open Source Software, 4(40), 1541. [10.21105/joss.01541](https://doi.org/10.21105/joss.01541) - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., & Lüdecke, D. (2019). *Indices of Effect Existence and Significance in the Bayesian Framework*. Frontiers in Psychology 2019;10:2767. [10.3389/fpsyg.2019.02767](https://doi.org/10.3389/fpsyg.2019.02767) ## Installation [![CRAN](http://www.r-pkg.org/badges/version/bayestestR)](https://cran.r-project.org/package=bayestestR) [![insight status badge](https://easystats.r-universe.dev/badges/bayestestR)](https://easystats.r-universe.dev) [![R-CMD-check](https://github.com/easystats/datawizard/workflows/R-CMD-check/badge.svg?branch=main)](https://github.com/easystats/datawizard/actions) The *bayestestR* package is available on CRAN, while its latest development version is available on R-universe (from *rOpenSci*). | Type | Source | Command | |-------------|------------|------------------------------------------------------------------------------| | Release | CRAN | `install.packages("bayestestR")` | | Development | R-universe | `install.packages("bayestestR", repos = "https://easystats.r-universe.dev")` | Once you have downloaded the package, you can then load it using: ``` r library("bayestestR") ``` > **Tip** > > **Instead of `library(datawizard)`, use `library(easystats)`.** **This > will make all features of the easystats-ecosystem available.** > > **To stay updated, use `easystats::install_latest()`.** ## Documentation Access the package [documentation](https://easystats.github.io/bayestestR/) and check-out these vignettes: ### Tutorials - [Get Started with Bayesian Analysis](https://easystats.github.io/bayestestR/articles/bayestestR.html) - [Example 1: Initiation to Bayesian models](https://easystats.github.io/bayestestR/articles/example1.html) - [Example 2: Confirmation of Bayesian skills](https://easystats.github.io/bayestestR/articles/example2.html) - [Example 3: Become a Bayesian master](https://easystats.github.io/bayestestR/articles/example3.html) ### Articles - [Credible Intervals (CI)](https://easystats.github.io/bayestestR/articles/credible_interval.html) - [Probability of Direction (pd)](https://easystats.github.io/bayestestR/articles/probability_of_direction.html) - [Region of Practical Equivalence (ROPE)](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html) - [Bayes Factors (BF)](https://easystats.github.io/bayestestR/articles/bayes_factors.html) - [Comparison of Point-Estimates](https://easystats.github.io/bayestestR/articles/web_only/indicesEstimationComparison.html) - [Comparison of Indices of Effect Existence](https://doi.org/10.3389/fpsyg.2019.02767) - [Reporting Guidelines](https://easystats.github.io/bayestestR/articles/guidelines.html) # Features In the Bayesian framework, parameters are estimated in a probabilistic fashion as *distributions*. These distributions can be summarised and described by reporting four types of indices: - [**Centrality**](https://easystats.github.io/bayestestR/articles/web_only/indicesEstimationComparison.html) - `mean()`, `median()` or [`map_estimate()`](https://easystats.github.io/bayestestR/reference/map_estimate.html) for an estimation of the mode. - [`point_estimate()`](https://easystats.github.io/bayestestR/reference/point_estimate.html) can be used to get them at once and can be run directly on models. - [**Uncertainty**](https://easystats.github.io/bayestestR/articles/credible_interval.html) - [`hdi()`](https://easystats.github.io/bayestestR/reference/hdi.html) for *Highest Density Intervals (HDI)*, [`spi()`](https://easystats.github.io/bayestestR/reference/spi.html) for *Shortest Probability Intervals (SPI)* or [`eti()`](https://easystats.github.io/bayestestR/reference/eti.html) for *Equal-Tailed Intervals (ETI)*. - [`ci()`](https://easystats.github.io/bayestestR/reference/ci.html) can be used as a general method for Confidence and Credible Intervals (CI). - [**Effect Existence**](https://easystats.github.io/bayestestR/articles/indicesExistenceComparison.html): whether an effect is different from 0. - [`p_direction()`](https://easystats.github.io/bayestestR/reference/p_direction.html) for a Bayesian equivalent of the frequentist *p*-value (see [Makowski et al., 2019](https://doi.org/10.3389/fpsyg.2019.02767)) - [`p_pointnull()`](https://easystats.github.io/bayestestR/reference/p_map.html) represents the odds of null hypothesis (*h0 = 0*) compared to the most likely hypothesis (the MAP). - [`bf_pointnull()`](https://easystats.github.io/bayestestR/reference/bayesfactor_parameters.html) for a classic *Bayes Factor (BF)* assessing the likelihood of effect presence against its absence (*h0 = 0*). - [**Effect Significance**](https://easystats.github.io/bayestestR/articles/indicesExistenceComparison.html): whether the effect size can be considered as non-negligible. - [`p_rope()`](https://easystats.github.io/bayestestR/reference/p_rope.html) is the probability of the effect falling inside a [*Region of Practical Equivalence (ROPE)*](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html). - [`bf_rope()`](https://easystats.github.io/bayestestR/reference/bayesfactor_parameters.html) computes a Bayes factor against the null as defined by a region (the ROPE). - [`p_significance()`](https://easystats.github.io/bayestestR/reference/p_significance.html) that combines a region of equivalence with the probability of direction. [`describe_posterior()`](https://easystats.github.io/bayestestR/reference/describe_posterior.html) is the master function with which you can compute all of the indices cited below at once. ``` r describe_posterior( rnorm(10000), centrality = "median", test = c("p_direction", "p_significance"), verbose = FALSE ) ## Summary of Posterior Distribution ## ## Parameter | Median | 95% CI | pd | ps ## -------------------------------------------------- ## Posterior | 0.01 | [-1.97, 1.99] | 50.58% | 0.47 ``` `describe_posterior()` works for many objects, including more complex *brmsfit*-models. For better readability, the output is separated by model components: ``` r zinb <- read.csv("http://stats.idre.ucla.edu/stat/data/fish.csv") set.seed(123) model <- brm( bf( count ~ child + camper + (1 | persons), zi ~ child + camper + (1 | persons) ), data = zinb, family = zero_inflated_poisson(), chains = 1, iter = 500 ) describe_posterior( model, effects = "all", component = "all", test = c("p_direction", "p_significance"), centrality = "all" ) ``` ## Summary of Posterior Distribution ## ## Parameter | Median | Mean | MAP | 95% CI | pd | ps | Rhat | ESS ## -------------------------------------------------------------------------------------- ## (Intercept) | 0.96 | 0.96 | 0.96 | [-0.81, 2.51] | 90.00% | 0.88 | 1.011 | 110.00 ## child | -1.16 | -1.16 | -1.16 | [-1.36, -0.94] | 100% | 1.00 | 0.996 | 278.00 ## camper | 0.73 | 0.72 | 0.73 | [ 0.54, 0.91] | 100% | 1.00 | 0.996 | 271.00 ## ## # Fixed effects (zero-inflated) ## ## Parameter | Median | Mean | MAP | 95% CI | pd | ps | Rhat | ESS ## -------------------------------------------------------------------------------------- ## (Intercept) | -0.48 | -0.51 | -0.22 | [-2.03, 0.89] | 78.00% | 0.73 | 0.997 | 138.00 ## child | 1.85 | 1.86 | 1.81 | [ 1.19, 2.54] | 100% | 1.00 | 0.996 | 303.00 ## camper | -0.88 | -0.86 | -0.99 | [-1.61, -0.07] | 98.40% | 0.96 | 0.996 | 292.00 ## ## # Random effects (conditional) Intercept: persons ## ## Parameter | Median | Mean | MAP | 95% CI | pd | ps | Rhat | ESS ## --------------------------------------------------------------------------------------- ## persons.1 | -0.99 | -1.01 | -0.84 | [-2.68, 0.80] | 92.00% | 0.90 | 1.007 | 106.00 ## persons.2 | -4.65e-03 | -0.04 | 0.03 | [-1.63, 1.66] | 50.00% | 0.45 | 1.013 | 109.00 ## persons.3 | 0.69 | 0.66 | 0.69 | [-0.95, 2.34] | 79.60% | 0.78 | 1.010 | 114.00 ## persons.4 | 1.57 | 1.56 | 1.56 | [-0.05, 3.29] | 96.80% | 0.96 | 1.009 | 114.00 ## ## # Random effects (zero-inflated) Intercept: persons ## ## Parameter | Median | Mean | MAP | 95% CI | pd | ps | Rhat | ESS ## ------------------------------------------------------------------------------------ ## persons.1 | 1.10 | 1.11 | 1.08 | [-0.23, 2.72] | 94.80% | 0.93 | 0.997 | 166.00 ## persons.2 | 0.18 | 0.18 | 0.22 | [-0.94, 1.58] | 63.20% | 0.54 | 0.996 | 154.00 ## persons.3 | -0.30 | -0.31 | -0.54 | [-1.79, 1.02] | 64.00% | 0.59 | 0.997 | 154.00 ## persons.4 | -1.45 | -1.46 | -1.44 | [-2.90, -0.10] | 98.00% | 0.97 | 1.000 | 189.00 ## ## # Random effects (conditional) SD/Cor: persons ## ## Parameter | Median | Mean | MAP | 95% CI | pd | ps | Rhat | ESS ## ---------------------------------------------------------------------------------- ## (Intercept) | 1.42 | 1.58 | 1.07 | [ 0.71, 3.58] | 100% | 1.00 | 1.010 | 126.00 ## ## # Random effects (zero-inflated) SD/Cor: persons ## ## Parameter | Median | Mean | MAP | 95% CI | pd | ps | Rhat | ESS ## ---------------------------------------------------------------------------------- ## (Intercept) | 1.30 | 1.49 | 0.99 | [ 0.63, 3.41] | 100% | 1.00 | 0.996 | 129.00 *bayestestR* also includes [**many other features**](https://easystats.github.io/bayestestR/reference/index.html) useful for your Bayesian analyses. Here are some more examples: ## Point-estimates ``` r library(bayestestR) posterior <- distribution_gamma(10000, 1.5) # Generate a skewed distribution centrality <- point_estimate(posterior) # Get indices of centrality centrality ## Point Estimate ## ## Median | Mean | MAP ## -------------------- ## 1.18 | 1.50 | 0.51 ``` As for other [**easystats**](https://github.com/easystats) packages, `plot()` methods are available from the [**see**](https://easystats.github.io/see/) package for many functions: ![](man/figures/unnamed-chunk-8-1.png) While the **median** and the **mean** are available through base R functions, [`map_estimate()`](https://easystats.github.io/bayestestR/reference/map_estimate.html) in *bayestestR* can be used to directly find the **Highest Maximum A Posteriori (MAP)** estimate of a posterior, *i.e.*, the value associated with the highest probability density (the “peak” of the posterior distribution). In other words, it is an estimation of the *mode* for continuous parameters. ## Uncertainty (CI) [`hdi()`](https://easystats.github.io/bayestestR/reference/hdi.html) computes the **Highest Density Interval (HDI)** of a posterior distribution, i.e., the interval which contains all points within the interval have a higher probability density than points outside the interval. The HDI can be used in the context of Bayesian posterior characterization as **Credible Interval (CI)**. Unlike equal-tailed intervals (see [`eti()`](https://easystats.github.io/bayestestR/reference/eti.html)) that typically exclude 2.5% from each tail of the distribution, the HDI is *not* equal-tailed and therefore always includes the mode(s) of posterior distributions. ``` r posterior <- distribution_chisquared(10000, 4) hdi(posterior, ci = 0.89) ## 89% HDI: [0.18, 7.63] eti(posterior, ci = 0.89) ## 89% ETI: [0.75, 9.25] ``` ![](man/figures/unnamed-chunk-10-1.png) ## Existence and Significance Testing ### Probability of Direction (*pd*) [`p_direction()`](https://easystats.github.io/bayestestR/reference/p_direction.html) computes the *Probability of Direction* (*p*d, also known as the Maximum Probability of Effect - *MPE*). It varies between 50% and 100% (*i.e.*, `0.5` and `1`) and can be interpreted as the probability (expressed in percentage) that a parameter (described by its posterior distribution) is strictly positive or negative (whichever is the most probable). It is mathematically defined as the proportion of the posterior distribution that is of the median’s sign. Although differently expressed, this index is fairly similar (*i.e.*, is strongly correlated) to the frequentist *p*-value. **Relationship with the p-value**: In most cases, it seems that the *pd* corresponds to the frequentist one-sided *p*-value through the formula `p-value = (1-pd/100)` and to the two-sided *p*-value (the most commonly reported) through the formula `p-value = 2*(1-pd/100)`. Thus, a `pd` of `95%`, `97.5%` `99.5%` and `99.95%` corresponds approximately to a two-sided *p*-value of respectively `.1`, `.05`, `.01` and `.001`. See the [*reporting guidelines*](https://easystats.github.io/bayestestR/articles/guidelines.html). ``` r posterior <- distribution_normal(10000, 0.4, 0.2) p_direction(posterior) ## Probability of Direction: 0.98 ``` ![](man/figures/unnamed-chunk-12-1.png) ### ROPE [`rope()`](https://easystats.github.io/bayestestR/reference/rope.html) computes the proportion (in percentage) of the HDI (default to the 89% HDI) of a posterior distribution that lies within a region of practical equivalence. Statistically, the probability of a posterior distribution of being different from 0 does not make much sense (the probability of it being different from a single point being infinite). Therefore, the idea underlining ROPE is to let the user define an area around the null value enclosing values that are *equivalent to the null* value for practical purposes Kruschke (2018). Kruschke suggests that such null value could be set, by default, to the -0.1 to 0.1 range of a standardized parameter (negligible effect size according to Cohen, 1988). This could be generalized: For instance, for linear models, the ROPE could be set as `0 +/- .1 * sd(y)`. This ROPE range can be automatically computed for models using the [rope_range](https://easystats.github.io/bayestestR/reference/rope_range.html) function. Kruschke suggests using the proportion of the 95% (or 90%, considered more stable) HDI that falls within the ROPE as an index for “null-hypothesis” testing (as understood under the Bayesian framework, see [equivalence_test](https://easystats.github.io/bayestestR/reference/equivalence_test.html)). ``` r posterior <- distribution_normal(10000, 0.4, 0.2) rope(posterior, range = c(-0.1, 0.1)) ## # Proportion of samples inside the ROPE [-0.10, 0.10]: ## ## inside ROPE ## ----------- ## 4.40 % ``` ![](man/figures/unnamed-chunk-14-1.png) ### Bayes Factor [`bayesfactor_parameters()`](https://easystats.github.io/bayestestR/reference/bayesfactor_parameters.html) computes Bayes factors against the null (either a point or an interval), bases on prior and posterior samples of a single parameter. This Bayes factor indicates the degree by which the mass of the posterior distribution has shifted further away from or closer to the null value(s) (relative to the prior distribution), thus indicating if the null value has become less or more likely given the observed data. When the null is an interval, the Bayes factor is computed by comparing the prior and posterior odds of the parameter falling within or outside the null; When the null is a point, a Savage-Dickey density ratio is computed, which is also an approximation of a Bayes factor comparing the marginal likelihoods of the model against a model in which the tested parameter has been restricted to the point null (Wagenmakers, Lodewyckx, Kuriyal, & Grasman, 2010). ``` r prior <- distribution_normal(10000, mean = 0, sd = 1) posterior <- distribution_normal(10000, mean = 1, sd = 0.7) bayesfactor_parameters(posterior, prior, direction = "two-sided", null = 0, verbose = FALSE) ## Bayes Factor (Savage-Dickey density ratio) ## ## BF ## ---- ## 1.94 ## ## * Evidence Against The Null: 0 ``` ![](man/figures/unnamed-chunk-16-1.png) *The lollipops represent the density of a point-null on the prior distribution (the blue lollipop on the dotted distribution) and on the posterior distribution (the red lollipop on the yellow distribution). The ratio between the two - the Savage-Dickey ratio - indicates the degree by which the mass of the parameter distribution has shifted away from or closer to the null.* For more info, see [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html). ## Utilities ### Find ROPE’s appropriate range [`rope_range()`](https://easystats.github.io/bayestestR/reference/rope_range.html): This function attempts at automatically finding suitable “default” values for the Region Of Practical Equivalence (ROPE). Kruschke (2018) suggests that such null value could be set, by default, to a range from `-0.1` to `0.1` of a standardized parameter (negligible effect size according to Cohen, 1988), which can be generalised for linear models to `-0.1 * sd(y), 0.1 * sd(y)`. For logistic models, the parameters expressed in log odds ratio can be converted to standardized difference through the formula `sqrt(3)/pi`, resulting in a range of `-0.05` to `0.05`. ``` r rope_range(model) ``` ### Density Estimation [`estimate_density()`](https://easystats.github.io/bayestestR/reference/estimate_density.html): This function is a wrapper over different methods of density estimation. By default, it uses the base R `density` with by default uses a different smoothing bandwidth (`"SJ"`) from the legacy default implemented the base R `density` function (`"nrd0"`). However, Deng & Wickham suggest that `method = "KernSmooth"` is the fastest and the most accurate. ### Perfect Distributions [`distribution()`](https://easystats.github.io/bayestestR/reference/distribution.html): Generate a sample of size n with near-perfect distributions. ``` r distribution(n = 10) ## [1] -1.55 -1.00 -0.66 -0.38 -0.12 0.12 0.38 0.66 1.00 1.55 ``` ### Probability of a Value [`density_at()`](https://easystats.github.io/bayestestR/reference/density_at.html): Compute the density of a given point of a distribution. ``` r density_at(rnorm(1000, 1, 1), 1) ## [1] 0.39 ``` ## Code of Conduct Please note that the bayestestR project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/1/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. # References
Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. *Advances in Methods and Practices in Psychological Science*, *1*(2), 270–280.
Kruschke, J. K., & Liddell, T. M. (2018). The bayesian new statistics: Hypothesis testing, estimation, meta-analysis, and power analysis from a bayesian perspective. *Psychonomic Bulletin & Review*, *25*(1), 178–206.
Wagenmakers, E.-J., Lodewyckx, T., Kuriyal, H., & Grasman, R. (2010). Bayesian hypothesis testing for psychologists: A tutorial on the savage–dickey method. *Cognitive Psychology*, *60*(3), 158–189.
bayestestR/data/0000755000176200001440000000000014357655465013334 5ustar liggesusersbayestestR/data/disgust.rdata0000644000176200001440000000062414357655465016035 0ustar liggesusersTN@)Z BKh7nM%< BT~[Ӟ1'8̽wΜ9wA(1 &2yȨBIXS/wYN.|Q' aBƈ w%a 4>Dzu}pn:KG&k{hs+6au {O]h #@C} -|8oM/KYɷдO =r}M{Y |㮝9VWA?IܯFMЬ zv~ !GM0.1}, we would set \code{bayesfactor_parameters(null = c(0, 0.1), direction = ">")}. \cr\cr It is also possible to compute a Bayes factor for \strong{dividing} hypotheses - that is, for a null and alternative that are complementary, opposing one-sided hypotheses (\cite{Morey & Wagenmakers, 2014}). For example, for a Bayes factor comparing the "null" of \verb{<0} to the alternative \verb{>0}, we would set \code{bayesfactor_parameters(null = c(-Inf, 0))}. } } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \section{Setting the correct \code{prior}}{ For the computation of Bayes factors, the model priors must be proper priors (at the very least they should be \emph{not flat}, and it is preferable that they be \emph{informative}); As the priors for the alternative get wider, the likelihood of the null value(s) increases, to the extreme that for completely flat priors the null is infinitely more favorable than the alternative (this is called \emph{the Jeffreys-Lindley-Bartlett paradox}). Thus, you should only ever try (or want) to compute a Bayes factor when you have an informed prior. \cr\cr (Note that by default, \code{brms::brm()} uses flat priors for fixed-effects; See example below.) \cr\cr It is important to provide the correct \code{prior} for meaningful results. \itemize{ \item When \code{posterior} is a numerical vector, \code{prior} should also be a numerical vector. \item When \code{posterior} is a \code{data.frame}, \code{prior} should also be a \code{data.frame}, with matching column order. \item When \code{posterior} is a \code{stanreg}, \code{brmsfit} or other supported Bayesian model: \itemize{ \item \code{prior} can be set to \code{NULL}, in which case prior samples are drawn internally. \item \code{prior} can also be a model equivalent to \code{posterior} but with samples from the priors \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \strong{Note:} When \code{posterior} is a \code{brmsfit_multiple} model, \code{prior} \strong{must} be provided. } \item When \code{posterior} is an \code{emmGrid} / \code{emm_list} object: \itemize{ \item \code{prior} should also be an \code{emmGrid} / \code{emm_list} object equivalent to \code{posterior} but created with a model of priors samples \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \code{prior} can also be the original (posterior) \emph{model}. If so, the function will try to update the \code{emmGrid} / \code{emm_list} to use the \code{\link[=unupdate]{unupdate()}}d prior-model. (\emph{This cannot be done for \code{brmsfit} models.}) \item \strong{Note}: When the \code{emmGrid} has undergone any transformations (\code{"log"}, \code{"response"}, etc.), or \code{regrid}ing, then \code{prior} must be an \code{emmGrid} object, as stated above. } } } \section{Interpreting Bayes Factors}{ A Bayes factor greater than 1 can be interpreted as evidence against the null, at which one convention is that a Bayes factor greater than 3 can be considered as "substantial" evidence against the null (and vice versa, a Bayes factor smaller than 1/3 indicates substantial evidence in favor of the null-model) (\cite{Wetzels et al. 2011}). } \examples{ library(bayestestR) if (require("logspline")) { prior <- distribution_normal(1000, mean = 0, sd = 1) posterior <- distribution_normal(1000, mean = .5, sd = .3) (BF_pars <- bayesfactor_parameters(posterior, prior, verbose = FALSE)) as.numeric(BF_pars) } \dontrun{ # rstanarm models # --------------- if (require("rstanarm") && require("emmeans") && require("logspline")) { contrasts(sleep$group) <- contr.equalprior_pairs # see vingette stan_model <- suppressWarnings(stan_lmer( extra ~ group + (1 | ID), data = sleep, refresh = 0 )) bayesfactor_parameters(stan_model, verbose = FALSE) bayesfactor_parameters(stan_model, null = rope_range(stan_model)) # emmGrid objects # --------------- group_diff <- pairs(emmeans(stan_model, ~group)) bayesfactor_parameters(group_diff, prior = stan_model, verbose = FALSE) # Or group_diff_prior <- pairs(emmeans(unupdate(stan_model), ~group)) bayesfactor_parameters(group_diff, prior = group_diff_prior, verbose = FALSE) } # brms models # ----------- if (require("brms")) { contrasts(sleep$group) <- contr.equalprior_pairs # see vingette my_custom_priors <- set_prior("student_t(3, 0, 1)", class = "b") + set_prior("student_t(3, 0, 1)", class = "sd", group = "ID") brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID), data = sleep, prior = my_custom_priors, refresh = 0 )) bayesfactor_parameters(brms_model, verbose = FALSE) } } } \references{ \itemize{ \item Wagenmakers, E. J., Lodewyckx, T., Kuriyal, H., and Grasman, R. (2010). Bayesian hypothesis testing for psychologists: A tutorial on the Savage-Dickey method. Cognitive psychology, 60(3), 158-189. \item Heck, D. W. (2019). A caveat on the Savage–Dickey density ratio: The case of computing Bayes factors for regression parameters. British Journal of Mathematical and Statistical Psychology, 72(2), 316-333. \item Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124. \item Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. Psychological methods, 16(4), 406. \item Liao, J. G., Midya, V., & Berg, A. (2020). Connecting and contrasting the Bayes factor and a modified ROPE procedure for testing interval null hypotheses. The American Statistician, 1-19. \item Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011). Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests. Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923} } } \author{ Mattan S. Ben-Shachar } bayestestR/man/dot-select_nums.Rd0000644000176200001440000000040014276606713016554 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{.select_nums} \alias{.select_nums} \title{select numerics columns} \usage{ .select_nums(x) } \description{ select numerics columns } \keyword{internal} bayestestR/man/bayesfactor.Rd0000644000176200001440000000647314407021360015752 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bayesfactor.R \name{bayesfactor} \alias{bayesfactor} \title{Bayes Factors (BF)} \usage{ bayesfactor( ..., prior = NULL, direction = "two-sided", null = 0, hypothesis = NULL, effects = c("fixed", "random", "all"), verbose = TRUE, denominator = 1, match_models = FALSE, prior_odds = NULL ) } \arguments{ \item{...}{A numeric vector, model object(s), or the output from \code{bayesfactor_models}.} \item{prior}{An object representing a prior distribution (see 'Details').} \item{direction}{Test type (see 'Details'). One of \code{0}, \code{"two-sided"} (default, two tailed), \code{-1}, \code{"left"} (left tailed) or \code{1}, \code{"right"} (right tailed).} \item{null}{Value of the null, either a scalar (for point-null) or a range (for a interval-null).} \item{hypothesis}{A character vector specifying the restrictions as logical conditions (see examples below).} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{verbose}{Toggle off warnings.} \item{denominator}{Either an integer indicating which of the models to use as the denominator, or a model to be used as a denominator. Ignored for \code{BFBayesFactor}.} \item{match_models}{See details.} \item{prior_odds}{Optional vector of prior odds for the models. See \verb{BayesFactor::priorOdds<-}.} } \value{ Some type of Bayes factor, depending on the input. See \code{\link[=bayesfactor_parameters]{bayesfactor_parameters()}}, \code{\link[=bayesfactor_models]{bayesfactor_models()}} or \code{\link[=bayesfactor_inclusion]{bayesfactor_inclusion()}} } \description{ This function compte the Bayes factors (BFs) that are appropriate to the input. For vectors or single models, it will compute \code{\link[=bayesfactor_parameters]{BFs for single parameters()}}, or is \code{hypothesis} is specified, \code{\link[=bayesfactor_restricted]{BFs for restricted models()}}. For multiple models, it will return the BF corresponding to \code{\link[=bayesfactor_models]{comparison between models()}} and if a model comparison is passed, it will compute the \code{\link[=bayesfactor_inclusion]{inclusion BF()}}. \cr\cr For a complete overview of these functions, read the \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{Bayes factor vignette}. } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ library(bayestestR) if (require("logspline")) { prior <- distribution_normal(1000, mean = 0, sd = 1) posterior <- distribution_normal(1000, mean = .5, sd = .3) bayesfactor(posterior, prior = prior, verbose = FALSE) } \dontrun{ # rstanarm models # --------------- if (require("rstanarm")) { model <- stan_lmer(extra ~ group + (1 | ID), data = sleep) bayesfactor(model, verbose = FALSE) } } if (require("logspline")) { # Frequentist models # --------------- m0 <- lm(extra ~ 1, data = sleep) m1 <- lm(extra ~ group, data = sleep) m2 <- lm(extra ~ group + ID, data = sleep) comparison <- bayesfactor(m0, m1, m2) comparison bayesfactor(comparison) } } bayestestR/man/sexit_thresholds.Rd0000644000176200001440000000272414407021361017037 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sexit_thresholds.R \name{sexit_thresholds} \alias{sexit_thresholds} \title{Find Effect Size Thresholds} \usage{ sexit_thresholds(x, ...) } \arguments{ \item{x}{Vector representing a posterior distribution. Can also be a \code{stanreg} or \code{brmsfit} model.} \item{...}{Currently not used.} } \description{ This function attempts at automatically finding suitable default values for a "significant" (i.e., non-negligible) and "large" effect. This is to be used with care, and the chosen threshold should always be explicitly reported and justified. See the detail section in \code{\link[=sexit]{sexit()}} for more information. } \examples{ sexit_thresholds(rnorm(1000)) \dontrun{ if (require("rstanarm")) { model <- stan_glm( mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0 ) sexit_thresholds(model) model <- stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0) sexit_thresholds(model) } if (require("brms")) { model <- brm(mpg ~ wt + cyl, data = mtcars) sexit_thresholds(model) } if (require("BayesFactor")) { bf <- ttestBF(x = rnorm(100, 1, 1)) sexit_thresholds(bf) } } } \references{ Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. } bayestestR/man/model_to_priors.Rd0000644000176200001440000000205014276606713016652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model_to_priors.R \name{model_to_priors} \alias{model_to_priors} \title{Convert model's posteriors to priors (EXPERIMENTAL)} \usage{ model_to_priors(model, scale_multiply = 3, ...) } \arguments{ \item{model}{A Bayesian model.} \item{scale_multiply}{The SD of the posterior will be multiplied by this amount before being set as a prior to avoid overly narrow priors.} \item{...}{Other arguments for \code{insight::get_prior()} or \code{\link{describe_posterior}}.} } \description{ Convert model's posteriors to (normal) priors. } \examples{ \dontrun{ # brms models # ----------------------------------------------- if (require("brms")) { formula <- brms::brmsformula(mpg ~ wt + cyl, center = FALSE) model <- brms::brm(formula, data = mtcars, refresh = 0) priors <- model_to_priors(model) priors <- brms::validate_prior(priors, formula, data = mtcars) priors model2 <- brms::brm(formula, data = mtcars, prior = priors, refresh = 0) } } } bayestestR/man/p_to_bf.Rd0000644000176200001440000000460214311464510015052 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/p_to_bf.R \name{p_to_bf} \alias{p_to_bf} \alias{p_to_bf.numeric} \alias{p_to_bf.default} \title{Convert p-values to (pseudo) Bayes Factors} \usage{ p_to_bf(x, log = FALSE, ...) \method{p_to_bf}{numeric}(x, log = FALSE, n_obs = NULL, ...) \method{p_to_bf}{default}(x, log = FALSE, ...) } \arguments{ \item{x}{A (frequentist) model object, or a (numeric) vector of p-values.} \item{log}{Wether to return log Bayes Factors. \strong{Note:} The \code{print()} method always shows \code{BF} - the \code{"log_BF"} column is only accessible from the returned data frame.} \item{...}{Other arguments to be passed (not used for now).} \item{n_obs}{Number of observations. Either length 1, or same length as \code{p}.} } \value{ A data frame with the p-values and pseudo-Bayes factors (against the null). } \description{ Convert p-values to (pseudo) Bayes Factors. This transformation has been suggested by Wagenmakers (2022), but is based on a vast amount of assumptions. It might therefore be not reliable. Use at your own risks. For more accurate approximate Bayes factors, use \code{\link[=bic_to_bf]{bic_to_bf()}} instead. } \examples{ if (requireNamespace("parameters", quietly = TRUE)) { data(iris) model <- lm(Petal.Length ~ Sepal.Length + Species, data = iris) p_to_bf(model) # Examples that demonstrate comparison between # BIC-approximated and pseudo BF # -------------------------------------------- m0 <- lm(mpg ~ 1, mtcars) m1 <- lm(mpg ~ am, mtcars) m2 <- lm(mpg ~ factor(cyl), mtcars) # In this first example, BIC-approximated BF and # pseudo-BF based on p-values are close... # BIC-approximated BF, m1 against null model bic_to_bf(BIC(m1), denominator = BIC(m0)) # pseudo-BF based on p-values - dropping intercept p_to_bf(m1)[-1, ] # The second example shows that results from pseudo-BF are less accurate # and should be handled wit caution! bic_to_bf(BIC(m2), denominator = BIC(m0)) p_to_bf(anova(m2), n_obs = nrow(mtcars)) } } \references{ \itemize{ \item Wagenmakers, E.J. (2022). Approximate objective Bayes factors from p-values and sample size: The 3p(sqrt(n)) rule. Preprint available on ArXiv: https://psyarxiv.com/egydq } } \seealso{ \code{\link[=bic_to_bf]{bic_to_bf()}} for more accurate approximate Bayes factors. } bayestestR/man/diagnostic_draws.Rd0000644000176200001440000000146214276606713017004 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/diagnostic_draws.R \name{diagnostic_draws} \alias{diagnostic_draws} \title{Diagnostic values for each iteration} \usage{ diagnostic_draws(posteriors, ...) } \arguments{ \item{posteriors}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, or \code{blavaan} object.} \item{...}{Currently not used.} } \description{ Returns the accumulated log-posterior, the average Metropolis acceptance rate, divergent transitions, treedepth rather than terminated its evolution normally. } \examples{ \dontrun{ set.seed(333) if (require("brms", quietly = TRUE)) { model <- brm(mpg ~ wt * cyl * vs, data = mtcars, iter = 100, control = list(adapt_delta = 0.80), refresh = 0 ) diagnostic_draws(model) } } } bayestestR/man/ci.Rd0000644000176200001440000001242114407021360014031 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ci.R \name{ci} \alias{ci} \alias{ci.numeric} \alias{ci.data.frame} \alias{ci.sim.merMod} \alias{ci.sim} \alias{ci.stanreg} \alias{ci.brmsfit} \alias{ci.BFBayesFactor} \alias{ci.MCMCglmm} \title{Confidence/Credible/Compatibility Interval (CI)} \usage{ ci(x, ...) \method{ci}{numeric}(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...) \method{ci}{data.frame}(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...) \method{ci}{sim.merMod}( x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ... ) \method{ci}{sim}(x, ci = 0.95, method = "ETI", parameters = NULL, verbose = TRUE, ...) \method{ci}{stanreg}( x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, BF = 1, ... ) \method{ci}{brmsfit}( x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, BF = 1, ... ) \method{ci}{BFBayesFactor}(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...) \method{ci}{MCMCglmm}(x, ci = 0.95, method = "ETI", verbose = TRUE, ...) } \arguments{ \item{x}{A \code{stanreg} or \code{brmsfit} model, or a vector representing a posterior distribution.} \item{...}{Currently not used.} \item{ci}{Value or vector of probability of the CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{method}{Can be \link[=eti]{'ETI'} (default), \link[=hdi]{'HDI'}, \link[=bci]{'BCI'}, \link[=spi]{'SPI'} or \link[=si]{'SI'}.} \item{verbose}{Toggle off warnings.} \item{BF}{The amount of support required to be included in the support interval.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the credible interval. \item \code{CI_low}, \code{CI_high} The lower and upper credible interval limits for the parameters. } } \description{ Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals (SI) for Bayesian and frequentist models. The Documentation is accessible for: } \details{ \itemize{ \item \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{Bayesian models} \item \href{https://easystats.github.io/parameters/reference/ci.default.html}{Frequentist models} } } \note{ When it comes to interpretation, we recommend thinking of the CI in terms of an "uncertainty" or "compatibility" interval, the latter being defined as \dQuote{Given any value in the interval and the background assumptions, the data should not seem very surprising} (\cite{Gelman & Greenland 2019}). \cr \cr There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ \dontshow{if (require("rstanarm", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(bayestestR) posterior <- rnorm(1000) ci(posterior, method = "ETI") ci(posterior, method = "HDI") df <- data.frame(replicate(4, rnorm(100))) ci(df, method = "ETI", ci = c(0.80, 0.89, 0.95)) ci(df, method = "HDI", ci = c(0.80, 0.89, 0.95)) model <- suppressWarnings( stan_glm(mpg ~ wt, data = mtcars, chains = 2, iter = 200, refresh = 0) ) ci(model, method = "ETI", ci = c(0.80, 0.89)) ci(model, method = "HDI", ci = c(0.80, 0.89)) \dontshow{\}) # examplesIf} \dontshow{if (require("BayesFactor", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} bf <- ttestBF(x = rnorm(100, 1, 1)) ci(bf, method = "ETI") ci(bf, method = "HDI") \dontshow{\}) # examplesIf} \dontshow{if (require("emmeans", quietly = TRUE) && require("rstanarm", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} model <- emtrends(model, ~1, "wt") ci(model, method = "ETI") ci(model, method = "HDI") \dontshow{\}) # examplesIf} } \references{ Gelman A, Greenland S. Are confidence intervals better termed "uncertainty intervals"? BMJ 2019;l5381. 10.1136/bmj.l5381 } \seealso{ Other ci: \code{\link{bci}()}, \code{\link{cwi}()}, \code{\link{eti}()}, \code{\link{hdi}()}, \code{\link{si}()}, \code{\link{spi}()} } \concept{ci} bayestestR/man/pd_to_p.Rd0000644000176200001440000000170114276606713015100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convert_pd_to_p.R \name{pd_to_p} \alias{pd_to_p} \alias{p_to_pd} \alias{convert_p_to_pd} \alias{convert_pd_to_p} \title{Convert between Probability of Direction (pd) and p-value.} \usage{ pd_to_p(pd, direction = "two-sided", ...) p_to_pd(p, direction = "two-sided", ...) convert_p_to_pd(p, direction = "two-sided", ...) convert_pd_to_p(pd, direction = "two-sided", ...) } \arguments{ \item{pd}{A Probability of Direction (pd) value (between 0 and 1).} \item{direction}{What type of p-value is requested or provided. Can be \code{"two-sided"} (default, two tailed) or \code{"one-sided"} (one tailed).} \item{...}{Arguments passed to or from other methods.} \item{p}{A p-value.} } \description{ Enables a conversion between Probability of Direction (pd) and p-value. } \examples{ pd_to_p(pd = 0.95) pd_to_p(pd = 0.95, direction = "one-sided") } bayestestR/man/point_estimate.Rd0000644000176200001440000001106614307033605016472 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/point_estimate.R \name{point_estimate} \alias{point_estimate} \alias{point_estimate.numeric} \alias{point_estimate.stanreg} \alias{point_estimate.brmsfit} \alias{point_estimate.BFBayesFactor} \title{Point-estimates of posterior distributions} \usage{ point_estimate(x, ...) \method{point_estimate}{numeric}(x, centrality = "all", dispersion = FALSE, threshold = 0.1, ...) \method{point_estimate}{stanreg}( x, centrality = "all", dispersion = FALSE, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) \method{point_estimate}{brmsfit}( x, centrality = "all", dispersion = FALSE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ... ) \method{point_estimate}{BFBayesFactor}(x, centrality = "all", dispersion = FALSE, ...) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Additional arguments to be passed to or from methods.} \item{centrality}{The point-estimates (centrality indices) to compute. Character (vector) or list with one or more of these options: \code{"median"}, \code{"mean"}, \code{"MAP"} or \code{"all"}.} \item{dispersion}{Logical, if \code{TRUE}, computes indices of dispersion related to the estimate(s) (\code{SD} and \code{MAD} for \code{mean} and \code{median}, respectively).} \item{threshold}{For \code{centrality = "trimmed"} (i.e. trimmed mean), indicates the fraction (0 to 0.5) of observations to be trimmed from each end of the vector before the mean is computed.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ Compute various point-estimates, such as the mean, the median or the MAP, to describe posterior distributions. } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ library(bayestestR) point_estimate(rnorm(1000)) point_estimate(rnorm(1000), centrality = "all", dispersion = TRUE) point_estimate(rnorm(1000), centrality = c("median", "MAP")) df <- data.frame(replicate(4, rnorm(100))) point_estimate(df, centrality = "all", dispersion = TRUE) point_estimate(df, centrality = c("median", "MAP")) \dontrun{ # rstanarm models # ----------------------------------------------- library(rstanarm) model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) point_estimate(model, centrality = "all", dispersion = TRUE) point_estimate(model, centrality = c("median", "MAP")) # emmeans estimates # ----------------------------------------------- library(emmeans) point_estimate(emtrends(model, ~1, "wt"), centrality = c("median", "MAP")) # brms models # ----------------------------------------------- library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) point_estimate(model, centrality = "all", dispersion = TRUE) point_estimate(model, centrality = c("median", "MAP")) # BayesFactor objects # ----------------------------------------------- library(BayesFactor) bf <- ttestBF(x = rnorm(100, 1, 1)) point_estimate(bf, centrality = "all", dispersion = TRUE) point_estimate(bf, centrality = c("median", "MAP")) } } \references{ Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). \emph{Indices of Effect Existence and Significance in the Bayesian Framework}. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} } bayestestR/man/area_under_curve.Rd0000644000176200001440000000305114407021360016746 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/area_under_curve.R \name{area_under_curve} \alias{area_under_curve} \alias{auc} \title{Area under the Curve (AUC)} \usage{ area_under_curve(x, y, method = c("trapezoid", "step", "spline"), ...) auc(x, y, method = c("trapezoid", "step", "spline"), ...) } \arguments{ \item{x}{Vector of x values.} \item{y}{Vector of y values.} \item{method}{Method to compute the Area Under the Curve (AUC). Can be \code{"trapezoid"} (default), \code{"step"} or \code{"spline"}. If "trapezoid", the curve is formed by connecting all points by a direct line (composite trapezoid rule). If "step" is chosen then a stepwise connection of two points is used. For calculating the area under a spline interpolation the splinefun function is used in combination with integrate.} \item{...}{Arguments passed to or from other methods.} } \description{ Based on the DescTools \code{AUC} function. It can calculate the area under the curve with a naive algorithm or a more elaborated spline approach. The curve must be given by vectors of xy-coordinates. This function can handle unsorted x values (by sorting x) and ties for the x values (by ignoring duplicates). } \examples{ library(bayestestR) posterior <- distribution_normal(1000) dens <- estimate_density(posterior) dens <- dens[dens$x > 0, ] x <- dens$x y <- dens$y area_under_curve(x, y, method = "trapezoid") area_under_curve(x, y, method = "step") area_under_curve(x, y, method = "spline") } \seealso{ DescTools } bayestestR/man/p_map.Rd0000644000176200001440000001116314357655465014563 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/p_map.R \name{p_map} \alias{p_map} \alias{p_pointnull} \alias{p_map.stanreg} \alias{p_map.brmsfit} \title{Bayesian p-value based on the density at the Maximum A Posteriori (MAP)} \usage{ p_map(x, null = 0, precision = 2^10, method = "kernel", ...) p_pointnull(x, null = 0, precision = 2^10, method = "kernel", ...) \method{p_map}{stanreg}( x, null = 0, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) \method{p_map}{brmsfit}( x, null = 0, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{null}{The value considered as a "null" effect. Traditionally 0, but could also be 1 in the case of ratios.} \item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.} \item{method}{Density estimation method. Can be \code{"kernel"} (default), \code{"logspline"} or \code{"KernSmooth"}.} \item{...}{Currently not used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ Compute a Bayesian equivalent of the \emph{p}-value, related to the odds that a parameter (described by its posterior distribution) has against the null hypothesis (\emph{h0}) using Mills' (2014, 2017) \emph{Objective Bayesian Hypothesis Testing} framework. It corresponds to the density value at the null (e.g., 0) divided by the density at the Maximum A Posteriori (MAP). } \details{ Note that this method is sensitive to the density estimation \code{method} (see the section in the examples below). \subsection{Strengths and Limitations}{ \strong{Strengths:} Straightforward computation. Objective property of the posterior distribution. \cr \cr \strong{Limitations:} Limited information favoring the null hypothesis. Relates on density approximation. Indirect relationship between mathematical definition and interpretation. Only suitable for weak / very diffused priors. } } \examples{ library(bayestestR) p_map(rnorm(1000, 0, 1)) p_map(rnorm(1000, 10, 1)) \dontrun{ library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) p_map(model) library(emmeans) p_map(emtrends(model, ~1, "wt")) library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) p_map(model) library(BayesFactor) bf <- ttestBF(x = rnorm(100, 1, 1)) p_map(bf) # --------------------------------------- # Robustness to density estimation method set.seed(333) data <- data.frame() for (iteration in 1:250) { x <- rnorm(1000, 1, 1) result <- data.frame( "Kernel" = p_map(x, method = "kernel"), "KernSmooth" = p_map(x, method = "KernSmooth"), "logspline" = p_map(x, method = "logspline") ) data <- rbind(data, result) } data$KernSmooth <- data$Kernel - data$KernSmooth data$logspline <- data$Kernel - data$logspline summary(data$KernSmooth) summary(data$logspline) boxplot(data[c("KernSmooth", "logspline")]) } } \references{ \itemize{ \item Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} \item Mills, J. A. (2018). Objective Bayesian Precise Hypothesis Testing. University of Cincinnati. } } \seealso{ \href{https://www.youtube.com/watch?v=Ip8Ci5KUVRc}{Jeff Mill's talk} } bayestestR/man/bayestestR-package.Rd0000644000176200001440000000504514357655465017207 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bayestestR-package.R \docType{package} \name{bayestestR-package} \alias{bayestestR-package} \alias{_PACKAGE} \alias{bayestestR} \title{bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework} \description{ Existing R packages allow users to easily fit a large variety of models and extract and visualize the posterior draws. However, most of these packages only return a limited set of indices (e.g., point-estimates and CIs). \strong{bayestestR} provides a comprehensive and consistent set of functions to analyze and describe posterior distributions generated by a variety of models objects, including popular modeling packages such as \strong{rstanarm}, \strong{brms} or \strong{BayesFactor}. References: \itemize{ \item Makowski et al. (2019) \doi{10.21105/joss.01541} \item Makowski et al. (2019) \doi{10.3389/fpsyg.2019.02767} } } \details{ \code{bayestestR} } \seealso{ Useful links: \itemize{ \item \url{https://easystats.github.io/bayestestR/} \item Report bugs at \url{https://github.com/easystats/bayestestR/issues} } } \author{ \strong{Maintainer}: Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) (@Dom_Makowski) Authors: \itemize{ \item Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) (@strengejacke) \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) (@mattansb) \item Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) (@patilindrajeets) \item Michael D. Wilson \email{michael.d.wilson@curtin.edu.au} (\href{https://orcid.org/0000-0003-4143-7308}{ORCID}) \item Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) (@bmwiernik) } Other contributors: \itemize{ \item Paul-Christian Bürkner \email{paul.buerkner@gmail.com} [reviewer] \item Tristan Mahr \email{tristan.mahr@wisc.edu} (\href{https://orcid.org/0000-0002-8890-5116}{ORCID}) [reviewer] \item Henrik Singmann \email{singmann@gmail.com} (\href{https://orcid.org/0000-0002-4842-3657}{ORCID}) [contributor] \item Quentin F. Gronau (\href{https://orcid.org/0000-0001-5510-6943}{ORCID}) [contributor] \item Sam Crawley \email{sam@crawley.nz} (\href{https://orcid.org/0000-0002-7847-0411}{ORCID}) [contributor] } } \keyword{internal} bayestestR/man/equivalence_test.Rd0000644000176200001440000001740314407021361017004 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/equivalence_test.R \name{equivalence_test} \alias{equivalence_test} \alias{equivalence_test.default} \alias{equivalence_test.data.frame} \alias{equivalence_test.stanreg} \alias{equivalence_test.brmsfit} \title{Test for Practical Equivalence} \usage{ equivalence_test(x, ...) \method{equivalence_test}{default}(x, ...) \method{equivalence_test}{data.frame}(x, range = "default", ci = 0.95, verbose = TRUE, ...) \method{equivalence_test}{stanreg}( x, range = "default", ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ... ) \method{equivalence_test}{brmsfit}( x, range = "default", ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution. Can also be a \code{stanreg} or \code{brmsfit} model.} \item{...}{Currently not used.} \item{range}{ROPE's lower and higher bounds. Should be \code{"default"} or depending on the number of outcome variables a vector or a list. In models with one response, \code{range} should be a vector of length two (e.g., \code{c(-0.1, 0.1)}). In multivariate models, \code{range} should be a list with a numeric vectors for each response variable. Vector names should correspond to the name of the response variables. If \code{"default"} and input is a vector, the range is set to \code{c(-0.1, 0.1)}. If \code{"default"} and input is a Bayesian model, \code{\link[=rope_range]{rope_range()}} is used.} \item{ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the HDI. \item \code{ROPE_low}, \code{ROPE_high} The limits of the ROPE. These values are identical for all parameters. \item \code{ROPE_Percentage} The proportion of the HDI that lies inside the ROPE. \item \code{ROPE_Equivalence} The "test result", as character. Either "rejected", "accepted" or "undecided". \item \code{HDI_low} , \code{HDI_high} The lower and upper HDI limits for the parameters. } } \description{ Perform a \strong{Test for Practical Equivalence} for Bayesian and frequentist models. } \details{ Documentation is accessible for: \itemize{ \item \href{https://easystats.github.io/bayestestR/reference/equivalence_test.html}{Bayesian models} \item \href{https://easystats.github.io/parameters/reference/equivalence_test.lm.html}{Frequentist models} } For Bayesian models, the \strong{Test for Practical Equivalence} is based on the \emph{"HDI+ROPE decision rule"} (\cite{Kruschke, 2014, 2018}) to check whether parameter values should be accepted or rejected against an explicitly formulated "null hypothesis" (i.e., a ROPE). In other words, it checks the percentage of the \verb{89\%} \link[=hdi]{HDI} that is the null region (the ROPE). If this percentage is sufficiently low, the null hypothesis is rejected. If this percentage is sufficiently high, the null hypothesis is accepted. Using the \link[=rope]{ROPE} and the \link[=hdi]{HDI}, \cite{Kruschke (2018)} suggests using the percentage of the \verb{95\%} (or \verb{89\%}, considered more stable) HDI that falls within the ROPE as a decision rule. If the HDI is completely outside the ROPE, the "null hypothesis" for this parameter is "rejected". If the ROPE completely covers the HDI, i.e., all most credible values of a parameter are inside the region of practical equivalence, the null hypothesis is accepted. Else, it’s undecided whether to accept or reject the null hypothesis. If the full ROPE is used (i.e., \verb{100\%} of the HDI), then the null hypothesis is rejected or accepted if the percentage of the posterior within the ROPE is smaller than to \verb{2.5\%} or greater than \verb{97.5\%}. Desirable results are low proportions inside the ROPE (the closer to zero the better). \cr \cr Some attention is required for finding suitable values for the ROPE limits (argument \code{range}). See 'Details' in \code{\link[=rope_range]{rope_range()}} for further information. \cr \cr \strong{Multicollinearity: Non-independent covariates} \cr \cr When parameters show strong correlations, i.e. when covariates are not independent, the joint parameter distributions may shift towards or away from the ROPE. In such cases, the test for practical equivalence may have inappropriate results. Collinearity invalidates ROPE and hypothesis testing based on univariate marginals, as the probabilities are conditional on independence. Most problematic are the results of the "undecided" parameters, which may either move further towards "rejection" or away from it (\cite{Kruschke 2014, 340f}). \cr \cr \code{equivalence_test()} performs a simple check for pairwise correlations between parameters, but as there can be collinearity between more than two variables, a first step to check the assumptions of this hypothesis testing is to look at different pair plots. An even more sophisticated check is the projection predictive variable selection (\cite{Piironen and Vehtari 2017}). } \note{ There is a \code{print()}-method with a \code{digits}-argument to control the amount of digits in the output, and there is a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} to visualize the results from the equivalence-test (for models only). } \examples{ library(bayestestR) equivalence_test(x = rnorm(1000, 0, 0.01), range = c(-0.1, 0.1)) equivalence_test(x = rnorm(1000, 0, 1), range = c(-0.1, 0.1)) equivalence_test(x = rnorm(1000, 1, 0.01), range = c(-0.1, 0.1)) equivalence_test(x = rnorm(1000, 1, 1), ci = c(.50, .99)) # print more digits test <- equivalence_test(x = rnorm(1000, 1, 1), ci = c(.50, .99)) print(test, digits = 4) \dontrun{ library(rstanarm) model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) equivalence_test(model) # plot result test <- equivalence_test(model) plot(test) library(emmeans) equivalence_test(emtrends(model, ~1, "wt")) library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) equivalence_test(model) library(BayesFactor) bf <- ttestBF(x = rnorm(100, 1, 1)) # equivalence_test(bf) } } \references{ \itemize{ \item Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304} \item Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press \item Piironen, J., & Vehtari, A. (2017). Comparison of Bayesian predictive methods for model selection. Statistics and Computing, 27(3), 711–735. \doi{10.1007/s11222-016-9649-y} } } bayestestR/man/simulate_simpson.Rd0000644000176200001440000000233314276606713017051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/simulate_simpson.R \name{simulate_simpson} \alias{simulate_simpson} \title{Simpson's paradox dataset simulation} \usage{ simulate_simpson( n = 100, r = 0.5, groups = 3, difference = 1, group_prefix = "G_" ) } \arguments{ \item{n}{The number of observations for each group to be generated (minimum 4).} \item{r}{A value or vector corresponding to the desired correlation coefficients.} \item{groups}{Number of groups (groups can be participants, clusters, anything).} \item{difference}{Difference between groups.} \item{group_prefix}{The prefix of the group name (e.g., "G_1", "G_2", "G_3", ...).} } \value{ A dataset. } \description{ Simpson's paradox, or the Yule-Simpson effect, is a phenomenon in probability and statistics, in which a trend appears in several different groups of data but disappears or reverses when these groups are combined. } \examples{ data <- simulate_simpson(n = 10, groups = 5, r = 0.5) if (require("ggplot2")) { ggplot(data, aes(x = V1, y = V2)) + geom_point(aes(color = Group)) + geom_smooth(aes(color = Group), method = "lm") + geom_smooth(method = "lm") } } bayestestR/man/contr.equalprior.Rd0000644000176200001440000001504714307033605016760 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/contr.equalprior.R \name{contr.equalprior} \alias{contr.equalprior} \alias{contr.bayes} \alias{contr.orthonorm} \alias{contr.equalprior_pairs} \alias{contr.equalprior_deviations} \title{Contrast Matrices for Equal Marginal Priors in Bayesian Estimation} \usage{ contr.equalprior(n, contrasts = TRUE, sparse = FALSE) contr.equalprior_pairs(n, contrasts = TRUE, sparse = FALSE) contr.equalprior_deviations(n, contrasts = TRUE, sparse = FALSE) } \arguments{ \item{n}{a vector of levels for a factor, or the number of levels.} \item{contrasts}{a logical indicating whether contrasts should be computed.} \item{sparse}{logical indicating if the result should be sparse (of class \code{\link[Matrix:dgCMatrix-class]{dgCMatrix}}), using package \href{https://CRAN.R-project.org/package=Matrix}{\pkg{Matrix}}.} } \value{ A \code{matrix} with n rows and k columns, with k=n-1 if contrasts is \code{TRUE} and k=n if contrasts is \code{FALSE}. } \description{ Build contrasts for factors with equal marginal priors on all levels. The 3 functions give the same orthogonal contrasts, but are scaled differently to allow different prior specifications (see 'Details'). Implementation from Singmann & Gronau's \href{https://github.com/bayesstuff/bfrms/}{\code{bfrms}}, following the description in Rouder, Morey, Speckman, & Province (2012, p. 363). } \details{ When using \code{\link[stats:contrast]{stats::contr.treatment}}, each dummy variable is the difference between each level and the reference level. While this is useful if setting different priors for each coefficient, it should not be used if one is trying to set a general prior for differences between means, as it (as well as \code{\link[stats:contrast]{stats::contr.sum}} and others) results in unequal marginal priors on the means the the difference between them. \if{html}{\out{
}}\preformatted{library(brms) data <- data.frame( group = factor(rep(LETTERS[1:4], each = 3)), y = rnorm(12) ) contrasts(data$group) # R's default contr.treatment #> B C D #> A 0 0 0 #> B 1 0 0 #> C 0 1 0 #> D 0 0 1 model_prior <- brm( y ~ group, data = data, sample_prior = "only", # Set the same priors on the 3 dummy variable # (Using an arbitrary scale) prior = set_prior("normal(0, 10)", coef = c("groupB", "groupC", "groupD")) ) est <- emmeans::emmeans(model_prior, pairwise ~ group) point_estimate(est, centr = "mean", disp = TRUE) #> Point Estimate #> #> Parameter | Mean | SD #> ------------------------- #> A | -0.01 | 6.35 #> B | -0.10 | 9.59 #> C | 0.11 | 9.55 #> D | -0.16 | 9.52 #> A - B | 0.10 | 9.94 #> A - C | -0.12 | 9.96 #> A - D | 0.15 | 9.87 #> B - C | -0.22 | 14.38 #> B - D | 0.05 | 14.14 #> C - D | 0.27 | 14.00 }\if{html}{\out{
}} We can see that the priors for means aren't all the same (\code{A} having a more narrow prior), and likewise for the pairwise differences (priors for differences from \code{A} are more narrow). The solution is to use one of the methods provided here, which \emph{do} result in marginally equal priors on means differences between them. Though this will obscure the interpretation of parameters, setting equal priors on means and differences is important for they are useful for specifying equal priors on all means in a factor and their differences correct estimation of Bayes factors for contrasts and order restrictions of multi-level factors (where \code{k>2}). See info on specifying correct priors for factors with more than 2 levels in \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}. \emph{\strong{NOTE:}} When setting priors on these dummy variables, always: \enumerate{ \item Use priors that are \strong{centered on 0}! Other location/centered priors are meaningless! \item Use \strong{identically-scaled priors} on all the dummy variables of a single factor! } \code{contr.equalprior} returns the original orthogonal-normal contrasts as described in Rouder, Morey, Speckman, & Province (2012, p. 363). Setting \code{contrasts = FALSE} returns the \eqn{I_{n} - \frac{1}{n}} matrix. \subsection{\code{contr.equalprior_pairs}}{ Useful for setting priors in terms of pairwise differences between means - the scales of the priors defines the prior distribution of the pair-wise differences between all pairwise differences (e.g., \code{A - B}, \code{B - C}, etc.). \if{html}{\out{
}}\preformatted{contrasts(data$group) <- contr.equalprior_pairs contrasts(data$group) #> [,1] [,2] [,3] #> A 0.0000000 0.6123724 0.0000000 #> B -0.1893048 -0.2041241 0.5454329 #> C -0.3777063 -0.2041241 -0.4366592 #> D 0.5670111 -0.2041241 -0.1087736 model_prior <- brm( y ~ group, data = data, sample_prior = "only", # Set the same priors on the 3 dummy variable # (Using an arbitrary scale) prior = set_prior("normal(0, 10)", coef = c("group1", "group2", "group3")) ) est <- emmeans(model_prior, pairwise ~ group) point_estimate(est, centr = "mean", disp = TRUE) #> Point Estimate #> #> Parameter | Mean | SD #> ------------------------- #> A | -0.31 | 7.46 #> B | -0.24 | 7.47 #> C | -0.34 | 7.50 #> D | -0.30 | 7.25 #> A - B | -0.08 | 10.00 #> A - C | 0.03 | 10.03 #> A - D | -0.01 | 9.85 #> B - C | 0.10 | 10.28 #> B - D | 0.06 | 9.94 #> C - D | -0.04 | 10.18 }\if{html}{\out{
}} All means have the same prior distribution, and the distribution of the differences matches the prior we set of \code{"normal(0, 10)"}. Success! } \subsection{\code{contr.equalprior_deviations}}{ Useful for setting priors in terms of the deviations of each mean from the grand mean - the scales of the priors defines the prior distribution of the distance (above, below) the mean of one of the levels might have from the overall mean. (See examples.) } } \examples{ contr.equalprior(2) # Q_2 in Rouder et al. (2012, p. 363) contr.equalprior(5) # equivalent to Q_5 in Rouder et al. (2012, p. 363) ## check decomposition Q3 <- contr.equalprior(3) Q3 \%*\% t(Q3) ## 2/3 on diagonal and -1/3 on off-diagonal elements } \references{ Rouder, J. N., Morey, R. D., Speckman, P. L., & Province, J. M. (2012). Default Bayes factors for ANOVA designs. \emph{Journal of Mathematical Psychology}, 56(5), 356-374. https://doi.org/10.1016/j.jmp.2012.08.001 } bayestestR/man/convert_bayesian_as_frequentist.Rd0000644000176200001440000000305714276606713022131 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/convert_bayesian_to_frequentist.R \name{convert_bayesian_as_frequentist} \alias{convert_bayesian_as_frequentist} \alias{bayesian_as_frequentist} \title{Convert (refit) a Bayesian model to frequentist} \usage{ convert_bayesian_as_frequentist(model, data = NULL, REML = TRUE) bayesian_as_frequentist(model, data = NULL, REML = TRUE) } \arguments{ \item{model}{A Bayesian model.} \item{data}{Data used by the model. If \code{NULL}, will try to extract it from the model.} \item{REML}{For mixed effects, should models be estimated using restricted maximum likelihood (REML) (\code{TRUE}, default) or maximum likelihood (\code{FALSE})?} } \description{ Refit Bayesian model as frequentist. Can be useful for comparisons. } \examples{ \donttest{ # Rstanarm ---------------------- if (require("rstanarm")) { # Simple regressions model <- stan_glm(Sepal.Length ~ Species, data = iris, chains = 2, refresh = 0 ) bayesian_as_frequentist(model) } } \dontrun{ if (require("rstanarm")) { model <- stan_glm(vs ~ mpg, family = "binomial", data = mtcars, chains = 2, refresh = 0 ) bayesian_as_frequentist(model) # Mixed models model <- stan_glmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris, chains = 2, refresh = 0 ) bayesian_as_frequentist(model) model <- stan_glmer(vs ~ mpg + (1 | cyl), family = "binomial", data = mtcars, chains = 2, refresh = 0 ) bayesian_as_frequentist(model) } } } bayestestR/man/as.data.frame.density.Rd0000644000176200001440000000061614276606712017541 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/estimate_density.R \name{as.data.frame.density} \alias{as.data.frame.density} \title{Coerce to a Data Frame} \usage{ \method{as.data.frame}{density}(x, ...) } \arguments{ \item{x}{any \R object.} \item{...}{additional arguments to be passed to or from methods.} } \description{ Coerce to a Data Frame } bayestestR/man/sexit.Rd0000644000176200001440000001763214307033605014607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sexit.R \name{sexit} \alias{sexit} \title{Sequential Effect eXistence and sIgnificance Testing (SEXIT)} \usage{ sexit(x, significant = "default", large = "default", ci = 0.95, ...) } \arguments{ \item{x}{Vector representing a posterior distribution. Can also be a Bayesian model (\code{stanreg}, \code{brmsfit} or \code{BayesFactor}).} \item{significant, large}{The threshold values to use for significant and large probabilities. If left to 'default', will be selected through \code{\link[=sexit_thresholds]{sexit_thresholds()}}. See the details section below.} \item{ci}{Value or vector of probability of the (credible) interval - CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{...}{Currently not used.} } \value{ A dataframe and text as attribute. } \description{ The SEXIT is a new framework to describe Bayesian effects, guiding which indices to use. Accordingly, the \code{sexit()} function returns the minimal (and optimal) required information to describe models' parameters under a Bayesian framework. It includes the following indices: \itemize{ \item{Centrality: the median of the posterior distribution. In probabilistic terms, there is \verb{50\%} of probability that the effect is higher and lower. See \code{\link[=point_estimate]{point_estimate()}}.} \item{Uncertainty: the \verb{95\%} Highest Density Interval (HDI). In probabilistic terms, there is \verb{95\%} of probability that the effect is within this confidence interval. See \code{\link[=ci]{ci()}}.} \item{Existence: The probability of direction allows to quantify the certainty by which an effect is positive or negative. It is a critical index to show that an effect of some manipulation is not harmful (for instance in clinical studies) or to assess the direction of a link. See \code{\link[=p_direction]{p_direction()}}.} \item{Significance: Once existence is demonstrated with high certainty, we can assess whether the effect is of sufficient size to be considered as significant (i.e., not negligible). This is a useful index to determine which effects are actually important and worthy of discussion in a given process. See \code{\link[=p_significance]{p_significance()}}.} \item{Size: Finally, this index gives an idea about the strength of an effect. However, beware, as studies have shown that a big effect size can be also suggestive of low statistical power (see details section).} } } \details{ \subsection{Rationale}{ The assessment of "significance" (in its broadest meaning) is a pervasive issue in science, and its historical index, the p-value, has been strongly criticized and deemed to have played an important role in the replicability crisis. In reaction, more and more scientists have tuned to Bayesian methods, offering an alternative set of tools to answer their questions. However, the Bayesian framework offers a wide variety of possible indices related to "significance", and the debate has been raging about which index is the best, and which one to report. This situation can lead to the mindless reporting of all possible indices (with the hopes that with that the reader will be satisfied), but often without having the writer understanding and interpreting them. It is indeed complicated to juggle between many indices with complicated definitions and subtle differences. SEXIT aims at offering a practical framework for Bayesian effects reporting, in which the focus is put on intuitiveness, explicitness and usefulness of the indices' interpretation. To that end, we suggest a system of description of parameters that would be intuitive, easy to learn and apply, mathematically accurate and useful for taking decision. Once the thresholds for significance (i.e., the ROPE) and the one for a "large" effect are explicitly defined, the SEXIT framework does not make any interpretation, i.e., it does not label the effects, but just sequentially gives 3 probabilities (of direction, of significance and of being large, respectively) as-is on top of the characteristics of the posterior (using the median and HDI for centrality and uncertainty description). Thus, it provides a lot of information about the posterior distribution (through the mass of different 'sections' of the posterior) in a clear and meaningful way. } \subsection{Threshold selection}{ One of the most important thing about the SEXIT framework is that it relies on two "arbitrary" thresholds (i.e., that have no absolute meaning). They are the ones related to effect size (an inherently subjective notion), namely the thresholds for significant and large effects. They are set, by default, to \code{0.05} and \code{0.3} of the standard deviation of the outcome variable (tiny and large effect sizes for correlations according to Funder and Ozer, 2019). However, these defaults were chosen by lack of a better option, and might not be adapted to your case. Thus, they are to be handled with care, and the chosen thresholds should always be explicitly reported and justified. \itemize{ \item For \strong{linear models (lm)}, this can be generalised to \ifelse{html}{\out{0.05 * SDy}}{\eqn{[0.05*SD_{y}]}} and \ifelse{html}{\out{0.3 * SDy}}{\eqn{[0.3*SD_{y}]}} for significant and large effects, respectively. \item For \strong{logistic models}, the parameters expressed in log odds ratio can be converted to standardized difference through the formula \ifelse{html}{\out{π/√(3)}}{\eqn{\pi/\sqrt{3}}}, resulting a threshold of \code{0.09} and \code{0.54}. \item For other models with \strong{binary outcome}, it is strongly recommended to manually specify the rope argument. Currently, the same default is applied that for logistic models. \item For models from \strong{count data}, the residual variance is used. This is a rather experimental threshold and is probably often similar to \code{0.05} and \code{0.3}, but should be used with care! \item For \strong{t-tests}, the standard deviation of the response is used, similarly to linear models (see above). \item For \strong{correlations},\code{0.05} and \code{0.3} are used. \item For all other models, \code{0.05} and \code{0.3} are used, but it is strongly advised to specify it manually. } } \subsection{Examples}{ The three values for existence, significance and size provide a useful description of the posterior distribution of the effects. Some possible scenarios include: \itemize{ \item{The probability of existence is low, but the probability of being large is high: it suggests that the posterior is very wide (covering large territories on both side of 0). The statistical power might be too low, which should warrant any confident conclusion.} \item{The probability of existence and significance is high, but the probability of being large is very small: it suggests that the effect is, with high confidence, not large (the posterior is mostly contained between the significance and the large thresholds).} \item{The 3 indices are very low: this suggests that the effect is null with high confidence (the posterior is closely centred around 0).}}} } \examples{ \dontrun{ library(bayestestR) s <- sexit(rnorm(1000, -1, 1)) s print(s, summary = TRUE) s <- sexit(iris) s print(s, summary = TRUE) if (require("rstanarm")) { model <- rstanarm::stan_glm(mpg ~ wt * cyl, data = mtcars, iter = 400, refresh = 0 ) s <- sexit(model) s print(s, summary = TRUE) } } } \references{ \itemize{ \item{Makowski, D., Ben-Shachar, M. S., & Lüdecke, D. (2019). bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework. Journal of Open Source Software, 4(40), 1541. \doi{10.21105/joss.01541}} \item{Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767}} } } bayestestR/man/cwi.Rd0000644000176200001440000000713014407021361014222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cwi.R \name{cwi} \alias{cwi} \alias{cwi.data.frame} \title{Curvewise Intervals (CWI)} \usage{ cwi(x, ...) \method{cwi}{data.frame}(x, ci = 0.95, ...) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Currently not used.} \item{ci}{Value or vector of probability of the (credible) interval - CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the credible interval. \item \code{CI_low}, \code{CI_high} The lower and upper credible interval limits for the parameters. } } \description{ Compute the \strong{Curvewise interval (CWI)} (also called the "simultaneous interval" or "joint interval") of posterior distributions using \code{ggdist::curve_interval()}. Whereas the more typical "pointwise intervals" contain xx\% of the posterior for a single parameter, joint/curvewise intervals contain xx\% of the posterior distribution for \strong{all} parameters. } \details{ Applied model predictions, pointwise intervals contain xx\% of the predicted response values \strong{conditional} on specific predictor values. In contrast, curvewise intervals contain xx\% of the predicted response values across all predictor values. Put another way, curvewise intervals contain xx\% of the full \strong{prediction lines} from the model. For more details, see the \href{https://mjskay.github.io/ggdist/articles/lineribbon.html#curve-boxplots-aka-lineribbons-with-joint-intervals-or-curvewise-intervals-}{\emph{ggdist} documentation on curvewise intervals}. } \examples{ \donttest{ library(bayestestR) if (require("ggplot2") && require("rstanarm") && require("ggdist")) { # Generate data ============================================= k <- 11 # number of curves (iterations) n <- 201 # number of rows data <- data.frame(x = seq(-15, 15, length.out = n)) # Simulate iterations as new columns for (i in 1:k) { data[paste0("iter_", i)] <- dnorm(data$x, seq(-5, 5, length.out = k)[i], 3) } # Note: first, we need to transpose the data to have iters as rows iters <- datawizard::data_transpose(data[paste0("iter_", 1:k)]) # Compute Median data$Median <- point_estimate(iters)[["Median"]] # Compute Credible Intervals ================================ # Compute ETI (default type of CI) data[c("ETI_low", "ETI_high")] <- eti(iters, ci = 0.5)[c("CI_low", "CI_high")] # Compute CWI # ggdist::curve_interval(reshape_iterations(data), iter_value .width = 0.5) # Visualization ============================================= ggplot(data, aes(x = x, y = Median)) + geom_ribbon(aes(ymin = ETI_low, ymax = ETI_high), fill = "red", alpha = 0.3) + geom_line(linewidth = 1) + geom_line( data = reshape_iterations(data), aes(y = iter_value, group = iter_group), alpha = 0.3 ) } } } \seealso{ Other ci: \code{\link{bci}()}, \code{\link{ci}()}, \code{\link{eti}()}, \code{\link{hdi}()}, \code{\link{si}()}, \code{\link{spi}()} } \concept{ci} bayestestR/man/si.Rd0000644000176200001440000002052214407021361014053 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/si.R \name{si} \alias{si} \alias{si.numeric} \alias{si.stanreg} \alias{si.brmsfit} \alias{si.blavaan} \alias{si.emmGrid} \alias{si.data.frame} \title{Compute Support Intervals} \usage{ si(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) \method{si}{numeric}(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) \method{si}{stanreg}( posterior, prior = NULL, BF = 1, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary", "distributional"), parameters = NULL, ... ) \method{si}{brmsfit}( posterior, prior = NULL, BF = 1, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary", "distributional"), parameters = NULL, ... ) \method{si}{blavaan}( posterior, prior = NULL, BF = 1, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary", "distributional"), parameters = NULL, ... ) \method{si}{emmGrid}(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) \method{si}{data.frame}(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) } \arguments{ \item{posterior}{A numerical vector, \code{stanreg} / \code{brmsfit} object, \code{emmGrid} or a data frame - representing a posterior distribution(s) from (see 'Details').} \item{prior}{An object representing a prior distribution (see 'Details').} \item{BF}{The amount of support required to be included in the support interval.} \item{verbose}{Toggle off warnings.} \item{...}{Arguments passed to and from other methods. (Can be used to pass arguments to internal \code{\link[logspline:logspline]{logspline::logspline()}}.)} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A data frame containing the lower and upper bounds of the SI. \cr Note that if the level of requested support is higher than observed in the data, the interval will be \verb{[NA,NA]}. } \description{ A support interval contains only the values of the parameter that predict the observed data better than average, by some degree \emph{k}; these are values of the parameter that are associated with an updating factor greater or equal than \emph{k}. From the perspective of the Savage-Dickey Bayes factor, testing against a point null hypothesis for any value within the support interval will yield a Bayes factor smaller than \emph{1/k}. \cr \cr \strong{For more info, in particular on specifying correct priors for factors with more than 2 levels, see \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}.} } \details{ This method is used to compute support intervals based on prior and posterior distributions. For the computation of support intervals, the model priors must be proper priors (at the very least they should be \emph{not flat}, and it is preferable that they be \emph{informative} - note that by default, \code{brms::brm()} uses flat priors for fixed-effects; see example below). \subsection{Choosing a value of \code{BF}}{ The choice of \code{BF} (the level of support) depends on what we want our interval to represent: \itemize{ \item A \code{BF} = 1 contains values whose credibility is not decreased by observing the data. \item A \code{BF} > 1 contains values who received more impressive support from the data. \item A \code{BF} < 1 contains values whose credibility has \emph{not} been impressively decreased by observing the data. Testing against values outside this interval will produce a Bayes factor larger than 1/\code{BF} in support of the alternative. E.g., if an SI (BF = 1/3) excludes 0, the Bayes factor against the point-null will be larger than 3. } } } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \section{Setting the correct \code{prior}}{ For the computation of Bayes factors, the model priors must be proper priors (at the very least they should be \emph{not flat}, and it is preferable that they be \emph{informative}); As the priors for the alternative get wider, the likelihood of the null value(s) increases, to the extreme that for completely flat priors the null is infinitely more favorable than the alternative (this is called \emph{the Jeffreys-Lindley-Bartlett paradox}). Thus, you should only ever try (or want) to compute a Bayes factor when you have an informed prior. \cr\cr (Note that by default, \code{brms::brm()} uses flat priors for fixed-effects; See example below.) \cr\cr It is important to provide the correct \code{prior} for meaningful results. \itemize{ \item When \code{posterior} is a numerical vector, \code{prior} should also be a numerical vector. \item When \code{posterior} is a \code{data.frame}, \code{prior} should also be a \code{data.frame}, with matching column order. \item When \code{posterior} is a \code{stanreg}, \code{brmsfit} or other supported Bayesian model: \itemize{ \item \code{prior} can be set to \code{NULL}, in which case prior samples are drawn internally. \item \code{prior} can also be a model equivalent to \code{posterior} but with samples from the priors \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \strong{Note:} When \code{posterior} is a \code{brmsfit_multiple} model, \code{prior} \strong{must} be provided. } \item When \code{posterior} is an \code{emmGrid} / \code{emm_list} object: \itemize{ \item \code{prior} should also be an \code{emmGrid} / \code{emm_list} object equivalent to \code{posterior} but created with a model of priors samples \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \code{prior} can also be the original (posterior) \emph{model}. If so, the function will try to update the \code{emmGrid} / \code{emm_list} to use the \code{\link[=unupdate]{unupdate()}}d prior-model. (\emph{This cannot be done for \code{brmsfit} models.}) \item \strong{Note}: When the \code{emmGrid} has undergone any transformations (\code{"log"}, \code{"response"}, etc.), or \code{regrid}ing, then \code{prior} must be an \code{emmGrid} object, as stated above. } } } \examples{ \dontshow{if (requireNamespace("logspline", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(bayestestR) prior <- distribution_normal(1000, mean = 0, sd = 1) posterior <- distribution_normal(1000, mean = .5, sd = .3) si(posterior, prior) \dontrun{ # rstanarm models # --------------- library(rstanarm) contrasts(sleep$group) <- contr.equalprior_pairs # see vignette stan_model <- stan_lmer(extra ~ group + (1 | ID), data = sleep) si(stan_model) si(stan_model, BF = 3) # emmGrid objects # --------------- library(emmeans) group_diff <- pairs(emmeans(stan_model, ~group)) si(group_diff, prior = stan_model) # brms models # ----------- library(brms) contrasts(sleep$group) <- contr.equalprior_pairs # see vingette my_custom_priors <- set_prior("student_t(3, 0, 1)", class = "b") + set_prior("student_t(3, 0, 1)", class = "sd", group = "ID") brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID), data = sleep, prior = my_custom_priors, refresh = 0 )) si(brms_model) } \dontshow{\}) # examplesIf} } \references{ Wagenmakers, E., Gronau, Q. F., Dablander, F., & Etz, A. (2018, November 22). The Support Interval. \doi{10.31234/osf.io/zwnxb} } \seealso{ Other ci: \code{\link{bci}()}, \code{\link{ci}()}, \code{\link{cwi}()}, \code{\link{eti}()}, \code{\link{hdi}()}, \code{\link{spi}()} } \concept{ci} bayestestR/man/weighted_posteriors.Rd0000644000176200001440000001443614357655465017566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/weighted_posteriors.R \name{weighted_posteriors} \alias{weighted_posteriors} \alias{weighted_posteriors.data.frame} \alias{weighted_posteriors.stanreg} \alias{weighted_posteriors.brmsfit} \alias{weighted_posteriors.blavaan} \alias{weighted_posteriors.BFBayesFactor} \title{Generate posterior distributions weighted across models} \usage{ weighted_posteriors(..., prior_odds = NULL, missing = 0, verbose = TRUE) \method{weighted_posteriors}{data.frame}(..., prior_odds = NULL, missing = 0, verbose = TRUE) \method{weighted_posteriors}{stanreg}( ..., prior_odds = NULL, missing = 0, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL ) \method{weighted_posteriors}{brmsfit}( ..., prior_odds = NULL, missing = 0, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL ) \method{weighted_posteriors}{blavaan}( ..., prior_odds = NULL, missing = 0, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL ) \method{weighted_posteriors}{BFBayesFactor}( ..., prior_odds = NULL, missing = 0, verbose = TRUE, iterations = 4000 ) } \arguments{ \item{...}{Fitted models (see details), all fit on the same data, or a single \code{BFBayesFactor} object.} \item{prior_odds}{Optional vector of prior odds for the models compared to the first model (or the denominator, for \code{BFBayesFactor} objects). For \code{data.frame}s, this will be used as the basis of weighting.} \item{missing}{An optional numeric value to use if a model does not contain a parameter that appears in other models. Defaults to 0.} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} \item{iterations}{For \code{BayesFactor} models, how many posterior samples to draw.} } \value{ A data frame with posterior distributions (weighted across models) . } \description{ Extract posterior samples of parameters, weighted across models. Weighting is done by comparing posterior model probabilities, via \code{\link[=bayesfactor_models]{bayesfactor_models()}}. } \details{ Note that across models some parameters might play different roles. For example, the parameter \code{A} plays a different role in the model \code{Y ~ A + B} (where it is a main effect) than it does in the model \code{Y ~ A + B + A:B} (where it is a simple effect). In many cases centering of predictors (mean subtracting for continuous variables, and effects coding via \code{contr.sum} or orthonormal coding via \code{\link{contr.equalprior_pairs}} for factors) can reduce this issue. In any case you should be mindful of this issue. \cr\cr See \code{\link[=bayesfactor_models]{bayesfactor_models()}} details for more info on passed models. \cr\cr Note that for \code{BayesFactor} models, posterior samples cannot be generated from intercept only models. \cr\cr This function is similar in function to \code{brms::posterior_average}. } \note{ For \verb{BayesFactor < 0.9.12-4.3}, in some instances there might be some problems of duplicate columns of random effects in the resulting data frame. } \examples{ \donttest{ if (require("rstanarm") && require("see")) { stan_m0 <- stan_glm(extra ~ 1, data = sleep, family = gaussian(), refresh = 0, diagnostic_file = file.path(tempdir(), "df0.csv") ) stan_m1 <- stan_glm(extra ~ group, data = sleep, family = gaussian(), refresh = 0, diagnostic_file = file.path(tempdir(), "df1.csv") ) res <- weighted_posteriors(stan_m0, stan_m1) plot(eti(res)) } ## With BayesFactor if (require("BayesFactor")) { extra_sleep <- ttestBF(formula = extra ~ group, data = sleep) wp <- weighted_posteriors(extra_sleep) describe_posterior(extra_sleep, test = NULL) describe_posterior(wp$delta, test = NULL) # also considers the null } ## weighted prediction distributions via data.frames if (require("rstanarm")) { m0 <- stan_glm( mpg ~ 1, data = mtcars, family = gaussian(), diagnostic_file = file.path(tempdir(), "df0.csv"), refresh = 0 ) m1 <- stan_glm( mpg ~ carb, data = mtcars, family = gaussian(), diagnostic_file = file.path(tempdir(), "df1.csv"), refresh = 0 ) # Predictions: pred_m0 <- data.frame(posterior_predict(m0)) pred_m1 <- data.frame(posterior_predict(m1)) BFmods <- bayesfactor_models(m0, m1) wp <- weighted_posteriors(pred_m0, pred_m1, prior_odds = as.numeric(BFmods)[2] ) # look at first 5 prediction intervals hdi(pred_m0[1:5]) hdi(pred_m1[1:5]) hdi(wp[1:5]) # between, but closer to pred_m1 } } } \references{ \itemize{ \item Clyde, M., Desimone, H., & Parmigiani, G. (1996). Prediction via orthogonalized model mixing. Journal of the American Statistical Association, 91(435), 1197-1208. \item Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25). A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64} \item Rouder, J. N., Haaf, J. M., & Vandekerckhove, J. (2018). Bayesian inference for psychology, part IV: Parameter estimation and Bayes factors. Psychonomic bulletin & review, 25(1), 102-113. \item van den Bergh, D., Haaf, J. M., Ly, A., Rouder, J. N., & Wagenmakers, E. J. (2019). A cautionary note on estimating effect size. } } \seealso{ \code{\link[=bayesfactor_inclusion]{bayesfactor_inclusion()}} for Bayesian model averaging. } bayestestR/man/distribution.Rd0000644000176200001440000000707514307034413016170 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/distribution.R \name{distribution} \alias{distribution} \alias{distribution_custom} \alias{distribution_beta} \alias{distribution_binomial} \alias{distribution_binom} \alias{distribution_cauchy} \alias{distribution_chisquared} \alias{distribution_chisq} \alias{distribution_gamma} \alias{distribution_mixture_normal} \alias{distribution_normal} \alias{distribution_gaussian} \alias{distribution_nbinom} \alias{distribution_poisson} \alias{distribution_student} \alias{distribution_t} \alias{distribution_student_t} \alias{distribution_tweedie} \alias{distribution_uniform} \alias{rnorm_perfect} \title{Empirical Distributions} \usage{ distribution(type = "normal", ...) distribution_custom(n, type = "norm", ..., random = FALSE) distribution_beta(n, shape1, shape2, ncp = 0, random = FALSE, ...) distribution_binomial(n, size = 1, prob = 0.5, random = FALSE, ...) distribution_binom(n, size = 1, prob = 0.5, random = FALSE, ...) distribution_cauchy(n, location = 0, scale = 1, random = FALSE, ...) distribution_chisquared(n, df, ncp = 0, random = FALSE, ...) distribution_chisq(n, df, ncp = 0, random = FALSE, ...) distribution_gamma(n, shape, scale = 1, random = FALSE, ...) distribution_mixture_normal(n, mean = c(-3, 3), sd = 1, random = FALSE, ...) distribution_normal(n, mean = 0, sd = 1, random = FALSE, ...) distribution_gaussian(n, mean = 0, sd = 1, random = FALSE, ...) distribution_nbinom(n, size, prob, mu, phi, random = FALSE, ...) distribution_poisson(n, lambda = 1, random = FALSE, ...) distribution_student(n, df, ncp, random = FALSE, ...) distribution_t(n, df, ncp, random = FALSE, ...) distribution_student_t(n, df, ncp, random = FALSE, ...) distribution_tweedie(n, xi = NULL, mu, phi, power = NULL, random = FALSE, ...) distribution_uniform(n, min = 0, max = 1, random = FALSE, ...) rnorm_perfect(n, mean = 0, sd = 1) } \arguments{ \item{type}{Can be any of the names from base R's \link[stats:Distributions]{Distributions}, like \code{"cauchy"}, \code{"pois"} or \code{"beta"}.} \item{...}{Arguments passed to or from other methods.} \item{n}{the number of observations} \item{random}{Generate near-perfect or random (simple wrappers for the base R \verb{r*} functions) distributions.} \item{shape1, shape2}{non-negative parameters of the Beta distribution.} \item{ncp}{non-centrality parameter.} \item{size}{number of trials (zero or more).} \item{prob}{probability of success on each trial.} \item{location, scale}{location and scale parameters.} \item{df}{degrees of freedom (non-negative, but can be non-integer).} \item{shape}{Shape parameter.} \item{mean}{vector of means.} \item{sd}{vector of standard deviations.} \item{mu}{the mean} \item{phi}{Corresponding to \code{glmmTMB}'s implementation of nbinom distribution, where \code{size=mu/phi}.} \item{lambda}{vector of (non-negative) means.} \item{xi}{For tweedie distributions, the value of \code{xi} such that the variance is \code{var(Y) = phi * mu^xi}.} \item{power}{Alias for \code{xi}.} \item{min, max}{lower and upper limits of the distribution. Must be finite.} } \description{ Generate a sequence of n-quantiles, i.e., a sample of size \code{n} with a near-perfect distribution. } \details{ When \code{random = FALSE}, these function return \verb{q*(ppoints(n), ...)}. } \examples{ library(bayestestR) x <- distribution(n = 10) plot(density(x)) x <- distribution(type = "gamma", n = 100, shape = 2) plot(density(x)) } bayestestR/man/describe_posterior.Rd0000644000176200001440000001703314407021361017331 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/describe_posterior.R \name{describe_posterior} \alias{describe_posterior} \alias{describe_posterior.numeric} \alias{describe_posterior.stanreg} \alias{describe_posterior.brmsfit} \title{Describe Posterior Distributions} \usage{ describe_posterior(posteriors, ...) \method{describe_posterior}{numeric}( posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, BF = 1, ... ) \method{describe_posterior}{stanreg}( posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, diagnostic = c("ESS", "Rhat"), priors = FALSE, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, BF = 1, ... ) \method{describe_posterior}{brmsfit}( posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, diagnostic = c("ESS", "Rhat"), effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all", "location", "distributional", "auxiliary"), parameters = NULL, BF = 1, priors = FALSE, ... ) } \arguments{ \item{posteriors}{A vector, data frame or model of posterior draws. \strong{bayestestR} supports a wide range of models (see \code{methods("describe_posterior")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} method.} \item{...}{Additional arguments to be passed to or from methods.} \item{centrality}{The point-estimates (centrality indices) to compute. Character (vector) or list with one or more of these options: \code{"median"}, \code{"mean"}, \code{"MAP"} or \code{"all"}.} \item{dispersion}{Logical, if \code{TRUE}, computes indices of dispersion related to the estimate(s) (\code{SD} and \code{MAD} for \code{mean} and \code{median}, respectively).} \item{ci}{Value or vector of probability of the CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{ci_method}{The type of index used for Credible Interval. Can be \code{"ETI"} (default, see \code{\link[=eti]{eti()}}), \code{"HDI"} (see \code{\link[=hdi]{hdi()}}), \code{"BCI"} (see \code{\link[=bci]{bci()}}), \code{"SPI"} (see \code{\link[=spi]{spi()}}), or \code{"SI"} (see \code{\link[=si]{si()}}).} \item{test}{The indices of effect existence to compute. Character (vector) or list with one or more of these options: \code{"p_direction"} (or \code{"pd"}), \code{"rope"}, \code{"p_map"}, \code{"equivalence_test"} (or \code{"equitest"}), \code{"bayesfactor"} (or \code{"bf"}) or \code{"all"} to compute all tests. For each "test", the corresponding \pkg{bayestestR} function is called (e.g. \code{\link[=rope]{rope()}} or \code{\link[=p_direction]{p_direction()}}) and its results included in the summary output.} \item{rope_range}{ROPE's lower and higher bounds. Should be a list of two values (e.g., \code{c(-0.1, 0.1)}) or \code{"default"}. If \code{"default"}, the bounds are set to \code{x +- 0.1*SD(response)}.} \item{rope_ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} \item{keep_iterations}{If \code{TRUE}, will keep all iterations (draws) of bootstrapped or Bayesian models. They will be added as additional columns named \verb{iter_1, iter_2, ...}. You can reshape them to a long format by running \code{\link[=reshape_iterations]{reshape_iterations()}}.} \item{bf_prior}{Distribution representing a prior for the computation of Bayes factors / SI. Used if the input is a posterior, otherwise (in the case of models) ignored.} \item{BF}{The amount of support required to be included in the support interval.} \item{diagnostic}{Diagnostic metrics to compute. Character (vector) or list with one or more of these options: \code{"ESS"}, \code{"Rhat"}, \code{"MCSE"} or \code{"all"}.} \item{priors}{Add the prior used for each parameter.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ Compute indices relevant to describe and characterize the posterior distributions. } \details{ One or more components of point estimates (like posterior mean or median), intervals and tests can be omitted from the summary output by setting the related argument to \code{NULL}. For example, \code{test = NULL} and \code{centrality = NULL} would only return the HDI (or CI). } \examples{ library(bayestestR) if (require("logspline")) { x <- rnorm(1000) describe_posterior(x, verbose = FALSE) describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", verbose = FALSE ) describe_posterior(x, ci = c(0.80, 0.90), verbose = FALSE) df <- data.frame(replicate(4, rnorm(100))) describe_posterior(df, verbose = FALSE) describe_posterior( df, centrality = "all", dispersion = TRUE, test = "all", verbose = FALSE ) describe_posterior(df, ci = c(0.80, 0.90), verbose = FALSE) df <- data.frame(replicate(4, rnorm(20))) head(reshape_iterations( describe_posterior(df, keep_iterations = TRUE, verbose = FALSE) )) } \dontrun{ # rstanarm models # ----------------------------------------------- if (require("rstanarm") && require("emmeans")) { model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) describe_posterior(model) describe_posterior(model, centrality = "all", dispersion = TRUE, test = "all") describe_posterior(model, ci = c(0.80, 0.90)) # emmeans estimates # ----------------------------------------------- describe_posterior(emtrends(model, ~1, "wt")) } # BayesFactor objects # ----------------------------------------------- if (require("BayesFactor")) { bf <- ttestBF(x = rnorm(100, 1, 1)) describe_posterior(bf) describe_posterior(bf, centrality = "all", dispersion = TRUE, test = "all") describe_posterior(bf, ci = c(0.80, 0.90)) } } } \references{ \itemize{ \item Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). \emph{Indices of Effect Existence and Significance in the Bayesian Framework}. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} \item \href{https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html}{Region of Practical Equivalence (ROPE)} \item \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{Bayes factors} } } bayestestR/man/mediation.Rd0000644000176200001440000001375614357655465015452 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mediation.R \name{mediation} \alias{mediation} \alias{mediation.brmsfit} \alias{mediation.stanmvreg} \title{Summary of Bayesian multivariate-response mediation-models} \usage{ mediation(model, ...) \method{mediation}{brmsfit}( model, treatment, mediator, response = NULL, centrality = "median", ci = 0.95, method = "ETI", ... ) \method{mediation}{stanmvreg}( model, treatment, mediator, response = NULL, centrality = "median", ci = 0.95, method = "ETI", ... ) } \arguments{ \item{model}{A \code{brmsfit} or \code{stanmvreg} object.} \item{...}{Not used.} \item{treatment}{Character, name of the treatment variable (or direct effect) in a (multivariate response) mediator-model. If missing, \code{mediation()} tries to find the treatment variable automatically, however, this may fail.} \item{mediator}{Character, name of the mediator variable in a (multivariate response) mediator-model. If missing, \code{mediation()} tries to find the treatment variable automatically, however, this may fail.} \item{response}{A named character vector, indicating the names of the response variables to be used for the mediation analysis. Usually can be \code{NULL}, in which case these variables are retrieved automatically. If not \code{NULL}, names should match the names of the model formulas, \code{names(insight::find_response(model, combine = TRUE))}. This can be useful if, for instance, the mediator variable used as predictor has a different name from the mediator variable used as response. This might occur when the mediator is transformed in one model, but used "as is" as response variable in the other model. Example: The mediator \code{m} is used as response variable, but the centered version \code{m_center} is used as mediator variable. The second response variable (for the treatment model, with the mediator as additional predictor), \code{y}, is not transformed. Then we could use \code{response} like this: \code{mediation(model, response = c(m = "m_center", y = "y"))}.} \item{centrality}{The point-estimates (centrality indices) to compute. Character (vector) or list with one or more of these options: \code{"median"}, \code{"mean"}, \code{"MAP"} or \code{"all"}.} \item{ci}{Value or vector of probability of the CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{method}{Can be \link[=eti]{'ETI'} (default), \link[=hdi]{'HDI'}, \link[=bci]{'BCI'}, \link[=spi]{'SPI'} or \link[=si]{'SI'}.} } \value{ A data frame with direct, indirect, mediator and total effect of a multivariate-response mediation-model, as well as the proportion mediated. The effect sizes are median values of the posterior samples (use \code{centrality} for other centrality indices). } \description{ \code{mediation()} is a short summary for multivariate-response mediation-models, i.e. this function computes average direct and average causal mediation effects of multivariate response models. } \details{ \code{mediation()} returns a data frame with information on the \emph{direct effect} (mean value of posterior samples from \code{treatment} of the outcome model), \emph{mediator effect} (mean value of posterior samples from \code{mediator} of the outcome model), \emph{indirect effect} (mean value of the multiplication of the posterior samples from \code{mediator} of the outcome model and the posterior samples from \code{treatment} of the mediation model) and the total effect (mean value of sums of posterior samples used for the direct and indirect effect). The \emph{proportion mediated} is the indirect effect divided by the total effect. \cr \cr For all values, the \verb{89\%} credible intervals are calculated by default. Use \code{ci} to calculate a different interval. \cr \cr The arguments \code{treatment} and \code{mediator} do not necessarily need to be specified. If missing, \code{mediation()} tries to find the treatment and mediator variable automatically. If this does not work, specify these variables. \cr \cr The direct effect is also called \emph{average direct effect} (ADE), the indirect effect is also called \emph{average causal mediation effects} (ACME). See also \cite{Tingley et al. 2014} and \cite{Imai et al. 2010}. } \note{ There is an \code{as.data.frame()} method that returns the posterior samples of the effects, which can be used for further processing in the different \pkg{bayestestR} package. } \examples{ \dontrun{ library(mediation) library(brms) library(rstanarm) # load sample data data(jobs) set.seed(123) # linear models, for mediation analysis b1 <- lm(job_seek ~ treat + econ_hard + sex + age, data = jobs) b2 <- lm(depress2 ~ treat + job_seek + econ_hard + sex + age, data = jobs) # mediation analysis, for comparison with Stan models m1 <- mediate(b1, b2, sims = 1000, treat = "treat", mediator = "job_seek") # Fit Bayesian mediation model in brms f1 <- bf(job_seek ~ treat + econ_hard + sex + age) f2 <- bf(depress2 ~ treat + job_seek + econ_hard + sex + age) m2 <- brm(f1 + f2 + set_rescor(FALSE), data = jobs, cores = 4, refresh = 0) # Fit Bayesian mediation model in rstanarm m3 <- stan_mvmer( list( job_seek ~ treat + econ_hard + sex + age + (1 | occp), depress2 ~ treat + job_seek + econ_hard + sex + age + (1 | occp) ), data = jobs, cores = 4, refresh = 0 ) summary(m1) mediation(m2, centrality = "mean", ci = 0.95) mediation(m3, centrality = "mean", ci = 0.95) } } \references{ \itemize{ \item Imai, K., Keele, L. and Tingley, D. (2010) A General Approach to Causal Mediation Analysis, Psychological Methods, Vol. 15, No. 4 (December), pp. 309-334. \item Tingley, D., Yamamoto, T., Hirose, K., Imai, K. and Keele, L. (2014). mediation: R package for Causal Mediation Analysis, Journal of Statistical Software, Vol. 59, No. 5, pp. 1-38. } } \seealso{ The \pkg{mediation} package for a causal mediation analysis in the frequentist framework. } bayestestR/man/hdi.Rd0000644000176200001440000001662614407021361014216 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hdi.R \name{hdi} \alias{hdi} \alias{hdi.numeric} \alias{hdi.data.frame} \alias{hdi.stanreg} \alias{hdi.brmsfit} \title{Highest Density Interval (HDI)} \usage{ hdi(x, ...) \method{hdi}{numeric}(x, ci = 0.95, verbose = TRUE, ...) \method{hdi}{data.frame}(x, ci = 0.95, verbose = TRUE, ...) \method{hdi}{stanreg}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ... ) \method{hdi}{brmsfit}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Currently not used.} \item{ci}{Value or vector of probability of the (credible) interval - CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the credible interval. \item \code{CI_low}, \code{CI_high} The lower and upper credible interval limits for the parameters. } } \description{ Compute the \strong{Highest Density Interval (HDI)} of posterior distributions. All points within this interval have a higher probability density than points outside the interval. The HDI can be used in the context of uncertainty characterisation of posterior distributions as \strong{Credible Interval (CI)}. } \details{ Unlike equal-tailed intervals (see \code{eti()}) that typically exclude \verb{2.5\%} from each tail of the distribution and always include the median, the HDI is \emph{not} equal-tailed and therefore always includes the mode(s) of posterior distributions. While this can be useful to better represent the credibility mass of a distribution, the HDI also has some limitations. See \code{\link[=spi]{spi()}} for details. \cr \cr The \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{\verb{95\%} or \verb{89\%} Credible Intervals (CI)} are two reasonable ranges to characterize the uncertainty related to the estimation (see \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{here} for a discussion about the differences between these two values). \cr The \verb{89\%} intervals (\code{ci = 0.89}) are deemed to be more stable than, for instance, \verb{95\%} intervals (\cite{Kruschke, 2014}). An effective sample size of at least 10.000 is recommended if one wants to estimate \verb{95\%} intervals with high precision (\cite{Kruschke, 2014, p. 183ff}). Unfortunately, the default number of posterior samples for most Bayes packages (e.g., \code{rstanarm} or \code{brms}) is only 4.000 (thus, you might want to increase it when fitting your model). Moreover, 89 indicates the arbitrariness of interval limits - its only remarkable property is being the highest prime number that does not exceed the already unstable \verb{95\%} threshold (\cite{McElreath, 2015}). \cr However, \verb{95\%} has some \href{https://easystats.github.io/blog/posts/bayestestr_95/}{advantages too}. For instance, it shares (in the case of a normal posterior distribution) an intuitive relationship with the standard deviation and it conveys a more accurate image of the (artificial) bounds of the distribution. Also, because it is wider, it makes analyses more conservative (i.e., the probability of covering 0 is larger for the \verb{95\%} CI than for lower ranges such as \verb{89\%}), which is a good thing in the context of the reproducibility crisis. \cr \cr A \verb{95\%} equal-tailed interval (ETI) has \verb{2.5\%} of the distribution on either side of its limits. It indicates the 2.5th percentile and the 97.5h percentile. In symmetric distributions, the two methods of computing credible intervals, the ETI and the \link[=hdi]{HDI}, return similar results. \cr \cr This is not the case for skewed distributions. Indeed, it is possible that parameter values in the ETI have lower credibility (are less probable) than parameter values outside the ETI. This property seems undesirable as a summary of the credible values in a distribution. \cr \cr On the other hand, the ETI range does change when transformations are applied to the distribution (for instance, for a log odds scale to probabilities): the lower and higher bounds of the transformed distribution will correspond to the transformed lower and higher bounds of the original distribution. On the contrary, applying transformations to the distribution will change the resulting HDI. } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ library(bayestestR) posterior <- rnorm(1000) hdi(posterior, ci = 0.89) hdi(posterior, ci = c(.80, .90, .95)) df <- data.frame(replicate(4, rnorm(100))) hdi(df) hdi(df, ci = c(.80, .90, .95)) \dontrun{ library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) hdi(model) hdi(model, ci = c(.80, .90, .95)) library(emmeans) hdi(emtrends(model, ~1, "wt")) library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) hdi(model) hdi(model, ci = c(.80, .90, .95)) library(BayesFactor) bf <- ttestBF(x = rnorm(100, 1, 1)) hdi(bf) hdi(bf, ci = c(.80, .90, .95)) } } \references{ \itemize{ \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. \item McElreath, R. (2015). Statistical rethinking: A Bayesian course with examples in R and Stan. Chapman and Hall/CRC. } } \seealso{ Other interval functions, such as \code{\link[=hdi]{hdi()}}, \code{\link[=eti]{eti()}}, \code{\link[=bci]{bci()}}, \code{\link[=spi]{spi()}}, \code{\link[=si]{si()}}, \code{\link[=cwi]{cwi()}}. Other ci: \code{\link{bci}()}, \code{\link{ci}()}, \code{\link{cwi}()}, \code{\link{eti}()}, \code{\link{si}()}, \code{\link{spi}()} } \author{ Credits go to \strong{ggdistribute} and \href{https://github.com/mikemeredith/HDInterval}{\strong{HDInterval}}. } \concept{ci} bayestestR/man/effective_sample.Rd0000644000176200001440000000506714276606713016766 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/effective_sample.R \name{effective_sample} \alias{effective_sample} \alias{effective_sample.brmsfit} \alias{effective_sample.stanreg} \title{Effective Sample Size (ESS)} \usage{ effective_sample(model, ...) \method{effective_sample}{brmsfit}( model, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ... ) \method{effective_sample}{stanreg}( model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) } \arguments{ \item{model}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, \code{blavaan}, or \code{MCMCglmm} object.} \item{...}{Currently not used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A data frame with two columns: Parameter name and effective sample size (ESS). } \description{ This function returns the effective sample size (ESS). } \details{ \strong{Effective Sample (ESS)} should be as large as possible, altough for most applications, an effective sample size greater than 1,000 is sufficient for stable estimates (Bürkner, 2017). The ESS corresponds to the number of independent samples with the same estimation power as the N autocorrelated samples. It is is a measure of \dQuote{how much independent information there is in autocorrelated chains} (\emph{Kruschke 2015, p182-3}). } \examples{ \dontrun{ library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) effective_sample(model) } } \references{ \itemize{ \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. \item Bürkner, P. C. (2017). brms: An R package for Bayesian multilevel models using Stan. Journal of Statistical Software, 80(1), 1-28 } } bayestestR/man/estimate_density.Rd0000644000176200001440000001175614357655465017051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/estimate_density.R \name{estimate_density} \alias{estimate_density} \alias{estimate_density.data.frame} \title{Density Estimation} \usage{ estimate_density(x, ...) \method{estimate_density}{data.frame}( x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, select = NULL, at = NULL, group_by = NULL, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Currently not used.} \item{method}{Density estimation method. Can be \code{"kernel"} (default), \code{"logspline"} or \code{"KernSmooth"}.} \item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.} \item{extend}{Extend the range of the x axis by a factor of \code{extend_scale}.} \item{extend_scale}{Ratio of range by which to extend the x axis. A value of \code{0.1} means that the x axis will be extended by \code{1/10} of the range of the data.} \item{bw}{See the eponymous argument in \code{density}. Here, the default has been changed for \code{"SJ"}, which is recommended.} \item{ci}{The confidence interval threshold. Only used when \code{method = "kernel"}. This feature is experimental, use with caution.} \item{select}{Character vector of column names. If NULL (the default), all numeric variables will be selected. Other arguments from \code{\link[datawizard:find_columns]{datawizard::find_columns()}} (such as \code{exclude}) can also be used.} \item{at}{Optional character vector. If not \code{NULL} and input is a data frame, density estimation is performed for each group (subsets) indicated by \code{at}. See examples.} \item{group_by}{Deprecated in favour of \code{at}.} } \description{ This function is a wrapper over different methods of density estimation. By default, it uses the base R \code{density} with by default uses a different smoothing bandwidth (\code{"SJ"}) from the legacy default implemented the base R \code{density} function (\code{"nrd0"}). However, Deng and Wickham suggest that \code{method = "KernSmooth"} is the fastest and the most accurate. } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ \dontshow{if (requireNamespace("logspline", quietly = TRUE) && requireNamespace("KernSmooth", quietly = TRUE) && requireNamespace("mclust", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(bayestestR) set.seed(1) x <- rnorm(250, mean = 1) # Basic usage density_kernel <- estimate_density(x) # default method is "kernel" hist(x, prob = TRUE) lines(density_kernel$x, density_kernel$y, col = "black", lwd = 2) lines(density_kernel$x, density_kernel$CI_low, col = "gray", lty = 2) lines(density_kernel$x, density_kernel$CI_high, col = "gray", lty = 2) legend("topright", legend = c("Estimate", "95\% CI"), col = c("black", "gray"), lwd = 2, lty = c(1, 2) ) # Other Methods density_logspline <- estimate_density(x, method = "logspline") density_KernSmooth <- estimate_density(x, method = "KernSmooth") density_mixture <- estimate_density(x, method = "mixture") hist(x, prob = TRUE) lines(density_kernel$x, density_kernel$y, col = "black", lwd = 2) lines(density_logspline$x, density_logspline$y, col = "red", lwd = 2) lines(density_KernSmooth$x, density_KernSmooth$y, col = "blue", lwd = 2) lines(density_mixture$x, density_mixture$y, col = "green", lwd = 2) # Extension density_extended <- estimate_density(x, extend = TRUE) density_default <- estimate_density(x, extend = FALSE) hist(x, prob = TRUE) lines(density_extended$x, density_extended$y, col = "red", lwd = 3) lines(density_default$x, density_default$y, col = "black", lwd = 3) # Multiple columns head(estimate_density(iris)) head(estimate_density(iris, select = "Sepal.Width")) # Grouped data head(estimate_density(iris, at = "Species")) head(estimate_density(iris$Petal.Width, at = iris$Species)) \dontrun{ # rstanarm models # ----------------------------------------------- library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) head(estimate_density(model)) library(emmeans) head(estimate_density(emtrends(model, ~1, "wt"))) # brms models # ----------------------------------------------- library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) estimate_density(model) } \dontshow{\}) # examplesIf} } \references{ Deng, H., & Wickham, H. (2011). Density estimation in R. Electronic publication. } bayestestR/man/bayesfactor_restricted.Rd0000644000176200001440000002173514357655465020227 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bayesfactor_restricted.R \name{bayesfactor_restricted} \alias{bayesfactor_restricted} \alias{bf_restricted} \alias{bayesfactor_restricted.stanreg} \alias{bayesfactor_restricted.brmsfit} \alias{bayesfactor_restricted.blavaan} \alias{bayesfactor_restricted.emmGrid} \alias{as.logical.bayesfactor_restricted} \title{Bayes Factors (BF) for Order Restricted Models} \usage{ bayesfactor_restricted( posterior, hypothesis, prior = NULL, verbose = TRUE, ... ) bf_restricted(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) \method{bayesfactor_restricted}{stanreg}( posterior, hypothesis, prior = NULL, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), ... ) \method{bayesfactor_restricted}{brmsfit}( posterior, hypothesis, prior = NULL, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), ... ) \method{bayesfactor_restricted}{blavaan}( posterior, hypothesis, prior = NULL, verbose = TRUE, ... ) \method{bayesfactor_restricted}{emmGrid}( posterior, hypothesis, prior = NULL, verbose = TRUE, ... ) \method{as.logical}{bayesfactor_restricted}(x, which = c("posterior", "prior"), ...) } \arguments{ \item{posterior}{A \code{stanreg} / \code{brmsfit} object, \code{emmGrid} or a data frame - representing a posterior distribution(s) from (see Details).} \item{hypothesis}{A character vector specifying the restrictions as logical conditions (see examples below).} \item{prior}{An object representing a prior distribution (see Details).} \item{verbose}{Toggle off warnings.} \item{...}{Currently not used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{x}{An object of class \code{bayesfactor_restricted}} \item{which}{Should the logical matrix be of the posterior or prior distribution(s)?} } \value{ A data frame containing the (log) Bayes factor representing evidence \emph{against} the un-restricted model (Use \code{as.numeric()} to extract the non-log Bayes factors; see examples). (A \code{bool_results} attribute contains the results for each sample, indicating if they are included or not in the hypothesized restriction.) } \description{ This method computes Bayes factors for comparing a model with an order restrictions on its parameters with the fully unrestricted model. \emph{Note that this method should only be used for confirmatory analyses}. \cr \cr The \verb{bf_*} function is an alias of the main function. \cr \cr \strong{For more info, in particular on specifying correct priors for factors with more than 2 levels, see \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}.} } \details{ This method is used to compute Bayes factors for order-restricted models vs un-restricted models by setting an order restriction on the prior and posterior distributions (\cite{Morey & Wagenmakers, 2013}). \cr\cr (Though it is possible to use \code{bayesfactor_restricted()} to test interval restrictions, it is more suitable for testing order restrictions; see examples). } \section{Setting the correct \code{prior}}{ For the computation of Bayes factors, the model priors must be proper priors (at the very least they should be \emph{not flat}, and it is preferable that they be \emph{informative}); As the priors for the alternative get wider, the likelihood of the null value(s) increases, to the extreme that for completely flat priors the null is infinitely more favorable than the alternative (this is called \emph{the Jeffreys-Lindley-Bartlett paradox}). Thus, you should only ever try (or want) to compute a Bayes factor when you have an informed prior. \cr\cr (Note that by default, \code{brms::brm()} uses flat priors for fixed-effects; See example below.) \cr\cr It is important to provide the correct \code{prior} for meaningful results. \itemize{ \item When \code{posterior} is a numerical vector, \code{prior} should also be a numerical vector. \item When \code{posterior} is a \code{data.frame}, \code{prior} should also be a \code{data.frame}, with matching column order. \item When \code{posterior} is a \code{stanreg}, \code{brmsfit} or other supported Bayesian model: \itemize{ \item \code{prior} can be set to \code{NULL}, in which case prior samples are drawn internally. \item \code{prior} can also be a model equivalent to \code{posterior} but with samples from the priors \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \strong{Note:} When \code{posterior} is a \code{brmsfit_multiple} model, \code{prior} \strong{must} be provided. } \item When \code{posterior} is an \code{emmGrid} / \code{emm_list} object: \itemize{ \item \code{prior} should also be an \code{emmGrid} / \code{emm_list} object equivalent to \code{posterior} but created with a model of priors samples \emph{only}. See \code{\link[=unupdate]{unupdate()}}. \item \code{prior} can also be the original (posterior) \emph{model}. If so, the function will try to update the \code{emmGrid} / \code{emm_list} to use the \code{\link[=unupdate]{unupdate()}}d prior-model. (\emph{This cannot be done for \code{brmsfit} models.}) \item \strong{Note}: When the \code{emmGrid} has undergone any transformations (\code{"log"}, \code{"response"}, etc.), or \code{regrid}ing, then \code{prior} must be an \code{emmGrid} object, as stated above. } } } \section{Interpreting Bayes Factors}{ A Bayes factor greater than 1 can be interpreted as evidence against the null, at which one convention is that a Bayes factor greater than 3 can be considered as "substantial" evidence against the null (and vice versa, a Bayes factor smaller than 1/3 indicates substantial evidence in favor of the null-model) (\cite{Wetzels et al. 2011}). } \examples{ set.seed(444) library(bayestestR) prior <- data.frame( A = rnorm(1000), B = rnorm(1000), C = rnorm(1000) ) posterior <- data.frame( A = rnorm(1000, .4, 0.7), B = rnorm(1000, -.2, 0.4), C = rnorm(1000, 0, 0.5) ) hyps <- c( "A > B & B > C", "A > B & A > C", "C > A" ) (b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior)) bool <- as.logical(b, which = "posterior") head(bool) \dontshow{if (require("see") && require("patchwork")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} see::plots( plot(estimate_density(posterior)), # distribution **conditional** on the restrictions plot(estimate_density(posterior[bool[, hyps[1]], ])) + ggplot2::ggtitle(hyps[1]), plot(estimate_density(posterior[bool[, hyps[2]], ])) + ggplot2::ggtitle(hyps[2]), plot(estimate_density(posterior[bool[, hyps[3]], ])) + ggplot2::ggtitle(hyps[3]), guides = "collect" ) \dontshow{\}) # examplesIf} \dontshow{if (require("rstanarm")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontrun{ # rstanarm models # --------------- data("mtcars") fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am, data = mtcars, refresh = 0 ) hyps <- c( "am > 0 & cyl < 0", "cyl < 0", "wt - cyl > 0" ) bayesfactor_restricted(fit_stan, hypothesis = hyps) } \dontshow{\}) # examplesIf} \dontshow{if (require("rstanarm") && require("emmeans")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontrun{ # emmGrid objects # --------------- # replicating http://bayesfactor.blogspot.com/2015/01/multiple-comparisons-with-bayesfactor-2.html data("disgust") contrasts(disgust$condition) <- contr.equalprior_pairs # see vignette fit_model <- rstanarm::stan_glm(score ~ condition, data = disgust, family = gaussian()) em_condition <- emmeans::emmeans(fit_model, ~condition) hyps <- c("lemon < control & control < sulfur") bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps) # > # Bayes Factor (Order-Restriction) # > # > Hypothesis P(Prior) P(Posterior) BF # > lemon < control & control < sulfur 0.17 0.75 4.49 # > --- # > Bayes factors for the restricted model vs. the un-restricted model. } \dontshow{\}) # examplesIf} } \references{ \itemize{ \item Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124. \item Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. Psychological methods, 16(4), 406. \item Morey, R. D. (Jan, 2015). Multiple Comparisons with BayesFactor, Part 2 – order restrictions. Retrieved from https://richarddmorey.org/category/order-restrictions/. } } bayestestR/man/eti.Rd0000644000176200001440000001511114407021361014217 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eti.R \name{eti} \alias{eti} \alias{eti.numeric} \alias{eti.stanreg} \alias{eti.brmsfit} \title{Equal-Tailed Interval (ETI)} \usage{ eti(x, ...) \method{eti}{numeric}(x, ci = 0.95, verbose = TRUE, ...) \method{eti}{stanreg}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ... ) \method{eti}{brmsfit}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Currently not used.} \item{ci}{Value or vector of probability of the (credible) interval - CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the credible interval. \item \code{CI_low}, \code{CI_high} The lower and upper credible interval limits for the parameters. } } \description{ Compute the \strong{Equal-Tailed Interval (ETI)} of posterior distributions using the quantiles method. The probability of being below this interval is equal to the probability of being above it. The ETI can be used in the context of uncertainty characterisation of posterior distributions as \strong{Credible Interval (CI)}. } \details{ Unlike equal-tailed intervals (see \code{eti()}) that typically exclude \verb{2.5\%} from each tail of the distribution and always include the median, the HDI is \emph{not} equal-tailed and therefore always includes the mode(s) of posterior distributions. While this can be useful to better represent the credibility mass of a distribution, the HDI also has some limitations. See \code{\link[=spi]{spi()}} for details. \cr \cr The \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{\verb{95\%} or \verb{89\%} Credible Intervals (CI)} are two reasonable ranges to characterize the uncertainty related to the estimation (see \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{here} for a discussion about the differences between these two values). \cr The \verb{89\%} intervals (\code{ci = 0.89}) are deemed to be more stable than, for instance, \verb{95\%} intervals (\cite{Kruschke, 2014}). An effective sample size of at least 10.000 is recommended if one wants to estimate \verb{95\%} intervals with high precision (\cite{Kruschke, 2014, p. 183ff}). Unfortunately, the default number of posterior samples for most Bayes packages (e.g., \code{rstanarm} or \code{brms}) is only 4.000 (thus, you might want to increase it when fitting your model). Moreover, 89 indicates the arbitrariness of interval limits - its only remarkable property is being the highest prime number that does not exceed the already unstable \verb{95\%} threshold (\cite{McElreath, 2015}). \cr However, \verb{95\%} has some \href{https://easystats.github.io/blog/posts/bayestestr_95/}{advantages too}. For instance, it shares (in the case of a normal posterior distribution) an intuitive relationship with the standard deviation and it conveys a more accurate image of the (artificial) bounds of the distribution. Also, because it is wider, it makes analyses more conservative (i.e., the probability of covering 0 is larger for the \verb{95\%} CI than for lower ranges such as \verb{89\%}), which is a good thing in the context of the reproducibility crisis. \cr \cr A \verb{95\%} equal-tailed interval (ETI) has \verb{2.5\%} of the distribution on either side of its limits. It indicates the 2.5th percentile and the 97.5h percentile. In symmetric distributions, the two methods of computing credible intervals, the ETI and the \link[=hdi]{HDI}, return similar results. \cr \cr This is not the case for skewed distributions. Indeed, it is possible that parameter values in the ETI have lower credibility (are less probable) than parameter values outside the ETI. This property seems undesirable as a summary of the credible values in a distribution. \cr \cr On the other hand, the ETI range does change when transformations are applied to the distribution (for instance, for a log odds scale to probabilities): the lower and higher bounds of the transformed distribution will correspond to the transformed lower and higher bounds of the original distribution. On the contrary, applying transformations to the distribution will change the resulting HDI. } \examples{ library(bayestestR) posterior <- rnorm(1000) eti(posterior) eti(posterior, ci = c(0.80, 0.89, 0.95)) df <- data.frame(replicate(4, rnorm(100))) eti(df) eti(df, ci = c(0.80, 0.89, 0.95)) \dontrun{ library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) eti(model) eti(model, ci = c(0.80, 0.89, 0.95)) library(emmeans) eti(emtrends(model, ~1, "wt")) library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) eti(model) eti(model, ci = c(0.80, 0.89, 0.95)) library(BayesFactor) bf <- ttestBF(x = rnorm(100, 1, 1)) eti(bf) eti(bf, ci = c(0.80, 0.89, 0.95)) } } \seealso{ Other ci: \code{\link{bci}()}, \code{\link{ci}()}, \code{\link{cwi}()}, \code{\link{hdi}()}, \code{\link{si}()}, \code{\link{spi}()} } \concept{ci} bayestestR/man/spi.Rd0000644000176200001440000001033614357655465014263 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/spi.R \name{spi} \alias{spi} \alias{spi.numeric} \alias{spi.stanreg} \alias{spi.brmsfit} \title{Shortest Probability Interval (SPI)} \usage{ spi(x, ...) \method{spi}{numeric}(x, ci = 0.95, verbose = TRUE, ...) \method{spi}{stanreg}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ... ) \method{spi}{brmsfit}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Currently not used.} \item{ci}{Value or vector of probability of the (credible) interval - CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the credible interval. \item \code{CI_low}, \code{CI_high} The lower and upper credible interval limits for the parameters. } } \description{ Compute the \strong{Shortest Probability Interval (SPI)} of posterior distributions. The SPI is a more computationally stable HDI. The implementation is based on the algorithm from the \strong{SPIn} package. } \details{ The SPI is an alternative method to the HDI (\code{\link[=hdi]{hdi()}}) to quantify uncertainty of (posterior) distributions. The SPI is said to be more stable than the HDI, because, the \emph{"HDI can be noisy (that is, have a high Monte Carlo error)"} (Liu et al. 2015). Furthermore, the HDI is sensitive to additional assumptions, in particular assumptions related to the different estimation methods, which can make the HDI less accurate or reliable (see also discussion \href{https://twitter.com/betanalpha/status/1479107186030624771}{here}). } \note{ The code to compute the SPI was adapted from the \strong{SPIn} package, and slightly modified to be more robust for Stan models. Thus, credits go to Ying Liu for the original SPI algorithm and R implementation. } \examples{ \dontshow{if (requireNamespace("quadprog", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(bayestestR) posterior <- rnorm(1000) spi(posterior) spi(posterior, ci = c(0.80, 0.89, 0.95)) df <- data.frame(replicate(4, rnorm(100))) spi(df) spi(df, ci = c(0.80, 0.89, 0.95)) \dontrun{ library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) spi(model) } \dontshow{\}) # examplesIf} } \references{ Liu, Y., Gelman, A., & Zheng, T. (2015). Simulation-efficient shortest probability intervals. Statistics and Computing, 25(4), 809–819. https://doi.org/10.1007/s11222-015-9563-8 } \seealso{ Other ci: \code{\link{bci}()}, \code{\link{ci}()}, \code{\link{cwi}()}, \code{\link{eti}()}, \code{\link{hdi}()}, \code{\link{si}()} } \concept{ci} bayestestR/man/bayesfactor_models.Rd0000644000176200001440000001723114407021360017307 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bayesfactor_models.R \name{bayesfactor_models} \alias{bayesfactor_models} \alias{bf_models} \alias{bayesfactor_models.default} \alias{update.bayesfactor_models} \alias{as.matrix.bayesfactor_models} \title{Bayes Factors (BF) for model comparison} \usage{ bayesfactor_models(..., denominator = 1, verbose = TRUE) bf_models(..., denominator = 1, verbose = TRUE) \method{bayesfactor_models}{default}(..., denominator = 1, verbose = TRUE) \method{update}{bayesfactor_models}(object, subset = NULL, reference = NULL, ...) \method{as.matrix}{bayesfactor_models}(x, ...) } \arguments{ \item{...}{Fitted models (see details), all fit on the same data, or a single \code{BFBayesFactor} object (see 'Details'). Ignored in \code{as.matrix()}, \code{update()}. If the following named arguments are present, they are passed to \link[insight:get_loglikelihood]{insight::get_loglikelihood} (see details): \itemize{ \item \code{estimator} (defaults to \code{"ML"}) \item \code{check_response} (defaults to \code{FALSE}) }} \item{denominator}{Either an integer indicating which of the models to use as the denominator, or a model to be used as a denominator. Ignored for \code{BFBayesFactor}.} \item{verbose}{Toggle off warnings.} \item{object, x}{A \code{\link[=bayesfactor_models]{bayesfactor_models()}} object.} \item{subset}{Vector of model indices to keep or remove.} \item{reference}{Index of model to reference to, or \code{"top"} to reference to the best model, or \code{"bottom"} to reference to the worst model.} } \value{ A data frame containing the models' formulas (reconstructed fixed and random effects) and their \code{log(BF)}s (Use \code{as.numeric()} to extract the non-log Bayes factors; see examples), that prints nicely. } \description{ This function computes or extracts Bayes factors from fitted models. \cr \cr The \verb{bf_*} function is an alias of the main function. } \details{ If the passed models are supported by \pkg{insight} the DV of all models will be tested for equality (else this is assumed to be true), and the models' terms will be extracted (allowing for follow-up analysis with \code{bayesfactor_inclusion}). \itemize{ \item For \code{brmsfit} or \code{stanreg} models, Bayes factors are computed using the \CRANpkg{bridgesampling} package. \itemize{ \item \code{brmsfit} models must have been fitted with \code{save_pars = save_pars(all = TRUE)}. \item \code{stanreg} models must have been fitted with a defined \code{diagnostic_file}. } \item For \code{BFBayesFactor}, \code{bayesfactor_models()} is mostly a wraparound \code{BayesFactor::extractBF()}. \item For all other model types, Bayes factors are computed using the BIC approximation. Note that BICs are extracted from using \link[insight:get_loglikelihood]{insight::get_loglikelihood}, see documentation there for options for dealing with transformed responses and REML estimation. } In order to correctly and precisely estimate Bayes factors, a rule of thumb are the 4 P's: \strong{P}roper \strong{P}riors and \strong{P}lentiful \strong{P}osteriors. How many? The number of posterior samples needed for testing is substantially larger than for estimation (the default of 4000 samples may not be enough in many cases). A conservative rule of thumb is to obtain 10 times more samples than would be required for estimation (\cite{Gronau, Singmann, & Wagenmakers, 2017}). If less than 40,000 samples are detected, \code{bayesfactor_models()} gives a warning. \cr \cr See also \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}. } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \section{Interpreting Bayes Factors}{ A Bayes factor greater than 1 can be interpreted as evidence against the null, at which one convention is that a Bayes factor greater than 3 can be considered as "substantial" evidence against the null (and vice versa, a Bayes factor smaller than 1/3 indicates substantial evidence in favor of the null-model) (\cite{Wetzels et al. 2011}). } \examples{ # With lm objects: # ---------------- lm1 <- lm(mpg ~ 1, data = mtcars) lm2 <- lm(mpg ~ hp, data = mtcars) lm3 <- lm(mpg ~ hp + drat, data = mtcars) lm4 <- lm(mpg ~ hp * drat, data = mtcars) (BFM <- bayesfactor_models(lm1, lm2, lm3, lm4, denominator = 1)) # bayesfactor_models(lm2, lm3, lm4, denominator = lm1) # same result # bayesfactor_models(lm1, lm2, lm3, lm4, denominator = lm1) # same result update(BFM, reference = "bottom") as.matrix(BFM) as.numeric(BFM) lm2b <- lm(sqrt(mpg) ~ hp, data = mtcars) # Set check_response = TRUE for transformed responses bayesfactor_models(lm2b, denominator = lm2, check_response = TRUE) \dontrun{ # With lmerMod objects: # --------------------- if (require("lme4")) { lmer1 <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) lmer2 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris) lmer3 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species) + (1 | Petal.Width), data = iris ) bayesfactor_models(lmer1, lmer2, lmer3, denominator = 1, estimator = "REML" ) } # rstanarm models # --------------------- # (note that a unique diagnostic_file MUST be specified in order to work) if (require("rstanarm")) { stan_m0 <- stan_glm(Sepal.Length ~ 1, data = iris, family = gaussian(), diagnostic_file = file.path(tempdir(), "df0.csv") ) stan_m1 <- stan_glm(Sepal.Length ~ Species, data = iris, family = gaussian(), diagnostic_file = file.path(tempdir(), "df1.csv") ) stan_m2 <- stan_glm(Sepal.Length ~ Species + Petal.Length, data = iris, family = gaussian(), diagnostic_file = file.path(tempdir(), "df2.csv") ) bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE) } # brms models # -------------------- # (note the save_pars MUST be set to save_pars(all = TRUE) in order to work) if (require("brms")) { brm1 <- brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE)) brm2 <- brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE)) brm3 <- brm( Sepal.Length ~ Species + Petal.Length, data = iris, save_pars = save_pars(all = TRUE) ) bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE) } # BayesFactor # --------------------------- if (require("BayesFactor")) { data(puzzles) BF <- anovaBF(RT ~ shape * color + ID, data = puzzles, whichRandom = "ID", progress = FALSE ) BF bayesfactor_models(BF) # basically the same } } } \references{ \itemize{ \item Gronau, Q. F., Singmann, H., & Wagenmakers, E. J. (2017). Bridgesampling: An R package for estimating normalizing constants. arXiv preprint arXiv:1710.08162. \item Kass, R. E., and Raftery, A. E. (1995). Bayes Factors. Journal of the American Statistical Association, 90(430), 773-795. \item Robert, C. P. (2016). The expected demise of the Bayes factor. Journal of Mathematical Psychology, 72, 33–37. \item Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values. Psychonomic bulletin & review, 14(5), 779-804. \item Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011). Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests. Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923} } } \author{ Mattan S. Ben-Shachar } bayestestR/man/bci.Rd0000644000176200001440000001511614357655465014226 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bci.R \name{bci} \alias{bci} \alias{bcai} \alias{bci.numeric} \alias{bci.data.frame} \alias{bci.MCMCglmm} \alias{bci.sim.merMod} \alias{bci.sim} \alias{bci.emmGrid} \alias{bci.stanreg} \alias{bci.brmsfit} \alias{bci.BFBayesFactor} \title{Bias Corrected and Accelerated Interval (BCa)} \usage{ bci(x, ...) bcai(x, ...) \method{bci}{numeric}(x, ci = 0.95, verbose = TRUE, ...) \method{bci}{data.frame}(x, ci = 0.95, verbose = TRUE, ...) \method{bci}{MCMCglmm}(x, ci = 0.95, verbose = TRUE, ...) \method{bci}{sim.merMod}( x, ci = 0.95, effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ... ) \method{bci}{sim}(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) \method{bci}{emmGrid}(x, ci = 0.95, verbose = TRUE, ...) \method{bci}{stanreg}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ... ) \method{bci}{brmsfit}( x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ... ) \method{bci}{BFBayesFactor}(x, ci = 0.95, verbose = TRUE, ...) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{...}{Currently not used.} \item{ci}{Value or vector of probability of the (credible) interval - CI (between 0 and 1) to be estimated. Default to \code{.95} (\verb{95\%}).} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} } \value{ A data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{CI} The probability of the credible interval. \item \code{CI_low}, \code{CI_high} The lower and upper credible interval limits for the parameters. } } \description{ Compute the \strong{Bias Corrected and Accelerated Interval (BCa)} of posterior distributions. } \details{ Unlike equal-tailed intervals (see \code{eti()}) that typically exclude \verb{2.5\%} from each tail of the distribution and always include the median, the HDI is \emph{not} equal-tailed and therefore always includes the mode(s) of posterior distributions. While this can be useful to better represent the credibility mass of a distribution, the HDI also has some limitations. See \code{\link[=spi]{spi()}} for details. \cr \cr The \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{\verb{95\%} or \verb{89\%} Credible Intervals (CI)} are two reasonable ranges to characterize the uncertainty related to the estimation (see \href{https://easystats.github.io/bayestestR/articles/credible_interval.html}{here} for a discussion about the differences between these two values). \cr The \verb{89\%} intervals (\code{ci = 0.89}) are deemed to be more stable than, for instance, \verb{95\%} intervals (\cite{Kruschke, 2014}). An effective sample size of at least 10.000 is recommended if one wants to estimate \verb{95\%} intervals with high precision (\cite{Kruschke, 2014, p. 183ff}). Unfortunately, the default number of posterior samples for most Bayes packages (e.g., \code{rstanarm} or \code{brms}) is only 4.000 (thus, you might want to increase it when fitting your model). Moreover, 89 indicates the arbitrariness of interval limits - its only remarkable property is being the highest prime number that does not exceed the already unstable \verb{95\%} threshold (\cite{McElreath, 2015}). \cr However, \verb{95\%} has some \href{https://easystats.github.io/blog/posts/bayestestr_95/}{advantages too}. For instance, it shares (in the case of a normal posterior distribution) an intuitive relationship with the standard deviation and it conveys a more accurate image of the (artificial) bounds of the distribution. Also, because it is wider, it makes analyses more conservative (i.e., the probability of covering 0 is larger for the \verb{95\%} CI than for lower ranges such as \verb{89\%}), which is a good thing in the context of the reproducibility crisis. \cr \cr A \verb{95\%} equal-tailed interval (ETI) has \verb{2.5\%} of the distribution on either side of its limits. It indicates the 2.5th percentile and the 97.5h percentile. In symmetric distributions, the two methods of computing credible intervals, the ETI and the \link[=hdi]{HDI}, return similar results. \cr \cr This is not the case for skewed distributions. Indeed, it is possible that parameter values in the ETI have lower credibility (are less probable) than parameter values outside the ETI. This property seems undesirable as a summary of the credible values in a distribution. \cr \cr On the other hand, the ETI range does change when transformations are applied to the distribution (for instance, for a log odds scale to probabilities): the lower and higher bounds of the transformed distribution will correspond to the transformed lower and higher bounds of the original distribution. On the contrary, applying transformations to the distribution will change the resulting HDI. } \examples{ posterior <- rnorm(1000) bci(posterior) bci(posterior, ci = c(0.80, 0.89, 0.95)) } \references{ DiCiccio, T. J. and B. Efron. (1996). Bootstrap Confidence Intervals. Statistical Science. 11(3): 189–212. 10.1214/ss/1032280214 } \seealso{ Other ci: \code{\link{ci}()}, \code{\link{cwi}()}, \code{\link{eti}()}, \code{\link{hdi}()}, \code{\link{si}()}, \code{\link{spi}()} } \concept{ci} bayestestR/man/figures/0000755000176200001440000000000014413525307014622 5ustar liggesusersbayestestR/man/figures/unnamed-chunk-16-1.png0000644000176200001440000054646714410351152020465 0ustar liggesusersPNG  IHDR `CiCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i `k.@IDATx{]U'_$D  +Rт TuԫHae; 3JXA,E"e<I: ! tIN>ǜޟS~߬ ? @ @ @ @ @T`ܠ  @ @ @ @ @ @* C @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @  @ @ @ @ @ @@FP @ @ @ @ @ 0#+oFgggݠx`;ԡ8!@ @ @ @ @P% ط 4ܹs믵5f͚Uw  @ @ @ @ @@l[51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @' ]51 @ @ @ @ @9 `oZ @ @ @ @ @'0x-븙UVUm߾=OG}t~1eʔQk^G}4V^7nSƬY}{_|ɱZ/&"@ @ @ @ @cs]Vq]wŭ6mpGqyπ5#qqҥ0*w;㢋.+q @ @ @ @ @-7h;W\?Wwx5\&L}0wk6~ƟgK.l;wnuŭݸ.:!@ @ @ @ @( d7.|}!gw\tvv3<<@U}ꩧ;Tϛ7oDP v:nܸjvZtAꫯFe{Ю~0̙ @ @ @ @ @2 ;3Š F u߿vrvڸ⋫!rKq{wÆ /})۫1{]}g/͛7jΘ:u.#q#h  @ @ @ @ @@s kζtլv[iӦO~9|])1cF̟??8Zw];ۃ믿nii=P2O^Xr۶mO @ @ @ @ @* UJ],[,$9眘>׾A?~|~6կ)23  @ @ @ @ @,0~ N`ɒ%[f͊ӧww0u8_R;v@ @ @ @ @ @vnƍaÆ̘1vSӟt{챱cv%`1 @ @ @ @ @*`R%k+~e]'Vjƍ?*;`~/~0aB%  @ @ @ @ @dv&&E---uu{:I)?~w)SM7ݴK2ik38ʕ+o; @ @ @ @ @ U`Iج3&M{=\[ L\|.w=y{|+; z<{j{'|2b`ϹO @ @ @ @ ͿFM;;;aoؓ'Ok>@':문;׭[x=fΝ;7.\7  @ @ @ @ @)0mzvMo޼9s ;p>O=_|jN>x;Y;w@ @ @ @ @ @ _ӴYՔZ`ڴiq) * w>xg{]>3|R;|q衇.7;Ｓv> 7[nݪG @ @ @ @ @`C+yE]Ǐ*tvve]O=.*O9!@ @4v3^ @ @ @T mYگ#vWޢ덈ʿ7o?3nbw4ZlČ-fK @ @`G 4 @ @ @ƚ@vxϑK"M?3ZhvȌo @ @^ `%  @ @ @M tDE;bƽ~%ݱM;)Z%rЙ @ @  @ @ @ RX󏑖~'%x 1D٣; @ @"0 @ @ @Ho>>鹿U؏ /w @ @FE@{TMB @ @ @+z_jۉ{בIz @ P첬$@ @ @ 0Diqnx}OQ(j̹E~s&4 @ @ BW@ @ @ @.iխ}^y.š_EzDڴZ @ 0ޚz# @ @ @HѻH}^w {Qpʾ?&$@ @% ] @ @ @v+:Gz7ﶦon%ߎzU @ @. @ @ @ -#=6''Flze~J1@IDATḘ @ @cW@{쮭7#@ @ @ I  Q77]M @ @.Z @ @ @ "=~fD#>vnx>s}h @;cg-  @ @ @! !=W͋"="um @ @+ ݼk3 @ @ @ H|;|ݻas4Gzӑl4B @W@ks @ @ @Ho- _fl|̦}!쿉}w @ @$ =$. @ @ @-T "M~tӑH]y3 @ @ @ @ @@IR};_ %y^s#^)nD @\@{p# @ @ @ /z~5wDzʽ @ @@9˹ޚ @ @ @D)Fz*[/C R6 @ @`W]M\!@ @ @ 0 }=wLHLZ|iGb(c @ @%.b{U @ @ @ Xx7N=i,j @ @Ul @ @ @1*6/1v#Z]mRm#4a @ @. =W @ @ @R uo 1?lEeH(&@ @+ ]޵ @ @ @cX =wADNJ1#jH7#@ @ƢX\UD @ @ Pjb~Jm0Oϋip  @ P"-W%@ @ @ϱxH  @#cd! @ @ @}s_+piӞ#@ @J ]E @ @ @H.X^m[-Қ;9  @ @ `xN @ @ @_ vWp?^M.m^c @ @` `5F @ @ @%HAoEZP @ @X++= @ @ @J+?Gto(7x RM  @ @@1n&@ @ @ PHnX =Җ ݰ @ @@jz&@ @ @ 'dF tDZ"YM @H@@U @ @ @; EDxq#6>FlL @ @\4- @ @ @Hkx FI H֌l!@ @Y@WGo @ @ @H]"-w\j͑_ְ L @G@8kS @ @ @U􊈮7h{#hj> @ @lAC @ @ @`O#V߾(P;u M @4v @ @ @@펴Ry tUyv`n @ @ g @ @ @2 eYr h1ҦE ܰ @ @@ `7  @ @ @@@ڶ&KWh ޾/kN4A @蛛 @ @ @Glsh" nX @ @yuF @ @ @O =],L =EMM֕v @ @F `7Z @ @ @B H^ц t  @ @@s `7 @ @ @+oh_JY^!Җڝ @ @`7Ր @ @ @FB uo쪑HݑFn\ @ @ pQD @ @ @"^6 F ] ] @!4  @ @ @HDFrHc5P -)`h @ @Ye%A @ @ @`;];\qXnQs @ @`Q @ @ @@dڻGl<@zH=Fg2 @ @ `Fob @ @ @ ; W[`ۚG @ @{- ׄ @ @ @ 0r?Elxd4Ҩ !RQd @ @ ` @ @ @V v-O1nto'U @ @! @ @ @ xM 0!GU:׏&#@ @FO@{D @ @ @`w{nQ H/]SJ @ E@{(Zj  @ @ @4J`m5qG[`͑:ZG{V @ @ = Ȧ @ @ @ 'շc{*qhoGs`mK @2 `gbRD @ @ @v޶:Wٷ +LmR @ @q؍52 @ @ @A_AP ټ˦e @ 0`B @ @ @h۷y Tw^g&@sב #f'&v[];de[Hnߖl˶(Ս sʔI }W2l৬G4,`aP @ @ @L+G{i[G`kr&@ @O0D7  @ @ @ [OGH @_" @ @ @@N#?_~=89I=l  @ @Owq @ @ @@YOG:,rsC I @Ur#@ @ @ 0@z)=^.i @ @Q؏zD @ @ @#>vDu+' @ @0}a2 @ @ @] 3#/d&w9 @ p_/ @ @ @6V_%ߋbfE֏#CF @ @`b @ @ @,J o&ןSr%@ @U '@ @ @(%Gl~X*/99XU!@ @0=̾ @ @ @`y; [XER, @UvW7 @ @ @@1ܹl@>ʔE @%`{XT  @ @ @@FQ2B~~R, @Qv]W3 @ @ @@1<ڍb@~.Pu @ @`D% @ @ @tHO#;Tz%|RR, @MvmW/ @ @ @@QE >p<< @ o  @ @ @:$D]2J/?99e&@ @5j$@ @ @hE׭0Ոg_  @ @@O `q&@ @ @@.VWM~&/s @ 0po @ @ @ZTDm/A_  @ @@ `kr&@ @ @@N#S9ISE @ @ `j"@ @ @hW`vnPשB @ 3=kt  @ @ @'׿׽dnĭ_  @ @ `!@ @ @hW }1vF ZJ @"`/' @ @ @@'SKRwR2 @ @0 ` @ @ @X@E ٖ5 ߫\ @ @ |$H @ @ Y";"p=˽@Q @迀P @ @ @ N&^}]I?f @ @ psF @ @ ]s{MPfOEf& @ @ kM @ @ PX&յֶ @ pm!@ @ @ p@E\$PJ W @ @0},K  @ @ @Xy>`vV^ @ @ `?F @ @ @'  @ @ @_ '.t@`L @Sv}W5 @ @ @. ,* @ ps, @ @ @ p,p @RvmW4 @ @ @m{-{#b^ y @ U]팼 @ @ @ZRgZFRA @ @ `u5 @ @ @<*nGDKFN^  @ @@ `w%"@ @ @h[ ow[ڏ@yc @ P\ @ @ @Gܣ}"0@*Q @莀B& @ @ @qrR(RWCLM @ @`aFoc @ @ @.u! 9(#p2|rآ @ @J `Wxe @ @ @+/ 0hAק8 @ жG @ @ W"v'(!ZVb @ @* `WvE @ @ @3  _`wY @ ТmE @ @ <܎89?m/Tf% @ @@K[  @ @ @@V^v,)($0?.\X @ PZ @ @ @ퟱ P@E,zUJ @ .+4 @ @ @@7r=bF7B䥃B @ @@e+kr  @ @ @V^CX7rwUK @ .*$ @ @ @@rNPvdE" J @j0]SJ @ @ ?_&AJ\yu+ @4)`IM @ @ @/BDu?O(!~$@ @ %@ @ @8ȥ Pҳuׯz @ 09=N @ @ G'a( K(UH @ PzzR @ @ @ &-Aέ TO @0=G  @ @ @%K?W²%PJ`)إh%@ @ ~UH @ @ p,{kY pd @*`{V9 @ @ @K`|'YJ l~sTtq  @ @ `#@ @ @x >) @ pQ @ @ @w?ݻ%L@.  @ pQ @ @ @/<_2&PR`ݥ;M @)`{mU @ @ @L @ @`JSBYF @ @ O<؈_g&PX '@ @A d[E @ @ ʋyG? {]# @ p'@ @ @@.=%O@F,O-D'@ @0=* @ @ @yp'b?/rǮ@ @-`lw @ @ @.RD (+0~+r\v  @ @ `J!@ @ @xT {O"0Xy. @ @ >M5 @ @ @ Ὀ7z_!Ϸ= @ @  ` @ @ @xL`c] @ѥȃ;p @oL @ @ 0\q vW. @ @{@ @ @ @<.՗ g 䲗q @<$`! ? @ @ @ D`t9p{ (@KkEm @ @@ `w2'@ @ @8C W{8*b!@ @ E @ @ @@QʋI1e//em @诀N @ @ @ ?>k'y'@ @U '@ @ @ O 멊Z8܌_mqC[ @ @ _dL @ @ $y]8G W?g @ @nu_ @ @ @A #vo &h]`ַ! @苀tJ @ @ @ 箱sV"6?:g @ @^^ @ @ @ ^OU/3,ݦ @ =i4  @ @ @,qO^. 8: @ @@+l  @ @ @p ۪ km  @ @@ `w?#@ @ @R `O)e)NM e @&` @ @ 0@[p)rmng @ an @ @ @XyxaN28rwi @ @ `m @ @ @*+Nhkh/7,:  @ @n V?dC @ @ pA<1t,'@`/7Ld  @&` @ @ 04#&CJ=!0ypȂ @tDvG!  @ @ @r Ak篳 @T$`f+ @ @ 04̣WVztJ W_T>!@ @0؟ @ @ @`vw#6fޓ/juV @ @J `Whe @ @ @(+Nb_1íw:t @ @ `/ @ @ @ ȕYf  @BvmV$ @ @ @`x 0袀9 @ @ `/޶ @ @ @s 8zNA^`zO_o% @7Wi @ @ @! y^uQ`.f%' @ кmH @ @ 0@Dl~4o pt,%@ @! rwF @ @CL]+ݥ'3 @ В얠mC @ @ М@\0^`ӯ @ T@, @ @ @Ph'bty婋@rv$9 @hEv+6!@ @ @hLdzX8J XJ @&`{hU @ @ @`ށXy]8yatʍ @0] @ @ @ h8 .e5 @ Oz" @ @ @`r{˃Oaz!Jdf/R$ @(!` @ @ @eVY&L/pĝ!#@ @ &@ @ @Q W `orTE @ 0魬$@ @ @X@.9uw& @0]WUK @ @+]&pwVz @ @Tb @ @ @`ERģ> @ @@5iB  @ @ @ȣ݈ѥ sR$ @JTL @ @ @,T`|%br<]/Gt'# @ @V `l @ @ @yry,%&;%"I @:-` @ @ @}ؾ:)k^dc$E @E ` @ @ @`^Syx^(*& @t\v$= @ @ @@/WO@gv$: @ @@7 @ @ @A4ݠP 8 @ e] @ @ @ F+(@$Ȏ @0ݼ @ @ @M qiT4q(!Afb @ @N d[$E @ @ p" @yz׳ @hLvc @ @ @4)y|kMB^(+, @tRv'") @ @ @0`}8~YK}U @ @`Nsz @ @ @@Z&4/p @tPv"% @ @ @c5ؾ$~g. @ @( @ @ @@]2E%@S˸J @0ݹH @ @ @׾z(p緑{=L\ @ @b/e5 @ @ @@ j ؂6N*  @tOvz"# @ @ @@99]@*^kM @ J @ @ @66ޏ8N @iѥEq#@ @0ݡfH @ @ @ "^@@_"6?k&@ @S " @ @ @V_mm+ м@zyU  @ @K  @ @ @*ȝwT \`K=  @ @M @ @ Тk-nf+l{HhA  @ @@ `w r @ @ @/ @`NB@ @ >U @ @ @rr1#@@:; @ i4 @ @ @ lqtz!099D) @ @0m  @ml@IDAT @ @"-d_ P@p;b$@ @0Ȁ @ @ @D`dr! @ o(@ @ @ (ܽ颶/%ּTQUL @X@ @ @ @5}  N`˃+KA @ @ @ @ @rd{MN.*& @,X`{ @ @ @@99]A)k.E @ @@  @ @ @  .EQqE$@ @ 0@|[ @ @ @DkfGCN] @ PJl @ @ @@gV `w!P@ P @)`{&@ @ @T.{+\A.0z}* @j0][K @ @.C.l&r\$ @ @`nO @ @ @ j^CH @j `Wj @ @ @%9٭dC@t}WA  @ @`1nW @ @ @Ds @5TF @@vMV" @ @ @ PZĝWR2  @ @`a @ @ @:*ku43i PDKEX%@ @ `onG @ @ @@yq$kTZ  @ @`\ @ @ @:+0GMObx?nB @ @v `m7 @ @ @c9 @uy1R] &@ @ ^OUD @ @Q4.k^hU@ @h]v6$@ @ @-w{nUv^ @AS1 @ @ @8M"B;_D[ @ @v `l @ @ @p}-f @z/`-T @ @ @?yN) v @ @@[ @ @ @rw#&;#(@㫑O @}0ɝ @ @ 3\smZ&] ݍ" @ @ `m @ @ @c o @Wv{'s @ @ @@ro%bY2F!Xa  @ @ m(ۃ @ @ @7) @kFi @ @^ e$M @ @@_dL@qTpq  @ @@QEy'@ @ @8<4@?߄b @z%`W, @ @ @_i&@E J @J .-,> @ @ @@AK-o_ @t^v[$A @ @ @@rfP < @ PZvia  @ @ @ N{+(rtˮ @ @N t{$G @ @;C @ @@Ye}E'@ @ @T/77@? @ @Y @ @ @#`{8T ^(*$ @0]Wp @ @ @@i'@kN2 @ 5]| @ @ @Cpe.r\& @ @B @ @ @|-kP @]>g @ @;  @ @ @'TE T$@ @RKɊK @ @\ |Z J`,"@ @ND$A @ @$ތYЂ @ @ `7-* @ @ @}to7"Z @ @ `/ @ @ @ ^;C-O]ћ I @0ݼ @ @ @GLv9 @`z[[I @$`{A%@ @ @ YIC8q @ @ `7g) @ @ @?S xycj*  @ @`ok @ @ @r=bC,MM_* @ @`ns @ @ @ |J`ZD @%`{Q%@ @ @ T Go2e P\ "o @ @`y @ @ @qǯB)rtiʕ @ @^]  @ @ @ȯE|1E@K[  @*`{V9 @ @ @<.M\!@b>ܽ}g&@ @- nV @ @ @ ͡>p v @ @ `1 @ @ @G2'㫏^3 @ @ @ l6`cU6F @ @`&3y @ @ @1.@W#?Q @ @K O @ @D X[II%ѥ6  @yYM @ @ p@Flw 0@ @ @@a؅'@ @ @T!~dRI@K#'-mf @ 0魬$@ @ @8C Ǘϸ2f8{ @0]Vd @ @ @@=ԪRrG{v"@ @ `OMe! @ @ @iynFrti=L @J.*& @ @ @&fM6?m @ @ @rt @)"C @0=7 @ @ @ EV|hO  @ @\Y@ @ @ p@n9bo[ @Y @0=g  @ @ @5 8@;_F~E{ڍ @!`   @ @ @,c'>Y]_m4` @ @`Vسy @ @ P@$bvJ'@m]n{K @ @S `" @ @ @~q%n @Q7) @.`{v;O @ @ @0YoUN`Qk۟.jw @ @o `C @ @ @irtyڥ @9{ @f0=3  @ @ @u ^uj*N_  @ @kؾ  @ @ @0b{g&@@oGQ @ @3 ΃ @ @ @:rtUM#~[i< @ @I @ @ @@ tX`|I @(`{]U @ @ @IÍMjE@^iT8 @8WD @ @ @ȻE r/0~9ʐ @%`{PT  @ @ @a_7 * |u-rfa$@ @g >Ku @ @ @ 辀U  @ 0 jR @ @ @M df&CE"oUWA  @ @tاJ @ @ I:t_  @ 0 jR @ @ @ 6N0ؽyb&@ @ ~X @ @ @o,@@AH @aFUA @ @hT sN1#@@I/ @0  @ @ @-菀+ @ @{@ @ @ @ +( FK @ @H @ @ @~ @@oݛVI @}0ɝ @ @ P@ ',$  @ @}ؾ @ @ @ l:|"@@O>d*G @豀7O @ @ @"o +( GlZ| @ @@  @ @ @ c\ @@o M$J @ iM @ @(!KV  @+`ޫ @ @ "z+;9K$@ @ aӤL @ @(&~Xh  ЊF[& @ P:j @ @ @96}*K߲~K @虀5L @ @ @Rya @5^6"@ @ `s @ @ @N(bٻ0Ƴq$BH[DZTXD-)_iUj+|ZURڢ+ECQki4ĖH03}?yْ;sw~kγyߓN/3Q OY< @ @+H ,F @ @ @@k[#N@ TL(E[2 @d]@vw @ @ @HjD{/T<񓚑 @J^@vo  @ @ @TMHVI3Pjr$EpK&@ @, HX @ @ @':`S @jE&6% @R] @ @ @"P)-L PȤH7β  @ ] +#@ @ @\ Y1,wy  @ PKwoEF @ @h]jJD~z @XXWo @ A K"@ @ @ta;J<t@͢i&&@ @@ H.M @ @ @O(Z Et '@ @ HޞX @ @ @CNi I?6=0? @JI@v)X @ @ @#P99"^'%@@q T=I\U @ @@$`gnK, @ @ 1I儎,l'w @%% S0 @ @ @Z P='@ @HFX @ @ @#v$Ȁ@RDVa  @ P I~) @ @ }'#  ^UOFRF3 @ta$`zꩱFQG>`vm: @ @ @N- Ƞ@i\% @ @@ d&;[tiz뭱СCsύ_|L @ @ } _ @|koQ @ @K d*8f}ky5 @ @ @` )X'=BH*Iq @ @ IӧO"SLo|1hР8#fk @ @ @hAjJDRBM(Q'#DwWX @0$`K.w֭e-]4?ƁlIs9 /t @ @ @ T:|={v\z饱7;ovŰakfk @ @ @[ @ TN  @C 3 ؍,^8|wyg[ӳg8csύ-آ:G`Ŋ1vo~o%=cbԨQѽ{&ro~3`qGr Nl @ @B`MR2vs2٬O{,1*t@ulQV0E @(/̰;{sO}ݭ|ʖ/_7xc.a?a~ѭ[)7 . xW7tSЗ^ziѣ(]hQ\tE ׅ @ @ȶ@{']7~l؍U{TN⬌)P0g"6إ#g5 @@&`/\0~ߢ-Ї>G}t7̿K,3<3y]ey +_㎱lٲ6mZnO***r=SqwR+"̙SY O @ @ 'Hz޸ @ @( JnyX%;I҈yS +!@@' $l;y'@ @bV :ujviǁZLvmsIgώ{'=І4t;x衇wy ]vY,X N?izտ|]߶FW_*wމt\ @ @|ػo=QQ[tqɑ$=k @VC دZ\tEӨ /"MmZ㤓N)S?guVI]go6o޼\bv^B̜93d먣>}W&_s1 _c… I$.to] @ @jYI~:o-6k$@@1.  @ @`2]QQկb=-"/lݺu}'w"9srϦګ{}_t믿޸N Mno|}sk\l>ݟkҥqǘ6mZn!C7ͼ9ғ] @ @(e%=gm=m-Жn @k ص[ @h'vtM9#cРAq'ǤIZ"MNONS/G^Z|u]7f.+'d5v /СCc nғv+_3ݻ??zݮs @ @YjsVו,ڒBaL@RSq߬ @-NJ+۷owqc̙3s ip{]yCNye#H}k7[neC7x᾽n-[?5*n8 @ @ȼ@֓op{,pSKc$c @*'EԖVL!@ @ d&H7tS̙3'ns=kT&~ Ϧ8r7UUUQYYPF5ܷv3p.͋Ӟu]; =s뭷|+9 @ @ ibIn.ufzfqNx]= PG,g)G(6 @(@y\!7dHO1NOn|zZiw`3=n… _=lWSwܑ{gϞ~7 z̘1і+**"M:OOnd5u @ @tmbB=Zx"ߎ-F @ 7E z#<2?1bDtqs'>-ZhQ^Y[޽{u]dI^yM Ϗ/O>96tӆr{<#Mî&KnN @ @@*wa[SvEDՔ5}s(y-e]q  @O 3 /RU`uY'S7.]ڸ^ziMnzA @ @I7uԶ(y* @T*'G$QVVV* @ ,qLHP5kVqW d-{ܸqc喻zŹ"mz @ @JRN.M(*&J#2b 3Y  @ @(2;Đ!Cr톹V[fmx`qQYYϮXkkkU лw^˗/+TXo߾}[b[MMM\tEd^8bĈ{[|/X`A}[ߊS$: @ @h$P_u"r[(:B o\@*e}d @V 3 ؅ sٳgN;TJvܵI^lY$`Sd玺z6MիWXtiD @ @ *0E( ʉ%  @ @cJ:矏W^y%OgϞye 4rb{KwZzqی3[ni=zt'bϛ7… sf7Gy} @ @ @@I ԝ"@6,//Eٺm; #B @%,! cƌ,YǏ$Is΍?<:pUT.0x֭[:mVkZ)S_ۦ7xcK.Ç}%@ @ @ck\fOT8ѵ7Qt@EH8o3 @ @:$;M>sCEi`lv=l/=9m~VG @ @H]"$uTMnKW} @N {k@٦_eA @Zjvp 'İaaSN=z ] Ϙ1᾵^x˶np @ @( 8  Pbu . @ 9[nq5䒰kkN[ .脙KgO|OJO~뭷rbazb;emN ?CcĈ cvp8s1"@ @ @%+ dV`H`He},%@ @Rk]vN;-n&҄$Irm뭷^Mk2MӧO>iks~IwuW=AǎО>>|/O[ u` bȐ!yu  @ @ @T  P8 kd @@%`^iniJO#5}~n:QO}*&Ll4zwlrUGqD}ѱ馛6We$I4!He}6kQ @@f}٨ͭj׷?8#cРAqǒ%Kr/R}٧&u @ @ @ 'p羦/H?~1"N8ٳ'H*'Fo]  @ O # y$  @ /-y!CСCs ؝my믿>vqfnM7_:~ @ @ /^{o^[Ǐ#G̽a1}+G -h"@@I外;h%@ @./N!fmW_}uTWW믿;{Ŋ&>lsT[ox'sHc @ @ @@ƍ-jv{/b-b-l$ X= u'` @ @@ [6G>  @ @ 5={v}]ofZ[ݿ8[y_7omXF$Kߊ^[ x@IDAT@O>s'#7я~;S+ϟWW_aI @ @x{^ C>}4ۿY^~K]mq}}kѷoV8?@t#~# @ @@I <{ҤI1u<:+z表\^ @ @(V &\?pCo8MH^{oI-]=zSN9. 8{@R9!$` @ u H @ @:Rg/|]+2$/v鯷~{qOӯm em=O @]+8 @ @h /0>_f9sfs=ͶPztkv~1dȐf{g4ۦa%[] fFv @ P곟ll&y 0 /… WWA @ @I MmuW\qEtA+ȇ g?Y]jlHdҕ '` @ @@T @ @ @ Z5u-eeehѢXU%Eh,-ʉh  ^dyeg @ A K"@ @ @⋣O>MrAŴibرD&;`nj)P9k-j @hQ.]b  @ @ @@G <8>켩>SO=cvk[B$5:t2\3A@I $.PR) @@[u_2}F޽cРAqă>  @ @ @@!g֟ԧbq.SJnnwҢ0Y67bEn &@@$`g~, @!P6ꫯ/ӧ7Ȋ+b}I_4gΜxr|3W8߿1T @ @ @B <1tBMQKcX 0(\)A0C&0z$ |v@ @ P;OSlqyĉ_&O=UW裏#Mv @ @ @&9gu]+;xWCw1wY/'EG@ rrѮ  @ @0J{#h-[ofC榛nk>Fb @ @ @d Q,7:Xpa̝;7<83"E\fJbG.ŶcK @ d&{q'Fuu*Qyuwvmk_Zl&ycǎ|0N @ @uIYH|ںbԩ ݓ$+2>OČ3z,XufϺ Ъ@V@ @]K 3 W]uUTGK.mݶqu<#[o޹'?뮻.Nh闿e{ @ @ PYsfsK|gv-?4ٞʪəY @$ޟI͒ MP @ fI^~xL6-=0`@^tv[^9-g?޽{7/nЇ>PC^P @ @@G'CSu핕qFEGַIN_ @U/G @'w}7Oް78~%T74݌7q1wĎ;WgqFCek(!@ @ @]AЉ؅P{t 'ěo٦ӷvf٥YJEN @#P>ì(SL$I9bui(7I_[o5<0ܸ{4.ƿ @ @*'TozkrXk=P' -6>jԨ׾֦)^1t#@@.%@ @@[2q;３֝w9ܸp7.U+Z:gΜ @ @t-4vwxhOڨŞ|{ٯ_caWU}:ɺk;u &'@@75]"TA @ @@H~V馛VN>Æ k%>mo|-XPw @ @/HH8rȨ1O?t'|ԈdEi('#IjJ%q @ @Zd2_%sرc?oW׸ꫯFzƗk'@ @ @@ W^y /_rHnƮ!0x=z~F+$@@) ,?"  @@&{WCӦMK/$I|_fԨQyƅ^{-=ШnN_1F5 @ @ @@ l۶)4 Ʃm)LE |b.\ @4-tiVx9{_c6/==y⨣ʫK 3f%o1}z_WA @ @):w[ou'>޽{}u vED,, ХKn @ @Yf[:v)y晆'M駩3Έ 70o#Gd|3E_  @ @ @ |q'?xwxСDw޹v2)%\E @*'G粲Sp @ в@fNN֮^x*6|UҊ~_6 @ @ PώD޽W 4=cԩ!zYl/ P+*#Xa @N 3 iG}4/6a?xk>MFr'|2bU @ @ @!O|"~Gnq?p 0k ʉ%` PTvY, @ !P^Af̾}N"5kV @ @!_~yq?.(KN Ij#,DbHleI @\v}ni5*kכo9ve߿[C @ @]HOO}S1lذ.PKN`sK., @h]4[e @(@f4k @ @hN@us2F@_l PD(y(, @hM[k @ @ @dG Ͱ]wEN @:  @ @ @:A^Y&s"@vH*}/n7L @ @$`Y2 @ @ P_}l1~ $YRzFg( jH @@yhѢx饗"=bɒ%|򨩩Y%{k  @ @ @k#p-I'IAsO1mCJk^(7"YV\虌O @d3ꫯ7`veݮ#@ @ @VCC|_%_-]4>7n\^HnHt@=y6 @ @ ;ݲ7՝p/9v\v{'_g)Vk!@ @ @wFڼ/^cĺD. ح i'@@ 6 @2'c9&n!Y @ @ @`m8ꨣa-Zp@L22Y<췚m@,b:t @Ȏ@fxHO~p @ @ @JI#GFuuuaooG$5%HWt%@ @N(Ĺio߾q9Ğ{mY/J? @ @ @ TUU5{k?~x{x^ @ @ @9޽{{-&b}nWtxKiZHc$`w$ @ L$`O0!jkk@uKtM @ @ @@i TWWGEEE 8]+V?>w"묳Nvm??Uy_es#W@v l% @ @u[oU^K#Q @ @ @@I $Iw\|W^yc\5jT\QVV}lu<3dF`Hdf9B @#ʼh{Ｒ @ @7f͊O1}Xt]V_j\s5 ?zhw#I夆g @@\dd- @ Hp Bi  @ @ PRΝ{WL`6l_[RHECJJ 򶂒P @ @$`OvXnIo};6̙i @ @_[nqWh. 70|7E=!]V{O @m(ocw8qbX"Fn<9_y商uY'niwtws"@ @ @8bq'Fuҟw}|'5""H*ZDeteFlKWV; @@f:蠨l~ٲe1sܧŎ  @ @ @h;0`@qhѢ(//;#vmB Lrb60@=[v; @eY @ @t%<0~p c̘1qtJIvyļlSIւ @ @P9P @ @C`ذa7 ű`$PhE.-,'@IDYYY{h @Ȩ@fwX`AF, @ @:B@uG(h*'R-VTE,޶8 @ @2}뭷8 @ @ @mH$`KOdEru @ @ 8  @ @ @@ Ij#\'=B)g:S @8 gm& @ @ @@?Q=m}"@'` @ @$`  @ @(:Ik$n"$Yq~{LoI.(#YQUI O @%ʏ:nY?a­:?Ň?ᆺt e]׍K/4W'@ @ @dF YSީ<~|:q= {G$_7-Pd{h< @Ȉ@&/_ɺwuWׯnMnƖ[nooFC  @ @@kvқ TMj{ߕzyh8r>u9ٷ}W\r:u'dKQ @@j , @ @@;d"{ҤI`p;fmkzS^^gyf㯽Z^Y @ @&0eʔ8SF5*/^ܶ"@M򊈅/osƜ+>~Fe1g}=뮞 )TSe @^  سfʋdذay).yKP @ @ @@{8#}azw=fΜ٦u"@ Щ.}z{=W6Z  @p?I?X+  @ yH;wn@{&`oycKP @ @ @@qQGٳ>s뮻]wݕW@ $l`9ze+( @@ $US;tJ @ @@d"&/y睼ǻwwC @ @Z袋bM?~zo;VYo$@yIͷi!@8ͪ  @ Њ@&ӧצO= @ @ @yGy$~4?;~: д@R0gnTKE+^o7(Z '@ @@ d"{y+'M5fᩧ{b @ @ @A`ܹqQGEmmmC]s7={SO=f&Pd]0  @ cUS#]EY @@&cѣGC,7xc̚573gΌ뮻.+@ @ @M kQ]]tJ?cv[V $U?(&%uo8ks1-Z  @ @iL$`z{6pq'6&1/nx|vA5 @ @ @@'gOwk9c㤓NjFZ fEyN @2.O[sʫoK7ߌ?[o5nHVTT5UXti\q6wߝe7ͫS @ @ @w\rI6<зo߸ۣO> unXE%a @4*$IJ36Q @ @ g)o9v};wnò~IiV[m묳NC[zsM7?1cƌkO ={[n%zJ  @ @h~'OtM6dիWtIWa @ @ @"0U !s:NRva @(/k6:guV~q=#<'N{.VXʠk/?OcȑG @ @ @ S3!@ ,ɢע @ БMG(//C9$[paTUUҥKc 6GE @ @(&ʉŴ_JHK^+B @ @ +EFq @ @ @ZRvQ @`5Q6xBW @Ȫ@.̺ @ @ @,,RQl Xrb{ @(b EyN @ @@~][ĥw./]-(H @KjqΝ}***ro~lM9 @ @ @&Iz6rx59k-aV&"@@Z2 @]U  i?⡇W_}(++: ozѻwVӁ @ @ IXFkqKcLxɽſk9 7˗3W>Vg }  e(_ @(K^hQ|W_}Iv-?8#MYߎ'M7ݔKNVUUSN!C2 @ @ @ _yWg -_+F$V*,xvhUT @@TE @$Э{y5|N;{|hsuAŗ7n\ qaΜ9s_** @ @ @"PUwٱ<:gD.|ݢF$HjTH @$! O=T\uU92w;JV|;37OϞ? c̙; @ @ @vH*'mꯓ6\,ƞ+nVקP)Ti&* @tUbVnjy#xqmE>}׶0z馛Iލw5) @ @ @n喸Wl->(=gUOs+ @ ^`z @ @k<{Ŋs<8.UzGGzv+EŋW'@ @ @@ q)Ygg"-|zQg:!6Z;WޱjPW@RU]+&@ @@ ӱ{,*++"+_~yu]8s7o^u]yu  @ @(E .̅OĎ;7pC)+&%0ojDRS\k[_7F< &@ U:k* @hU 3f[DϞ=Ϋ+Daw>oW^y%@ @ @RG -M> _B̙3'MH*'vd8Sne1R;Pȸ@MFg3H#@ \U8; {{0 @qP83%"Q6' "1HDdI/Iu:[T^Nuߺ{={OK=v}'Psѯ_sj7`7xA @ @ Kq9紛wݺy-n(@nv74Z. @ @`U`曫ηƮ7p#_K  @ @Ț@$q-;*vZhQy晝`X!b- ERV, @ E/-iM6)h|`_A @ @, L>=x.< ԥ: jh^3 @Ñ΋ @JO cJe7 @ @=,W\qEf=CR_؀9p0C @@ 4"=_iH @(PV"@ @ @@G;v۸K;"Hgg` @@ xo(ݵ9 @e-P즦}E @ @r2dH\{qw[lFq5FG'IDJ[ *DO @2(zvJ @ @&0~xg_rA 'xbtA4!D4.LC%#%V%@ @* WpH @ @ :4~_]wF.NAؕޚ=!Hj_퉙A @Pje( @ @HGѺkoqʢHpZ>-S@!-YǛt'@ @voꛛ @ @= 馛ƞ{3v. (w{D ȟ @P]&d @ @ @t/GԽ]:zV 7g3 @t[@v @ @ @@@a]8. @@,1  @ @z:[n%}wyLB @ @hO i @[+FI @JD g͚/ @ @ @@YfE$@HZ+*`?;  @ =< @ @ @e#Ե|[eD  @`=r61[O9 @ @W` I  @ @ @u\ߐ ;"B`S4.+T%I @,(*ʁ @ @H@uy+?~. @<ZF~l ;H@Ñ$ͥ  @ P6 f%J @ @@nVMU*OUvoqq2/и$bәOS @(uإ'@ּ@IDAT @ @R'f.4t bӍ #d`.{lקQ{H9  @(1%`%@ @ @  qG?$eF )2tS>2.׿po9(NQTTT @@<ēE @P% @ @*pe7rJԔj*&PKhZVd #7qU\. Pv.U3 @%&/Z%`%@ @ @  ,577ǕW^kzLXV,pt˳aVuE@,WK @ VI @ @d^SO+V[o?8W^)A@zܬ'2( : @P]K/q @ @"pw]wn8ocر1mڴv@@( @@) $9%nb&@ @|`Z˔ @ @ w>:,oѢEӁHQ f'@@gg ) @ @  2#@ @ @=,Xicƌ;~: 9s'@@6Vʷ, @ A\T) @ @ P^?RW\qE߿K}u"@ܬޛ -dk=eC @@`gj9%C @ @@) ><z?aGuTzq(KB/TV_E @ U`W:ˋ @ @kg}+2FǴi8Hj_XZzJsDM @@YN#G13gΌXI @ @ @2N>xK_RȔ)Sb-,8A@JʥtaEXL$ %  @ m`W\7xcva6Ĺ=\W@v @ @?#F_c]w=3N=T>@U" JF pɄ*P @@ W7/naxU8&@ @ @@&>œO>wuWTUUe2GIȤ@L%)={Kᛙ @{#~Q裏{' @ @J]o߾Xy@$"=_.ʓzJ 7f2 @@j Cʵrʸc[7xg!]]  @ @ @E~^Hj˞ @&J^2ĉc̙k}ۍ䭷j3v7n\\yQ]]n @ @ @Hr5q  @ƈsY@ @H@j Wb-ώ׾|WRp~FSSSA  @ @ @@r6  @ǔ/  @H@* Wk/_=_Kq]]]zqV[mZ3ϴ]w@ @ @I%OnaGZ~ @ :`/VUUǏn)~s饗'?Ir> @ @ @n T?fn;.H~Y @)^UgȐ!1iҤxbqE~kOsz1jԨ8ꨣw]477:c @ @ @z $ճ>7 @. 4h'U' @W,dѣG9s̉7|3~ŧ?0`ԧ"{ @ @ @9]*V75DZƓ/ىX%@ @%_j:oy|_;.?U/qꫯƔ)SZ iw"@ @ @@\rP!V<~8?6"@@zY  @ @E  .k6>>g?v[8+5\{G\~ܥt"@ @ @Dc+A=n='/s>71%,P='$)$'@ @ Tuc-[,~_ 745ur'ƠAZ꫶6O<]w]TTTz1 @ @ @`Mܜ59STo5Ǚ2ѵ6ŧA}Sԅ08=+P칈f#@ @ ؍q=Roqv#o=|͘6mZ\p+}GuTTV\qI @ @ @InME_sQT_H O^IMI @k(>^[;wn~[cŊFnԩS^+>F߾}w>蠃[om-0`@۵^K.-8A @ @XU I#^" |pto|~] %di5B @@ ^;Ǹq??wm{Ȑ!qI'#<q':HW촟()jߺPR%X @2-_z0E-7pC̞yl㏏ &D+#<2c57}'_~yr @ @ P&?(McI_]4Ŝ5LF |3D6  @ @k)>cƌicƌ;.=fm:Y78vu֝/"@ @ @'fw" ZR8ڝeaqɿS|ݮ @%|'@ @ ;){;,4hP|snx`TTTlUhll.U^{*- @ @ @쀽H5O9ow v787oQ a?KDQ1wp @zD 5e/]狯;Uu{mC狽`q8 @ @ @ 5551dȐ.ԅ,$EԿTJ2>š߮m-^oo9mCq@@<5 @%)ʿ@mqyŋ/<@kv/ ƲebС%&@ @ @n~+7_mƃ?Tٯ*>}eq_fI@ZJ< @%&G}tk=W>pg>SbK'\ @ @ P[[g}vr8S⪫O|" ቁ" $ $nkcRźݨ7JY 4rb'@ @@ 矏br]+% @ @R)0uxWb{㠃 &e]Gn (NbXu*B@! =jn2 @.sL>jb_'I ,{'Mڬ @ @X7x#.䒵_:vu8bٲek$)|+ ^ P-;`{ @ @@ f=#[1_yov)͛6ֱmY[ @ @Wsύ+V{{]]]\xᅱ|rD*LXHDEM2D @ Pj7ߌn1%Kl0W\ @ @ @:̝;7nNs鴟@h鬖H  E$,&&' @@j %t҂_{ @ @G3Έ$i)~o;FI/ ()j%^%@@ƐU @$gy&͛WmQA[ @ @*0x;m̘1/"@ ;ICugL @4< T&j @2#P\}ձhѢm_^3uuu;7߼ƭo @ @ @ ?L2%hhhXSN BI+S#HVFEI& @(!)E{]f"_Æ cnaG @ @@ :4~'guVu] b„ 4(}$7@?G ;s @JP'b4iR7'pSO=5a  @ @ .;Syqzkeeekq/%"DJ(j*K @ "^8MJ @ @@>x'ꫯ_~9k'-Ce&4XDe-]H@[* @ q)>qM7ݴVҷ~;$i6xxگb8O~2>vv @ @@>}⤓Nn&@ ՏF$)Ph PVՏ|}*m @ @ =VO/oY[Æ \.zώ|;k @ @ @W;z @4-if&$ @ @\*%Qy @ @ @%խL668  @ ]Q҇ @ @(k!bܲ6<O pPED @@UZ|'5!C%,q @ @ @"jh^IKH$***h @ q`oV @ @ P%  @  eE 5IJ @L_H""@ @ @K Q ]{- @ @`i @ @ @HK3xQ @@ܬ(A @MqLsE^{Up _B,Y\1sO15& @ @ UD4d5;y"pϟ'w7XCXzv @)Pٳgܹs :묂vq}E.[ @ @ @^hOoo.u>~=19 }oF╨]2 @tIKt"@ @ @@hVq嵱+ڊ^|K},ij"@ ޫr"@ @  S8B#@ @ @R -aCX".v$/Y Oj @ okH @, T;[L3bĈvqGIJe8 @ @ @"[$>uyjU׫6W(v~Fh F9iJL @Ȭ@ /.]wu] @ @ @~c=5Q>q'wxƦsۿ=B3_偡ݨfh?;  @ @='< @ @ PL9abXE11z~: @ ޳R @ @<`:˒ @ @Xܬ=)Я"/yuSvщ= xeS @ @`M @ @ @E }#vZ8c=GwQk? ʁrP],G @R"_R0 @ @ @=.{rʊok#Y ۏqZOg"iX܍J @]JG @ @@&2@R=!*ݧO[;lQ~o(lN@ $-]#+w @ @E/cܹEO(~ @ @/>fΜٚmrJ|ߎ6,ːE˞ﰏ}>ub P9P'@ @*{h @ @ @ UI7ͶG?Q3&~ʕ+ۮ9 @ rs0MYu dNHVd.-  @ @ m Ӷ"!@ @ @Gnx'֘kŭ;S򗿌58A@ܬ')CȞ@Qo @ Uņe] @ @]noZ|_c>a_ Ƞ@ &%%(CDh9*G @@ ;x @ @ @ MӧOW_}ӐYuJ:Ȟ@Ҹ4%&#(:˒ @^MN @ @.YԯӁt @i1 Tύ @Q@vq M @ @@aw:cw쬛dP `VR"@hm&&] @ @7`9  @ @5N;-f̘K1 <8{2.G0QX @7; @ @ 0a„xb-X#>;Fy'Ⱦ@Tײk_  @ 2#@ @` @ @^ӧO|+__|1.2dHk#G3<"2%sDs}*BXo#Iv7 @ @@U_38#.k } _%K+F{)ư$@ @ @D{np cǎAh6&@v 6 @ 5Kd# @dOسgώsȝuY|\.y' @ @ Æ .'2)H`xuF$OSNd: @ @] @ @ @ IscDYNQn PF**Ŗ* @=.MH @ @R`ɓMS @: f-n @ @ Tu?[ou#F(hGqD,[lN @ @ @zD 7G1 ,{!*6ީG3  @Iؗ\rI<.Ӊ @ @ P N`5&@Mvo  @Ȩ@eF @ @ @IDTr  @@)$ݡI @\4! @ @ @X` xP @^P `z @*;++/ @ @ @ճWO P*+_RV @(%T%@ @ @%!Xe7n$0)y(ū#4 @JTnllW^y%^xᅶ^z)ni{nQQQQ i @ @H촬DƱ>R"^+J\tM QŖGw^ @ %T'ԩSc|.%4|4iRL<9j.ݣ @ @ Pu/̻%Ԕĵ5Ŀ>Xuuu}DeP ;vw @ i4fWSSbqw:{]tQ1Ҙ @ @ @:-+Qrq>!v?yyuDJsK.' A/FRn @zO u͋v!LK,Yo1>яƢE{7 @ @ @H .Bvu I+7S}Wuk @hFk` @S UصqQG… ]|c}m>|x}f͚Ǐ_];E @ @ @ [vz@6VĘI\X ^1 @XG2vɓ'\c?f̘Ϗ|osmywcŊ-n;v?qǯq  @ @ @7"j7K_T n+ݹU@vQy N @@ 뮋_+{ٳgDŽ b~7 KL81z꩸cw,w뭷̙3 i @ @ @e. ?GUWoW'wwOU`34,.'@ @@9 {ڴi;sw}qQYYG}t<[t?  @ @ @@y $ b{M*bXˏzWe'ܜ  @Ȑ@* ϟOZ< żk씽>kII .Ȇ%@ @@ +8qbwk}I& ?A @ @@R0b 噼77( pF9ocv#zU PNor @dI oFG>vwx`zA[ @ @9sftM$-_Eu躒鿦Ѝ+">-M:oA1uR5!@W<I^  @Ȋ@* WXQ{X;ù @ @455g_CP})L@U*3zx槃?O[~ \Lx@QHLmR @dM 5jT/XN#F5 @ @(M믿>{|8#|45=/衞ӌؿ"v2eWRl8m8K# @ PKرc Va֬ ij>[0ѣ  @ @@}}}L2e[?~|O @ @ PW_}u+=>n(s9-I#HN/4Օ]&@ @HEv>m͛7//Etw}w~mN816d @ @JO`Ŋ7h֝;e),]({"l/ @@j 'Op@[6wyg~Q[[vn]fΜsL477޶6ԩSe}  @ @HO~x;줓N޺~: Pe  @^˚^ =T @ ]9͛YmYq୷j- `lv1zvm[w^pa{ӟ=\=3Z}_,A @ @@7j0aB\wuno1bD] @HoHH.Ph$͍QQYrKʏ @2HZ^ܸq1wbNNc9uEl r!q$`fm i @ @/wo&_~9|#Rӥ?KީDa(@GC-&@ @@* @ @Ȟ;7xc<qG$xg+. @` ܬ5N9AJ{aY-d  @ 7  @ @!=3Θ3gN|#F駟CRH"C3` fi  @Si?fl| @ @e.~oV 45O@5hn)"@,Il+_ @ E/>}GN @ @Q֡?r%M 4D,}&b=VI @]8kW!@ @ @2!D @mB @ P weN @ @J in~r,hO 8O @N`wJ @ @ %OD4-D* @PmB @ P weN @ @K Py+[ Б@H=Q @ @)~oi @ @ @ InvSX7` @?4K;kŲeˢ>n$innn[[[K,~;;wnSLYN @ @ @Hܜ&(3 IKv6w @-w1uPޫ#{ @ @ @`,}:fÌe Ee%y @ @GRU{š?x" @ @ȸ/pv+MqώqLH@[,)*mDE @ ;I0aBQRnJE @ @)fe31YeFךbʯ_#zF1dPEfr)ȿG*N @ T%;#fׯ_tI1cƌXpaZ @ @ CM`Bvif]_6v?yE[u~Ϩ_'@: xHi@ @H͖ӦM[c9>);Clq]wřgc92,Y\.^xᅸ{{~uuuqAv @ @ @|=ѐ+|eZ?>~q_C45=i>Q .kr "{h c @@*v9s+_sƿۿG?"}s}^|e]bܸqqaiZCI_~_ @ @ @~]N]2`c\,v`̢ @ ԾI  @ +(~ᇣ `Ȑ!qG>}jk{~裏ѣ[/ĉ' @ @ @H.&76ߴ󝭧UTEvi.j(2"& @R,^{(_,f{qӟ"InizQUUz{^ @ @ @@ 4ؿ"F[[qɭvJ%an @2HEŋ w}]v٥txګ>OE]v @ @Ⱦ@|^D;OT%)pwo`" @fJ$@ @@*RY=zvqvykO>dA{ƤINbŊ @ @ @ fe;C۩^z).]^>z뭶ӵm @ @=n!{챸袋b~7/^{ fe/'eROsL()J@`s/*@H @HEvÕUw뢦]]wݵZsssok~FC @ @ Km%K+̟Ϸ ]Dvw O&ཱིV\ @@* lKaٲeq… έzxfL:5 ν߸ ?lw̘1m  @ @z^ ט8v~'|!v~g˗ tY PHD$w= @ @@WRS}+f͚Okq;SˑGn;#ĉ'MMMm$K.$nֶs @ @z\`bʔ)/"@$+ߌX Pv.ߵ9 @$cQGU7b+(2dHp }; >I ;4r @-)ίOmXQFE>} Ο~QUUUp:n馸ꪫk|K/TFN @ @Ȳ@]]]\p8`8s;Hrwy @]$"7ݫ. @ @ y63gƸq g̘1|c뭷kaNva"@ @ @dw'#G촟hW 7K. @ $Cq @'|L[mU<í{Gko[Ͽ˿ĠA /:n[& @ @=-/9O[lESo~. @3݈/vu @`mEbm* @ @@ u***㏏z*ϟ'O.zơgώc9&viM7O|qM7ŵ_@IDAT^ivۍ @ @(@~_jM]GQ L@(+E"MHmx @ @ I+ shjj7|3cmJZ(1C9$ނ,XlM9  @ @ڸꪫK.w}7/r 6 =(픚.Ͷ!]۝>3՟v'@%+PmQ1␒_ @(@U'[ouONi. @ @!0`83㤓N+_wԭ& @n $- Ef @2.쌯 @ @dV`qgg6? sIe܄f"@YbVr"@ @`# @ @  z{OYy,YD @(@IJ m?/R76t֟=#mZ(Z%@ @ @R-,z( @QHOD$@ @@O ;ԩSc|yמ>|xL4)&O[mUO{ @ @M77dG iyOP  @Tr}{1z⋻\|ދ.MM-Oz @ @ @H#><%HzDCM=l @JS u;`ϛ7/XpaDcʔ)q}o~6lXs3 @ @ r)< P"ISmTP"  @='kkk㨣"6|w}[ޡ֬Yb봋vH @ @R YP*(I!ђ ] @(@ 'OO>9wĞ1cF̟??Eov̝;wߍ+Vbرk裏y' @ @ @ `gh5B)H`@ @@RS}u/~.{o̞=;&Lo}ׯO1`e]bĉSOō7;cA[o5fΜYpN @ @Ȇ@Pl$# hlJ\s7Gq;Z= @"iӦ;}|pqG<[neA?A @ @dD 7%$#H +˗\AEUjIJ @yT`ϟ??x≶2dH79rdqc?#< ,x_ @ @ @ #InVF2u^_{oCrʏW+$qM1uXU>bW= @ZRQc,ĉ#vw_oL4`?m  @ @ @ 2@-׻^O2^~p)j)"@@wrvw @ @ s(~7 `?8 n  @ @ @@i $K#jM tM'cǿ^Z#߲ C} ~"9 @Ȳ@* WXQ`{X;ù @ @H@nNKDiJ<*0x@EpMh쵩8G: ,ILg @2/QF@4 :bĈ ^ @ @ @ eIΜ)[ħLx.؝"@@+#> @ @RQ=vYfxg n=ztA[ @ @(qE K|Oץ;%&H `GW]#@ @@ {ܸqja3bҥd1暶q ԧ @ @ @HE,y=N}b;{ߚb;S2Hm1Λ7//E$mo։'&lv@ @ @@IS'!|/.783}c5bS'NzOHzo~3 @ @ eKɓh;Oڶsr0s8cfmbԩ2 @ @ @@C)Px+kj'􏑛#b 4|n/ @(1"{Ocƌ'Q__vWn&@`OH67ȣWǴD@MZrp  @J"PYYMJ @ @@/^_~yQB<0>Ǵiӊi @? ;qz @$в7O i @H  @ @N+l tPv~W;F恾( @@=' @Ƚ@Ugȑ#{ @ @ 0@~O=TlƝ]rHwq @t_qfoГ @9쫮*t"@ @ PW_}jw^QώaÆx1N`􈤹3 еG"im~/5:= @ PBmj @ @2&PWW]vYQo&~: @Iʹ> @@1w @P @ @555]NTz]Ӂ=Uc;7 @>ЛK @\(2J @ @{1}8#V;oǏ_u [eio @'I잸 @| Te!'x"LSNsFmmm̟??[o(|i馛b̘1YHK @ @2)~==X\p+&rYgzEISߏkD @kG(7:= @ Q$qwĄ ,BZtզOxTVH @ @@ ?1fΜ^}wFm7h @sfZ%@_>ba7Ql_e @T 555qǽ#3fDymor-{4 @ @Z`+f͚s̉#Ft}@ZؽF4 @YH/Rްi1yc=Yc @ @^@|H fp! 0bG @@R… #sv4hРzc̘1]u|hiiY8ۋ_U;A @ @dH`#IS*ȡ@ۿIksTT R"@ @ SN9%{U>E]OTUursss{\[4/'tR~E5 @ @ @l q3[%Zȩ@K}YE @5 T]1cF|E.q}?8_n*f~q=ă>~`wqG{njSt/~񋢶 @ @ eIĂ6= @ V/ @(@* ;TTTč7[mSksȑq뭷:qopŽ @ @ @ CG$M X @ 9 J @HE?uuuQ~򓟌O|qI'uܾdɒ9sfG @ @ ;mfgDJe R7SJK @NRQ=gΜ8vos-jk @ @ @@ID2IT @(HE[վ[Mc`Fӽ @ @ @4I˒4f-7WmӃ] v\'@ @ (Nw 7,jX-p%@ @ @J!0zD\Il\;|>&o D^ @ {رE|f*j1sfnlIos/ @ @ P;lݔe#[+Ǝm׿)["nϿn%( G,{ @ 0,~aƌEcmfEm  @ @ @ 52 dK`qKcWez^;`gkEEKD.i  @(@* nj뮻nw~?5 @ @ @t $ͅ52@~tkŅ+F?S7W^c@R; @N ؕފ/}K>Zߋ׿x;F5jT; @ @ȀG" *DsAEmuzPۃk?=֦5vq @yHEv?A8sy_P-n_zq7yI'5 @ @ @ $ dL}b~7ouQ܅K@ ,X*Xp @\WU(O|qG6a„e]onw}wqgFgQtN @ @Ȁ@ 3(p2ꖶ 4vO\@ @O*M)_~%{gqE]_l6ʘ;wn̙39sx;Mꫯ}^s @ @H@\pV: |rskZ%AX@R35*/$2. @ v!.8SW駟³'E== @ @ @@ ?0Sȷy .n4]GWG**+_w$?=ƨB @e!P,oM7CW\qE?H[!@ @ @!LF/]?XoSc*s׍'4XuOqGZ>ȱ`F9e,W @\Ք`wq1cƌ?>xNn$@ @ w^x!,Y4G@`gyĞ] ]e~޺1a5t[ݦґ @ w3gΌs9'o4hj+++c=څI&߳\ @ @ PIGcƌQ___"'@ mI∅-,ȝQ?ph̸rx^n%D`4i @ Pz҇>DYxśo555` ڟG[o̓J @ @@wO>d{;N'?38}u09 @ZM, ;]W6,$L ,x4eQ1hL!x @tG 5,Z(,XFZm#Fwq] @ @ @]tQQ8sK/oo}+_>H恁\ @@oZE,x,bf @ @ i+m&>o~_w @ @@.瞘5kVzwi'  0 Sd @}$P;2  @-KF;IOC9$r#@ @ a /b]wia'chc @$T? @ Gy|_.jk @ @ 7{o^qǶnU7  ??cE?c @)HEs= Ɂ9' @ @@wv4hP{@R3w(@kc% @(T`/\5+=6|h @ @ [W_}5y.9cbw첟76  @HF&@ @ 5(u]W={* @ @ @wF9sE]naUVVy5'  0Icmb*s @}-PCT}Mj< @';,v"A @ @@s΍K.$6d:;vl9  @m%: @>X03%}4a @ NT`WUU-lAҍ7_ע @ @N`Ĉq9+^zilfQQQa#6=HjC: @ $> @ @RQ]oɓ'ޑc=7M̜93.\q @ @}#0|83 ΢f @`-`% @ ]>L  @}/PCl'x"E'?;};'xbǠC~c1hР=oݮ @ @(+C'?ɲYO YVQl }i' @2(C9$jkk$7o^?ܳ,R% @ @ @t Jof GyqTTG @LW8!@ @ @Y Z˝C i}(Ȃ @() @ @ @D KoZ зIo[Q @ &8-ZpA @ @ @읈< @~~a5( @HM]wݕQ @ @ @PUw @XD$M bݘ @(@eIg79 @ @ @~ @@sT @ , @ @ @P]J}s @>>'5  @)P @ @(gdK^)gȅ@$Gm[La@ @\ {/Ʋer,) @ @ @ Z]L I:)ƒ MDX30s @(Pŋǯ7n\1"6`ab1v8?aTWW  @ @ @R $5J5y @KN7Mj/c'4Ss[GeQ( @@L@ @ x-^l}I'}---s8cwn! _UA @ @X9^\Qb)q¥ k(^7T`/@9 $ yN @ Z=~8cwhMMM|q/ܭ{t"@ @ @%ԷF-2(zo,\/~F- t(p@ @@~kԩS#E~7 @ @ @)PU Cꅕ<۶+m{%M'P?;/o @ k)~g/rРA1f̘]wi(;{"W^yetA+Zxk/:thѵ @ @ @@N$i(?ћU |Ba NȘbs#YۮQ @Ȳ@`O>g/~EVlSN)=i @ @ @Hj`gsDM|~HT㐪x?/N[7lEh]˞ @@W_}p ':_㤓N*:](.a{ @ @ `E @ ID>N@v2ppU;$/jx\=~z~?Hjf,b @ @`[oU41c]5FJ~{sN @ @(G+"g?٘5kV9ș, ,z2i~3;m?:qxqW׍-6 UY]9q @ Љ@dɒiGQ1r>|xQ 5 @ @Eg?Yv;b#<2O^r&@ 5S XI`ˍ+cӑJj 9eoERB0 @:WB-[V4:SNc*VxcɃ @ @@ \}ձ`"{'87n\L6& 3mK" п__ @ 0`^XilEVU @ @2/|w}qAq>. @IksDC  @ $bMG @@ {vkkkQE4 _A @ @ڨ`ﲏ(™-u%ڤ @@jKdoZ @T 4Z @ @ K.K/KM74կvODfjI5) PBڈO0S @ @o`Q @ @ _Ny1lذ.@R$5SJ19  @R +`~ @@@v  @ @@ <]NFJ!4D̟^IX -%^ @  B @ @P[n'YO?1bj@ ,x4uYIC09 P"#IZJ4i  @ 7 ( @ @TCI&ŴibܸqEs92o @@)i G, @@ 4/X8k g4 @\@v @ @ |#{7OGydą_0Vfޡ? 'jʅ @@Y Te֒&@ @ 3/xcmYv!@ OI3\ @HjDg] @ @ =^}-3 @ @ @ eI NYT!@/_bi/?5Ecsq4WXE@Nj41i @ gy^] @ @ @4TONCb @ %cOk΃_qݹr&HC @@`}G @ @J,L.q'@ M6(6YːX`.t *ʁ @@Y (., @ @X$i6T ;"ܐ.c^uj겟d_ QE @2P]f .] @ @ 0 h^8S r}]}mh RfJ/p; @V@z @ @Zou+ mevN[q^$w#@ @ W s!@ @ @H'+  o9$F<_}{x˨Awr| LW>!@ @  s#@ @ @HZ"?RL@V~mߞn@H @@ (. @ @D'?I,[˹;.@T TOJeX"@-TONw#@ @@l @ @Xwމ믿Ywug?e? 6͈i K< @@|+ $F @e/ @ @ ̙3cРA]N}/***R'p*uK"  &3  @P].k @ @ q1w8b4w19N9I $Փ @4 ["ͫ#6 @`5 @ @ P 70.B /0 {nTVznEdHfr* 6fRB @SġA @ @`` ;`1gΜ0aBl&1f̘86 @F,{F3  Pv.e4 @, (j @ @ 뭷^|m/ľ;*J T۱2+,= K_  @血¹ @ @@ 6,v}ژfc @ K @@`g{DO @ @R#6G앑& @P]6K-Q @ @  AՐAb~mWߵ (]""1; @ tD $H @ @T QS: ;˻["~|]ҁ@V'g%Rq @ P `H @ @C im}?6&(+cIA@IDATVnVgeeMq$g'X @ {5*%H @ @X`-Kz|  SX.؃=Uu㗧#@ m5"Iڶ @ @@ ``@ @ @(̛ŰL@NHU{owV W;l޵, -м0b6= @CjB  @ @Y9sf<3Y _@NR`c//N[7l-^Һ@z޵ @2C-t  @ @^`?x'~# @ IR('c~5<ƺ1jSo}˵<j߾Q+/k @*DDD @ @>hƭ{g|3Y%fhJ@OݕN @ -6g@<IG)> @@eR$@ @?.h$ICqGgu @@Ns4 @$-52@  @ȯ @ @Y`ĉCv{'O~>. @ Փ2  @ XvN @$;O) @ @ 2>OvOdI )b,,V @ /> @L (  @ @TSLSv9QGcǎȔ§L-`  @@gG\$ @';{k&b @ @tg늊8S зI}; @k#oҗ @~P$@ @ȷ@]]],Y$?ne? %$iX  @l 0XK @(;*' @ @~1bDeҸ@@̈h^ Nd]zr$I,O @@`gxN @ PZqŴi>(O}S{ @@.'" I @hX ' t @.;+(~ @ @ |I&ԩSx{e,!u*4-X8#ɋȐ@RCaZ. @ȝ- @ @J-.: @jF$-3Q  @k#0z$ks @3}Fi  @ @ o;M{}eG2%4ENTȂ%@ @ ? 2!@ @ @+0 @HmZ @ З RX @ @ @ "mv#@2(P=1A  @<(*ʁ @ @ @@H^nY˗ @(N" @ @ @@=- @蝀 @ @ @(@2obf6- @,W_ @ @ @ @ 5#IZ  @Ƞ .  @ @ @[wƅ,[h@w @ @`%ښ @ @ @(k[㧷5u [m\'\6K@.O.R @v6I @ @ @5qbۓ?0%7 E`@yd @ @`~ @ @ @ {׫[[۵^_uWS,k*N巓iRsI--H;F @ +عZN @ @ @ :˒c|}=MѸҒn H@Q35mQ @ (J @ @ @S':9z${*WsN k&73 @e'\ @ @ @W u.حv.gN`̅,` @+;k'r @ @ @R` +㫇w]In]גWwX:7K7  @(+eܒ%@ @ @ @;G !Ukvf:d}\%@ eOY@!@ @  "@ @ @ @S-6D`oyE\ں3O:I@%A @XgY @ @ @ w.{-*W^78yTBodBfj$MU @d[@vO @ @} kŵ^}0! @ ƕ;nYuuď+ډjZ#?. @ @`q @ @2+0a„?~|lvq5IJe2  @/׉ xdI ɼ8: @ yYIy @ @H7ވl_o~W_}u444hL7 @dC`ЊF$@{O/ @B@v/J @ }K.d Eַ J_f @ P.dٻ咭<  @( @ @of\m 망vZq @L.)[ @ȟ @ @)0a„Uv/˝v @R(k  @yPՔ  @ @@z뭸;Ʊe? @ @ %G$) F @Q@vWUN @ @] ?.1hР.@ @)hXxJ @ycRr82eJktMcv~1| W^>^x7bҥ[ѣcԨQnEe b @dD`7[//^ڈwa8V{ @H@_#F~  @ ( (7M,Z(=/ 'oD*뮋￿;vlyI @yǏ/]$.v8{  @ @ ,/>3wľꪫ ~E  @%DTO\^y˖ @h+JMd&BSO=#w9~ӟȑ#;~878 7Da>,Y_W^kFgO?pK.m>tx7.ﾢΝF*:A @W6EU һJ"#@/F_Н!+ڗ п[_ݿs @,ˬ%co 6 ~R|]5\mQG;7SL(.sǯp`{1x(br-h/ @ @Ž؊;q @Y71Kъ @ (b:ٳgc=6lXG{BŎ_Ӄ.O8<#b_xᅎc @ @ @ C7"Y\ @P]ӧO/C)jw8C;N744ğvOuܺ;:^;qPLv@ @ @ @9w_ @P]bC H6Ǿǧ/\{gw]{$&+Cgkt @&&|ZيJ]褱rÇwҫNM:5.;רgvynSOcٲe @ @J&P35o,Y&&@@i+e1W WZ㎇iZHZFŠK  @ȦlۀGݛ [ohWO}Sqgoor7n\V_ @ @ PJ;ARdQ`;鋖FW_[3e69@nZ6Ъܤ$ @J'KK rŋ}Wck۫\+_j}ٽ.^. @ @ @ n"'@@ ٬2tH{\}Nk޶ th @dY@vWocb-ynϾr_vcaԷrKG8K_R9 @ @ @RBҹpDޱĠnzMEukp_>__ @(#n4PFR]!CPo/?أFaÆuyOw;,Z(N;2eJ-#F.,;찎s @ @ @`%yY&tG`׽].1Շ ,y9l: @ _]>l̘1c>]<3]vegO?tP"뮻.>ts@ @ @ $v\tS]+ޅ=cU9n >6`&"@ c9^ܾNmo^믿n]wݵ7 qYg?1N;^|=zs @ @ @`U>U/8CضmBʏBg>^o[y?h:+$I˟+_[=eʔ{:Nmq;9 @ @K`ܹ>W%@@C8 @`'TO];,n<{h츥_W rH "36Q @ U+3 ǏGy$cٲeqg%\OQ8ӧOs=7JUUU| _(bs{svXwy˛?[[[?yGpP( 衇uя~4 ֝ @ @)zk:*ǮG NnjGo=Ȕ@hK @@`k=R[orJ\s5644g;cG3^hzyBb-ry?xx׊Pnc=T], @ @@^y ߮U(ľ裏n/;vl^ YlD?  C9\T)<F+% @Xgۑ=(*5t ol>qM7? Džs]=^|{u  @ @ ^hjj*J-Z7|snqǷvQA,ਜW_ @@A`;Ž*C%v-`wT@g7(vv@uc#S68 " y[Ar| @ @y'|2~}mݶ)o馛O+_| @ @/p衇ƅ^X1e]x`y& @wU^z=J[\xj]  @ /{{LYy\ @d@`RrB&M;󆯜"} @ @ G?x\|3}#Hy& @)޶EuSԭH @~Uz&muLG|&@ @@E g@ @ @ ַbf_ףҩØ@B9C @q ; @4wU @ @r/p[as=Cаs  @YRJKnlrI(Pq  @L@`* @ @d^xGyq7{=h7~=4#ڛtE @pڠ.. @ PQ@vE" @ @,'~_u]{T7>!@@ , @"R"@ @(4`t @ @l ?c̝;7(7_O"@_ @Ԟ+ @#Ѐ=r+3  @ @r ǽs  P,f @@<͒* @ hfH @ @:--- $ "R%(ը P=scjՋ( @M  6Y @ @ NvlW= 0@!% 7 @Ѐ  @ @ @8)E,TTU  PmdNCG @@4`|G @ @M.M| @07<6C @T@ @ @ @ %7" @,г,bE5/ @P@L#@ @ @蘓˴%M@Z=E @ '@ @ @Cu "V=4Ĩ @< @* hld @ @ȧo&@iu].Pzhmk OD @A@vvI @ @ @` IcPs /ж?ϙUΕV$?;@ @4`4 @ @ 'Է.<,W4gsN\?gCiWt7 dE !Y y @ȼo  @ @ @p[ @V]'WMzxmw/u  0@Obl5 @l"{ o  @ @ @@QXTEX>7..7^^kn]w/ۤ#{) P+k~Ht%@ P( ؅N @ @ @: @ LqM=jX)+%PUT @EЀ]U @ @4@Z`MY2%rPkŴ{#sS+B@b @ 'p[  @ @hzCM[8lm[*&x=TS+B@6;N1yk⬳ΊRN`/#zW  @alhn&XPKn=Ԩ @4& | @ @@~D{{4,Xԧb]v /06yC 8qx @ XvH @@s hnV- @ @ S+WSO=uМz8Cc]wj9. @fovG @ $+ @^@vX @ @ ~lٲa|wݰs  @@DZhĺ? @@ Պ$ @Ѐ] U @ @ /blM| _84-@ U9p @_@vP @ @\ r)jժ{񒗼< f'P? @W? @^@vP @ @ tww%\R1qGWg] uwF, '@T]CnU' @@!4`bA @ȗ@kkk~R5p5[\` @2!;  @ @ 0B忎Y63-7MJػnz{]{~mOWǫ[cN6P= @&ЀO @ @gxe9JMد 0N_W __$3@۽"@ @ @ @ @hnRxWzVON&?+}&^]ۼW:% v?{(n{\'@ @8f^ZUB @ @r-V=[0;Kײ||}_  @ 'Eq L"06! @ 7 y1 @ @ @@ ޢ3.]+6`?M[A`7Lw9q;['EՓg1 {:ʇx @Ȼ  @ @ @iQJg&mR(j-0)J>ݓsmjLGZJ|5&4 @Ѐ͐  @ @J oxϞ*ƺr9  @`oeb|ͥc7yޓMs?UL ބ[5Hm$ @d_ߺG2$@ @d^v}ݙSȵ@`',?ϟwAȒo-cbiq[^91K)ʅ@Vi݂bר: @   @ @%6N8x[<Jź(@jxbN~~kʧ`O{_  @`jbiq^zn'06A[(w @  + @ @2)/9RJrk oxCr!SOe2_I @ geD睛?ƫ7Gnx=V;U# @d_ u62$@ @^noq@qk_8裣c 0%֦7Ο{S>{-c @`~YcF\#@ @ J#@ @ZK_ҐKtww~i  @@e-OVZȜWsϫ  @95 -( @Ѐݽ @ @ 3gΌsVooctZ !#ܴhج$  @9a"m @F,{T& @ @hE7@C k7|[sO-6G @ }k#ޖM @1 @ O2L81N:a$@RJm6ifMy7 PmԾCs^A< @$;K! @ @@N^5\wuW{r!QEXqODWf4.o# @GJC @E@v]-B @([ꫯl=eʔ7Y̢UE: Yu\R @c^cݍ @K@vK @ @L pqyӧO|3W2JhG;;W{(Y @iR5MSB  @4fP? @ @@u&N'M,V=&P: @ g^ݜ%-] @"챨 @ @`HSƟٟ 9nF(6ki. @4T`ݼH)X @hU @ @ @RP أ c2 @@ؖ"@ @ ķ4 @ @L }:b 9{  @h9Ȁ @ h9 @ @ @(=g:]#yVwF^ @8V?i @A@vvI @ @ Tm֐NX{ @ m:} @ PY@ve#3 @ @ @@Rג忮zY(w6fi @j,i&5^\x @".!@ @ @#h4 וGi @XqOWD @2#;3[! @ @ Pjnz +Ks܄?M!@F<эpff(% @ %J @ @,z輣bg[qNv'onz2#@@ x}iea@IDAT5IMz @ hܖH @ @V=#,?q)a @@:WG;Z@:e* @@ hn֝W7 @ @dN ]=✦Ͼ4|t^|)a @R|YW擫'zz_(Ŝ C 0b :1 @r&;g&] @ @(@]SMeŕԄ]>Qh:TS 鎝__+| v3xh@j[ @ h! @ @ @`Kn_?g1\n⻵)X%~zko,^6|sꏋJ"<3n%@ @ 3"@ @ @HmWގ}7э1po+[jbH @`6eDpQWcFTI#z":nhV%@ @k+8 @ @,J9s*OdO(r\i݃@D i῟TKS@횡 @ [ ع: @ @ @@aѷzL}GWץ @ S9tJLX9Eoow# @Ѐ} @ @4@5NF>XKD;TG5Go 1[ŕo5@]'4 @ ' y- @ @ @@Ro)纪IY9 V4A @/ڬ/kpZoI5XUH'ڮnUL @ #@ @T뮻4 P+;"zW-z㛰˧pٷm@_dB| ˍ'~5?{8l1aBKM@S t)KW4 @ h.Ϊ @ 0իWǁ;Sx≱f͚e TS 6Ě>үK_fzo"@q|ZRn_9hJl5E88J`pKo|U @r);&i @ @@uN=hoor# ';s}WD!@aR*aup#Zn)_u#v9~|}{W/ȋ@;Ni^N -vE&@ @]wr  @ @!hѢ8$x8#b=Yf j ˈ~6RoQ?SPFKRzfLȵ@us]  @xA@  @ @Jk_Z]vК~8o{%/} @WDw]geތwo|?ԛU]g:԰ @gG Z5*Q'@ u YOP~ @ @cΜ9NO< @`li/v @)г<|.k @h @ @9vqNJ|Zq  0zRD5 @HmJ @sV @ @4~|>tІ>>rL\",I @j a I @ n9 @ @@vaK7MviYLQN(Dt-.N=*!@@5R1 @L LT6!@ @hoq4@jT# @P=":w5u @2.o @ @ @8)ſ(NA*!@@Z졼1 @@F4`gd#A @ @M 7]P% @ +vM7 @dW@vvFf @ @ P0Âmr @cYyu @ Ѐ- @ @4@J)b/T5 @@ -9Y @ E Y9 @ @ @@&kqR @fE۽"@ @oq @ @h'6N 0Bewpi @dI@vvC. @ @ PH#~QE6XL63\u @ hɏ @ @/"_  @0]=)N;^5zim"l  @Ѐ}% @ @X -2KT=O/E|®Xrf4@򈥷5= @yЀ/ @ @J _*g @ D_صqO/4\/X{3G<M-lO @ kr&@ @ @tѽ4?ʔ@`qåyzyw,^?ȈK h6R@ @ 3A#@ @ @| W @AN;.w.8y 0@ʈ%7 ?( @Ѐ  @ @I f$ @ 'skh{r+mHg6O*%@ P D% @ @ @@F:oYE./_Xk)E|,`W2@us @ @ 'sQ$@ @ @ 80{&c1hWoRy<4@ߚ%765  @I@vvK @ @ 6+7JV`' yS#Nxk<|P<'] @[nN6J @ @ 3%7E>KF'p['߿~7'cgo_9hJLm|J\ Ќ7D]݌ @@4`n$L @xV ]tQ !@ EWf0+) @ q `iq綊oGW_[B h%* @@Q(; @ @cwٳg7] &@@Rڈ3Y# @@v叶%M;OSE+v @r[ @ P5kė {x?pu'~}D ۋ4uJ|mZe#,B @ P  P @ Pg~hѢΙ3'sg?| @ 8V#@F F,0( @@Q4`ugE @V駟}{?cwGqj+zXrSm @+* @@ J!@ @Cc|x衇cj$>+F%@(@]: _  @Y@vwO @ @@ qqWT/}i|[ߪ8@ZT_UD @G,YrTB @ J"@ @)s̈;G4$@ZyGD ДiѕMY  @E@v^vJ @ @@ ?Ŵiӆe]⨣vA@UF%@h)W @&;o;&_ @ @iZ[[|>džt83bC @ E. @%W @r$;G%U @ @@Y`q%]wo|}_ 7_؊ @H//d]"@ P EE5 @ @M)𖷼%8/S˧_{ @@P x @ *H// @';{{"# @ @&L~x @@wgDm5]Bp @F'{t^f @ @ @N"\t @@ZZ @1 h# @ @ @@,9g @h6Rڮ!: @#Ѐ=b*  @ @ @@'TK7̻{N[Qj"@ @  @ @ @ ե&rt  @@n]oqwǍ~2$P':d @* h$d @ @ &vMDF\#@ 0?М+ *g_xU* @@C4`7ݢ @ @ 54'YKI> @n7ٵˇuENJa$P%s SB @dI@vvC. @ @ Է6bѕ Yۢ @cWT?k @ 'iE9T @%PoG @ @ @`gF: @\ Lg=eD_rGo5@J'`ܗ @YЀ @ @] I״  P]\1ֈK+3@!R_ĂE @Ȓ,\ @ @ @i]u-HT_ໟn2d81['["$iEMR2  @O@vD @ @H ~mK%Ĕ-ENO;n[Pl5WŮQu @,ou @ _N:)f͚dN[ҏdd. @8mf>x̭ckh64CͶ%@N @D`ܹq 'tP2e @̉hr @ 3S㍯UuE-+REF#H=+Gs @ #{C @ @@OOO~߿.׽uq"@ y @ z qlom`îh>u.oUL @Fk+, @ PN;-x-_|CS;x'@HF,)ʒ @8  @ @@RJ_$eG @iy5^Ax @Ѐ]U @ P%q7;C_ezU. M`mkr"@ IF[$E @ Kr$@ @2#ƃ>]w]/L^!@ NY @}&b.Qq @j)b @ @6mZMQ(@jh% @ҼG&>uӛFzyr!\l$  @2$;C! @ @@숮*h&kS|?{_Oww7ZA`zV4Cj$@ P Ua @ @(杓ŴDD{{c#9szd\nɾ| k ~$O @m- @ @@ZDDu[B @@qJ3.v- -^룧w˱-&@ 'iy9T @/{  @ @ I@`o8jMa%1H Wk3 @4L@v-L @ @H}ZK .0mjK;'ʓ/tye @N @ @XtEDFlM @_U3GOo*@J Ph6( @ Po&@ @ @YHOCHurK1w_uĿ5&OjQuR%0@4a&"@ @,Pᯋ @ @ @@+WҲ%@2'7;O/}uȼ?'o8dC1@ Ώߓ%M @^%m @ @!+VhȺ%@ 8qV&@E8c۫~[}ڔ}fJiW>phI;"ڮiM @`d682' @ @ ̜93viKs  @`,kic= @-Z'_[vq>{ .ȡ@zf-e @Ѐ]?k+ @ @u#<2-[|ptAY ,E ADboQ PPƿƩ}wq{f/V+kS忎MxO @&f  @ @@qK,Xe][̚5k5o @X)EwnR  4%֘0%H@=gck @ȥ\n  @ @.袸ꪫp@var-] @ _~a΋> @,yˬH2 @ -  @ @?~|6{{3HHOeK @ "\ F @aFoa @ @)8CgzժUW< @ i#w#YY @ȉ@YRN& @ h @g>,?I肮KX ȂQqAE` ʂ"E "( @ޖ*HǎԄ1!={>D r;uy{߹ev @^袋⡇.]vNIDH3,R @(% -IJ @(0ۄ @(|;j @ @߿-f%Ȅ@yy&rA @ /Gs.JU$ @4`w$> @ @dN .s[r D @Ҍʹ< @贀NSH @ @umD63q!@ ODZB.JU$ @4` @ @dN "ͺ&s"@ 4x`lCmle f\)u [X @@f4`gh#@ @ @7 5}F  @2P^Դ2ίE -oB 'G,/"@ Ы{ @ @ nqī퉥A( ǎǬg`=oi.)z6@qIwK @d4` N @ @ ̺6PJ@ӯWw?ՕSj)wb\W> @-4` q @ @$k#,E ^<0>g6K4S @}#й&]  @ @ @@Ĝ" @q;.᫻w,eDffNfB @k+= @ @ @K)H3.\ @Y]݁ܜ}Vd),H M~Ec%@ Pf@C @JY`…Q(J  @jROj= @@'\aً7o9ͷ|&P\~Eid @@hDK @ @;c={v@~QYԡ @kW~plo?_O?45#@ʈ&l/ @y\^NZ @ @ 'tR<#;2X<m鈥O6'@U` * ZِcfzP ͸ @ @Ehhh<0,Y/B|믿1n @@ 4qNVE @e-KT @f ؾ @ @>8SpիW{ vJ @|RˆWo.TB @N:@IDAT Gi9V @yЀדW7 @cG}49Ni3X @" _  @Q`铑>L # 9:l @ @, 47U?0[~ p P~Eה~!* @ cO+  99he @ @ 80.o{ڌw6Ae&0뺈&l/ @JW`_#P%'@ Ё&@ @zW`}c;b>:򕯴@j4,NU @r&]K ' y:m @ @ Gy$FkR~C#Gf4X +QW( @E{{YEv @#8v!@ @:߿򗿌/[m ` P.)5F~Q @7 @'Oڪt_`U @dW#.n> @tQ@vL#@ @zO2dN i @n j"͸N @ {w& @ @ @ _ rBjV- @̺&RTN @hA+ @ @YHS=:g# @n 4yU @, hiB @ @ E"?K @ _iVh @>^ @ @ @ iy( @_1c @Ѐ @ @yHKGG,y,oe Ыg6=,N+i%k2 @Ѐ# @ @HSG$@I7ǎ +Ү!I @ȶlt @ @(K칈em"@[>їķί=`#/6;+*R/& @@Ih.c @ @%S^ G,,*s:  ]5"MO9+i @ e ]3 @ @"VX׮L5 @ =;SOOnzUO"4`{:{VC @ hY @ @ E4ӯHg @`gZW\=fR!v? <{Hl6mot>[i`gD!@謀:+e @ F`ܸqq衇ƢEb. POp @]п"nx*bop4_"iMO%#@ КT\#@ @ZXxq|K_5co}[QSS  @@Z1׿A ЋO'CC{ŝ,Mg"zvQ @e ؽ ly @ P.nj3Zt7Ʈj{. @O5@(N+*]@US{J: @EЀ]$h @ @R8lgy&vqxGO 1+\ @tZOx  @> @ @⢋.0 k_ZTWWw8ȇ@|J @.P=3t} @,#@ @&0w8ꨣ:2~Đ!C:5 (o왈-"UG @@Dj푵,B @4`  @ @@ [o56h+9b=p 4(T @t_fN+u+ @(" ۂ @>OL @$`-K @ @iF-K$@R#?T݇i> `k @-4`4q @ @:)jE̸ #@(5'^8šhh8ֺV%.^:+ @4`ۉ @ @EHSΊ(TqG[ @K._޾S&P!HB @@f4`g(!@ @ @@i U#^BKK ) IUqc-3c⬦7^$&,R5W$n @t   @ @ @u4鴦oJ P?v\U-_ٟUǼ%m)Y)jRī7g3T @Ѐ#W0 @ @/<1O_  @8šxyA0׬1_8:Vt< 4:1 @+w}N @ @HO.˺E 7ŤW 1~`w ˠ ΍~Iױ @n h& @ @ț@sGgVz  @SĠ헼[+sN+.H/T;W @Ѐff @ @'YK%@@HN+b @tU`m+9}'54>4LuHn@H익J @; e @(5_|1r˸㎦z @xY=u @2,pnCH+㱑C xH+'g/ @hEwCD @J]W^;ϟ\r%^ T83D @b 8bkg M6X{(DxJ# @ 'A @ҥK3L̞={MaB!95>쨨:q @xi ˋ @2!p+ aq7e"b>$  @EЀ]tr @ @}'&Lh'X9眘3gN\{1`O4V&@rH&E̺JR  @@'*++SD^$&8bODE?/Y:Y @y藇"H @ tPE:%0S:5  @WGZ5O) @@>4`UM @e(;x׻fup@9n @7 ő&K @ @ {/8{$"@([ e{ #@ @< lvO[oݢ=#~_GEEE{. @Ҥ3"v5 @dK`%[!@([ e{ #@ @ lcŎ;`}1p׼!@ /DrC{C#@ @@ē#5f*0 @)R!S!@( s*!@ @ @@?NHh2 @@Vפ.5@ U~] @ {B @ @(q4玈/*'@(U[^-j rgP M9;Rͼ & @4` O @ @n U&UL'@ 5+\߹&-Mɓb+zfc$@ P [v{KE|x5*6|vǹI:-0뺈%wz @ț@Hl @tC@v7L%@ @#O~28p`Ӷfx5_"tE US2 @GPiQ @tF@vg!@ @=${ Xgmv͓7lu@#^~D,a. @!ɈG$@趀nZ @>or~͓5_ о@E?] @X+^Y~ @@[ےq @~7tS|#Yw  @ oH/K @ #;2RJ[l @Ѐ]G@ @ȪO=TmojD @DҋGE4,b @ @>1> `k @RЀ] $# @@~5/UH ͺ>bѨ>ݶ @(}4H~!* @5?5Z  @ @ @jf'wS @ @ Ց^8"Rj,C C{2 @ @K M G4&@ i14fn٘id), @Ѐ @ @]~Qҧ3wu+ @@gEmGuʐq /IVMtF @z_4z; @ @ q1lذ[2M  VN4$ @t o?wh|m7W_wM]^:+XC#5vvq @e( UI @ u#G׾C9$y䑮/f&aXi!^r @S-V_X&}b@yX1.KV'@ȴLp @ P,8#OҚmK_RL0X1CXU& @ X<837[bW;'#e}fK PF-ųS  @+_jw}-/[,{xꩧ|g. @b xbmg @e%PYYW~pm1vZc\]eu}TLwdĮODwQ @'`}  @ @ f͊]v٥6g?+W|  @@QRH/]=mF @~Aq)C!ۋ@D{h_kR @(- إu^ @ @@ 1~W}c@zR ~= @V_?׹=(|铑&7V& @@4`gpD#@ @c6FFѣGwjA @ē#C @=-0WӫZ @ 3|8 @ @@ lvq-D~&_e]z? @{"^? @ qᑪgg  @RcuhX[[X @zZ`H/ӫZ @ 3x(" @ @@\qn+_J<ñf (@lc+{ @ @@O ̼<ܻzrEk @dP@vE$ @ĝwÆ O<12dH߄+V |m[r[  @ PiQVM*2'@hG;"@ @tM瞋78w+^ -{&҄}  @ @#=]v}3  @2+ ؙ= @ @4_}  oT0sG|C @ zrR9T @7 h~ @ @(@*445_#fN @ ؘO^-%1bYZ @N hA @ @=4K L @@Q~|Cm|̚8gl4ܗT @tW@vw'@ @ @@7ҫ7G|U7V0 @, 8>KgT+ Y(KQRij3 @ЀݻV'@ @ @@iӑn @ PZg6a֬ =ĤW 1Uq؆׽ə@Hae W. @|4`٪ @ @ 9M??(Pᔢ @ YeR|QU//HxEOR)xU$i9t @,OWm @ @dR 5V75_Q;?"@ @` W\mӓ_om>7uӪcǭNF{#M:K @}% @ @ @iQyW @ [\}q~Ԥכhzӟth.U%i/Uj  @FC+b̅Cc*eĻ/-MVܠ::@6ҳFzËL , @dZ`޼y^{i @ e7naV#E @@ ?b̅Cc{Zo?V஖*YEF\ Wk?&@ @>>}z|;/<Ϗ:(=U   @ 3Pك"VML&A @}社 MwP*t\ rC@ @RЀ]j'&/ @\k1ctX?~z @}%DiܑK%@ @6R1$.ޠ>?>Le ɧG}[VE & o @V#HB￿Sc "@hybۏ @@jj~|ԇ*xdH ^ŏf(( @m hnKu @-mQoq @b WELU @?+3C+2PLHiŋ# @@۶q @H`ذaqW3fL >qn @b wGbok? @(JP @e+lVa @ȮK/<蠃Cm17|s\{1dȐ] @})=Ú"ao @(e|9RRBv @@Y h.U @%P(sύv!>]r%1vhn"@YH˟\j^ @ @[U"=oZd @Ѐ;V%@ @7 L>=vm1bDg=ܛFq 6[o5'pB<1lذuD2 VMn_  @(cXS&) P>,UB @L .>{챵FԴÃeO:5F X; TJӟ'nqV"A @"HcTh(A(  eq @ @@6f̘{g}ѱz!'L?OZ\%  @@&RHkd" @ P ia^ @Ѐs @e'sϭyQڭ .~1n @, %MOBDմ,Ɠ @I`έ[N PK'@ @@v~>|xr!Ċ+:kȊ@_|I @oHWc+GaIVz @%)$Mh @d_q 7ĠA: /q8 @@RêHO,đ @s{]ᩆ)q؅ձlUZ%.0(L:ċ PK U@ @ |N;|[ou~3@j"('@ @@ խ~ ﮎ{_{͛2v~),B@(] إ{v @ @$N < \d3GK9 @:.a  @ PlMqk~/ƞ{7 @ l?b#Y( @91XۡŠE+np2'&Ԅ}~r D(w^ @ @ 'pB<^{e# @԰:'_w6 @}-p5Qqul/a4TyRl9 @4`%: @@eee~= @@o 7bS  @ - ɗ;\"+x@rVB]{Oˮ6 @(/d"@ @ @@_ |Iu_  @בֿ/ ء€iw7/0md& @@@v @ @9T(E,{ @zQ?654:fPlb\; @ pا? י}鑃c!\f]#˸H @V@v۝ @ @+b$ @/Mŝ ixצ. ;ېQrs~鹃#5֖\t  @ ࿰Kd$@ @ @WҊrD^ @({@CO>YH-Qì P]'< @'cĉ @Ғ'"=?G  @h)Њx&ZCZGlE9*Z @_ٽol @dN`̙qĮG}t D%6 ˋ} @ @@qV<ԄW @e,Wi @x+bĈ1|[~衇~P  @@ Y7DzڲU @ sS#=H+^9  @=#gB @L 444_[mU{Q[n2]p @I?4U \t @ P"󚚰?iC%XL @@v4`gl$#@ @@=:n8ꨣb…9}կ~=  @@9 B}^nĴʩ, @ @ 4@IDAT~^mE ЪVY\$@ @@lf1cƌ :묳bܹ3@_}#f!s @d[;j4k!e;hӥHiyP? @Lg" @JC}{_y]jUtI3@OF,~L @ ZPT߾&>ttUiLC3=`svDj;  @-{L @ @@ r)wn1ct8 PJiSM{D\Je%@ @@I ڨW ӫ?\;9Hc>nqc GȚ쬝< @M74Fʟԧ-oyK @"^9GAr @Q-X=NϜRNi,ryHi?rR2  @Ѐ}C+ @ @$=x׻jm&?z["(%0HQ+ @ @~|}mv6G4awgEz؞ PK㜤$@ @@v:.,ƍֹ(UT,_qi 7 @JF` q7VMe|hXeԕˠ#=wP65ԷQKE @ЀO @(ko1| @Vdhzo#yo`!@ @A`dϫ!1 @**пgs2 @Ԡ-[%Kt:lN8: @ZH־3H_ @ Й3{\۝9XH0忉;܀]ڽ @*`j2"@ @/xxSԂ@4E2qmk> @tEch~h@:*@6D EW=[ @+ t @Զ>5jT~}/,XSLc6 @@M $Mtc"V=ZSc7X @(P1s/ZOH_q$ӎd=y"} @*"eE @[ <@L4)K =dCE)i ) @0vMH @N>`ם 9H}Q ټ,t$?$/^`c"@ @7.и1bfd J ,# H^ISY̫,z @B7 @5)|򓟌+& TB ijdH< @>__.\Q+_JOwōv@i#ܑa87 @ԀNr/?̇~]H?31DnqU  @  @s΍g_|q.[,839f  V/"}B @*-pw})vfJw|ɲ#74$@O=- @v'>+nU @@4H) @ @@*|nc?6ӯl) j|'dM$M&` @@/K.0  @[k֬)ZO @`[!yS#yఈyߏHd @߼>}8uqMc<]_乿c#Y~_Ј Г{RW @Tg 47tZA @@$,%"w ZWE @jHAˋ8&c)9HhzH|fk@) =%_ @F`ȑq)o,ZG @`@,T?* @ PoO➧OΒΌ}6ĝO4ִSǐ!C:2XjUu @,|,Q$?Z0v @ -5l?< k $L oãKDEۃ @n H6 @ C3MS薀OvӘ @466Fsύo9Ǝa֝!hK@H^>;F#@ @w X$zAgr1^G>"YH97r>{M%@zOv󺉚 @@3gNs=qwC=yziӦM}ycEНz@4E,4ڈ7U  @(fO)A2}"L;4F,1Mi${q&^]ٽ>&@t   @(ʕ+{7~_[;sZqcVd˦EɼDC @ @`%o<?,I#Jv K'ltFK"=v6 @)]m^w&@ P믿>.hjxl&J%`WdNBz@yyGԯE  @T"[vx-q#7EI Lsʥ輲)%N:_>*G-3r*bFn`p> @ T]3$ @:8C:MZs=w( Pvd͌tJg% @ԲEdϿ%f U$ouq~qqb+G\ʉ>ɌuUľ1#7hRZChW@v,v @ Pc=6'v-^8f̘'O.)At 45D~{:?GA-  @ @r _ȖJR8݌yM-4/9k`ݣgǮ_ɜoD<%=8r~:rÏ*xY!@*PJQ @ 2$>}E@tM 8?^j$3|5F @ @@Tf2$xfnS| +[$_D"4AC&@* r @ P>$`%Rl@;鉏FwFt' @Y42v\;ZPhͳ<q$M>7-BHd'@ @,$`?ñnݺO' @usiUlEԟF,7HR @ @gn9rz{#ǥb/%G @Z oe @>+Д>Op֬YG}}}|ӟX:y;Le]⤓N+WU$('!@}H ix3bm,ψ  @^m,8 Eb͌H^B/E2s^\Nzq<5 @@mHl @5&$I̝;7|x'O=T! zرK߿qwB]]]qq'){l 0Ʈ @ $M鳄:E?X۴{jM @z5xrNSqtH{.?|O8*Ύ_䆽W @F| o @}[`'`w4 Ē%Kb=JYs9se bȑe_g @$u"Y׿hXY 6F @ @D0;-{ ŁuZͱ8|bx~u1h@WeN$[N\{I_8  UqA @&L4;;㬳*;xdBl@TX5},KKҙ6}M @Ԍq?q3[g}6%S~S_>Y}<.51]&&a]{aRّ̹&"]]ܞ#7d/ $`Kl @(ӡ?K4  @VIeLׯ*}풮[ @ @:m\|}KVgM@:+3og4ד8%`?;|ų%ךOov{G_Yl$/]&cOܘt1gFnIvH'@ H.n @^'%`+  PI7~;"Ѱ: @ k޽.;1[ǰ0M2rM?r#"%O53d"FaFۑ˥S+ @@g. @T@SSS,Z(Ǝ[08∢y'" X* @H6.Hd+hg% @ @`>iBv%KH<1Ur~NE.1pd${&c1 ص8 P~ 7# @@ Z*fϞ]Xf͚/R̙3'bÆ 1p0aBnzϵvژ9sf谎 @@F7X7| @ PeOT4>7vG#_?#IdёuJܮ~ Pꈍ @W viq=i2U'%K>C;QC\.YN;>}N$@H֦I+~&]&|(bˆu5 @ @lܜ߹_efoHk7{Ľ\QdIc>Q+dИ45{ШVm @) : @zѣF8],GGyd~9ꨣ裏.  @@Ɇ҄iH@[@Ko& @ @<;)_OwUds_o[J۔ELS'?O1mGͳc]&b<>bı0l&v @;^@" @#&M*:,R㎋3fw瓮ǍW; dü4HV.ልiB @q^RT )W9vڸ9ך&`[;׾.ɫ?L[ɰö&b14!{xeq6 @] I ЛVZ ,/W;")%ӛf*gyfdBG iJgIZ|Ī҄Gt1uypB @)NߧϼYt"zEN#΄]}%ͧK2N)!U_""@5 .! @5\gώ  6Xa1Fx`x1tnGiѪESg?Y viӦX|y)ׁRd񦦦Y% i3[gzش D @ @*:8/T:9'`Oܳrݜ퍱n FŞ#r+zBgk"Il-Hv>(M ;[b[&qj!;?KŸn=5){tva#vM]܀a۴(M@viNjfl=Pۮ 73f̈o1`m+ucOэ!hJzʕ+WUbŊk޼dMqjUbYs%`qŪIMfo⠃͛7\:!@:Hmi͋MtI_VuQ @ @>#PߐiRr'e`A\'5whъc4fxgNl/Kga0NbޚbCb>Lj}A#\ Ё-;c뮻Uu6䩧'O'/OƵ^W\qEǝvHх5!@Z`ɒ%O~1,];>f;hzY83m  @dN/[,֬YoƧ?|ە{fY*ُlJo}[: @HOjKu5ea @ @ Lg4ŜEI)^y)3c',ӝQ47ִ{CznX.ٓi$D2d߈4hĭ#aS)-Ki-TB0nBÇ믿> R׼2f̘:ujya&,q/oҭj[ИlW^OiI1bDqd/\T)3`W2(  @@I۝׶&Zox5 tY?7zQڮAv @ @š/mQxuY[TӢg]SmewӸ-_=!b I׳/^}8#b.䗝w޹7S35 @@ Ha9s'( sm7ȑ#'igg>j;cЖ_`Æ mܸ1%Ζٓ"n0+ؕ( ]w5?wGdv̀ݑ @dKDzOؘ&So\I5{i~ٲ֙ @ @bޕm:Zi3`w6RW-|>"IMlgo]jm{LLMq%>؈>ˎeڵM6EA*MkN;TXlo) 5u7ӧओNj'\H>u]qgW}GH% y#͛>v= }o}vb>k?as݌)%74r~hYwvYvO3`g YR>cǎ/zhO PIcȦ%8l{ⷖ4:KfQ @ @԰@) c*8oMn}qD6u-'e˛m{ƤnpWTTN2b?OK/&MN9.Y$?3dߛN< P_:Q6^|@ǍF*lw2lذ8qb+*ӦMvvј'@$,)}tԖk\m7/{gd*Dx#9ԧpV\rJ466mזKCCC)(T':=^/lFJR;K.w{̛7n-[VѣG/n(dIv%;Epb!qW45["Iiu%]o^L*t @ @qQcaXFS,^ĒtY&A__JWk]#%_TM"6̍5KZMF 1pTKHZGN޾]|͆]}7{wzs9'~wZ\/ƣ>//gn:esg-G>(YfŢEq4[}鲼:- w_F /η=I!W_-Օjk׷ ۖ쏔2u>hty'cʔ)&6'~C.CGG kҜ?q;Tv(z 7tω'XZ>W^9*dN+_Wb}<^ /bT&{ O.VK#m…yNj)>[^9*_%~YsvG)O*v?d=~ѝ=Vyɶ%WU~hL @$e)Z6kt~Ill)ޔ>m#ۗ}k?vt@_r4qkcFѓgψϕRh@* @ @@lHb=s1>M~z˹ԖN[𱗊OvSxEON&nքS"K9!Z rLu,Ҽk^Ӕy;nd~ٳ1E"ȾoTCcQ|[ߊÇ̜9b6zf+ @}@`̘11tV#;wn466g @@{^ \CSSS6ޘfPj8v @ @ @ @ @[뙰{ܢNvکUV۝mm{lGqWիۆv,~%tx @#pWʕ+ g뮻 V @|;`VùbРA @ Ngn5'1bĈVl @>x{o;ϛ7onɓ[ @@L2UvcN;v @f~o3~<}Jv @e7|6p ^{m @mM=Ik׮mZmW:ٶm۾;hݶn۾:k @ @ @ @ @L@AI/<~,]vYu Vr۶%q&@ @ @ @ @ 3jkcFEz믿^rO-ǍC )mۊG۸l @ @ @ @ @Ԇڸe ̜9^l_,T9C ]]8v @ @ @ @ @W@vv=yO ؋/.lwpXlY;zWW%Ư @ @ @ @ @@{]#?㣮mV4[oPgqqR-qt5~ @ @ @ @ @zٴw "c)-K1cFa3<~{a駟#G,l]I$Znt-e @ @ @ @ @@K -5g?ۼys| _'|rvӧOڜ{kqwG6uP=G' @ @ @ @ @[[3iq(Q`رqEԩS-6m^ziL4)we ٳgf헾{｛7Z-qt{ : @_WcÆ Xa @O |_5kִ[m @ .8Z eĈm @H@vG2w(},sϸkbƍD^z)V}'w[%n Bc @^!p8I @y{ۅ @zG+$ @@u HRQ}7Lf͊mb>#3Lp+׎j\ @ @ @ @ @@u 䒴TwvƘ7o^~솆;vl~=ztEC8*:h'#@ @ @ @ @r; @ @ @ @ @Y7/v @ @ @ @ @TR@v% @ @ @ @ @^- W_> @ @ @ @ @ PI ؕv. @ @ @ @ @z^}O @ @ @ @ @@%WdE @j7o^KpXhQlܸ1Ǝo7.=Ш߫Θ1#a„ 뮻nw;  @u 5jTxq'СC+P-qTdNB Cvl @%iE @2 ,Y$~i|p| _'tZq;Z*Y_}xbڴiP|1a„8^B @]w]jɸ[} @v@.M*HvdM @ذaC_E,X _~y|Cj>h~&7N%t\}&Pr[ 4* @]~:.:蠘2eJd[_=>ŢE =vwV%A[ @{^ @`G툓:' @*%swy&_gǏ>|J,cA@IDAT֍n )rH=Eu75'@!n0Ç_MuVa̘11u9rdmVXJqhO Pto7r:'"@( ;Jy  @@6+_sf 7;|=3b}-={va+cg8ڕv @5,%}<s=7 Rn%_{o[ՕjkG Pro7r/"$@TZ@vŝ @ <3M4)JI:{{sɒK7+Cv5"@Լ[tI8 7mwuWa+GW׎ @n&n_DHJ; @f%9#c8}衇|Y? %m/\=`0aBa  @R^|BqŨQ  6,&NX8;뮋Y _?8cZշA P[Ւ\-q7Z @znvNw; Pu=|'@ @@ /\rI[qiŧ>vwV83]tApqxZw[li: @@ rV#njjjF$Y%VA P=}o7Cu&ZM(*;EV @XbEl޼njuutڴiqWSO+bAeWg, ;{.lpw}u  @N;j4-@;m:Z8JV- @*P{}d\ @ H @TH_z<%;]v٥h[n%1Zxg%_ ٬ٍܹs%`we7 @nj;*q57F @n_7{  @}I)҈ @՞%^o|O:.||v%`+ @+6izڵ%c۶;J+m۶j[m_u @@o])w_  @}[ } @mŃ>X8ҿ+SO-쫆ګU+Wlm @χuuu%deҥ%;lذ۶X-q6 @@Mv+n~? @@ @BώN8X n5k /P8;5\GqDa_XU(Om @%0p|… Kh=nܸ2dHmV8e @ {ٕp H> @ @Ws1݊sݺuq饗K/T'6,T(J߱zXjU~38ϟߪ^( @Զ9{̙%c⋅rHa+GW׎ @{}"R @@$`WZ @M.k|}Ɣ)Sb=.zk$I?OR[ԝ5w}{4V @T{x衇f3`/^xGE4lٲwTK]_; @!#fB(  @;BnG9  @ PI뮻.Z&3믿Ǔ16,&MT>+W,lwꫯwQ8|a>SضB P|d?k.v[jˀkkhH +v ^6$ @`}vI  @ г>`DQF5\C-ˉ:fl. o|0#v~7lR~n @v's1,{ƌ+{g,7n'ZK-~q'w[%n Bc @{U @` H@ @yz.=n_ѕ &9gqFrG @ Ǿ_4mTp6ʵZ(xC n&_ PM$-X @ P ٟbK.^{-ϟO9rd=]!@ =%d3`744?Sf+G=tn @@'v @F$`ȅ6L @ @ @ @ @/P.@ @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @ @(2  @ @ @ @ @](  @ @ @ @<Ȋ|adP Q܈("JnT5P!+Z/[FQ=b&J *#J A/ss{2sUSӧ~n}%@ @`% @ @ @ @ @4`o$@ @ @ @ @ @`% @ @ @ @ @4`o$@ @ @ @ @ @`% @ @ @ @ @4`o$@ @ @ @ @ @`% @ @ @ @ @4o.  @ @ P ,M4 -[.t9;|a7N @fcƌ O?tb?? :4ʕ+Àš5k#q} 4(̙3'{헿evl @ @줇 @ @ oôi [X|} '+2fX~}Cb7z~m(~'k駟`̙gz!@ @ @ -4!@ @ @E?ps=ѣ"܄|ЧO;=/^xƎԱ}[oYfjeKӢE;P @ @h< g%S @ @6ؕ ?O7;v-0rлwozM6 C Ib5 |gK,q';&b @ @@NOv @ @h<} vZ ^:Z*X"|GW^ ,HwwfdO ?g2a„I&Xx >lذT @ @B@vC& @ @I={.f͚;1"|7zsLhӦM"n@@ NSN.g ѯ_l&;ƍK9`D̀ @ @hZ)ʐ @ @m6, 2$L4)$nvѢEK C_7sI,M @ @F _$E @ @6 C9$N0bȘ:8餓B+?aՉ i͚5|"4 @ @ @Q(n$  @ @TFbafk PG-[ guVb%Kd'Z*LuGw13 @ @ @q4oiʒ @ @6l:w> 7aҥa-ƪډ;ař+WfΏkĢ8 TL׮]y0k֬Ю]УGлwЪU֨|˓;wn1cFO2]M׮]3>MVdŊW_ }QƸ[n޽{._o @ @7?߱ QGUմX|Yg)Nĝ;wΆ2իWg?|yå^cŋWuZx, T,ηVC+iXC={ }߮O @ P͋3-Y @ @ @`x3s>vRηłO>9̚5+qx-!~бcL7w CbM>=ӥ裏 Wuׅ3fT:'Q5tF ӦM+O'3 =zxy'ܹss]w -ro׮]8^{Nkg}6{sgϞ0bĈD`޼yt=֦Mucx)8vՎ裏&p+/bh<11cd׊]c!ֶm1{<;},QP]y5E:۸q{ٽ{D⠡ߕ4!w'@ @(Rij @ @ @@5 K7sTse˖v5fUW]ܾ}.]4`YÇ-+.:.}K,YRZV^ZV]ڻw+Vdת| ۴iҲҲw/_^zI'=^9ҲBSG:wmM̩8(z^ZV`:(vqtmR]ve9)+Ow5lhj&^9Yf X܏o[vmo8vۅn-Рm۶aرE)֭K=;ŒcFO:thX|_+w 96a„HgyfhժU"VqP,Jżb\,^Cܻk @ @|dG @ @@#x'ATO=2c;|aʕ;xCر9vЮζ.X",;>ǮUmŒ_\USgѭ[Tb` ~*'N cw|6 ?lذ{7B؊%Bڸ5;ռyaw]'O%έ9%wP,J;V,^}߷ @ @@_ ?_ @ @ @h-ZOmlH;ƎX}wfbպ:[NRW^Uc=*;=V,7Se;o}pB6md> =/BvNΑGY[:*~3>쓍mNX賶؍c O=TC= ^zy˻H5, @ @@ ] @ @bYg^- Uz^vmnAu.ĆȷK.cǎzԼi-ͷn:15;; ݻw۷O ~iNM(0Pqqcosӆ8'^z)8XdIxÇ'ƅ])4W,^]ߧ  @ @؍31 @ @1-Z={ .;w;ϟΝ{0gΜ+db5H,fn׮]MI_+N\AnݪM$vZlnPmYXfMvy5)Y+$vvm_|=eC͎+.ٹcAgQqZu(Z<ZK @ @|`>LB @ @@ 'r)U&QRRڶm)^:at3]MfϞ)z׭[Wӥ_ӎoMgVۊ+qXp:jԨZW_}Uu%ǚ>k5h޼y8sµ^]G zkq%§zjO1wby-L @ Ш`7O @ @{FY)}[n cǎ ˗/wePif򭫓,YRWKg֭bqc>sK. _S5kV_݆ ;,xޕÉ-Z @ @ (n  @ @ Xvڂ0brw/<5k'Zy!mڴiUVW^]%Ǎyj|9 wC /R6:~_o߾ iwr^<{uy&@ @h g's @ @6qgyfM4 ;sk?Cw׮]C<9sԫ`c˷qr%FLS6"[lYSCɌn4tDv;a_><$yӻRZZZ[rej~5r]O(B,R<#Cv]ٶlٲ|Ihln-V*u΢EB=R 4&o#FM裏aÆeS:ujXpavܢE0hР츐YΉE/={  @ @MŦ# @ @^DvsNx'\eu:êUAC嘛C1W]ލGM9dȐдi3LcxW:uꔸuJ64x7CS+T< @ @޿wvG @ @).]ׯJ]sŒ {o-l;',_<\xᅡn/ܹsk}٩g$wBEN7T$hpYg-[f3zgŋSO=n{nv\NcxWb-͸rCy-[Nʂ Ɉ @ @4\ @ @!&Κ1cF|؁W^aX$Y[c˷. 6_:t8O}y%⹃X}Wo177o.DM6?b' m rixI'M#v9rd QGva зb-Ů&LHrO.h߳WI @ @,] @ @!py祖iz뭰zKɓ'O>9x?_|EXm4|kޫZSNM4IL}7>)ŭgtZ6mZ;ƌ8'qf%T瞉Ȓ%KBa.--i/C&aÆ%ҶmsM3 wuWxԩS3i,F{Ü9s2lq{*q @ @7ԅ] @ @6^O/4ޕK.$?>_ gC[III8qb=ztx*~ {;" @ @ -vCO @ @~)w… Sqn,>}z8S‘G8=vW;wn"V[Ɩomw}ٙnݺzJv^,;vl袋v~_U6%̚5+u>sL] C ɛѠAB5SnHǎ v5<?AU<{U@ @ P ۥ @ @ P['O.ݲepdž_~9L2%bȸvabٶ.Ɩo]T̙NݳgϪ.!>Çr~:\q}{ｗݩs[ltk A͛Fg(:t!\z᭷ }gF|N&@ @E&eKZ\R @ @ IDATϟGVZm&t=/4@f/uË/f_uewy;eNff͚0s̰hѢz;Ν;޺#ǂNj J|._z0cƌs|ve̗+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i `k.@IDATx ս8. ` 1[q},.I|5Ϩ苉e/e1D1Fk (_ϙO3~֭[]}_5`#@ @ @ @ @ @VC @ @ @ @ @ Hv# @ @ @ @ @ @B BF @ @ @ @ @  @ @ @ @ @T( B( @ @ @ @ @ =@ @ @ @ @ @ $`W @ @ @ @ @$` @ @ @ @ @ P t#@ @ @ @ @ @l @ @ @ @ @*]!n @ @ @ @ @ @ @ @ @ @ @@+ҍ @ @ @ @ @ @ @ @ @ @P@vP @ @ @ @ @ @@{ @ @ @ @ @ HJ7 @ @ @ @ @Hv @ @ @ @ @ @B BF @ @ @ @ @  @ @ @ @ @T( B( @ @ @ @ @ =@ @ @ @ @ @ zVO7v;`0xি6ڨ]8v͛ǍƎi_cx5@=B>}B޽C~È#5^G~l0w:Wl>TaձN @ @ @ @-ۢoN:{R}7;KNHLxʔ)"kwJr_CtMÞ{k0iҤ|6o~0r̩~n!Npљ+Wa-k  @ @ @ @F&P]_~9\qC cƌ ӦM FZ?~ꪫGf_*466sIk=zt1cFMC˾C[=iH @ @ @ @$`cW5kVgy/ҕ Ъ/>+^:T.cw9xsد1aXLy N @ @ @  u̵;K/4|߯ :GQ'~SN G?O  Nװ>nI\ @ @ @ @K W@L~!V]|yxwòeٳO?x;癩;øqĉS?p衇:pcccXreXbEOms m;(|pҗ ɸٷwzՕ5/ @ @ @ @v-'0~뮻bO~ı1 /Pƾ{dhkT_`an3g rJ{Scq믿~j_Go_#G=3w#_]g\) @ @ @ @ .#0dȐ8;\z饉C=&LkԶ@Lҍm]K &py3L6mZ_pM7Xemζ"u=ZO!@ @ @ @m==E~aСvmSo߾aԩauI]_  @ @ @ @ @" XO>OS1:aI'/{ @ @ @ @ ;*6 |H3wT=x0k֬/wy=tc<_{0gΜ[o}Wüy:kGË/VX֦#N^{No^x_VO֣+`{_0cƌdɒؘ8W^aaw'N p@ѣGOqcfXͷN;- >yM&=VLjp]w{',X D+;6~C cƌ)jkL`:ujx衇1{ٲeMsnVy=3!ZW=7M{L'>( o x ׿ί+ogpA<{0nWxr-K^fL@5jT}1QnO?_!-j7`{챡_~Macoݳg?qx'nݺ5?MzWk}M[U @ @ @ @@.F 3\2XdNk|.,1f<6{m5㎩qT;t֘Kfl|{wj/u%;us x]w]fm:b,DxG48v ⍟w^9ys \sMc.Љx.65)S}Zj{ ꫯN\g޽.+W qvK/.17N6|O]%\RΞ=;5~?\9n-آ8,s O=TzuU6n .6TJ]駟^ɡT-_%U7;>/ kﾦc o~ۮ1_WЊ_~Wk}'T߭s&@ @ @ @H t%t9\X+z+*±pxݞ-Vr>cg"hwkSN<9+~|U\vx饗 V_s|e~!jy睐K<W^yev> 'r aժU庭q|m-]l*~Rľ\BdUc5Z؞y4b\g*^bܹswؾC~YY~VX+19&{.h_bc,׽w!&J!~ e\L1C ;Ċsdɒd9[ދ M85\\җ6p! k9\ݚZn @ @ @ @@ Ym2ӧO̔Nm:ŋs8sƍԉ'|rE͙3yKm%!Yvz(uLbwc.1vqqf͚Ukc.07|w)yL!KkfmR*7.\-KvmU-NKn|S}ѣG'|pqD;WlS,V|l&wKtUMjD,6^xP*w~{ӱݹ$Uc\|s[o߶!>$N6-Ī=zhJwv=Pw$ÖX}=.I=yUc5܏Z:Ud_.(umÆ  ^fΜYh6MU{e~ ѐKmk_ZM=]wW4rIe ϥ;pw=ܳ("+ve}b?# ;vltA%ƈB=]gqwk6 @ @ @ @$`wΝU /BLtR];!+bBZLvW8O<1uYcbl 7tSXbEɓ''څe]B3s;~'@^~\Bu޼yM obr^[L&}CL.l1?&֑@ZK.?χ\B(3̍7x#0|;sK/ 1!Զjժo~3+W)#G`ҤIP އYn2W?Wm5,+<#<9bqBq(^/|]曇j!~go9\|}ھ[Ɉ @ @ @ @S1N*ЫW|X!-V bp>}j*9я8 T VcYl}iM7 qmڲŤmš۱Znkr78|Nqdž.$pEě_ҼY]yݫϥ,`P*ܹ(QgSmРA [owpZhnm. @ @ @ @@ HӅi oB8bUJ7ù瞛}{Q_`f5}宯t/Vn- ͇ 'ON x=U W5R]v%:K, x`Ign햪][GN;5oVT}k vupM76ڨ+)n'BLUy [sϵ99p|k-(e,P|lWz._{{G/W Tmš뮻njoi ᖮR{[ yO @ @ @? >㫯:ĄJ|χG}4|[oM%$*1Q7MVoᩧ sC-NNuE5^0xX񛘀|t?O65?fMbb^L`pᥗ^ dȐ!M&;p'_L 8qbg}$>u պ_b{J,}i:O<өK/U>թ@L4}'=bШu?Så^ڂL6jTNlĈvR%޽{*xWza[+ҏ @ @ @ P?gLuF;?O|soDƲeI޳gf 3g̷k\-V=ce]4\LI㧜rJS|0kj$rM_y]O:J_|o[ޮb|Lqn§?|2vL_I|+=ܥY7_}DJKlmi>Xz„ -Inx_eojUXuR{sIǷÕ^J#@ @ @ @ԏY뚙qwyꫯ&uyz+IG? s=XY4N+{V&Y՞Kk1p5k|7@G>+CJ_=\~ @ @ @ @ޑ'wnI~X{ڴix?+~; \ޏ;6㎉cb^x!{/_t[7%ޗKJtBT%°[ne?.|Bx/ve0cƌi 6 窅RU7t5&lcXֽZm+<6W~g'ÕrnTJ? @ @ @ @@H~ 뭷^j^O>d*V}G•W^Op.˽dɘ+:_~ao.׽x]*۝wZ~]||ݻwP֒H{90|c9&_pMƤLJ[om6_B>}R K.MXxqb]_3?nfP jwk  @ @ @ @]_gןԫ:FyAYj{þ%m0 3&*ovȷchѢ6?ÙgV\tԩS\ԎoDo߾OĊ N"=NeeGgr."(g=Q :8]CTCM+>}V: @ @ @ @J@v]-wMvM6I%`ϛ7/5e˖}'+}rH8;z_x7C1+\x`馛Ĥ<7.I7tP8p`"V܈cKc=a /$ /0[D?;Z^2eJvjgh?'*[neJ=/6pv%ϥWUþ[|@ @ @ @56!/~:5_?̙3nݺ{onU|XdIbhKv'Ɨvm5cUɓRM74 ؝q&M _~y>6Q19W_])t{`'TlYJNuj!v 8ukm?ꍸ>}۝j @ @ @ @$`nG'gϞ#FbSNMb;/o-0wTX-{6x!oľ8=3+Ո3fԎW\٦c^~T%իW8#YgDט^j*ht{K֥H`]v)3Ϥb-ZJUGUu!\B|UԮZ7 @ @ @ @$`rdO^rcǎMşTlK* HukhhHZ #wq.Ol&K. gyf"Vicʔ)wLyлwmQU}sڴiwMQ*5[gtNvb/~6S,X ?Mw衇b]1P\I>Ρ=ϩ85ws}aү9ܞݚ^K @ @ @ @@ H; ?&S 1x;zWnm*SOb-br{梁:F|뭷wG?bJ={~_}{Sx} x`kLHut:=@`ᨣJ-[ַVX??|p"UO]zD=m\b_. kj @ @ @ @^$`wy?s cǎ ?xjeL,}CJcUV18V.ۥk5V\;7&u/~aРAfqWzwSfobrzLfolll av{"Vh~ᅷM_U9s… vyP ؝HLVUxO#^ {G7o^"^zpYgݱRSׯ_=Rk(%onn- @ @ @ @Qg=Nڜ;Vfp [X yʕ!Vm}̙3[<FjJ0aBzp'TEB~O>d!z}7SJGqD8+thL*}ڲ \sM*zaĉ3'[LND%K$v ]tQ"ּ{-"̝;)SN }m͢Ec?hοVc@5VOcl!VĴy䑰;?Xݽx?~|2eJq˶ * 2$|ӟοaOv}<ǘ1c׿Ԑ\l) tp{wk8NM @ @ @;%s=U?|o?φ/<̘1#+ wyg8vmO I/R5kV:ujxgƁ9s4cqL_wub ]rH]خȘ|9cE!&bJ`Xxq={vk /[n+oj_!лwpw}c1;V-՟'èQoO1ao˖-+ djlmxoFtMG>N;+Z?!&hG[L@C^wuv{{^[o tPkMk?Y^%;ĵv𚬏j#@ @ @ @t] ]w\yN Vp?m1 nW-NU`l{>);V>ͷv[8cb9&`O`xgJvε\b_~A;sxMwk @ @ @ POiZ;b>/ fm7ߜ\U:hРp7d{ղ۳%i7l7sl5ѣ է~z~ݞO>X8&Us@5X/c{k ^zi"}[O>|%ZK.XĪ.4Kgh=lkľ]k>[˯= @ @ @ @z]/+٫WM743&va / wuWUc[lѦ>_W>zkؘ9eʔ0wpg=z?Jl{… [CL-U]:V.>0k֬(;CcuV3τ#DW_}5{_ /K, 195Ť޽{u~1\/R/aǍƏ_Q%jL@ᚼ@W^ - V ȑ#?ؘ0aB?mҥ1 xƣëYJkľ;Z߭- @ @ @ @Z]k+j>]R V~ꩧ}]v ӧOoj{C @ @ @ @ 9SsU3fH$_ItI]r.. @ @ @ @ Pk}ͯ WJ\z;DL @ @ @ @ @sH*T`…᪫Jc O4 @ @ @ @ @:@9.U/|{'xiݻw3g [mUS @ @ @ @ @#г\+!PN~v0jԨ /~8p aΜ9IO4IuBD @ @ @ @ йT\jjP`au -ή''iN @ @ @ @ @agvbu"гgϰ:ۋ.HuJ: @ @ @ @ @:V@v;{9řySOm @ @ @ @ @/ ԁfmVrlI.Э[}  @ @ @ @ @:@y.ǕM+Wg}6}#F$FիWA @ @ @ @d+ ;[_ @j[?~b DL @ @ @ @N{vC @ @ @ @ @% l @ @ @ @ @P@v&@ @ @ @ @ @$`z  @ @ @ @ @ H @ @ @ @ @ԖZO!@ @ @ @ @ @ C  @ @@IDAT @ @ @][i6 @ @ @ @ @d( ;C\C @ @ @ @ @ P[kk=͆ @ @ @ @ @ $`gkh @ @ @ @ @jK@vm @ @ @ @ @  q Mj <#awN͟?0 @ @ @ @ Њ@VMD୷ >`jVXhk @ @ @ @ @  @ @ @ @ @! 5B @ @ @ @ @@= P-CC=41܀m  @ @ @ @ @ [ U;vl馛-\0444$b @ @ @ @ @@vݳ @ @ @ @ @- صfC @ @ @ @ @@354 @ @ @ @ @% l @ @ @ @ @P@v&@ @ @ @ @ @$`z  @ @ @ @ @ H @ @ @ @ @ԖZO!@ @ @ @ @ @ C  @ @ @ @ @][i6 @ @ @ @ @d( ;C\C @ @ @ @ @ P[kk=͆ @ @ @ @ @ $`gkhTSs޽{o< @ @ @ @ @VznD)n'vj @ @ @ @ @UP$@ @ @ @ @ @V$`ʚ @ @ @ @ @UY HlK.I=dȐD[ @ @ @ @V@vF'@@Fa @ @ @ @ lL ̜93|+_I9}t   @ @ @ @ @l7: @ @ @ @ @jG@v @ @ @ @ @ 쌁 O @ @ @ @ @@ j[`ĉaժUI! @ @ @ @ @  PUnݺ==j0 @ @ @ @ Fm; @ @ @ @ @V@v. @ @ @ @ @ V mӟ @ @ @ @ @]Ko @ @ @ @ @U@v['@ @ @ @ @ @n$`қ8 @ @ @ @ @mV1  @ @ @ @ @[ u&N @ @ @ @ @@[$`UL @ @ @ @ @V@v. @ @ @ @ @ V mӟ @ @ @ @ @Y37qt1~:L\9 i @ @ @ @ @ HNO @ @ @ @ @ tvx @ @ @ @ @ @v$`Z  @ @ @ @ @ x| @@ vqh}I5 @ @ @ @ @l$`gktTM`„ GMpАi @ @ @ @ @ tnh# @ @ @ @ @ @$`z  @ @ @ @ @ H @ @ @ @ @ԖZO!@ @ @ @ @ @ C  @ @ @ @ @][i6 @ @ @ @ @d( ;C\C @ @ @ @ @ P[kk=͆ @ @ @ @ @ $`gkh @ @ @ @ @jK@vm @ @ @ @ @  q M @ @ @ @ @@m H4 @ @ @ @ @2!  PMx lVyU"@ @ @ @ @Z~  @aΜ9YjUA @ @ @ @d+vF'@ @ @ @ @ @Tba…_+Vna|C>}xC @ @ @ @ @ Q rp-뮻.,]41b~ž{N=WsW_ݦ!Ǐ #FrJbhk @ @ @ @ @ H^C%K䓫ϟ_r˗(=k֬}/T3Y򩧞 -*yrz.q:n~$2VohhH4 @ @ @ @ @$`:PHѣGe]رcCÌ3 dWy UY[onm Y# 5 qL`,b ;fǶXEA!@BaZ Kv`t[]ݵW{y2222o~7"{ݔש;B!{ ]vYG>;Uzth,v @ @ @ @ @ v Wa}׆ݻw/F  !7+ X^ܽ+,ti}fff1^!?p 'U7nX @ @ @ @ @P]ۧCnxSׅ{n;KrKxo^{,枛[;22^җ\.T, @ @ @ @ @Onz |k_[:^?S«_.9^W.ggg׿fO?N @ @ @ @ @O@vwygq^WxE,ޞ/9b @ @ @ @ @ Ԯn]9B{k_\|xq B˿p7TN8!\r%77C\kTx衇e˖000Pw _ ^~. ߺMU~꽕n#nZJfBVj_'f?Yh[)|wk8?~^nrG %KOqF?Q򑏄[o5}﫻X0.pWnO ~wK_ >e] @fffm۶U3V|-S ZNK~ @ @ @ @P݄pqT|b7=/o{\R㎺ O;p;]8餓Xu$@~[n%oL صkW83SzюtrzvG}4bqvmhLj:ڮ7c^]4eke!fգ9êo#f]kZ9ӛ2(X|֭Φi @f6lFFFB;ZL,c @@ qСCsN&/*pǦſ'k558|}e틜чӊ[8j s ᬳ ?<]K_Һݻ_Bԭ#Qp-{ u|MbFl+ŋ):-7'Y1R3ċ~:캴f;cv3:yL'ϨΡ%bה\}:}һjwHvኩPE .c>a24$000a@M -=L @2X]~\D(]Y8iV8XI ֗:VX]dfPM6?#T8ֲ;w.=P;GD} ;^ j7Z/ @ @ @ @4"`F{)Gşطo_8תٳx/IV; vt؍ 9f. ;v? F-;.'Jcc's7%.ݥ⅘=Ɲ{;]?zgSv];ż*VĺC{4v`ɝŵX}O'?V܅jWSx_)~XqL녘by'@ @ @ @Ȯ&5|#Gg{ _XϦ<'Fͱ_+J \(JFcb].SS#p/^,_H JG:c<n}XbzK1/-)5Z,  @ @ @ @SݙZ?y)y-ڶm[hh[n ~k^71ݻ#KnW{ץIuX`Rߗvԥ8+^c4~O*ѝK;H<ƝN^qcu$e;2'?W׳%Y(-Kq);#ƙOr1 q+/OH @ @ @ @Kw4!W*|_y=Ge/{YH{^oo=9駟~šïʯʻf.$EOW_}uRTXuYgFן. +<ֽϟt*e-$~:Zw]Z֥.~c'K{Z!?ƙ(7`<[l]?5'WXZ\kEc5ӺOd2ҟ 1O: |~:+U:W{3Ww KnIyĭV][iX1V3ߧn$n* @ @ @ @@7 TtskN:)zq+2qv lqZ;P_ BK.|‡?01k||v&]^|]5OrKp[y[+_Kϥ-Yڅp1VεU3Np}1~?]6T @ @ @ @+8_aajj*\q5yM8P;wpСm޼9Qͅ? rK>{]wo.C7!qazz:޽;|; O=T1[ŵ/8!@@bqvWijEͭ^g۝o4=LS(.W~(ڈҹgӽK+_|B%=Jw.\/O.T*.W E%Ωꃞ^7_Yގ8P^H:aw,Oܶm+iI,.ߪIٶ8p @ @ @ @%{k[R8O~2?Lַ*;88SiV~{pȑq={>b1pEU"&+BghgWɧXcQvvP.\)\?giz 1ҭd*]Ε;Hb1ǮKwή=[q]\lN*T7Y [0߲ U)Z.תvo:!@ @ @ @XjO<1\s5};\赯}m//n?ۿ gyf8q=\pA?j/GQjnI5A"*G+iWxyi7kKBGXwo+~"\xէW췺eeϻjzcv]EUgq @ @ @ @@}vϩf_z'ݻw>éN^o~w^káC#<}0<<^N:X: @[bAZ2/bgz<.^diwh[(.gZz(nIgwNK> q=ͬ|׎ʕ  KрeGoqp4J#iR]GJǔԌ_W @ @ @ @@`X6=GssY|8% Еณ Zxin>"X8\PN6^y%p!^Ăg:Zlfǽ"O$ek1nqg:b- @ @ @ @ ` @@O 04WUZdwq>zgg)no/|CH~KGXqwœ`^;ZݵZI @ @ @ @/TwL(2vy߲UBgfإ-WbpUT)kK^qG$ޛ0>Js{4Z|=5! @ @ @ @-`v O&wkcunqR]eGae{#vt)\}4%csIXݎvĮs$u*zջ.,NaHeFQ @ @ @ @4'97 { ?S/ ék+ fJīgRsRDXl <^K%e7wbbTKH#؍<{,VOzb"Z,x*uvtnIV_ Ӌ @ @ @ @AItX]w~7~#z'V3k)$EGB!p=ݵ돵cHҿU:v:iw9'v=}Jg~>*u /yIWUpbbW~^zy  @ @ @ @(n  Щ,jnen/_]^T,[?b=jH/,l]Ou!%V @ @ @ @U (^% ].|nuVywדbx8:-/tNݮ1)_cg=Kuz1F';bU++~{B"B1_{zͻ5K @ @ @ Н Y5ThuAti\^֥s^Rb/)I^/|w.]G ǮKg $qx/mqڸ3xI^Ifs8waWN5zы1wYjh\&q @ @ @ @@@K:9%@xK^vޝZȆ Rm)nq=[[B҂$ɤ0W"½qmSZ vyg+[])q= • ơ q+Yxzw=5~/U'N܅[} @ @ @ @@Jl hH`ƍN㮵XMAw5+.ՉK K|ץPzlX\*3i&)*K1v@WWyjW++)^|1|S,/=V3Wi @ @ @ @z[@vo? @ .䦋3 IU]zK;aݬ K[*Ta")V^yqos.U8_ԯpmuG-/,/-'_v$e+7)|5f^Ug삐w @ @ @ @V fff` }T07 ;R`m(yN];UwjU1WZR.nWZE Xp=c9&lذ!>|8򑏤Vq[i @ @ @ @ @P>[  Rz(|CJ|^;%A @ @ @ @+ @ @ @ @ @ @ ; ,eB @ @ @ @ @@m/<H?l۶--^s @ @ @ @ @k'{DU U K sssk @ @ @ @ @@Zd @ @ @ @ @dK@vl @ @ @ @ @h6 M @ @ @ @ @@`gyʆ @ @ @ @ @6 (n# @ @ @ @ @dK@vl @ @ @ @ @h6 M @ @ @ @ @@`gyʆ @ @ @ @ @6 (n# @ @ @ @ @dK@vl @ @ @ @ @h6 M @ @ @ @ @@`gyʆ @ @ @ @ @6 [hhO~שW礮i @ @ @ @ @P>[  R}~W^yeA @ @ @ @WE'@ @ @ @ @ @@v`gYʄ @ @ @ @ @6 _xh^ץmܸ1 @ @ @ @ @+ @ew^7::R4 @ @ @ @ @ / @ @ @ @ @Ȗl=O @ @ @ @ @ Fm @ @h`@IDAT @ @ @l (  @ @ @ @ @mPF\  @ @ @ @ @Ȗl=O @ @ @ @ @ Fm @ @ @ @ @l (  @ @ @ @ @mPF\  @ @ @ @ @Ȗl=O @ @ @ @ @ Fm @ @ @ @ @l 䳕l @\|oWP @ @ @ @ Н Y5=(?moKe~7O?=uMc]bR @ @ @ @Nܬ Je>??jk@iQu#3qӗ @ @ @ @'yK" й_2/B; @ @ @ @t.{`K'B; @ @ @ @t@kY38#\uUoߞjkOջVb.B,2 @ @ @ @E@v[X%@@bW^ <::R4#Ў]aYJ @ @ @ @v 3 @ PA @ @ @ @l ou\  @ @ @ @ @|#%@Z-0Wafaf 3^~G @ @ @ @-PD! @@Kv,) 'xLlCI @ @ @ @-XjyX  @fؾ͡Մ1 @ @ @ @Z,Š @V LNU!!@ @ @ @ @U (^% @}s/l|c!,,s*  @ @ @ @ @u B'rQu.,MOM8Bnn}K @ @ @ @VP" @+`f>}CK  @ @ @ @ @``1 @QX|fg"7g[Go] @ @ @ @ @ [-*h@Եop8'ix @ @ @ @ :Mk%0>>ٓn͡?uM]pMqM%#7=an04@ @ @ @ @hL؍yMuصkWx _z=#붞^8a7mw!j&O?yWX @ @ @ @ K @ f7w%[Ƨ+n @ @ @ @d؝tU`d !fu |S C|o5!%@ @ @ @ @2e  @ 02iWUoy佡\E @ @ @ @ @`wS&XwT.[!,, @ @ @ @ @  @-1+ gK @ @ @ @( gUv!7Lw'a @ @ @ @,:K`x7Cn~ob8 @ @ @ @( @e#c_.fk]HF @ @ @ @X'oZLŭrUdǮ aan '@ @ @ @ @@ {7u @կ~5藿aƍk{ӟ'p; @ @ @ @4 ,]  sOxߞZm85UO}_[Eɿ S~- J @ @ @ @t@_R @ ^ۿkXMx-2 @ @ @ @2';sTB Ьq#u[0 @ @ @ @[@z? @@GM?SGe? aaf3 @ @ @ @2!D @@ Oe:99R4!z2?`ذ3s~94 @ @ @ @ Ѓv.eS χ[^}}3ޒ0F%-Ȧ> @ @ @ @O@^}Nz @@(< [ ;C @ @ @ @)) E/bŜ|vB @ @ @ @`Wqz@ 7/ 2▟(ڝ%@ @ @ @ @ۇzZ`d !01韇 O @ @ @ @ @`%+ O>5=Í ї @ @ @ @='  @ 0p_B~B'`w@ @ @ @ @Z kGǻa3.oB @ @ @ @ } @'rsod;6^[{ @ @ @ @i=%OC  @ #6lg}v*T[ce!?X-LO}":D @ @ @ @ @ Pc@.xK_vޝZhK]Ө-0`@C8|T @ @ @ @zKҕ-?d5< @ @ @ @dQ@v @۫so!@ @ @ @ @@(-M!73ShB fæ>HC @ @ @ @ -z!@vᱯGW @ @ @ @,;OWn #hL ƧAz @ @ @ @ @ c 3@CN}w}=M=V_g @ @ @ @ A|R"@zp Wȅ64Fg @ @ @ @dI@v\ @Uј?M @ @ @ @(ȃP]ۧ}G/62D_ @ @ @ @dF@vfD @nנ?tt'@ @ @ @ @@ (g(XA 73Fg}  @ @ @ @ |&D_Z/P߭0??21el?CK:c1VA _gȪ @! Jחut P&~]= Xn @@]\nY=L:@VX{&@W_{umlƍŠ @v[Rop駧i,O_teGvcf9c @@ r @vl޼a$@q @ظqc;ŠI=,t֭=, uh B|9 9rhg [ N333 mxgwߝ}!ΥD*7~[Q ??W46Ho:R snnoW'dQ>K\awgggB4-Ŀ8 @@+ b V+{ Oʿ+K)^*O (^jTi{Vnf_8nmAxia X+c9f'a'''C @wqǥ8p LOOi @foUشiS qX@,;SaF8 @`*lٲ%8  @sܔxTcce׶ @m~F?'@ @ @ @ @@s @@>'dbO<wiﬢ @ @ @ @ @`}`Y  а^~65ntt4ͥioO_j@.̆ O6?--  @ @ @ @:Md= @U}V="@ @ @ @ @@6`g9ʂ* rz02 @ @ @ @& @@bc6~6ٵL @ @ @ @XnJXk\0̍w @ @ @ @dR@v& @ 7/Ob6h: @ @ @ @6 54G&~~3 @ @ @ @dL@vt @`I`P}6{ML @ @ @ @@` wǴL O> @ @ @ @P*)@nv_R|_o#cd ׮ LM @ @ @ @ (n N'"` ZX @ @ @ @mP&Xa  @`ݾ~yQ 0Fo @ @ @ @Ȝ=R  U099z-,,d5U5X_gt @ @ @ @ R-Huo.=v공#a?e+) @ @ @ @  {#׹lٌ콮o @ @ @ @(P].M]-ן9M?C @ @ @ @@ (/udQ ?qoڜra>] @ @ @ @ @\ _~A:S/xAkR;Rm`wާ`dsBngE @ @ @ @hP@v` @`N>w35hK]F~^'gg[ @ @ @ @ @QFO:UofO;Щumx_ @ @ @ @dG@vvL  _w`?~ϧSu @ @ @ @ Ѐt%@O mkH @ @ @ @@&`g1J@~Rv'}5w @ @ @ @+ (^H;`w?b @ @ @ @, @Qdu/t, @ @ @ @ (WJ?hBnahq! L @ @ @ @V@v>: '@RĽM,0^ @ @ @ @ @> @@(,sX,J  @ @ @ @ P")t@~r 3aؗeI @ @ @ @tɍb sݵh%@ @ @ @ @@"@!ooŞviahh(u'ӡꑞL[y2 %LsQ` @ @ @ @}&@79n-qkO>rnGNv=4%@ @ @ @ @ 1 @.)f|&@ @ @ @  Y=$8t@.Y/t- @ @ @ @^PO_Ȉ@~ތd{ij 3  @ @ @ @Z|׮  c\pA;SYv6 CnS[_ۭ)X7 @ @ @ @=&t ^-[O?=hK]Fnn<h)UT*r+QL5m66Z-54?zhkmC661BDY@QaEvYscvv̝2Þevxd2y>dvf  @ @ TF @7׿]S׮]5N}PI)ʯG_ 84 @ @ @ @O@v,D \ve;cbb"kJ)0Pjs ˼t @ @ @ @N [&@(FvɅ@i͹U @ @ @ @%;zʆ - N~ew @ @ @ @+Ѐr;w @ʍCVy78=# @ @ @ @4`UO @ YdĜ < @ @ @ @ " +bs [5- 9(  @ @ @ @$&;J NNɫ2qf  @ @ @ @ @`Ye2J k<9S#/ @ @ @ @$&;J) !J159AZLV @ @ @ @N,Ff @ʍ#1 d[cQl @ @ @ @$$;bJ hNkW @ @ @ @ p !;:ؾ!k9D @ @ @ @ D ) ,Pٙrzr@)̆j>d  @ @ @ @_@}JhoM6um߾=Hk[;3_I$i @ @ @ @ @%F 4ӟ ZV8ATkϼz8TZk/"@ @ @ @ @@8  @ :Pn<]XS:yc @ @ @ @d4`'SJ @ M9Js4UBo @ @ @ @ @*Zغ _;/\s5]r)]ӒӀͧš4,K @ @ @ @@4`#@F / ❘vZj ةUtTk7j< @ @ @ @V +l'@\gBEd%FD  @ @ @ @4`TM @ A'`'X}.'@ @ @ @ @Zyy @ 'ƮD*̘c G, @ @ @ @$$;bJ) 8;Ū>od @ @ @ @ 'p%0r$0Y,XJs3aX @ @ @ @ hNR!@@jYP Ғϐm @ @ @ @("U[ș@+g 7& YsOL! @ @ @ @4`'PD) @ Urcgk0a'[ @ @ @ @ P$ E\  3윕,p7F @ @ @ @ȷ|OHZ Iw(ɭA(>lB @ @ @ @@14`β$@@.ʍ][q Tk7h @ @ @ @ȵ@% 8tPرcGWr9Jk) 3;SJG.#Nn[ @ @ @ @Rpvj lݺ5wy]o۷oO60Yk"d64JP @ @ @ @i hN#@@nʍ!ݳs[vCnc8 @ @ @ @q h!@gʍ],M`vssg! @ @ @ @+9蜀A_3alu @ @ @ @(@Kx_/v|YguSg4`Trn>P@ @ @ @ @@4`xB'@XgqF_Ů'&&B ةT2<뷆pj=mF @ @ @ @@ZӪl @#<$@)B%DD @ @ @ @@n4`T%@@qƮ$+ӡ T'o6$@ @ @ @ @  R&HF<3\${Ci| @ @ @ @\hEIb Uf[߮Zyڍ @ @ @ @d4`'SJ @  2Lb M\ @ @ @ @D.; E(7v1m9Q`CCV @ @ @ @";Jʃ gv&Tb־kh"@ @ @ @ @ b Gh(@U".! TLn; @ @ @ @ITB(ݻm֕饗^g@IDAT֮]u-rya^z4TZk/K$@ @ @ @ @  AE~+nݺ5\p]>(7v=HZj8;G* @ @ @ @ dA @9l̓ @ @ @ @$&;Jy(74`罆yVz O! @ @ @ @ hqlO=/P4M@ @ @ @ @@2d2x_vѕe{4'`w`ږpPJix6 @ @ @ @ P@ , ȧ@Z zjWnw]ؕğ3rk"9pOhnxM". @ @ @ @p(IK d=47k.@v 6 @ @ @ @ 8Ŝ hw:N?p>R?O^JE{3Q;G= jka k @ @ @ @/>=h4—>۷uօ7MCO>d?0==}x˛n)lܸqXۇ+(Z}n"Z]c v) @ @ @ @ UVnޱcǒ+xf @ 23S$񽷆0;B6^J @ @ @ @24`/?|S; wڏ?xG?х)}0˿K׵ !Pр= g{,-N}߲W  @ @ @ @ 0/QXWś>z³O.|f&''|9xh\Z@ CW~U @ @ @ @<+{ 7pS;{Moz1Wï~josW߇;vzoof) @`s##J#xJ @ @ @ @n =Ź{B/_iޞ]wܱ9uxG?&5 ~6"@in&u\#@ @ @ @ @aw CZR`nn.3{ҙNw?_]wux7 5PG _"{׻N=ԮkyNkRZZZ>& @ @ @ @ {SSSwmذ!T*1|ɋ G2tNѾik‰?}'>;^H@{og>u;9a?G=)!D6Z8H6 Л@\>: ~̄=/ۉg͚5=7㎼e#}<'RRmkNxob@.0D  @` P<2&@|3ha @z̊gGD jD=6`OOOJömW  0ri #?_>b) @ @ @ @~&|$rsZȹG>?c]/s9᪫:T HH 6m(fГ]ܓ_ ۨð? @ @ @ @ h^AA]333Oh,N9餓/IO|$ڵkIJ|w~wzgÆ =7~W~%ڵi)|Εnaa 'D숢 /t 22&ő?CwС0;;[!@ Y&tZV8g9LE @ߵv;AyLb:_WkNXn]&u~^ Ӏsώ]vc𲗽W2s__|O?| ]s Oco @i>'<]q&ظqοY7],KE4=Ԕ&"}ȕZR?  P /݀9 @`>lìV pd/kZ*y.׏G׏5Ѐ ׯ_i~D#o|=ͩ~~)<KnФ>{.=F.Pnt=@Yjf > @ @ @ @Ѐ䓓N;ͻw^s/>?8W_8>ѓSַ~cO 0jrcǨC?%~fvq$ @ @ @ @ (pc r>paޮ]'>VΟZx/]x= /5,x'2 @ @ @ @.𒗼$qű'I k)X3P(z|s_ۿ[G> . @ 5N|mN,# @ @ @ @ RJot_y{·PL>7Wa||<{_zؿa 6kt>`ۏ;NjHI؝R:rIT`͡GBУ]}qJ @ @ @ @^4`*ļSN9%?c?~fnoGO ~~藌  PhK>?a?O"%@ @ @ @ @` @V-ТgqFoo G?JRx[/WGlL d͉ȇ@ۃ @ @ @ @N@t??;O~8 U" @ @ @ @@4`缀'@8{ wygW]<<- T6iA6 @ @ @ @ @91M`Yrec2 @ @ @ @i hN!@@>jms  @ @ @ @(@˝y8oow~qYswsX@ @ @ @ @-=9x+_/uE<11v׵\ flv*W! @3TZ' @ @ @ @  @ ӯ#0+Pݼ['@ @ @ @ @  ؉Rȣ@ܓǰL TC#A @ @ @ @@4`R&@@,c)8)Pn>Lݿ̻L'@ @ @ @ @  )TQȩ@ 9;  @ @ @ @(]E kN8,[`vKs˾  @ @ @ @[@v'zZ svW˭fޢ3ȟ @ @ @ @@4`&@@<e'`S HZyE @ @ @ @ hoDN ds_â'Po a]t @ @ @ @(B[K@v\d;pot @ @ @ @Ѐ 9 쁜'!|!n@ @ @ @ @@4`R%@@L  T뷆0Zn$@ @ @ @ @ _U/ @ 9L.)@֮wA @ @ @ @ $@Ŗ*BRzۤ4`t_B`y. @ @ @ @ *' vs-rsO^C7 T_a. @ @ @ @ j*#B ع( {0;=6 @ @ @ @< hsN dNq@yˮ @ @ @ @ @%|Cd^򒗄O}S]vi]< j!JyՋ9 @ @ @ @*C(78'&&BA5PI']c/=7 @ @ @ @| d [ w'`罂_JZۼe @ @ @ @HH@vBŔ r#0;܄+P 5V#@ @ @ @ @ sX4! @ DS?%0ߗ|E @ @ @ @ЀFeA\ dsU/.OZۼ&@ @ @ @ @ WsU. @  iQK 5/J @ @ @ @@4`羄 @@-b= d}al߿84 @ @ @ @&;o/(7'B -Po>^!@ @ @ @ @ s]> @ YKv>+'^\ @ @ @ @ #Jb*$"9;JJXY{_S^?:ocywL @ @ @ @@LcX PrsOA2fUc5^/Uk?ۙ7;߈=p{ @ @ @ @""IH / 5Nvy{5  @ @ @ @M رUD<8}ۻ^=Ú5kE?m/0H`/?Ntviž? Xs\'@ @ @ @ @`TG%o_,SW^ye][n \pA׵Ysw!*V|&  @ @ @ @&x @ mrsO ʮ/WztuG_4&@ @ @ @ @`G\ @hYsh)˷ /V{͂D @ @ @ @$g@%@q5̧Яӯ4:/ '@ @ @ @ @ J1zK7ͮsN8P&1H+ M @ @ @ @ X@-O~ r)/~qrnw]}iD[+[Jᵟ［  @ @ @ @ 0@lk[ɱg4cin7^77k @ @ @ @X@ `{F`Jzaҕ(^rE<S{@2 @ @ @ @G (@Nto! $I @ @ @ @Ѐ (7'X @ @ @ @ @cTqeL~LWTZ-v]u5'b M\ @ @ @ @ @g =SH dYƺ(J]c @ @ @ @ @W׉ @h^{  @ @ @ @ @  رTBH\ܓx#@ @ @ @ @"h.BHA@ @ @ @ @ЀjB  @@/{a2 @ @ @ @"ЀyGT͉TR @ @ @ @X@v/u M`Jж @ @ @ @AZPZyB @ @ @ @+;9r#i @DM: @ @ @ @hB @@D)ʏ@| @ @ @ @.{6 @L @ @ @ @HD@v"bЀsu\+pC @ @ @ @*Ͽ ( ?SWh^{m8Ӻ8(7D'0;G @ @ @ @xN@s @ jz*|rр쮲8x}cx @ @ @ @@YaRZNNr@Z[J @ @ @ @]@vI-HG dLYߵ+. @ @ @ @ @%@AذaCK&w5CU24AQ`94^C @ @ @ @} @ 'ykDh]bdͧC)C bjְ܏P*G @ @ @ @W +n2'@ad=ڵ0vd @ @ @ @4`VQ @ 2rswd @-)B @ @ @ @Ѐ]Kp퓒@uCk\ @ @ @ @$#;RJq d͉8dXs# @ @ @ @ h.neN[{M&PmI-% @ @ @ @HB@vepvY{lA @ @ @ @@4`R&@04`S^) [τ5I)% @ @ @ @HB@ve(7' Nd"ַD @ @ @ @O@vj.c O`J_ an6C @ @ @ @ ]? @ jt(cʭÚsb#@ @ @ @ P8 ؅+  0<91D Qj}KI @ @ @ @@>4`n&@@.sQ'A-0^Zsq): @ @ @ @Ѐ]bK| y /z{ǣN*k>u|#rkOX3u_B# @ @ @ @BT $  tضm[W&fk kMxRZ_M @ @ @ @ 5'`VQ @ "U(ȯxk!7 @ @ @ @HH@vBŔ bpvlO^ʭf꾼/n @ @ @ @I TF2HXs y{2ܸqc8*"< ׷K  @ @ @ @$!;2J"\tERvZL 1UC,y7`8P*= @ @ @ @ȵ@OQ h<˙@9LݟK @ @ @ @ = TFFM,!) @ @ @ @V@hNdJz(VI([B$@ @ @ @ @Y > @` Ykr Z@ͧš@ @ @ @ @F.{%Ѐf]e5zږ! @ @ @ @Ѐ]KZA.om5`'@ @ @ @B@veЀ^Me@Pz `DA @ @ @ @ Xt) @`Ykr؃@!ͅ[ @ @ @ @bЀC@Jbn%q @ @ @ @(•\lb O  @ @ @ @X@ `{*;+j}s, @ @ @ @@4`ܒ%@ f3jhSҀmi@~K"H @ @ @ @@4`^%@7é裏F+j&0)BSHE @ @ @ @r%;W,# Vr*Pmi&@ @ @ @ _  @=JsO`R5`RKy @ @ @ @G@v~j%RFԚM%grcgAS; @ @ @ @ Tr  PPs\WgqF8A֪8$/Pm ]|$@ @ @ @ X*!@`ӦM|g׬n0ЀCPpk<  @ @ @ @\ y @dr9I@P9`ቋ @ @ @ @@r+ 0z أ%Po)V²%@ @ @ @ 0B #ķ5RЀjexms @ @ @ @@r+ 0z أ%Pi?,VҲ%@ @ @ @ 0" #-RZӓ(u`GYA @ @ @ @$';J(&GL``K @ @ @ @h4`ݮHZ Ӏt}%@D|(DE @ @ @ @ ! S*E@v,G뛋|  @ @ @ @ ]@mHZ!JCb PHrG] @ @ @ @%{X!@@AV J@-q&* @ @ @ @TCH^駟wuWW]tQV]F=Z -Potu $O @ @ @ @`kmQn+Vܺuk z{*3CeZ E? @ @ @ @dYբ PX [{#0>  @ @ @ @Ѐ=W @N.l%@;r @ @ @ @ 1JbH'RAB P [lsv$@eP9-^qBM`I_[bN`kVq7]`a O`k+  @zr5 _gV{4`]X~}VxeV#𶷽-A @@֮]:UuŃCOZӻyСkEtz#7(ق;;;ZVA6 m|;kN>/N@Yv͝@qt&@@Ryus籸@+= B4`𳲣E  @` t*N${ YtEia @@Bu Xy)G*Pm42a @ @ @ @ȯNNԮR ' <ӏ0s) @ @ @ @ZZ,a T[bQ| @ @ @ @r%;W,Zq(:60k) @ @ @ @ZЀ]K8ByD*D @ @ @ @Ѐ:Ѐ2 f-e @ @ @ @Ѐ=W @YVȼ%M vjms! @ @ @ @@n4`T%@@NF",@eP~˚ @ @ @ @@4`r(@5YN jj}K  @ @ @ @@^*y T(>oxG8䓻rQۛaW  @ @ @ @8@8o`k] @ePk>DB @ @ @ @ Yc2D*H #, TY @ @ @ @ J ثt;<' <#@ :jMvtE @ @ @ @@*X(@\/x \QjF,ሃ%*3^K @ @ @ @hED 71ݻ+nj&G} X@9Li^ @ @ @ @X앹~}J@IDAT @ @ @ @ЀT9%C Zmngz<zo" @ @ @ @= @`N^!@Zw mI @ @ @ D ) Z@+` Tk{2 @ @ @ @@n#X¹*3lK @ @ @ @ЀʀQh г@잱L$@ @ @ @ p#0<%@ h^; BZӀ= w{ @ @ @ @_@vk(D!jQ!z<zl @ @ @ @)WW]~ gyf׵Q Vmړ>Tk7+Y @ @ @ @@14`β$@ p-te|k ϟ"@ @ @ @HV K63 @2'`F%Po%@ @ @ @ Hlj5&% )B]҉ Tf?J,+ @ @ @ @H?O:+w'PvUe{*$jA&IM y|(296h5h^-c0I3Ad !@ !!IսU/vץnƪʝ;k]k}! :3gNdPD(KNle4,X @ @ @ @@ohvnݺ[N &ą^{  `Wn}T>3"@ @ @ @ P<`woO&M8 hhh@卨]< @ @ @ @GsL >|+_J;6N=Ԙ5kVd2M5HHe"KU)E @ @ @ @ T{^$^tMqGMMF---_*N<Ę0aB1o޼ @3~RAeJ4& @ @ @ @@E Ags̉Eŏg}6ɻdɒO~{w~qW79 G@vyB\-vZ: @ @ @ @z@ ;=yx .cvo?SqƸqӟt~d5 @< loY @ @ @ @@r'O.,.\wuW|wkį8cg}vy @4 K**J 7UM @ @ @ @C&N7pC_"0`@ǔץKOӘ2eJqGCCC_ i,~P @Mˢ]\Es8 @ @ @ @jpÆ ӧN^lYr-qgѣ;O˵y8bܸq|&k9 @`"F;1-9 @ @ @ @@*cO6-fַ̘b|;^n]|qGNN-9ꫯV<}'`WH@I*I\A  @ @ @ @v޸g}6fΜ$']wJ&a_{j*.f dҗ+O45oFg#3d, * @ @ @ @^*k ,X7pC\1-rO4)O{`}|p̝;7vuׂ{: =T{M@o3V)5K @ @ @ @솆[rE׏>hoVeԨQӭ??K_R`+:2L[orJ<ӑJ5 @{Lc0^#Pߴ{ű7K&g @ @ @ @(@`]6f͚+;et:=i'|ror{W^yez֖=SNs  PMɉw R=ztAؕP&Դuk!gA @ @ @ @UQl抮ohnn">8s\L0as;<37M|dmy X\z.]4lX9;̊Hdrk-'0N @ @ @ @@/h/7xc,\p\CN;-wuruO:7i( @ 3 .Ptg͈To @ @ @ @tI_cܹM4]z1dȐꍝw޹`^!@ (z@MҨ[TݯnA @ @ @ @*Pdv:+>m67G/rsSL) @@`wLY 9[vo~r'@ @ @ @(@`4(N9iGuTb3k]w;p{ =T{M@xwTi~+Q$M @ @ @ o*ZJ⠃]q1bĈSO=kXE Mg,O?{Na @ @ @ @طv[^R{雓6 7Q}6O @ @ @ @AR_g2xc̙}uK >dCho+b @ @ @ @->c}}f͚`?b~0N9hnn @`o}M&,V=׶e? @ @ @ @-P_~9{ܧo@*ook @@ҙmYH@* @ @ @ @z@E |򂐋/. @@q]\OT@}jOS~ @ @ @ @J*g b3g` :CP]\OT@rU{#@ @ @ @ PRREooo}s`.1o޼3fW_wV^z)֮][؄  :Wwy` C uFݲm!*&P4'ZR-L @ @ @ @%+NR1mڴ8䓻?ϑ|u>.+8~8 xGbv++W'Y^C@ l7b"RuUT @ @ @ @O ]ʥN:'?Y%6{kf  @@qҙ^%6ǀ%K @ @ @ @%-N稯/fΛU[[|x~|=;, @B)Sٳ o<ԥR%Pyt۪X7'# @ @ @ @e(Kvd9I1c{QKF6-+W''km Pys`W5Ȁ @ @ @ @-/~Wm{w-I=pvOs-+f"@N ;ah1pn T  @ @ @ @@?nڞ  @`[#]Atob&@ @ @ @(@ Zz@*7aM`ʹʬ(Z< @ @ @ @Tj~;r#@@ H@ER1Yۢ @ @ @ @-P[G=x7;(xCr([@oktJZ @ @ @ @z Ы yHӱv`!@@ӟg}vAҏ3!@ @ @ @ @O 6U}饗C=^iy˖- OX|yE6vvE-JRMwU{#@ @ @ @ M-^`A\qm`c)^{mخ+^bE<766ƌ3} =zt'/Ls_ J P8Q$@ @ @ @ P=_yښט2eJqwǒoVwvX 6,?xGb9v[$a @>!PnY'b @ @ @ @6%P{'ĉsE{g~1s̎fG \rI~lSO P$H+R0akor v_{C @ @ @ @ /_?|>/8 wnlx"'v/BAHgH@}>7#@ @ @ @ P7|@/wt^zxW:w\AS[[ƍƒ%Km (@:8ukEz¾A;#@ @ @ @+NN|Ν_.{o3fL~Y`CEHeI@}㜾={#@ @ @ @+noo/`fw}:ujAŋCcǎͷ5 @8on)(@}쾽A#@ @ @ @+~_[oκu(? ;WKvi|[#88ukGW& @ @ @ @_ T{„ 1p<3|xXG9f̘эe]} (@:\@ =  @ @ @ @@XvB/|!/Ǚgzk/9Ygչo qŋcIC Pq@] j?l  @ @ @ @@E ?ѣ7xc]w5x?~||S*馛ɓ'ǟ袋} (@*T`" g=  @ @ @ @@v W_}u_el1gQ___0gܹ%/8&NѸf_|1-_ulvc`X|}JX5>'!@ @ @ @-NO=xޗ;ݺiSUӬqI'mkH ]k-)V ,e/6C- Դ,D)[ @ @ @ @^#PD#{.f͚<@<1f̘8_j(N >779 G Q]IQ`m @ @ @ @>/P؉ĉ_rU)S5\rJOj @ +ږ 73".J @ @ @ @(@`d)_zg  O+>F}my״^&Nԭz"Zb @ @ @ @zuG$p!K/TKF6-+e'i.ex %_޼j7!@ @ @ @ P% EHA m iʑ*Xx‘Iw)q)I @ @ @ @P]!x @7 _ TD` ׯO'؊ @ @ @ @2 T]ҥKW^hiiSL6z6Hg74B p?/CW @ @ @ @j㪫9sD[[[Q.(@:T`" '0nFv @ @ @ @$P;.~W\ @`)'`oB\ׅ"ao(O @ @ @ Pitԧ>/袀e~*#J_)I\A  @ @ @ @D'`zCmw]]]|QFŰa"xF9 @@pv|L;o-wu~|S @ @ @ @@*Z}m?JŌ3k_Z 4T^ ؕ2 P OإZS @ @ @ @ To&9niӦ4 @JH6T.s)UC @ @ @ @HҕbXbE+;0y T@*:ߌT@i[2jؤ @ @ @ @Tg+8ꨣm Nt: @ @ @ @(@i*&jjj r!}>Ȉ @ @ @ @*Plw) @@?G >oFRZ"վ+M @ @ @ @^RN0!vaXdI.>MVtKXre<y[Wt`m {yUrz @ @ @ @*$P*l&>g|Ғk @@u 2Օl2^e9I @ @ @ @@*VlsύaÆv?9~" @@QYE@8̶ @ @ @ @ vu]/ӧKbժUo}+\dF*q3,rRvҙR>!к~u?fW5` @ @ @ @EIg}v]6կFKKK?_/~1w9ve9rd9tn?TI+Hoҥf JI).3 @ @ @ @h^Y˹… X{{{LHg7[Js ӯ @ @ @ @U"P{'Ν[% @- (ޒ{tLO^;|gۊ_wJ @ @ @ PMjJF. PLS&'3J`'Oz!@ @ @ @$PkkkS: PijE*&~s}^o? _i؊J @ @ @ @*Zx K^4 &__}m5-[%2 @ @ @ @ ] @`)[52mhhoۖ%@ @ @ @ P]qXti,Z(֮]{b]vof @ @ @ @_ ⥗^/_\rId* OluQqGF2~'F:}ݸ &9{sy_xW?Oc̘1ۜC=;#ШQN]w5?OqwG[[[,Z(.kvǚ ҙY;%@bhqTr0 @ @ @ @ TMur?cժU[;w^}#zq 7Ā9519]z5/\vn`L6-y晸袋")Nꪫrxw׷~;f̘6lX~ST|ӟ}k9/1bokc/_|)ت@ [52 7*^0 @ @ @ @Y{q%ŏ>h|C׿#<2≮[rK/[oudB^?Do2eJ~ҥKsE;S~@sxwbʕ{m tU ]2b XH2^; @ @ @ @ PT-\ԥ6T*]w];n4_W1_xXjU>fW njg^{|kРA1y䎮@:& @`[RQa5  @ @ @ @Sb'`~=}8{t:HN~Wbq=dɒp|vH)Iw)dgώ:̴ibذaK`=+ rjD"@@9gŻcN+"@ @ @ @ %`/X V\O򨣎ʷ{8ccҒ ꫯ{ڮ192_|ml$/ Ɲwޙ_+ ~ ˖-[os1;vyt]`Ĉ>.7m2dȶm}L1$H9gxY;؝b]oFl\},F @ 4ݽU+f GnBb @ @ @ @}Nb'`o͋#8`x}˷H;M({~`<7tSA~zvmq_|я~F:\ = ylSݽe6Eh_F e3ew˖Sq@ Gl,0[q/07t]ane&tMaTY+NNŰ;QFŎ;|0Wxؚ@::g'@@6Ѷkq @ @ @ @lMvky]w/x饗rKl'sb<0СC 攺}9s䖺KG?Q.k꫹ln89zҤIo~ow4>7&[_veqntի?i̛7Ѹ ")v ׇd;S 0qvI@IDATy'@1X7.>a @ @ @ @TUv>H>׊+r˖-v-W|][[Կ/~hll̝Bo|#=sO>d{ｱrVzKWR\liJzqgDR\w}w</ٳsqGucI@ O? Gy$"w'`T8z(Pxy @ @ @ @xb^_fwʨQk|;/FkkkDS;gP;wq+NkqWn2^MMM`{雼o[Hgt=M`#Y˶ @ @ @ @l(p@{;C\uUO}*7RTL:5n{7~rxr˿{8t:^i<ؒ@*-G@RQtW @ @ @ @M7wU %[ϛoϏ5kĄ bv^?:57oҤI<^_=WhnVt-N ؄@:M"@BwĻcN%@ @ @ @ Qدj<;IJer+VN9rd1"w+j7nܸH>}')#@<ɯO;vmT`n&>}xGb̙y7c͝=qĂ{: 3{)J.0qvc @ @ @ @ oo6*.(/GWSL_u,[,ˢ9%Kic s{IJ*PӲ(V=C?Ru'@ @ @ @ @zÁb B92fϞ?яT|]tƌ'}ݷ`c=?pL =so< Y @ @ @ @@'`_y啝6lX<1uԂv犭Ǐ_bu n @@N_ΈL" @ @ @ @@(YvCCC$'`w~{yhC (_:z뭂1@*G$@ 5pŃn}osvD @ @ @ Pe+^paUlX 5tFvפ"@~^| @ @ @ @}HGR!([!@@Heۖ>"0pʬ#  @ @ @ @jP]moD>'`WɋHF}ӝ~ @ @ @ @"PەI=syŒ%Kzg @ *B @}o1aO @ @ @ @؂@ :-,T@*X)ʏ[d-6;  @ @ @ @=H! @@pvvH/ onP}yF @ @ @ P!,Z-RٕU 5۷6} @ @ @ @ @m!pܹ.]4l]tR @}ocevu `&@ @ @ @+龲 @ &*,j_p'@ @ @ @+ ʛQ i,b4 PyƙOB @ @ @ @}B@vx6A ]\PEuI @ @ @ @@Pߡ @Lsc HJ =fU2k @ @ @ @}E)63X TE @ @ @ @ {=J"rvI\%@ukG*  @ @ @ @z^ mHgTDT@}*B  @ @ @ @YwuW466f? @ E*ˎ ^qVD{ @ @ @ @ T{ƌ1v8bΜ9* $_Hф!@@u dŀTWR!@ @ @ @U-N֭[zkp 1a„ cB,@:ܗc/H`P̍  @ @ @ @@ ;'o??ŤI*:O&@ 2 KL,<HeWV8  @ @ @ @V`s11|M|+1v8Sc֬Yd69 O m*^0 Po 3 @ @ @ @@ohHN馛㏏ZZZWUx1a„8c޼y3@.~L~-kEv: Pu 3.'  @ @ @ @`'D 38#̙-DZ>lRoɒ%${o+˗orA5uŋ >Ef*\ @V?5V[Z!@ @ @ @/l;׿xg瞋 . ƎyJSOŹƍOqG& @ 8gn"@w ֧dK @ @ @*2yb…q]wg?9Ə+~g7g&vvנ"@ 7 @ @ @ @/P[%bMMML:5YrevmqGR|Zti?}LӧO3<3Fy6zĉsd9#Gv4% vږQ:tjOU~ @ @ @ @U$P؝ +N bdo=̙ 3<w^\tEq);:ꨂ9:M{g?.H9Ɠl6[0ti[CxFa^$J @ @ @tu,biӦŌ3[Vlv nݺ裏}7noo\ (G鮈ugvJ @ @ @ g]v%.X|V1S?ıV@(6m3T ]맻m @ @ @ @J<`믏o1I&cc̿sƮZpO] QM`PX7mK @ @ @ C.nhh[n%Wt裏F{{f9jԨI/})W}WW_L&wﭷފSN9%~HRN`3+thvn @ @ @ @=kβ<}L2KBBCBHBXȢ( R>QDUĺGKS -Jm-.K, j B {XS$,d&39cs2oYϜ^!{JHr癘={vww+N'}Ygۜ{Ƶ^||CyO,Yvh~OeD*:{ @WcM @ @ @ @/04{$A_>veD ˗/l6H'm2k P-scuvutTK @ @ @ Pj?D3m @_5M#@ @ @ @4ؕFC8{h Pͳ: @ @ @ @YPɿo'xPiߵkiIvt 5 '0rQᏑڿf @ @ @ @@ 7l֭+{  @RjHSR7N^3!f @ @ @ @/.EHpvO@% ԯ=+Sɉ @ @ @ @` wE uvky 0t5kN @ @ @ @e!P[(͛lPۗP Ci+JyVlUd  @ @ @ @.P1cT  P6e k鎦[I% @ @ @ @  @\Rٶr U()Td~%` @ @ @ @ +v'@@YN.%HJRyVI%( @ @ @ @(.]  PVN.%XJLvcJ,* @ @ @ @JPE&o_SScǎs-$nAg]v]lAXhQvm`.7n\bl tm ˬ!@hh5:FɃ @ @ @ @  V}I'cm> C &HO??~bl(;]]]C PTK7D gu֐`}u @upYDMcM @ @ @ Pv鲋X 0HEi3T@smԷW-_ @ @ @ @@U (.ilpf - F, @ @ @ @Lj gCCC5*}cߎ}9 ȑ#cJt- L`GfOV @ @ @ @+sgܹs7w @`'xbOJY|ydX;Nؾ@YfK? @ @ @ @H} @A N!PØi @ @ @ @|)B"@p 28"@@E dVȶVt#@ @ @ @Tj ?U/@ 44:;ڎ @ @ @ @`  :I@ Ե΋TGsg(5 @ @ @ @@u ԖjtXhQ^c~ӦM P6N.W%PD hXXG$ba @ @ @ @G z׾gώ70v)N;cԩ;&l[ qe @` +oU=p>+  @ @ @ @%-.r']wyqǬYz-Žz9sfL>=>GKKK#@*V6 "PŨ]D+N @ @ @ @~D=|ptMُ<=cΜ9^oY uv5 P8晅 @ @ @ @E-ړJlvPvm4iR>ݟ#FĒ%K򟦦Ě\sΉ+N8=ضb_5'VO,"0ح'@ @ @ @(!`wttĹ+VH|qZDWĩׯ矏1c$!@ҙ @ҝk~]a z/ @ @ @ @@|[ߊwr}ݽ_uQqwC={W~_=|_/ʶn; 0(晃Zo1 @ @ @ @@ nʋ~|~>:n/#w¶/ʮTtn; 0(k  @ @ @ @%Pe˖?'?gqFƱW_}u~YKKK̛7/ @@ ,X N;lѢEY5gJ)iz  @w>  @ @ @ @(Zvsss(w`}7&L&wʶ/۸C4G]C} @ @ @ @,P=#zSSS?N&tq t PEK 441 @ @ @ @`hjf2u1bDtttt/~F=V,\0zz=yw5  P{=I$1zDTK'@\@_Α{`% @ @ @ @$PcƩgh`\q^xa dfPT jE@ 44Y  @ @ @ @?E->K.|'.hiiɏq)mmm:蠸ꪫTKax=F?O8 @ @ @ @(XvGGG1cF|co~3LW^ye,^8l^F&9sć?8cڵݷ8∸{tm؆@:m"@@^mL @ @ @ 0<zG=؀ϝ}wjkkcĉ1y䨩gƍ[_WW~x51z}tz33v@^k!_Qgxň#qi'@jHR[3f  @@ w9a@(Qx\S^T &;8wÞ u{%s\2͜ G1W"@`x fgmxHueiVJV$s J6H @@ 0e  @`"M {  @jrER w𚺚^n]/enG!@A)2EҖ,]vPշ.a @LK~ۈm Z̔rq߈uttĶL1cl(O_&NZy6@ .y E @@Ny_>l!m 0 .&J wyLfOTm]r{ 612\vhE ~3_}{jGء@zѱӱ;77sEr?իG(ue_.~q @ Nع?{jZO9ܟmY+^}|} @P~T0C!j lY;l'>vCC }ѡ^ PTڒzhhYrؽ> @ @ @ @  @:R5 :߾ (@}ݑ.~O @ @ @쁨YC puD) PhXy{/p @ @ @ @@5 (/wZ i%Ob 44,vO @ @ @ 0,^fM'?%'`Wϻ))P NT @ @ @ @"ꊥKƲebƍ-X='7/Wt?pWuŇ?- @l~$bʔ)vY'`<J1Bmo_ @ @ @ @D nk&-ZT4mIÓ?8ymv*Ӻ @0Է'^]5iA @ @ @ 0E/~O^{m(Q }2HuUubk @ @ @ @Hfݫ3:!/NR7OHe]U/\@C̒M` @ @ @ @[ [n%~魢jhh)SD]]]4iR1gΜ|gc_1zk6r @`W ݹ&W14 @ @ @ @ {ʕO9DSԌŋǖ6̝/|  @`N!Q">ݣ  @ @ @ @n‡@IDAT*P얖DSLI7u8M|Dght}=oi @L# PLFgg @ @ @ @Ah؛ 78~MďKn'x"޲1a„8.][N'@p/@CM @ @ @ @E+u]\2y Nέ4iR~SO=ok @fTvM"y@JB~HeזD, @ @ @ @ض@`kێ`=:… m ,Z(%ta @ @ @ @JWh'Nw=/3w|{ƴiCO?t[6,YZbEAҙ-()K* @ @ @ @$VJxG>֖lr!{6ryД)Sm ,*ެE]di% @ @ @ @@ sy@-[oc~lSctzsY}UW%{i/? @@D:†JCD @ @ @ @[ ljV:NO?x`uY?!?^{{|gs]wņ /sjjjb5 @`@*Z(=UwD* @ @ @ @@Ӡ6xݡd2կ~'tRmoˇw饗ƭޚϛ7/r؛oѸ c]w9Mhkk%K$rm"si/'`W| @s}ԯ=7`O#@ @ @ @U'`{{#J%o\1瞛uU|N;׿ @@9 3gҥJ)u,"@0 442O( @ @ @ @ ;E]>`uQ,ݸcX~ζ;s?=s[ @Ne@aQXX*B @ @ @ @@ ԖJsL,X .\~{L:ujjj?A|q7ǣ>L{ȑ#㤓N?iҤ @7kh @tnQGn"#@ @ @ @T@`oӛώ}s^:zu]C\zHezd]~՝z—vlc @ @ @ @J?/fvO>?K%@@ -o/ vY'`<S յ1V8ax6 @ @ @ @@.&*^`ܸq~%\|ydX_:N9( `ƫ @ @ @ @[ ́O ieL22^ @ @ @ @(;;;cҥhѢ /cǎ>uڴiFdDap0 {P}h+ @ @ @ @ \SO=_bٱqN;iW_}uL:us$@? k"Y PF-wWv\E-T @ @ @ @@e K%Iw^~1k֬^sq^:fΜӧOR*鈃%+}5#@vR]w @ @ @ @`J{>8nwq5sz  PML[5+WT@C-]]D @ @ @ @*P[_yVn1iҤg}?#F%K?MMM59wuWp {: gTw @rݸ8Fy(:v:3 @ @ @ @bZ{nX"z'_k?_W^_{>ƌW"Y'`: @@ 46  @ @ @t1ַ! {--:ꨣ;z(k>z\qlHeZ7w @ZF#* @ @ @ @*@7tS0N~8c}m}qmE]]]~_] pvC$L44,J @ @ @8`/[,<'?836=ظZZZb޼yY u@C]rNA @ @ @ @(Z/;St>IJE%: l_(oeQzoy'!z @ @ @ @@ +ģs'Xw}c„ ꫯvo;eEJxW[nIw+F뭓87#  P M7ƝO.0G @ @ @H` Цr,1L&9nܸ|[.s%x]ʶ%!@ٰ8/x @ @ @ @\ ]N#F?>WD8k…ɓ'vK  Pq+JHqCMU  @ @ @ @ PcƩ7h̝;7?{ԨQqɾ-{D+l_  EtnddA @ @ @(#`猾/E*;/bqw|0 /0Fk @ҙ6 Pl[ԯ]H @ @ @ P^E->K.ɋ};߉K/4ZZZc}i{q)D[۟ :蠸ꪫ;Xn]3mڴ~~Y@h\qS&0 @ @ @ @@ #{̘1#>}oƔ)S+ŋG6d21gΜ?~z]GsO466MHАl.}M.]ϫ}<(럊ڵON@"!@ @ @ @T@mr</OmmmL81&O555Ԕlܸqb @`ӯ7[h @RnQUJ: @ @ @ @@ *I׹s\2T@:VyK,PX=KUs%)7 @ @ @ @@K& @@Rւ? @`xR]|> @ @ @ @U,_ >{2&@*nꪊ\%I @ @ @(@mxG }  @`HgJZ}i\@9 @ @ @ @] oQ@:Ǚ @@ 4B/ @ @ @ @,`k4&:{`rV @ET @ @ @ @2P]/P菀e.K tKy-Z @ @ @ @@ Ԗb̝dɒxqѢEQSS{ݟ?>;HՑ{'8ފ 0t 3cHMD @ @ @ (7qEu]'"Ng/.Ҙ4ivf&@@**X&u-wq @ @ @ @%st믿w^]suOS\{qGĬY(qt %GA 4٠ @ @ @ @J{7>hkɬVs9'!/o?cw PO?t?LD%nQ ;q!0r#Q~QddA @ @ @(1`?݅[_R8#cԩ1eʔOnűdɒ?6lH^~񶷽$ @lj,o_K: PSWOc @ @ @ @\^}F__UW]~xگj̘1#Їg]ve5 PN/wIa/c̈́GWNՔ\  @ @ @ @"l!gώ1"Θ3gN׹E&LsO΍/_|Sbs.T@*&Rf @jR룡֪W @ @ @ @(j&r7vZb/S̙3.??AAJ=ztvaOϟz׽ OhXqcDWWe%% @ @ @ @@ ;=ܓ'^3x[3f/{gc…]c'x"4iRJg 463M#@ @ @ @@ /_o}k?cƌ/]dIAjHg7j?E wvFO\-[ @ @ @ @{Æ 'MJbĉ] iv @Rodܰ)U%L @ @ @ThعӪ{^O>dڹE.]  UjM_ @ @ @ @!(Z>G'`|{<2L~^{ok @Rj'?R ݹ&V^K @ @ @ P`璙>}z>Gz| oۉew\Cjpv5} PM?v @ @ @ @L'pB>E?|뮻.nC9$rl @* P^WK @ @ @ 0E-ƍgt7ǧ?hnnΏ~~61/Nu P鎦j'?ZqS @ @ @ @ @ {]wdژ:uj̘1#^~LYbEp qE]7nt+O\pAAlb{#Z H @ @ @ 04E-ΥO}*;D6mmmI&E}}}~q!F=#?x饗kǎf͊ĸ] mv @R+nj @ @ @ @BU5551wGyd:::cg[ N}t  Pi'`W44ό5?A @ @ @ 0@;wyD1ߩ466ƌ3駟?- @@ tuFs}ŧ)Aر@:fx @ @ @ @;(\GsGx`W򕨯7  P>`tAϒ%KR*OL"@h\OR @ @ @ @ pm=uJn{{{N:ۺ[  @F6Fy$:F2. @ @ @ @`hZ_}Kd5q}\ 08tmpXM%иѪީd @ @ @ @Hߣ~??ٳ?>m= Z qm@ k;+(# @ @ @ @Oh'`_>fΜtժU1y|_&Lc&8{{2  PDC-v@ @ @ @ @A{ѢEf'k @@R`qu%/_4qG'uvMxCX'#R#x @ @ @ @C ݏC:uʕvya @`CjG@M)WYI @ @ @ P`tANo~|SSS,XIHe*?I @@W5 @ @ @ @]`s0K?>=SoD_F uHڅ%0bJJ6 @ @ @ @ ;u]{l>O|f͚ ^ ؃7*U)ؕfE @ @ @Jcƌ{'.䒨??C.(oٳ矏קPh%@@ 3N.w&^ @]Hi9 @ @ @ @-f/Bwo~c%KwA+v @@} @R?M1N @ @ @ Cؿկb=$@BN.=  P) ?HRR @ @ @ @`lc(tdb@׉g^`""@ @ @ @|)B"@ tuFsni3l\ve1gΜظq6 'O/g}6$@ 3 f[qOc7"US'@ @ @ @lC`X oWhooF/^}{3Έk6w7 PӧO |T-F&Pk;6ަO @ @ @:`犯/ vq8dT MozS"˗G6MmIg>.иؽ3A @ @ @T@9/~q3fLlۚg6lz7 @w'`ndl-0rQn7 @ @ @ @\?я+A|!~hjj\5kG+2F37ߜ!@ 3N Iq ~$@ @ @ @_`wvv 7$ 6ww[wy뮻vP__Gyd\ve`4iR\{O 26 ԯ @ @ @ @`{o,]4O>ĭ޺) o4;{=#sH!:\ @@Td# @ @ @ @+;wnB37MΝ=mڴM~D_.ζ} @` \v-Fu  @ @ @ @+P_~9zG'ęgO$: GHud @̪hX˭o!@ @ @ @T@ /_ 8qbΖsw4=؎@ꍢ9@6 @ @ @ @*B`7&My}}},nmmZ  @`@:Z 0Pڍmr @ @ @ @%0luuu}{sW^ @@ٶM4"0jp @ @ @ P+d2 t9rdb{%n @vR'`o 5Egd @ @ @ @@% **\ Gah\D#@ @ @ @@m$"ؖ@sss,X qXN* 08UwĚ/Α{n#  @ @ @ @e,_ .{,>$~bԩ'`&@ "+~k&|~[YO @ @ @([tF.pU qvH& @@oTvm֘L @ @ @$ؕ6B-Y[ @ Q @ @ @ @"j+" I @ 9x3&߲8{K}@m+Q:76|7 @ @ @ @tonoܸ18{{%ѦMK @ @ @辀U|qu&&& _B˲^oy[b```yϿۿݸ?11۶mk] SZ5i"@ =:(G @ @ @X͏x#/(NL׼ѿ^=77h/bϞ=34/o\/v8֮]x7] O2dE(UǢg&^ @ @ @ @*P^jGj裏6n\z?hddd:qo}}}q5Dqgtl?^9ȷ@:eGTLn4"cG&6L @ @ @ @TB,O?l\J!駟> -[R5p\tEG>aG?QTFWkSTݟdEkGSL-X @ @ @ @`Hggvjcʯ4r8~~m)]vmq,N`7TfkQ[F @'Ñl%-pꩧf; @@֮];'S @ ׯE @ ^$ȕ@_{jtG`-9D-.y˖-qUW5jon] cٱ''5Ț@ɿZ%@ @ @ @,*{QyzJ '''_OFFF|g8p`~/cpp T`~H" ?TJ @ @ @X@ 6V5F%IҸ>ő}>ٸ>߾}{z]zWwy M ȹ@ 9a @ {']1 @ @ @ po; x{3_8W\qE\r%tb׿'aϞ=L@TcX;ǠA]Hb.nj'@ Dz^pߏ\,UwkpT5 @D_7>s6D\~DV޲@c @`I~9~C^ٮr4P#ҎwlV xz?U_7uA@J\&@ |$$  @ @ @(Wћ7on*nL ݻ7/7qW6,|&@t lLQyʤ+B @ @ @ @N,P:cO't~uk7ڧzjqJ.ki*_Ӱ_D(9;_*H=(# @ @ @ @EPk^y}57xt7Wzq뭷WK.$>@  *PF27YMYtLB# @ @ @ @1wX//7dQTӯ=ܦ>G6xG6.|7nmo߾'\/?i?H7|_nddB¥ @ #ߘ$$0 @ @ @ @˲o[Vt\~׿>^WE___<Œpxx8׋Es=C5޽;77KR .JY(Ug1l1 @@zf/ԆR̥K @ @ @d]@*vSOc b9uooo|:xe1b $'`keK XLON  @ @ @ @ q޴iStM71'p@IDAT\J\r%qwyweze1b 8X-[dY<') @ @ @([ӭwl߾=~D/:+'e/]?OHNU@usLrqv) @ @ @ Px-83En 8[%@=@ z%Í!@ @ @ @t\-HmH*:  @@v~S @ @ @ 6m51#Pwga @ V=ц @ @ @ @:+V#@@ێlh஛[>  @ @ @ @PUs @XW4X@=3 6 @ @ @ AĶ:!N([Z-pp-| @ @ @ @ (n9  ]RuXP`4m #@ @ @ @tF@vgB ; @@+'Z9 @ @ @ @-PrR @={olذ'l^VdnȐ@Givw"* @ @ @ P4Eq YJMj)2 @YHj310鬅-^ @ @ @ @@ R%@   =Ie! @ @ @ Iؙ6A @b˸KY(J @ @ @H\\JL }qW6aÆvRqvdV^=Dg(9 @ @ @ȧ|ȡ^xהHT='`7(\ @@J}{Lg"| @ @ @ @ o%$Y 9\E"08D^ґ @ @ @ 9Hi @.l_ 'Ru4ܙB @ @ @@@v6Q XH*.}&@5bn:H @ @ @ȇ|, 0/P @=$C @ @ @d[@vOhHNn @\ |)3E @ @ @ @@`ge@. @ G=#ѿ9H* @ @ @ @@`gyNQw4  @@>w~,6ddA @ @ @dZ@vOhpvGgv{IH& @ @ @ @@f`gvNcJtD`p-O$i @ @ @ @YP՝7U"<6ȍ@yX# @ @ @ @  o&@1Ie{n @ )syKK> @ @ @ @@U(Dݻ``` JKS*n @\ /)I @ @ @HӿG"$@</˛>l)U7] @< ç` @ @ @ @ (NH*N^ ]ԏo+M@ @ @ @ @@`gzO+ȿ`l/ @ @ @ @@`wݒh@Ruv;\IX3SIgp"@ @ @ @r-Puv#@@~g69 @`=;b`g9Jw @ @ @ @( $@ x.஛#v'@ @ @ @R(;"$,U .~ @2JeЕ @ @ @(< ȥ@r8̋h_GivW{&7+ @ @ @ Yؙ: @ l_ @mIm*wضML @ @ @dS@v6MPvUjغmO%L:'п3d @ @ @ zr#  8p |&S @@kcvb @ @ @ @pvfNHj3 @6 Jͫ @ @ @Ȋ8  @wmm  @ @ @ @(+ @bgqF\z饍ǵٱX7ύ  @}3_ӾEL @ @ @dB@v&I8sooPovAW`hGbߺ%"+mv @ @ @ n @`q}?hѻ[>  @ @ @ @l (~ ̌>Ў"f:E @ @ @ @t (N羈'pɍ @-y6YMG @ @ @dI@vvK8B  @s;2-h% @ @ @ @ U S!@2fGYW @Ux VMg @ @ @ @ c 3a%@@C`f_ Yݟ3]j @ @ @ @@*`bA8{h @$~]k&3  @ @ @ )ؙ. @'`t^`ؗ|_؊ @ @ @ @@W`wXWg(hޚB @ @ @dF@vfJ8J`v @@z=}c_#@ @ @ @(&@JjՉɕ7hгFf[8 @ @ @ @4 (NGjV}L>vS @@3OG%@ @ @ @:,#@J(kώ_==S]t @-yS$-T @ @ @ @@Z`ugE @@fJձusf( @ @ @ r+3 @ m  @ @ @ @  󹯲"@ @Im6v\U-G @ @ @tZG+x+^7pGmb)G2M @@{֎~1&6%*g @ @ @ @]P-&y?sD< ԋ@rxg?/ckZ @ @ @謀S;m5F`v_k1  rCFW[>  @ @ @ @t(N>Q<0  @@g_QV#@ @ @ @:"#!@@bP @ ;Z; @ @ @ @T(N6]  @N 1ٝv @ @ @hv QVs @V chG[9 @ @ @ @(N&/{ @@=w~a+ @ @ @ @mP6Z @=LnV @ITctN @ @ @ @P] @`? @k}otm}  @ @ @ @PZO @3_  @@K`Dms @ @ @莀[+p$@](Ooݷuiu @ @ @ @PJMs @N5 @@we$}| @ @ @ @@^r BxG;Q{2?Ͻ'h IR@ m!g\Z @ @ @ @@`thwy ^ ^/J+ @ @ @ @ NC @h@s1-D @ @ @ @@`w܊ @X෢ok: @ @ @ȶl  @Ƞг17ȅL @ @ @ @@6.sAāG>{dcDI3Obb[h @ @ @ @P- Xn]}17Y8ԃȸΛbr洌g"| @ @ @ P,GkeK@fG @@Jsbhw@ @ @ @&;k;&^̎1 @r"пeL\.GOOOƢ.lNn,_ Jqgn_`# B@oooJHv Q׿߬]6s '$1AY{n @, S~gCK LT;]Jv*x8@m zDd]<~_2/d= @ǽ&X@=/ vLkN(@0SO-  @Qz^`bbF`ER): ENdVv[pMJR$0QˇOQTB!@NY $|&@ ONEZ!p0j5jZ+6\SREZ!g+g:'cw /c,U/Nٷ @HšGC/|GF36s7q`ffX@*O%La hgӦMMSSSM4 @Jcݺu1;;{] @c^6;x`2og 3E Llݺ5>oGzX-  @ g>SmYf!@ @ @ @P=xOnx)7pvO=  @ Im&?_WOF @ @ @ @ g# @B`G?"I @ @ @ @< (nʅ @\ ?{MLr  @ @ @Ⱥ  @ȭ@yzk |*I @ @ @dQŠL" !_.br&@W11׻'@ @ @ @ipvZvB8@R;I  @< $s1󘚜 @ @ @ @@&`grM@`qLX;= @ @ @ @  S B @RRCT`#fr @ @ @ @@v`ggDJ@]/ @@O'  @ @ @t[@vwX%BFr,0(M? F @ @ @/;{$B (@$Xj @ @ @ @@`wX@ivt9%@r*з_o+9NZ @ @ @ @  ӿG"$@}! @ ۮN,4}&@ @ @ @:(ؖ"@jjKHgvg h2  @ @ @ȎH (@2;Zp @G |&z&t- @ @ @ @@`wh@Rk4 @r"D5=Z-'I @ @ @dC@v6Il_ @@@coj @ @ @ @m(uv @@klşt|_}qiKӄA &01uQ+R̥K @ @ @#;V%@X4k[ @@J8p t  @ @ @ @@ww @`YLKb͡l  @ @ @ @@`w ޲X@RU/}  @@ ?Zh˗ @ @ @t\-H(U$~ﭗ[y @"L>o @ @ @ Fm55Z%P/tOJ51E8@in"=g'9 @ @ @ ث3HZ: @@}_x'@ @ @ @P޽NnP @ 0}T/. @ @ @ @r`/WLtA uaUK @Y쉡j&@ @ @ @Pp @`{?k~w'@ @ @ @N"$@ @ x !pos3Z @ @ @ @  ӿG"$@@$1  @e ],{ @ @ @ @ (U`f3B2&P/z"cQ  @ @ @W@vzFdxNVd  @l{Ej+o @ @ @ ,CH*㑤.* @Y=`,,V @ @ @ Zة @9Ru  @`CۯUc @ @ @ PtE ?(U`~H2 Pm@B$@ @ @ @(;< @@RG*릚@x EXT`?7bf/- @ @ @ @ O).P.Pp _]φᤩAX@ =}e}"J}K @ @ @ ؾ rONz; @ @ @ @@TmGCH&Z> @.0(O<8@ @ @ @)&@ Jձ< y$*ne(E @ @ @*;/oR/TS  @ a x˘ @ @ @D@/TgvwJ# Pt]򡇋  @ @ @(n H@7A(@s~esӅ_ @ @ @ Pl bRe_ Pt13ȟ @ @ @ (.e!8;%J P`ݟ5R'@ @ @ @" (.˙L8;$H Ph$jnTA @ @ @ P,o !, @ gX@ @ @ @ P4Eq ؙ* @ +ƾZx @ @ @ P gY A F-d @(͎5}y @ @ @ @@UȔ'`6CI=  @@7JձX{٭Xޚ @ @ @ @c ;Fm!,C6M\L5{x枦{ @n /w6&7n`] @ @ @ vRW,[4wc @A`EiE  @ @ @ @- jRNTٷ &Q@IDAT@tI M-8= @ @ @ @@`qWD@J'`g~%@ ,f , u @ @ @ȳ@9ɍY8 دzǷ6ӓ @ ->.١A @ @ @Z"%&!@@kwv_/9CukFK ZwGg]˘ @ @ @t\-H'(UFOG @@zf3W=L @ @ @ @e (^ gy>gXV>ŀsX\`a$H @b ` nAY44Ӛ髪5X)~w>hFOM5IDk  @ƿ}6y  @ @ @ @@4`J[ )i@ @6)#  @ @ @ @@=Q2-HJc-^r @ $1 r @ @ @H@v-Ch^ @@z'G>TH @ @ @VЀ"h@ 큷* TC. g5'@ @ @ @Ѐla  Z\$2 Gn~s  @ @ @XN@r2 @MIxV, @i[ @ @ @ @@4`7 VXU )XT @?yk\*r$ @ @ @x쇋'@@X3< @33{ @ @ @ @@4`7T8W )i^ @@ 1<\'+C @ @ @ p@k IĒY_O|X }  {c࿍Kޜ%J @ @ @4`=@X݇_{za  @`,6>9憟Y @ @ @ @ 86}V&@˝`  @)-?HGS^  @ @ @ @ +$@ 5˝$JX@RMQr @ @ @ @[onE(ǖ|[`8W󫐯CH@oя @ @ @ @@ , @@' ,wuu!zR  @C] ( DC F @ @ @)FjE$ " @ }("W:eL @ @ @ЀV(i͟\y: ʑ ܁ش_5% @ @ @ @($+5(0 @ 1pO[  @ @ @ @4`w* $Ӷe%@$0ts{M., @ @ @XۙI hn8 @@JrQ=Gt2H @ @ @U@vH@R:ʼ%Mh@x(xSDҌb @ @ @ @5 h^Ih** ^dN @ @ @]'TAY )9} @"0t3M-( @ @ @XՊO& 8B @| .r q @ @ @ ݳ*!@ ҉.B  @ 䋇c"* @ @ @B@* %@@4`7[X| @ }_Ms r'@ @ @ @.ЀG )uO1*!@4A`gM,$ @ @ @OP0 @+5`xgk7e]7 @@W b>G_'Ũtu#@ @ @ @Ѐݙ"+2(\lckOVj @ /]h~}O#r=W# @ @ @:Iݐ HJ'2]  @;:Gb, @ @ @h0 B $ !#eb @ @ @ @@':! 9 @@DR\G | {7 @, TMh7Xb,V @ @ @h6[ GΝ y<#{^'~ hېy @ @ @ |KX8_v=1!@dQ0+6}KKW3 @ @ @A@v-IrK= @ :FB @ @ @'{}~f @aNn@ @@F673yGFW6 @ @ @J@vC$N> @rQ=GR<@o  @ @ @ @:4`T4R )72X @L KG2Y  @ @ @ @ol%O5  @z|7ەyK @ @ @({p @Nnx @@}{cX\y5r\ͽ:O ؝'2"@+cdD2w *'@ @ @ @ +rI{.lzm۶E̜2::[.^yYzٓ/袕zG@ h͑ I꿟J~(&@ @ @ @4`/o#G,0G?z~xjz>u?ą^0 IDd! @szfvqD:5 @ @ @.{ Μ98kƍQ(822؀} ڋVyQOuRYe{n wo}[ Ox #"@== @@M|5.9ʏgd#~yM6z1 @@6?!닭[fA tl: @HQ1go @]?lذ]wsssM˫-6`WrOooЙNuX:h 3\  @-ozb.NTvR"ӓLIi61;<  >Iߞɘ.0C#@@=L8U.R {X=6`W} pV`S}\Kyr5 @Kr",r[v]qL&@ @ @ @Ѐ}BذaC͢CRrj```qjܱiiKb8~x @iHwGDDқHզ7`ONNLm @{6nx|碌g_UBv $I?LMML;Ӳ6t@Oeզ8MU:@ syHFYUًP=ӧ>ԩSN4`/&$M+( @@szQSL#,* @ @ @:_ kأK/tqVicccm۶g]9rd\x $'Ǘ]c#.h4 ckPDa @ @ @ @ Mװ[_|6N?pykvM!@VӀuS.On= @ G?}Y @ @ @ @|>{g~_^?͛7Dž^x ;J*'@t}oS_dE @ @ @MЀFڧ>3o,^/wq/] mx"'@X > S  @ @ @ @j4`V?iO[y7_ٳ'n/| ] m'`g{UO_ )Oܡ @ @ @K@v]LtE//-馛;w믿>>~}UW=g>o}[=btN @ȗ+rP6 @ @ @%PVUzU|[ߊ񘝝7M ?wqG|_ӧO]xƍ{{+&qwWxI@$SJ @(=W~4"דa  @ @ @ @4`c7oG-oyKl߾=bzg=O:'={,P)E2?e @N`cпﺺD @ @ @ 8!5_UO~pcǎ155\rI\veQ=);z.;}mT N @`C? bzۋ< @ @ @` ޜ.(| p>8v! @T`㾷G5fG~!H @ @ @H{94W  N\cx3vam @ @ @h& Iz҉zC R\e.Fv*;SZ  @ @ @ @`)R=#@ {߱r-$Ÿ퉑\37 @#̟F=/{Q$& @ @ @X5әH Jc  gn @:K _<6aF:+9 @ @ @ @U0"! B 噶oQ @ @ @hYDU h^ @ N}/F\QO}- @ @ @ @@4`gyN@[≶oq @ M|56}k" @ @ @4LаH @V{3|L|nf[7 @)0g.z} " @ @ @<\@E @EIiu'`̷(9 @4U`ȟD%#8 @ @ @4^ i|H  @Hg; @:?-Pe @ @ @R ]"@Xg'(; @ Vش_7}-  @ @ @ @@4`7R$-N=@ @E9G_"UF @ @ @.Ѐe!t,  @U19sg+ @ @ @S@:M'@Z5s @++O[ @ @ @ %d#A@- @_F~fY @ @ @({p @`=Iql=%@R|Dl#;ܥ* @ @ @Ѐ=T)pv 7M @ 6a|iE!@ @ @ @4`h4D Y8Ї @rݱ߈rC<'@ @ @ @6 hne ȶl  @L#vDy @ @ @ @@4`28W ){ @gXh~B=$@ @ @ @ Z  @`-'`5:s5xk}qߥAqC2ok˪S @ @ @';}{&cR.+MDn ?F~J|RMoޅGn @P18c7GzB% @ @ @ @ =MM^ɔ.He @R+ Mد~)9X @ @ @~x1h@^vkF"Sa EU) @ @ @(+] @ =\^\AT@ * oD'&.{? &@ @ @ @@4`7QF )Yű?{U!~"  @@6}!* Mا/}& >P: @ @ @=J=9XXkvK p^} @ @ @ @[m1Dc @ 㟊mH,A @ @ @ @> 9E ) @@ x   @ @ @hA[ $#^' @ &H B @ @ @ h>h@y& @?m>> @ @ @ d M { @@C:ކ @ @ @j4`z#@@S @я @ @ @ @& hnXJ _#2&.{Wl}^[r( @ @ @Z%U!@ bcN$~󙽙uT8 @@g {/ ՝ @ @ @ GT#ШY @:ظmvb} @ @ @4E@vSX%@Cݸ"@ #(OgZ% @ @ @ 5 Yq r'`܂ @ 77eׯF8H @ @ @Ѐ8K @xd @vbF~fw> @ @ @2$;CT#nV%@ } M/l@ @ @ @ h^XV 7&e{A @ Dl7P  @ @ @r ]#@I @t@.J11tJ% @ @ @Z@L @@#6 @@|$G(dZ% @ @ @ ЍqWD@8cB" @$Ŗ]/x  @ @ @Ѐ]QX@xxML"@ =SwŖDazG> @ @ @L@vmr,dNvgl @:I _<w$zO}Ғ  @ @ @V(KX@xd]ϝ|T9]>Q<c?W  @4 $31Uqߏ ^J @ @ @@F4`gtM@kbN]xM5x¥gn @M شQ/)"דK @ @ @@ ժT\ ?׸[  @X`gc_\q+[ @ @ @ hHN<1 @@z[w Sf\B @ @ @tNy z|HR_ @^ _<[v8/nE @ @ @Gp^ @5\zS2PM  @Ufbx83smw#r5 @ @ @)Ѐ >+klƁ\\uEs  @ T[1ql  @ @ @ @`N]K'`׵A @Pmy#߅) @ @ @ hNێɗGRD  @t@غW;=U @ @ @ |G@[ @P z .NI @ @ @E@vZvJN _ԀM0 @@ W @ @ @tS !ܑD @O䭱u #?3}ũ @ @ @Ѐ#9R+Pt @4W )OW࡛#*ڢ @ @ @ PЀ /nBT!  @XJ p- د\ib! @ @ @ @aF)H4`? @@k&[vٚdԠ!@ "4#'^/~sD~E+[ @ @ @v hn :|ĭ7_c69]wC @@N|6z'. X @ @ @ 86#@{D @ @aز1t%FxD @ @ @@hT"?yȀ @G>[w @ @ @t '`dI @CrQ[}vNޡYJ @ @ @l  @ @36=pcJD @ @ @@ )R"@ }%-c @:V`b='б9J @ @ @@V4`guM@C ' @{clB @ @ @@hHG#)Io2'@ @z'6n1xG::W @ @ @Ȃ, h@~f ~۝xK&k~:P~ @ J1h9soR @ @ @|B(4 ER+u TcQYw(G]i\{(F @ fr#.~iDwkٺ5] WȨ ˇ4C`+&dX7dX@ LyH`jjꡛ_9 =ʙW  @hOGk?}J3ۻV'@ @ @ȚMm&"<;z;+% @ O(1u;b~UuPN<R ӧO%9 @F IزeKͳyE{X,ƩS m۶ @i虺k űi NK$@ @ @ q;nK$D@ݒ+ @U yf %< @ @ @U h^%xP 7&c' @R#}㷦&o @ @ @ ؝ r @ T-i @<(//=>O @ @ @VЀWXI0g @ @ 5g-;xs$#[ @ @ @!$@+b#A @Y\TbbψC7Gn  @ @ @ЀGG ?;Z0c @ *\e&[yFl8T/Y @ @ @(4{  Э֞=5SC.EO!W  @!/M,N_tc ?a @ @ @ z ةB .Vdzo).H @Vl l͢V!@ @ @ Ё;pSD@ gF;?I @ @xƾyF OJc ^A8 @ @ @/Ht@av @Z#c'bOCDnOjU @ @ @:A Iȁiny?$[7Ԭ{6ߣqC @@K:|s wbz"ޖ`1 @ @ @Ѐjq і$kn9  @8@RMG?yml~y@ @ @ @ :Һs&@Ѷoq @t@~@ ?pcl3~['(' @ @ @ЀnBȜ@}+[ @WgfglQ?ʱ;8 @ @ @Ѐm$$(uRJr!@ @@g nTQ3rQV @ @ @V){` @ ?;Ξ,$qmQV_}ZZ ꧵jkK uߥTaI !ɬ93ސLf&wf=~s3> @lQT~rF,^wVta:-%@ @ @ t.! @ Ф(VIJ_迹IgiZ @ @ @&=x@ip @ @w\Xz׹1n $@ @ @ !%`z^fK @@ y&@`F 3j @L]{5γco?zC5  @ @ @́9@6# } @ ];+~X~Y?a3$@ @ @X bI t ݠ̓ʟ5tA}2 @h7ߋgFвWD+nz @ @ @" Uy )/sR]  @@[cن?5I 91̈bW.׺ @ @ @TVAM`LМ3+ @, cmEX@T @ @ @=O@i螖 @ @J#bn}Y,zQ}km @ @ @M" Ii ő-Q,7D͐ @ L8X,~${ƏFq&` @ @ @s)1,PJ^q=ǯ>뢺)}[5/FNX$N @ @ 0 gU@=󺰮B^.z^  @h BEcDw Z$ @ @ @`72=G44#a& @hEF{b\~fDu` @ @ @M'PlT`wnR"@ @@Kt K0VXGat[K$  @ @ @O@v=3"@IJCtfE @S(>xXrΩ6U @ @ @@& "PS @@2}{c/~7WD37E @ @ @  Pm# @LS{Ǐ"M]G+~3*Eu @ @ @"`򤭓( m8 @ @@ t mH%xG  @ @ @E@Vզl @ 0Cb?m||c]o?Tf؛f @ @ @&n ̆@V @ D?hבkYDcY @ @ @f[س-BƶXE @ @:%e%qн[f֑V @ @ @-/  01|l @hBe(z^mXp   @ @ @% Q!@moh۵Y @\sXzٮ؋( 3δ$@ @ @h @`:o뇽obrCqA @9(mE)KËOo/(vL G @ @ 0B@g}J+=3 ni^'@ @@[ tIܱEg_(`Ϛ @ @ @O@'@`A t< v&@ @(ht?~ež$\1䔈Bub @ @ @BT ;n0# @ @ѻ,;VWe#6w] @ @ @T`W%  P#ЙA @ZU85,ucZ .U=Ud @ @ @4Dh&4̅ @D4@,,vbؽO?n%@ @ @,X [8( Gu[9 @hYbh`3챞'L @ @ 0Zx4@g M?G$@ @*1tw,~Yyz -;=4{v= @ @ @`8f"Lzko?`8_}ooXW @LWsp}t>> 1;n]O @ @h{m- 4kJrrv W] @ @SI0bZdgW$'h @ @ @B@v[oh@g`}J)|AoC׫3 @ pe^Z+IzY<'@ @ @4{$&D T*Ӽ o` @ ?R%1}tk/  @ @ @% {A=n%@`2& @ Be$w\${S`$-~ADA# @ @ x؍7#-*`}pM @-/1totlXJ7 dwSra-> @ @ @K@v{=O!@`Q{5#@ @%P(+Ki=O%/Iv>% ~~;vO @ @ @`FgĦ&SmQC @@cHӢ-BW=|ЋXS`@ @ @V{bKt8+ @h@2;Ғ|R /I%LO @ @ @}b@ @h-zY*G{`ύ(ւ̖ @ @h -LYEfu @ @+PHu[mLT 11c/yaQ($N @ @, 1[$ t#ɪG @@2];x(\ZKI0vX-"%@ @ @E@v< @`:o;pPyQ({9 @ @ vDf);qp,>y" Y.'@ @ @d}! Z%?_hW#Kue. @ @ Fcߊ$X瓒_d'AI`vw @ @ `/n Jv  @ @ F6God)y$.vn @ @ @@+ ng@a @ ^;V%OXϱB{-j @ @ @) J@ΟҬ @h@itKV$)=ʥI0shI@_6\W @ @ @iEi 0=c.i8;ˊu. @ @(mR:b#֎e/J=+*s3 @ @ @s* {N F@3 FF6Ӕ&˚8]q @Be0v8K *Q&v~N(w2?3* @ @ P $гQV @ @-"Prt-K}[zsu픝d=#"+2M @ @ @* *L}k nL @̟@idSv$)=*;1 ^ggr  @ @ @) J@i/nmeY @ Bpt_:M5s3#= @ @ @@n` ̽@V_Ͻ  @ @ FJv~(%;YJbcO(ו @ @ @, %X rl'hj @ @qB%o-K_ E1wb;vu82 @ @ @``ahFidsLL @ @(k珳TmVX>wRvM;WVo; @ @ @ @L] =[5K @ @ۢjأǏev&@ @ @f( {p Кw[sfM @@idSoXǪMGGhoݵ:/C @ @_@ @(ThEB @@itK2)ʼQcy># Nw>>9cDy @ @ @`r,ޭ__D @ @ۢ{ǵYz'eI`v=bO3 @ @X죷p O8@tn-܊  @ @H 5,UV쌽&!{4 >.]V8 @ @ @! {Af/U7[/;TW @ 0űǣkg:n%ɔ$ {w"%5j5g @ @ В[41ٝ6S @ @`J _vbf?51;MXQI`P2 @ @ ywn~ @ @)PDYvd<0IPv=-0{ @ @4zfCloF$@ @hx`$0{}]oi`Xdi;Q쮫 @ @̕칒6&нQ{|o/<|5u. @ @$fw ޙuUc]'efue';hw?9*+j @ @ @ n8 h6ޭ_k)h>◒ l @ @` 8ʥ@d$0{, NXבɮ]uu] @ @ @6@az @ @@&"TsT8kv$({M]EiK @ @&= [@+ҶB @ @ QNv̾?KBg}G'Qٹyט @ @'  P#г5W @ @(PD]YnuDPvkx`vv:4 k=\ @ @ @fݟX]wDu X  @ @T ;:ԽGg(X=iɹk\)-ޣK @ @h n^ @ @h@!Ƣcxc_< >" ȞHY> N;ݳ]{k @ @\@v? #@`z kF @ @cۢ8-:~*Qrdw> >4a$HUH @ @owhA-_}Ԃ1e @ @3(TFc4{48(w8O\g嫓 vއb @ @ܭ@[ %~-fQ @ @fCPCdi_;i;g94`IOH @ @XSF AR{o*m ֭w~3/)ԕ @ @ Ht'YrqqM,_\5jgAܫjO @ @-! %I ?G];{Z[+[JKue. @ @̇@3C;ݴtrqQh'# ޝ/_cIycyDbI @ @v HX٥ @ @%b? 0(%+@9I5Ү#2ttF%QJIn @ @ P s.P.by`·6  @ @'P(nF$]IzR*Q88 NRz΂rWSr?{R @ @$ {JL* Ь[tqNϼ @ @B@GRԮf<_H˓S5 @ @X0̣P'P~0?W}מQBڊ  @ @ؗ@2:Bg=df4^,bOm @ @6zB` t߅Q,/e ^Pb  @ @DP,MuJBw=])$M+Y> ^IyAz @ @KoK޸@#_P @ @ @` $`{S3F8 N$8{#fI yAi4n  @ @ zwG#4\ NOri&`;ݥ;_IG05!@ @ z̆./| vZo4c>nZG`b=E> @ @LCXHȦi],PgkAm۶e^{/<θKbҥ{7{&ՆtmA,(@Ԗ @ @#_GalGDJ#͸,;ۍ; '`,PZ6qN+dxYf<  @ @K@dPk׮xRrJtIQ,n뮻.]׭[x;x\r O@Q@IDAT^e>Ǟ|fh@e4?d @ @@]OvNRl>Vc"p; ȞN|Yݴ7"M> @ @@ >OO~?`W|^7tS=4`zÆ O~2.jsOZC(?K7]7N @ @ @ dgIiH%& N |VVOlW뎟{&}Tsm<) @ @fO@ mw_~]uڵkK/s=7++|gXZe{ړՀ 0(=64#@ @ @.B"FCT83=])N j@x@xR^=˒Im10]#Ɏt34<{u~i?__Z'mcN6vOU&U @ ВOi -,YSc\lY]v2s=֭[+ƫE/to{([3  @ @ @` " hPi:3Z\ij0408x]WQ>=_MxV^fw@x#y$֩K5mjĽxmR/_W~OZ/]G}|H璶w/oS{}j3^7 rsu%?1v:Ou @`bF"@%P͂Z~n<["gk6{ʫkz~8>яNy_)OyʔrR%;9~=g @ @ @fQl]7 "H'R]x]>}ɂɫ&VV>on|_m9GV:o~߼KQ>)Sjɵ>_'=ʒ?5>dn/ߟUunf4hQ]Ccq_jsXo,}M3LS=!@@[ {w 9]Q{ŝm>hc?*cx͖6ipDv=qWӝӪӺZ'QϮjj>iW{'mӲb|TM 7DAzm鹐__vu'IŤ~%)6#[NۥȾsz]-KHjyqd{麓?:5-V'{V畜I'Ŏl9-KR|',TMkƬ{y%kdLyW{~?:g:ijj{YZm=ׯ3Ֆ_բ:S~U$euzNڥ'iY^r}Yw~Vۥ}TI^W˒s6j85e|fzk}{{9n|Z5~߿{~gz{0{;I}:c$1Ӻ}zN˪:οgij|Z/=}M߫{TVui^k|ymMC+Vԕ-Yᘦ@ pj3|=yA᝝~ 1ӹ&b߷RZa?𖺩V|\_ڹx(pNL;Nt @ N[n7kϯ+sA @fC_Z7ۿWue. @ 7n*Ϯ+[Ϛ~1MP_&-fuϱ5Q  @ @ @ @ @gPVAy>2ug=cnݺ}Ţ'(!@ @ @ @ @h3x/[ر#rL%xy`SY[0 @ @ @ @ @m,`<#<2o566[nͯ'lڴ)jժǞ|!@ @ @ @ @ .g$;xի^袋˯;;ˊݯO8'<=BR0[cm,e @ @ @ @ @؝[я~۶m /yI'4it쫮j=>rعsgs=usyӞ}࣮ @@`׮]_n&O~cѢEue. @ ###OQGK.m @[n+Vԕ= O|?mPWq9իׯ8#"T<޻ϱ># @ @ @ @ @K@v{=O!@ @ @ @ @ @`ط  @ @ @ @ @ VqZ  @ @ @ @ @) {6uM @ @ @ @ @@[ ni1 @ @ @ @ @̦7 @ @ @ @ @m%V@\͛7ƍcpp0VZk֬6]e @ n{olݺ5[։'~-nz @#<6l8CBK2w @Z\;~NYzutI3^MqG43_v[ @./| ͯ/N;xiA @fxsΉ]veSXtiN׼ @X |&oF=Mp^gYre-y @̺@+w+m/{˦C??5\mY;RmSN%? B%9Q_U#?ipuɎg<q%^ = @M`ll,[o ;!@ @`~ӟG>xG'A g1i=7  @ (o+㪫ʺL?O~/~1FFF=yO|B=\ @)]w駎O(q 7u]֭w<$ @HS|]sK @"e˖>;vOr3HwN_}WdoIw5yYA  @h9rG. Yf/__c9&{qWgҵ^oo~쀽_" 0ԧ_r6pWWW =_pM7e>N.h'kD @CnmP{VC @?HwN%Kĥ^w\46mڔ9?,UtA @ M?ǩ}=9CCCYO>9>aw@s=7:묺q]L.P 0n _a?l`"v+2nZt&@ @ ?'_ N @ضm[|bիWgdo)M~8, @h@R/<~ +Wf~|O袣#~~/ ?Gt ?]<Ⱥ9N8!^җf'WH8 @ 'bƍT~7~d @;#WHN=zSxS_> @ @>`a\r%100uk֬v7tSww7ytuBI`O&^vSN9%U]4x\.H @*hߪ+K @x/_2~x^|}y @@O??/JG?=-+sGDOOO~;25 @`[.9yNW& f7o>tQGU  @ 0>h_e6f___\x1222s0 @%jժ֖-[ҟ]uWw﫝r @LE`hh(V*3ό]״P(]"msG젝o8{qB.s|S ^reI݆ b*Ad @ @??۷g=wyq!tE @i p {xx8k{eooﵟ[o5jw{z  @ 0S4|ea6nbɒ%񒗼dZwqy^fWQJ`ӦMP'V^_OwIG @l ?O!_گlo @L[`׼&o}.CP(}}_mg @@|%.8N_b4}[S{JL* @`nO%utL_˖-{7k[vޙ  @fY }'?l+VĻYQ @[x;Nկ~5gD___u]qusL\r%1~lFZ @ P7T*2\sM.݅1=EMO  @`S%}U^f  @ 0'###,T_Ԑ~PA @fH_}駟_|q<#qgvb1=xk_  @ в:]tQ>t>;9E9ݽzػv횓 @U~qwfgyf/r&@ @@S g|_΂5r팝l5 @ @@+ l޼9wŎ;e?礛,Z5/s=/%@j_1֭} @h7_җ8x;ѸD @Yԧ>_W^fMqqFGGG}__qM7Ŗ-[ovK; @ Њ>`|aW=qI'U/!i`JɇT_iiO @@ҷ|#ä髹Eooo @.o|.u{]o|kf;^_~q饗X\y啱lٲ,X!(C @Ϗ{,\zիk W]mMڠpں @ |c. o||f! @%022/w>7w_7̙gg}v^tWC=_ @ @?8;`7SW8PRGnݺuYW뻟gM7ߜ_|yr!  @fK }'<#z<ύtx\-v&@ @ Y&ƍcǎXdI^?:ꨣ  @M\._?/2}z @@CN=Ԩ`_}7iڵk  @fS3Έ4MH_}YgU?ҥKk @̅SԺaE/+"9oϋ#!C @&g?w~7ҍA;; @`e4kɯs=}//~_e @ @ @v ^:'磿?[K_Rlٲ%u'y @4 _b>%q EXO @;xի^sEu]_W3w}wwy'pB3 @ @ @~^l''100fo> oxCs1  @IK/cVZ[nG}tJi׮]ʹKG  ַƏ~ضm[ \/y{^tww_*bǎΒ%K_.@*K&@ @ @LY/xAof|k_r-qggysiB cGxzL @7xc>M>:9=8묳dA Ь˗/}022ַ眻//裏k @ @ @=GOOO|_v{G;N]|w;ҿ8 @ Ќ^{m3NTlYZX`O~2^WGGPO?=/I'm @ @ @{H6->ĉ'l~衇?Hn @ @@ oq̭@s; @`&>`_>#:*ҝ @ @ @3?6l[G7m% @vzB @ @ @ @ @ ]J:  @ @ @ @ @ К[5 @ @ @ @ @ { I @ @ @ @ @@k nf @ @ @ @ @̃y@7$ @ @ @ @ @) 5Y @ @ @ @ @ 0ݐ @ @ @ @ @|nfM @ @ @ @ @<tC @ @ @ @ @ К[5 @ @ @ @ @ { I @ @ @ @ @@k nf @ @ @ @ @̃y@7$ @ @ @ @ @) 5Y @ @ @ @ @ 0ݐ @ @ @ @ @|nfM @ @ @ @ @<tC @ @ @ @ @ К9m&wgZUSZisDE4 д BD,H!+HH T/.4R@4,˜g2g+gtxogzo!@ @ @ <䓱iӦgώ]c  @ @2`_l @ @ pk׮+W?ۗ`3gN|'; @ @ @J~6H @ @T`1hР%@ @ @@!`B @ @ 9/'ŋի{o3& kԩS1cƌX`A|wwJ?qF~gaÆEIIrqԷVXƙή]τع @ @@\^{- @ @ P@r#)ZI ǏoFt=V\U|ꫯ͛Riiii̟??nsƗ/_z:=z?\P\*]H' @ @P ExD @ @U $=PڵI?ao抨O`m6Zl+߲eK|W1u8~x#FH߿?\ߺuwɏ'J<-Z s/en @ @(bE|F @ @iѣGǤI 4ţFUlL6-^x8qD\>}IJeKKK#)n֬YsrY&?T'qIIIbݔ}_~U*r0F @ @uj+ @ @ @6l'ONN2%*N&>cE޽Nϟ???#ѥKT_UAI&={ ۅ˻ @ @(@B/h= @ @ p9.\ZvرѰaT_U믿Cj8?f̘xcӦM}jjԫW/:wWO=~x},v{> @ @ )"@ @ @"pXtij!C͛ǡC4y7nzĉBvv!. @ @ -#@ @ @ $7R>}:nM6Fr;u_ijׯ+V7|~m޽;~yyy*.T e` @ @T%* @ @ P4Gj/7tS$Euyڵkw^IQ%KbժUq\uRxeK27˹] ( @ @.싀 @ @ m ۷o_?'Nyn߮—,v  @ @%k>F @ @2(pTV5Jŵ ZjUiQVVO=Tu]1w;uFEEnjNrn' @ @ @n. @ @ @mڴI}T\`ݵ#G9s3I&QZZwygG-[7n\})YR7  @ @ p)`_ U$@ @ @L ]cǎ%%G)bڴi~0 jywSYB] @ @Z@vŭG @ @h߾}j͓'OΝ;]vm۶U79sfjϏf͚ ߟY-i @ @2.P=2 @ @ @{Squ޽{#Gď?kV7ÇS>}:owO#@ @ @P}K @ @:thj &Drvm{/N8Q%KDYYY~NIIIw}Ƨ~zΔlذaj~ŵS @ @(&tB @ @U 6,ׯ߼ysL>=WسgOL2|V^sT_UMb WWݴi+W [ŵ  @ @ Pl D @ @*ڵk˩ѣGٳS}=wJۥq}Qs+v]6P=zTꫯNׯ$ʞBVY @ @ P, $ @ @jxcǎyIaur3رcc͚5Q^^ۿ̝;7zK.ϯѨQ0`@jʤIbܸqqT$ɭ}g߾}uڶm 4ȏ;v,JL0!y ۙu&@ @ @@1 bܝ= @ @ @~xc׮]gDl2ذaCjo7ϛ7/߿bŊ޽{>N۷o=zS͚5;#Wj[zu+ oV駟3fIemI"BViR:  @ @ P m @ @&m۶\vruMOR`܍~a~ze`2g#GVH _|xwСCѺuMM6={5\S'"GU7e'2 @ @(2"ۏ @ @ @:v?SL:5tRnNn۷os*|Gs7h1"oTt!֭?5j7pC3Jrg}n$j/Z(wcIvTw!sK-, @ @ @@ V @ @ @eee|\ƍqѾ}xrQ}#zÆ |w˖-ݻGnݢyxZ[n;vѣGo5 E؞O @ @ @ 3 3s!@ @ @ @ @ @ %YOP~ @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ QiIDAT@ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼ  @ @ @ @ @Ȋ쬜< @ @ @ @ @ȼs.oǞIENDB`bayestestR/man/figures/unnamed-chunk-12-1.png0000644000176200001440000051506614410351152020450 0ustar liggesusersPNG  IHDR `CiCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i `k.@IDATx ey {z@e]h ("(xIbT]cɢ$D\&F2D03}o:}I|-?C @ @ @ @ @ ; @ @ @ @ @% @ @ @ @ @5 (0 @ @ @ @ @( @ @ @ @ @ @@ k2 @ @ @ @ @  @ @ @ @ @ P #@ @ @ @ @ @l @ @ @ @ @(F( @ @ @ @ @ o @ @ @ @ @5 t80 ,^8͛+V+WFWWW}q1'|r7ο3X|oL6-Nmmm/>O21R).첸j󖷼%/ɓko @ @ @ @ @`-= xMozS;.*M/Y$~_ٳ3k}s=4Owygu:*>8S'{bƍ1}{K/= @ @ @ @ @h|Ν;h,_|ĤIK.JQ`z(/DWW׮tPr-Q)'?ꪫxEf͚ cʕo9N8j @ @ @ @ @Zkh{ｷZ|]?+ϕO{̙/6?oWW8kݧ2#믿>^WVykv @ @ @ @ @`׀dȋ[w*7MwyqVϟ?<ڇ #soն @ @ @ @ @ (Uʸx' zxP}]).Jh~̴3<3w?Om @ @ @ @ @jP]T[83OO>f= +pGTlٲ%*_ @ @ @ @ @#pH_yrJy4i#)6mZfxEo̙3cʕC ɼ;si @ @ @ @ @>~QuQqYgn;2Ni8蠃22?nXg @ @ @ @ 8Ǧ⩧+"ק?tP&=oμ؃>xQ cӦM7_җ駟a@ @ @ @ @ Z [뼚6quŞLs9q׭X {zz2~#->2ט>}zO @ @ @ @ z [̚*R_}̜93>?L_={Mo߾eZ5/d  @ @ @ @ @@a`ǞxF/}KqVK/4>j_=:]7jW +kּc_<@ @ @ @ @ @v F#m۶ 2ׇrH\} +9eʔaYf,>cbԩ1 @ @ @ @ @ \@ggg\tE1gΜJQ 7o~}z8K?{ߨ>{ @ @ @ @ @ P@G#P|31o޼*ȉ'W]uUvaվF>mooWZ{WX֭:餓 @ PO򗿜Y}oMoi @ @ @ @@k (ns׿wӣT*;O~CwTO<9~@ @z _Y#T @ @ @ @@ n"o{7f͚UvڴiqWFSJ[dMgqFM駟~x'㮻v=Wն @ @ @ @ @ V6=cƌBx;SN ~{wg]v>*~_FTn-oyKf?_^ttt>  @ @ @ @ @ (UX|yF?a]kSOݧֹ}<]]qE_j>uybWջ @ @mmm< C @ @ @Ŝ9sH7?xի^쮮]͋wOw݃G @ r!cǎg! @ @ @h.uMŋ2߉c=6ꪘ;wn['>{y @ @ @ @ @HR3 hVWn닣>z#א:sҥq1d4 @ @ @ @ @ZO حwf"ޏ@GGǮ[t  @ @ @ @ @ch  @ @ @ @ @ @@A܀]& @ @S m^ѳ]6Gh84#^xd﫢3c4 @ @ P$E:m @ @ @@!R-EtĶg5Yd˱_&,O]m "@ @ @@ (n? @ @K tElz {"6{D缽FY){]کrK~W)& @ @ @9`7繈 @ @H "iw#<3cܳ6bwT[NW?Um} @ @ 99Hi @ @ @@1Җ^,^MMP{Ñxo"M{ϋ؇m&9$a @ @ 0J_Q™F @ @&J Rڈ-LT[XsW7<:OF}^uR| @ @ d @C @ @'"V|'G\a߽  @@i͏#bĎNiqވ_ֈ.8DۤZ'~ @ @ PH؅mmm-P  @ @ȣ@{ @ @hvTzJ}^VH=k= @ @*'@ @ @ /}_ٿ_Dݽ1 @ @ @  ly @ @ @ZH#bS{v{UwCG8J.RJ2 @ @uP]7J  @ @ @҂#v =~%c9X# @ @ PGuĴ @ @L ^Dz]v.  @ @ @` GLf @ @] u( 'Y"=_#m9F @ @ @`  ǀg* @ @J mwFl{jaލUoS_iǺ @ @V@D @ @ @ MFEd3F.#=5 @ @#P=,C  @ @ @@-i-k-Í@zFiu\R @ @ (zh @ @ @1 Fz1c^g:R" @ @ @`p؃%@ @ @#HT.-W_x u?~^R_ @ @EP]_  @ @ @.i5^^,R'?":iZ @ @_ (S @ @u?<긃 @fH +ןoĴvV&?s_ @ @uJ"@ @"6lHtwwg @@¯F|%ldWvhkC @ @8 {mG @ @H +nuv*J$@ @ @I`7 @ @[ -z~?/ d @ @ 05 @F`ʔ)~63SOʹ5 @H+ϵ~"E`#=s~r}3 @ @uP]DK @ @p@ @@Y޿afJiŷ4?ETJ @ @@뵐u @ @ @@#=4Tk#-j! @ @uP]wR  @ @ @@'#=RO+dNi"-V!s4 @ @P=z;3  @ @ @ iHɸ8ig/vVq) @ @cP=fB  @ @ @@RߖrEnsέɿ > @ @E@v-J @ @ @@!R/F_ HIIY @ @^@$@ @ @ g/8;YJo@ϚrE @ @C (K @ @(@z++n+j{HO|8R(f&@ @ @&51D @ @EH4\w y9nK @ @}`C @ @,=O@nf @ @T@,:  @ @ @wc>Q*brC L @ @/ (K @ @ @e"=ሮe<}?7R @ @tdZ @ @RJhѢӦMC=4ӧA4@{y{/0M@]EqO}ag @ @J Mu!@ @VN8![=- @ 3#=yJp[~igF1 @ @*;'+/ @ @I m{:3]X *Hn.h&@ @ @`o{h @ @ @@aR߶HQ.L@zH[d @ @ȕ\d @ @ @`$OE\4)UEh߇ @ @b t;} @ @ tAq]we=S3m  @9#575% @ @ PV @ @@Q:::s)j&@-#>϶Lm"r~Z[v_6QPB!@ @ @`<s3{ @ @ @H}"=q^DwC T+E> @ @S@v1] @ @(@z#v..l@xR_)!@ @ @x w2&@ @ @@aҲ["K"4u\R @ @V9)q @ @ @RH_:5L&XH+gf4 @ @ȿ  @ @ PxT_F , 9EZVEF @ @@S (n @ @C -2bX"=R)ۯE @ @@n`h%F @ @ahke @ @M'D@ @ @ P/Էu2z-i i[I @ @ g sv!@ @ @Ҝ#@R>i`gv. @ @M"IB @ @ P_fwQJ` ~q @ @ 98D) @ @ @@V nN-!HA @ @ tLо%@ @o=駟|Oh@#~(&M @ @V>= @ @@ tuuŹ瞛oT @Hk~ع8/DIW 5; @ @ZTE6 @ @G n 0KgDokC @ @/v @ @ @qHs.0NنOD1 o  @ @h9-wd&@ @ @"V1+}&FkIy_J @ @@:  @ @@9XfM&e PԷ%v~]H`lKgD:ꏢm  @ @hMs!@ @<GT@ZJ |DﺖYHϜ[G[$-S @ @9hqnR#@ @ @ME,Je:XtMˆ/p @ @ Z @ @ BOPB-@zˑv,,j&@ @ +ع:N @ @ @` G_ےH^В  @ @쬇 @ @@iWZ$Za( liwP @ @  [O @ @" ^M[Ի3: @ @  @ @ @V֋[6Ezs @ @ha-|xB'@ @ @@RH>_iCyF @ @ 'pG.a @ @@w[; ^ ͹(R( @ @(OM @ @(@dIJo4{iJ`%3rd @ @E@vQNZ @ @hqRg/*gZ<xQ -2RZ @ @;0 @ @ @ohaӗxGz&&% @ @wz#@ @+\rIf=ӧAL n4 #d4VXu{c>m鿴Bb$@ @ @,π @Q7̊r쌈@wEDߦO4@ g/l%D @ @΀ @ @4@d[9D@Kgm  @ @7Fm# @ @@zohCe҂wc+P @ @EeWӗ; @]=^d=C3m  @vY# @HWV@ @ @ #0G-Q @>8/^<[ك^ tE{y #h{I. @ @4@{$" @ @ PX(HY|J @ @5`湉 @ @Hݫ"-%G`P#A_$@ @ @9`79 @ @Hs?Qڣ#i8 ˔ @ @@ (n. @ @.6*b̼)?ع8b7 @ @&T@ۜ @ @H)Ez=<(@zH=  @ @4f?! @ @ @H"e,W tF @ @ 0 ' @ @ [ z#ͻbw_+R< @ @4&; @ @ @KfDt--l'@)ۭ @ @ P=6'@ @ @@酫` Fx޽ @ @L ķ5 @ @(^JD "my @ @P=$@ @ @@ڹ4bj{ l}"bթI @ @D ((y @ @ @.4^ !]ig^ @ @ 0^ K> @ P;wiu]] @`4ic}0(@ײM7+g @ @hR&KX @ @%Gľ~L[xI ͽ'H/\qm+% @ @pvc}N @ @H=by}DZ}u @ @ 0 n @ @ PH)Ew F*HkF:x @ @(Qǵ,E @ /0yxޗqxk_ik @e5wFl{ #(uEzd7ax @ @P]/I @ @X @CRk^ 0oE:Sv7 @ @$ޠu-K @ @Xq[ĎR1,rqF @ @  a( @ @ &˅0+}D`#m{f$3%@ @ @N i @ @A` =kh y7  @ @hZ @ @H}[#-/ 0:wGE @ @`D @ @@Z|]DL1aҼ/3k @ @-ޢ#@ @ @}Rƈا_cP" @ @ 0#2 @ @F%]19& 0@Zp%@ @ @ i1 @ @[ lXO{wk P/-DZwwV @ @(k @ @@Z4|α-b6C nK @ @uP]GLK @ @ @@V u)~}SS l{2Y_׊ @ @#{ @ @ P/RwCTnN) 1+ @ @! @ @{T^#(@ZB,Y*و5wMh6'@ @ PE8e9 @ @ l߾=3ߛnih&׽X^ -܂]}$@ @ 0 'R @ @ȩ@ZV֜f'-M,9/b8@ @ @h}ح2 @ @ @@ HMA -G`H @ 0a ' @ @ȧ@Z|&'+ c~ĚBb$@ @ В-  @ @@ xկ~5駟ik @ E˷_=Mhj—#hkkk8G @ @`⩉ @V`q6m|#@Hݫ#X?"s= @ @#hx  @ @ @~Ңk"J}'mf' @ @P]Ö* @ @)zE,[Xl&Y#a, @ @5( @ @^ -|u @`܂=n6"@ @(T  @ @ (Գ!bMZ޺V`ۓ= @ @ 0APt @ @ @]#d4"qa  @ @@`谥J @ @FMnn5 K`룑^Y @ @@`' @ @cX:#b`1F _i&@ @ P(؅:n @ @ @3Ғ껨#m~Z @ @@`ХL @ @ ,fD-g!'^ݸŭL @ @@ tR%@ @ @@=@O_"@~i۳ @ @ !,I @ @4@`w"z4`aK (`7Jֺ @ @E(Rr%@ @_Wm?6mZO@J^i@VE/w @ @i @ Pعsgq~#8 @ %kI "-'r$@ @hZ @ @H)odD(+{UQ' @ @ (;  @ @ su?|>IJ@R_r @ @4V@vc}N @ @ :wG*" ,9R"f.g @ @c  @ @SNzڮ<ʹ5 @@+ M=VNATvF,)ℿA @ @`p @ 0IOjw @ҢkZ:~ @ZrCqGۤ_D @ @Î0 @ @R缈u?eA@^z7DN^ @ @qP=n6"@ @ @@k E׶v'@`HO @ @/{6 @ @ @Rꈕ @ o;Eq޲ @ @ (n(  @ @ /Ȃ@ZtMA @ @  @5@IDAT @H}"\xr+Hmz#@ @ Po @ @&\|_.!@ i[s{#@ @캓Z @ @HHdB%@ @ @ #;áA @ @U3#zVg4ȧ@Z|&&+ @ @uP]gP @ @ @ Oi\J.RڡFxG @ @@Y@ @ @ *6G9I@R_%3r @ @W@v}=F @ @:7G) ,fI @ @Y @ @ao|#83} @R缈?o0G@6EnıQG @ @ 7 ss!@ @fOәPnF h_)@cҒ?(<#֘ J @ @[<~ @ @ @@Rφ߫#@ev,X W @ @[@xۏ @ @.ƈROG)>(Z @ @`J @ @H= }("m}'@ @ &@ @F!p衇FTlkk˴5 @@S =wCS(8Gr v۩Ahۅ @ @܀J%V @h JߖZ @KXHݫa @ @ @4  @ @ PTιEM_-#-w6 @ @ (.O @ @^HK di+ۧE @ @ > @ @*sAA@ߦ3}Z @ @ .? @ @ @"AAR  @ @ {'@ @ @okĊ @۟%@ @ P@ @ @:AZ @ @&:Glla oX53ɋ @ @@U@v @;|}a+ @QewL!@қF?L @ @-""q  @@T%Kdb̴5 @x+;[ك/ l&懣 @ @@܀ @ @v 0 0i݆ @ @*{\mF @ @HKoBw޽ @ @r#БL$B @@`ʔ)O}*I'ik @F -El{X z#V|;^/ @ @P(| @h.8 5WP!@ e,\&@Ҳ# ښ+0 @ @@{ְ @ @4@_$a PX#6¦/q @ @| (ʎ @ @ =UK@ EH @ @uP]F @ @ @9o6G @Yzq @ @ ;ع;R  @ @ PT5}y l?b-* @ @1Z @ @!Ho @ @P  @ @EH}["VQM@ t-pOF'. @ @P=*6 @ @ d+9w/00r  'Ul8b!R1&slϑڨ'Ms9mi#1ImbH)",E`p7ݹefggg=8{d~N}Dx: @ @ ډ @ @Z pk@94WZUI @ @` d  @ @,v?1|KTuH]7Y@ @ @0] @ @Hۮ_:&@TiLjV, @ @ `/&: @ @J &vGVJH@ƶG츯'@ @@guZ  @_ M o;h@"f[N d%_.* @ @& m @ 022~z7XH9 )Xw#/&  @ @OvDE @ @X@|"bKkrH]qb @ @U ^5 @ @Gӯq )p' @ @.!( @ @HS{#z7,6  η  @ @Rs @X pqō76E]` @E=ӣ- & '0ƛ>ؾ2 @ @h G @쌏F=E m-y$!@@4hsJC H @ @H" @ @N ,b[P$S`f"vf @ @@K `S0 @ @d/@@i& @ @@3 @ @HcݞjWh# > @ @h8B @ @1=d!@@i72.4 @ @ `gg+2 @ @Z.] @  ZR @ @0= @ @ @iֈGۘQ*d(0=sk &@ @ l\E%@ @ @@ZS@)5r @ @X @ @Hi:&Y =iYg @ @@K `S0 @ @d$0pox_F%@@~i`/3 @ @J `D= @ @h@꺡#@@ff&۔L @ @0zC @ @ @1pw9'@@n;g' @ @X@ro @X\`jj*6oܴ .3<Xa#M-  P&8e*Y @ @50]: @^`я~)^ԧY @^O`Hc}XszjW1 @ @@:jױ  @ @ P"4D/JTR  oF @ @h춓KH @ @ xҭ$@݀  @ @j#`6GQ @ @&G#z6l @`eFu @ @6 t1T @ @'xblݺN;imA,{[ȒH 7D  @ @T\vX{ @ ^FguV{FDEZ %'֪m @ @K\媖 @ @H|G# @ @@ `pF @ @@}R׍m^Z u[< @ @@ `TH @ @@RJ]7լk @W?e @ @ +`G0 @ @j+롈m_)~ @ @,`ȧ6 @ @j)`Ǯi t),5 @ @.Q( @ @ir8NXWܧ"@ @ P@<% @ @ Pc"f@> O @ @@Q `dE @ @@-R׿ղoM @5pS^  @ @0 @ @H#/F =>轵'@ @(b @ @@f 2H]7.w @ @$`;'xi  @ @ P ^f? @ @ P բ @ Pz>. Y @?b5] @@R8םA @ @0]P  @_`bb"ꪦF֯_oIĂ^O u}.FߊtΕh`W?  @ @_q @ @ @ir8SN}:[ @ @+`޲ @ @ @}Ǧ+ p@A @ @(@gQ  @(@шSO=5k4- @ &@!#MDCް$@ @ ~7 @*,p'Ǝ;*ܡ @iՈG[V<TK`z43>QtC @ PJRVh @ @TEtd*2 @ @`e+ @ @Z- @{5{ @ @@ `K @ @@"F_RKz!@@7g_t @ @K0$[ @ @ @fa$@@eRMMc @ @0]R) @ @HcU# @ ^4dIA @ @`q؋x @ @ 1'" @˧ThE @(B  @ @@꺩J5DD @ @؇X @ @ @ k4>ӈOj LF ]tE @ P إ8&E @ @ P)["tZ )}@;"@ @h0aE @ @R2!*-0poݕnQs @ @0]ܳQ @ @H#q;(&#zomcB @ @Z-"@ @ @@sH@:4:  @ @,fY"@ @M_E\veM, @)o׳y] @CODr4NX @ @8x @,O`zz:x>7- @oXWN  @ @8@. @ @J uԪP @@E @ @ . @ @Hc}wԳy] @ +ї# >Utq  @ @@^u @X@ggg|nwݺuMk w#kڼ  Sk/. @ @0}% @Xq7n\M @@ER*ڙ @ﭑr4:ι  @ @"QFI @ @Į[J//-0{{ݣ @ @ %`Pǡ @ @*)sKDdk"@@RME(C  @ @50]& @ @ o\fA`HCuT @ @0]CP @ @HFy E轣 @ @kpZ$@ @ @ ?L kԭV  @ @0 @ @T_;Q(G".B%j @ @ @ @O =1R~L G/u;q @ @r0  @ @A umH=7 @ @TWvuVg @ @(tD+5lհq- @ @Sv;"@ @ @>;Q~uJnO.Q( @ PYؕ=Z @ @ <&@=߉R 4O @ l}E'@ @ @iz4S ;2 01h Q @ @@U `WdE @ݻ7N8ᄦ믿>Z$%@7GL˱  PoBP= @ @ kY O @SSS30.]w @ _#L[ @ @0]٣ @ @y];# pP`j(bǖ+ @ @hr F @ @@z6D3 @@K @ @K[ @ @ c=6/6  Pmj7;E`໑&qR:  @ @J"`$L @(1]bUI-HF = @ f#7F @ @ t,w @ @ @`Y=,k @N D'@ @Z  @ @B |;b @Jv>i|Jv @ @0,. @ @ @`yiو/&  @ c[3!< @ @@ `K @ @@&;V'z:Aw @ @*`Pk @ @D疕Z`HdE| @ @ ak @ @lce\TX$zC @ @ `SxA @ @ Fw @@[=fI @ @0]( @ @Y4{[$@V <𳭊& @ @@ `@ @ @R`;W @v)'@ @6  @ @F |' @@kznRkcF @ PKصlS38#֮]t͂*"0pwHE/0~:$@ @T3 @&o߾x׻aÆ1E%-R.QJ%@ @(" @ @(@qoT ,$@ @ |7s @ @"7Ě @ [JVr  @ @&`h' @ @J!z7NE @!}#Lrђ @ @:N @ @H|lٲiy״ @ ];/#: @@Du^ @ @-0D! @ @A:*.䒃K @@UHUN_@%+$@ @d%БU`q  @ @ PU󝪶/C`໑գW] @ @\vI$@ @ @i7bUnQoh/ @ @+05 @ @ P_ sTD RNA @ n @ @R l_ Pz["M  @ @_ve$@ @ @i{.i&@&4ѷ @ @^= @ @k?@꽥Rh @ @=,  @ @0WC |(W&@ @ pDG$ @ @i#>*%0{[:  @ @@7 @ @  B  p&@ @8# y @ @sr @* XO; @ @@F3 @ @=?ط: zok^[ @ @8@a @ L7t_{n5 (@PUKH=.  @ @+`gs @@`ll,⊦^{& PQKxhJ&@2<ih2n @ @um\ @ @X@z*bKjY?)驝 @ Vm喌 @ @ [Vz  @`w r  @ @@ `L @ @RJdeJ/0H  @ @d/Й}  @ @@}N:njx͚5Mk (cc=%*X *tsXU7 @ @T_:$@ @6 a/>\t *ԻU!@H @]vG @ @(LDE,MM #}> @ @TDvER @ @X`#-*]G @_vg @ @ (z6*% @@fB @ @r . @ @ TDD /HL @ @'`;?{  @ @("&w:u @@ק dL,< @ @K}|'@ @ @ {ka$@^JI @ Х$@ @ @if*Sq Td/0r=?>  @ @0]cS4 @ @ z br0 @@9|B9I @ @< `.' @ @H6 @@zooc2 @ @$`LV @ @2H3}2!8D`+~XbI @ NԖ @ @b ?bj5&SF- @ @TV @ @ccc}O~q7] @b +湨 qsK/1 @ @@1 `\TE @%n}{& S LDo*fq"@|o4T4xa>e%@ @(@G!R @ @-{S*\#G @AvR @ @ P<v; @EJ( @ @(C @ @q75vڦO MG l.^a*"@ƺ"XkQ @ @@! `A @U8gJ; @@}v1>%0) 2 @ Pe*77 @ @,E`nXTH)-7 @ @%`^[ @ @HwrՒ,z|/  @ @,`Χw @ @"v1=BV ~I @ P9k @ @ :׹8DH)rђ @ @xz&@ @ @@.  pd' @ @ k @ @Ev1wѷA .&@ @  @ @0H秀%wGu @ @0]3 @ @KHw-a- @Wc]CO @ @h @ @@mv~/bjom8L ݾE @ Pؕ9J @ @ kn9^ @@ @ @ @ P?431pW1^`+Г# @ @@i `N @ @v|/bjxŷ-S}'@ @3@ @Z(o߾ 60P w{+ˆAu{Go @ @@' @ @u333)`ڂH3w[ Pn푆/,w'@ @X'`M @ @V`S{J[  @Sq @ @ `;t)  @ @O ޑ_r  @:}~T0uB @X@M @N裏??ir94- @ ?43ѿ9d&@5ҞET' @ @,Il"@ @KXfM\wuKl_`CSC+#TR n') @ @:w  @ @ Pw{u /wg5 @ @N.! @ @y4ѷ)r @@UF_4LU @ @"q @ @ z8brwŚ-z}Bg ? @ @-. @ @>rKJ QG1~ @IDAT @ pC@,  @ @@J3}ט @ }/D|u @ @mF- @ @ ~4bbGn%&@  @ @= @ @@2WS#LqB% @ @vn @ @&R3 @@ >i4E @ @9~ @ @}Qw @נ @ @n $ @ @%z e//$nSz%@ @Zk>o~ 7ėLr ӟ4fff.Էl$@ @('TN2 4/qTZ  @ @V `{hnY\E|_?0}), g?Eu @$o߾-{ltvM(h@z*bM٤!@ }Y  @ @UzkΝ;+\WR֭[Wr{ @ ޽{Ol3)8,.o~s'@ @(@껣\*!0ag  @ @bq;  @)f͚׿Too7- @M- 4 >i| Ǟtق @ @:sm뮋iwꩧƕW^sz饗bfff>y / @Y裏??͹  @ 1  @ ѷ1Cn)  @ @!ю$rTK|q{Y.n:~nak/ @ @_! @C9KM @^7l??8~~=~uYgEg$@ @0槀rp8\ː @ @ SٸV:y{}{s_}x裏ƃ>jl߾=֮]x;|_|űnݺ{ @ @@eO۠ @i:sskU! @ @ `/ +LK5ŧ?xͽػwol۶-u]W\qE|c}K]LNNFJ4%=b0 @ @/wqh@}0bU @ @0]sP2b|||{gb/&&&k_Z|ߏ*N>Ŷ.zd<Ӌ'oDOO^ @ @A`n]`&qr/E @ @0ZO /&˚5k77=yO\p1T_~9yx'?3qW_ @ @:iwЯ{Pu: N MF >VL @ px؇nnT)_W㬳j>7}]w?-[K.M- @ @* пMh"> @ @ P>;~w??fza+]vY|_x)暘nfA @ P~A7_ @0;4=ZrB @ On(m{zr憰7o<́v]]]qg.9̺ubdd_~&'g?Z @ @@ݏ-D @39%-[m @ @(JW!h4 m 57(쫯zI\z饱eLE @ ^MR{sF #(y @ P.rZ+8tzn @ @@uRߝiF' P#LT @ @'`![֦^wݴ @ @@+l uyšiZ MEzhq @-> @ @#`;wYsصkWS38imA @V%\kO}SM, @O4 @}JCvk0E!@ @@vA K[n%bpp0>e]۶mkڷnݺ @ @@y| @ oO4GD @ @,]ҭ,I'zLX>gٴ @ @(@q_9W5C`rwG#tq=% @ @O{8sΙ'?I=-+͛w38c~ @ @@Ď @@RuhS @ @Z1ɹZ>\]tۓwwOĞcWW?̿ @8?q_b @!CX @ o:?+ @ @`؋^;>|uͿǗvG?Kqϯ @ @@+:::bSw~r)L!,H3w/%(XOĞ Z @ @#й(sW\qE({{,枎=FFF矏gy&枀}묳Ί???' @ @@v>1]j"CM& @ @{lnꫯ|+3Ĉٯ={Ľ޻hz׻ n|ɋ @ @@R*X Pob tO @@GzBM.¸ӟt={Xvb\'@ @(@JKVr  @/G~'@ @TAfЈ-0cjl۶-FMo>;K/-[4圫kݺuM, @ @V'v=?X]w @v 8;| @ @-la,&07p}袋rCb @ @ ;ۗL& *_[) @ @ \JJ @ @U`V "{) @ @Bv+ @ @ @{ioN @@#VIC @Ev. @ @ ׫s/+X @ @V+`{'@ @ @ڟSF *'#*8 @ @m0fp @ @X@|ľW @ o( @ b+s# @ @o% @VzE @h@g;E @.011\sMS]vY\pM, @`ΕN PGkR: @ @(`{P @ @__5m= `7X @`i៬<;  @@QtDw#xQ*R @ @:6 @ @/з1T@Z$SZ)  @ @ . @ @+HWN(#M. @ @VayI @/f͚X}QG-?; @5i|g^s PZ| @ @*YM @8餓bY7$ @RhJ @ @@<'? @ @H+҉6 @#L.% @ @@ `G @ @@ም @# @ @@ `WpF @ @2;)ʴ P ^ @ @.`'> @ @`@Hi-j @ P%U:M @ @@رiJ`b b  @ @%0]R& @ @ ?bz_m8C oG$@ @T@vQ  @ @,` ʧ78  @ @b . @ @@R'@25iV @ @r . @ @@1=$@ @ZvGq @ @-6@ P+ԿVj @ PVe=9u @ @A:  @O#vpO @ @ .( @ @@ZB  P?P31 @ P:U` @ P`5U}..Ҧk pddHv @@~5! @ @@ `W4B @ LMMƍG>Ҵ @% 7}Ļl#@|,Įhrz @ @@:*ܛ @ @(@eJZ  @jf"7&{  @ @201 @ @@ӯW@TNA @@g5 @GਣiJimAGHdTV`Fybe[ @ @|zj'@ @ . @Li| b2V ZE壭+ @ @@K:ZE @ @JHU!@i<6E @ @50]& @ @Me)U @ ;{#Lf_d @ @ ^1  @ @h@VO`jćW  @ @50]C" @ @/bf4*d)S! @ r+s' @ @-H}[Q8 Pb͑R*qJ'@ @TSv5UW @ @J'f&#v[L2tf&@ @X앹 @ @V ~pGJ-7~ @ @(`' @ @%0`VCS2d/g;{d @ @03BM 􈺝~  @ @ .ޙ @ @@-RZ&  @wEJ1E#@ @XeqL @ @@+쓯wۊPb @z Faz- @ @` v !@ @ P ]GL עUM @V ~"jS @ @0-{  @ @h@ܒ8 @Z =Zs4 @ P؅9  @ @V  @#GR H @ 4Ks @ @ F(0 @1SM^ @ @@ `@ @ @FXN[ @ߔUhq  @ @ `@&@ @ @Z *R`H;kٺ  @ @y '@ @ P#刑רc @R]Y @ @0y[ @ @2RJ+4uꩧI't͂\5NZ-f6_ZV< @ @#xM @#022ׯo曗^TZ ot#@myѶ @ @  @ @"&vE >ޖ\ @ŽG^-Z$ @ @Htj!@ @ Pev7SFcN*g2HͰD\X.) Z (TR[)_R-nDE+&3!?"JXBwYoi3l̻9s>yr {  Pu{ڐ @  O  @ @TI@XmC%Pl$leK @@K= @ȕ?S9wqQ h_ш˙TV+{P}N @ 0*{ @@KKKoBV @@:n.!@.PzD첻Z @ 0@d  @ @ P.Ra P!?g+kY @ @ 'vK @ @@d(Z,CH6<8[ @ @@e`Wժ @ @l;ckw @UbUk @ @L {] @ @O ),)bV"@&vB @ @(E  @ @(*pA*%WlyR[ @ @`1.  @ @(@MwQ @ Nܯ @ @ i1 @ @RONyh @ $~VP @ @`?g @ @2 (+3 @TE2a @ @ @ @ @`@[X{= @@eY۪ @ @ G)\ @ @ PVҲ.g1 @`z'A @ 0+سs3 @ @ $% '@*%P1Jn] @ @a  @ @@?ajŋa @@M=M @ #bd/6 @ @r";')  @Ȇ@OOO{`*) BcEPoC*I 54`gXC @H9GH @ @$%D @K0i) @ @'zv"@ @ I2Qlk\%I2)d$E @ȃ< @ @dI,E$ xFxg.c @ @j-UF @ @,XWNeGG.(ˏ@酗AB$@ @ԟ;3 @ @@bpB#@@ K- @)ɖѴSN3H @ 0s @ @L,l|(bc%@+EUn @ @@(n( @ @*Ta[ @#=L @ @f,{dn @ @ @`2ē6'O/y{$  @ @9P @ @j $ňTk; @ $˧e @ @` gf: @ @ZIu @vZۓ @Ȼ켟 @ @TI ).N!@[,n" @ @ 72 @ @iL30 Pu+  @ @yPӕ @ @j RC@ ),lS  @ @P=q @ @HKc P#5- @ S9=Xi @ @@ E[} @ dfz @ @(F7 @ @)}wD_vN6`ׄݦ @ @@>Z򙖬 @ @@mz{{.Km~9 @@<# K$`.s @ @ -n? @ȵ@___|OxG+Nh ;OݑJr(#-D܅9LNJ @ @ 4Ww; @ @ 'dӣSJr!@(77 @ @(ض"@ @ ;OݑJ+79 @ @(RŽlE @r/-J`T[yH K\ @@:ndps4͙ @ @`ZZZ-oyK;, @@] t".C4 0@)ػ3$ @ @[`o @A`]w뮻 +YHJY> @@.J?^wMR @ @J4WbQk @ @ 39;P @1d1.  @ @P=1 @ @"pH @y(9; @ @*#@ @ COJt @ @ '1@ @ @@I ).A]H6=K @ @",!@ @ O3|&'+ @9ϵ] @ @L*{R @ @Dm!A4@RXYJ @ 0{س7 @ @ (Jho$߯ @ @ %;šA @ @Vd7c֦ @@:#ޝ,G @YZ @ @@NnܔEL$#@ @`= @ @_ʂh4v%@ @f.{f @ @  eI l|(MqM @ m@4  @ @H @@# GXxr&@ @f {X @ @6lMMM}kfPx3@RXZlC @Oyn&@ @ PQW8ȶ@Hf;F @ @j(&@ @ Edf141 @H#oN @ @ԥ<6A @ @@[oèS# @ P+Zml_ @ Gsƿ˿R?T[YPphjީ ق @ P_ DK @yoo3 0@2)'!@C``}Dʈ}^ʒ @ 05 @ @ t1ԛ,Gl@R\L!@ @4;s @ @T@դ4 @@ Z/g @ @C@v B @ @d(ʑ'"4 @ P %K @ @` DuL1 pEOn30 @ 0iL @ @ 8hY @$3m* @ @1`79˒ @ @O  `oHz!N] @ @4 2L @ @ODl|R# 0#$[2f$f2 @ ?c @ @^@aFf @HР'/m @ @`2ؓ'@ @ @Iaie+U @`F+"-& @ @,;ϧ+7 @ @!s;fB42uI @ @&P=> @ @$б<"hJP )  @ @hoj2#@ @{'aoOYH KX @, `YLL @ @ (:  @ @ 6m?>UW]~S}Ȋ@ FߔpAdU`HM{YP\ @ @ 4Wm' @ @ =_Dwg/. @y v @ @ -n? @ @H K3P @, !˧#6 @ @ m/ @ @Y$ˬx @@vɖg @ @Uh>!@ @ !0o޼;R~᩶"l|8bӣY G @@="]P @ P10 @49sNhL@= xu=  @@MhR]39 @ P{ڇ  @ @j!Zk=  @z5  @ @P=kB  @ @?+  @ FtRN @  @ @DmjM  @HޢQ'(z @ @` g+~ @ @u(N dCId#Q @ @j $@ @ PKd?Z`o @:0R@IDAT3; @ @`V gf @ @u(ug: \ @@VM#+'! @ @ knO @ @5H5 @@.>c @ c w] @ @W~O @ #~IS F @ @ ( @ @T `D5 @@N4 @ @ ( @ @Y||b'@YH^  @ PEUĶ @ @Z $TY#?ȏ@#ؘ|dB @Ng @ 繁'tRuQ> B X{w-' GD @T@4 @ @l_|qƫJvJD ol{ @(]IvVF @ @S$@ @ @ 7) @@YW uI @ @.;'$> @ @eH{#:Va%K @uF{LK @ @@`eH @ @ H @.-e'  @ q`ߍueKx @ @`jv-R_z׻( [- @{FC  @ @@# d./ַƲebhhE @ Ps̉_MMMu ȍ@AvnR" @ k'x @ @Lv)-[5\zj,Z(>%oa @ @ _=ʑ`J޾ @ @@ 2U=6gy&>G||+_k׎ @ @P=J @Hmczn%@ @M 3͛?9hmmI @ @ @9QY"@*$uG$+e  @ @LC=wSNڲeK|ߏO?=>w]DEC @ @ CIo1b/3P @\ $725I @ @yYUh--[O=T\~qGO>;2稣ŋǗt @ @ )Plkȴ%MT_[7onG @ @6)Ї7M׿K.$.\8vJ{ /0Xti h @ @hDӖ3 P #I?Zۓ @@& {qWO?K,>;veSF{{{?AqqAq?. @ @4@2%FJY @@-"e&@ @TE [ZZZOk6֬YW]uUUSRKs8㕯|e|_!@ @ (E nnlId@72pB @ @*.P7c%cx~{ @ @"Ou^S @NL @ @ Zf8?;::n'>z_z|{ߋO}S| sUm @ PA-[__vx{'xbOPTqb @ $hzL< @ -޸qc?|;q7DZ>?='`ĥ^{o\}4v5 @.kRs_*Nh P Dv5AL$н2ѴM4 @ PuU=000Ruiכ7oZZZSO .  @ @I ٲ&bݯ)d @yHԾ @ @`{̙x+RSgT[(< @j*P)hj)  @ @xtvvu]7RtrieGb}K.3ф3<3Jk vA @W`޼yQzj% Zmo_ @ E @ @ w)>s믏i_;8cѢEΟn‚ #x`tj ۇ @ @@ t10 ?[9``eD @Df o)ϟoy[WUTHwǦ @ @ATCȄ@#>PA @(@f 'KTl]*._T]Oۏ=ҥboأ. @ @D Ib[D+L @ d#ѴOU @ @@c d??w^)`?E| @ @.ވ5e_ւ @(=[ @Ȧ@f we8sFv}'Gsss͛ox @ @TB ) 8 @2$ `7vQ"  @ @`)~衇b  @ @UI @@Iw4g  @ @`V{4aV:IXjUƿNa @ @)lY ^ @@~MOf @ @@C d/}itA#_v/zыCO?=.*"@ @ b[fB @`@  @ @d%իWG_lan|kR} @ @] ){ '@*~S$CԜ5Wiy @ @U+ RK?S @ @zH7GtViȫE @4@ xxGSǺ; @ @^㖈-u @ $Eoʌ @4@UuUWEgg町===~{|sm"IBݺpq}: @ @Գz>= @( `IV @ @@R]*G>ݖ˗/W?{wuQ^z @ @`T`ӦMq1njKgNi @\{r-g @@e6?Ƈi*U  @ @Uh^~cj=N;4 @ @`6CCC㏧6l0%K*0 @,C @ȁ@U _rя~4Vۗ @ @@ELq( P~V$@ @j!RM__^{[Y&F^:x^ozӛ8 @ @(_"&@SuE{5f&@ @r#PؕW^95{]]]#CЇD @ @L qb<#Sm K y&bZ: @ Eq @ @ TX @^`ܹ/~8gY @ $hR  @hLL[ @ @_TC+ UȂ%@ @l+'`w}144ڱ{m @ @H7Gt6% @Gtϫ X! @ @&LA4qz  @ @/qKP~= @ Ѥ;$< @ @`* @ @ M4 0@m  @ @P @ @IDC͏GzT @ @ Z&-c>x衇R+~c=6wgS}hVbYk @ @_E @(cʽ @ @Uxʕ+{I%~0.5/_]]]u @ @ H2"@M )FaK @h@ @ @@ , @ZH8T?ظq~ @ @(i$@ԯ@2VϩDN @4@ ipg @ @FH  @< tP45B @4@ P @ @`T Im.vme]R}d`SD;r{ @Xug>^l""@ @L!<Ř! @ @`7n=y|;3\tL"qKP$  @'wf"&@ @"`S@ @ @N(A ~b5 @ `oٲ%# @ @ P>$I"(J @@66!e#Q @ @S Sy{l̟??vuNe˖MyA @ @u##&\ @[кSM$@ @dA% AlK_R,Y$JSF׽.V\_fM|5믿>s  @ P ? ZO5 #¤as PIqi4u  @ @#G/:;;G";wn Esu_tE㊯=[o5^WcvX @U%;Ｒi1=ҟ @ wGM;E @M`|Us 3s-.≮oWqu<qN4 @ @@#66q  cC7ح"@ @@ 3؛7o=1000K  @ @u!uqL$@v\ )xǎ빓 @@K7l/~Q(R/yKϏ#<2-իS}'tR뮻_>=Xt/| ׿~ @ @@=(HS# 0+#ꏦf  @ @LToy[ꫯ-;x׎m\_y啩{\wuq衇FGGȜ˗ƍcA @ @ ۳ @0;X5D @@s֝ѲqsƷTAاZ_W13vK.nm @ @@:VD e>L @f+f  @ @UD]wI&|ܹsGc/Xzخ8SN8al3|T[ @ @@"etFUZ,F @@& b*;.hm/z)Ek֬I5 @ @dU I"< 2#. @=OD^z @ @ d#!jml[^{ŋNI]~6l0 @ @@v2= Pnrh= @ @@2Q$I*T{kcrʭ͑'|r47OO? @ @*ǿ . Pr8Z @˕7 ^T{͚5Ɗ+bSO=u?zvj @ @Z ( ؟ڻ##@ @H ?Ig?)q 7mƢERm  @ @YHz,&& @@ߜ[l&@ @^eK~m/pP믿>,N$wEwwh_O6xӛsI'~; @(@OOOy晩oX | @ )~s$C}  @ @DvpJ.N8aI؇zh,Y$5N;[T_o?5}, @ @ Ed`cDϳ @]c @ @ }eNc=6ѵW\>\rIﾩ뮻.>TF5y֦ @ @+б"S{>"#@*.[iV| @ @vD 3Onjj(=zq'M;:^W_=N @ @YH Y I< @ ` @ @*'`.\zk{q 7Lh79o.2n/~׿?cqc: @ @@ϟ?pj @`{d(}N7 O'#h|'+ @ @2U],jժF6m~x}җtRv-:( q'?bΜ9c @S9^sIk hkhK/Pz+.z @ @ d{!־o~3^Ǟ{=!@ @ )8\hC ߋ @ @ s-Qғ} @ @ԭ@I> @oIz;i>4 @ @hT4!@ @ Ul` @ $v&@ @dB@v&A @ @m @$Eo @Ȉ0 @ @(0g @H$@ @VOM⡇g}6zzz/iѷ0L @ @ΟWc; @,0~G,G)6 @ @2YƗذa<"@ @(#/zV"@D&99Mi @ @|dwqCW @ @STXC 0@a`@ @ @6͵v];<%@ @ȱ@ Er @T$n%@ @W 3mmmY @ @@=;"# @6Rw @ @ L[Ov?~\ve''q衇7O @ @zH   @H ` @ @`{2Q+WL{ 7/{R @ @ 7+^TR @XHzۣit @ @-;#Fsonn)>CF\ @ @zmTzz8=1@v%@ԍ@Ql8u@  @ @ 4g!իW(=ZuD @ @ ~ד PfMe @ (JI' @ @*Z󚚼 @X`oy״ @ @`Zv߲ @3(iZ @ @D… OM-G. @ @M I#o[Z!@TV`3Me: @ @`L`b?8jwwwh @ @ tߕ$D`W @ @).=ooF7w @ @$yIE @ =6#@ @&Lv)7#a&I裏믿>֬Y> @ @(*9J_E[v$@ @@KV$ /0o G-ʞ;wn,Z(9䐘?ds @ @r $H @ mxy˘ @Ȅ@f :7y䑑)'$@ @ ebk @ SM 3N$@ @yhkb"@ @ U;g#. @N:ndpK+L @ @ o v!@ @ȴ@ҿ6{ec @ C=f>L @ @hJZrJlذ!+ሃ @ @@eo5Vfm @HV@K @Ȋ@f 暬 @ @@JB> @e(aK @ @f.<[A @ @$CwV @l+l$~m6 @ @yv3 @@OOOy晩.8R}4@X۠K P~E8 [ @ 0)p  @ @ 7ߜsI5h\ڸ˜ P W/JlM @ @͓ @ @ @Oh!@("ٲ Z @ 0@]<{hh(;G׾th\sMzꩱ{ @ @ Pkdu'@O/󗗌 @ @ d'o~v 7nܘ====.8#R @ @---qi8Sm T z&@*, eIv-O @d@|/<;usdW׿>R}yMyA @ P.]w5.]ZC@JA> @54g^$ @ @`@ 3ό+WvUVf ?(yE4 @ @TK E @z#:nXxFc-[ @ @f5y{{{ oxÔ;wO׶إ$I/j  @ @@Ut  @Y )xQ#  @ @@2U]zJwܑ2y⩧|3SN9%oŋ^#ן'g\ @ @H  @(.y0Sc#Ȟ @@f ׾T'|r/}KqYgA߶x;K/45f͚W @ @ Pid?cy> @ dO @TM 3؟ԧbhװ/G?qWDc?_~y rM @ @]o|P=N : @ P-L`Eksa]`A?w}V]g'xb @ @@UZ @(.EA @@& W\6<7qG%.:?xA @ @=9Xti'LJ>93?V.袞L7 @ @ 4=Ѿz0 @ID @ @`)>]zW*[o5ƏK,I]㠃;#5dIi @ @(@0Z @~)q @ @@{?|3~1 Mx“ կDn3 @ @%GB'O+W$\.W(>KElI`ĉ1}԰sرcS} @ @@m $+fGq @U$;ȍ"* @ P-uY o}k#8bCu]cʔ)z)-@ @ S)=i @@?Q @ @`` d;;o\sM3whO|3)& @ @@8S#@("i]VE @(gaq%_wuW<1cƌ{q|y晱nm4F @ @r $oD,[X @I{Ģ{~3#@ @H 룯38Y߷jժXti477cĈ @ @ Я6'@H $ S#;E @l@UV-㎑8 @ @dI ipB 줣-ruUkQ @Ȩ@]F @ @HD,yb, @ږG,}Ӕ  @ PYؕ @ @@ ,~0V @jU  @ @l d][ ,^YdIAo1":6lX6UEE @ 0).g  @B紃PI @T@& <@q}/E\.p@L0!&NbȐ![g @ @R $I8Z @k^dRf  @ @@k… +믿>ZZZzu;_R'?v)≮KbZ @ @*OF4n& @Q e4 @Xu5k_b>~żbŊC/| o; @ @TB iZmA GA @(@şvZ<%J!Lkkk|߈;3nONh @ @@:::K7) @  PsKgFҲ$rv$D @T^͋O>y_DwM{{ȑ# =#/-[V,Y$zx׺NMq1=&LH] @ @XzuL]ϿiҤI] PCڿFSCI PID=ϭD @TXb_@p /wG\pAuY1bĈnloČ3⦛n*Z'I8r,]4ǬYb]8%@ @ P"/e @eHFNvY-N @@]mgώ3g'?_5jT|)SĜ9s6Jg…|~ @ @J!/q @T#i_W  @Ⱥ@E |7A@IDATwřgYxѵvx_ϠARӧN/bO @ @ $+"<˘O P MWb'{ @ @5.P_nHm},T_)]tQ ><;rI]sB @!ǴiRK?> @PBR!@Զ@05rTIʎ @(@89).1rhjj*n{s=;S'guV(./ʞ?~ PN'S[̝;7Ǝ @ @_㙏E,d@qu'>WIJ @(@]7x衇RO.gu~/~/cٲevB @ @`k=bѽ[ @h?UzW @ @5&P ]r~G!Z^J5 @ @YK6!@ @}d3 j?Q @@){je-_ @ @`+*^=cƌ @ @I iRMን @I[Nr {e @ x6v @ PCe˖R2dHA@ 4*;'l @!֥vǹJ @l  @ @Æ +#@#V0O P=ވ7YխI @Ԡ@] $% @ @|- @vo;ݻ+3 @ Pz?oGnE @ @PS!h @K`}tFn @ @@ {U!T @ @imUDN- @h[䑈NdC @E,Z @ @@,?V @&) @ P"@ @ P @Ԯ@Mf @ @@I`b @ @$$j)% @lJy^$+  @ @EE ' @ @6XDDk @5+0fS @ P:إ @ @@ $ pjJ yQ\%@ @ } @ @ؔM'@Ԧ#i~6s @ P2% @ @@- $^XR-$ @4N(c @ @,{| @ @lF7 @f?콕 @(@} @ S~wq> /4N~"$@(GҶ:r;~m+ @ @5!&n$ @ @ +q 7™0a씈 $G,@EH PzG|_׶" @ Pu5$ @ @R`=%\Z @U$4LhJ @TZ@vG @ yarc  @@$i/&@ @Y; @Ț@]]]xjk mf;H @W)b;X @JUyM @Yajx"@'K~Ѿ'#!@aaJ` @@]ߧI @ @6 @B @ @@ wK @ 0$h:32 @F_d u @ @d?y,_!@ @ 3 @@%[C4 @ @ #)?#Gs9'M! @ @@H [-O @@=g @ 02Sgonn[o5N9;vl\ze` @ @@ @X:3u @ @~TvWUW]tPs10-[us @ @%HּrNֳ @@-$D@ @P 3o&z'ⓟd5*:묘:ujor  @ @z-׽63 0 K) @ @L??bĉQW}X_"N=3fL|_9s<77X @ @F%@ pF<O @tҹ 矀}ƴib޼y=9Moƌ?>&Lcҥ @ @M $"fl~ @,о&A @X//|!?O?gc=:$u>k֬袋bԨQ8L1 @ @6)8-:k. @ lq= @ dv?ַzL<9F~q=DGGG% @ @^:򖷤>~{IֶeXpD2-nY @Z֔Z @ @[/}֯[ƍ_җC,X 'Ő!C6%~{WZ@ @ @?={vL}4@T6 @jhR @(@}2{G}ٱ;ǠA׿&__~yGK/}g] wi+z>q+FZ*z衘7o^{pq ';J @Դ@ԚNOr @%X|$_~X"Q @ @ŋ]wwqGL>=֮]*7}kqG]]?z??я"ķ|!|ȿ'?IXoy~l6ݎI @ Ld f&@@䈽?yf @ @5%P'gqG{{fo̮{nI9'`w=E۟g[n%r\{ /Buo|e]I˒ ڥ3#@ @jP tYk֬Y']vmظp>By#G|0N;?{1| Xpaj;wygT~:>鿿k&둏/Ǿ[ldĉ?ܹscر] @ @,k$Q؞ @r0rϩK @PktW^y%?4 &ozذaO|"xxgK.bu>N8!nT˖-/էʕ+㪫~_o<='?Fw6*_{ߋ]vS~߮+ @ 0:_ @ [[TzKf< @9,edɒ/Yxc=~wigqF_ܗ}o(NWN6xGF#E]_+_|1OE_s9ۯon5_|zH;{O~2vqǍ @ @™seJ(#i_mtY @ @#'`uY1jԨ cKO"|1gtA/vt/pM7ť^*u] sLqR G)]O.Ї>TxRu9~ť <9 E{&ǔ³>[\v+od}-^{mK]'@ @jX@L \ @*!85$r)؃ @@& nj~7_4[#__DweroYtAq)Ą *ҥKȑ#[:c=C-[Ë}N @ @!tD䟀 @ Wu ˟~t_W0 @b`ovqYgvQWWW1>Wlj(4:VZں7ػ{jEzU}뭷ƼyRkt+Vn> @ @?<Ѷ?#7 @@ ߪS]wR  @ @)~cw}f (իW2dHjڵkS-5a;s`  @ PQ| @V <[ @ @c`S$Ibܹ1uԸkYذ{=yРAͩ @ 0@ DI PVUGnaq @ @ )>Ccхwi^{ũgdk[ +onG @ PK#RJr!@OoWO}{ @ @~L bϊ+J2tZ_Smr;::R5OCzwm:'@ @@֮]]?%[Bl@@f&@H 2šA @@W\2u3͛~xOz  %\cñ;ot|,[l ;.xgBņ2 @@ߡ;S*n!&M @`m  @5*HZDn.5 @ @jg^z)ARmؚu֥mQGW_We @ @@? $k^Xl?n[ @|[kԈfz"@ @HvI_K,6W3?~ꪫ7{5I644/~ 7|2pkmnk @ @@ 4L$@ 5-+9Y-!@ @eHv(K/q"w_?>ve?~|^sϨΧ tB6lXOG @Ԁ@pw d! @ ,z fHB @ P`O4)nƘ9sfy᪟ԧbmhò(0hРa.\0`;6~5 @=n?Aj??T^ iiXolG @|#8s! @ PHvc„ 'W+_J\ve~e7n\s)=N @ PJ~("@Ec K5 @l$4L\t @ @ZHv﨣|3qmukq$kCwܱq[{l9C⤓N|[zmoGymfbo.CƏ_(h.h2~{zit| @m}]Ģk;I @@∥3#v>; @ P]fD ͍1bDo/`Ϟ=g;Ｓ' @ @`,}D4  @K[WK޾ @ @ +onn“Ou3]^xa׭['=k---s9gq: @ @PSVf @L 4NT8!@ @'[+OaÆxS`̘1<s\ַЗ/~ O^/97oJ @Ը@m[0Ƴ @@&Vɪ#G @ @@2S=zei8묳bԨQqWڵk ?|?ftI]G @ԪY- @&lY+!@ @%+$PAwqa v磏>:n8쳻 @]MNf @H3s7E@ @ @ װvAW_-<5ƌSMnĉ1}Ԟs΍cǦ4 @ @ t{#h\ݶ @ @@ 6&@ @ P-kK,ʖ$@ CMpa @ @@ (;&^ @ @ ,?ec\%@ Pfoe)3  @ @@? ޶&@ @5';SO=kرH.V'@ ѓ @ @U&np  @ @ uuuqGd;Ha-qZ g(5 @hg"7 Y @ @@z6( @ @U hD۲*T @AY]# @ D?ꫯ^{-3?2@ @ @J+V#@JwEo[ @ @@^&f͚`gV @ Pzɥ_ӊ @*Hּu @ @ e0&! @ @@g @ ,[ @ʛۑ @ @ –2Z @`k[kh> @Ț@}:X @ @` (l'@dS`㑬[f3>Q @ @({O~^e @ @$k^X\oK @BID㔈1Wh? @ @+'@ @ Pv^^vc @Y i& @ @P{"" @ @^ $ {If8 @@%?IJh/ @ @ ˈki @ @ $G,}ف @@_:E,#@ @2&;c7D8 @ @h9!$  @TV Y- @(@}2 @x---o}+{x[ޒ @tI-f% @h'mK @*%P_|ϧ+Oy晱bŊT_9SN-Dz$@ @uť^u]`D4N i[*J @KmYDӌ]YK @TH؏=X̚5+%\jw_455mԯ @ @&ѱn] @ %)-  @@]fD @ @ »3 @ParF @dY@v @ @* ]?uu]7RЙH:"|$@ Ph~=N @ @/w'pB3&j~zZj~ @ @֭JzfD-EN 0 #7  @ @@ꫯ-ңq @ @ $ w @ P} ;ߪ/n @ @E@.R8!@ @*U`  @V=W` @ @U,o  @ @U YTD  @]\ @ } @ @@5 $ wWcb&@ Po @ P  @ 00<1p`wY @jE`H5J6 @ @N2nkk^{-^xW^m6FQzq\# @ @@/Ez3M!@ $aJ؏f% q @ @tvSSS\s5quի{n&M /0Fݣ9 @ @T»(X @^ |KNv8z  @ @@_j7._sYhQ\y啅5۳ @ @(4(#i @YXP$m+X @ @ d^}7.XbExX[[[awdɒ!@ @:yaIJU  @l$xF: @ @ d{ڵ~0/^I\.{Go-|vmM_1cFzꩽzft @ @v&@ Pbow)1 @ @@2U}ƟR?co_~9E .Yf>f͚xg?Y?~3gΌ .`~ @ @%,- @ ,7 @ @@U d[no938#{vB @J-sgZ.N:)էA@uq}ڇ @Ȯ@-/1wHd @ @`cL`3]y睽...y2rȸ;xG?x≘;wno. @Zoڮ~] @0A @Drȵe5G,! @ PjL+JuF [{䟀=iҤ2<@A @ }}]ĢT @z+tfogO @@& ϟ"xߞjoMOMSm  @ @*XG P! @@m/W3 @@}m׬YFّGjoMcbKnr @ @ l69rs\$@`I[d @j{  @ @DQR/btA6:::RSw}T[ @R`~KZH @@ y5/r;RIJ @Ԏ@]R?~|*3f[Ә3gNjqRm  @ @ 4!)A  @V 4ܵ N @TJ &Lѷ~{\$7xcq!C{b  @ @@(ٿI"$@jdF @@& ~/K/yIr2yo~SzN;Tl;!@ @wWAB$@ +_$k^EL'@ @*! /0;bο3L]כiӦ9icǎk7KK @ g"s'@ P!Om @ @ d;wGyd1뮻.gw---͝|sS]#@ @Șװg @I]e] @ @@iK̦W/ҦlpewN+"^{ƍ7ͅ[/^8E_?hР kg}v @ @@d @Kdݢ ޭK[ @(@.}z*sرcS} @ @/EߖѮ @ !ddA @jTF @ @@ ,3? @^ $k3 @ @@`WZ~ @ @=Px#& @jM`#i]QkYɇ @Ԕ@}yÇ/6'@ @!ej(# @@ވ=?  @ @({u]WG @ P = @@) @ @u @ @z+,]oO @v:|dB @jL@vP @ @@ Z*F?ߠN֥MTY%@ PB/႖"@ @J)P_ŬE @@$pڵkSm  05:A. @mqjm'); @ P]7N @ @ZHVS @ 4L&H @ PAS /e]VAZ[ @ @V i˿jN3 @@ 6E4ͨdD @j@>9444ļybժUmmm݆sQ+ }c֬Y_~yk$@ @4hP| _H-ualF`}͛ @#;Lnw eJ @D sO\s5vT%G$@ @ <8 @I84 @5(pw$_\ @^L`/Z(N>x駫WT @ @}H:Z"iI @jRyA?F kM') @ PuY |0F+Vxbԩ1}hoo/[n].<]8  @ @@#arb  @L~)EnAG @ @@D.<bڵ1lذhmm-},~6lS{c̘1_q?x|#^zp)O?ƍp6 L8G];wn;ks @ @@X$ҥ) @r}%r}q}W @ @y髮*U|8zӰǜ"vw13g,\/_<>w7T @5@IDAT @@@B @ Mߋf3ZQ @ @DyRbw9շqqǭ?x1"~_E}}}aG-uB @ ! J2t7B 5#Y37kQ @ XL`/[,u9Tk,6W\jQG{W^ye  @ @@6D4@? @@5&C7C( @ 02Y=nܸMޗ8 uOSacҤIŮ?֬YSl;!@ @d @d\ i]# @8(2dHJ|vK6͘={vac-v[.yb  @ @@ޕ @ @ KgF!A  @ L`.)E]Ol6Ů-`><Zϝ @ @@լ~; @H"bU)A @ @@ d{ $IsM}VZL#0zR$@(@IZ @l@& ;T?pac}-v+rb{Óx7k׮-;!@ @[^mVmGfwL.!@ PvG"ii*66 @ @6/qƥj}-7AT{oɜ9s"?f% @ @5s#V@D@ @Z)8  @ @@ d;{I'O ;bž'G}tf\s5nݺT?-|g}Rm  @ @~~- @@5 $ N @jB 3؟g#Qg̘GuT؟?y{C-=<;oG$qWǯ~] S @ @~H~o{ۘ @@ ,~ UU  @ @@-: $x|lm]䟊6CKf?1bD|Ʌ>hN]?~|̞=;2SwO6&NӧOO%3w;vlO @hkk.]TzG^{U ˊ@u ܿ>fb @ 䎸9r>PH @2U|̙3'u{ƍJo޼y{G==NrJOGO f @ 0dDX%@ P"gDݑh1 @ @ԣwy6mZL0!>jcƌn)7]GZuw2 @ @H_H @I{s' t @ P*S=:BqZ?麻#H}ݱ;twя~4~_N @ @O iihz3 @jh_jB @ @j2Wrqٳ_ /p'|rzh{qG.H @PIڈETΒ%@ PVEKe @ @@Z MMMq5u]WNGn&M /0FQ?{W] l6 e X"SUbZ/X--勤Vg:NN[qu|˨zG咐 A$ KPp 1&nv-˞d\9y&w}?Xs @ @.G  @Y2o @ @ m9)⪫ 5\3j-۷o#s1X @ @-'Pm !@ @[GJA#@ @&uK^g?GFb^ܹH @ P_4.": @V89kM+Vf @ 4<½cǎqJvZq#'6l0#MXzu;3?#< @@/Y$뢋.řsZN`S-` @m2Ip+ @ 0\5`_y裏Vk^ԧ>~E/ٳgg6nW׬YE>_~y,\0sހ @Z3{Lo|3"(Pm!@ @N[G: @8T;߉oۙO[jUw}#>:cqec=7xc}ٙX-+Vd @ @_ !+ @hUV^ @ @ik3ſe/G񖷼%smmm/瞑e3ءc @ @FI]X @ZV[gZvN @ME~6ZI'zkT/|a,[lxbÆ I @  @ @-2 @ @$Gy$Se]'`OsEW\ swf @ @s̉M6ejX %Rz[r, @B {"Ҿ_2uI @ @ {׾tox2ӫ!@ @T*(=굜/S @ )eE5 @ @@rр \Ogph3ݻ\ @ @I$ r+ @ M @&*O?=O>Og044~ie @ @uЀ]G\  @"X9! @ Pk\4`{V^Ogg/X 36 @ @@pāM .* @ G8K @j(/86F/Y$[2o9cK/; @ @ןVd @GH @ @@rр]FKZn]|蹩~xѩ]vYx≣c @ @uز&@ @`\5z7{I @ @6i+hU˗/O|;zn2+V|14442m/|a2!K @ 0EhLqi @LK``Od @ iT*lٲ FS[_W~ӟ?x;#~#Ν{ @ @H mYVH @ 0Y{d'@ @hSӟt[n3O>̽# ՟Ϗ:+,XgyӭwkfϚ5+>O^{ߟn@ @ P-TH @&$H:rM @ @*i3)/zhrxw˭cBEo}kZ* bs @ @i}uYS @BTBTH!r$ @(@[/ @ @@R|'(; @- f% @ @@4`7 ޲ @ @ h(* @@Է@ K @Gީ^r%1wz/#> @ȅ@___?C&Q؇@+}طJU# @ E˜)= @ P<7`_.  @ @29 R l) @@R粨h.Җɕ @ "Vh?{'6lvݻw 'zN;/wǂ r-) @(9sbƍ/THK9 @MqW2yMM @ @LmN)ҥKkzh\jO?O}*.?W^yee @ @^  @ GM @ ;yΝq饗SڵkW=i>餓 @ @Rƈ5 b6 @H# E" @ @UG>Xvaoy[ꫯ.(Oy```l`gqǒ%KƜuH @ Pe5 # @H^р]?`  @ @R?7|s&s9'VZ5}_}jc_~{^zxlK}7c @ @-k( @ H뻆 @ @ErӀ}5dO9XbET~=k_ڑ ,L׿ @ @LO nM @@#X @@.<80wR믿>̩͛I9wXhQ̞={tnu5:v@ @ 0MO& @'5 @[  ۷oT|goO //|tc͚5c @ @1=?  @4T`" <{نm1 @ P"\4`?SWՙt\rIf 2c @ @ d @hP_Ķ;  @ @@rрm۶ dKt4%@ @r똁C @ :!M9 @ @\ ;A:3 =p @ @  @P`H=L\ @ @ ?h~+^yG2 ֬Y~ꩧf @ @׽umV%" Է5b"I @ 0 WLb[  @ @C=ь =P\q5Iy ^ @ @Z }ݗ up t.(V @eͦrJ%йlRy( @@o'\ @ @f|g|Ϩ}#MgJ%smm=XX~}x≙j-ַ5VZ aÆ>݇ @A`?2 @+vlT޲>*Ƿ  @ @rՀO+_?s=7.8묳FmmmQml}ꩧFk֬ͭ}{߸ל$PK ص @&Fϗӟ7" @(@巿)؅- @ @@Li_oosw*|3g @ @Peg4_bL @s"n  @ @mMo&ŬY2̙3kj @ @8LڠC @@I4SbA @'jw]Sx?OĔcH @ @gO8"@ @CW @ @&7a -yyҥKGEŝwk֬q緵ū^x_^x9I @ 0E[')N6 @< TrS9O򘚜 @ @@nrۀ\oo߾舝;w|y{3όN8i$@ @@\R @ tm+# D" @ P4`wwwǞ={bG3gN/=u @ @#F쾿>E%@ @yCWDx v @ P8d/}):x]w]%5y @ @t:l8 @ PBԹU) @O  ؽQmN)ŝwMozS @ @`Rsɤw3 @ض2ҀdhǤJ @ME>۷oP_Ufl@ @ t`KU  @Po_  @ @$h^vaox; @ @@,^45aaK @ (ԱQKY @^  ]]]A/< @ @HK  @hU5vM @ @ s='< @ @ {3fd7Q _G @%:%)F @ @h~/~3~+_Ɍ  @ @@Qb7TIpes @R xM)UQ @ P\4`… y{h_}|}j @ @0 n9 @H{  @ @@!rр] ;ok_ZU뮻.֬Y]]] @ @W n`} @ El=?Ȅ @T=/y=100___cҥ#7ãiz񒗼$<̘1c|ߝ#@ @={v| _̻K2c?S|%J @oq @ @eO |v{*9)uZyo}[cժU6lϜ3 @ @yZ @@۬QyR-E @J%VjC @ PH B @`C[o/X%@ @ЀXo @ @!0q @ZS y57^ @ 0a Y_EwwwW @ @`"sDns @e̹eNM @ @`i^| @ @`iS]?~  @(@r[^eM @,V @ @MƋc%@ Ps炚 H @Ѐ]T  @ @&sqMB @@vg : @يL @(@YX0 @5H[nqP @ @@9rрgϞXn]CU @ @ t.)j&@ @ގScP @ @4ͨd޽x4f̘g}v򕯌??>я)ҌI @hIԱ%V4 @7R>uN @ @h.\8d}ǪUF[088k׮[n%)^ǷH) @ wmľ_6h5 @ -  @ @@ڀ}W{غuܹsg_eoOh @ @&Ss3 @@%̻6 @@T'Nv??LvsO|0N<)0 @4B`hh(֬YYjq)dȥ@\%) @(H:rML @ @ _ y/>7n3f̈/O~^x'x"zK @ @_.[u͹ Q u?@ @@ ΥZ  @ @ iꪫ;.>:::bq]wڵkc߾}rʑWox=mL @ 0M& @J,-Ļ4 @@8˗/6gΜ\sMviksL~c3תO!@ @@ڳ& @ t.._M*"@ @Sh O{2Λ7/>fi >ĵ^;zYfs@ @"pq=ܓIΌ M#!@ ?Ա$*/d @h@~LY{b̙sG\~ju /<4 @ @@Sf̘oxE LE ѹd*S!@ @g}Tq+UV @ 0@۸gkx3ms ϟ-[l9 @ @S30 @ZN?l-W0 @/PgV3gNf\s+36 @ @@XJehj)M4 @ @`T u2z @\2D @,P2㩍 @ PT4t0bmEM_ @4Kg]5ku @ @\h6H @ `wFE-G @@R2 @ 0e S3 @ P\ ; @h@H)5=  @ @f hnu  @ @MH"ޤ-K @@l@P @ʙG @({  @ȁ`@ @MЀ4z  @ @#:niV%@ @<K#ԣ @ 0 IV @ @9<_2wMos9's΀@mw4ky @ Pm;8R: @ @ހpx'`g_xq<䓙s|_#@ @8p@|7;#bT?:,N @@9R-Qр]T @LJ ثWw:?ߩ|4`OE @ @,sqYJQ @ز<ҹ/*m3  @ @@C @ @&oa @J&ppwĎ;KVr @ @s h~n#w @ @!0tHQ* @ȅ@%yH @4RY @]NL3fȌ 4K u,j%@ @[o4ǖBu @ @ހdɒ8pa ;A @*0s̲ ;-pR'@ @ "q2=I @ @zԽ{޼y[L @ @t.{h23K @ T߶Sр=!+7 @ @@9Q* @ @&:n9e @ 0u+#|3  @ @@4`läK @@TĞ&; @P] @ @KJ @ @UcQ/H @ xt'@ @" h.nɕ @ 0Թh L!@ @$vo$& @W@vqN @ @H{  @PD0 @D@vA6J @ @O9 @L^w&of @S@v1M @ @ t.}"@ @tv?wtO @r/;[$A @ @Ҟ#fj"@ @T:#ЩC @Ѐ]- @ @` F @B u,E1 @ @@4`z{$G @@JC<75= @ޟG)O7 @AIʑ @EqWdҭ7f{#}  @ @PԱ0*/CO @ @h.V* @ pI|;Cbjà @"qK[ @#֘eB @ (4ey @Gp @(mR @ @#VF t @ @@RǢma @ Poz/ > @h%3foogJ>S2cH 뽄 @8@H?Q8} @ @ h.I @+pq#<eVz47bS @\[{"N_9OTz @ @`mb @ @@n1t I @HZX @ @@K hnV, @ Pv ea @( T  @ @4`O] @ @ ;}$@ @E#hbI @$v[ @ @@: 7TUG @@RB+Y @ 0 Qr @ @ IR$@ jVD:8$l @ P" %L @ @+?P9 @غ<Ɋ @LQ@L#@ @JcQґ  @H~^yŸ @ P %He @ @-:6  @ȯGۚdF @&){`n'@ @M u=% @P`@ @%Ѐ]T  @ К~ݚj @EHH%W @8J @ȵ@J$  @-H~E @B@v)Q @ @@ 'oK˖p @#6\deJ @"(8. @ @ g.\5˓utR_r' @MX-N @j%^@ @ @CCCnݺ Ewwwfl@Vi@Ė[kN @WH.: @ @: xv'@ @M`{^` @Z[|j-* @4C@v3ԭI @@|S A @ t,44-E @j/^" @ @5kV|cȌ B }U-BA @ GqkZ @X@vA#@ @={v{k#1"Ƭe @P m^ 5 @-G @ 0} @z{}Xٚ @ @&k( @ @qwc @ PKވ2X @ @m1 @ @@ :  @h@ڼy[ @LS@4M'@ @4Z mKZ @qW) @hA[ @ P hľ% @(0>M4 @LG@t%@ @4Xӯ n9 @&盺 L @uЀ]g`  @ @Hij) @~,^oiFȀ @&+{b'@ @4K`]ۚu  @ PsqSc H @- @ @j$6\H @ @ 'FJ)'H @LL@ĜE#,8@IDAT @h@z[Ss8 @j.p`SĮ5+  @zM @@zpC @7& @ @h{ @ @M޹sg7n#pd#_t @ErkE@ @ b[lÕK @طo_r)__EE/@ש@ @ZT`;b[xe @ @@4`qL @@ǢzZf @ RRۭX @^@vP @ @@^ @hu+#lu @ @@A4`dI @@ڻ6,^ @@\: @ -^%O @r&p1wLVyk2cHo%@ @@ao  @ @u4`^ @ 0sЇ>Ԁ, ) Et  @{Գ.*ǿ @ȵ@[ @ @vqN @@ Mb[\ @R@v!M @ @@+T_C @~ PJJV, @O@vL @ @@ [nmJH @1OGo  @ @ '2"@ @ 7_/!A @HnhL @Ѐ]- @ "iM-R2  @ pۀCN @ @h^Ȅ @ 0"tF츋 @ZS`;bY  @ @ M$@ @ZJrSKX @Ho;tL @r%;W! @ @p0 @ @vgmmz @ȭn @ @VHݏE}KW3 @H;"@ @9Ѐ͐  @ @ mm  @ PH|o @S@v>EV @ @@ '-lʕL @q!h @ @N @ @LrLIw^qs^r @(6WK+f @ȱo @ @xĿoW\9g@`ku. @Q@vwUM @ @@1׃,  @ o&H @< @ @@Ҧ5ki @ @bmB^ @ PO.F* @(@yuJZ @hྈۄ| @ @@4`7 @ @@ lW: @.mBS3 @j#6 @ @&,R{^n$@ @@F`׽oȜ2 @ @ЀHmk @ @VG>ł @*Ʃ4 @L[@  @ @LN'n @*P}PB> @ @XԚ @ @//(.9H=[.  @ P [ozkM  @ 0) ؓr3 @8@___\}ՙϟ;#jp @LKviL @Sh4 @ @"Pm!@ @ ב  @ @`2'^ @ @4_iD0 @Foeȇ @4XY @ZRܹs35Κ5+36h]-^ @@ݨ̻$@ @GЀ}dW @ @̙w</R|c U! @)kuT6T9Fj- @hq_ @ @IDƬe @ f+ @9Ѐ @ Pnk} @ @o! @ @`< 8G @@ѹ"@ @Qާ#v3:t@ @- @ @:D r @ @: M) @ @p ؇8C @Fr F @,t @ @:h @ @gҾ_Ey?  @ @C":# @ @0 ؇8A @_R$ @M mh]#@ @5Ѐ]3J @ @Y#6ߔ=iD @Zi @Ѐ=! @ @VFmiH @ @BtdW @ @vkg) @ @ # @_`-DihX @ZZ@vKo  @ @z Wxq  @ @`<Ww9 @ P3 5 @ 0F㦈kcD @ @!i Y" @ к[  @ @@z{{]zW&'?ɸK3 /6}E @y~v٧1;9 @ @@ 4``@ @+Wfz{ޓ_ y$b/T @ȣ@|cċ?D @%h+A J @ @J m.WH @&6^j% @(ؖ"@ @/{#:n)*$@ @@z~iyPn @ P`.u @ ;xޖk޼yA,.y#@ @@K  @ @p e&@ @< {qw9EY ~ @ȁ@HߨA2R @ @2  @ @)z~ku3S6 @<#01܄C @j-֢ @ @-+6]߲+ @yH} @.;( @ @ ) Fl!H @G`= @T@vM9#@ @ZV`ʈ--[  @ WOȋ @Ѐ]ܽ9 @ #e# @|CC @ @`+h> @ o[Ķ- @13LMR @ PL 7Y @ @y~Zr @V@vaN @ GRtwwgyLUNH]?~tQL'@ @ nh#@ @ h.ߞ @h@b  @ZT< @s @ @H#:nf  @ @)=뿚E  @ @(C @ @ gώ|3d.ؠK#KP @ Кէ`WN~ukj @i @ @5kV\uUϞpTJۥKQ @h%Qyb˔P @@[BD @(@D_  @ PfވEePm @ PG u @(@5> @ P|o7* @Ѐ,y @ @HCn(\&@ @qq.8E @.> @ @ز @Ȕ̙3.7llrG>JI @H-߈kZ @K@v}=O @ @4 tAqNs OU D=eO @yBocz  @ @5 @ @| ^D_G2KK @(ۇ @%{,  @ @ >z @ @WGN @S@>Y$@ @*v,tQW7 @vE6  @ O dq @(_ɫ @uA # @ k ~ @ @Hpw @v X7$_ @%{C @ @Go/8  @ @`@Z-ػ- @^Ѐ# @ @_W@ @(X@ގsF @ Px ؅@ @ҶGl  @ `OD= @ @! ~  @ @Ci| @ @`/ҷ%: @W@vq  @ @_  @ @{ Z?>  @V@va  @ @{#F @ @h[F{8&@ @@~ @ PI{ʖbL" @Ȟ@φ?CkrID @5Ѐ]sr @ @h#" d&  @ mƷ(e IG @4f @ @bqQVYHCשl @!HˢWJ @쪰Z @,0gΜ"7<ѳ.?y%%@ @Lނd" @ 0=ӳ]  @ @+̟v'@ @| 7|f @*""!@ @$:Gl @ 01A>1/  @ @` F0E  @ @4`U @ P&:~cQ9 @ 0)rǤnu @[@v @ @Rm* @ؿ@jYipۇ @ %P[ @ @{}Ć-.  @ @=ʯkE @ȴL? @ @ Qzh @ PA f) @ȃ<<%  @ @) : 5` @ @J t<iJj= @Ȱ@SF @r'^ziY~q痝3Y_MmG @E(o(J$@ @@4`W @TR/nֲ%9 e"f_]{u; @ @@kQJ @ 4t @ @EH_"F @.kK @5Ѐ]cp @ @HkV F @HkGJ+ @Eh*Z%@ @hllsm1{첱ARo݆v"@ @ \"ۻkr @D@vAt'x"Z[[裏38#ǬY/cppp{r)  @8@A˖-;4k%vg`wv @\ 5  [| @ O 5… ;۷sn!.?8蠃9g*'l73%8'u @ @ ) FZ| @C`㣑vYG= @ @} 4#PzW\7|ץ{{{cO~2J ەX1^> @ @`, Gtuy @ Pf~Uֵ( @dG,roG#y; ώ~?xl޼yxs=]w]\~#T`X @ Pi2e @ @@tgL @&/{v^x`3<3xk^3rϏ.(.Xvz(O$N;yS=݀=wܸꪫƽD @ȍ@ڱ$b+( @ԑ@ߊ8uTR @ @`@c뮻F̙3'n馲=ؘ7o^uQO5n:+9qr!S٭ @ uo @-oUG @ h./D/5#Dkkgqȱ @(@6oA @ 0;Eӛ @ P5 Uy晲w5x׻5r;~rrYB @h] @ @ x ۜ @UЀ]UZ|ѢE#xqG:={vz#|ɑXb3f)22v@ @Hi0RmP9 @dGDڵ:;y$!@ @ he//9wܑvi#SGrlٲK MMM#c @ P`܎( @#ى#  @TL@j({-[DGGH{9昑)[nk^s9X|mgqXfMƜ9s(^y[v @ @@} _UG @h+韍[Z @د[s'Ҁ}Gݻq)5`ʕ+G|#hѢs;vDKKK<`?qr/~/_Ǿ| ×RJ @TA m榎UaeK @ @I h;un#@ @, hS`;w9sfx;rWWWxG9렷7͛O>d\uU1{챦y nGvL @UH~]E^K @ @$R'}d%N\m @ ! zYg!2|pқYl^z{{71~w7J{Z*zxgGqM7>s @ PIҟ7-Y3sH#V#@ @58Jf  @Ȁ <h=boKfV'@ @HͷD쉡M @ 4f8hhhh(KSj('T6ij}vZ\xo>3_^ף7|{Gk6 @ @@>`5^j @(Թ @Z'l+;lsg͚Vz{ug"RC=/m7n8餓ƽ)==~ڲebgD @#zM  @ @@߂7xW @ @@54`WCלJMSm o ޥ إ5VZ5+r\[^zi\sM"@ @f̘ ;wnؠ!@ @hV3s2U@ @ؿk=w1n=ָ=v]j~>UN @rC=4FUH[Ӫoa @ P1oFriŖ @L@lk׼ wqˆ ]žsgϞ={+9TOGGc @ȡ@Z=/E&@ @ " |u @ @n^R >8F70_~یn>c̙㾷7o\k_ڲ @K uX@BKK @n6P= @@jPBN>hkCŋ{E=묳F'sP[Ɩ-[ .Zl^܇ @+[ @ PHh8)d&@ @@xv<qRzv{{xR+2rd8Xpa<,{q//=餓 @ 4+ @l-?=_ @ȡ>ַ5_ysYzgƌ񖷼epR={v~#XC\xk_;2v@ @9h'kBK @~%VCA @9x6E^9sy7Yxσ 㨣yR?{^=&җ4|9{{{믏Wc)  @ @ Gvl%GE%@ @{0RW'  @ @ /2Ը4'.xJ3 _+5?>{.>0JosW,N<đ󥽾/G>hmm~ />x;⬳; @ @ l|$b犜 @|  @ @ GQ`QWN|#1oޯ;>O駟spRCeJO:?9sf?G yG駟۱O>%Kċ/KN=ἥc @ȧis @h#ˣ=. @ @@4`g e0>Nwuu 7Z/]4J?ޚwk_&}d}W5\l۶-}1<쳇gϞ= @ @ iKvH @ @x}t}&X`A>OdwuKos)_7|s̙3gi @ @@RWsRD @ 0>| 7, @Ȍ@Cd& իW/N8c9f~7lk֬hhh:*N;,5 2ѻxʶ,: @ @R+㬈މh6 @Ȱ@Û ' @h1 455ܹs&zo=s=RZ @)oƌKP&1Hͷj[ @ @ i?j# @{ ߽H @ @رcGze? ,H]-ߠA @O`O"m}R @X@v?\ @ @h7nQ @-Vc @ȸ?  @ @@RJA @ P+T @J@v]=N @ @:xም+0% @ @V߲{ @ q @JCy|y媆M| s֞< @ PoF{y4̘]-I @Ѐ]IMk @ @@f̘ P)g[~\C @+0zG)nF @ @`X @ @ i_gE @H_4_H @Ѐ]QN @ @H]WC @/н6b甐 @Ѐ]_ @ @ ["@VE @"۠jQ @TT@vE9-F @TB mhKY @K`/"m~2_%@ @@4`+ @B\D @TZ KZ @*("@ @.{#5u Y @U`cv,kz  @ P+ @L9 -. @@Z]j @ P1  @ 0UR * @B`((E @7 DC @,ш%y@v @ Pi-Y* @ PQ  @ 0ꦩ^ @ P_ "mTC @:Ѐ]Q  @ @#:R@ @*#п#ʬe @@SV @ __e~z{e M!@ @iW#^hh @2";#B  @]vbϟЇ ]#KI# @ @ g]Dw#^{1  @Ȉ@cFrA @X y ( @-P֨\!@ @ h) @ @@IDAT=RϦֻ @ @@K.)w\= ~TZ @ @@} 鴿NTC @iЀ=M%@ @ wn_/D @F EZy}4 uSB @ 0ӹ  @ @| ۯ'@ @Bkm!JU$ @-'@ @,%\ @ @@}ނE @fi @ @:8j:c2zy @ @~3ҩC0%+ @Ѐ] Uk @ @@afΜO=T1;^.F$@ @ 0i C5j @ @ 4N6&@ @r+0W6 @ @G^WN @Jh5 @ @@ۯ_*Z%@ @z uC @F ӈok @ G_Ky.3 @ Ph#RZ @ 0I ؓs @(":| @ @ ܗ @L钷/ @ȡ@J_" @ @ew @O@"@ @Jz)  @ @ /Ҋk^ @ nS @ ?o3 @W`w @ M!@ @%݈u9 @ @ -_cr  @ 0 @ @ ) VJ @ @`mFC @xdC @ v TD @ @`X`#m{ @@@\&@ @h-wcaW8 @(@-> @ _v @]vY-oxyVݘ2 @ @X-OGÜ?"@ @@] hǩ @nC9$1Wϋ:V @ @r'~! @hF!@ @!z;"9a$@ @*/HV$@ @@h  @ P)ꆈZ: @ @@aj  @ P صq  @ȅ@^|k. I @TQ`s6T. M @PkpC[ @ @ Mٍ& @ȟ@J)ʂy1k֬sY%Wd!  @ @@uCCZ  @ P5o  @ @q'|[&E};^f6 @ @ vGZ咈 @5Ѐ]cp @ @,HˮB @ @< sYJ @ h8  @ @@|=kMH @dK`0+I @X@vmG @[ a @ @ 噼 @Sh  @ @F;참Fƥs9l<݃ꦈ @ @@ҒE$N @ h;  @ @^MMMqEu>+'R+oJ9 @ @ lIW~ G'M @I 4NN7 @ @H˯ؕ @ @HKL" @TY@v-O @":Eޑ8r @ @y\vwޫ @Ѐ=a27 @ @| WD| @Ȥ@Zš۶2p"@ @jFka @  e'$ @ @@}X=>jQ @){P @ @< %s|  @ @ 7D٘ᄢ @ @+i5 @ 9f.@ @ @@ tFZ~U  @X@ @ @H}~>'@ @r"z{9 +& @&{j~&@ @hzĮ( @ 40* @ @84` @ GԷm2 @ @yHO1 @ qL @#V^ב @ @H?)ס @O@t\#@ @9HD4ߒb @ @\ĺs_p @Gi\i"{  @ @{ %8FAu  @ԃzxj @ @tuuE]Tg}\5i&@ @-z^i= @X1E'@ @H)EZ{5$@ @V .R+n @Aۆ @D۞V6!@ @)0iƼ @,;OOv @ 0J tGZQg @ @QH_&@ @@uU  @ @@1?hii)+#,Wm"۪  @ @N6  @ q @ @ @@NyԳ!k  @ @^a4Ns @yhSXY  @ @} 1s%@ @L@ZH}Ә @zZ @\ m{!kC @ @v.Xs븦D @<hS @G -? @ @`#l  @ @+h  @ 0]-L%@ @O{e_\ @ q @ @ @@W%w @ @%zG/f+4 @I @dB`Սk3E @ @RE:43 @ q @ @ @} H+} @ @yx*ҺXV @%{/' @ @@ҒE ve? @ @=ҒF! @#;?JR @ 0,:~~ @ @| tX}S>KM @! ~  @ @@Re9J,* @ @`oH]m{_p @9Ѐ$" @hY㥑 @ @@."-t. M @& @ @@zzz3Lق]tQ{e&3H#-r2 @ =ߋh8& @#{?8. @ @ u]WvۙgYe_R @ @ 忋xEC9t*yژ @ {Kz6 @ PSgR @@CCCwqe;͜9lg%@ @H @h=bs*% @ @;"-ڻX @Ѐ=a27 @ @ W"-|" @ @ Fx+ @:Ѐ]UI @ ?\b @ @@˗E.'@ @4`L @ P鉈E  @ @ص*ks_ @)E% @ @`v\pAYO}SGGev@O @ @K` {4~:G @ h) @ @⩧*+//eU7D\Qvʀ @ @`7? ~  @@c# @ PHCiu0 @ @#Hk= @ @kq @ 0@z҈'B @ P&}e  @ PkZoh? @ PMMM׽ue 1& @ @  5_ş߹e7J @ h @ @vX,\p g_w @ @X{O? }_w @Uh'@ @(}Unuq֐ @ @`K# twy @rZ @_ m @ @ص2Ҋ/ @*Z @)v& @ @ )ҎEX @yM @&-_VM8 @ @@%KԷKZ @e8  @ @vMtl̘1cg^aj @ @="-3 @Ѐ=I8 @ @}  @ @PHᆶ"@ @HJ @UrU @ @H/mh @&({` @ @:y"~~ @ @R{m%"@ @ MS @ @ƖF7ovNܪoy//x @ @@ h'D  @v\59 @ @@vSM' @ @@ iI-,$ @(WM @ ʊ5o60Vj\"@ @hoF]C4 @Ѐ]uU @LP ZTWMpG^zs @ @ y4ғC @@-! @ @<1tټmNeg99m  @ @-^iG  @vY)y @ @@F>kqśxi<)81U^"@ @h@ץ<;JIM @@99 @ @f Tc;N)7;x @ @9Hwk{r4 @ț켭| @ @k(߳9N @ bPTnq" @ G y\9 @ @@K/!;Mܦ&@ @h@{C4 @Ѐ]uT @LP;zNg-={ @ @< ,V_)# @  9X) @ @@kRǜZ @ @H>ihY @Ѐ:{  @ @ ''ܓlA @ +Ց)Urd @hًL @9X;d" @ @ 6ҽ_mz#@ @- @H=ǞQM9J* @ @ˑzej"@ @- @D }-*$#i @ @[ E{||); @&]@ @ @y;&f& G @hH>C @@ hܵW9 @:V`蚻3?jA @ @.Ni2 @K`Z{+[ @ 01Jw_trub=ۣQ}1SGydz衏 @ @&~.bחDi[%@ @h  @hگ>,]=i G%=E|6œ}'M @ @JqĵQG  @V Liep  @ @@3~f @ @#;!RߴVT6u @(" @ @`C#o9 @ @j+#V?A @!  @xX#*ލ(=A"@ @hGtɑzЎ˙ @q L{^#@ @m!*XwFuEoScA9Gb_Q9m#]jJ @ @4SDqmۧ"@ @Evn @ 9/96DSc1s:ujS F @ dHsTmr` @hVI @MϚK @ @1'@ ;cUI @],{Vխ` @ @ /D,Ɋ @q h7  @ @ /ix4V헣ڵ6/)Ƀ @ @@&"=>4 @(-R @ Щ=eQn @ @< FyRn @lm( @O_b(m @ @Xww.x#@ 9;gUJ @ ]ugQ]6U @ @ XH)MF @@k& @ @`b]ꭧDV&6QJ|:nRLw볿}WU d: @ @vH ?Q햺|  @xGa8%@ @ E_%\j\K"^WhJI @ 4/"JY# @)0=Ӗ5 @t@J)ufS M @ un}{\  @t^~ @ @/q @ @xD`H;RG @H`Z*U @p ID)bSSw]uwߐsu#@ @h@U(=+M * @ЀEs @ @ ߺ(z0WŬc^Kik @ @-F(p|G3( @@ LiK @'P^H#W  @ @ -DF @(좭z @ P0p|}rT)Xe!@ @ʖ=@IDAT J9EZ @m"MJ @DRts'f @ @N(t"tJ$@ z$O @b cE7H @ @ ޟ}l( @r.; $= @t_}'_TSQ @ @@CV_: @hƛ @&(oMp<^cRr"@ @ȓFyH. @l"{ @ Z;Uo9%bDD'@ @ "t#-=Eх%@ @`K${ @h@yz"lZL @ @Q H=W159 @x # @ Ū7})*u#!Y @ @h@t1-heb @  ؛Aq @+*~i12nz @ @@ymi: @ h.ޚ @m'Wm'\WA @ k.l @ȑ-T @ ЉX_wbj&@ @ u}"96Rut @*{RyMN @O$ړG(Ǒqy~򓟴]&@ @ș@}rt @t+Y @ KnvRihH@dvEmMvچ0 @ @@ ,;?v{GPe @ȇ @ @@G ߸0vjDQu+ @ @?#4& @ @`oM @=Gכipdo+~=l  @ @yHwS!9 @HiY  @ @%%ݱujwK7#贘Sc޷CԌ @ @(@4vғ*| $@ 7 y[ @ @zueIOA++k_,fBת8 @ @ Hsx/ [ @:O`J畬b @h@uz|f @ @@q*n~ku [ @P@vEJ @(@U{Jt_R  @ @|t_EZp> @ЀD @J U*3byJ!gqS @ @@!5awE @Ȼ켯 @ Ц)yb۴H4 @ @@cMأ4 @d ؓ lz @t~7wen @ @=oTh~l  @tZl @ @Yk>?f @ @Gzot#UH @@4`7t @t\}_O @ @u=WEݑ 2 @ h.* @ƥ4;lKmT  @ @ZH)Uں  @ȣ< @ І߹<|;my3S.53X @ @.HWք]t  @hr @)~;ϝj @ @ ,q;N̚]~If @&VL @șWG{Q89[ @ @Xrn;?N @ Lk= %%R @ @ ,FT•  @Ѐlq @ PoUo;5bRjYB"@ @ 5aC @V hj* @ @@M|wi@ @ @]&v];y @B@v.A @h5_bɒ @ @ ԛ @#0qM @#0|}jD.+03)/=؇] @ @hgE5RL9KBl @m'L @h_Ǟz+ǔx[{ 1WnFik @ @Z,ףZ-ǔgD'@ >S'U @ @@+֝~V؋I @ @)~;) nM @4`* @'"* bf @ @Z/8kg_  @]@vWH~ @h@Y~+¦7-Za  @ @4Y`"=>R @h/ ^%@ @@S֞rq9񻚯&$@ @h #v\ք=yF @@ J!@ @@#|4b*s@A @ @ w+閷E .5  @ȃ< @ R s @ @h@nH-MCp @yЀU @,*yY_59p @ @VH71ܦ(1 @Ѐ u1  @ #4<89ʪ. @ @ ߞ5a>Z @lm& @#P_]oBM)*וr @ @lV`H׿6ҺM @&V\ @ Pꍕv& @ @xbYG- @ЀD @l*0zXqcd~ @ @]7El߻K @CuH$@ @ #se2 HqutnvGxֳ$D3% @ @& TG}3JeG @(] @t+Ǫr0ɕr'86Ƃ}q 'di @ @@R9ҼD >ڄB @ȗ|# @,u]]דU) @ @htϿEODJvHW @&a&"@ @@~֞|awfH9Iʌ @ @x"ygߺ~'c @ h @ R};z?È K @ @XyIir1 @qL;^!@ @6[o?=_rkd[wiqy&v=M/>l(P|qVZ% @ @9u 4| @@4`mEC @L'GD)b=tM] @ @(ࢬ 5/av;@) @c< @ER @ @Q`tui1{9 @* [! @oLTieI @ @@hy/DJx @4`w @"wc|9pQJ*`$ @ @Hs2xOO @-e֒&@ @id4z>1+7sWR^ @ @X~a"^(m0+ @&  @ @XyIj. @ @+vNk_wNc5 @ hn @ȼb?3ѩO @ @^GZɍcv @MЀd! @ h :*jT4 @ @@CNUr @H@ @9HjDYvٲ@iˏx @ @@閷E-z#@(. @(@w K #l\V @ @NXuYkO'UV @h.B* @b ܵ$b9.Tu @ @tHeM+~95 @ @ @\+^(߻evHm.V& @ @ T"ygT|6Rn[#@ Ri-.8 @<@*Wbͧ΍H9b$X;\zo~~v^aR"@ @ EE5Di9HH  @_@ @-Xvj _}wrx|#Q3㞈jclC @ @}kxˋ:dE @L[ @(wŲ}\u!8*E @ @hвH׿>҃g7lJ @hF @H)/_+,^˷@)Ɏ @ @@h;?ܟ@ @1s @Z"PΌK$(E)fǴ(m?#J{ `& @ @"HkF<(NZ @m  I @[`ڻGb!ʚ=u+;je @ @$E;*OOS;IALK @`l&@ @F b/7׍B<)J @ @@ÑhTo{_rғ @@ \ @@bMt|^BJ % @ @ , R-;'Jhթ @F%U @!WsbsQu1S @ @4S`H׿.Ң3[} @B@v+$@ @#hEծih!g @ @R9҂t_G^9L@ @`[4`o  @ 0|*=,+ @ @]_i%E @%[ @4[+0κ$1:wqËG @ @b DQ#ŮUu @Ѐ @E(/_]Xsw#FVz @ @ %75GD%?9Ʉ @ #@ @\˟V!vR2 @ @ .tk#{rj0e) @ &2"@ @*c;NOjϺ6D#PiJ @ @@5`_wd @ ؓjR @:Q`IJg~4ϿW3 @ @#7/ҵ諑l @ЀHMs @ Бށ~c_~)+z;@[+A @ @ 0QH'E#[8ټO @`N @ ?)ޕ7:Pԁ5+ @ @@zotvn2O(" @4KON fMbƴVho I @ @nرþU"D , ͒ @ u|ݨ+LM i@9qUtE̯ylL @ @l@H׾2ҁAҔ>7 @:^`J @ @V 슕oBt㫚c 6 @ @f r}_t"#@(, @\TDW˞t3; @ @4G`H7>i91E!@(BT @LEߊ[-GēbƳZ/oPf*Z!@ @ Ki<%Jmף @IЀ= @ Ўվ̏T۱9H`e-{b1$&.  @ @ȅHWiS4\%  @| LgZ"@ @@ο:=#V- @ @h@~I{OTnvt @D@v,4  @|{vRtQYfЁkV2 @ @65`W]fK @, @5+nukwR  @ @#0x[ipqԭR @- L @ @@֝wUӹv.+ @ @4R((M~By @k @!0|Xqħ]gjW+ @ @h@u8S"]H/je&b @@@vA  @4O|utXO4/H% @ @Ñn{OT]9\  @& {x^%@ @}H࿏.Fx2%@ @ @@WGuއ" -[v!@di<  @ RR ?C-Ep:  @ @(EZӈ}4ONҴY+P9 @T#@ @믜+^yי E(T"@ @ @*=9GJG @ J"@ #w<+zȜ;CHF2 @ @4P`+'FV @ o| @ 0^=8愈F:zo2=&@ @ u "wv}i\v{i.Ғ @@4`7L @HjmD[ @ @ @Qknt"(=(G} @sr'@ @o?Opם㐛/c1vu8s7gg,D @ @4KבyyTifE @`=&@ @`r_D?;89AJ`)Rh`mM222a8g @ @-mΰ"-0~DwI'@t^| @h7POڳҗ/L~  @ @t@D @ @yHK"FYOcr"@xGa8%@ @ ;_GZ;dA`+fĔxiq1WnV% @ @2ڎga?H5k(h @r*; #- @(P~+NY֏t" /P*| $@ @ @`"Ոe6|X#/Ȅ%@ ؓjJ @M`?CD9evaVa @ @-ui(=cQu`> @q h' @+GW~Cmⓙ@[-I @ @$H1ЬĈ})\ @'\ @Z+F1ﴟȜ[.`즓 H @ @(4 >wGiEN @ЀV%Y @+PYQY} 9 {B|^&@ @ @ bxyq;5cfD @- @NkIuI H#Hf0 @ @ 0`ăgG=_F=Ȍ%@J [ 1 @^ U*wѓ /`/  @ @Bבjcӣt"?&Jf"1  @!#Y @#Pum7QypUsBV%Y @ @&00]XH3k>!JnUȗ { ع_"  @ȿ5wgM׿ .?ah[F/0 @ @N(GfY$@ @ @`FVE,:-Rm{vŞ1E @L@vT9 @&C|u +`d0'T#Xk/.׵^{;0  @ @,HوEQ(vH @ hn*` @G /n]}[D>˔@ Go#>Qc}q 'dvnM @ @##Rmz#v(m'] @kb_#7,leJJm  @ @0}'RmlԈ}}0 @+ @Z_C# ]B`bOUlgS86Z&b @ @ #6v(st>Y6`rS @K@v{l  @l@euMݮQn^ @`Ŕ8*=Wn7qI @ @@;  ?idwiX  @,{ɼ@ @ ̚/!=beH#ˬH @ @$7/R6b5cWY34靤V @4`w؂+ @66]_swDUgqW[e @ @ @ 4c/\YYv{ￌaR"@_@I @#ݟ5]?9F-ny> @`K-={ @ @C``aĢS#vF(ƈ_)ӋQ* @ЀݱKp @vHC#1t1[b}6*Kzڱ 9`;w+ @ @@ -xHوi;E5QOz]f޹.*'@V@v.  @:EЪX9[cG:tu @ @ @E(E8R6"Jvyq3v֌kaEV= @@A4`taE оid4;~u[z%[  @ @ @+#e#~6̽]FlGFi./ @ЀJ}  @lXl^ Hl(@U) @ @ ^y1%Y#QYCQ(J c @D4`OT @!PY&_1?=~;/*Kz1Wh?l7 @ @ j;M?v+YS4[1G @#{r\J @11|՝G\] @ @ @<@/b%Q{G5bgMQk  P @*}1|]1ztO;A @ @ @^H٨}vOkdr⚕ hc@ @V5w7^ @ @ UCo]H٨};dw{yĮ(lT"@lI@|O @`Tȼ1|=GMrI@ F5~ǎW:f^ܩ$&@ @ @@j;d/0R6i;EYCKl(MD$@ !˨ @fcA _ Fn/d47m,0x+րk*u @ @ Pml}DY]_4vu` U  P @mC12ʃ& @ @ @l@5o~}S!M-Y3v;v6bFi[3g @Ѐa \ @/FbdeQ}pD%7 @ @ @]]%SvOZcs4}rQ- G  @" Tݭk;\vԛ˚j"@ @ @4D`hIĊ%V|tiD) @*$@t@J)ʋbtc sl+#RGQ( ̊iq[!vb[_^b-FX @ @h"VbiY##v<,JNϊupL @8*!@t@esIPޞ5\gc4;OCg`#PR3cwYdB @ @'0ظ'PizOϚlĎFFvT\LLI' @`1zגpγFꪾN} @ @ @#F#﬏MٵHSgeϨ7df5eo5fO\J4T@vC9MF 0^4Z+c1 ٱ\;fM5{ @ @ @%Pk)Eup֐YO҆c:(Jf @Ѐ?-ݺuqUWŒ%K\.Ǟ{rHy1kVs1QO @ J%}+ @ @ @ee>6'ݜf5eT?6? @ h4bO<::]tQ{׷bկƱw\L:uLf^h'@Eg;Yg nEcڱ6jM֣" @ @ @/0"6V_Z~zSSٱCv=cM Ё;p'ZrZN:)'jdd$9眘?~r)1}'|~[Kۚ  @@ TG(/ͺvd ٱڵK? @ @ @ZQi;Fl@֐k OɎ'Gi.SL  @@4`h1%381oyva1<<s̉+"zzz%r-qi??7ļТLFZ,*ʒឱcUcMٹ/ @ @ @VI On1{(mgǨ}6f37y% 6 vmqo|xF|+_]v>:>ҥٿ>\rIo:h9K @u룲lM6VGyiv\5YgϳRmvj @ @ @ z]Yv6Ϧ {3knI;;ؽ{gǽ4ctNY`Lky晱;l{7߸vq#L蘗<&T  @@j;VW]kǎgcd];ӺD4 @ @ @%0Q}eoI{ʌ);kƮ=R֘3k׵1v^=C\@v/`3ӿ{ocl#q֛k.?g~qǸ؂@J)ʚWE51Ύڱl]Qql!  @ @ @ (HƆ9o1Ӵk;kg<)J3xQ*MmT!@ Ѐ0Ot7>ȣ:1כxk_{hh(~_GG^^=H+FFf *=Q].u^5PWkvpjǚ) @ @ @ F }fiYcӳQ;-;-JQv/{~5mOaN @dh Ղy]wm)OyJg/жyE՟0䱅}MHjQ];ld;S׏p&k]׎Fv  @ @ @P`tMDm}I K74d5lgӲvΎ.Σ~S̆{vҔ} W;787o䠃؀x-=D ip8R8nhX;F^v/k˚&ڽlZ딽O_-PPȻpTq{lw1{<ˏ @ @C Ft?.iK l5dgMٵ&i;>jrcPhk30k}C߫ Z @k^o…;k}7]80sX*UbQ¿ gVYWo6d@yVWJѱ =,m B|/c.{ⶖ޾r'm}re#@T &`n/<͖lF @ @ԉ@X4ńvVWxLyZ{lky{˫p{0w{>uki#б@k"qkƖ_XU 򋫢mѢEEkw{챪^mZr' W\qEUD @@{C| @ @ @=+gOl+~0bC z\N]뫽e%ԀڨtƨSKӿI+⪻6 @Ho?LC!@P`РA>;ݯ @@fx @@ِ;@VG5S6ۄt>Æ 뮻njs e#@ ПV^y4oT @] .D2f̘0,X  @@ ΍;65kT @hiw n[gV-nnn.>l*Y0&@ @ @ @ @V:thMMMz{Ҿq%n_rUdSO=ߓO>.88pT @] ?R8蠃B| @Oq . 5'N8!զB @  _SnOT  7I|^dIJV ݍc뭷NCs 7.p; @2.ꪫEx-S@ wӧ au[ @ g.K9rg߼O  @@73"q2_Ҥ T=ҾD-K-=w{*[z @ @ @ @ @@>J`u +ϙ3bҾ#FҎY4.u @ @ @ @ @]Q<8_o-v^=z1muJmŧ @ @ @ @ @ Hۣ;vlrgy&)wT6mZe7O]-d%8 @ @ @ @ @ Hy;sr͸ٳz[Yf7x#ٽ[$GWw @ @ @ @ @@~$`w<=#44|pM7%} &NԻZJ]q @ @ @ @ @x?6cy javKzꩤ^Zx'-ܒ4xaȑIZ_G  @ @ @ @ @ H.PP|8p`ߒ%K—裏C555c>Okm;C\ٺu[qTF @ @ @ @ @ ;*6`pI'K/pŋ駟Ə>bB3 Y_jXoZ~JH`m ?R#;vlB @?>*} c#@ _gߵZ x @W_ٷ 4lFw_8¢E::{aVا;oVG?ڥSa„ ]:A @S ϸYήQ @ wųL P g}6|3),꫇[n¨w ̉  @T-W>묳Ÿvijj _~y+\paРAO @@qCE @J ϝW @r'3y]׶;;,<w6f  @ tvֹC&@^w]wp衇;.!:_-*={v'D >hN5iҤ0z.  @'g,fֈ @JYQ'@+r)a֬Y%<Ȥޓ,<x(ܲ7k!@@Z/Hk릛n.°ꪫ6ck%W\qEhzw _=S8ooU}!C# @@3nb3ld @Yynx'@K۷‚r׍r-M=Rw I @6c暤jK.,:vX{å^F曓rO{4oyXk~IN @u/g,P7 @@dwup" @ C ,~8ʒ{3̬<AhР0nܸ@ @Z, -K}:p#@u* N'ް T+pT$`暩c|n%`X" 9/^N:POĝ ,3g {oÔ)S,) @X ϸYoC'@ԍ@V;}[7 @2!pa$<d.JP@6bN!ﾛؘW:thjERVf͚,Y,:^)\z _BxKw @ԡ@qCN! @N +ϝۭ[π  @u)7h P+`% I? RuN+Vwg1cF+r~vmv/x <#ISK.$yI @@} d7 15 @ PYyW&@}- ]@?|JoWwÆnj؇rH_ZW޾äInB P_YxB 5FKO?&@ԛ@Vx  @@jua%@  HbŊTJsssjFmZio0|n%`&{w7K:_/[_|Qv* @%xO=f!zsc%@ԫ@;}[wq @+Nvve P4`.[zO͎]l @@ >>'Sڷ\[---=Wiu @(}V,}lOo;n$ @/JKۋo;> @6kr#놆T̙3K1c{cC6o޼2 @@ d7 1ٴ. @.ݺm  [?^ @Fkt]%@vXk!C $̚5P׫:>v*N=zthll؞8w_T] @k֍ Pyn}޷FMȫ@ޟ.n P+ صw]5mݺtձc& 3$@@ w }w)W"@ ;sz\{IBR7HvoI+Çn){o[>O?;f̘T] @o捘 P~nsFLgZ?׳ @G {Ghhx7(bt6hР0qjGƏOy% /rےlMX @@} d7 15 @jߌ P~w'@})~Fe_^յȕjvm$昀SO%O<n喤 #GL ͡Uil+ҥK71mojj w˓.瓲 @@ 3nm|okںv @j}}[_ @@5Ͼ_mQ@vgMj X%K—裏ECc>O+n;Chs-ޝ:0zuywy'ik-᳟lx[>6|@ P[m{f @T;}n錨 @Mg8zΛx  @@w6e m 6 tIK/-kOǏЇ m1!{ƌUկ[׏'hll 19{ʔ)!&w]_ZX{رa…aaԩ5

Å^fϞ]8o6Ϲ[Gf; @S ϸY>gߨ  @%PNf @zw?  }{ƌSH+M2:w1|s oqkSp 7UOe]YgFLo9Ɉ N?N;~/544N8,k; Z{S>FjS!@ @ @  @ @  &?À’%K… /x0k֬~ګs@;b}?Çb믿>wyawFk)s?qF @ @ P  صPwM @ @V[mN9Nmҥ!{'w}7u|<߁jW!@g>NN+~ 1qĤ;*uxIRm* @ @d_!! @ @[`РAN~{hllL vΜ9WUMOK.$ qunzkx뭷RO2%URJerlE @ m ٞ @ @ P18;0駟w]H(nnРAa]w _  h{aG?B2pk{7l ~xx[wGN9kUVI틕ގ# wuWrݘ ;կ V1O>B+s _}Iإ[o|# 6twU/Xtic<}-lV6Κ5+l6ղds9'\xu]4T(tŗ{z}#$]X~ NTD*YiڥgO&'pB袋zGgy&ns;ګu#@ @ * @ @ @@ H]+&ƕ͛WHI?:LI1C 'N of[OyZ|ya}ݷ,:ygVNNRx긭rrL>cáJ&//c駟^p]dIom]*&_ǎ%&oNW{b{[\q|7pC! N q^kŊ)TBzU\qb,^OkLyɩ/1i+[\<&ow\?hJGqJ\3[|Y^5qC @ @@{ @ @?|*78 2$Z+_4OGq߿necrG]rqǘLa]v :k\'MTHlmmZؕ{;'?SkSj+]w]=P]\Tmj=n'@ @Ȧl%* @ @ԧ ţ+)Wb'>0mڴ|!{u]75u\{W-*p@qs . L:>1֭qGi 'ᨣ niG_aƌIXO~kp '$I#FG[o]X sOxgS>3G?Q8S{.>U > @ @@FZij @ @ @@'Z[M>v,NرcS7^//;a„Wزs)SʎmInR}=,;ci~衇͛ܒܒݼN;5/\09W_ے ]1ކUZ ,h?^ֱx-<̲c^{TJ˪- eǵ$E7]=GM6٤츯|+I -oյ1v^kw0UlINoIwkaC9ZV`}Y~Sq3}+ GkE׿k3; @ @ 4|e#@ @ @ ̙3'{!R]92|s+nJwr,=s\mW/WU.~߇GgN:RpKuXmfm>τ0lذtY%5W*1иzx\zWN..$go=zIrHR_=$ŧڊ+C\x;#]wƌSܜ*GIRqT[w+Y{Ǖ7xԩTJ׫jag8bVk @ @G@v~J @ @3SON;-|]H.bJ!&an/bjXcT[[VZ)gW_}E]^¾Ļ^{;xaVgȐ!;NY{qÀ Yqe˖IZgu¥^jk*., <8|s&;PJk]bL<9/~^K?wEvpQGCJ+YUzVZ5  @ @- ;#: @ @r$p7vۭצnZXi96ۄ/8,Zlq?=6,X Հ115W̶Fu_paY[{ qjtG[V=S; 7/bܸqe [ouiSxbíJcw7x≩W\qE=e%jﵞs9gj{`q7H[:OUY[_eq @ @@f?^ @ @ @ s [LҎIqEJ[LɶqUl뭷^Ybv' +eن^{[Okak-VIԩSönu׺:J:&<|[j+l-wa#+T5dޫ] @ @ V @ @IG}tx衇ZmU׳f*z|eZUWZEk1c¨Q /eJl1i~ذa;?Wȑ#SmT~n.PeCyjcW*fɓ'͜93ʼyoT)SRj+Tʽt~ @ @ X;s&b @ @V[mǟgѣ{lqE>̘1#W_ \rI‚ cƌҵjûoo4o޼:u=z?Tm9䐲KL6-Ao'xbqr>+U؋r @ @ s޻dɒ^bSSSϟru{E'=#Iu]W1t6,L0!9B-?+؛r @ @ ;w"'@ @ @6 6pð['BرcCӧ`mUW]gqFaNvt@J^mɩv\ hŊkM얧JssshѢQz@>qy'@ @? 7FL @ @@?xꩧ¡Z;b~jmNJeАx0Nj3gΜ馛ת!1M|ɡsWhÉ'pwٳg'c=6WSgeҥ +K5  @ @&o1k:!@ @ @@Fow}7qO|xyRJo%`-2^h8p`XoRg~SZWc_566#<2uz¨QR}:dJ+ԔwT]^%m @ @Y @ @X|y馛Rj?!CRUf̘Q{Ŋemm[og0aB3</^jlٲp~:,\CL7;N<9usb"ޚ_:vjG<|VJt~:uj{J @ @@F$`gd"A @ @jfϞ]ҕi;:wQ%&x{zoĉ?au]>򑏄-ܲkJWg.>π|^Sf;*&&Lr-]w~d?0iҤ^M!C2k֬T${  @ @@$`glBC @ @*RW%}eU|{z[==wGW^9ZJ7hѢpڊ+հdɒTRcRtoT'pBhh z뭗g\uJUyBSޫVJ? @ @7} @ @ @@1cBi<*'ɒ{ln1qo|F |˂ Pjf̘:1Svw(M3gNTV1P裏C I"{ܹso~-FO:W[g%^ſ^ziqS;LRNZ{mh'@ @Zπ @ @ @ m]ꨩS . VWa?_iwI-0h_k_:L0!묳w0ppꩧJ+ÇO5p !dVۊ#G Ǔ0᧟~zj?IY RC_J;{*& @ @X@v @ @zB3Li򕯄?<<)?pwO|a]v /Rx%'zx{rk \sM0`@?vBroLn}g +-?#?ql9眓:&+(K(l喩yض߾ܜE3X}݅4&o6aC^{Bt#@ @Z]u  @ @ @GqD;ÕW^$&,BLt\`Atz0bĈӟ4{ｅ$[ y*_{^{]|eɱUwԼ)^}̙a̘1B_ǘ\8W^y,;ګmg_bw}!í}zauꭶڪau)/)Stؿù:0r&B_X|ݬ?Kyw<|Vvmsυ38{(:N Ov׆^ؽwEKg%ohLM HVݵ/lM0m kt;$c#J(Uzd*Ei%{Fž% `XO+ltqĿ $[ֲw3% | SL^Y绰) :gq< 381b eS Pٳ GE/ .RH"uoI vHmĿqGc"yǗj,cR>5y">E"{k_qRYV"T{\ }` t-"YKD:MѾdL;H[* _D2ЪIʼn4}UHqq7ՏbZY\\!/Dل XKߥ%}ӵV]SȞ\H+4 |Z?gE|Vhqd " mη6Q~,POҮ j^!K\K&Aݖ~џտ_P]j"Z"YSc 89#gF0]Cg^eI?87>YxcD+rhHA5ulGgVƦUG-sE;pSY r۷ŴL#mk4 Nè$gp3kGirÒ>Eox/HH|8wZ`5KU%ӵƣ+qx^u454*(3E5 mOC!Q|AmH1HjQC{5^"RC" `+gZC NB}"98+= D;/i [LcD|ccMk$gDjEeZsQdUvbx>qͧlv:"o~c[_'TvFi?QQYa@Hi}p^?GR)'v矽^-cif@G7_efN^yy%x;Btr 7'_w4 K8AFK 84`:#Q)@["oJ#L\\5Pj#(nͥ Pac #؂iJ=MqsYy.-ނ{&v2A~u@O_5^M:i"qꖮ|?M"FƒJ݂'L{0FOzTJVuo G@Z7[T"_\p$鞦`Os+͟g!}lC"8_SKסUMMF#c 7 wZ9 n-s}ws;'KE|pD<K Gm@C1h3ѯ+"ʇ/\ x_w7J> Fp]tM"!jAs09dn52n7-~UG6I;-0"FV6o+ Lfy#[vIKi-]Zm+%V@|(|c0`D؇滣HLR[I`+CIuuIoɣD`Kݑ` "O <[M2Hs;J895(-bʩrp0o'+CSD0>ңFϮcR2 Nc<^4zopu[|Wx3mW/=ʷ(gEHK8ԞIj h0Ԛ+DZRfV=CJcܸqX?9ڮ7o`b:uȓO ǟ|Ffg'Ϭ >锬ȫ$5|~ɞ>rtbe>ߋJҤ5~ Wց\0Oɼ%&-b4;ː!Cs1B\,mĶ'8!V`tJAc؈;$8#+W7f OZuv`}eS"%WHe޼y2g;v3FRRRR;t iiih"9}Z}ѝg8+u(7Ɩ}Ur݈~RXXȑȄ $==]xYx]w%;w[dص7*C !~!//8"U1WZbRm'[sML֭[xekO?-SLe˖)Q^^uЍiQ` ؞{5iC VhJ_˨ueڴi>'N=B6 mOBr,{>TND Z~+%99Y&O ۷;> οOGsEz)z,_}_U4GJ^̨:11QVYː l$%2M"G݆>T< 0@;Cy`F.GM^#{=[~(=aÆ J%Qtj5 ,j{`t=n[y;yO ܙ_yF|p)4pdJOͥd-j)ቕ;M+SGɭHVtib\oJޭoUg]H|/Wr}-g}qmQ\X]hz7bZKE:$nIY?6SGJoѵ奸eڪjx+Mlfɴ;+g=i$6K@kދ:>r%rf.@\ْ#*8*i.k CtNW>ZҠϟ㲿P"?^!+%j#g^BӦ77!} Lk0fΎ401+tىn `tʚ[ȭݥ:mTgFE[0>ybi+J!e }45ET$_$wgI*@~ud|TzH^yTKƽmarC\W)]Qz2QrJZ.u]7:2H8s0Ӱ5,DoIXt2!,F:! R`h_-i]Oԓ}Q+Cll/dɒr`JI'mƶ$gmT'LZ4 ga}"ym/"K 0P95(}c0"H :<&QaR-"R.$a<|VD6;f]qiٱ'](m n9-$đe!zOu:@t#lf¸دoD;!C Vu 2hQ.8ĞPJ|DƆsNr$ܸI«lǙ8*2&]2q[{T`$3\bGaKh%Ii?]HDȋa\z"X;='&{ /R{E^'lIMs6rјÒxdϒ敼8 ĚH0lMub){W Y*qvHˆ-,{ /n)~ Q4.HO :@.{rY#YI{Jx_Q^ )AGmkٳ&{&=9*/K,MU&/AK0yiZXl_EGp^ʋ|mnp" ){> i:ceO''/E}b" uhʞy kbl O:@tl({z;gbm!/^D0+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i `k.@IDATx ey {z@e]h ("(xIbT]cɢ$D\&F2D03}o:}I|-?C @ @ @ @ @ ; @ @ @ @ @% @ @ @ @ @5 (0 @ @ @ @ @( @ @ @ @ @ @@ k2 @ @ @ @ @  @ @ @ @ @ P #@ @ @ @ @ @l @ @ @ @ @(F( @ @ @ @ @ o @ @ @ @ @5 t80 ,^8͛+V+WFWWW}q1'|r7ο3X|oL6-Nmmm/>O21R).첸j󖷼%/ɓko @ @ @ @ @`-= xMozS;.*M/Y$~_ٳ3k}s=4Owygu:*>8S'{bƍ1}{K/= @ @ @ @ @h|Ν;h,_|ĤIK.JQ`z(/DWW׮tPr-Q)'?ꪫxEf͚ cʕo9N8j @ @ @ @ @Zkh{ｷZ|]?+ϕO{̙/6?oWW8kݧ2#믿>^WVykv @ @ @ @ @`׀dȋ[w*7MwyqVϟ?<ڇ #soն @ @ @ @ @ (Uʸx' zxP}]).Jh~̴3<3w?Om @ @ @ @ @jP]T[83OO>f= +pGTlٲ%*_ @ @ @ @ @#pH_yrJy4i#)6mZfxEo̙3cʕC ɼ;si @ @ @ @ @>~QuQqYgn;2Ni8蠃22?nXg @ @ @ @ 8Ǧ⩧+"ק?tP&=oμ؃>xQ cӦM7_җ駟a@ @ @ @ @ Z [뼚6quŞLs9q׭X {zz2~#->2ט>}zO @ @ @ @ z [̚*R_}̜93>?L_={Mo߾eZ5/d  @ @ @ @ @@a`ǞxF/}KqVK/4>j_=:]7jW +kּc_<@ @ @ @ @ @v F#m۶ 2ׇrH\} +9eʔaYf,>cbԩ1 @ @ @ @ @ \@ggg\tE1gΜJQ 7o~}z8K?{ߨ>{ @ @ @ @ @ P@G#P|31o޼*ȉ'W]uUvaվF>mooWZ{WX֭:餓 @ PO򗿜Y}oMoi @ @ @ @@k (ns׿wӣT*;O~CwTO<9~@ @z _Y#T @ @ @ @@ n"o{7f͚UvڴiqWFSJ[dMgqFM駟~x'㮻v=Wն @ @ @ @ @ V6=cƌBx;SN ~{wg]v>*~_FTn-oyKf?_^ttt>  @ @ @ @ @ (UX|yF?a]kSOݧֹ}<]]qE_j>uybWջ @ @mmm< C @ @ @Ŝ9sH7?xի^쮮]͋wOw݃G @ r!cǎg! @ @ @h.uMŋ2߉c=6ꪘ;wn['>{y @ @ @ @ @HR3 hVWn닣>z#א:sҥq1d4 @ @ @ @ @ZO حwf"ޏ@GGǮ[t  @ @ @ @ @ch  @ @ @ @ @ @@A܀]& @ @S m^ѳ]6Gh84#^xd﫢3c4 @ @ P$E:m @ @ @@!R-EtĶg5Yd˱_&,O]m "@ @ @@ (n? @ @K tElz {"6{D缽FY){]کrK~W)& @ @ @9`7繈 @ @H "iw#<3cܳ6bwT[NW?Um} @ @ 99Hi @ @ @@1Җ^,^MMP{Ñxo"M{ϋ؇m&9$a @ @ 0J_Q™F @ @&J Rڈ-LT[XsW7<:OF}^uR| @ @ d @C @ @'"V|'G\a߽  @@i͏#bĎNiqވ_ֈ.8DۤZ'~ @ @ PH؅mmm-P  @ @ȣ@{ @ @hvTzJ}^VH=k= @ @*'@ @ @ /}_ٿ_Dݽ1 @ @ @  ly @ @ @ZH#bS{v{UwCG8J.RJ2 @ @uP]7J  @ @ @҂#v =~%c9X# @ @ PGuĴ @ @L ^Dz]v.  @ @ @` GLf @ @] u( 'Y"=_#m9F @ @ @`  ǀg* @ @J mwFl{jaލUoS_iǺ @ @V@D @ @ @ MFEd3F.#=5 @ @#P=,C  @ @ @@-i-k-Í@zFiu\R @ @ (zh @ @ @1 Fz1c^g:R" @ @ @`p؃%@ @ @#HT.-W_x u?~^R_ @ @EP]_  @ @ @.i5^^,R'?":iZ @ @_ (S @ @u?<긃 @fH +ןoĴvV&?s_ @ @uJ"@ @"6lHtwwg @@¯F|%ldWvhkC @ @8 {mG @ @H +nuv*J$@ @ @I`7 @ @[ -z~?/ d @ @ 05 @F`ʔ)~63SOʹ5 @H+ϵ~"E`#=s~r}3 @ @uP]DK @ @p@ @@Y޿afJiŷ4?ETJ @ @@뵐u @ @ @@#=4Tk#-j! @ @uP]wR  @ @ @@'#=RO+dNi"-V!s4 @ @P=z;3  @ @ @ iHɸ8ig/vVq) @ @cP=fB  @ @ @@RߖrEnsέɿ > @ @E@v-J @ @ @@!R/F_ HIIY @ @^@$@ @ @ g/8;YJo@ϚrE @ @C (K @ @(@z++n+j{HO|8R(f&@ @ @&51D @ @EH4\w y9nK @ @}`C @ @,=O@nf @ @T@,:  @ @ @wc>Q*brC L @ @/ (K @ @ @e"=ሮe<}?7R @ @tdZ @ @RJhѢӦMC=4ӧA4@{y{/0M@]EqO}ag @ @J Mu!@ @VN8![=- @ 3#=yJp[~igF1 @ @*;'+/ @ @I m{:3]X *Hn.h&@ @ @`o{h @ @ @@aR߶HQ.L@zH[d @ @ȕ\d @ @ @`$OE\4)UEh߇ @ @b t;} @ @ tAq]we=S3m  @9#575% @ @ PV @ @@Q:::s)j&@-#>϶Lm"r~Z[v_6QPB!@ @ @`<s3{ @ @ @H}"=q^DwC T+E> @ @S@v1] @ @(@z#v..l@xR_)!@ @ @x w2&@ @ @@aҲ["K"4u\R @ @V9)q @ @ @RH_:5L&XH+gf4 @ @ȿ  @ @ PxT_F , 9EZVEF @ @@S (n @ @C -2bX"=R)ۯE @ @@n`h%F @ @ahke @ @M'D@ @ @ P/Էu2z-i i[I @ @ g sv!@ @ @Ҝ#@R>i`gv. @ @M"IB @ @ P_fwQJ` ~q @ @ 98D) @ @ @@V nN-!HA @ @ tLо%@ @o=駟|Oh@#~(&M @ @V>= @ @@ tuuŹ瞛oT @Hk~ع8/DIW 5; @ @ZTE6 @ @G n 0KgDokC @ @/v @ @ @qHs.0NنOD1 o  @ @h9-wd&@ @ @"V1+}&FkIy_J @ @@:  @ @@9XfM&e PԷ%v~]H`lKgD:ꏢm  @ @hMs!@ @<GT@ZJ |DﺖYHϜ[G[$-S @ @9hqnR#@ @ @ME,Je:XtMˆ/p @ @ Z @ @ BOPB-@zˑv,,j&@ @ +ع:N @ @ @` G_ےH^В  @ @쬇 @ @@iWZ$Za( liwP @ @  [O @ @" ^M[Ի3: @ @  @ @ @V֋[6Ezs @ @ha-|xB'@ @ @@RH>_iCyF @ @ 'pG.a @ @@w[; ^ ͹(R( @ @(OM @ @(@dIJo4{iJ`%3rd @ @E@vQNZ @ @hqRg/*gZ<xQ -2RZ @ @;0 @ @ @ohaӗxGz&&% @ @wz#@ @+\rIf=ӧAL n4 #d4VXu{c>m鿴Bb$@ @ @,π @Q7̊r쌈@wEDߦO4@ g/l%D @ @΀ @ @4@d[9D@Kgm  @ @7Fm# @ @@zohCe҂wc+P @ @EeWӗ; @]=^d=C3m  @vY# @HWV@ @ @ #0G-Q @>8/^<[ك^ tE{y #h{I. @ @4@{$" @ @ PX(HY|J @ @5`湉 @ @Hݫ"-%G`P#A_$@ @ @9`79 @ @Hs?Qڣ#i8 ˔ @ @@ (n. @ @.6*b̼)?ع8b7 @ @&T@ۜ @ @H)Ez=<(@zH=  @ @4f?! @ @ @H"e,W tF @ @ 0 ' @ @ [ z#ͻbw_+R< @ @4&; @ @ @KfDt--l'@)ۭ @ @ P=6'@ @ @@酫` Fx޽ @ @L ķ5 @ @(^JD "my @ @P=$@ @ @@ڹ4bj{ l}"bթI @ @D ((y @ @ @.4^ !]ig^ @ @ 0^ K> @ P;wiu]] @`4ic}0(@ײM7+g @ @hR&KX @ @%Gľ~L[xI ͽ'H/\qm+% @ @pvc}N @ @H=by}DZ}u @ @ 0 n @ @ PH)Ew F*HkF:x @ @(Qǵ,E @ /0yxޗqxk_ik @e5wFl{ #(uEzd7ax @ @P]/I @ @X @CRk^ 0oE:Sv7 @ @$ޠu-K @ @Xq[ĎR1,rqF @ @  a( @ @ &˅0+}D`#m{f$3%@ @ @N i @ @A` =kh y7  @ @hZ @ @H}[#-/ 0:wGE @ @`D @ @@Z|]DL1aҼ/3k @ @-ޢ#@ @ @}Rƈا_cP" @ @ 0#2 @ @F%]19& 0@Zp%@ @ @ i1 @ @[ lXO{wk P/-DZwwV @ @(k @ @@Z4|α-b6C nK @ @uP]GLK @ @ @@V u)~}SS l{2Y_׊ @ @#{ @ @ P/RwCTnN) 1+ @ @! @ @{T^#(@ZB,Y*و5wMh6'@ @ PE8e9 @ @ l߾=3ߛnih&׽X^ -܂]}$@ @ 0 'R @ @ȩ@ZV֜f'-M,9/b8@ @ @h}ح2 @ @ @@ HMA -G`H @ 0a ' @ @ȧ@Z|&'+ c~ĚBb$@ @ В-  @ @@ xկ~5駟ik @ E˷_=Mhj—#hkkk8G @ @`⩉ @V`q6m|#@Hݫ#X?"s= @ @#hx  @ @ @~Ңk"J}'mf' @ @P]Ö* @ @)zE,[Xl&Y#a, @ @5( @ @^ -|u @`܂=n6"@ @(T  @ @ (Գ!bMZ޺V`ۓ= @ @ 0APt @ @ @]#d4"qa  @ @@`谥J @ @FMnn5 K`룑^Y @ @@`' @ @cX:#b`1F _i&@ @ P(؅:n @ @ @3Ғ껨#m~Z @ @@`ХL @ @ ,fD-g!'^ݸŭL @ @@ tR%@ @ @@=@O_"@~i۳ @ @ !,I @ @4@`w"z4`aK (`7Jֺ @ @E(Rr%@ @_Wm?6mZO@J^i@VE/w @ @i @ Pعsgq~#8 @ %kI "-'r$@ @hZ @ @H)odD(+{UQ' @ @ (;  @ @ su?|>IJ@R_r @ @4V@vc}N @ @ :wG*" ,9R"f.g @ @c  @ @SNzڮ<ʹ5 @@+ M=VNATvF,)ℿA @ @`p @ 0IOjw @ҢkZ:~ @ZrCqGۤ_D @ @Î0 @ @R缈u?eA@^z7DN^ @ @qP=n6"@ @ @@k E׶v'@`HO @ @/{6 @ @ @Rꈕ @ o;Eq޲ @ @ (n(  @ @ /Ȃ@ZtMA @ @  @5@IDAT @H}"\xr+Hmz#@ @ Po @ @&\|_.!@ i[s{#@ @캓Z @ @HHdB%@ @ @ #;áA @ @U3#zVg4ȧ@Z|&&+ @ @uP]gP @ @ @ Oi\J.RڡFxG @ @@Y@ @ @ *6G9I@R_%3r @ @W@v}=F @ @:7G) ,fI @ @Y @ @ao|#83} @R缈?o0G@6EnıQG @ @ 7 ss!@ @fOәPnF h_)@cҒ?(<#֘ J @ @[<~ @ @ @@Rφ߫#@ev,X W @ @[@xۏ @ @.ƈROG)>(Z @ @`J @ @H= }("m}'@ @ &@ @F!p衇FTlkk˴5 @@S =wCS(8Gr v۩Ahۅ @ @܀J%V @h JߖZ @KXHݫa @ @ @4  @ @ PTιEM_-#-w6 @ @ (.O @ @^HK di+ۧE @ @ > @ @*sAA@ߦ3}Z @ @ .? @ @ @"AAR  @ @ {'@ @ @okĊ @۟%@ @ P@ @ @:AZ @ @&:Glla oX53ɋ @ @@U@v @;|}a+ @QewL!@қF?L @ @-""q  @@T%Kdb̴5 @x+;[ك/ l&懣 @ @@܀ @ @v 0 0i݆ @ @*{\mF @ @HKoBw޽ @ @r#БL$B @@`ʔ)O}*I'ik @F -El{X z#V|;^/ @ @P(| @h.8 5WP!@ e,\&@Ҳ# ښ+0 @ @@{ְ @ @4@_$a PX#6¦/q @ @| (ʎ @ @ =UK@ EH @ @uP]F @ @ @9o6G @Yzq @ @ ;ع;R  @ @ PT5}y l?b-* @ @1Z @ @!Ho @ @P  @ @EH}["VQM@ t-pOF'. @ @P=*6 @ @ d+9w/00r  'Ul8b!R1&slϑڨ'Ms9mi#1ImbH)",E`p7ݹefggg=8{d~N}Dx: @ @ ډ @ @Z pk@94WZUI @ @` d  @ @,v?1|KTuH]7Y@ @ @0] @ @Hۮ_:&@TiLjV, @ @ `/&: @ @J &vGVJH@ƶG츯'@ @@guZ  @_ M o;h@"f[N d%_.* @ @& m @ 022~z7XH9 )Xw#/&  @ @OvDE @ @X@|"bKkrH]qb @ @U ^5 @ @Gӯq )p' @ @.!( @ @HS{#z7,6  η  @ @Rs @X pqō76E]` @E=ӣ- & '0ƛ>ؾ2 @ @h G @쌏F=E m-y$!@@4hsJC H @ @H" @ @N ,b[P$S`f"vf @ @@K `S0 @ @d/@@i& @ @@3 @ @HcݞjWh# > @ @h8B @ @1=d!@@i72.4 @ @ `gg+2 @ @Z.] @  ZR @ @0= @ @ @iֈGۘQ*d(0=sk &@ @ l\E%@ @ @@ZS@)5r @ @X @ @Hi:&Y =iYg @ @@K `S0 @ @d$0pox_F%@@~i`/3 @ @J `D= @ @h@꺡#@@ff&۔L @ @0zC @ @ @1pw9'@@n;g' @ @X@ro @X\`jj*6oܴ .3<Xa#M-  P&8e*Y @ @50]: @^`я~)^ԧY @^O`Hc}XszjW1 @ @@:jױ  @ @ P"4D/JTR  oF @ @h춓KH @ @ xҭ$@݀  @ @j#`6GQ @ @&G#z6l @`eFu @ @6 t1T @ @'xblݺN;imA,{[ȒH 7D  @ @T\vX{ @ ^FguV{FDEZ %'֪m @ @K\媖 @ @H|G# @ @@ `pF @ @@}R׍m^Z u[< @ @@ `TH @ @@RJ]7լk @W?e @ @ +`G0 @ @j+롈m_)~ @ @,`ȧ6 @ @j)`Ǯi t),5 @ @.Q( @ @ir8NXWܧ"@ @ P@<% @ @ Pc"f@> O @ @@Q `dE @ @@-R׿ղoM @5pS^  @ @0 @ @H#/F =>轵'@ @(b @ @@f 2H]7.w @ @$`;'xi  @ @ P ^f? @ @ P բ @ Pz>. Y @?b5] @@R8םA @ @0]P  @_`bb"ꪦF֯_oIĂ^O u}.FߊtΕh`W?  @ @_q @ @ @ir8SN}:[ @ @+`޲ @ @ @}Ǧ+ p@A @ @(@gQ  @(@шSO=5k4- @ &@!#MDCް$@ @ ~7 @*,p'Ǝ;*ܡ @iՈG[V<TK`z43>QtC @ PJRVh @ @TEtd*2 @ @`e+ @ @Z- @{5{ @ @@ `K @ @@"F_RKz!@@7g_t @ @K0$[ @ @ @fa$@@eRMMc @ @0]R) @ @HcU# @ ^4dIA @ @`q؋x @ @ 1'" @˧ThE @(B  @ @@꺩J5DD @ @؇X @ @ @ k4>ӈOj LF ]tE @ P إ8&E @ @ P)["tZ )}@;"@ @h0aE @ @R2!*-0poݕnQs @ @0]ܳQ @ @H#q;(&#zomcB @ @Z-"@ @ @@sH@:4:  @ @,fY"@ @M_E\veM, @)o׳y] @CODr4NX @ @8x @,O`zz:x>7- @oXWN  @ @8@. @ @J uԪP @@E @ @ . @ @Hc}wԳy] @ +ї# >Utq  @ @@^u @X@ggg|nwݺuMk w#kڼ  Sk/. @ @0}% @Xq7n\M @@ER*ڙ @ﭑr4:ι  @ @"QFI @ @Į[J//-0{{ݣ @ @ %`Pǡ @ @*)sKDdk"@@RME(C  @ @50]& @ @ o\fA`HCuT @ @0]CP @ @HFy E轣 @ @kpZ$@ @ @ ?L kԭV  @ @0 @ @T_;Q(G".B%j @ @ @ @O =1R~L G/u;q @ @r0  @ @A umH=7 @ @TWvuVg @ @(tD+5lհq- @ @Sv;"@ @ @>;Q~uJnO.Q( @ PYؕ=Z @ @ <&@=߉R 4O @ l}E'@ @ @iz4S ;2 01h Q @ @@U `WdE @ݻ7N8ᄦ믿>Z$%@7GL˱  PoBP= @ @ kY O @SSS30.]w @ _#L[ @ @0]٣ @ @y];# pP`j(bǖ+ @ @hr F @ @@z6D3 @@K @ @K[ @ @ c=6/6  Pmj7;E`໑&qR:  @ @J"`$L @(1]bUI-HF = @ f#7F @ @ t,w @ @ @`Y=,k @N D'@ @Z  @ @B |;b @Jv>i|Jv @ @0,. @ @ @`yiو/&  @ c[3!< @ @@ `K @ @@&;V'z:Aw @ @*`Pk @ @D疕Z`HdE| @ @ ak @ @lce\TX$zC @ @ `SxA @ @ Fw @@[=fI @ @0]( @ @Y4{[$@V <𳭊& @ @@ `@ @ @R`;W @v)'@ @6  @ @F |' @@kznRkcF @ PKصlS38#֮]t͂*"0pwHE/0~:$@ @T3 @&o߾x׻aÆ1E%-R.QJ%@ @(" @ @(@qoT ,$@ @ |7s @ @"7Ě @ [JVr  @ @&`h' @ @J!z7NE @!}#Lrђ @ @:N @ @H|lٲiy״ @ ];/#: @@Du^ @ @-0D! @ @A:*.䒃K @@UHUN_@%+$@ @d%БU`q  @ @ PU󝪶/C`໑գW] @ @\vI$@ @ @i7bUnQoh/ @ @+05 @ @ P_ sTD RNA @ n @ @R l_ Pz["M  @ @_ve$@ @ @i{.i&@&4ѷ @ @^= @ @k?@꽥Rh @ @=,  @ @0WC |(W&@ @ pDG$ @ @i#>*%0{[:  @ @@7 @ @  B  p&@ @8# y @ @sr @* XO; @ @@F3 @ @=?ط: zok^[ @ @8@a @ L7t_{n5 (@PUKH=.  @ @+`gs @@`ll,⊦^{& PQKxhJ&@2<ih2n @ @um\ @ @X@z*bKjY?)驝 @ Vm喌 @ @ [Vz  @`w r  @ @@ `L @ @RJdeJ/0H  @ @d/Й}  @ @@}N:njx͚5Mk (cc=%*X *tsXU7 @ @T_:$@ @6 a/>\t *ԻU!@H @]vG @ @(LDE,MM #}> @ @TDvER @ @X`#-*]G @_vg @ @ (z6*% @@fB @ @r . @ @ TDD /HL @ @'`;?{  @ @("&w:u @@ק dL,< @ @K}|'@ @ @ {ka$@^JI @ Х$@ @ @if*Sq Td/0r=?>  @ @0]cS4 @ @ z br0 @@9|B9I @ @< `.' @ @H6 @@zooc2 @ @$`LV @ @2H3}2!8D`+~XbI @ NԖ @ @b ?bj5&SF- @ @TV @ @ccc}O~q7] @b +湨 qsK/1 @ @@1 `\TE @%n}{& S LDo*fq"@|o4T4xa>e%@ @(@G!R @ @-{S*\#G @AvR @ @ P<v; @EJ( @ @(C @ @q75vڦO MG l.^a*"@ƺ"XkQ @ @@! `A @U8gJ; @@}v1>%0) 2 @ Pe*77 @ @,E`nXTH)-7 @ @%`^[ @ @HwrՒ,z|/  @ @,`Χw @ @"v1=BV ~I @ P9k @ @ :׹8DH)rђ @ @xz&@ @ @@.  pd' @ @ k @ @Ev1wѷA .&@ @  @ @0H秀%wGu @ @0]3 @ @KHw-a- @Wc]CO @ @h @ @@mv~/bjom8L ݾE @ Pؕ9J @ @ kn9^ @@ @ @ @ P?431pW1^`+Г# @ @@i `N @ @v|/bjxŷ-S}'@ @3@ @Z(o߾ 60P w{+ˆAu{Go @ @@' @ @u333)`ڂH3w[ Pn푆/,w'@ @X'`M @ @V`S{J[  @Sq @ @ `;t)  @ @O ޑ_r  @:}~T0uB @X@M @N裏??ir94- @ ?43ѿ9d&@5ҞET' @ @,Il"@ @KXfM\wuKl_`CSC+#TR n') @ @:w  @ @ Pw{u /wg5 @ @N.! @ @y4ѷ)r @@UF_4LU @ @"q @ @ z8brwŚ-z}Bg ? @ @-. @ @>rKJ QG1~ @IDAT @ pC@,  @ @@J3}ט @ }/D|u @ @mF- @ @ ~4bbGn%&@  @ @= @ @@2WS#LqB% @ @vn @ @&R3 @@ >i4E @ @9~ @ @}Qw @נ @ @n $ @ @%z e//$nSz%@ @Zk>o~ 7ėLr ӟ4fff.Էl$@ @('TN2 4/qTZ  @ @V `{hnY\E|_?0}), g?Eu @$o߾-{ltvM(h@z*bM٤!@ }Y  @ @UzkΝ;+\WR֭[Wr{ @ ޽{Ol3)8,.o~s'@ @(@껣\*!0ag  @ @bq;  @)f͚׿Too7- @M- 4 >i| Ǟtق @ @:sm뮋iwꩧƕW^sz饗bfff>y / @Y裏??͹  @ 1  @ ѷ1Cn)  @ @!ю$rTK|q{Y.n:~nak/ @ @_! @C9KM @^7l??8~~=~uYgEg$@ @0槀rp8\ː @ @ SٸV:y{}{s_}x裏ƃ>jl߾=֮]x;|_|űnݺ{ @ @@eO۠ @i:sskU! @ @ `/ +LK5ŧ?xͽػwol۶-u]W\qE|c}K]LNNFJ4%=b0 @ @/wqh@}0bU @ @0]sP2b|||{gb/&&&k_Z|ߏ*N>Ŷ.zd<Ӌ'oDOO^ @ @A`n]`&qr/E @ @0ZO /&˚5k77=yO\p1T_~9yx'?3qW_ @ @:iwЯ{Pu: N MF >VL @ px؇nnT)_W㬳j>7}]w?-[K.M- @ @* пMh"> @ @ P>;~w??fza+]vY|_x)暘nfA @ P~A7_ @0;4=ZrB @ On(m{zr憰7o<́v]]]qg.9̺ubdd_~&'g?Z @ @@ݏ-D @39%-[m @ @(JW!h4 m 57(쫯zI\z饱eLE @ ^MR{sF #(y @ P.rZ+8tzn @ @@uRߝiF' P#LT @ @'`![֦^wݴ @ @@+l uyšiZ MEzhq @-> @ @#`;wYsصkWS38imA @V%\kO}SM, @O4 @}JCvk0E!@ @@vA K[n%bpp0>e]۶mkڷnݺ @ @@y| @ oO4GD @ @,]ҭ,I'zLX>gٴ @ @(@q_9W5C`rwG#tq=% @ @O{8sΙ'?I=-+͛w38c~ @ @@Ď @@RuhS @ @Z1ɹZ>\]tۓwwOĞcWW?̿ @8?q_b @!CX @ o:?+ @ @`؋^;>|uͿǗvG?Kqϯ @ @@+:::bSw~r)L!,H3w/%(XOĞ Z @ @#й(sW\qE({{,枎=FFF矏gy&枀}묳Ί???' @ @@v>1]j"CM& @ @{lnꫯ|+3Ĉٯ={Ľ޻hz׻ n|ɋ @ @@R*X Pob tO @@GzBM.¸ӟt={Xvb\'@ @(@JKVr  @/G~'@ @TAfЈ-0cjl۶-FMo>;K/-[4圫kݺuM, @ @V'v=?X]w @v 8;| @ @-la,&07p}袋rCb @ @ ;ۗL& *_[) @ @ \JJ @ @U`V "{) @ @Bv+ @ @ @{ioN @@#VIC @Ev. @ @ ׫s/+X @ @V+`{'@ @ @ڟSF *'#*8 @ @m0fp @ @X@|ľW @ o( @ b+s# @ @o% @VzE @h@g;E @.011\sMS]vY\pM, @`ΕN PGkR: @ @(`{P @ @__5m= `7X @`i៬<;  @@QtDw#xQ*R @ @:6 @ @/з1T@Z$SZ)  @ @ . @ @+HWN(#M. @ @VayI @/f͚X}QG-?; @5i|g^s PZ| @ @*YM @8餓bY7$ @RhJ @ @@<'? @ @H+҉6 @#L.% @ @@ `G @ @@ም @# @ @@ `WpF @ @2;)ʴ P ^ @ @.`'> @ @`@Hi-j @ P%U:M @ @@رiJ`b b  @ @%0]R& @ @ ?bz_m8C oG$@ @T@vQ  @ @,` ʧ78  @ @b . @ @@R'@25iV @ @r . @ @@1=$@ @ZvGq @ @-6@ P+ԿVj @ PVe=9u @ @A:  @O#vpO @ @ .( @ @@ZB  P?P31 @ P:U` @ P`5U}..Ҧk pddHv @@~5! @ @@ `W4B @ LMMƍG>Ҵ @% 7}Ļl#@|,Įhrz @ @@:*ܛ @ @(@eJZ  @jf"7&{  @ @201 @ @@ӯW@TNA @@g5 @GਣiJimAGHdTV`Fybe[ @ @|zj'@ @ . @Li| b2V ZE壭+ @ @@K:ZE @ @JHU!@i<6E @ @50]& @ @Me)U @ ;{#Lf_d @ @ ^1  @ @h@VO`jćW  @ @50]C" @ @/bf4*d)S! @ r+s' @ @-H}[Q8 Pb͑R*qJ'@ @TSv5UW @ @J'f&#v[L2tf&@ @X앹 @ @V ~pGJ-7~ @ @(`' @ @%0`VCS2d/g;{d @ @03BM 􈺝~  @ @ .ޙ @ @@-RZ&  @wEJ1E#@ @XeqL @ @@+쓯wۊPb @z Faz- @ @` v !@ @ P ]GL עUM @V ~"jS @ @0-{  @ @h@ܒ8 @Z =Zs4 @ P؅9  @ @V  @#GR H @ 4Ks @ @ F(0 @1SM^ @ @@ `@ @ @FXN[ @ߔUhq  @ @ `@&@ @ @Z *R`H;kٺ  @ @y '@ @ P#刑רc @R]Y @ @0y[ @ @2RJ+4uꩧI't͂\5NZ-f6_ZV< @ @#xM @#022ׯo曗^TZ ot#@myѶ @ @  @ @"&vE >ޖ\ @ŽG^-Z$ @ @Htj!@ @ Pev7SFcN*g2HͰD\X.) Z (TR[)_R-nDE+&3!?"JXBwYoi3l̻9s>yr {  Pu{ڐ @  O  @ @TI@XmC%Pl$leK @@K= @ȕ?S9wqQ h_ш˙TV+{P}N @ 0*{ @@KKKoBV @@:n.!@.PzD첻Z @ 0@d  @ @ P.Ra P!?g+kY @ @ 'vK @ @@d(Z,CH6<8[ @ @@e`Wժ @ @l;ckw @UbUk @ @L {] @ @O ),)bV"@&vB @ @(E  @ @(*pA*%WlyR[ @ @`1.  @ @(@MwQ @ Nܯ @ @ i1 @ @RONyh @ $~VP @ @`?g @ @2 (+3 @TE2a @ @ @ @ @`@[X{= @@eY۪ @ @ G)\ @ @ PVҲ.g1 @`z'A @ 0+سs3 @ @ $% '@*%P1Jn] @ @a  @ @@?ajŋa @@M=M @ #bd/6 @ @r";')  @Ȇ@OOO{`*) BcEPoC*I 54`gXC @H9GH @ @$%D @K0i) @ @'zv"@ @ I2Qlk\%I2)d$E @ȃ< @ @dI,E$ xFxg.c @ @j-UF @ @,XWNeGG.(ˏ@酗AB$@ @ԟ;3 @ @@bpB#@@ K- @)ɖѴSN3H @ 0s @ @L,l|(bc%@+EUn @ @@(n( @ @*Ta[ @#=L @ @f,{dn @ @ @`2ē6'O/y{$  @ @9P @ @j $ňTk; @ $˧e @ @` gf: @ @ZIu @vZۓ @Ȼ켟 @ @TI ).N!@[,n" @ @ 72 @ @iL30 Pu+  @ @yPӕ @ @j RC@ ),lS  @ @P=q @ @HKc P#5- @ S9=Xi @ @@ E[} @ dfz @ @(F7 @ @)}wD_vN6`ׄݦ @ @@>Z򙖬 @ @@mz{{.Km~9 @@<# K$`.s @ @ -n? @ȵ@___|OxG+Nh ;OݑJr(#-D܅9LNJ @ @ 4Ww; @ @ 'dӣSJr!@(77 @ @(ض"@ @ ;OݑJ+79 @ @(RŽlE @r/-J`T[yH K\ @@:ndps4͙ @ @`ZZZ-oyK;, @@] t".C4 0@)ػ3$ @ @[`o @A`]w뮻 +YHJY> @@.J?^wMR @ @J4WbQk @ @ 39;P @1d1.  @ @P=1 @ @"pH @y(9; @ @*#@ @ COJt @ @ '1@ @ @@I ).A]H6=K @ @",!@ @ O3|&'+ @9ϵ] @ @L*{R @ @Dm!A4@RXYJ @ 0{س7 @ @ (Jho$߯ @ @ %;šA @ @Vd7c֦ @@:#ޝ,G @YZ @ @@NnܔEL$#@ @`= @ @_ʂh4v%@ @f.{f @ @  eI l|(MqM @ m@4  @ @H @@# GXxr&@ @f {X @ @6lMMM}kfPx3@RXZlC @Oyn&@ @ PQW8ȶ@Hf;F @ @j(&@ @ Edf141 @H#oN @ @ԥ<6A @ @@[oèS# @ P+Zml_ @ Gsƿ˿R?T[YPphjީ ق @ P_ DK @yoo3 0@2)'!@C``}Dʈ}^ʒ @ 05 @ @ t1ԛ,Gl@R\L!@ @4;s @ @T@դ4 @@ Z/g @ @C@v B @ @d(ʑ'"4 @ P %K @ @` DuL1 pEOn30 @ 0iL @ @ 8hY @$3m* @ @1`79˒ @ @O  `oHz!N] @ @4 2L @ @ODl|R# 0#$[2f$f2 @ ?c @ @^@aFf @HР'/m @ @`2ؓ'@ @ @Iaie+U @`F+"-& @ @,;ϧ+7 @ @!s;fB42uI @ @&P=> @ @$б<"hJP )  @ @hoj2#@ @{'aoOYH KX @, `YLL @ @ (:  @ @ 6m?>UW]~S}Ȋ@ FߔpAdU`HM{YP\ @ @ 4Wm' @ @ =_Dwg/. @y v @ @ -n? @ @H K3P @, !˧#6 @ @ m/ @ @Y$ˬx @@vɖg @ @Uh>!@ @ !0o޼;R~᩶"l|8bӣY G @@="]P @ P10 @49sNhL@= xu=  @@MhR]39 @ P{ڇ  @ @j!Zk=  @z5  @ @P=kB  @ @?+  @ FtRN @  @ @DmjM  @HޢQ'(z @ @` g+~ @ @u(N dCId#Q @ @j $@ @ PKd?Z`o @:0R@IDAT3; @ @`V gf @ @u(ug: \ @@VM#+'! @ @ knO @ @5H5 @@.>c @ c w] @ @W~O @ #~IS F @ @ ( @ @T `D5 @@N4 @ @ ( @ @Y||b'@YH^  @ PEUĶ @ @Z $TY#?ȏ@#ؘ|dB @Ng @ 繁'tRuQ> B X{w-' GD @T@4 @ @l_|qƫJvJD ol{ @(]IvVF @ @S$@ @ @ 7) @@YW uI @ @.;'$> @ @eH{#:Va%K @uF{LK @ @@`eH @ @ H @.-e'  @ q`ߍueKx @ @`jv-R_z׻( [- @{FC  @ @@# d./ַƲebhhE @ Ps̉_MMMu ȍ@AvnR" @ k'x @ @Lv)-[5\zj,Z(>%oa @ @ _=ʑ`J޾ @ @@ 2U=6gy&>G||+_k׎ @ @P=J @Hmczn%@ @M 3͛?9hmmI @ @ @9QY"@*$uG$+e  @ @LC=wSNڲeK|ߏO?=>w]DEC @ @ CIo1b/3P @\ $725I @ @yYUh--[O=T\~qGO>;2稣ŋǗt @ @ )Plkȴ%MT_[7onG @ @6)Ї7M׿K.$.\8vJ{ /0Xti h @ @hDӖ3 P #I?Zۓ @@& {qWO?K,>;veSF{{{?AqqAq?. @ @4@2%FJY @@-"e&@ @TE [ZZZOk6֬YW]uUUSRKs8㕯|e|_!@ @ (E nnlId@72pB @ @*.P7c%cx~{ @ @"Ou^S @NL @ @ Zf8?;::n'>z_z|{ߋO}S| sUm @ PA-[__vx{'xbOPTqb @ $hzL< @ -޸qc?|;q7DZ>?='`ĥ^{o\}4v5 @.kRs_*Nh P Dv5AL$н2ѴM4 @ PuU=000Ruiכ7oZZZSO .  @ @I ٲ&bݯ)d @yHԾ @ @`{̙x+RSgT[(< @j*P)hj)  @ @xtvvu]7RtrieGb}K.3ф3<3Jk vA @W`޼yQzj% Zmo_ @ E @ @ w)>s믏i_;8cѢEΟn‚ #x`tj ۇ @ @@ t10 ?[9``eD @Df o)ϟoy[WUTHwǦ @ @ATCȄ@#>PA @(@f 'KTl]*._T]Oۏ=ҥboأ. @ @D Ib[D+L @ d#ѴOU @ @@c d??w^)`?E| @ @.ވ5e_ւ @(=[ @Ȧ@f we8sFv}'Gsss͛ox @ @TB ) 8 @2$ `7vQ"  @ @`)~衇b  @ @UI @@Iw4g  @ @`V{4aV:IXjUƿNa @ @)lY ^ @@~MOf @ @@C d/}itA#_v/zыCO?=.*"@ @ b[fB @`@  @ @d%իWG_lan|kR} @ @] ){ '@*~S$CԜ5Wiy @ @U+ RK?S @ @zH7GtViȫE @4@ xxGSǺ; @ @^㖈-u @ $Eoʌ @4@UuUWEgg町===~{|sm"IBݺpq}: @ @Գz>= @( `IV @ @@R]*G>ݖ˗/W?{wuQ^z @ @`T`ӦMq1njKgNi @\{r-g @@e6?Ƈi*U  @ @Uh^~cj=N;4 @ @`6CCC㏧6l0%K*0 @,C @ȁ@U _rя~4Vۗ @ @@ELq( P~V$@ @j!RM__^{[Y&F^:x^ozӛ8 @ @(_"&@SuE{5f&@ @r#PؕW^95{]]]#CЇD @ @L qb<#Sm K y&bZ: @ Eq @ @ TX @^`ܹ/~8gY @ $hR  @hLL[ @ @_TC+ UȂ%@ @l+'`w}144ڱ{m @ @H7Gt6% @Gtϫ X! @ @&LA4qz  @ @/qKP~= @ Ѥ;$< @ @`* @ @ M4 0@m  @ @P @ @IDC͏GzT @ @ Z&-c>x衇R+~c=6wgS}hVbYk @ @_E @(cʽ @ @Uxʕ+{I%~0.5/_]]]u @ @ H2"@M )FaK @h@ @ @@ , @ZH8T?ظq~ @ @(i$@ԯ@2VϩDN @4@ ipg @ @FH  @< tP45B @4@ P @ @`T Im.vme]R}d`SD;r{ @Xug>^l""@ @L!<Ř! @ @`7n=y|;3\tL"qKP$  @'wf"&@ @"`S@ @ @N(A ~b5 @ `oٲ%# @ @ P>$I"(J @@66!e#Q @ @S Sy{l̟??vuNe˖MyA @ @u##&\ @[кSM$@ @dA% AlK_R,Y$JSF׽.V\_fM|5믿>s  @ P ? ZO5 #¤as PIqi4u  @ @#G/:;;G";wn Esu_tE㊯=[o5^WcvX @U%;Ｒi1=ҟ @ wGM;E @M`|Us 3s-.≮oWqu<qN4 @ @@#66q  cC7ح"@ @@ 3؛7o=1000K  @ @u!uqL$@v\ )xǎ빓 @@K7l/~Q(R/yKϏ#<2-իS}'tR뮻_>=Xt/| ׿~ @ @@=(HS# 0+#ꏦf  @ @LToy[ꫯ-;x׎m\_y啩{\wuq衇FGGȜ˗ƍcA @ @ ۳ @0;X5D @@s֝ѲqsƷTAاZ_W13vK.nm @ @@:VD e>L @f+f  @ @UD]wI&|ܹsGc/Xzخ8SN8al3|T[ @ @@"etFUZ,F @@& b*;.hm/z)Ek֬I5 @ @dU I"< 2#. @=OD^z @ @ d#!jml[^{ŋNI]~6l0 @ @@v2= Pnrh= @ @@2Q$I*T{kcrʭ͑'|r47OO? @ @*ǿ . Pr8Z @˕7 ^T{͚5Ɗ+bSO=u?zvj @ @Z ( ؟ڻ##@ @H ?Ig?)q 7mƢERm  @ @YHz,&& @@ߜ[l&@ @^eK~m/pP믿>,N$wEwwh_O6xӛsI'~; @(@OOOy晩oX | @ )~s$C}  @ @DvpJ.N8aI؇zh,Y$5N;[T_o?5}, @ @ Ed`cDϳ @]c @ @ }eNc=6ѵW\>\rIﾩ뮻.>TF5y֦ @ @+б"S{>"#@*.[iV| @ @vD 3Onjj(=zq'M;:^W_=N @ @YH Y I< @ ` @ @*'`.\zk{q 7Lh79o.2n/~׿?cqc: @ @@ϟ?pj @`{d(}N7 O'#h|'+ @ @2U],jժF6m~x}җtRv-:( q'?bΜ9c @S9^sIk hkhK/Pz+.z @ @ d{!־o~3^Ǟ{=!@ @ )8\hC ߋ @ @ s-Qғ} @ @ԭ@I> @oIz;i>4 @ @hT4!@ @ Ul` @ $v&@ @dB@v&A @ @m @$Eo @Ȉ0 @ @(0g @H$@ @VOM⡇g}6zzz/iѷ0L @ @ΟWc; @,0~G,G)6 @ @2YƗذa<"@ @(#/zV"@D&99Mi @ @|dwqCW @ @STXC 0@a`@ @ @6͵v];<%@ @ȱ@ Er @T$n%@ @W 3mmmY @ @@=;"# @6Rw @ @ L[Ov?~\ve''q衇7O @ @zH   @H ` @ @`{2Q+WL{ 7/{R @ @ 7+^TR @XHzۣit @ @-;#Fsonn)>CF\ @ @zmTzz8=1@v%@ԍ@Ql8u@  @ @ 4g!իW(=ZuD @ @ ~ד PfMe @ (JI' @ @*Z󚚼 @X`oy״ @ @`Zv߲ @3(iZ @ @D… OM-G. @ @M I#o[Z!@TV`3Me: @ @`L`b?8jwwwh @ @ tߕ$D`W @ @).=ooF7w @ @$yIE @ =6#@ @&Lv)7#a&I裏믿>֬Y> @ @(*9J_E[v$@ @@KV$ /0o G-ʞ;wn,Z(9䐘?ds @ @r $H @ mxy˘ @Ȅ@f :7y䑑)'$@ @ ebk @ SM 3N$@ @yhkb"@ @ U;g#. @N:ndpK+L @ @ o v!@ @ȴ@ҿ6{ec @ C=f>L @ @hJZrJlذ!+ሃ @ @@eo5Vfm @HV@K @Ȋ@f 暬 @ @@JB> @e(aK @ @f.<[A @ @$CwV @l+l$~m6 @ @yv3 @@OOOy晩.8R}4@X۠K P~E8 [ @ 0)p  @ @ 7ߜsI5h\ڸ˜ P W/JlM @ @͓ @ @ @Oh!@("ٲ Z @ 0@]<{hh(;G׾th\sMzꩱ{ @ @ Pkdu'@O/󗗌 @ @ d'o~v 7nܘ====.8#R @ @---qi8Sm T z&@*, eIv-O @d@|/<;usdW׿>R}yMyA @ P.]w5.]ZC@JA> @54g^$ @ @`@ 3ό+WvUVf ?(yE4 @ @TK E @z#:nXxFc-[ @ @f5y{{{ oxÔ;wO׶إ$I/j  @ @@Ut  @Y )xQ#  @ @@2U]zJwܑ2y⩧|3SN9%oŋ^#ן'g\ @ @H  @(.y0Sc#Ȟ @@f ׾T'|r/}KqYgA߶x;K/45f͚W @ @ Pid?cy> @ dO @TM 3؟ԧbhװ/G?qWDc?_~y rM @ @]o|P=N : @ P-L`Eksa]`A?w}V]g'xb @ @@UZ @(.EA @@& W\6<7qG%.:?xA @ @=9Xti'LJ>93?V.袞L7 @ @ 4=Ѿz0 @ID @ @`)>]zW*[o5ƏK,I]㠃;#5dIi @ @(@0Z @~)q @ @@{?|3~1 Mx“ կDn3 @ @%GB'O+W$\.W(>KElI`ĉ1}԰sرcS} @ @@m $+fGq @U$;ȍ"* @ P-uY o}k#8bCu]cʔ)z)-@ @ S)=i @@?Q @ @`` d;;o\sM3whO|3)& @ @@8S#@("i]VE @(gaq%_wuW<1cƌ{q|y晱nm4F @ @r $oD,[X @I{Ģ{~3#@ @H 룯38Y߷jժXti477cĈ @ @ Я6'@H $ S#;E @l@UV-㎑8 @ @dI ipB 줣-ruUkQ @Ȩ@]F @ @HD,yb, @ږG,}Ӕ  @ PYؕ @ @@ ,~0V @jU  @ @l d][ ,^YdIAo1":6lX6UEE @ 0).g  @B紃PI @T@& <@q}/E\.p@L0!&NbȐ![g @ @R $I8Z @k^dRf  @ @@k… +믿>ZZZzu;_R'?v)≮KbZ @ @*OF4n& @Q e4 @Xu5k_b>~żbŊC/| o; @ @TB iZmA GA @(@şvZ<%J!Lkkk|߈;3nONh @ @@:::K7) @  PsKgFҲ$rv$D @T^͋O>y_DwM{{ȑ# =#/-[V,Y$zx׺NMq1=&LH] @ @XzuL]ϿiҤI] PCڿFSCI PID=ϭD @TXb_@p /wG\pAuY1bĈnloČ3⦛n*Z'I8r,]4ǬYb]8%@ @ P"/e @eHFNvY-N @@]mgώ3g'?_5jT|)SĜ9s6Jg…|~ @ @J!/q @T#i_W  @Ⱥ@E |7A@IDATwřgYxѵvx_ϠARӧN/bO @ @ $+"<˘O P MWb'{ @ @5.P_nHm},T_)]tQ ><;rI]sB @!ǴiRK?> @PBR!@Զ@05rTIʎ @(@89).1rhjj*n{s=;S'guV(./ʞ?~ PN'S[̝;7Ǝ @ @_㙏E,d@qu'>WIJ @(@]7x衇RO.gu~/~/cٲevB @ @`k=bѽ[ @h?UzW @ @5&P ]r~G!Z^J5 @ @YK6!@ @}d3 j?Q @@){je-_ @ @`+*^=cƌ @ @I iRMን @I[Nr {e @ x6v @ PCe˖R2dHA@ 4*;'l @!֥vǹJ @l  @ @Æ +#@#V0O P=ވ7YխI @Ԡ@] $% @ @|- @vo;ݻ+3 @ Pz?oGnE @ @PS!h @K`}tFn @ @@ {U!T @ @imUDN- @h[䑈NdC @E,Z @ @@,?V @&) @ P"@ @ P @Ԯ@Mf @ @@I`b @ @$$j)% @lJy^$+  @ @EE ' @ @6XDDk @5+0fS @ P:إ @ @@ $ pjJ yQ\%@ @ } @ @ؔM'@Ԧ#i~6s @ P2% @ @@- $^XR-$ @4N(c @ @,{| @ @lF7 @f?콕 @(@} @ S~wq> /4N~"$@(GҶ:r;~m+ @ @5!&n$ @ @ +q 7™0a씈 $G,@EH PzG|_׶" @ Pu5$ @ @R`=%\Z @U$4LhJ @TZ@vG @ yarc  @@$i/&@ @Y; @Ț@]]]xjk mf;H @W)b;X @JUyM @Yajx"@'K~Ѿ'#!@aaJ` @@]ߧI @ @6 @B @ @@ wK @ 0$h:32 @F_d u @ @d?y,_!@ @ 3 @@%[C4 @ @ #)?#Gs9'M! @ @@H [-O @@=g @ 02Sgonn[o5N9;vl\ze` @ @@ @X:3u @ @~TvWUW]tPs10-[us @ @%HּrNֳ @@-$D@ @P 3o&z'ⓟd5*:묘:ujor  @ @z-׽63 0 K) @ @L??bĉQW}X_"N=3fL|_9s<77X @ @F%@ pF<O @tҹ 矀}ƴib޼y=9Moƌ?>&Lcҥ @ @M $"fl~ @,о&A @X//|!?O?gc=:$u>k֬袋bԨQ8L1 @ @6)8-:k. @ lq= @ dv?ַzL<9F~q=DGGG% @ @^:򖷤>~{IֶeXpD2-nY @Z֔Z @ @[/}֯[ƍ_җC,X 'Ő!C6%~{WZ@ @ @?={vL}4@T6 @jhR @(@}2{G}ٱ;ǠA׿&__~yGK/}g] wi+z>q+FZ*z衘7o^{pq ';J @Դ@ԚNOr @%X|$_~X"Q @ @ŋ]wwqGL>=֮]*7}kqG]]?z??я"ķ|!|ȿ'?IXoy~l6ݎI @ Ld f&@@䈽?yf @ @5%P'gqG{{fo̮{nI9'`w=E۟g[n%r\{ /Buo|e]I˒ ڥ3#@ @jP tYk֬Y']vmظp>By#G|0N;?{1| Xpaj;wygT~:>鿿k&둏/Ǿ[ldĉ?ܹscر] @ @,k$Q؞ @r0rϩK @PktW^y%?4 &ozذaO|"xxgK.bu>N8!nT˖-/էʕ+㪫~_o<='?Fw6*_{ߋ]vS~߮+ @ 0:_ @ [[TzKf< @9,edɒ/Yxc=~wigqF_ܗ}o(NWN6xGF#E]_+_|1OE_s9ۯon5_|zH;{O~2vqǍ @ @™seJ(#i_mtY @ @#'`uY1jԨ cKO"|1gtA/vt/pM7ť^*u] sLqR G)]O.Ї>TxRu9~ť <9 E{&ǔ³>[\v+od}-^{mK]'@ @jX@L \ @*!85$r)؃ @@& nj~7_4[#__DweroYtAq)Ą *ҥKȑ#[:c=C-[Ë}N @ @!tD䟀 @ Wu ˟~t_W0 @b`ovqYgvQWWW1>Wlj(4:VZں7ػ{jEzU}뭷ƼyRkt+Vn> @ @?<Ѷ?#7 @@ ߪS]wR  @ @)~cw}f (իW2dHjڵkS-5a;s`  @ PQ| @V <[ @ @c`S$Ibܹ1uԸkYذ{=yРAͩ @ 0@ DI PVUGnaq @ @ )>Ccхwi^{ũgdk[ +onG @ PK#RJr!@OoWO}{ @ @~L bϊ+J2tZ_Smr;::R5OCzwm:'@ @@֮]]?%[Bl@@f&@H 2šA @@W\2u3͛~xOz  %\cñ;ot|,[l ;.xgBņ2 @@ߡ;S*n!&M @`m  @5*HZDn.5 @ @jg^z)ARmؚu֥mQGW_We @ @@? $k^Xl?n[ @|[kԈfz"@ @HvI_K,6W3?~ꪫ7{5I644/~ 7|2pkmnk @ @@ 4L$@ 5-+9Y-!@ @eHv(K/q"w_?>ve?~|^sϨΧ tB6lXOG @Ԁ@pw d! @ ,z fHB @ P`O4)nƘ9sfy᪟ԧbmhò(0hРa.\0`;6~5 @=n?Aj??T^ iiXolG @|#8s! @ PHvc„ 'W+_J\ve~e7n\s)=N @ PJ~("@Ec K5 @l$4L\t @ @ZHv﨣|3qmukq$kCwܱq[{l9C⤓N|[zmoGymfbo.CƏ_(h.h2~{zit| @m}]Ģk;I @@∥3#v>; @ P]fD ͍1bDo/`Ϟ=g;Ｓ' @ @`,}D4  @K[WK޾ @ @ +onn“Ou3]^xa׭['=k---s9gq: @ @PSVf @L 4NT8!@ @'[+OaÆxS`̘1<s\ַЗ/~ O^/97oJ @Ը@m[0Ƴ @@&Vɪ#G @ @@2S=zei8묳bԨQqWڵk ?|?ftI]G @ԪY- @&lY+!@ @%+$PAwqa v磏>:n8쳻 @]MNf @H3s7E@ @ @ װvAW_-<5ƌSMnĉ1}Ԟs΍cǦ4 @ @ t{#h\ݶ @ @@ 6&@ @ P-kK,ʖ$@ CMpa @ @@ (;&^ @ @ ,?ec\%@ Pfoe)3  @ @@? ޶&@ @5';SO=kرH.V'@ ѓ @ @U&np  @ @ uuuqGd;Ha-qZ g(5 @hg"7 Y @ @@z6( @ @U hD۲*T @AY]# @ D?ꫯ^{-3?2@ @ @J+V#@JwEo[ @ @@^&f͚`gV @ Pzɥ_ӊ @*Hּu @ @ e0&! @ @@g @ ,[ @ʛۑ @ @ –2Z @`k[kh> @Ț@}:X @ @` (l'@dS`㑬[f3>Q @ @({O~^e @ @$k^X\oK @BID㔈1Wh? @ @+'@ @ Pv^^vc @Y i& @ @P{"" @ @^ $ {If8 @@%?IJh/ @ @ ˈki @ @ $G,}ف @@_:E,#@ @2&;c7D8 @ @h9!$  @TV Y- @(@}2 @x---o}+{x[ޒ @tI-f% @h'mK @*%P_|ϧ+Oy晱bŊT_9SN-Dz$@ @uť^u]`D4N i[*J @KmYDӌ]YK @TH؏=X̚5+%\jw_455mԯ @ @&ѱn] @ %)-  @@]fD @ @ »3 @ParF @dY@v @ @* ]?uu]7RЙH:"|$@ Ph~=N @ @/w'pB3&j~zZj~ @ @֭JzfD-EN 0 #7  @ @@ꫯ-ңq @ @ $ w @ P} ;ߪ/n @ @E@.R8!@ @*U`  @V=W` @ @U,o  @ @U YTD  @]\ @ } @ @@5 $ wWcb&@ Po @ P  @ 00<1p`wY @jE`H5J6 @ @N2nkk^{-^xW^m6FQzq\# @ @@/Ez3M!@ $aJ؏f% q @ @tvSSS\s5quի{n&M /0Fݣ9 @ @T»(X @^ |KNv8z  @ @@_j7._sYhQ\y啅5۳ @ @(4(#i @YXP$m+X @ @ d^}7.XbExX[[[awdɒ!@ @:yaIJU  @l$xF: @ @ d{ڵ~0/^I\.{Go-|vmM_1cFzꩽzft @ @v&@ Pbow)1 @ @@2U}ƟR?co_~9E .Yf>f͚xg?Y?~3gΌ .`~ @ @%,- @ ,7 @ @@U d[no938#{vB @J-sgZ.N:)էA@uq}ڇ @Ȯ@-/1wHd @ @`cL`3]y睽...y2rȸ;xG?x≘;wno. @Zoڮ~] @0A @Drȵe5G,! @ PjL+JuF [{䟀=iҤ2<@A @ }}]ĢT @z+tfogO @@& ϟ"xߞjoMOMSm  @ @*XG P! @@m/W3 @@}m׬YFّGjoMcbKnr @ @ l69rs\$@`I[d @j{  @ @DQR/btA6:::RSw}T[ @R`~KZH @@ y5/r;RIJ @Ԏ@]R?~|*3f[Ә3gNjqRm  @ @ 4!)A  @V 4ܵ N @TJ &Lѷ~{\$7xcq!C{b  @ @@(ٿI"$@jdF @@& ~/K/yIr2yo~SzN;Tl;!@ @wWAB$@ +_$k^EL'@ @*! /0;bο3L]כiӦ9icǎk7KK @ g"s'@ P!Om @ @ d;wGyd1뮻.gw---͝|sS]#@ @Șװg @I]e] @ @@iK̦W/ҦlpewN+"^{ƍ7ͅ[/^8E_?hР kg}v @ @@d @Kdݢ ޭK[ @(@.}z*sرcS} @ @/EߖѮ @ !ddA @jTF @ @@ ,3? @^ $k3 @ @@`WZ~ @ @=Px#& @jM`#i]QkYɇ @Ԕ@}yÇ/6'@ @!ej(# @@ވ=?  @ @({u]WG @ P = @@) @ @u @ @z+,]oO @v:|dB @jL@vP @ @@ Z*F?ߠN֥MTY%@ PB/႖"@ @J)P_ŬE @@$pڵkSm  05:A. @mqjm'); @ P]7N @ @ZHVS @ 4L&H @ PAS /e]VAZ[ @ @V i˿jN3 @@ 6E4ͨdD @j@>9444ļybժUmmm݆sQ+ }c֬Y_~yk$@ @4hP| _H-ualF`}͛ @#;Lnw eJ @D sO\s5vT%G$@ @ <8 @I84 @5(pw$_\ @^L`/Z(N>x駫WT @ @}H:Z"iI @jRyA?F kM') @ PuY |0F+Vxbԩ1}hoo/[n].<]8  @ @@#arb  @L~)EnAG @ @@D.<bڵ1lذhmm-},~6lS{c̘1_q?x|#^zp)O?ƍp6 L8G];wn;ks @ @@X$ҥ) @r}%r}q}W @ @y髮*U|8zӰǜ"vw13g,\/_<>w7T @5@IDAT @@@B @ Mߋf3ZQ @ @DyRbw9շqqǭ?x1"~_E}}}aG-uB @ ! J2t7B 5#Y37kQ @ XL`/[,u9Tk,6W\jQG{W^ye  @ @@6D4@? @@5&C7C( @ 02Y=nܸMޗ8 uOSacҤIŮ?֬YSl;!@ @d @d\ i]# @8(2dHJ|vK6͘={vac-v[.yb  @ @@ޕ @ @ KgF!A  @ L`.)E]Ol6Ů-`><Zϝ @ @@լ~; @H"bU)A @ @@ d{ $IsM}VZL#0zR$@(@IZ @l@& ;T?pac}-v+rb{Óx7k׮-;!@ @[^mVmGfwL.!@ PvG"ii*66 @ @6/qƥj}-7AT{oɜ9s"?f% @ @5s#V@D@ @Z)8  @ @@ d;{I'O ;bž'G}tf\s5nݺT?-|g}Rm  @ @~~- @@5 $ N @jB 3؟g#Qg̘GuT؟?y{C-=<;oG$qWǯ~] S @ @~H~o{ۘ @@ ,~ UU  @ @@-: $x|lm]䟊6CKf?1bD|Ʌ>hN]?~|̞=;2SwO6&NӧOO%3w;vlO @hkk.]TzG^{U ˊ@u ܿ>fb @ 䎸9r>PH @2U|̙3'u{ƍJo޼y{G==NrJOGO f @ 0dDX%@ P"gDݑh1 @ @ԣwy6mZL0!>jcƌn)7]GZuw2 @ @H_H @I{s' t @ P*S=:BqZ?麻#H}ݱ;twя~4~_N @ @O iihz3 @jh_jB @ @j2Wrqٳ_ /p'|rzh{qG.H @PIڈETΒ%@ PVEKe @ @@Z MMMq5u]WNGn&M /0FQ?{WU yONe X"SSbZ/X--ߨVg:NN[q|uӪ D$BJD $(X1H$䞜sXI^~ywֳȓ  @ @.ឺokC @,0f>b @ @@ZrStttW_Ϗkvcܹ3>X;cxx8%ʉ @ P: @,myT8 @ @hkްaCE/Oy܏zohh@߉ݻwu @ @H#;& @(@ֈue\ @ @a Ǯ]p*J~qgiӦO~Wmjժ8i @ @*c!xɒ%X_|q/\3 P:]E M/ۗK @&!0ʜ'T @ @`:jꪫG=WUO|".x ^fkk^n]|'=P\qpu @ Pm?΄4`gD (0C @@-x55 ., @ p@ˡ5l?+Wƚ5kCwqҗ4.xos9'kѢEbŊ5 @ @ 4od @eEzu @ @  _B%q=ěg{<-ԧM @ P?SA @:SڣW8 @4@  ?G?x'|r~1ϩ~Dze<W1|شiӯI @ P u@ @m3 @ @$Gy$S_cO/+2fժU @ٳc˖-jn!B "Q%K @]ODY!S4 @(@.nݚq{_Og׽.|? @ @Z T*x ^N\`D)C @ )pj @ @'Cuf̽w鄳 @ @`I$L%@ 0={z~V @ @ 3Ofd~陱 @ @@ 4`Wh @t>\4$@ @-;/Sի3 g @ @HFmMpQ  @8ydW  @ @@rр}%K,W̯q;~ @ @Nkg+2 @gH?-  @ @* {/iÆ ?RJצ;ŋ/㤓NA @ PCmk\h @(б.R#r @@nxk_;^cX_̏+V9l޼y}n2!%@ @@x4S\m @) @<@n+J,[,./ooė~?hmoS8̙s @ @TI m[VH @ 0Y{d @ @I Nj&򓟌 6Lx)~3L\pqg㬳:t]vwΝq}39?~ؽ @ @5ضA$@ @`B{cϘt @ @ TgrK&7K.~xrj80s"79V\IwӦM1o޼5 @ Ьi㑾f-O] @ !P9sQ9CU @ @h-EKX @ @H @@ mKpJ$@ @ hnm  @ @M+ѣiVa @س&R%,U @ PZz饗Ɯ9sj @ @ ww\w؟}A u,k}JU# @ wD)= @ P<7`K_*  @ @__2=\ v{S8 @EHˢHG&W @(@KA& @ @@<| @ȉG؝dA @G@vJ @ @ H#9؜ @p;' @ P j @@Rsf8N8؀@ liKS @ ^9EM_ @ @ h~G{^iӦسgOݻ7N<8|O?8|g̟??ؒ"@ @={vl޼ U!#G @ uoQas @ LmN)ҥKk~cMO?t'>`\uUҒo@ @ P}Գ)G," @HCű @ewݻ.;4gj?֮]Go|clݺ3\"@ @6O` @(ob4 @ @5`?.(VX1ӹxE<#ӎ% @ @3 hxfw @4\`תH OC @ @YZTHGGG~l4#|f̘gyf̟?w``ܧz*bxxU{w]O>@ @ 0=Ի9cXM @@`Ďx{k @ @DjЇ>ׯ?MozS\s5qGkS:dO:?Gσ>7n+",YrU?  @ @"о*a!@ @viW4`Xd @(@K^]vmz뭙t=Xr+_gl[4֘}%ĝwW>`K.5k|o @ @*m( @ n!: @(@n +V_OWg~k_ˌ  @ @'zF{xzA&@ @#;S}@ @J  ӿT*`;w.Ms̉EŬY׎;::~ @ @LSӯ h9 @ x{MD @-x ƥ[T\tEqW/u֍ @ @YM @;4.[׽mF @H  O=T|ef<^YiӦ؀ @ @`j=bS[l @qW# @h2\4`ر#[[tҀ=Mk  @ @ l @A /-Br$@ @EvJ)t)ds:%@ @U @ P@+# u0q) @ @e/{YFGɌ3Xn]fi @ @j k^;bȅ@r$ @H_X`* @ p@1>+*]6y{^fl@ @)0<<k֬Ʉܾ}QՇ@ /(Vf+Q= @U`m63YS @@.=8cNj{2خ]SrKf^؀ @ @`c > @T`ݑ  @ @@rр\pF{{{i4(}#'xbO5\Ksq|,X`<؏+"36 @ @3;Lر7?h*eL/7b @P`63K @4^2ڬZ=ogT9M'J%sH;#>{>q8餓2 T[o~s\2vӦM1v @ #u k5 @(@qQyƨP^ @ @) '100pX9w^\r%qg[ZZb:]n]?:}0O~NO}JT!@ @*оlCY  @Q /Հ]ă3 @4\__ŷ8c3̙3 _B\}Փ_l @ @ac > @4# u7I1 @ @]X}{cڵwc?A|cr  @ @~-G}"@ @#;W @ @6` myҥKGEŪUbݺu1<<|---W"^ƟٟE]ty. @ @LQхi-#@ @ coGyLMN @ @ m؅^c߱OWWWݻ|GFF9y΁Yg'x⯖' @ @@R*G @ ;PwTZOhx* @ @EMvggg۷/͛vgώx  @ @{MpQ  @hHoݸ33 @N%/_>;7ƍ7yIM @ @$ @4@j_ڄU) @N  ؽ1րRUV?xPE&@ @@j_2& @ P wGT  @ @h~衇bΝȌ  @ @#E}1ە @ F\Q}@ @D  ׯ?u{a\ @ @hellK @%k+ @ @ 0?]s @ @}I7# @ع2PW} @(@.;|î@ @.1cF=iˏ3 @ @IF"v|IQ @@. _L_3c @ P8R*J$p@ïB @@S xMS @ @hnmm s,XkQ @ @Y@FmG @;4؛ @B  cR]tQw}q}_Wq7ƺu뢣c @ @H["=TMD'@ @ ?#O>2!@ @9hK^>h ׾Xt~_?4O;xы^guV̘1cD|ߜT @ @f͚2.؀@a&_ @ 0m4 38 @ @fO |s{y*9)uڠqo~cʕ6m\3 @ @yYyOS~ @TS嘨Qyr5E @JQ  @ @@URӚ") @ Dl`IK @W@v}F @(k} @(@r  @ @`Y㉯ykƻO @ 0Ծd"!@ @v}7ྨ̜ӌթ @L[ 7 ˗/v1 @ @L_ < @b mwD_ @ @-5/< @ @@nh'&_ @UH\PuS  @ @y4`7Y @ PԾ*q!@ @4H @N@vlE&@ @N uo|pyK @* mwT9p @ @9rрo߾ذaC7* @ @Eh_RM @@ʠ @ @@6ŋ㦛n5kDww4f̘sN/ . >ǩڈI @(@j[\ʺM @v?RΨ:7]"@ @.\x++W7_p_>nxK_7"TR9 @ @Nii7 @ m  @ @@ڀ}UWŻؾ}ܽ{wy7NhI @ @SzYE @%OWm @ 0U֩.x=PtISa @H[.SO\3 K%LKR @4P`ڣr L @ @ _uyOg>sg̘c!z)/yKbl|O<y[ @ @tww%\.[u͹9 <@|,g @eHKZ  @ @Ҁ}W7n{7֯_]]]qwh>xo9~C/ @ @LSkŧ h9 @&Hޖħ4 @@bfϞwkO?=scߍG}4wd W5 @ @*x] @ ФԻIS @@W^cM/oo|'xf;.so> @ @HE>U" @ |틛& @ @) Nq݄=s΍k4xЇ _100s5? @ @@^?3s9 xxND> @'ږD_b2"@ @ yO?)5yM̜93sh+"Ӏ=|=ք}Em{ @ @!3f̈׽u ۦ"Rh_2 @ P&E^XJ @(rīUޞ6;lʶm @ @oZB @@  @ @5o<{s̉N8!3#36 @ @@j[U;sӀ @ @`b1cbs"@ @@j[ā @^ ##OR:STMgJij "@ @H @h_2i& @ @fyv3㩍 @ PT42펢/o @%н!RǏ}  @ @@.4`$A @U{꼩 @hԶP @)YH @(➝  @4\}I @ @@4`7J޾ @ @ ᾈw6hw @ Px,| @ @SЀ=U9 @ @Eywf/o @r :98) @ @@4`7 @ @]  @hHԣ @ 0 I5 @xW7!=5HC];j%@ @YvD~ĩ, @LX .| Mܸqcfŋ'\+_DG @&-G3뮻:  lψ`s @C  q @ @I Խ{1T>f  @ ,}q @-my_TZf6: @ @ u7 @ @4L yO1 @M&07bת&+J9 @ @4`? @ @}:]E @B ݖ<$A @)ZE @]OL3fȌ 4J -j%@ @Yi7*3k E @y%Kﰍ] @ @*0sf-M]H#vH @\ wE+?ez"@ @yܹsk @ @h_2:{d2+%@ @޶Sр=!+ @ @9Z U @ @M v @ @`;49V @ @ h.؁I @ 0YTľ'| @LL`d b5 @4&8D% @ @*ж$@ @tug @ @@4`J @@j_4U @ @`Կk L%@ @Ѐ]ܳ9 @ @YFY@ @ D/^  @ @@A4`䠤I @@j멸YC @}gfV @ @@14`dM @@3 @`Ӎb= @Ƚ  @ @SHFbj"@ @T%ЩYC @Ѐ]- @ @` 5 @HmF  @ k ع> @ @&HD'MM* @,Ǒ~6 @ @"!I9 @ @ŕW^Iwl׿>s̀@v?{ͷ @Hm ?1 @h Ms !@ @< ƷL*c3$ukx!@ @@CnЀz @ @@}Z곍] @ @%F"-v!@ @@Vgc}k׌ @ @@ hnT  @ @#:` @ @amQ1 @@k7 @I`ƌO=؀@RZo!> @.ж8OT*3>] @ P@ <4) @ @@~?xG̚^ qWש@ @r.0#b'*= @ 0y/ @ @ mz#@ @<mQyU) @J@v[ @ @@ hphV @ l[i@ K @LL@Ĝ"@ @^ uo  @%ع$* @$LV @ @ڗ75 @B W @ @`"'d @ @ pHR$@ P6+" > ۇ @4&:L @ @H=OE{*'@ @ #ۗ37Y @ @) h"e @ @\ -U:!@ @??  @ @I4`7A* @(@j[Xn @ _]ߋԿ=Ɍ @LR@$L'@ @M u<DҒ @G`$S@ @M$S) @ @@9 [ @ @`q9d zd͟@jĵ$@ @m  @ @@ZH @ @ bdd$6lؐ̌ TK ElZ!@ @@mz<#: @'`Xx @ @@v1f&@ @@ŧڢ @ @@#4`7Bݞ @ @*T! @@H#CuV @ @)" @(1G2/{2cH{#vF(1 @ P?=8N @ @ * @[`֬YFP}}ڗEe @TQ m] U @-R G @ 0} @~gFlO @ P Ua @ P?Ի9bmh' @TS`7bՌ( @rی @ PEU" @'.lv&@ @Ѐ=M@  @ @H[o#@ @@uv{ucF @$Nж!@ @TC u<ѵ @ @@F"ݧ&@ @h @ @: xumG @@f @ @@4`Xx @ @@RjaC @@:~2 @ @ h @ @F 7b`Gv/ @.nzL  @ @@4`ZX| @ @@[I @D`H)$i @ @ hY')@IDAT @ @ w44 @ @}["zX  @ @@-4`RWl @ @@ƚ{M @F m97H @LD@D!@ @{mݻ3 63 >Mw @ PdmG+rr'@ @ h.ف+ @j+zj`n*z m:H @@I:#v|+ @(&g @ @\mF)Wͪ%@ @TSV, @ /G @ @[D @ PvwG]v @ @@A4`䠤I @S _X9W5 @HCKSJ  @ @^ @ @ g{lp ^We&#< @ @co  @ @<s*%@ @:̜93>a'[A [P  @ Hr‹h @ @\ :; @ @,2  @ -T#W. @ )&i @ @ c!@ @@FR*UɊ%@ @ h.ޙɘ @(@v{ *U" @}:b.I @';g"# @ @hn @(@rSjV0 @K@vK @ @@I[JR2  @ pۀp!  @ @@~4`,dB @8 #vK @~g9kW5 @B@v!I @ @@n-7d @ @`惇~ @ @\ hqH @ 0z  @(FQn @ @@n4`h$F @Q u>2f @Z G-/ @ # 9:  @ @o @V>o @S@v>EV @ @@ R}Vd @A` A @4Z ؟ @4P}ݙ?833 Q`'b`oH @2 -7EeTL @9ЀÑ @O7~~/u]W^ye @ 0[#Q̘dS @ @@}Z곍] @ @ @ @$GZ5E @ @ h @ @ @ 0 i @T_@vME$@ @ @ @j lvjE @L[u @ @N8X~x؀ @HD҈y6E @ @ h @ PBxK^RʕL @j'~+*k,2 @LJeRM&@ @ @ @`~ @ @" @ @ @I m)Oȅ @J,ćt @ @ @F`-R*L%@ @Ѐݼg2 @ @ @4@{V7O=*!@ @ h.I @ @ @H[o*W%@ @\ hH @(@*Cj$@ @@ڗE^< @ @4`O @ @t6}} @L\`+bo& @ I @x64m @ p@C @ @ h @ @R%A @SH= @ P Ua @ 0q'L @ l9;6"@ @uЀ]Gl[ @ @_ @!tBa) @@WZH @&000OqEeW`/zn{*'@ @@5zس:⹯F41 @ @4`Od @ ptk2͛;#RXu+7  @ P[Qр]I! @ @`-]`> @ @_5V @ @-4_ @ @Nm @ @/G~ @!0<|=ڄC @-Z G @YRĜ9s2%s1Ayo7"~ @ @i72j @U@Qy$@ @={vݻwr.@J)o* @uس:RSQ9mi# @ Ђ @ @I bG7 @J&TK @Ѐ? @ P o*E$@ @@co!@ @Ѐ]/i @ @=)m '@ @@Mz}M @,`  @ @5zjYH @H[ @ @uЀ]7j @ @etu @ @>ۖG^v!@ @ h. @ @Z [M @#}9 @ @h M @ @ t}cUYKW7 @*6/~6#@ @ h.٫ @@߫. @ @uA @j.6 @ @*p޲n @] m캣ې @%Ѐ]CW2 @ Pn}6  @R`-Fh @ @ h) @ @@YwvDז|u @ @1;#vhv%@ @h.Q+ @@718\-E @i @ @5.8 @(@oooT<.5ƪ/R @ȣS:=ɉ @@@v @ @ ?CCCqwgz׻ޕ4@ 1㧛P @ @ imD[ox򘝜 @ @ Z% @ @r%{rd @ P6yAJV/ @Q@vmE @4Hot/T @ȳ@"}0ʍ @ ,ZܥN @r'oy[2y͝;736hnE @Hos.-@R$@ @ h.ډɗ @r-pq]wݕ%W[S D'@ @ /tJ7 @LPeL#@ @x 2m @pwh @jG @V?J[  @ ;yAr @_@vP @ @@ptpo2 @ {0RC? @ @@54`WCQ  @ @a - @MSv"!@ @@4` U@ @@ ) @ @a[o42xe @ @T4`OU: @ @ owA @yL"^xaflP|Ek"u @ @cOʒVl @ ZO @8cꫯ>芟(uf,KM @(@Hߨ<<5 @&RH @ @J 0-ѿz} *U" @X`7mQ4 @ZM @4;T @ PJR֭h @@ @D FZe @ @:&/Ry @ P  صP @hJ%#7em"@ @@(cj&@ @i h& @ @@ymeyU) @ ж(Pw*U# @TQ@v1"@ @W`ɶￛ@ @ @]mr5 @ @44`OR @ @<]׍>:^ @ @,i7R:  @ @J)  @ мi`0y T @,H,v @IN @OgC1| @%HO{ vIZ @0 B @4@nF @m # us @ @Ѐ=!& @ @ nhU?.k&@ @@9G/.G$@ @i N; @ @H<gqF̙3's͠8]׭HW @ 05Q9S[l @JKu܊%@ @Z twwǹ瞛vmV E @r%б6R7 L$C @ hH @h@ϲbdGG޽Ubq ( (ъmGE=SܭvGԞS=[nU^\0rD$@BB !$+~k~'+mIʺs'7}'f, @E ^]B @Ѐ= @ PCypw[ @ @@i/siI @%;[! @ @ #~tFC @@+b%  @V-K @dP`֬YqwVd7blD|*K @@Zh9o @ @4`7ݑ* @)^{ũĮ@WlA @|2o?]&@ @'( @ @p7'a @ @@UF߂C @Ѐ=y @ @=߹+ @ 9p  @ [ ػe1I @U`1sE-_ @ 0*0, @ @n4`$ @ PTo.ɫ @ # @ ( @ @S7=< @Dt/  @ ]HL @ @EC:i @ U l? @ ]M @ @=\ @ [n4yL @ @@q4`UN @ 0zf\ @ @@ʃk+< @Ѐ]aD @Tһ Z  @ @`"H)M= @(r  @ @][zwa @-xg @ @1  @ @@QzH}CE-_ @ =p @$VbJ @j-0<<]w]EO>9Ν[1g-ܓdC @pWѲkl @ @!.( @4@]EyW\q l :JϭVR!@ @ #/Zb @4BA$@ @dE2oYȃ @h~r))J @#>΢ @ @(}>̤D @'KKB @ P 7 @Ȉ@?(34 @ @ iտg=E @ @@C @ PWUyz8A6H\~o6 @C`zFˁ#_Y @ @@M4`ׄզ @ Pd9sbdme|n( @4L`--oV L @hm| 2 @ @_һTD @ȿ# @ @4`O΃ @ @@^k&@ @F " &@ @ hnO @_һ"RH @!V] @%{Zl"@ @*P~M @Y~&_f!9 @ @@4`7]H @ @q>q L @M!-Mq @ @4`OC @ @@^/+˛ @$m7d)# @ @@4` Z @ @.E  @ @ ס @)y @ȫ@w5uy @ @@+#6b @ @@4`K @+PZ9ny*'@ @ p{# @dZ@vGr @ @@z._1bΠ}u * @F`--wAaU( @.?'@ @ Ǽy*<5`W}]*" @G`"hwSJ  @ P`׮t @ @CO P  @ @a#kkXx  @ @- @ PgoY @ @@Ҫ+"TL @ b @ @ ܹs+"̞=blP?{ @+B+?)  @ P 9Z<@oJ8C㏏wq*}~(SqGL9 @ @`OZt鞖_'Nф!@ @ Ev O @@4`kQp̟??m . >^{53g}v|zC @ v_zW>% @4{#.izTA @hIq_r\|6_>>44W^ye|3цj^xa!@ @Yq  @ @@mҪ+j]  @ @ 3ހO"^xaOڵkqqǎŎ s΍o|r|' @ 1p+Q @h"RW"X @Quǁk{kƖ̙3'.袊7;참K>UѸ=697ơ:;%@ @ t(? @hbr^W4 @Ѐg` Ϗ=}C1k֬Ǧbpp0Ƕ8Ǯ] @ @@ʝ{FP= @4VwiW~D'@ @ hmm裏Vwb{遁뮻3X|y-4`Q @ @@z/R` @ @@c @ @kd{/^x#<29䐱xgώc9f… Ǯgr /={G=6vA @H[nǿUT9 @TE"XlB @Ѐt6>X~sű;dʕc3Xt mmmcc @ P\< r @Ȑ@ oqH @UеZEfު#6o9 lꎞVwS @ @jm8jf @Ȁ BRR /PAvAsLh#ǝw^xal ~wmoXo@ @jxꩧ*ڴiSؠ=volG @ Phр]I[ @ @ HCYhiiHq`RҶ{qꩧn{Kwi1'?T{122R1g@ @H|&/k @(+Gy @Y'lPxk8۫GS6aqhѢmmܸ1֬YGuԤ9cppp.]]]]s{| @@ߏ~#k7OY @ @z l{ ]Xp @ @@ 4`IM3mG7`bŊ)5`k_T3LjE @4{G* ;wnؠ]^ F @j!H9ZSI @uЀ]G<ڹi{v& w3 @oꫯ4cbKk  @ @@ߏ8SUF @ Ƅ5o~xeÆ .a絳gϞ\8ZÎ͛z=\ @ @ ]$i˙ @ *V^\*h&@ @@yjRI gر^t<Ș5k֤M6Ul׾bl@ @(y%nz8_I˖ @-0&ۊmz @4@[Ԡ: 5k%KL:ŋ־oho9lq)Imzu> @ _([  @ @irYM @ff9:qI'E}u]6Lc7]OUzU̟??x'bgX{QGU  @ @ ?$,S @ ]`c:~}O @ȡZR?hm-ܲTF{x߾}8?gϞwسobc.V\wq-׾vl @%{QWҲ%@ @)^ @Xݴ9.B3gNmo 6ڀOwxꩧn>S|Rߝ8MqYgm{n5;^ ###cӟ'Ʈ] @ @@FuJZ @ @`Gn߾k @ȑVRm\nkkۖ`qڣ>hg}C>qwm˟Gyh56=N?x'OŻx86vA @QZ>_I˖ @T#W1c@ @N+ q<.?~%@|ӟ;.N/I>5 @QHsόwuM @9ЀCZ3=5&>;9Xnݶ}:;;{wN8a[ٳ] @d[`1pߢl'); @ 0ڈם> @ @@Z3Tr$w#.mjg}vŕW^W3}5\ܣosGǙg_|q̙3ge  @ @ ]ޞ,H @&'V^W- @2#В~2Dr)P*_8#}=к3caÆXjU^:ZZZc=v[.uKdk`yys @ 05 [bQw`ijfxa S'ҽ] @ @@ h95*$@ @@ 5Q-Ji@[[[̝;w۷A)lk>b{I'5* q  @ M`ppBbVelix @P 7 MxJ"@ @>_ @ @@c^yu΢•0 @ @_Fk @ # 9:, @ @ ~QSM @M.^vW< @4:O @ @H)E?nD @ @d[@vGv @ @?y,JK @4@9ҋ5sj#@ @@S 5U5!@ @ oK.mo{[`j]yĬ&@ @\ ?3eٹL_ @("Z  @ @{w|y|\(媓 @,0~Uџ,  @ \d)I @ @~]cW4 @ +V~'RTN @hIɓ @LzcpV. @Z``m&P< @ ;$G @ P@n( X  @ @o| @ @ sqL$@ @(wF Uj  @ @@o"mZȂ @2,;Ç#5 @ PTyF(j&@ @ \@ @ȶl @ @@pt_t{V0 @ظ`?L^<6tA @Ѐ  @(@Ⱥ; @ @b Vl @ @ 3|8R#@ @EH)E׹l @ @]i`ݮf @ @~ @ @ D ?۾}O @ P\Teŭ_ @Ȱ  @ @@:Ϲh% @/~eC @ ЀvA  @ @[?vic @ P\RwD[  @ Q%- @ K/~QqvXŜ]ܶ @ PpD]p  @ @ ;s2!@ @&w\qя~bΠR`xK7I# @ @ bp}ĺ"^! @ ֌!  @Ⱦ@IDAT @$b\` @ @Ҋ"4w @ @- @ 򾝧  @ @=K"6޳}O @h @ @vG3 @L(?}7  @ @~m % @h~8 B:ꨊo=}]pE @^H[-sx @ @@4`׍Z  @(@kkko-BUQ^6!@ @._-'T @2/К %H @4@.E?iE @j"]dk @ @4`OJ @ @>#k6UqG[ @ @H+.l"UH @ hI @4@J):uk3& @ P[u7E_Sv'@ @ 4`O& @ P ~bk{ @ @HH/~kT @2.;$= @ Ќ߼R @@# mO,Q @ @` ػ @ @j)01Z7 @hnU7w#@ @@4`gpF @Q󬛛,5 @ @ "zS0 @ ~ @ @ zy  @4mF @, hȍ @4_7ف* @*^8`Cs @EЀ]SW3 @hsk_5  @ @I_X{}, @dW@vvFf @ @:ϞQNMUb @ @@Ҋ #F!> @ %VjK @j,044^xaE}q 'TmPZr^he @^ňu?xkK @& @`|s*|v9E. @ @@u"?-ZZZ] @ @`B I @Ȇ-ݟp @ @ ,xqoA @Ѐ]]O @ @; t]𓈁f  @ @j ۇ @".̂ @ @@bokkq]ݗ]W+ @h@^y1E%@ @@ Vr  @ @@M^W=oG;"uo @@Z~Nw0  @ @`Tr @ @@M=}5as @ @`M #u<ÄK @Zړ @K @ @@ 1P @(b  @ @@Muޏk @ @n6.nn"@ @j h} @ @1Dα  @ @~o/H @(  @ @@-ptsk-C؛ @H`O= @y @Ucd]o!@ @&^8n"@ @@4`K @j(J#yF5 @ 0)#,R @ @`je5 @ 0@ʍp @@ @Ѐ]W. @@~TK @LU`#S @ @4`m @ @`r7<e'* @ @id[ϭ} @ P0 ;p @ @Zr9:vS-' @ 05G_= @(@Ց  @: A @UGgۛ䊺=Њq YNR @ PG:3Ѳd @ @kjO @(Y⡇*D<O*D$@ @M!PhyӷE @ @Q ,. @ _ѷ_o[  @ @@Qڿi`}QW7 @"*6!@ @H feV- @hַ`  @ Ѐ0z  @ @@>F~/?g&@ @"گԿ @LS@4 @ 0@ķ%@ @">gQțq-yHU @ @@56.Hjj/ @4:N @ @@w8sƌw](o>6 @ @'jK\ @@kC @D`dswtd+M @ @Uֆ @h r @ @U-:m @ @< 習ǴL @h  @ @ w#YY @ @|<҆;j  @ c 9>< @ @j t~HC~ @ @@)s  @ P[ ص; @ȍ|%J @XgIĺ8  @ ? ;3 @ @t~#5ۦ @ @@>ҳ"󙼬  @ P# 5- @ȓТU{ÃyJY @ @@=WE_UHb @ @ 7ssT%@ @#ʩvL @V -f/q @T[@vEG @r&0rt  @ @ ;u ' @.;'$? @ Pc_['@ @._ixKː? @"*6!@ @L^ @ @@J["-?~D"@ @@2 @ @@RJf͚:8*0͵LoYȁ @B`w"h\+I @Jk%k_ @(@OOOyn!/߬dn"@ @2(P &&% @W@v}E#@ @HC I @ @h6R3K @h.A+ @(}=Qz\ @ @&!P' @4=[ @ @ 7I @ @6=. @*֬ @4B`o"'X1n[iO @X =hqR'@ @4`OΓ @ @`8vȆ-u< @ @ t2wG!k&@ @Z  @ @ l#.o  @ @H}9R*g/1 @ @k l{ @ F < @ @ ,Xsmޫ? @,{d @ @8󚈒RdM @)~=H_6 @j$F%@ @YxhI,$ @ @GxI3T @LZ@,$@ @  @ @L Dܘ%G @j h @ @@zoz8Y̤D @4HOehRA @h5 @ @ i[>MN6 @ EYt%J @hg  @ @@/;J7d/s @LBmk,!@ @&)P*[oXַ5^Wz#Kc @ @.8  @4f8E5 @ @@fN+~s <\p-C؛ @ 0@{ċD{k!@ @@Zs  @ @RJ]Ӭ! @ @iy_oP @ P' u @CcW/# @ @Fz"-!@ @@4`N @vHCkwrM @h@5m\|  @ P#k[ @ PH<0V^]QAT1ՠWj}  @ @S(Gz 6,'@ @@4`g|dG @9hii#8Ygϯ{\  @ @ H/-oen @ @ OyJV @ @:p]4K @h@Zϑ @h @TW@vu=F @.0{u+  @ @`R"V͛R @  y8%9 @ @ :>݈4 @ @ HΎ4J @Ѐ]G @ @s -( @ @`HK: @ @ |:r#@ @^=  @ @h*Rע %$ @LO@G @(@k V/ @ȣГ+yL] @ @zDb @ @ 3x(R"@ @; l=v6&@ @^ -=++C @G)Y @ ~xEYfU:sS}z @ @@>JrpI>% @Ѐ] @ PM<0֮][-]}^]lD @Ȥk"?$E @Zw&@ @%?JJ6 @ @gΈ5ٖ @zڍ @TM`hѪΪg# @ @@XL(9 @ hs@ @2*"J @ PW# RmI @ h @ @@zY >\ @ @ -R.R$ @Ѐ]ܳW9 @dT:I @ Pc5FxAlO @ h'  @ @@M|(YmJ @ȃ@zHi$ʑ @ h.+ @+0ԋ}=MPf @ @zt/XuE="A @) h2 @ @@mRNNH6J @ȑ@ZH/(c @ P E9iu @ @@z._C.|$@ @Eiəu % @"{*Z @ @ lFۖ @ S#m/K @fЀݬ'. @ȕ@WEҗ%K @@zH#% @&%{RL @ @ t^vL @ȳ@ߊHsr'@ @ښ @ @ )R>?48a?  @ @v'H0Ze9 @&/6V @ @{9~uD9-=+~?{nl @ @#-|pi ؚ @" xvO_ @ PuKc\Hc߶bW=  @ @v'H9 @X@ m@ @~+v @ @ai?EjX|  @h^ {*#@ @: \@:G @ @`k#=2I @a @ @!0aKtwc+Ό7U%T  @ @$~u3 wUS= LO-Tu]'Ωsyw.PM4 @tv'  @ @fTvW;L@ @ }xQsnp @!е}L @lC`Kcgl* @ @D`H}%S @nu @4I`jU_w4i @ @f$nF @c @ }FTv @ @B O&[19  @h36[P @ @@=Mh& @ @ tf~;  @ I@? @ 0ekc>;B @ 2?- @v{. @ @)yW# 5qVS @ @C ||z e  @:T@C^ @ 0sΏo$@ @hDoTC^ @LG @)0hEٻ  @ @m#旑V6h @ `7l @ P`4UcO4:Q.N @ PH| g9  @찀 @:U`'-M @h/H )Uګ/ @ p @A`Esۡ= @ @l'@ @v toU."@ @,P?%!U"ŭF[֜s@ @ Uy> R @) @Z-Ԓ5UHLkk?1s @ @r"&#-Lj1J}NVE @r-ЕG @Z,0?~*LO @ P"-xC08 @# >k @@y}< @ @r)zjY.T @-n( @(R|%*X @ @ 3DoF6$ @$N @K`˿.v8;^TsccϚc @ @9_ҳi"@ @ yX5 @ @@&3iVu @ @@*ҲDA1J @ @ ]y,JM @ @UX/ELL @ @X H  @ W켮 @ @%}EK6) @ @@N*c-Ry<') @< `i5B @-9- @ @9%ҢI1 @ @ OyZ  @ @@D?~e @ @ KisX @hv+M @HrKQE= @ @ȏ@ZHc+SJ @hv˗@ @ j2O @ GɾH )X @hv MI @8 @ @ ]/. @ 얰 @ P^ǞQIy(G  @ @y z/sj#@ @IM6  @K =}%ʫ0 @ @T EZH9OY @4K@Y!@ @\ x^fAjR  @ @@WEZr @+ ݹks @teE~ܱk @ @`'6Svb @ Pt7~ @ #垁9䈩ʎܶNF%Ί5׿ żs @ @+*bEi(n*'@ @`3s# @Ma{=%+VxbakD @ @ .ʑnx[ċ.Ү @ ];z  @ @@Q6|1E-_ @ @y_i?FJKkyjU- @ `z8"@ @6ͱ?iE @ "bK6) @n  @ @I5_({QMC @t z1j @n @ @RoJ{X]3Ww @ @D/r @b `sTM @E< @ @W`H7' @!. @ @@.%TZ @ @l]`"y?s @B tZ @ @MSKƺN,d,񑸡ؿ @ @H?瓢t;y @h#6ZL @ @S*cu'Dg0w-OE%΍5u=7q@ @\(eAl/ @)U̲UM @*R?5&o\֩&@ @(@y(D+rj'@ '@ @@6|=b @ @Ft["U6'@ @@U @ ?"6|Z+JWS^Kͱ @ @{I#JO"  @ & ]S. @:U`%D| qAUT @ @@>}+OңߞzTA @v tmU."@@@IDAT @-ZsF&ZX  @ @_ H=`# @ 0 @!P'Dyz g  @ @HH48_u @~P @ @@RJZ]  @ @4N`jC뎎4۸9L @@Fi  @@G^]aG @ @ #weO>6Re2 @ @ \'rA @ @}Gc @vJ@{L @o4bhc @ @ȷE Qu @:\@h @yX#&y+M= @ @"lg7e. @ ;n @hԪXD0Ҡ K @ @{i1U% @. @*Pu\k"@ @ <47EZԼ9D @v `o @ @\cNw5rc @ @(ԆH׾>bխZ @m. = @A|;Fy}JU# @ @ ޳1=5yF @ `?( @ @͘ @ @)00c#U&Y  @@w @(~>~v*v#1k.|<9;s @ @@En+Jb @+ ]_O @ @v ]yuq.D'gUJ @ȱʳ#9(JOTT @juH @yzq}RDC @ @ wi] @v/ @ 7l @ @H~0Ҫs Q"  @@w;6' @ȧXOFg0֡7cjF:,9v@ @ @`R+JsC @a27 @ @Lʽޙ^{Ĭ\^zJ @ PP4i"(6l @*f٪&@ @" TFc>S(Rj%@ @ oHk4(u @@ `قj @yHoOk[i!@ @ P|ɾH׼.E @ " ]R& @(y)1v"f @ @[1=SzUI @_@ @ @ )}7bWDu @ @h;6'ۧ' @ȩvNFY @(^ ~ @ @)ҵGE.N*%@ P@.  @ wQ > @ @'M돉TotD @ '9Ye @ @]6x^ |viG @ @'{I2UUL @X$% @ @(_U̢N @ @+W#R*o:#@ " @&0 c| @ @ :'ҍ' aWۃ  @P@;$ @M`茋]ߌHE\ @ @\`Yn>> aWZ{ @Mn" @ Ўg_ojDpq}D @ ψtڠ- @ȇ@w>P @Q`+Om3Ew~ @ @@snTv'yF @ pQD @fy"*͘0s d<=ίqx9 @ @@~-*zҧ>  @oj @M9XwI&h @ @"pQcu  @:U@SW^ @tN @ @\a|@ Pd"  @ ds'_ _7Yt @ @ 0h6$ @nuH @>)bRv]cVϬٱOͱ @ @D'}.( @@QR$@ @@ rY{v芣qK @ @@F2]O91( @@1Q*  @ @UCg\=ony  @ @4\`7rRjT& @ z @ @@sarA3 @ @\,Aߓ}P @@s<#@ @@N;?i" @ @@3V8҂GL5sVs @(vL @hϋOf @ @ /UD,=TC @ G9Z  @ @ ?Йy(E  @ @B`/#]wtH+f7' @ `~H @_=9 @ @ \Eo*#@ " @yHry*K- @ @RHW:VVan @ݒ( @H㓱/hf#@ @ @ 7e!WD7 @@m @Q28k_5y,OM @ @A`HW4Т  @ @ 5tTVv).5=![9 @ @ )Pt1Oz @tv.  @\ыnuHGc*W8<Ԝs@ @ @i*wFcm( @Lfz @ @XC?$־3Z6 @ @ȭ@?r#JnkT @F`7B՘ @șΉNYe!@ @ @˾i#սB  @vH@{\L @b r9zȏ"RjW- @ @Xs~_i + @ t&@ @ TF/Ķk jz; ; @ @ vFxO4жkOC @+ }_  @ &S+zck> IGi+JWUJ @ @^#Kvpg(J^ @@rW @ @`/N) @ @ LE#8kF @@Jj$@ @v XEye @ @@]QYH)yp @hv@ @~ 2A @ @ Swi?D*0n&@ 7 @141V  @ @hs"񬳢4Ff| @M0 @(5G~\1F%@ @ @GE_ьA @-_ @ @`f UP_~p @ @%0:U5kF @hvh L @ se~Gl]&12 @ @)PQYHRϑE @M6 @vN U*c?7|1 n @ @B`ɑ;:d+f7' @iB @ @9XgωH͙, @ @hFH7dx @hv#uM @: Lܺ @@&*"@ @@WuGF`QSkD @ @؊@"]g "@ |  @,0v魱 _o'@ @ @sVF}sz) @@ d &@ @]RJ ƚ#+*۵M} @ @ @d[ij) @t`NS @ @ʽsܩ1aJQ=?s^ @ @s"mX34wf @h@O7  @ @A.-zR}+.,|}sH% @ @@~FDȈ'G-u @:[ @ @ G)scKS:G @ @r&PtF45C Љ݉g @Z.P^>zJ]( @ @XHE~zzv!JV$ @@{ xv{ @ȱc]:k4 @ @r*04ҕ/䔨A/ @n9  @H41}XDe톎44 @ @vZ MEZ_ߑp @ ;*z @@`y/"CYf  @ @OH>?ҚC @n  @p8X䂥} @ @Y`7oMij΃ @, @vZ`jU_}cߋ @ @ @"FE{ &@ P?Y @[zEol9  @ @4P`dI+_"U8  @:]@ @ c=o8)*Cu` @ @ THnb @E @X/{gN @ @ @@Fő|9R"@ POzj @G?|5ֽsQYߑ&@ @ @@*}<ҕ/48w) @]; @ _=E9F  @ @ k"]BO~ @3#@ @@' {Yu2޷"0xW\UxIXs @ @MO? ;VGiS8 @M@VT? @4\`7ǺOʺe LE%.52^s @ @ ,t#((uҢBLK Pd"v @B`쏷 _ޜ @ @@ .}A+11 @:L@\ @ @ @ @zETn:>d? @-нW @(Fi:s-T;EƜc @ @H`"USN”B W켮 @h@CEyli-&/?"^ @ @H`bmiQzIQ{hW* @@= @ weߊH弗> @ @@#]Hw}=<^QC fm!@ @`ihqT~m1f @ @+P]X>TN 0 @&Ϗ轤(e @ @)0rWk_뎉43 @`[0 @ P_H<3Dn4 @ @(_Es3ʣG @;- ӄ @ @i Q3b|M[P3 @ @4K2q=iչ͚< @9( @QYHW7f @ @ @@{ 醷fxY٣ @) M" @ </fO'yFĊCKz @ @ @V */HcZUy  @Z$ "x @ RgggFZHs&6  @ @g?"M :$@ @H=Dő3"^ @ @ @ك?xz{~)>  @% P  @uHFڣ"]ڈu @ @ @`k#||Ki۸ @E.꩝ @4,* ߕ}u @ @hТH]T|Y2I @+ \o @ 4[>gF8+!5`C @ @ @XU^뎎4pR @ t@ @ @dNX]< T ~]3ixT9 @ @t_GZH!Jp!k о:#@ жij0GSڶOS eO`ɚ'Rs @ @NrHS`vt! 6m!@ i*{ogO>5b! @ @@*G{fgEzqQ:Qգn @ E @E~,x}iE_L @ @ @@DH˳0#ޜ] @ $ ]R* @NH"~3 ^-boAvY/9v@ @ @i4aqc{c @\@; < @(EZ}7 ^t" ,Kt@ @ @4]D{aH=J{`B @v `o' @h@']_ɞqFDe @ @J#U^1ssUb @"+ @ @iHwg Hף @ @ rTyQ(𲖗 @% @ 2sIS#z~ײLL @ @r-wYǓ ٹ.Yq @vjG @@Re2Ҋe _kyTC @ @y-ҍtS#-9%V. @@ xv/  @C ME,Aߊ_TA @ @&}ǞWĝ7G1Êօz  @.) @@푖}3޳"*/X @ @ @呈eɾ϶^A(Bj$@^@K @HKi׽@ @ @ @vXHmwF1}0_Gik @r' %Q @ {"VgO_ f6 @ @ @3^Hsv5}kg2{ @( @҆k~=}+ @ @ @^Hm!:J:b߿RfT` @@Fk` @H屈K"uDuIH @ @ʈe߉m=/~_ˢ˾X @`7$ @f.FG0 ]&љN @ @ @@+"V)"Jznd,}K4i @n* @h@LD]) ]ǺF ޜB @ @h@:ROFY;b#4{Vc2 @ `o @4P -Ξn,t}Q4< M @ @ȡ{)"c?; b9Q*aJ"@:Q@W] @-H/{lq؊פ @ @ @@~*ӱҝi߿ҾGdDiT @' qKa @V֗gֽe @ @ PL5Gʶ+zPľY; eG5c? @f`7C @'&z.Yz30 @ @ @a#V)۪4(bf?k&@`7@ @ity2 \_ ׋0! @ @ @K`,Y͊Gʶk >w(k( @% -! @@J刁U!*0y[3cأ @ @h@ ٫Ήmӯyzn~~ζ=+JsX  @vn @@]ڈk5پ͏el ~Q5}>q@ @ @& L D.Rm|uEԈj({l=E(vQWN @ HSӭf!"gl?YE @ @ FgB7NoNf=Y;{:vÞ]kBK@^!@(@*E ޔoᆈ ٓe}d_y @ @ @tdS4Y (U;<۞{wn  @`?  @vHY,d R խNvlWO @ @ @#n,lso @n5! @RJ˲-Y,l}cςףK;AN`nt vy @ @ @@ޓHk~~Y#|ZyO(ur7 @@ pN @'{XߖoT \g e?%J{>)bl˞]*6_eOP@d @@ Yl[F_ @ @ @ZՇ[Bg͂OdxB޴,UI:Z@_ @Jwd;" /WC1՟BUB @ @ @`gj]s"}\ζҦ}=,JswfF @u3h 744\rI,_|z8 'Gs6K%@;*R9b,d}W+ Yߙ_m~di6\eGt= @ @ @eO˾iutpv,}VcϢ4kN{  P -VJs=78ji_c;.f͚kvd^>OI G6OζT Voz?NSԮ^ @ @ @4^`|uDu뻬&]8y0c4~t0;vώw٧񵙁tv.ζ\Tx\z9D~q7Ɖ'g~wüԱu] GX/$lFeM҈~ @ @ @[Q.}`8{ψmj@Q~(ޫ8}H@;GQRN9唚!/iO{Z}Ntu'b^kS#@-H,\}o%l7 Xg贈^ūdz @ @ @)051x-%4~dĜGdGDiN>GڻeۮDi֮!  p qymO|b|_oý/7 7V~.{qQGaޝy:v @f ,Dj&ޯTOF|u_ \g44 @ @ @ Y@;۲v/ d1=,v=(]!@" )+]><-#qꩧ7tP|k_[] n|NRN5f P'VOdu[i|`uy3 @ @ @6pt[ iw풅0vc}z(vqqnMozVכ/w}ciW={ldF1D!RuԆ_`LQ W>N~}uV} @ @ @LD޳q4ւՏR6O֮w?JRiV4v(#;Nl}*w  @ @ @hs[}v4{,olw'{O6cYh{[4B@m:歷޺G=Qqom=,=Xdw::Ѻ  @ Rd?q~ g>UWMUWjzH(h @ @ @-lsظ mfo d`vw]ݲogR)ܛy5uϋRWvxQ-ܲ-^t.ycZ"Rsy( Eoڦ8 RϪ~V Zg' @ G9>77xV[s @ @ 4PթkNBՐv6=6}i?ߴMҬ ^@K؜֯_}}}[&;蠃֛7Ύ @@ &?k*xj%]# @ @X2[~׶BܛoBӁ7fM[Gi\vMw[6owmܗ6; @oh ;>j^n݌ح3ό{T'>7/7/@ r뺕M[> Ŗs͟W߲kcjJ\eӹTkyv !0(ޚRǯ^㱸~Ƣ ~ҧ?rLD,˾"@ @ @6~ߘ^J]=O[5]}s[yU}"wzq6}l϶{7yTjLF%@ 8x^7û=l[`sxvv-FG:.뷫;E @yXuj SS.uQݼ<@%8 @ @~ԕYܪNrP|j߉!Y>ƙlu|Ԥ64|?$WZih>H,.ȝtgsw9וּkosNWv<늟fq2ܿTߕ+ۿWđ:*m1Z  @*D>73@IDATի+$:a P!k֬ MMY) @ ߾t= @ @ `Zxʝ0JI|8nOS @T[lD"_~央@ >< 2$5oVkI EE`ĈaK+o_"Q!@ @ @+8[xk׮sљ;8 @ @ @ @ @[=oѷQ`+S*} Rd_W’%KZdL?묳  @Tŋ@|gI qWѣGT @@w\q7Ljƌa6 @ @T1c<4 ]N;nБ?S c]w, @,p嗧/zm('$`>-Zk-ń BG]d@  @ @r*_$P˖-|cecc4VqZ9 @ @ @ @ @Q@uI`ĈpLN}⎕Gq\ @ @ @ @ @!~Fmm,)п[o/Z=jԨ5P)q+> @ @ @ @ @[@v~:1c$͙3')V={vewL-TJu @ @ @ @ @+ z]G^{%;`/X 0o'wiB]G @ @ @ @ Pu{_{̘1O~z{ G{w @ @ @ @ @@ M[sy7 la}M^\x=ܓ4vaaذaI? ]Gὔ  @ @ @ @ @ H.PnUSO ~V _O?]rݓO>;ؘ;g?[/uK.ɟ*UqF @ @ @ @ @LZ2 lSN \sM+Wӧcdž|#=o޼naկ#G~8:< @TE]%]C L2%r!qrT]t??Knz* @ @u>MG#fΜ.ҰbŊV/Uwq-;`Gw^Ύc7r @ @ @ @ @@-v a/s %_bvmKuVCY1 @ @ @ @ @@e OUDf͚k^z)^:lM6٤[㯔8unF @ @ @ @ Э @ @ @ @ @fj^ @ @ @ @ @N ݩ^ @ @ @ @ @T~|'@ @ @ @ @ @;$`w{ @ @ @ @ @ P  @ @ @ @ @Λ @*A`a̙7Y&la  Az$o=׿C ^zidϑϒlP/&J^3f/b|„ aMB @ @@ ij>jpަL @@ ^:}oK.-+п0iҤ0yзo߲}^ ڵkÆn瞮1 @%ĩ,v9Lҿ"?N?OvZ8cLZ @ @H ;F @@/\pAx[acccs"]vYׯ_;_p璯;c\ @ *{)裏M=±z%@ @ @@U UeԂ&@ @@n喤laM7 \sM6lXƌI ˖- >κq\JYҹh&J^*{W\QؤL @ @^% W=N!@ @X_fJ?φ^\ד&MJ||O<N8<O>!Pi#gIE, A @G*{"K/4BcXie @ @  ؽ1 @x'Snܸp7}Cv*K>GϒZ!@@w TR_ypyXE @ @BW$ @ _|19& lM믷ֽMwq0eʔ>: J>Kzf=+zZRVZ.袰zɓN;-[dO @ @N$@ @Ry睰x$M74)VdM.K, gOSa¡s\z@>G"ϒXnI Gϒ_7"$@@W TRYwޙvÿ뿆zցq  @ @yA @w}75pCCCRe+VHU #͒"PKK. ^ziBxꩧѣG'u @ @F ؽ @9d;+W,* P#>GjA&D.첰hѢ{&NX%$@ @ @@$`Ε @T@%&T8(9RJ=*PiKw_9sfds }Q#7'@ @ @@wHe @ @G?֮]9TT]9R,  P-`pUW%t_Ó @ @z t͍ @@/|ժUf馛0pTTJqA9zϑ^`MU*P)K^Ê+r&LǫTU @ @h춛 @KO?O?ޑdo ؙu"|GjBjJ^[~ezU*x @ @U@v['@ @j-[9ceHGZ_ҵ @r%5ɷ-+߯9so1vi#%K ] 8B @ @J]OH| @[`Ĉ.]67… 3UwСՑ#s3fhu;ӯ_0~@@ gnd^2dH|392Ź맮8p`  @ @A,jV @hlw䪘's=瞤 -?E *Xϑ @- ^jI9 @ @tqv @zPSO VZ/~$'|2w1w.^~_q%\?^&U#gI/[,Cn nA @ @?N @ @bp)k&7+Wӧcdž|#=o޼.~_ 2=+%s @|/U @ @]@voG @@Nc mYKÊ+r/R?厸AT6jTH>x&@@ ^#, @ @jB@vM=ᩧ[WI'TۭZ֑?GI |& ><զB @ @@e Wvx#@ @ @@7.}ѭVZ/_^O\|'p,X~x_`ʔ)_|(tå^~nO># @ @I @ @@e]™g湭^:ĝv8瑩vaav:W`- C= o~AbI[G 7tSx &T @ @|Q @ @ 'tRBCCCj . ?Sm*tԩSKSO=Ν*  @ @*zUH @ @@m~]g{7 ~x6lXj+466SS7F @ @B@vU<&A @ @ P+ӧO11կ~UXU&@ &M}ŹSmZ*wꪃ>8l6 @ @C:% @ @jC`7F Z2w}7,Y$I[kx?-ZYbE8FLkBCCCkd>f͚ٳgC>axA͛7/ Cnh3f̘O]]{,_< zx{رflٲ=,X.\KdMѣþJvw]kA}s W_}um=;.6mZSug^{97"@ @l ؕ|DG @ @@ H_|1\yᡇ%Dׯ_>/}K>}=wӟt.8G 3<>ꫯO^<ϐ!CRb=ƒ>7&UL.w$38#{ofKbvy_|aРAŧ3*餓W\[+̙3'|Muw=R+^Ku @ @@^; @ @ @@ OJ+&Ɲu,^8pV817&N81?>^IҥKCW}A$_Nj~ndBww_1az#L%1~9UV%}(\{ecwySO%f)ݴ?O}S!&+:wwO9Pg֮]hjjJu;ZutU묵V8f[SNMu_reI918C%֎zG^Vm9X,Gw,qC @ @@5@ @ @ J*m6 0 Ֆĝcwj}Z{@r!u+9'MTraǘL<uw].dz>ۥC-ln|e^x>1s9a֬Ypo?ۇxO~͛'tR>tO~2뮹_~8Kk̙38#^\yÁպCL֍n{ŝqwuWj'x"s̙3C}}c]tQ2_W<&!CkWǘܨLkmj^qo9.ƤnrtM}9vT[q+t'^O  @ @*T @ @ FM| _h(K.m3fLjx/8믿q㚖,YRyiӦ\ۜRu/&op '4=M/njNojNns=/_6'H9yW$|aٲeM~xs=Úq^?k7tTJM %5'E75]=Gۮs=7鳮Bsb~꺯k;ZLƓ )3^ݚd[+SqY֖&K{E-5ko8A @ @@ @ @  . 'Oqcذa_baSR Fwmp s2] G}48zr)lva>4'dA%UJɭKv뭷^wa99;w}aȑI / 'NL[oT[a[V;w\xѣ SwÞ0aB=ݜjhRb̺::x}ܩzmM u뭷Uw^sַv]WZ;W뎹 @ @@Hg%R @ @z@L}gw%OOyW_}5wK5~a6Jҷopi~7KZjq_q-uɝx8p'o4<ꨣJ 0 |,i/lӧOyrc͚5??S6lp5פU2dHkC.^ɘv*%ƬkS\%SNM]CA%~-!aJWz{ @ @T~>#@ @ @f̘wV~Nqv-\uUaŊ%3;N2=6,[,݀115wn˱6۔t_|yI[K qktkG{Ygj;X/>ڪa]w-n Kbýcw\YO>Tn!D8*%Ƭk3#k]o-~NT{\lV)k~ @ @/WʏW @ @X GLҎIqGrGLwɶqW#G,XRN;\;nܸ$ #F(98_z!oI />&m-TJYZ{Y'>ӟ490|__{3os{Q)T=TCw[ @ @ v? @ @ P{1zҤI'̴r^>f͚|1k]\=: >؆JwWZue40 @ @@U H'x @ @*I`v ӧO|pWk6,[?zvݫa뭷kw3fL1wnxg/9眓{%'|W/w]mԩv hڵ[oMkQM6MoŊ%ˍQ蚿 @ @Ԟ{fL @ @@/xÑGY^{bn-K.-9].S;-vL͗l%,\0l%=P 1vM|q!;4u]ONBx衇‚ zɓzBWV^eZI^|)+P&@ @4{# @ @T7廉;̙3Gjupũc-.h#GLϦ=]˨!wq?LՋwg>Z+}MM1UoR.5^9m @ @" R8 @ @ Q w}ww-  HT7o^kזu|rqR̙V\jRYfM‹//_}!̓`ǩSFhѢ\[LD{S wNXG+ş1m]o/B^  @ @ ]!B @ @*`$C9MIDAT$LxIGoiǧNGo۩,n-| ;sn6(\8N>} -|S1{ve$0}=>`_r-Ä zB5WS*/Z뒜  @ @ ]aD8 @ @hM.qC=TrIŷjxsLXoR].?1R%~k_KuYbE8CSmjXjU^X cr.T'tRkȑ#S󌻮;uUy?{^V) @ @[mѹ @ @=:'\?-b\8HL^>=cr ,L:57ߜ|ɩz[*^2dHI؅GMp@}CiLFmܹssl馹z-t#@ @) @ @ @@9o1$&y睹-[I:0t <#$X ;GΟ cr ,|ټ%ݧ> ^җnϖ3g!{onſ|{+Q'@ @i;`p @ @SrI._vmX`AIdo}pG>8uy]y޼yΪT[5p *%I{׆3<3ik0q//-u g.9ߝ1ܼ/8tIe#㏇|0dxx%ɢqgۮ8-ޮ0hm̏~aܹݩweֺ6,CMj\rI °a K/ c}+t  @ @:QOl E @ @= w^y믿6x0v0~e[~]?)̜93{zwr-KիË/.\[lF6pLCuG饝c=^xC9m&Kcu A  @ @2H΀  @ @ @ @ @@B @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @e$`eH @ @ @ @ @R إ&Z @ @ @ @ @ PV@vY @ @ @ @ @(]j @ @ @ @ @eT}$=IENDB`bayestestR/man/figures/unnamed-chunk-10-1.png0000644000176200001440000062074614410351152020450 0ustar liggesusersPNG  IHDR `CiCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i `k.@IDATx{ӝ8oNN82!DB)2ôM3e<3jRqǓh&֥4D$=e;$$=yvZw]볶|nW @ @ @ @ @ @`5l @ @ @ @ @ HE @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @l @ @ @ @ @) L( @ @ @ @ @ w @ @ @ @ @e H.J3 @ @ @ @ @H @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @l @ @ @ @ @) L( @ @ @ @ @ w @ @ @ @ @e H.J3 @ @ @ @ @H @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @l @ @ @ @ @) L( @ @ @ @ @ w @ @ @ @ @e H.J3 @ @ @ @ @H @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @l @ @ @ @ @) L( @ @ @ @ @ w @ @ @ @ @e H.J3 @ @ @ @ @H @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @l @ @ @ @ @) L( @ @ @ @ @ w @ @ @ @ @e H.J3 @ @ @ @ @H @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @l @ @ @ @ @) L( @ @ @ @ @ w @ @ @ @ @e H.J3 @ @ @ @ @H @ @ @ @ @ @@˄Ҍ @ @ @ @ @} @ @ @ @ @ P24#@ @ @ @ @ @@m[&7[D'O\ @ @ @| |ߏǯ$۷ooy>{guQ1hР׃ @ @ P9VqUp6H^y8p`k}-y_ @ @)0r;vlLW^qI'e]ݻwow @ @Z^_QoۛتU[ni @ @ @gώ믿> 'Nl @ @ @@+VĄ ֺƍe˖ @ @ @~IW]uUs՞ @ @*@M&`7lT?I&b* @ @ @ +K.>tV!@ @ @F݈滛W%[7jjj. .a8ƌCMT @ @ @ VXQx<@3OKn* @ @ @@~Fcǎ-'|uuuEr~w듳?}/nau @ @P W k„ EIGyd#=Т=(&@ @ @38#&NIj9s  @ @ @B\vJk|+?(.@ @ @#1tТG-Z{oQ\ @ @*SM%`O/HNw}c'pBt!u  @ @X}{%1cFɸ  @ @T@JۊV`Ѿ}x]]]uQEmƌS @ @ @k { 9sfê2 @ @T@I^paL8h)8[/ܹs|Ey睸 @ @ @`m/+"gqF$. @ @.&`?31}8ӊbk ~%o=d\ @ @K`ҥ"=^~u5w @ @*HƒPJ~ݭ[8}7 J깇z(f͚;c*B @ @x'Gزebp˜7o^K1uxcEϿ{qA_} @ @<\&`/Z(~_i'כlIQ|].(lժUq-Ŀ* @ @ ?]w5{bI 7^{mQ"ܹs裏_=6t~  @ @ @`26Ι3gưaÚ-l~nO:u*u[ @ @ lfq饗Ɛ!Cf|g)?86* @ @ PqVqUܨ6p@zhcq @ @ @r=~ؘz?K/U֪  @ @T@rvW_-#@ @ @ Uʕ+;(ۮ]S1cƔ  @ @ @/1cFɸ  @ @T@zxwtGV?_w0aB|%  @ @ @{n[% @ @ P9J7n\lr)R_Ab})ztq]w @ @ @@)s [lQ2.H @ @#O>$"ك:(S_#J>:f̘qA @ @ X`ƌCN.X @ @ZE 7 ˖-+B6lXQlCC.]us37x#^}xwދŋo}v!v}ig/ƪU=w16lf? @ @mI F~Gk%1' >=66y @ @@EqJ.ذaJ74x衇Fl:k֬TWIOU%|;痜_wcѾ}m6$ǘ1cG]k7 .>)| O?4=rꪫ(  @ @ ȑ#>+I/P {̉rK3c  @ @*P I~r-#,gh׮]~[n%~Fƕ?d.,x≵NnٲeIW_}utask6Mu]JuYqI'XkK  @ @I$_K= osO7O>I#8"N<&ﻑJcN$[js>fA @ nONN"7o^L,^NOM6K^3f̨?FðrNnTu^"# KƳ>.OS⓫K.1~Hƛ.xo'B+liQ=ny+ @ @f͊E&-|3(zw2eJ% V  ѣGxEI_|QWWWhP^c=VHN8SLN_OOɕ$bO8&$޺&P  @ @4!o$_7pk1'-l9g_Z!@ @hR(uaÚp79r-\bEzEqH6?&0tڵk޸$_-zXpa>t5WrT;dȐӧO3 ƅK߸: @ @(+x#DrpC ,P { OK3c/ @ @d.P ثVǗINWǎSI ߙDʕ+XgIOKU\/Y$~Sx .Qӻkd?g믧I.$F @ @`;w*{gtIqWɓ㣏>7QߤETsbՒh @ @YfIkQSSoVk:믿>+/ra;CٳPoн{i"tN䓘3gNkmfD˗L~ u!vqB] @ @@[/~E KcN @ @6a/_ӧO/Lhw.Uׯ_!7\W&'I^xavcƌ7S2:iа]8^[ p  @ @cN7 Q @ @aYuKf?s^6*lօ&͋b-]={v̜9ʍ ߿SO=OwG$':(] @ @ д@51'*wsw @ @' ;kjF ,\0cs{z?ި 7|s\0A V*ԝė,Yg}v4Y$`xGqYg'xb$}% ɻʽ:tuuu6׎ @ @.P{ ^9̭Ǽlٲ*,vǜ5 @ @l lSڵkJ.]R/^dիW|[ZSM}wcҥ؃>X(7UH6W^yet޽M~&7|%&M8N @ @=}c:uj~Zɓ'~-YiL @ f$`٥7rowԩGcǎ99`3+/B\~婧~6ynj3RmJΝooc=ܳYfœO> M7xc\z饅 @ @U7go; @ @@[V|-Pm㯿z\|őP:Sk_ښj^{-b-뮋v)O=ظn5'zO|ߌ?>̙3;N}W_}uYB_\2暔GQ  @ @ NjcN&}jcNv@i{Iw_$z#FXS @ P~ MڵkzŪURUV^][۲M>=.XpaGy:75GuT']'?ۮG!C"UW]U__Ѿ}B,¼y"yJ]-#y睗i* @ @4)PM{$gZKFrvX555 @ @ - !sh]tI4:Iv @ @ @ٲԸm㾊h~517!C/o_V(%I. @ @H Ts2,1Z @ @mHnl(~Ot裏 vmBy} K,I%_?ѣzu馛wW&M>}z@ @ @9=6}f{9š @ @:jB$1yvMɿIRCqAn!&=+_oqt=ve˜^xᅘ;wnT7ߌp{=޽{  @ @ WJcNF>=fr @ @(eFi[9(S 9]z/N_|Bq矏)SGuT k>ﭩ?c={ƨQ[nk5g?YD5-[]w]\>s e @ @R7c^k_RK3cX @ @mԶi% H~XbE,]4.+c}Iu3%\IrrСCSmVxD5#8"_uMU[nIŒz*+raE׮]SMO9ov};n,Y~.$Sƌ3RG'm'$5yղ{gQvooqYg''= %} _6mZ!=ĭO=Taz _~y@ @vv}ODd:9{l &޺{k㭷ފ~>Ѻ.W?^TFGÇOo駟ۯaH9#KFΝS|͑"@ @ @ ;{Y?q1"nTL%;SO=5B{G< @ @]+h*P[[[uV']d<9zmHtnJ @ @ 1g  @ @ P J @ @ @ @ @Tr -'~^PWW @ @ @zgׯ_SM  @ @U) *͠  r;viӦ L @ @5jT$ @ @ 5yy @ @ @ @ @ @ k Y @ @ @ @ @ HҚ @ @ @ @ @Y HZT @ @ @ @ @V@vn @ @ @ @ @Z@v֢#@ @ @ @ @ @ s&F @ @ @ @ @@ @ @ @ @ @ۥ51 @ @ @ @ @ @ @ @ @ @ȭ. @ @ @ @ @ EG @ @ @ @ @@njs;3#@XlY瞩g/8S1 @ @ PJG?QL2pk]wﾻPW @ @Tj_A'@@WW^y%ܹsSu @ @ ДٳS;vl8 @ @*jrM @ @ @ @ @V ^I @ @ @ @ @@u V簍ZJ}qg8p`B @ @8Ccǎo}@ @ȃ<9 @ C;vl= @ @ڒ#" @ @y̋ @ @ @ @ @Y HZT @ @ @ @ @V@vn @ @ @ @ @Z@v֢#@ @ @ @ @ @ s&F @ @ @ @ @@ @ @ @ @ @ۥ51 @ @ @ @ @ @ @ @ @ @ȭ. @ @ @ @ @ EG @ @ @ @ @@n$`viM @ @ @ @ @jP POMK.ѡCTL @ @XdI,[p}ѭ[B] @ PN4~d,t޽{3v،ߢ; @ @ȫgc>:U"@ @ڨ6M @ @ @ @ @@$`7 @ @ @ @ @Q mtM @ @ @ @ @ 6O @@jkkcر)p  @ @hJ`ĈqAn  @ @<H*2h߾}y+ @ @hKrH$ @ @ 5yy @ @ @ @ @ @ k Y @ @ @ @ @ HҚ @ @ @ @ @Y HZT @ @ @ @ @V@vn @ @ @ @ @Z@v֢#@ @ @ @ @ @ s&F @ @ @ @ @@ @ @ @ @ @ۥ51 @ @ @ @ @ @ @ @ @ @ȭ. @ @ @ @ @ @m[`ժU#&1`ݻw*B @ @J L>=fϞ]馛׾B] @ P} ,_'@ @ @ @ @ @ @ @ @ @ @]Kh @ @ @ @ @l,ڍ"!@رcL6-5^z* @ @ @)QFŅ^XݹsBY @  yXEs @@ڵw?@IDAT=uE @ @mIwޑ|\ @ @ ubE @ @ @ @ @$`g-? @ @ @ @ @r+ ;Kkb @ @ @ @ @d- ;kQ @ @ @ @ @ [ ع]Z#@ @ @ @ @ @ k Y @ @ @ @ @ HҚ @ @ @ @ @Y HZT @ @ @ @ @V@vn @ @ @ @ @Z@v֢#@ @ @ @ @ @ s&F @ @ @ @ @@Yw?n+W~$ {w*B @ @J L2%^|­m&:B] @ P} X".TuuuS"* @ @ Дwwyg{!@ @A&0 @ @ @ @ @l  C; @ @ @ @ @ȅ@m.fa @׮]Su!UW!@ @ @M t)3wҥ @ @]fh9dc?o @ @r-_" @ WN̼ @ @ @ @ @ EG @ @ @ @ @@n$`viM @ @ @ @ @$`g-? @ @ @ @ @r+ ;Kkb @ @ @ @ @d- ;kQ @ @ @ @ @ [ ع]Z#@ @ @ @ @ @ k Y @ @ @ @ @ HҚ @ @ @ @ @Y HZT @ @ @ @ @V@vn @ @ @ @ @Z@v֢#@ @ @ @ @ @  @z ,_<爛=sbȐ!  @ @(%puţ>Zշo߸馛 u @ @@ H4~d,jժRJNq @ @ @Z^x>{챖n @ @Ol @ @ @ @ @h ح @ @ @ @ @T@mِ  @jjjOwީ  @ @hJ`}vک @ @]fh9:#}z8 @ @'@@dpΞ=[vNĄ @ @{BsssvQva@ @ PJ5 @ @ @ @ @ @`$4`g @ @ @ @ @ @9*A7eʔ܄ @ @ ${O>Х @ @ )&iTO`ܸq'D&@ @ @)T> @ @TJ. @ @ @ @ @Ѐ[T< @ @ @ @ @Ѐ* @ @ @ @ @cG @ @ @ @ @@]Z @ @ @ @ @ [@vlQ @ @ @ @ @HV@vK0 @ @ @ @ @b h-* @ @ @ @ @ hNviF @ @ @ @ @@l رE#@ @ @ @ @ @ Y . @ @ @ @ @-;x @ @ @ @ @$+PN2 @swycX  @ @O / wygvC _}67 @ @]@vWP,\>77!@ @ @ <}ʋ?| @ @) R*F- @ @ @ @ @jM @ @ @ @ @@R太Q @T 'rqf͚ @ @ @>֖9sf66 @ @ ;UT" ;6x# E @ @IN  @ @ UR @ @ @ @ @4` @ @ @ @ @d4`' #@ @ @ @ @ @ آ @ @ @ @ @ dVa @ @ @ @ @Ѐ[T< @ @ @ @ @Ѐ* @ @ @ @ @cG @ @ @ @ @@]Z @ @ @ @ @ [@vlQ @ @ @ @ @HV@vK0 @ @ @ @ @b c/Օ+TɁ @ @ @ݡ444ׇ @ TVR$ƌ^y啑 C @ @ |S1q> @ @` he \ @ @ @ @ @/{v$@ @ @ @ @ @` he \ @ @ @ @ @/P$@rKr͟??77!@ @ @ tI#N؀ @ VQ (0f̘pgF( @ @&!@ @*PJ0u @ @ @ @ @ @ آ @ @ @ @ @ dVa @ @ @ @ @Ѐ[T< @ @ @ @ @Ѐ* @ @ @ @ @cG @ @ @ @ @@]Z @ @ @ @ @ [@vlQ @ @ @ @ @HV@vK0 @ @ @ @ @b h-* @ @ @ @ @ hNviF @ @ @ @ @@lr @@êUrEtAaڴic& @ @ @?/BvjҤIaΜ9܀ @ Pt E_A @ @[[[8crQŋsL @ @ @@]tQhnnN566kfs @ @@JE/@ @ @ @ @ @) #%9 @ @ @ @ @^@vP @ @ @ @ @@y9 P qƅ+W=ss @ @ 0\N;ĉ @ @  ) Q!}# E @ @I @ @ UR @ @ @ @ @4` @ @ @ @ @d4`' #@ @ @ @ @ @ آ @ @ @ @ @ dVa @ @ @ @ @Ѐ[T< @ @ @ @ @Ѐ* @ @ @ @ @cG @ @ @ @ @@]Z @ @ @ @ @ [@vlQ @ @ @ @ @HV@vK0 @ @ @ @ @b c-.\̙;fB @ @~{.\  @ @EЀ]?" ttt%K655iΉ @ @ @@7pChnnN766j4  @ @J) @ @ @ @ @P  @ @ @ @ @Ѐ2* @ @ @ @ @(C<#0~]eJ @ @u%o;T> @ @T;ՕU @ @ @ @ @4`G' @ @ @ @ @T4`"@ @ @ @ @ @  @ @ @ @ @ TWV] @ @ @ @ @DЀT@ @ @ @ @ @RЀʪ @ @ @ @ @ H @ @ @ @ @@S]Yu @ @ @ @ @ ]@vtR  @ @ @ @ @HU@v+. @ @ @ @ @ hN*  @ @ @ @ @ S-L] 0;|"mo ? @ @qpmiӦ~% O>93kvpUW; sᇇ&g)|zozr7oޜ @ @ 0s7qW,_|1l79Vhq @ @u!0WE 0]]]aҥ+U[[[k?Pl;I'3y|&455 *zoP @ @=j3K}iH @ @`ހ]nm{7Kb ,s a͚5'?Ix饗zy׾pg뉷mSG=pqƅz*Z*XQᦛn tP>׺&$ @ @ .P{g > @ @@Ah.H$PS|0~Yg˖- }ټ{.ygɮ79l>믿>O 6>f̘p9}C[reۺ[ZZzO0!|[ >z|4ϛ7/w$@GGG8s>玙 @ @ 0xz؃>s=7jw}or)kwQes @ @ ^ {GKk>{f~x˗gו'tҀוy{z+ʧ҈}-礟[Iɡ w7|]X @ @daP_2? Ypa\g|* @ hq_O2nO<1L88Zil.~e˖VuV}>3gf_>o;ǘ @ @) l륾~3j!@ @o >իW2?ܼ޺uk뮻pk׮n;CgNW6y_ @ @&P/{gRݨ @ @~4`Ȭ~,?L:54}^bE6꠵5̝;7s1 x;bFJu}% @ @=j3C} \B @ Prr" [.a֬YxgC9$<==S;|&s9g;:~k]_ @ @=j3C} lD @ Pހ]Nj#xƍdgliӲK^yPg =X?<\_o  @ @ @^}Wy @ @Է^Ձ-[rY {ԩ{_xܼړٙ=fΜ9ٸwPzk @ @*P=؝3zȋ @ @^^%1q|G &N՜X"T/fkYe]V\2`aƌ-<]8 @ @N{1}ZC/;-sӦM={̕ {޾{\@ @ @`Gw7n?~.ƍ]uܼZ_ /̅?묳رcs*ZO5klS* r @ @u+P=]A>s-4VeQ*aww^ @ @@`'O>w[rɛ @ @ @;}"W? @ @@@vI宮A'ݝ\K׭[8㌰e˖N9lwPnN @ @z(PV_^G @ P  X'YP`„ ;vҤI;|έX"~W_,X | _?X  @ @ P "gHg#U @ @:xxlQ[o5\~a7np au%Z/})\p9&wnN9V%>yʔ)Vr @ @ Я@-`Mhge}s +W?կ~>ʿrFC,f֭m!t= @ @ h. ʿ}7osW߆  @ @+k'8=#xg~8mo{[6ޕ-[’%Kºu0񫮺*yٱ ꩾZ @ @A`c3[}E@IDATMȑ @ @b/{##0o޼p<g}6Vxl<֭[?裏f!;찰lٲ{ddž:#0v|'|ܹ  @ @=j3S}_WVS೟l_ܕyM @7`W}Jc rn-''|7_ ^z.5_Wr⾸'Κ5+CD#@ @ 0iT(Yuy{r{:_ @ @*ǎҡzHfc9&Ҁ&]6|W6slwz}Η/_i:uj&M 7/ @ @ @ ؃cS}摨o'@ @ P r-(xjժZ[[g.w;Wի߇r-G?i=`/~w󷫫+\}չc_cwqaĉ]Z{ @ @܃}j7 .J&@ @s u@ҫ3fۿ MMM=Imݺ5,Y$zY<֯_6+ӧO/~aÆܽrNwۀ] @ @ PTZV{w!o @ @b h.ɺF'¾ꖖFG}4T}*o8;5c֭ýV 7_ @ @ @H܃}ZW߁\  @ @/k?0s̰lٲ6mܹsif͚ݹx's۰E}JM @ @(@`GjV e @ @ 4t)pR'PSPٴ=Twڴi5+륾O>9\wuVZ͛;fB @ @" l꥾/̟??W)1 @ @J@?r-ױt#jz(j @ @z`So @ @F@i׮t @ @ @ @ @ I@\L @ @ @ @ @hЀ=W_ @ @ @ @ @ I@\L @ @ @ @ @h(N tuu;#w1pc& @ @ @?5kք 6dv}7 @ @.+(DhooGsQŋsL @ @ @@^zihnnNU^vln@ @(@ȟ @ @ @ @ @#%{= @ @ @ @ @ h.* @ @ @ @ @(ԃ<!0nܸkrs @ @ 0eҥKӕ}g @ @@JSZM @ @CCC8蠃"D @ @FԩSCC @HUja"@ @ @ @ @ @@l رE#@ @ @ @ @ @ Y . @ @ @ @ @-;x @ @ @ @ @$+;٥U @ @ @ @ @4` @ @ @ @ @d4`' #@ @ @ @ @ @ آ @ @ @ @ @ dVa @ @ @ @ @Ѐ[T< @ @ @ @ @Ѐ* @ @ @ @ @#@b ttt . WG>0o޼1 @ @ П|Ծ>es @ @@4`}O/E}[ߪ;'bB @ @ ?F ؙ @ @)"@ @ @ @ @ @Ѐ=ʞA @ @ @ @ @@$PDkr&L @ @ @&Ogc=q @ @@!4`r$M ?> { @ @ W\*_ @ @@T S @ @ @ @ @b h-* @ @ @ @ @ hNviF @ @ @ @ @@l رE#@ @ @ @ @ @ Y . @ @ @ @ @-;x @ @ @ @ @$+;٥U @ @ @ @ @4` @ @ @ @ @d4`' #@ @ @ @ @ @ آ @ @ @ @ @ dVa @ @ @ @ @Ѐ[T< @ @ @ @ @('[ @`Xa{8|$w̄ @ @'|%}٩>8?s67 @ @]@vWP,~_UnnB @ @xGr7nR  @ @(2kI @ @ @ @ @ @k @ @ @ @ @S\̴eM(Jp. @ @ @w7ff͚6mZ66 @ @ ;UT" 3&|_Q( @ @M'pB|} @ @ R-L] @ @ @ @ @-;x @ @ @ @ @$+;٥U @ @ @ @ @4` @ @ @ @ @d4`' #@ @ @ @ @ @ آ @ @ @ @ @ dVa @ @ @ @ @Ѐ[T< @ @ @ @ @Ѐ* @ @ @ @ @cG @ @ @ @ @@]Z @ @ @ @ @ [;x PlC劘>}zx[ޒ;fB @ @x/zӛf͚  @ @EЀ]?" 9s655ŋ玙 @ @ @!477gڵk @ @  @ @ @ @ @쑒 @ @ @ @ @ /K @ @ @ @ @FJ tJSxw]hSaoc @ @$ pWRIpgpߓ׿{>-['N c @ P 5@HԻnV)E~/7_o7^?6u! @ @xӛޔ^QU:é7ѨOﮡ_ @ P+y= -ڍM_}H5͟W.yH @ @ش;^ [_t-7!@ @j+N|qSx +Wu @ @ @ ik&K @ PoMdDu*{Ƴ; @ @W;\5Zw?~=h @ @!hK  @`t rQ:~L| @ @Sz.QK1 @ 0G# @[u y[B[ @ @K ۯ{+[BWiM[_ @ @`4` @@\a%wT% @ @ PGG4KWs[a+& @H@@2 @/PyCkj.`WMW` @ @^[;-ص_d @ @Ѐ=[ 0׮y[ۇs6Ե."@ @ @b \W=F/X  @ @@E/@ W#|=餓q;6&[qOtٝa9 ), @ @ @@5暰r3fK.mߴV]y ^N/  @ @ ~  m?Gymn]hh_a[+o/'LYrBU J @ @XbEhnn8oZӖYTs/+[?rlhhhc&@ @(Q @x>ػ0ɪPgfzaʎĘpۧħ>C5 h jрAx AdGafcg{gZ^֮鞮.}ֹN_u~']Iw @ @ @@:l.KM-BS2 @Ⱥ̟(a~M Fq妞So!@ @ @V =!DU @ @@? @ IWyU!qUYO_4u_+LzEM` @ @ԩSO>zv^'GK`  @ @@$`'mK L0!̟?$9Zr. _H4݀ @ @UBts1,Xj:-Oo; @dI`l&k @`8{nr8vw[_:"@ @ @4u,|؝/]I @4@@vPuIX6d"X(l%@ @ @ܳ> k^kf @ @ HN )g. Q @ @)ag),PjY?k&@ @YU6G@=K @ @ @ \Rhi ϭ/yŖ`p @ f i^]s#@  KFl?,箨Ww!@ @ @& <h7qƆ"@ @6[A9!5ll]7?N @ @u(/?Is!_l^w݁uH @b ; @/f"?y,"2! @ @(0{m1j}sCZ^#f @ @ Q\%@ft; 9Fiu_O5n @ @$FK9ĸ  @$I@vVK p塸n[ǩu]u뭷crC̢{Q{(m1DyߜPھ @ @#?=w#%<g*ر\A @ @@b  @!r9̟?[V]yfBsS)6!  @ @ ]j-aU鮞} @ @`*`LsH@c;ݷ=F @ @!m/\<Űz{2 @ @u]'H @@r-$[v6> @ @ @ O,Ě* @ @>X7n\>P5חUi( 7wjRáS|c @ @z~;5 Wƴo|wEeb-L @4Z`GG?$B Xdnzvא9]vCduJ @ @@=>蕵5N6,'}6͗ @/࿮oGH@ű93q  @ @YXvtc?{H @ ; $Fh@nFCWw 0 @ @ O`N{_K @F@h  @ @H$`Ts !t':Iy*ة @ @Ӟ=u' @ @@+$`R r{L @ @t hc)qZnL^xL @ڥ51E ?' CqsG-SԆ @ @$%_`'P;&h @,0 'ݻwBK~Ί״Jyﬦ g  @ @*;;;k}4qߐ*/N>H&@ @ HNܒ 6=Ъwڢ˥R螻E~خ{$`^Q @ @[_{`}rY] ] -O@ @ @ Mt}(%V!J"w @ @ @@k]ɽ~|*ح @. ;+(~@~Ί?K:BqE  @ @Ȥ]$%ݙ\7&@ @=ZA @@b'6;w' @ @4Q}G))#%*`'xN @-hk؆&@ |;UNEw+`Gyϳ_|wZ< @ @HpEUfrGVt`}1ٰ~8z\b @ @m,$@`ܸqÇ ;Pܺ3;bA@ @ @:+ǂ4Ql iXIs @ @f m`"@q%Q*yO @ @ @OAh--h"@ @Y7wdX;կ}~ @ @ @@/5i3cU!tu;  @ @@$`lAMj_][oN" @ @#U(Uґ+tO @]@vVZ @@'rS^ܞ1 @ @[`RHSGJ'Nt @ 7 q[ @@SST;ovS B @ @!,S6:EcSB @ ec @@T;ND @ @ ,XJ~35T- @ @@$`nID(nJw6zs\HWŕ @ @H[h/+ C@S @ m ^'@@&Iݼ!?cIeB @ @M-;41 @ @@\$`ueE ^a}rxc @ @ @ B9ܖiU$  @ @.¨H@t&`wINP @ @$T`R(^Q˷[ @ @@> ?  @ 3V=0:sYG%@ @ @@+oJo`#eL @H@[c24PT*~j38#L:^/Sr{pM @ @ ,X [2ɓ' /rEJI ?A @ k >  P%.䒪{7tS?^u/ŭ;CiÎ?d]͓= @ @4R+_J[*Cs9aٕ뤟P.Ø1cL'@ @ uNb&н`M"o8]Ϋoz#@ @ @*)Oo徭tA @F! {x%@ t* g[ @ @ @ R9ؚi X ! @ @ Hn  @EMlw=Ƀ @ @X οOOY @ @hFg  @ }&Ls̩ԩS|ѝzp^e; @ @ >Tf0qyOmIyu=JƎIr @4L@vhuLd 3&/Of5DGAB @ @4F+ $`ʇܺb8g_%3lN @ PF/ @ RWC.@Gam({8 @ @+ ќ\Qw  @ @~a8%@t Vl !_H$|5d韧 @ @ @Y>"{M @% ;]i6 pux7]ou=TNɪm٫~rXN;j\M @ @aFc$SP( O|vV+`f. \{AUk @ @-RsΑ]H [6 @ @@6 @X2Z; !?}q,@ @ @HʌVUŤ.  @ @@$`7V r +7%؂i@ @ @I`U{*`; @ @jKW @ 'V1%_՛CT g@IDAT:G:u&@ @ @Ǐg>蠃ZE}rz{) @$Y uI;b*mwvv4UXadܓ CX cƍKɌL @ @8 |{ +Mʭ4MgsГ=ay @U)ue͋*O. 9+*N @ @ @vbxb`Z @ @ H"".PX>!7@ @ @(BCTA @T Ѳҏi @ @ `2}xs)lá5 @ @@$`'hJ#Bc F) @ @d\`OŌL @Tt}JgVJv%j@K @ @+ > @ @o$`( @@J;v]c=ZjG @ @kO @PlC g5)x~dz @ @Xb{o8#@ @7udA[veUP8!@ @ @@*`'}nO @AOZbc7u?&# @ @ @ 尣K,$@ @l H=R/PX)sy=#MU5$@ @ @@n)\U;!@ @Y7wd@@v"瞐]- @ @ ] U. @ @ fNLH^f  @ @ p ;Tﳭn. @dR-6iT;zh˫%墰rcRBmJKBƌ4  @ @2(o|# @Ȓ, @R뮪]vYuR.J{By۔8˝<tM  @ @dO`֬YUsNb('6FBxyս~  @ @@"&"JA @V~=[nگ @ @#> =Tv @ @ H'  bM)ȧ{r$ @ @2$f{)CmK6ŽNkҊ @*Ж։L`̘1}SNNʅW*7M2 @ @ P38jOGM#W(M%Bxéz= @  ؙXf$@@&L?pĸeQWfK(ڎ{I @ @\wu!z%hߡ`kp'@ @L,M2)ˮ 6!@ @ @@$v׃}  @ e Y^}s'@@ +6|#^nگF'  @ @ 5Ulg)bI`> @ @@$`͐P{=p7C @ @=%`1|q @/ ;klȤ@3JwdrL:?ky(wki  @ @2)Յ7. @H/ @ U<] Kn @ @2*  x @X@v eMY~Ms=v @ @ @ kw8,f*  @ @ SD!VIsjPMO @ @L 尾ɹ:[KaIziG @4@qfCT{"o @ @ QMʡ(zW{H"  @ @ SE l:/o C:i@ @ @@w\˪ZS6 @ @ uS&D@qZ> L @ @dJ`]׵,k 4ӆ @N@vԄ @ ( ܓ kh  @ @%CZV|b(%b  @K@vl @75*`a=%'m @ @Ȗ{w>ś$צ @I@vV\ P\.:ꨪ:ܼ.J;vή . |wg t @ @&O~jo|cB2:Ϭ.T; @ D @n6mꫳ:՛b|B~pЫNOL"!@ @ @ >֭[7:׺h•Pks @ @@*T2?;vA$B @@:kc"MEn&d @ @O..*`׌! @F@v ST8c•W^P*,H@a,_n4ז @=-pH@\w?fM`ɦRؕ,o @ @@<(N(gM7n\?_5_uq1VUz @DHN/{a_j8ȺuzۜuY / ַ¶mm dM@xny @CscƌO|"{~wEa^L ]]s=&{zq(}f=,A @Z)`&@ -:앎d-g-1 @ @D H{o k֬ w}wx{&N8`Ĺ\.gx[;$MYfsװ E _ @ @@17܈C`]J#Yg(57 @ @@2$`'`_nְ~/cƌ0׾pgW֭[l&&P\%mSj|r5m, @ @Oc=6 /B%@`U4k @ @@1oM͈ qgfy늡Pb6M @d^`̳$O | |~g?Yx[/A ת?%=xz @H=. hPC<"\! @ @ qd|Gk o}[nV W՛Uӎ*i; b쑮e~ΊPuq @ @ ǜ:uؠ<-y @ @HNJ ͛/|axnAZWߎb/{7J%^-$ HŪ !Jv @ @ǜ6SjeI j֚2 @  1uSܵkW;ÿ|0K(1}{_4iR3QGgggg>fϞn0f̘o;'@@o܂M_Ը% @ @눩+R'a,lGY @H,VPo/ٳ瀑.,o{{_=P㎪?я駟}{t bŊIF1y{q(okh+D)H @ @`x5شiSأ0aB:ujenYu|qnR؝/I|Z @F' {t~ zƌI׷zkظqy晽IW]uU8ckU~ӛz[U;O}SIO'I'TM7>W݋EP ;ZbbINZ  @"`%mg?p-T=szr#'*`nqy5$=M @q_1\e˖ǽ׋-2)S^x oÕW^w+l߾=<+ @ ) C(N2*,^Jw/4n7 @P,n @`*`l-;hn @ @4 Hj^q;CFs'k&\}NP =җ4̟?4Jv @ ŵnH> @ @@17 0dB@/sTA @. ;+|0zҤI]zW]_|a̘1uP }qpF {Ǐwyg9眪^]*`; @ @cNZ@Vop)SNcX[|McTyw)pO0 @Z@v'JRu#ҥK+]G+NdR {]z,\~ƒzt @ @['a??DwIךEU/9Mvh*9)l`raÆpmG=7 ⺭iJl摗 @dWsv h@W:r3aR8ƥ}G @EGyBqG:(XH~ֲP.Øq6ӲA @ǜ51شKFܵE ؍' @\`l#HyЇ…^Y~ Ǐoy @@$`_'z$@ @j\3]Q=~] @ pcǎ ַzKlyҗD۪sSO=^.-Tē$LxًS1 @ @IǜU3O=TX|y]vY:'*`7fUHn ^  @ @x+µ^nG[~}F2:&O= u3ڈ?Cz_Q?g}vx  PW^ye::馛*f\ә^ @ @ ch˿[n9眓R ],ƤtE @YݤC8#֭[{>/ =8@i @h=֯H ؍Y\1Kc5f @ @ mѸ%@u(JqG^ܕ{ @ @R(qׯ6Skda; @ @@$`lAMY(m!B @ @H]sյ~  @ @@Z6+s 1eʔ}'hA֭[W5aVuq )Ug. ]pJd2 @ @ MӴB T&_InR^>Qޢ#@ @8#J k'@9=uZAX&tO @ @@1'xN QRqƅKP4n= @ @& mx#@uPUF @ @H ؍[b97  @ @@ $`ݐ P_z+Z[աԙ @ @)Uy ]͹ s @h@[GЀ'.\X5믿>{U{{ѭ>  rR螽"<  @ @k8'@@6*5s= HA @ @ HnN6-̘1j~U<nݺ}7 @6 ص9Un أ, @=y#ش<<2 Җ @ 06 AH~ہ^3֡] @ @ @ ~wUY:%7Y @ <gm ڵ+ W} pQGO?= o&MjɌ򓟄'|2vaooܹsC4ƓN:wauPCt懲 @ @@\fs>#zj ؍.^?^y_O7^ @ @( ㏯!Jm:!p-׿pWq ئ7.\&Pqb۶mİE]4g=D`*`Vp6vuկ}=ܼys8}/Ym(CyH{ʓg-/>337 @H=-ِy9 ~hSz3;.0'A @" ;-+iM7Q|(\z/yrg >`زeKo<3g OEUE>q/^<=L_7O=?sq @H@\#z3cN6#S$)+-)!@ @& Hna/0k֬pwV&rg/x *.w+ɟIXvm; rJ]=O$GmSO=5\5ߡ4$PuEYVK3m @ @sj1n%B`ӮR"Lz˶|9L0&S? @}(7!Rwr1DŽn)|TŽ?5ϝ;w%x9~g>^]@$`7vs= @ @#s4z3cgSP9kPuusčB @_mr]]]aĉM5E3f̨L+0G$}>C=ɨ~>k_Z%;l̘1#7Ar\XzuO?r$[B!|tT}mս\7ݬ(,ja䃛5q @ @& cnv{s>?I?qUNZB5r)a(5 yl  @ha DI:){aҤI{lx[=a L>7U]o܎~qq=TGs \wuU/| {_WWs,]4J{bOpնX,~*}sv4=? @=81G3k>=~f[To9%dYү:s{ @ @ c4{]www|?O9s(;:֯_~_., o۶mo.`JN8!uQNLN>ۏ>h|4'k֬z. o;ＪýXdILJN:r@Jw9ŖfidB @ @ M㹚qcl9=Q -e롕b:  @RZg?YG>Rl|AV$;v<(zڴis#/8<c]?~Z9SN QՏXbEz3<3\s55yM]\hQ(q?* Nb-PM` @ @$jY81GgܲG)iQe[Jag&4or  @ @&Ȱlr-Cu]+2˅k׆?oW"'>w*[n<Cz ^P7/‘<>3/wGIQ"ʕ+ի%Gwm'OۉJnҨ\o @ @Z1*vqcl8xGVcm[vbS/k괮y @ @ +6+gϞ*/zrR/]yYg sOolߛwqG{å^waڵp:ꨪg7m4w]U}"\Uk1;w V >` ܾUiu)GI.UaPvHS5 @ 0=mξ{cLܪ=h8Сe˖U;::z}tg?:o1D$[vu.#@ @ H{aÆ8pW~_7~Vxӛ&|ph}o^iOO+;ٽ{wR{aߚuwk֬ Q#Jᦛn >hÔ)Szd rDQbYm-v׷wg? @L`2oyusX77ݾ)>}}̠f M_y= @ @ c?O*O|͕oz/{ϣ };ӟ4%/ 7omUW=wnGՁk=&LP4J hѢš8qb8y=h33f̨7o^7/V9!,rJ[v6k8F R >  @ @ Fcb b$ew)Fd# @$]`l'7mΝ[ԩSÏ~ʛ='ZG_WO4)|ӟ܏9򗿬\;] K,9#·|%\q!%ao뮻3ziӦU@3J{};d3$`; @ @xc:( {^TnZ ;s6/oD @zjӧryõ^hׯ__uwC}/첾|ndVbP(q m2eʾM}oR֭[='O@v,'uF&@ @1È=6iՅ3Q"[KaWO @$W@vnE ww~w]w2p U.j0aB T8J;aԩU_,]4?+]1O<1Yg,XPi{gVto۷o۶m ^zik qժUU$Wqh M@d¢PN>xn @ @ яay`C{<g=Hz_= @ -^;,uDφ~r>&Vn\}/Η-[BP7)s1k'xի^Uy ^$Jl޸qc:rɓ'&?!578\4Aa{F1Ā= l$@ @'`y֣zvqy[vlt:Z&v L @u]v|袋z+a%/ w}wǏW^yeս"%o_paܹU_Eյ ov;v\!;_#+D^׌W3|>x㍡Xܻ1|'L ZWUgEiXƕϪ6O @=xO]1>17[<_u2*`t]m)368 @F@v r̘1Eo9__줓N^t37|9<(\.>τ3g{ߋX#zf}FkU?{}_{i?N82^4ۿ {}'WGìYn7P$/h@׆ b7P.S;#+m @ w{q__ר=V3cNgQ.]jy޼y6[3VF -Ӏ!tI @&l҆uZ>#ᮻwĉ{Oޥ^n0eʔsc|G>nއ?'vi(!{ѢEUգ,L:u6C9$DC\{oxꩧBTO v կBIڗ\;{sf Un&c(~4n @ @ 0ںuls>L:f9Ҏ+O+y @Z'f[gȓ&M V\~_vN9'e/'Ow\^r%0nܸ&~A+{louD 5U4y<[%Yp C{{{o|;vwߠ/Mܖ?(7(P@.C~0f @ @@#17R>}cv\w?S  @$F@v /~q{_ ?ax+^?<0^ׅhD"tj}] ©w+?/(?gϞ>餓»p嗇M;vlU q;TNJY*;K!  @ P\=1Yנ.}hs) ح_ ح_ @ @Ɣ{=) BX|yo}d3G􏆨zT}ժUGydoEhwnڏ?Ϛ裏044*JVwc/M;;Y6,zI H$ @6.@IDAT @@K@`O̻vn& @ @A ٨nV^npmFu;ޏr쀝rvsS @ @ Mki< (NlX-:/;A @E@^u;pw4kH @ vN`g'"!@ @ Xc.o͜ lf.Pj8~tp\ @ @@b- \~劯g$a.mn_ (\?dΥ  @ @sWXϟ?F{{Ĺ\ؓ}Ҧ; @'`|97c.;ͽ=4\`d,7MauH @&ҫN-tpy{waӦMa?9=H9 ??W*Na30_( Z~B @ @ Xcn pOt{ ey"9;i惘}n󪌅' @ 0!{"뮻n7Q[ Z+fLOmH{tCXpʲl(* @ PPkMiȱ\꟬[`g55aՎOcw Cw[(#dȳY @ @@1g+!@ ֘D؃g5Dq @ @q"\tEgHFFFš5k?S>& .muS\i[7;ɼy @ @@1*&C@  ̳{z^$@ @f 4k  @FT77}$$P c] @ @@#&CA @.;M c lTVvf0*! @ @ @=퀝*YN @ @?ZI/p燁r Pԗ(beڰo]n'@ @MDlC {Zz`g9]Q @P/ߞ(@|D[J3egH| @ P4kE˨ @p$wp-<5 ˞9S @ ՚  @ I6Jۺv7 @ @4Hw Lj @U@\OM޳,ƞM\ j$*pէꦾ @ @@61g3/"@ ;vN2IA @*` e'o 22.),XFGG'xCb?}7==  … |qi5[ڸT= 7 @ @XcwHJcXx{;?q!|mZy @/!8@}ݪA^uU{^x'#vO^쌵5 7y؎6˚  @ @ O֘- @ݯLǷL~:\s5?i񫯾: @j馛b=𒗼$vٍfi TV=jc0u~z  @ 55  WCąN;%U fyz @ @F (ny;>?p燃>xd'_b'>h|wq%أ@}v>vv%߶sq0Sa3 @ @@>13o&Pdo~n駟l;`O$w'; 祹 [ @ P`IWpYg7ND5u'EMܫ|+_m|z… ׾`]oi @ W s݂T  @ @q֘g'+k&N @Ps1oou={lH?vm rK8sv;y{6Jۺ8٦  @ @ Xcn0(ևw`GZhO @Ȃ@Kï<doիWqE;.va㟥K'uϖ-[ʕ+Ϛ5kYg~+V97 g[^B^7j0{ym @ @`gk;k8'@`,owG @ @, ۷s=7]v^W+2\zaɒ%>Ůp|+ֵZ-HoooÃ>-[A ([ƦwuaM @ @5 'Yev;`g.'"@ @@`7!G'->3mN;mEh~xx[:yG>pwf;v]S wG$׾6v N~ΰ䡍@ @\T|_ :1ߣ>:\4N1#С1z!@ @9 m/Ug?Y馛v{K.z6׻vv'o,\0v{ k֬] @TQo=I#՞Bv/gu9X @ @ =k bkWyl(Hu=Q^QPHS} @ @`lFor-^̸'qaϯ|%OV _b4 7w{B)E @,`yg !ź[wW @ @ L;qGoqK =B}w흏}kapppK  +عނ}tCF @ @֘K@@`72Cݴw)P:B @R (N0/zzzb#|x`Zc]nݺ5|;߉] @͛ @`[>깜HckN%L @R@vi~I6^ĺꩧbm Iڣ;ONUOXu:z @VsiSo4X`,ڻ1g# @ @@9`']/^hwq-#PVC0?tz#cat_ @ @֘˚y&@ -:`g# @ @@9`',-oٲ% DC%׿Lop# @ @XcAH@.`"M33& @4P@v1wc֝ L5uNf D=ۚ5q,PiSdr @ @@1,a%@ }Cvlrv^%@ @9(W  @ yWvPi[F%@ @ @Tv.fFCsrfE @P vq_yh]ٝ 63 @ @PD$FGW/'0.  @ @ 'eq"PJ(h@(unlp#@ @ @@\@vܣHnEʧ @ @ O - @EN{eeggn @ @,02V c)a:1 @J@T: @@Qc@r6 @ @ 55 @d[@v#:^ ڪ_Jۺ"O @ @HYoHv)Ht;.؉" @&h}x{N7nܸ%mLKRO>9韆/v͛=^W-Fa~k @ Pf f k4^5tMx=Ff"0j켤J @ dkM7 x;,vB; q䥍@ @ (~V"mK4]6V #M׀[Ln-ۿ @d\s$<r!?l\$jA(92z @f ׀gQhݯh476 @ @R]ƦձA @)"@ Dg+Pi[EN @ @@f쀝42n؍ @]@ލQ @ @i TZ^Ikt6[CvɍG @R (.uMze;@5TҶ @ @r \v2n @HW@vF'@)=NoU: 8+S"@ @ @ -ZZC7ǞB*) @P]ʴ4!mݞ@EJ  @ @}CqUBa; @ @@3`7C 0+w۬R>* 1"25 @ @ ;{II8nk  @SU`ӦMK/OZ3Q᜙1GӎLH!@ @ @`axxxְdɒvN,ѵىG$ @ P\;`7fFY C=4W2Rs%,` @ @\sMlsύ?ФV$a쀝\ @EP] r,PjoVW=/ @ @ @`W>ػpw5DZi @ s ؃Sv.prM @ @@6<GCX%J= @ @@`?fH\ Ԣ(rg/Pyh}ٝd$@ @ @`B:ر  @$-К'@| ,X m,+VhD}a lPȐ@mG:7B @ @L׾,Yd⼙'XY誆g%q @ @@Q`g 7pAe ! Pvp嗧mݞz HG֩;z @ @@N14q&P`>;?i}C6H;i11  @ @d-%o&?vao{{CYdE@SmM`N0"!@ @9Ɯ$ T`Ք#0< @A@vF<<<np:*|# gëL%E0 @( &駟g):77a֭THHNfJ# @ @@1g;?#@yvnuFj vr" @M@v2~1?p饗{'T 0ɜD}alC 8 @(5 س@V õ=?N:< 69 @d@@v裏o|--#.\x# ?@d^W`#O$@ @lXcFDA@FBP~43;`7SX @(վHmI.p'|2p a{kSO=5X"| _{| QyZbk\gz"@ @\  J!@ @@f`g,5GqDЇ>VZK1|0\};1T @ 7 sDv":%@ @Xc.AMi (Saꯅ31 @H_@v9cgqFSO;\r%a}o}+˖-/Y  yRr1VVv&׹  @ @@I1$ѦI 'e)Ŏ.V*&K @& (n2lkmm ^xa;Bwww[9͛7iwgnư|W"tMgg]$@@V`g53͉~ShQ @ @֘c3$@`w])@{Kp%@ @@`7|tA~wO~֮]pYgS,} ~xx[~(0?=>w&}ic9&v-Fd줉3m]c  @(5d<dCࡇ O>D0_WOqbf(g{u=Q^v#@ @\ (eڞ z~w~n嬾+µ^ZZl6 ^`ttt|7'z7jK+N8T쀝$  @r/`9)4?nN?P/njxQ~$  @6sm۶|;Fя~թ| ^pe;~ __üy~ |g4_6V #؈}tCGB~2` @ @@1='@`: Tgڻ`?fH @t`>Qw]wp+2o ,77ᮻ QMᤓN ;;;7{ltAmo{x+{[o o۟n7i%p°f͚ؤ9X;Ou V @ @ #֘3a( 7>Oם}(nx6[) #cu^6 @V@vFRe˖E<^jii+/g}do (nb 'J(P)NHu SL# @ UkY͌S`ҥINstcgE`lǏ@{& 1?+! @ ";K]wFGGw+"uQ{}~opSN  HS@vP d+3!@ @, XcR6B@VkY E) wW` @ @2S_C}s9'wm1663Έ5 lx#ca'ӏpB#@ @ XcNdS`ۈlfQutU?  @ @ 3zu^|]ߩ:ڵk'{+pB@JSٰYTĈ @2/`9)  lBUuB]v&b @@@vƒtG+"] 'pB o:js'> 7opo_"Jۺ,фM @AJ@aU_& Pja~KcpB @X@v>K/t|;/4-/\|M@@d0 @ @`֘lP]μic!G\'@ @3P=cƿ裏89P%vC-¼&RBS- @HDs":%@  sBo*NV @(@Z.4TuV Okk @ vjfҋҶ.L @J*`7mP]$6x #!7jp#@ @2 (.h;::?… cm dU@vV3^\6;`od @(52fݜ G@vqrșw"@ @@Zo喰e˖)$|3hVqwwtݮѦ`@IDAT@]'?7TE6Gl cZ:$_ @QN@*wyghkk \sD;I z/^EM @PpJEG=}F|p8Sݭ(@Z c3;#V P A`\S @NsRn ! v\N?`L @G'0 @ @Z܃xVX13͸/,X7am &P`;L"P/v @ @ Xc.[͗F E룾 @4J@v$OKKKuq'>%@g#PiS]l) @<+`Y  @` U'7oQfl @ @k/>pwLJF~,^8p>oSgᵯ}mx߼W'@@L~>I6`'퀝 @f/`yv$@ Ϻv^g>蠃rj.KqVK @S (q7/"?|p}(|1 E-[4eQ=kuPݸ5_<  @ @t֘Kr&ko9?i Ӓל  @2/{3" @\ ˕ζ9W_8صK.$Ǯ%Ѹ{Vh@E쬲3siE9 @ @5%00<؆mwDKs @ @ h;`7w).dbM @MhmXs Gydlއzh]o o۶m (2f}sjaO'@ @Ɯ|l;yz`g=E#@ @@`'~_.P0 N{1r @/`994/opĎn;`0mB&@ @@`g*!@@u{],ᢋ.]Ka$TgA @ @@6nOOK_D;;`'[Zاu^q&e& @ TM6/EQя~ o~sTCvRWvrjF @ @舭3o޼ivӬ)wUg @ @@ }  @ 3Q" VCeRx @ @4[#/ 9q @ @ R6 dF%\xᅱx>X;Fo0[@ΰ 83S"@ @ oO?=|6mBvnujr? @ @`'h~6_>fřiJ)`pw2Hv*y^ @ @E\b a8Fji k <F`F/d @H[@v;Ã>3Z̼ĉ ;@mG @ @Mwwckg}vS`0rz @D3,J"m۶LGGGc$Q$gI*+;Â/lM @ @@}<88ؔF2A (jՔ @ y=pGF8Ccz oxClj\ @@ ;Vayl_ @Ȥ5LEPdX脖e(ቍ @2(;|V_ק PdHvӛ;`; @ @@1-C@# 6.j};uE @ P`P @ STl+Vh(NB<}*.O͔ @ @ o~?a6qɀ-|߫ e$@ @@`7RO(ßɟ4}.MӀzτc-Τ̄ @ @@N.P4Ѩ#h; _E @ @@BRB%@ D3{v .  @ @J$`%;  @ @` +9HT S(p :  @ @L`Hmˮ A @ -066֯_{챉OgggX`AXdN |+Ë_0o޼lOHt؃@{qyӥ @HsmJ.0߀Ow 5@ @ (h{zz>? ۷oVrHxꪰlٲi!dE J(ȩ@eegN#6 @h5ƛl d;>C;% @R뻩 @___'?=|f^6mw}TLV\W, Dvrzr[?=9  @$%`9)Y umvzrߪ ~D  @vl?xx+_6o[XOJ~S w_>g/2+Pllˏ@}#_EJ @(`"@ w sLj @ 0;`OG S_ϛ7/,]4yC9dph);t DC T~,S5O @  @õڔ-ЮѤ#@ @@a`g$W]uU/~[4뮰vP_@>g aF8Sw{?i+w&;k9c< @ @֘˘us&@`g;`|Bw4׽G @%Pd__bwx7)wqaѢEg}7|. /^Şַ5 dM S1;`1mb&@ @9 Xc# (B1 v&  @d^@vR(N:p};/v}op饗'/|aO|$PBm`(K!%Q0ՓM @f'`yvn"@X#Ś٤'F&@ @(N9Uk׮ =DtP8wݱ??Owqd6Za}鈀l @(52e\ Ghl-oyK+#dg3ۢ4  @ @` g+נ㻾e/kP!Z۰uDF D6o}O@vrn @(52g Y;k8]*} @_@v9>cY&֞K#⿙}衇Υ; @ 1Ovb%츺7TQ So @(5Rݤ D@$(.Z`UWuz @!;.첉spb=<+;`ϊK @( `k#y_y:;yΪNMRI[M@ط6 km4- *(3q>c͈=chA! $Qd 꽪G}UJ[N~;7U^{+N 3LJ /pgr!4 @ kYiyHI'ʟfݽP(5k4dARY JgaH @j:3{pVzO~]ݎkP,<7\ &Pvܦ$N| @ @_?O<>яK/47=蠃6mHzF ۷t|OnK(J @F0(n )ΜLMx]I҆!@ @@2ڒv2ʕ+Giqo1z#3f~x/b(6o|t&M +˜"PlWHS @ @/Б+?I6]`c{)Ul$@ @d(N<PmYr [Fo` @ @MTT, dC!Kʕ @ 6Q3 ӦM[ @ {vެ7>-+aF @ @FXcn> H8iB'#Q @ @@`7p:nkGޝdd+a%b` @ @h1VJ;.S:$` @)@ (;Ss V66 @ @ PΜHe@yl @N@p* @@JR(ui(;c3.] @ @, t沘!t11 @ @ a 6a%@@mNiM> c3!@ @ 0v;`7V!,`l @*6; eBng?Ƚz]۷ի+"PX%^x%Lڐgn @ @ z(XûuO:`כTl,?>z;N  @ @@ 3-X|y}.JZµ^_j *`@~0YuW @ @ +֘2$P?o~otxꩧ*h8I;`'mK @(n yڵkCggg\9Q*BS,۔vwwiӦ_*̛7U G@Jݭ)-X;s,= @*`y;Wdr @ 0X@`_7|sH O쎒2˜ @2'`9sS.a t`"4N`c{)U c|3 @$N@vLlᢋ. OJ7 ᥗ^ ˗/{oxB@. ~ڕ @ fE1t;3++ @( Xc= @ lF ,޾ @ ?yã>CP7o^ַ.YbE8g.}o^y$@@ݱI@( @ @iƜYcP=.mx6w|k @ F-{,V:uj馛„ *'rH#pǛ㏇3f?޺ukkb!Pl8nNPv @ Yk̙z vUh]%m @$C@viڵoގs=wixC4Tg}w?3q(;󒶘 ^M/-- @ @`ٗ (7y+n @ -W^y%I'xqqU.;::3w._j=!@ @ ƜЉ6 7|w6,N v] @dM@v fO d͚5G):uj; _+ٳé>O lc̜93rZ-Pl1зfsƲ. @]sgX~$Х{$ $@ @@`dnp ' 栃 &LܿC[[[/~}kaɒ%g/~ax= Z*PvK' ;S/m @ZsWr БG $@ @@Tdwp}38#QG._z[֐"! _F#0nܸpqE>h^sb1yf5 @ 7kqȶ@y3fhHfl, ] @ȔM!{O>?#9YgN80nܸg$<&P~& wv @ @,Xc,ˑ@v:`gw[yyg^*#Ohq$'@ @V (n.}饗7nյ֯>oµ^fϞ9QZ)Pl፝aաT,q2  N @T XcNJTB [oh @Z@Qg`[n gÌ3M74r77onB0w@DS }7d'a @ @@f1gf%Jv| ,Zb[o` @@1!\2uY_q?˿Rs\/0}-PPhc\ 7oexs!O @ @ i֘6c%@V\=x@ @ ];`d__X|=nܸpO?~9s¥^:]GCYؾ=  @ @ -֘2 @`,9;`K aS!U @#;&s5{hѢ!єwľ뮻ªUBy}ӦMa޼y^x!l۶-<{^8㏇kf}7 R0Y!7_vV^ @H54Ϊؕ] yHVl.6r} @ @@``rn-Iyx <#‘G&OiS2eJ8{ްx?}ёvwqG"\ @ q䳡WDfuM @4 XcNlʅ(Xs#\I @$(,}K_Dqdž_o{.Ə.C>83LZ-P*Ca?| H @"`9-3)*{b[`z @PZjUx'+QL:5s=gǁ~s{nǥ?  S|>N9?NWTT#PH/ @ @E֘[oXF?YcFl_|oz@}]G @ @  [u-o~#[.r(+n__ @$ZsO(F@,[ a @$O@vl۶mf͚bp1/\Kw%@@]Jյs@~sek @ @@1oNDD@`7H;XAu @%ЖtgMAF:0"2LdVVҕ' @$@s&IL3ײ L`XE` & @R*{-4w] @ EɞF{|Ϋ @ dkI= h\C{L^ @ @ 㓞  @ d.  @ @$C+;3(_,M$,S @d\H twwGnO812"c j @ @R!CP2~0yu=N]E}[`цB8po{U @qVD rG>7QX m3 7g_ @ @ȼ>gYwu'a\ԡ;] @ @@`xrF :{B!:+gDϟ  @ @#ЙN2Mbə, @ @Fz-Z~߆z(r^N;`׋R?uxr}AvMuG @8 (ѬZ*瞫9|0r)fͪ?&R@IDATp 8*&4'ܗ-[}w@D?s~BZ_k-]]ػ$ҠEΞ0Za  @ @@֘kq_u95s~ߍry~oŋ/| aĉ#_|1?Cu9js^<J LT _7 @'`9S5Zי_2%@g4ڦh@yl @_@vL K.>~顭m/>>V^#\T%/})R|׿>\tEryկ~ʿ|̟??˿Kԧ>Ux}__}1h]\.V-PlߖDj=9?9J @'`9s5z39d|CD9xi<6Bo&N׼AD @M 8D\0rN<@MozN/ 8<̙3|`gw}wxGr^O<ʖ;;.|_ 9я~4zѬ^V\YI8Y_MIy9E;`vnVqK @!`3kXgs~M=Z\ܚp;(7>_S  @ @ - c07tS$׽u ݯz}Θ1#7ȵ |߭> ӦMqr~a;nE +7k<?iӦ{ !n՜b-Pu|˶@~sԓ6  @ @ Q֘1]q\:sK7Ct~]w' f$ @h얰6hooo;ƍ/=Cv;#Lh0|gkN \sMm۶ TM`ܹ;p\pAvOOO{+׵|[ lR馼kzyG7M{qo1klRd' _%H @Ɯylי_2Eصy`7 @hF"X@yPřgy瞋\SO=Ui|a߿rS:rnݺsN\)ĭmr쀝ܹJ 2$@ @@1'c[u嗌o(kȕjyݻ.b=m @ JVn^xu-R]G}t|W'3g Vo6Bvp ꫯgu֮ye$Z@v/퀝y$ @ `95z35d|;DY@jؼD,PgMd7 @*o|M:X }wh* ʞ/^z X9Pi+gڴi{՜/gqF5y'n ЍT :zR#зrS(&gz  @Rs5k\gc~VV|=x@Wxe# @ @u [g?rysp0k֬>_`A/rbtc)#n޼.,g̯U0~Tb){?m1BF(=7S @ bk-Q 5؝WuVW^;Y6֘+8v*1I{FFEl|#Yܾ @+s;cƌnCOn׽ ?"}uYkxfezqvn  @ jحD_"p /r4/~nh_%ƍHw1-~Χ=Εv(uo7 - g_HBb$@ @ Xc ki/߮Fיn2Od͗h  @ 0U%;Qyg;3|/`V8O>Oŋ'>=2eJq>?UmcH_qhe~Gyd5k./_6o{E b)Pܖ 0deʌ@nvW @ LkV6CޣZcnooK,&+3Fuv[Mxr7jz$@ @`WV_X"\~EgqF8#*|³>Y`Ax' +_J(/B:e8^h:H[v}c ϮCvu;WDF`@a;K @ ?kYc!1ZטO:hǃ̙3'{5A,TT7Bqo0?7f A @HLG_/?g>_]ͻyU`ptGGǨiר;j`1 yHz_I& C9n`RG]A@ @ ` buՑvp_#۬gcHq n;,D<+* tnź+_,c @ @P\Gӧ:/ĉ7p{Cyap۩Sf5L{~rL8GG Kؾa}@ WR_!k8^o[ @ @@1ߴ=} 6;>;P4F _uX.:!@ @@+\qa~wo{?j݀ ;M68 .ivlOZѳFZ@;z<hA @v-`yFn5شF'Й褴 qC  @ PguGw'|r §>pg vfywnMۿoߩG,xU`ƌ~rzN$;;N _K @Yo@`Ӟ_Q"+-H} V @ 0jQ԰f O 6l[lŰ>?^{5=, xgw)w.]Xn]x*Ny'=S}%ӧW/ ~֌F׌3Y"]>_ @58Ϋ5c vsfȯ9/]&2;xrٸO @ (nuwwxyA׿u>;GefϞr77aCΝ;Y> `+rH7~_ ;>QSlT~MM`(mv"&J K!7ok @ @@1h2vJ#`vAq:zC#nX$@ @@K^&mi7o _UE<=puׅ~O|c ~zrA wD} 7>xelL{~``vध a ) @ @@1'gFӾMKye%%# @d\@vK.!܈_:p72˗-[.\ppby/=A)ध )B  @ Fkɚմ=d}6g~k)l, S+:zmV|m @ d$/pGիWWWnʵ >(,U/ZJݵ]-]e&@ @ XcޙL2} 6%[(;sJ߬f#'e#QY @ @ # [<G ./r4~w}/~1-dMP(o9^f͚WEWGyNKc08 @,`yk ,8 ᨏ ,Z_zq܈ @ Pwu'{vZxUW],Y׿p~O 3g SN{ @ʿ#ou+vE-OPB%@ @, Xcl˕@2o{=SWK( ̇rs1\ @ @@``-Z7pwG3τ|oB?'@ @ } @ivn({ly{5 @ @# tK#=@6wºWS @ 0}W^ +W o8h@1@WR?} @58t%gD3' @ Mpm /0a} G}tc=._lrd#@@xc#4^ʶзt}2 @F0(n Br̤+ ,\狜 @Pĉя~_l}5ׄx tuuUF/ aҥ??#wq6+BNH0r( [ @4]s H@:1 H8P]% @ #Mٳg=Ո[l zQ.P{#0*cGN# @ P/kIʕ Tr}' @H&L??}kUCK/4W ';`i6RZK @c"{tY\B @TsJ'VZ2 :?dݕ/ե @ @JU9s_rx[2֐ګzʔ)gݱh@y{'yg2l.@r-Cb @ @ XcNJ@.\Yc.6z9pG<o-:I9 @F#{4JU;wnC9$\uU{;8u]ydɒj$JD/X`qI @u\wR p;`'|?D`{n @ @@2`7p֬Ys 'Nk<._H@I;q(nn6 } @5:AtRD ,\G @*Жиƍ#qΘ1#r;lHMz Aq 7.-o׿>r]EQvtދ@eaQ4:a @ @@1'}O {ldy̙u̗ҏNE`:;`e.A @ (o۶-z=\bڴia=]]][n;!@@#&M~6!:m@{ϫ M @iƜٕt p ѥޤk W,Z  @ @`墿mɣ?[r!w#. R]zz8 J Qӈ @T#`5 fn\:TT$FѝXJ`}Őr5$@ @c<-m Ȃ@0͙qZؙt  @ ةFI @  ?G"N ز^ @ @cۨhL`'B`ẾD)H @ (z"@ YݶZ Vρ  @ @!;,׾R ;Y9k%@ @@`'qL ;&Q [>v @ @ P@WM   @ @`' w6WSF &Ub0 @ @W3_Jor2˴µ}_ @H$Κ  @;`'p҄Jd ,XW9{&@ @ Y3gN(j9}PTs(F;KSC ~b?"'/6 @ @@j1f*%B,\[#@@\G;`JFu_ @ @Hg(= @G ˻+4p] @ 9vN\:Ko0C[ @ @`5A .  @@ rĔg)= @C@vC`5W4H`„ oo# o\WsajԼ4#`'mK @ Xc.pTڼ;!@` 쀽sO @ 31 @mmm _B(ut׽O@eaC @ @y{B @`lX=}[۸5 @4]`|G4 dRٓɼ%-#Kl  @ @ @nl(ԭ? @ @@`7V 0@hN*P|+ɋ @ @,` @uP]F @HžޑxF r.KG. @ @ @ ,X1 H @cP=v3o @J=c|Cs=4 @ @Z*` @P=j*  @Zbgwz@r;q&` @ @D`˶RxYA @P!`ṭ,F'< G @ @  ` @͉ :bS7ک@+s @ @ @Hc$ @ q1 @ N)b Y:K @ @ 0:kFP+ @h(ud'Y.{d @ @ PS]/ @ @@s`7(ȴ3=L>7L-i @ @uv^ @ ؍q+  (ֽ\%I @ @PNH @uh[O:"@TJf͚H.ok"rahiܜ=%y @ @-[BgggIATvB @ @@:{# @ |>qwݚb-ut $Q Ȳ$-f @ @5 |1_r%5Yxb}!-_ @$F@vbJH@'@M @ @ @@{CxjS1 '@ @@l`vjF;=s) =v @ @ 0P`ھ  @ @ F c4B!@@ZvNkB1G @ @ @`v @h@[KG78N`ĉ;GG^ @ @ $;`7 0 @1iNcͼKӓL @ @ @^(RS4 @Z@ @J]{: 쀝9 @ @Z,P.^Q @ (,*P hg,Q[Bߚ͉Y @ @ yk F$ @ /*Pnh:'O'!L1 @ @ @@ ;"$ @.; @;`;d\Gvƿ'@ @ @@O/ނ6Z7  @ P7#  vf^ @ @Y ’ @O@v,D{2'JW0 @ @G`  @#>z!@{'0ngKX Ge+g @ @ @@پ  @b#HB(;ri3gFأ.=?\2+iʏ @ @@;wnxg+O +N|;` @hI _~y$~`wtGrA =M @ 1O+Yz +NT'rw)|fnBux @*0 ()$2y+C)ߛM @ @5 <\N @P]/I @EúAP.v @ @ 0zR4ZH5})Pz @H̕H  HR{w"4F~ @ @@z ]Mf({` @ @m [ @ɓ'uE"6mZz,Nc6m/ds @ @/}K*'N3=Q`+|G1}8r"@ @ Y 5_%@@S>ຍS[_:"t#KCW7.驈 @ @NgP(l/v PxΓ&U @ @@khg>$aN5P& D%@&$d6 ƶ~c{mg X? ˒ <QF:UwߪW }ys=Ǟ|w @ 3:`gf%Z@aP߰ @ @ Wۇc @ >22!v&Yu^so %@ @ qPORmQg @ ma(#vvZ S@ @ @!@$,=x @ P&2$2T -0N칕 @ @ KHl & J? d @hv[( d([[ Ȏ0ɹA @ @@yؾ Lik~% @ b-&vv\a @ @  0 @`tB @-Prr  @ [\-F[(C @ @w<(~ @hQ[GCk2K \D @ @+;4B?/`\ @ @@ `RȚ@a`$k)˗@M]55 @ @@L/y3 ܴ- @ -@*沚 )[wc @ @ yh0Ti\\#@ @@`J:Ƞt),0H @ @ yؙ{*pQYǸI @mf&@4 DQ>OTw3zj9%c*ZvV^ @ @Nַ֯__NC sN28;!D>xggeJ @@m,I!$@ χ/s1*. T ;нrEG @ @:@/\pA9N:i<qJg @h@w떲dM e-e]!GF @ @ȢYu9(p֨Ƒ @ @@`7Z| PL@UT" @ @P[7;`q<}7 @ @y͛ V;"˗WzRuq2)L-i @ @8̫WWqݷ0:g=D sqxB8,+G @$J@vC0h@xH2:c7<l&/k @ @ ={7lU]p@ @ (ne E`.i˙@]Xic]L @ @ L)I ik) @ @7vhg ɁBV$ @';{{.cD@0[r qV @ @W@y.7l2  @ :-e%H@wwwx׻UG]q^ˉص(CR =nOʙ @ @h_0<<\#(u.. nؚo{  @hf ) w &4AFF[vF^ @ @N?PZ'?BOcY;K-W @)ŭM+v̚+.`v @ @i;-;% <P @ Й ;s_eE -@JrWₗ)>a @ @4H g4idK@ll  @h[/vo$con%@ @ h(% @ߒO^P""@ @@ ( "IJ( :+N]&@ @ PhwC3, \9Rr%@ @@[`ݢ| e6K w]͚ڼ @ @!v:IL!<9PHdl"@ @@(&pG Oώ @ @OiBYa.Yo @ zح7"2!v&YMw67iv @ @H@;$ \;#4 @:A@v' @)BJ@R`  @ @4T ?LF kog-e @ @ [m1dG@L#0z͙ج @ @ vvI L!<F @t (N( $66H@Cס$ {%F @ @&(n)&pݖ(k)˗ @-P2j  @ [`.[ ˖@\[ @ @@J) T+pf @ viA @ :`'tc*R`  @ @4J Qɰ:`gxN @@`7[Hh:" P)  @ @@ଳΪx|' @ @`/ PE@*(.X@7CذY[. @,Xw3:J ~8p!T\0{S D=z?x3x @ @@6o~BK. /| sD:`idy \9 L`|#@ @@Y@2( W_‰Fo0 ] @ @?]}{_}uh \PT`#  @ @`F3ҸA{r#0@d @ @ :`xt;ˇ8a @P- 'vL+R @ @) P@X{}]k2 @ (MW (PxbW۰ц @ @H@4 L =<;=%R @*ЛEXhQXn]G}tl'`.n6",X w]a G,x @ @h__/OlٲqM59D` 1 @LP= !^W͛082g=H@mKkl @ @ wq5O~pޏz6>]O~aZF @ @QUwq)< 䮺;QF @ @H@;m[& 肝=1 @P R/P;( 0zS @ @%{^l"Pz%@ @tM\!@耽<C wu6 @ @@C) V);&j @#;9{!tH@;R  @ @C@yy@}S2 @  @:`7BGwpe @ @)v0h!H5E ^ @h6[(v',.I @ @)v`X: 4 @P٭8#3Y *0 @ @)4paHÞ\EM @6 qmK @@|8+";‹^k3=#qjf%@ @ P^StPx{S> 4VPnsNl6 @t` @^(>Ǿկ\vM(lȦe @ @\x .(=餓(*?{HvkB @@' twR2r!@ =AF.={I˘ @ @3KV,p(  @P}R+;[' ~qG: @ @Iyؓ4hP!@ @`ne$ jeȭ'FF9 @ @G@[56g @P]Ȁ@?\s:`Le Fa{7 @ @,@_z;<[vVh՛FNg. @tb  @~0s]',\`> @ @4@sooo](p( qg4 @:[v4@02BThL @^%w @ @' %/&Ȁxn4LH @(nY @(~@7l cϴky @ @h@~1 @ UYyy @ &jJj]r{C#@ @ Lh0q@`g`H @@`7D Xv{w @ @ < \<=E @ (؆K&0@;B\(= @ @I$52qxBS @hF( #$h@0vCm @ @(=N`a6/lO @ @ # 3$@@+ V,c f]|,w"@ @ ph0 @g \Qa @ (؍4}hŷ? @ @@^|1P~":+uVDj*hŷ~Q+ @ @׾nݺGo|>i J(DcZ @ *ة. @B!|߬XSN00R#TU  @ @2-puUg>餓j+뀝o'JM !!@ @ q݉H@ Zx0NF~~[$ @ @NwX~)jc  @({F7 @^3@`7 @ @M5ib PƧ ݅z3 @L%@'\18Dd\'zUwh^ŭH @ i>;<E@KJ]E-Y" @Hx  dE[ne^=/6h@n<^ywXPќJ @ @`BCOvf D+WD_S @ nt/zHI aa @ @ `zb) \9 8J @ ( 03LM#komʖ%@ @ P@ 'hX7m~ @ @  Ӽ{b'@@ E$|8LI @`e4 G9/fq@tn  @ @4YQW0= @);&j$N00D@E6  @ @!)NF2Ko/'\  @ P욘 "@\C'@ + qn +[ @ @@ 3@ktnU @Hth  X5˸@<<rWnȸ  @ @R!;$ \xr0 @P= P51D-#kok˺%@ @ PuqLU<|ܪC @T(N6 ;{$ \tKv9 @ @@z`gD)nޖTΒ%@ @\ rj&&E D𱶬mQ @ @5 kj .h5 @$\@v7HxHi)qfU`[  @ @"vZvJ(YK @3 (C cZ`dV[ @ @v8·PT ]i1 @$Y@vwGlhX8c*oIaЋ9 FܕBamK @ @2#O|[szn##Y  @ "H@aӦM޽ډT\# (.3,}+P @ @:Q'xϼ|=*pQ  @  @@ #)@:_`gt~2$@ @H7QgJFqr, @fP= P@7Y @ @8㌰lٲrNvXxgq@x0 ۗB @(n E  \un2hnQy @ @#pgW]`] &@=?0{Ӓ,nU @$H;AR,8zȎ@ۇ @ @@ą$  <;<~ @dL@v6\h͒5/ @ìƪ @ @` 64 \@Ԣ,C @ (Nވ;U%, adY; @ @@ -b"PMƫ]v @P,'P5or3 PXLF @ @` %< p>)l=  @ @  +b"@@ tN 9#(%N @ @ !.PCrcT @Ȉl4  L8X307 w km"@ @ @h`xV \Vz[ @ (NޞsY.0N  @ @$ 耝 9*vJ} @ Qxi @FNg.Z 0ʖ @ @Y ?XP h\o˷? @ @M oYt@<v'\!Xl$+K @ @ DɏQT\xŹ @dI@vv[hM5-& &`z @ @5 D:`(e\zXB @V (n Ё ;pS *FK @ P#6?SO @N2%@ZvQ1tٲea&#O k gD,L @ @4 raʕ@. lR?8'A @M $@@J/:蠊볦 @ @RϮx|i͝G48#H'.& @ @ [l t@< Gss @ @@*8B{Tl Ly[>\uJ @P{,C4]@[@Fi @ @C @ bꂝ @PL]s @ #HF2&wt^b2"@ @H@4XEJ4_ܯ4 @xގP P@___7Q+_ʊ':`OqN ]#?),9t-Z @ @ A83Z|\@vU Eʍa,E=]i Y @X%<̺R]'0_ @ @)pꩧW͟@C $@ yCc!ܰ% vt_ @$ݤyMKrV:O 0vKLF @ @( QA @NP݉*'X@[@|Sf5% @ @B@.}`<ቍ @ PpR @ {H1t @ @R#HM%@{| @ @`wJ( Zh-Bj: @ @5]!/p}`'DH @@`7J<Ȱ|w@ȏo|dB @ +E` @&6T:h@a`Z +n @ @jZC@}UHx#@ @@c`7,ȴLo;H wņP=AI @ @ :`bI_ܧ v-N @ ~C @q!eZ[7%0#koml!@ @ P@~qF x`'~H @@c`7,Ȭיzwn̤E @ X5#PaHnj'@ @@`nLd # H4,H;~A&@ @O@v}^FH@>G(4 @4F@vcB 耝٭x {FB:4;i @ @$R ?ȰE~~& @iMSb%@  vڊN8pGT\waNlA @ j;#<#eoW|>@i$.H՛02%}]iNC @U@v{ ,B(ay}iNC @U@Uͬ '@ @`wʉ-(nj"@c7=Gn#@ @Ȋ@vVZX{xv9 @+cVbh@A@[@tnu  @ @PMb.WvֿO @`wʉ-r-\RC`7cYk @ @dA Br$i*MO3m y @:O@v R[m1mސrW[ֶ( @ @@g ;{eGku@ @@ ( Z-jsh@!?Z @ @  $)E.g @:J@vGmd ZP:_hV#@-߻-Z @ @"#W' aN?S@ @@( Z.|M  ܕB~Gߪ @ @;89 0Y@  @H@o?4V |b7xEŵIA4t@T?1ul#@ @h~p'[fMG?Z>8 N(`NNQn @dH@v6[E χ;bhx=:`W@9!߽Nv @ @.T't,:`p;ˇGvaE#@ 6KunY $T w]!="@ @S@t S`|c @Hdh *T` ,X`<F~|ӂ1 @ @2Y r$@ ,$)GO`x|߉$I ;C߽.,?$,S @ @.]&g^bsƵq!y=)gW\ @dK@v[STls9Ǖ4 :G w靡k(t￬s  @ @@C?PDžs s(uZO* @:X?+͕-PPlcHXtc @ @@ -d*{:  @ vm @ do^Ow9tUbZz?t5M[ε H4 @ @%!ˋӤϒ:u*? o|xlw @R,Л؅NmHr쾗_vtY>de( x+zPx3;,~݉ao4,z1aK KC~`__8DlwΪ/Vs ^pEX>oAϳKӖش E'>w4_][@;ai/lMsFFC<2xs!dl!}ݚ2hQSB'%ѽ_UD @ @6|v _;xhO8hYw8pYW؝g aKkB9fQ:7~\OxVOXW̽]Æ7o v6}_X7yw8hЎ՛5s=ḃ{^ny{Е[n1 @*О54 @@ {۵tuV;wz=8CnaFgqXyoezsз Ƿo~zgo*;ZQ,.~3gK}ޣV:l<y;z}V8oZO+M)^SŠqzrɜ؋Uc6Y( #.ݼgZ*_>] @ @ D(c_ ?/ W\hZzg}(hi[~ bK~~a<|њgi.ܰuaا;Oy`c;,k}ZϽeIx׋.]׎ VV]}=߹Y{CMxtw!<[ @ O  @ }]ɰ_NMS|[.:鹵oRׅCa{ׅ]0BaPŪwZX񇯯VI ^b ?ӡCZ @ @" r3N{?}⚊fyag. 8qaݫSb=8b+rgwɟ( {>co䕋Wީ{>kz1'| @ V֕i@ 6]KWO>zV]aCpƖ:z]|uա{s kÊ?~s?o*:Rqp8gR*Ļj9X ]kk#;jyԘ6 ,9𬻾  @ @R:`/.;\^ً*; ؃K&޵-.u^"οBWu,+PKoz:pEGg eC&w:S.w|kXxb{=&K?/ɊP4 @Y@6 @=1]ݷ׳g,l[aBy{ycքů;1Be륃U@w{>__Y1O+OVгjyyɸPx^EΥOLx_Xw]s,:RVwQ@IDATʅ }{]?=0d]}={ŒU.v.gtLbC~io2s @ @[X|B-G]G_uToO6tkus%y87*r.8߇µ"v_8|\͑PϟXi]5؁=0^t)4v)mznBSx1U{j;ˇT9=kVC.!,v5 @ @-рE?qi٭ztxu.޷_O `(u&Y}Òɗ;B:;O ,<.O×yNj??~4s{NϿ^?:g!pBt~ZgdD'  @,{fwT?\Su̗?y晡gy\lV ;w g}<" s\8S)R YWW]TL_Vˋѽ^oo{MS:HǹP*~m5Ӗ(l= 'vN>{\Ա{ם w I=(c|#= 'Or'!\?WŮ> @ @z;ʕ#w̕j췽hQdKԅZrO7bΏ_S%UB8_,rm*OGn6{ ܉u.bf[>nL(&@ @@}Y dNs O4cu ell,|_sN(n䧙1lܸ+ߨOFړ=M^˅ݟ!WCϳE/zέ!D{Ð}qTkNsZ mꀾ/&(P S0c9xe`ڠ.\tk !@ @~fs=c/TcG>R=hJbK3pGwW5fTnzDWza=u3M1ϩRwU=5sN,P?046uXC @ LE.^mW֭[W^C É'FGGí.첰cǎc֯_/O~gz|(e Wp@|YJ]r\&=]BaP>(Kvmطl푆݋st.۫7\֗WWT=յsw 暿~-?!7#?9v @hʕf?kV16l/)o߾|\qPGbZ/vy],}X8l9{oŚ >ya=wzae7H{:|ļwguU/XS]ͯ^B#sv,kD{+]zK1BM2[ xhG!lx<Nx?H@B @ @@Y`oK&pm[{B_vꩧwxxG^~wc9<.ߩa/+PRpR?~#yUD۽rYX\*o7>yV=K @2%b63cuG2>n/ ]p/Ҫ*Xwn >bCWN/x.=?#v>=/Rzg 5e]a>`i״w[{|_]7rEEN& c%  @h@7- R"pC]jU}7׬YկP}̤B?\߶$^QلbІ ~JK}kYwM}&R*О:KG7/<D.o0daasO%oeK ãZZuڀ.~дQKN^Vҋ EP,Xwcih1jbDшJTT,XwPQl "JgN)wfvwfwfv~޼s]|o?b*j4(&ɴkKURq˹eEÓ2e٥9R~Y^w`w߶56U궶ҟn8kvJsթ6<Ohn.*[â b4oׂ1Є   ~p*sw!?YVG7<kvRLO֟U->Q),_\*'g$xkvGOP*?-(:;^mfx,*7P&[,]M\._]W.on,.)++!$z oحqhbw+Wnk;}/&DX9lzlgkj71n@i ) Yq@@ѿQ/իW𸵝 :th'|NcXre0,M5dH0HQ,=+#2v"v %_bt|~w׫ܫB[T)Փ $ЃdsyT"A5b[c=CSw-pK;4p?:]O* mTzd@ ^4,@@@t nHe{W&r孅_uJžpn$"!M?!Mdj$3s#D_|vM\vH lY- ]?34hUD%U{xLu>yoTs=@Tַ\OZr{w#Ϋ?ht @@2,&b JMMM0>}ݻwK]]Weee-ޝtİbŊ`8#FϚ5KfΜ)k׮KUUt3fjl+6_O%&s聧mR~RWR2>IAMq響A=c7VGv]xnq$G_զҷ.%U_]tqxu^C68$Y'_m(y;0@o>'pۋ+ezeAgͻ6&Glu)32Y@@@Ot<ߍG6q9@'m-wm4@%g_F|WvbU1zZC eDZ{:挵"slbVOIm#cT޻_DoW UćtoۯNO8)7蕶=n2UnTOVշO&B/aہ Oc,xrG-1+eɆ*FdŽͮd qTbѻLZa2@@@ Jn I+T=V m۶%`:'V E :JuQ֭['3f̐I&e]&wpı3a/d0`\.ٺukoŷF]ra²NiI̓=5^Ql-l?59BC"y5*):f6mA1O7]#EųvĶI0!p]J?^ߖ)ם!;Q4#  @Ƌ8z}wKgj۲eݩyvn t0 K@@@L֛Q](d[RRw4ņ͆xRÆ  U~>}zdh@'ȿ/h"ٳ#c+&zN ꛤ֗t OR HӤ;=Gk4"-eRu%iѓȏyN5Vۺ[_1*xD`#iTq>2Twߡ1W?kq/\'ϗ<ި9\娿J?NJJDW_ڦR{óԘ]LeERgc5կ 4v@*+`թdM    1qt3fX3fesxblE=ܵ-]ofMT֣,gm ѩ>Xѓϕf5?gC{1 Wmf))9r/pɤNn/OIXN3?Hs׷Ů*t\tDYD;k|](_y1q[bpLWl>r޾[]bVjk5761<Щ'~IVsתfU9Wz$mU' N9ہM=^W %g=ao5ZO $\G+u[CؽiE@@F?wf"T>!1\Juuw}2tPC+g}2~x T~'l. | \_??mXk# >P#vvoNǓWK J͕Wk`޹QߋOUxsԾ~P:=(oKO2֠n`!R|Ɯ+myo̽+:o~jjsu7),^w _6b G:`yTor~ğ sؕ5G:WsKi?\   @ n.gTv7EæVksF:`Wmѓ_]3J䈡.yjԷ=O?fU;Xzu %NJ*V{Z jg>{n^`!R+;-3Kj0'UTbrS:3yUջJ/e=9ݷ^\+ޭOg$ؽyƷq@ whx}ʮ溧>]Ѱ'IzeRvI7UVW,$Ksŧ7\ED?   ":21{g Xu)xP۹lpu/5js1:ɮV#s*,Rzumve)Oq.z.f-^I$:e[}.agu J޷7i+ބ ߿R0Śfgtvۧ乱ϝ}U|m~8${=!  X6heGؘSlCΩndm~?aHGZY󟐀5Y@@@2L 1+L#p{񌹠@1> ^]]3pLW֥C1YtQeEfx~ (8}rSvyRQ ٖoz"wC&}ˣՓӱWk2&XLr^UMB=;2?FbJW]3|boЈǏC9G%#   @~Oh :#IӍ'cF+^"mkȾcum{"]l6HVs?Q&0uO~ G eҿڟ<ywSmdSʎK66b^ge`)`o`/w긨w ~)lw߯EIJ8@Iyopx6$e,A@@@ "F>mkm}#jsF?8oX}s"ZW4_XօUzS5->9 |*/si>Sf9:ޭ$`+kTڏ~YQKP ?\i12Ƙ0>fM+a!   QvѨ ׯ͡*[l;Ⱦ;&/~ 1ĊYԐhʒx7WWrb| 4[gʦCn_?,C^H}_+iK9gyd5Vdn)Ӻ[_Ů~]zё1Qaop~yK#"{,⹠Ǯ?~6-zIL"Qϥs'NhD:# J fyCOd!Y80o䶱>W땸UJV1U#zus  QJIf#pg9eg{Y{߅E_K    Ba:KL^Xѵ-ŋO92ߑTŠ_{5Z9Bqݺun*ɜ-\.W L0A|[eCKǙ >M(,뮽]ՖpsunLOf /&%8dgIJEGvTnˌo moφb#\`)=LL/\M{:q-X-'u\C@@@ R|7QT3DB~dͣ6U/=Eo. q+&PSU$; F%[қAѓU2sdh+FsnõG5l7uկt 6~ԽNOhluY,Ȧ-=Bv   &2VzH@V7nd@@P^gыx/#wCzTrm'dnFv1'o~oAd4'a@@@HDQRϘ  x瞮 ΐ;{^:<:p?jS=YN+T@£?c30m*vUԫ"E5    "`N4#Gq͡.of$*9l63fLC琢BiRSSX;CmΟ??$s92xNv nL58,7蟸DWni ztF@A g{1ۓhvf2c,@@@R UwFW?gsVH-袢V jZfl yn%SC ԑ6QS||,Skc? :<٣|G"t9l1uY졃__M)}1jsX_HYbL6 KO M@@@HT DG?y".W\!&L𯸥E?˗GtMҿ쪶ҥ*Qߗ]vrM>]fϞ-rnҥKe…H.WwPl# ]`O=_~|f0a]KyuaF_3s`C訮߉j 4x7֊`.&{)K_3{P|R|~Qݛ^, *i}Nq!*R4nlk@==jD\? 5/mP׉)F}_sֲOo})7 4   *绉z"1'z+`E%b*Àbrh&l4{p͑E2 \ w}6TUU?K"c+7ɹBN`:U\axOc!w3Aߵ#J?bhhfve7kRVi<l->q_8#@@@ ;o0K~3۷:tss?zٲe^6U㏏umA%Yu]r=ƍ;h{^u}'nWTTtx=\ڏ .3JM2-T=0Gab]m6Iս[>^$-|:{{D%`쳫^x4=IkZm,JKNk4>nT{g*0DSŷWOfegyR+`s b=j"%?՞UMYRR1H|6mD15b [9Eb|櫮{Tl3WF"}LXqU}[N,X{|WnkSU#m3[ m]u@vOL~5lojMU(%fLZнhXN!  /oAJ#{LTqAAW)ѣGˤIdر)IU ɓUŒֶ!Cȍ7(=TUU֍PzmZi`'W^:IL&T?r=3sVwQm ΋lCzz$nE''Eɨ ~+<Yra R#`W%w\ }sڛm1ϥI 6@@@IDmSϘ y߫Wl^͹=p|7=COԓkǟUU=NEp`"UzfoYX TZ}z짎 UÝX}ǩ22xtZJl|lI qL: wo+g:߬Mf`W}lڧfB@@@2U Uw]o*sw!=)Z#,ɤWn|ͪy T/*+-J*qO6M,UwݭwPxC ?sWꎵ߾6)}zeWd=ds߿)u:cK]=/ 2@@H d,@ Ob%_d-&޵ң?!qb0>,=UiϊM^A:XGo6@IDATY[ٰ]W6Vynk1%νG~o=!U*co牊õp>ןm_U>ؚ+/_Tn_h H7$3JvkHVkizvN,1{ޒ'tffTV"&D@@@ ?N-ZtPEY\V땬ob]W-T~Jpr#9_2]z^q+I^i9|;eM*mǾjOj)7յiu?kݤJ<"B˶zţW C8Mڼ߿,v275z<ۣ;ng~:jZ|WO^zL|>XY OV-62zT4tJ`Gȧ=*,tj`.F@@: @vи@(7֓)%?OٮWƟf2Y-bcu2FsxVm8gk\j|XN$ͭ'_8^ (;PۻVz7QDjoampo;nsw"Vu;/KuYp|_S| i;ql4Z>Z(-;    *i^}qȾO)${ǟ{BԓCއ-^Mv6"F@@ 'Hʢ@h>8^LxmLϤ49G6~TT qCMH'RŻn{۝8߯d~!0l'ʉ^!Дw9+n;0^U;MUO!e:.xwWic%nm-IIv(l    @ ĨW6Xц\#׊V0O߹?;{=99g]n=HG[ߺޏZdcC}#'OI #7,+R/k* LS މn fqgc7E;nkL#RԷhRQi>=3    Hu!䱀IKJ?_p~KeA_-ou}sKzz5YCiӥp`ōXUEmCqid]r؆ Y]'N'SsúfX1Y,m^k gُМn56_n+kJ߉fϼ .׿߄\VܱEs    @ _x=%2X/|1zJ~Ipzx;&:Hz*/ 7k{G^ _Spp\~h43k5^yeK薩&V-o_'^0$ߟnz.^iM%ߒd{50&wK.mLO[L  (` @ .bbW?1鉞*aX%IkmN_s2vabY.2wsx7Պgi~wjӅVa#8Ў;S8fo6_+OKmQioǯ_@@@&nK/'|Am-MXKǭ'OvITpUr൶+ Lg/ dc n=,BW1֫tԫL8RmUIdQ,R]jJX*o]SS]2WJJm8 ߣ$^kQ sz)PZN`˺nFF@@vHtA0 x16dґ+%?_]o{490I7Bէ5_q;19?]"G\O0/8p0T| ⚻R\߬%Ɉ12W>i ؙ{{ @@@HI0S/X| ̰nGJe"hmdRE!UӖ]z5W懎;WrCv=A$*Aw=q_o7zef)3.ct @@H )aeP@ {#,]԰>}HUUUMkplkR&WJ'bp}\K7m9&    ظqdc4+[}-)]&>sJD ޥ/wN,@@[ N@~p\2rH_ h^/ @GO}K@@@@ 1uYƈ= c@-nUtG@@'@v,  1)E"؟)G~Q6@@@@vsV@T=I@@@Hߊ  i:i~N    Y(@v4BF ^ʼ@@F켹,H qd?9@@@@| ;:kF 3Wzds/2    5NA& 9rdg茀T#־՝k@@@@2L믗c*++ w< c@4Wq(\  tNq5 sfYN:Vץ58Z= @ !O)7etF@@@l[ԫՍ حpxe[S(&)   tR@ g7"b)@@@@2NcϸS`]OffgD  Y-@vV>G/vљ$-34@@@@(*`GЀxis%   A;e @ h t֍)h|̰    &y| @ L[Z][H  d Yy:_# ]䦀/[ӘcU    F_=8BN "o|8   $"@v"ZE_@ N4M8c2    @f x23.BxkWVO   }$`g=#b@K|!@ ?2    @f r}2w'WA   M$`g"V@  @ ܋Kˬ,փ    )v$  HFA@@HN _#; T:!   d3!"ԷhV  /@v"D2KWߔY 䌀Y⭵zX    @ cЄpzD^_JP  +@vDt@54$M@kvII@@@@2P )@5 عs7Y   -@vfC2N@wd\L#`Y +A@@@ Qm4 X'_Ka!  )x|G2+'O6DDv}wp@ ER4fd2e,@@@@4 |駲jժr<vЅHs]2z eT@@[G@w@K.Ġ1a 8 @NvU@@@HOlpQF%`7AR!0u[n='U%|!x*|@@v ?  q q# Qk_w[}G/:@@@@L'o! .+߸sa)@@2X 9dL'ă@N 8 Av@ ~1Cm)@@@ žv/+G0 TUU~@ ,zS˘  iOG ;,"@ߝ'5[;=    d1!e&׮\^"kC@@.  6m!/dtټbG@@@|_sX  @j^WfC@@,@vAe*`emdDs338B@@@HLSXz#ޤ󌹓\  1HB @lcЊmo>K    >Ocb&@Ggta  $]줓2  G.!@ 4>nF`     xLW@ 9_owQ@@@HG@ n*`MEGHk*qY @@@@K$`w;"<@@@ $`'@ꩀw!T{Cd    @T \) R%wPFC@@ ;o?G5@ YMd 8    ]!@vW3'NKX   I ;i 侀 عY!*H25:B@@@GO/ )xKx}ZJfP@@?b@$`w @ G$a$@@@@*`w ;"N g<   @rHN# y!58b,2SV @@@@]vxj30:  䍀5oVB@x0lee m ]&IIտ.@@@@u>}34hggOCqHs_ bJL  $@v.Mւ$A@-[5RQm4 ]%`}yb.)@@@@[+js7F5рt&M-*@@r@k`  i54a@إ陏L/@@@@vf@_8@@@:,@v/_}S~-"@ 4[4M8 @@@@@v>! [|2k'""@@&n+ ЅZ ggj@ Z|437-    'UE>c̻1D@~ P;?G@@3$`wFk@<5G"5 7kb%P@@@@ ~׷#3VxdvoG\   $`g!4@ | ͙ ~E✷ @@@@Lp7dzćy*lWe#  @gH"$jY+d@ýT΢E    |]9F x}Kv49X&C@@ Hθ[B@  8^\<%r }@@@@-Ȯ%<U¢  HR  4睬 @@@@ ;on5 E Tv[Љ@@H.gZ@@ _|M@@@@+vrA )PTN)c!  $`f}  @h-ㄮ3    @ii@ <s%  䕀5Vb@p\rAtMr@ 3Mn+&)3$*@@@@ ׿o\#?A2U`F^㑟J*E#B@@ S!Sq "i,XC @& x S3 @@@ uE=gX;DxDMvGV  @̩@@H@]os:B@@@G]O/ ].0sGovy  -@vfC@HP5g.    R )epH͆  %`m$@Ol6E]dX#D6qd]t^"!   9+pai 4HB@ Y*je">@@J쮒g^@ Cl6 vzՙ @@  -@u̾?Do/v~F@@@@pQ#5tɖF`}e=  %@v[:C6? WgkyR   Y"ig: GỎ  @W ŰddzN'tF@Ό    141P rQy.Y[ť&@@!@v @v hUiF8@h6_Zf~ke    @swgI:ɬw[~y>wy{GfI س ǭZ;c! @Pja @&Ƌ&1 @F`X#@`,3hV(PK @ ̳r$p]z"  @XЊFIh4q饗&6_ѳ6pmQܔDNI Wokby#!@@e>8EVL%@ P5Uq @`x_U'x},(O ceNSn @ @|SO>y7|eg;([O @+0˜ @6h쓎 @ @ @q>wAo qr @ (.ȉ @[?{V >4N @ @s#Ne_9 @ @1RGOl8 @ @_˗Ɩn`/  @XPELXhQ\{]4<>j{jZ٭  Ko<§<&  @ GO|'RmnzG,](D lIG]@ @ (Un @ Z-g ڈEQ;నx`?t @`ߎ̷E @ @@IGsKm5YJ}X'&* @_'Q @`n7Mz%@@z~r}tE$ @ @@A7$Pa @uOuh @9P=':%@@ALdI@6ۑ, @ @1OʕZ'Qr @&j#._LFd\K@o?:yA3 @ @TM PTiO  @I@N > @(أ0 Pun4vUA @ @ $sr!Xv X_DeH @" +2$@dR#{ @dos=J+ذ%K @ @3.{I5H@yOtYأ(z @C $ @-cwsպ H @ 0 Mإ('\[DeH @ +0R$@ڦt PjzlzJ @ @3&`8޸S< Ʉ @@E`WtMqǽ@FOobr&@ @LN ؓr5+$  @Y@vGWnI^J.vI%Rz @ @i g& (Oewc.ʋ @ 1β$@LOTF~ǚh9W @ @) gz#U#YY @( 0#&gQ#W`'N&(3 @ @4R?bs-F|r'); @%XPܤFS(zvyqM- @'68ʜ @ @O~7xuUϼx1 'ݎ Pv/\|8hOk}G P>S @`Zz=qTg^{Ѩcv  @)KbϷ{!@ @&pꩧ' @ gy @`,Xb~[b~?u1GC[ "ߏV @ @ ̟?pnyp9^^0iEF|󪾢!~ @PQW,XxqGψ;w+ Pa;R'@ @tIѿ sykl=S-19H @@`oLDD|#Q @ ]]^_hI @h@7Za P6]C @ K;#@Rʾ]߿i h[M @%`Qv  01W+Jl/ @r/;C$@́`uuIb ^[>b'!z @ @LX{&A@>w   @ &`&\̊IfY'S`(nɊ @ 0Qu 0J`g @Q@vGELk+" Ʒ}5RBIQ @ @4,1M@ Pe T@ @r/;C$@́9@%eret|2$ @ @,19/W @`@#[/ @r);"(̱9 PM<%.C*r @ @L^B7sF `#qUߨ#v  @ȓ@#@HmF ll/Rb%@ @LO"s7F \~@|QG @ y1 @ o&6"!@F{Q N @E>& r^6v @̪Y "`r %L"K%\q @ @'`; F|H @\ ,M}ઈI+~c9 UD(@ۿ{e[ @ @ |kE?)ч{(0LC Nѭ @fDF @/yEuε_  @ @@E^ȭr @T@@vY@wLr @$1>ɻ\N @(P (W p  @O`ARLGV/x&rHG#@) m{bN 7 @ @,pc0|ġ<+6Nu ۚ{< @F@viR"E|npc>^m~c@.W?7k @ @ ӟ59LH(@{;ʑ, @P! 8hB&@@KZڼ  @`HnA @(@y țw~Ub{ @ 0' ]ȱ(@ccG<')% @ @6 @YzГ. @Y@"> @VO E\_,+ @ @@kR/bhzǝF"B @, (ep @ V r lz﷢r%% @ @˜9i@|9[ @,ʣ/w!<r  ::e- @ @&`Y 祽qr^ @̚Y "pA&#wͪ'! @ @0\ݱ9s&Hǝَ @"{VuB /` 2 lseJI. @ @@zbr&@ ܿ9{ @(H˓09>Q) @`f%J~c`S̶5 @ @l Xc6Eμ?\޷1 @hָj09^ܱ9X16 C @ @@uR;2'@ UC(b @ Pjإ^ @`U!;\@IDATr) 0g^u1 @ @ xQc td `봮E @@`V(@[opL@[~oɲ @ P OY0K| ,_;'A @@`|O01>#@z{4:MOЍ @ @=47v8ʾ`e| @ @`\SZ"@ dOĿIeӟ]9bfAbmStA @!qz >q[:̎{1?|# @* *\  0׵6lQ<̘@w.o| @ @B;F1gmI-V H)7#u!@ 0=s7%ѐO P MF-H @(@jd^7;I @`>0yO. @ ('mPO 0@^hlR  @ @s+`ynN]|ʾ8]u @,M!@r ѐU G0 @ 0)mOYg/ zքưC9xY]7"- @r (.xʆV'Y0=۩ڨha;ӯQ?uI @_[ y @@~F]q_{,L~"  @b yKhIZۉ  @`>xJ^b @ Z)^ _7t7@ @( P  r-'%PoDuwM 7 @ @Z&m억a7da{ @ 0-s3J&`rd* @ @̞@!zh @(3@) DoAH/H$@ @*#` D (@tlNj @) ( PB,TĤDr 5ߏt7ʙ @ @b >T̸EM lHS~) @̀@J!ѐFI P-t"]QeK @Woc~c.pDZg!~ @ @(⨉;ֈ3a @1`*)л~8j-:::!@| |): @ @|s6߼~S|ʈ%ށK @̜kJK Phm)Q|0N8ax},u.V G Ͽ jˎm#@ @J&0_S~QN _Y6[7;_G @9}0W!п)5Էq @ 0 Qؓ˥ S\gҗE @``ݐ8DA3#uwk$@̴ @ @nE>v)޳<ѠY @@k`U( P1 & nH1]B @VSo ⯾v @A`| @j ZzS?ǰCog҈;.>f $H?jG}@A  @(@E3>j @@xw:̿3= @R`d棕h-0ѐ5/\8ogE'F[(FC wbŇF-r @ @E5O͋!fK7og{^}*  @ ztO2x4dFQح@ZHk$@ @LYv%8J-_Ʒ[%G @`W w%8$J-W*Y;r @ @`$\N|ܞ }IH& @&({P.#@@Y@hֲ'/Oz7w @ @z֏}Q;~t"J $  @`S!@@E</m\Q @ @&(`yP.#@@9Rߟ? ʊ @ @qhJ d  K;"6' @ @c gATI` ~];aWiJ*  01 ߚJE= @ @0<1'W @F;+.HK @)T\g\Q>Vx/}!@R ߜa"7ώڢK @ @ Fi ]r ېUm{?KnN2 4&+kƱO^XTF Pq3>N+Dɧ{F|-N8x},u.ZɊPT%G @LS`9fk'bd7|ş%)vF`{W^4~) 3p%@I]b(@+`/A @o͊_wÔnw @ Pshi @`r"we+a־j @P]&Z&гeMk .qG~?H @ @ ka&@" wߤ(v @`(#г:ʔ&/yg+_ @ @=˟  @`gu^;6H @   @`v*^~{p'}4{>f*&}_V}lo=TK @N u?)=o*v l!=qe $N P.O @`Rvz=$/+3vG@ﺡ"}QK @R`۫͋֞=FO @#v _ 0-5Ӻ P1HWAV,q @ @)  祽sF @@`qL01>S!@@u''k^W'g @ @Ǯm!@1N/}zw (A @B(.0 -P"X @H׿1*y#@ @v'R#w.q)[-r @  s?D$@@ `W(@#-*{#@ @v%л!"wuq [}#6td_"@ P00 @`&RlN[ PEUGc"5/g @E>* }L_otĪߘ @̢Yr'г6w!  (H׾.[𪽀  @)ӹFVoIov/Lj= @ (v+yMJ :ҀEf @ @@+ @@_=<#n}pTyI @ ʑ, @`=cOR|[#O9bL\`:xwǡϕ @ @@RV$]7f߿?sX{_hk$@X5ū%.ٝs @+{vF 9͙ǙY<`b&#H(߉~ϝ̝%@ @*л!"njkq/F}1$@ dRuZwv#1V}."@ Jyl\ c59Nh P: ~YQ$D @*)3"4̊]o߮ҝf? @؝8G2 tWFyVJ77#@w# @ 0Q.sr̜%wFD @`  B`7W}bٲeHY 5ߍtF;'  @nxԞ昳My7 @] <9ū?oW8N @ Zރ @ wQ!/Svv؛o C-~s_qG/vs @ @fW uݳ=oi' @zq˖8 @̦gS[_ȋ@:y,W^C@}k>_Y @ @B )G PHFG}rM(  0e{|  @ {B+ӌj @L[Fa x;&w  @LC@4J XC'pV`u.{aug6E @ @OZ"@9޳ξA Pfe] @`]q̡@}kT@tM @V;+N^$ 3˾=5$@TI@vF[.`  @ OZ {uyNL @ @@}  @@nmkīuYO4հs;P#@\@vP@׽SM @`tFZ|u# @ @`\sVވ'^Es;z'@S@v9UVؽ@?,ȃ@_Bc#uCDb @ @2Dۋ @ (aP @ ѷ1al&ҥ/tײհT2c @̑9-LGz7L  @P=La躯"JJ%t#*[~jl%C @o  @ $%ω4 @-{ڄ @@-X%@6^l5[ {] @ 0]jw:#@3&ƿuoV^?cj @z 72&@ Y @jߋqg @(@wF=\JXHFC @P=+ P*T)TZ`ӕ.{~U_i  @ @Yoֺh@}s/0;Z @2 ,(cRr"@t޵%)~C#,L?5rȏ@7XwZӾ}3? @Qqy _w⤿_2ȕF$[>C;jj|Cȩj-\ۦSvG&#ueG>'  @ c"=Q{ǣp9 G @ @+M5;z-ܹG @0ۑ! fN d+[w?0s jMoEVoZ @ 0iE>f/m @Y\h,W޽  @#8c%RL_sUֆbCjr-Mc#m]PG @ 'б,. @V_t߉bp @ *  P- LϫEFzi'k @.`yw #]h\H[nO @P]a01>C @`@GĪ#]Hw}!RsI @ @i+gudOxHh\oj  @ ,'tLF u%@idž R 2'@ @Cw @&*"]hwډ P,/ @`M^w @* =鎏FlE/f+bg+d{ @ @ ZM("֝doV)B KعA @`fRjD2jTEoc"?by|ll/ @ P5uyR/!f!C+b_6_?Cj @`.`ϥ  0[wE tVo!@ ӝ􋣢qG"+g"@ @c li @XN+^_&sk  @r&;g"D$-a(TT`#/g+b?-cEE!M @zsҕ,hƋ"ѸEcvq @P=Z$@@Ir7&"@էD7qk#mII @Ԏ-(v @t=k-;2ji.v= @@oȶHKˊUKy!Yq @Z,Rv5Or P滑--tdsqEm9P @| (縈HmWL  @/"e%l<ݨ-ܷ` @TcED9 A @, 4#8RE"l9[㠗F4F/ @av P2,! @hZ-[dhfDjj @ P1QK(|Ց-V|,_xlv' @@`WlK@5R׽I @llXtc$^p"@ @;  @=DRliE͞~TGC @ :&@-w~#@'з!b"e[ K׾  @ @vys< BH+9[H8+~q6Q[E(tV&I)U2jⰥ @h9"=_ZQz/xodً˗ @ @`]}[7+ظ5 ߽4gSgy(@NmWZzx65QeX> @P퇀%\deSΪFoq cѨcv  @ 4-:>bޢHYve[<9Q[K @ MS~M6o{}+-;(@=ٖTӲ#F昛Oa\H( NkeqɗG7ӃkG"}^}n6iܨ->xF&@ @=!%\q @E\m{~޳y潎Zm^2# @`X@0C ?Ȃȧ@r=a0ƴl<[;[;e[EE @|MD_, @`:=k"֝)_̞ms_[tzp/ @ [N̞@Xס @MCgd?#$VV} &5^ @ sԜG(< @t/Ę%99}9Y OVϯG,^zJH @ _Fpǎ<i; N @j tm G)#sy潞(?&@PafF >e ͛W=}C'ECm-k@}KzŃHQ^zz6akQ;{o[Ti* @ @`֟-m_}̼hn^ @H n#e?ihulh37W^u! @F*vu Pԙ}B*H @@܆,kNg+uTVl;*jK  @Z,8=h 0; o[#[{h9jZk @+{'@@N$a @!\Ť-J Ƀ[-[%{~+Qy0 @LQ u7)6 @@nzG4ËDZ'-7ĸm9fBG@vqJ9舋/8x^Aۿ˖-kyĭmzG'U0s) @hmd<~ll<[d콹zv6aDzmH @xymUjx#]=''X @&-yжQٵHK?8ܜ_ 77皏'݋ @(Xt3ΈO>9n:f_o|cMoyt2V=;6EN @J(0m,մcF+,}`av,yGMGAJ @eUqݢoQLݫ#GQO @t{8oTav6Ǽ`9X-ќg^3gs͵EOS @%P]A 4>^zn;닓N:)/_gc…~2'[C+۞L@M&@TA'+ hn/a<"[dCIac8۪&U# @`N2۪8Z V:M>X%@#PrЖ]:zms͹y%y3W'2NN @s${u[L/~;_zҗ4>믿>.ظq`^{m|~3p+che3GQ @J &Y3]äy4oIVج ;,_e%ي{dxtj3]E8 @@y2۪8Zny~I;bw @yhgoihb]=ţc/x ⵯ}mwqfMVБ9xk^GquSie l{o|~{=V_ @I4#:Wmm;NglWbfQv6Y$[Q{qm_|p‰rOBݥ @ eUq`q)H]9D @2 Zdӕ<Ϝ-gs̃ ~ɍs_[gPBJ'0tI@N9wҗC~N Na1) F汐r  @`F =#6] q_t?F#];.|JϏe/ƵOEHωHݫ#y @ylhUyRv#6^\T$A(@[D΍VKWDّ?4J4.~V4~y4nhH|%"m̞ر2RejKP]LθkKq07ן1y*;mO%WLL y&v @fO [ϤoCk7fEA`` @9gOj3%kOZ G/"]B=6__-lAƊޯk?|qFݐ- RQB!@O] ?7{Lw @W G>8Ů&#j'mҼ>4'ѳ7wG @ eUq:~bsh?gb7 @\"[!]1G˶+7璷/ך@F昛ca6Ǽ`E@vYFR-[?#9# .VʶwH){$}I;R|ܬg۫v݅[z^w @ dmCnRyy`7''г {Fol91 E@^`[GڭJSNwF":hi_X}w-^"C(@gDsYǝcy9 {xyxy"s߇皇旛sεKѿ @``ϕ~ #iӦhkˊGof~|2V=4]GnSlN_Q4^ B$v @Uh>=ˬǛ`~ceCKl2}}xl;?>o|л`nNI /sUi KZl17煛 4瑛| k~n5>y|Ԗ}ղ> @`O%`2t>CS*ne l{pW<0ƙmذ!g'@IDATguV,_| K) dtE?h 4c,}eE߃ 'iu'@q^~^,Y&ko7N @ oVIi+o,}p=edz0[{=G7s~dwy}v|uZ* p1 d*E9ё*V;:]_>.]>jժ9恭[FJ)VX'x5e\#go~5#_7m7nMqySǘ5sbt6]TyF8=⠽Ec冈)>v @` mvniۜ\G+7砷)7礛szU]V~h wHhGВOਣt)\Z(~xܷoVps> +XVj_"@%cdCJ @ @n)P+`+GA @ @dF ؙ9U@-<W*C%N XХ.K@&@@F3zM{}>n @(~VgqxRV[t~*0~@=kW>F@wpgݘ h@As$Ȩ@eWR___XlqZlJPɾOc'>0vb1cmXdI>CI) @@6f͚?$?CKȾc=^y@.’~h@v N;a7]B` +G-m&|+_insqοMnSY>+;jI dS`͚5aLw^N)x$7n\8u (@|EvϞ;E#s5[;Bg-g}$;_k+P @@n馒#<2|ӟnWv"@xK'Mvi T4 @ Tl!sT7>t0eʔ6?^=u޿Zš84 2'`o"'EdU NTng UwI˗/O=}x~[꧸mq_黥}m#@ @ @@wgRvk  @ @+ ;N$gШtG.n;p6d p  @ @ jlTZ1f @ @|UEJSeɒ%&`><߿}jP*wScQG @ @$P+`+GN׈ @ @dO@vΙ :wzk+s7iYd =c @ @@FY}c @ @ @@jlTY>b'@ @zfzԈ:Q`ڵW_ k֬ p[lEEQ*w9 @ @jTVV*J[SX @ @H@v7:نJ @ @ @ @ @@:  @ @ @ @ @ }$`wsm @ @ @ @ @tP@vN @ @ @ @ @@}ε @ @ @ @ @ A ; @ @ @ @ @G@v9FJ @ @ @ @ @@zup @@XbE1cFXpaڵkÐ!CŽ;;0`.4ZC!@@;]y.6; @j?~XhQxʕ+[oFvePWֻϗT @k 5".yC޽S׈:Go[/^;`[}tyr&k6q{=' h|K: @tDw͎ٗ%9sm @=zcݿ=g>te_oXZw;hСᤓN 'OvXn%Kyl×<0o?hѢ| rJڊσքl'@@^|}-|{= ;s/?)lVaȑbe @r Y.I @3W  PJ>c_4Q%56zp5ׄM6٤*/o馰;V @:*=/0cƌ|uSOm6:n7n\Gq=.+W wy}D @lkRGUawPTDϘcW H >+O?3L߿\'N~GŠ+e+ yO( @k[T\ϙ; PiJ=cq_鳧* ;gNO>O*yUVz(_B#$\r%᭷p7?_,>(iC <5*7_nie!u>P @(e:YsNw8t@1}dR@v&O  q9s;>|x2dHoXavg͚5}  @e]"@@' xG Ts w @ Y^\ !ٳg9rd~v!˹fZkm'@ NOƍ|t(@Lׂ m6%3gy @Yw2U I Ts w 4] %$`whho-[i-̯[䛼;!dMuV @cƌ G}tw};| &*x/c|u @r YNM} @W^dGAvΕH  fϞ.bŊ'@{ sq^׈ 6 mҚ]B_~qΞDh gI?3g??y &K.$5x}>Oe @kTwȰτ < Э9w` hiK9@G ^:A ;@L <,X஻ B_9—f#|7h  Pa5+ {dHgBNP }ecIt5˗bqRw!T]^|o)}m N`ݺuaڴi;Lp9N;-QT\|njƺ}5J =lImq_-kԞ@}>Rmji_ @u>cG(7߻[mq_-k ; gI(СCs3/qYti#8p`}5$@yP[C4(y+ 3fW+|_ &L׵>ߒm @]#z%@@еΧ u9jwkH(@]#Ժ@>}r_\dIj Çou  @6|y{p$7ppצN% @J Y)Y @ {>wDL@(3(>#$@ogOdZ`m?wzk+s7iV @ >yDM@XbE:uj={v~qn!+i#@hmӞ]WgB=FF@9 g:1# s5'~c3`/^8_nneѢE7oyV @ >yDM@XjUϟ;K1bD-+mҖ @-kEK[tm ]38z\"%@s$`w @f>PWjlsOM޽A/[!@l yDM@1cFx2dHꪫ€uYqo} @FIt <%-Pgq}EG@zoXwxG&@j ,\0L4)]6lo;֓O>\}^m h@ַOދ?* 4"@@֭[&Nq9ѣ_;пD{ @@|,# P#3ȉ Pg1pB4%@6#5P(zùM۶jժ0u0jԨ|3<,X %_p @@f|d ."O$`w/Iv/VR&@(/3!Ȯ@1G^"'@r+ggdBӟtjr|ʕD|8#ڤ2, 'Od^`|ʼn m|춧  P"3D:E31ǁwt2$ ;C'K!F0o޼P___r}'|s #G,٦σq ꫝ|0; @[ -OA @I M$@@E:s|EO Ș@ Kb.TP`ڵ!~93`Y&gd⟒b-*xT] @@ <3"W}z#@Pw- @ LW 6>Zݚ @ @ @ @ @@  @ @ @ @ @H' ;V @ @ @ @ @] @ @ @ @ @H) ;%f @ @ @ @ @ @ @ @ @ @ @@J )4#@ @ @ @ @ @l @ @ @ @ @R HN  @ @ @ @ @$` @ @ @ @ @ R@vJ( @ @ @ @ @ 5@ @ @ @ @ @SBiF @ @ @ @ @ خ @ @ @ @ @J3 @ @ @ @ @Hv  @ @ @ @ @ @ P @ @ @ @ @ @@k @ @ @ @ @)$`Ҍ @ @ @ @ @] @ @ @ @ @H) ;%f @ @ @ @ @ @ @ @ @ @ @@J )4#@ @ @ @ @ @l @ @ @ @ @R HN  @ @ @ @ @$` @ @ @ @ @ R@vJ( @ @ @ @ @ 5@ @ @ @ @ @SBiF @ @ @ @ @ خ @ @ @ @ @J3 @ @ @ @ @Hv  @ @ @ @ @ @ P @ @ @ @ @ @@k @ @ @ @ @)$`Ҍ @ @ @ @ @] @ @ @ @ @H) ;%f @ @ @ @ @ @ @ @ @ @ @@J )4#@ @ @ @ @ @l @ @ @ @ @R HN  @ @ @ @ @$` @ @ @ @ @ R@vJ( @ @ @ @ @ 5@ @ @ @ @ @SBiF @ @ @ @ @ خ @ @ @ @ @J3 @ @ @ @ @Hv  @ @ @ @ @ @ P @ @ @ @ @ @@k @ @ @ @ @)$`Ҍ @ @ @ @ @] @ @ @ @ @H) ;%f @ @ @ @ @ @ @ @ @ @ @@J )4#@ @ @ @ @ @l @ @ @ @ @R HN  @ @ @ @ @$` @ @ @ @ @ R@vJ( @ @ @ @ @ 5@ @ @ @ @ @SBiF @ @ @ @ @ خ @ @ @ @ @J3 @ @ @ @ @Hv  @ @ @ @ @ @ P @ @ @ @ @ @@k @ @ @ @ @)$`Ҍ @ @ @ @ @] @ @ @ @ @H) ;%f @ @ @ @ @ @ @ @ @ @ @@J )4#@ @ @ @ @ @l @ @ @ @ @R HN  @ @ @ @ @z! @ @ @ @tEN8ѣG۷o_V[mwp 6ؠ}ځ \qᗿes=7L2%QWʕ+G֬Yn[nɗ;{eҤIa޼yW|  P qwT @ @ @ @V O?tY{w\׿ƌS־uF)uօG!0nI_oLD~%u''ʝ]={vak @zu;# @ @ @ @j_ &uya]v ]vY,L Hg/\0gΜªO>=O>}BB(],L @ @ @hB J|WMlUESN oxꩧ:Y顮.q%J:R믇{,'>0xD @ @ @ @ @ǏԧZb}}}XzuXbExO<-ZT~p衇dgZ-IO?=B;#\uUG,z%guV;{ $`w3l| @ @ @ @ ;6mVXfMwyO;cFmW @lMG?}|s?8蠃uYcq: @@@]W @ @ @ @z8amҥg?YN L2r,O=T7o^ޯZ@Q @%) @ @ @ @J>,[*e*$pLJA%zC}}}=ӧ'vٳgJ @@  @ @ @ @NbRfh 7L81qe˖fOTz:ꨰ[' @  @ @ @ @J ^}?;aM6ץY} ᭷[reOLoBtڵk?̙FwЯ_TwvA-X ̚5+/rmvۜO]]sX" Zxˍ{ԨQe]|y/K.%oaĈ}iJ^;;Ǝ^kAyO4C~g}vPJ:]g_{96"@Q@ @ @ @ B &&`]J={vw}\BqKݻw7n\ s=zhynqKnlcw=+g?Yꦖ}yb/|…F;BL.^b8+2 0xs/puׅ3g5k4Fm9p饗c6&V.Z(nʼnW\qEkۇKJW4RQkʻk:yX}܏ mXc??%Z*Tұ~c3wVΝku-*yt\ @@g sΎ @ @ @ @5*׿5YL捳2,[,p|I1NtPx7[:Dn{}Y<ȒC.]yggm5ƙcII'H&//$S\W^=#xM&_dž%&.ᩧf%Φ}a!&7|;sI{n(X֭K8_ps:[Z*cu7ޚ{'\tEfq=Z[o[n{L=S'>3a?F1:&qJV+\k?пDv[p\ MUJSTZ^ нzu= @ @ @ @u7ٓ [Y[b'̙h8:?)G.=\nޣ>oa֬Y-q4.Վ/O?tc8#H8SѣCi뮻f(~~_';wn~;D}q_ ~xnVmmQɺqx8SpU;NOfΞ1cFtW\kI'`7޸q5Zjk.T,rK~uӖoN4QF% ~Sr5j  @ 4|) @ @ @ @@C2TĿ~{ｷ~mMqW6O~Ǐ_;4O0>d߆;CJit8?-[!!|}C}w+}vv M[WW! y}ìW/_orƱs1qwI^ve%n喉6Ņ7$XאartqKKmZiHOo~fΎZ"vN7$60{}t{e=L-mhÏ6NJjk@l @Uk @ @ @ @4!t0iҤg.\ >V%_5Q>|xn8{oKfm9Ϊ\QWX )y0bĈztaq8[tCvZ1L#GLtum%ʭgdMrַ_WZ3ʵcu  P, XD @ @ @1!^]tQh:8] 0KsIM-Jӟ/~1l扺 ={ _J6/\w󝖚JzhxaÈ#ujŻF+JlٲJu صc{ry晉wy'<N(9Ĝ9sBDrYgSW뽒: 6kC5hU@vD @ @ @ @.p뭷vT;$C=4|FʭڱF={lj[WWrpu=b}}}suxfΜۛL.z̘1aҮT6Jkc7hM@vkB @ @ @ @(7|ݣGۇ]w5/ҽۆ-.k;aҤIrW֬YfX61ixiQHakP:tW-,7 @ @ @ e'3y0cƌp'|w\lYbXTv-@E^°a=?sr YN9~ӟ&ų_NiP={&P__(Vh*}\{M#@& q%@ @ @ @*&{'-?q۷o‚ J6[YmǏO4;wnXjU.Maڵ g+VHK6Y1`:pʔ)z\]LD gNlhJ=۬YJF?\{%T* @ Hf'p  @ @ @ @ ,^$Iw„ xf"x衇JDr/Yo:(9Oԥ)~cXe]roxv~zѸ{m.Q5blaرb}ݗ+?#wofmG/Y{_~,Z(Qn_&<7l @ @ @ @MRgn><%Y|˽d-rN>$|_zBD+W>:QX߿juՉrq1PKYgaqmiSYx 6,18okφxIJiG]Um$q @ @ @ @ 0bĈPpOf2n8ԩS@O0!|#ɷiJWbnR;Hi =\auu^*& @ H'ְ @ @ @ @s9%K§>χwy' @ @ @ @@g |ӧO6&u]uuu!&:._я|?DwKVdro2cƌ5?. ͊|^2t3`w3m @ @ @ @@ {M-֭ /.Imcs=N:pQG%v+/X QWB-׸sinŤo1VN8mϙ3c38Ɉ&Mz|^qs? <ۇ8S6lS@ߖX׬YfϞ.][o6lT:ԁtцYxr̙a֬Y!^1x-yӧ"gǵWV @@ H! @ @ @ @ @j[omv#@ @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1 @ @ @ @ @ P5 Uw` @ @ @ @ @& ;kgL @ @ @ @ @TM@v @ @ @ @ @ H/ @ @ @ @ @U]5z&@ @ @ @ @ @ kvK @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1 @ @ @ @ @ P5 Uw` @ @ @ @ @& ;kgL @ @ @ @ @TM@v @ @ @ @ @ H/ @ @ @ @ @U]5z&@ @ @ @ @ @ kvK @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1 @ @ @ @ @ P5 Uw` @ @ @ @ @& ;kgL @ @ @ @ @TM@v @ @ @ @ @ H/ @ @ @ @ @U]5z&@ @ @ @ @ @ kvK @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1 @ @ @ @ @ P5 Uw` @ @ @ @ @& ;kgL @ @ @ @ @TM@v @ @ @ @ @ H/ @ @ @ @ @U]5z&@ @ @ @ @ @ kvK @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1 @ @ @ @ @ P5 Uw` @ @ @ @ @& ;kgL @ @ @ @ @TM@v @ @ @ @ @ H/ @ @ @ @ @U]5z&@ @ @ @ @ @ kvK @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1 @ @ @ @ @ P5 Uw` @ @ @ @ @& ;kgL @ @ @ @ @TM@v @ @ @ @ @ H/ @ @ @ @ @U]5z&@ @ @ @ @ @ kvK @ @ @ @ @@$`Wށ  @ @ @ @ @Ț쬝1A 1+(DAG= @ @ @ @ @;7L @ @ @ @ @c%@ @ @ @ @ @ `g  @ @ @ @ @x`}̽ @ @ @ @ @d0 @ @ @ @ @oBď IENDB`bayestestR/man/figures/unnamed-chunk-8-1.png0000644000176200001440000055453214410351152020376 0ustar liggesusersPNG  IHDR `CiCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i `k.@IDATxw\U8FB0 F`B` *P$* *E@E4"ACM J s3sgwvwf23y糙s==sgo:5dJP @ @ @ @ @ @UέЀ @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @Zd7…^ءqv曇QFnݺuhl L81̙3'k׮N:餬:x饗QGաv)gt=Ŀ=z^;zaȐ!aѡw:FtK{%,YƎ[A8ڏv۵Wm5nkz9[ @ @ @ @+@c_^z1cƄ/?>tҥ,1'=̚5+k1PWYq-*۽qV[}'{j^𫯾}pV|'e_Mh޼y5m^ntz];x8  @ @ @ @T@9… í&Md>}zFӕ]`G vZ:th83²eVvG}>馛*Ip ׵s'@ @ @ @(@]`7׿F= @] ,Hsk J#GN:餰dɒ j ^e]+  @ @ @ @Dk^{ 'oJ.wY GuTu]s=a"zEvںs) @ @ @ @@ywG5jTbÆt$i|YhcٳCܗVb !C¶nDu$0p|}aٲe?L-J5kVxw c}{/.ƎĬ\>芜СC+rگWG2u]Wo @ @ @ @VxnN;Tŋ  L>=_ CSA;,̝;7,p O~O|p;guV6mZX\rI8CѣSW[5\+ү_ʜimź,  @ @ @ @+<#𫭶Zw}ɓ'[Ny0r] *pꩧFԩSr?;vl+ț\ >S”)SUc5\W9&`ݶ&d? @ @ @ @+RüzhI`РACIm֫$@ @ @ @ @[p ا~^y啼RT,^8̙3'aٲe&X`AcE8^~;,_|EBYhѢE^tiV띿/N^Koke\nX[7m]+}3K-zdy.Xm=j.iۢ @ @ @ @$еNkӷob+cp0eʔ^^f=z~a ;Su]ænZa~کSpGΝ;/5ׄ f&l/eյ}]w?O!fk3ja [g}wҐm';w}_lkt^} 믿~rx իW_wu!5/mQ3fLWj5?:Ġ#Jc6^\4_}ðaرcoYo6`U cx´i;bhcg>ݸnk;UW]qw_ۻW+Ò%K{ߊ;f̘~_5i|3~C=׫6~vҥi9[.Kã>ƼyN>8FS{7d-:C9$8Q[j4{LprW]uUKݚE;!7FKkve]֐ l=o2r w^Zkզs_7z oӡ7xczm#6:j~̛C&;kS'xak5=2McT͓O>zKYNz_?ѐ l~hޮ̹C^{m1ƺ)m{fr:cD_kwǰ{~;(o.Z(L<9JKni-G @ @ @ P]=xi5_oB 2nK9Oӂ]b:$1+hKIfZqoݻ6ܹs0aBy $AmK1s /и:qĦiob . mWRka|7OKϜ93<'L 7o^3fLnn9YUۡCѣG^;t-xw61{١,ƍ}"Qkyuץ~^bX>k;gΜi ~1kuO16l{,<#ɽ$S]dI8ꨣҚfРAY{|_?ҥKܪj{E3zg? W\qE߿x㍓^{ߵi%~\tEa rH^&|i߹qX~)+\ob6 @ @ @ @U-\ \j@e:|LfLuؙ[oMg2ycs{LxrKðaRLj\ve-ϡSNy3[Lͼ6pÖ4xy}a&/?+lXmRu5d oqwtMn˗76{d/o8z:F&H1OnE&8/o&x;Yv5ƓdTϛC׮]ѹ;4vkz]tiïXz?Ծo2Yx%?t&[{C&7x7tS} {GjxC I%124d ̃}s+ۻm <8#Nۙݼ4|[cs}l<ǎ^R[>_G?i!`NVƾ}mȝWំ .6dH+ރ34-K9?ڴsE @ @ @ @:ggj 1q&:WJ5*앹%for[>Cl={v^}'6LGI0qގV*bx k^\Z ~2^wI̝8S1|~7|s薷YE :-'xbXgur nOۿxܜWъjZGe„ k kvkM6]w]֭[^۸&2k"~^bpe1ܳ<̴]~TyŔ`b⋋m|7x# '?Isjj3m~_O>3|h<믟hN{a5\뗶.f_r% MwIm @ @ @ @Vxv}[hg,[$zj&cuZۘxUW-دЎ4~QG~S+:38疫:<[/AV'of%̾m-;p1lɒ%yz뼺*bhZyҪ;TWM먥Ġؖ&~y]x̙yV1gΜpgaÆ>_LJ hN;PC-g?Yj`uz衲L-Zg4R۷o|[o0WZ0^e6 /z]|4ok~[&d? @ @ @ @@- G r_b)s4mN6-R<{W1e 7L:ʘ537McU-2)1 ;kZ( 96/~b[oꢶcdnoL2ZͫK.ͫjF[b } ` 2 4N1it'OݻwoIꪫ5*cE??E!>lp}z䵡1c~f~aUVilG fcgu(FTzϬAN«wzzh9rd^}KlMriަZ.i>mђ} @ @ @ @&Pw^xa/ƍ+lE_. /rx޽{'AE0v&M mPl?:f>oĬ%fAg)_M2%|+_:u-_'m ?sQj[G j!?JUl̗Č'N,xÓO>M7 Ǐϫ/"f=3rs= uY۵zϬ1c|u]75{nXim H.]RǫԓO"E @ @ @ @@ t3o?p'YoZj7x^{c=CAqV qCZ]l+ʘa;,X éƠaÆ틁Ç^{m޾juf7d]'M1k:c Tv)tI!DTio liC%믿~>WW \H%>ZbvZ)h7~vrKTnj.=B~[QO @ @ @ P-cPa1UcPe¢E… @aܹgLϗ_~yYkS;2f~:RzYLvO9唬=\fms7y晤]n}P>Ӽ;C^][+bn \={vVBر1ofnjfرIN;bz+XG&mYܹ}_%؟s9aOwʇzf7 y!si^lL̪/džuSXo߾n%س[:{f>Q!-h:>dȐRS衧Vtw9K=A-Ҏ @ @ @ @VVx?pwk̙G?Q:7x8:qa5OSs`2Ϙ1)(|ڴiw-ԥ?<w^PW_jUW]w3k*1@+9r-iTׯ_q?k楗^ ^xaףGdn{c=,٩(w: $,zvyo}+ ŔBttoM]l%اzjڳ23%-ߚkټ}२sU$7(Hc @ @ @ @@ R 6,\s5裏N,Y5l̞}I'% x_x$:^Ǡra]w w}w֜p.]d7n@[bp^Klwy!Č|I59`o= ^xqN묳Nbv-j(+bλPvnEr\oѡwk .>|x`CltOgk[ `AаM_MQR_w B[_Em @ @ @ @Zȏx3O9ϘnKf~ꩧ هrHJUJ8`BD{fϤIΝ瞩2eJYqx=a„UyJT̟??|M=Ԗ[n?%G7]vY׫Wh9f̘b(YjXG'S(u6~ȑ[vXwuCnJr^+:MI.L RRƇ,TwI~[+ @ @ @ @@t-} ằѕW^uv nN{{UxO?t8Btl,q}ıb@~%J5m) zv޷M 3p BBc-]^eݔβ#=.j9]R,BڽؾiW-:b/ @ @ @ @@i.;x≩:3g |amM2f/_s믿⊰+C=bncvAEVYe-ʫkoG}ڵ*WnZgj]EVq  @ @ @ @V@ur7@`?0+aȐ!s=Vc@W&=bĈ7<ɘݹŵ?Ֆ&M _|qV|}-;,C \m fo޹_~7O:5rhYlY}G}wyg{ëZ01~o߾I wQШZQi;z_n١ ,Hk֫$jJ wW- @ @ @ @@ ev A=\ޕ5kV짞z*!j/| a GÇzJkUp¬nČܛmY1cF^{m^W_&n7.lBARݺu [mUk+?ƹſXp}%1 Pjlc=6<쳡y|בR#ҷuC|P Վ?u5\3^%\jg枣/PO%i8K-v @ @ @ @ZT͵:zʲeҪ?<5`G᪫ ?p8C .&:{O?Mo2f-18w6hlz8qb?uc=Z_mmQ wygS+ĺeavj^U#RJvA[~3e:*\/P(K|4fo/XV=Yww+r6y @ @ @ @@] e3S/X;#ۿ.u_1ۓ{ {wagp,:uʫO5jTeUھ[Ÿ0s̰xxw_p嗇iӦ'ѰaÒعqTqZXG<OZy衇ҪT?y}FtWb{{Zy}m @ @ @ @#mkoyg|WŊ!CĜV^y啴>['|VjĉcĬq &)T3~ewctG3<ƍnf3LXc57l P٫cffw G}t8[|ܹyuuײnw藿ex7Rquׅ%Ku=DҞI^zulUwI{[z @ @ @ @T@`vm /L׾Z+͛|j}1w_xSƀ;$7/13<N滒Cfյo&Aޭ/G?Q3ny]b{]/";pb&|;U:j_fϞ38#̜93ȑ#àA"rŋsVjg^[]ґEք @ @ @ @%Pسf vZyvٲe‡rH a-L>8~0gΜ-ZTp_k;cuݼ3tAͫz߯_Aѧ~z{K/k ޻wƦY1p=F z[Y66}SSYK=ӧu.=:ab}̊+9pYg>SrWϛVZPz^W^~tmѱ57 @ @ @ @@u t]ѧ //EF b1t p;£>b>};6[mU8^oϭ|g R[FN>i7|}٫W6@+d1`9z}٩;̘1#!wޢk̎>o!k 1ص)n馼11c[QK먽sԯu_aK.j㏇:׿p@־܍燉'=XJ5ڿ)Ƭ?ΝWDZ,o2mb-Zkի~pZK:z] @ @ @ @%Uv;o6 ;c:uj|'L6-yaСycv|0\veI~&⭷ʭjv̂<;s lo۷oL1y =ܓP@ꪫ&b bP~i.]k6lyWk;wn$p p|ݼy`X<8{fMNB|_WP_fϞ=>|Swieڽ7NON?o[o5lf=ܳbnj;øqW-j^ypUVQ%~[TBs: @ @ @ @X>":v-p _rcc̨曇?} 8B xGC L,/R7bmֲvg5N8CBރ _җRz_C_q#L9sf-{Xgu 70#lA3|Ecaԩ{ ;cOcvKƉqbK ~yO8N%JJXLjcxk1>QLido;.u&c#8"ĠB%OJHu޻WiVa}mQ5b @ @ @ @ tjȔvxφ^x!_ ׯ_뇘q^78 @ @ @ @ @/u=͆ @ @ @ @ @2 .#  @ @ @ @ @/5!@-0hРxIv=k @ @ @ @O@vlLJ.ЩSгgϒk@ @ @ @ @(Nsqʹ"@ @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @m  @ @ @ @ @ @HEBiF @ @ @ @ @ @ @ @ @ @]$f @ @ @ @ @芀w}7p Y'|dž: @ @ @ @G@vy\J"hѢ6kc A @ @ @ @ t.F&@ @ @ @ @ @@} i6 @ @ @ @ @Qk64 PbUVY% >=wU:߼ @ @ @ @ @ @ @ @ @ @r `焲 @ @ @ @ @ؾ @ @ @ @ @) 2 @ @ @ @ @` @ @ @ @ @ @ vN( @ @ @ @ @ ;@ @ @ @ @ @9,#@ @ @ @ @ @ @ @ @ @ @r `焲 @ @ @ @ @ؾ @ @ @ @ @) 2 PUV'К @ @ @ @ IZD`޽fNu؀ @ @ @ @' U @ @ @ @ @n8 @ @ @ @ @O`|JLZ`}(Sό  @ @ @ @ @~U\[nu$@ @ @ @ @|YE @ @ @ @ @ؾ @ @ @ @ @) 2 @ @ @ @ @` @ @ @ @ @ @ vN( @ @ @ @ @ ;@ @ @ @ @ @9,#@ @ @ @ @ @ @ @ @ @ @r `焲 @ @ @ @ @ؾ @ @ @ @ @) 2 @ @ @ @ @G@4@J)mۖiC  @ @ @ @$ uUC`ҥq衇f~zl& @ @ @ @.b @ @ @ @ @˩#@ @ @ @ @ @@2( @ @ @ @ @ PN`|Is @@18Lso3c @ @ @ @vlU&@54iR\z5  @ @ @ @̷* @ @ @ @ @ @ @ @ @ @ @@NP @ @ @ @ @ @@w @ @ @ @ @9sBYF @ @ @ @ @l @ @ @ @ @ e @ @ @ @ @} @ @ @ @ @ S@;'e @ @ @ @ @ @ @ @ @ @ @@NP @ @ @ @ @ @`< @yv?2 zqQGe  @ @ @ @ @>qUE`͚5qfju]1k̜֬ @ @ @ @G>eU%@ @ @ @ @ @@ xv=Ӧ?ц e˖cʕ1a„8#cqӳ.X 6m4=8󌺐 @ @ @ @ @c. =6$sθ;_j޽{вR{ܹo}+7W\g}uXdɨ_ԅ @ @ @ @ @s1'a9UVe]ׯ/wyܚ5k+m{}#FL @`9xg2{챙 @ @ @ @O@~*زeKi gg7ooq!Vˉ^z)kYR-H-#M @ @ @ @ 0z0 }UW]˗/T9#Hx1~Oٳ[oͬ-K!rpLqŔ)S2sy{} @ @ @ @ @S@9[t}/ϟ9//W_x`f㏏g?]]]󟏳>{X{xL38#n̜ @ @ @ @ @@ t)򗿜iN뮻nP /0Srw`ѢEr7s @ @ @ @ @v=œ?A,]4ϥ^-Ko>묳2}ݙq /d `g8  @ @ @ @ @m#0|ҵm(t̖3gΌ~~;^lYf+VĮ]23 @ @ @ @ @nG].X ԙg7x[x`fٜ9s2Z /^)3eʔ:ujf΀ @ @ @ @ @=9V͛7g:32[̲gy&3`ѢE2~0 @ @ @ @ @v[=v9 71%K wK&s @ @ @ @ @eƷ>l &_\ԩS3֬Yv튃>83?P9^z(/_}8餓xGz衣ڽ @ @ @ @ @.iv6mڔ9i2㼃:j+V̙3͏dbƍQ9G/~p2wvvG}tyw[p/SpQ\͑Xpgx}{chn~=nܸcÖ?̙W\qE  @X T LSz+ @ @ @ @4v>|`Hy&L0]v ŋ3vuu _i߾}q 7ի{߆  P-[s\}793g@ov; @ @ @ @W@Wعsgʁoyov… +9 /c=6L+W_|7c n>: fy6m&O9 {o7>k[EOkk|N`iǬz}> @ @ @ @Goܛ--Z4Ҟ]w]\9sf{s?px㍱aÆ̚O?7`@ZP`%srj@x" @ @ @ @#162{Ɍ88`+C+WXYs!7<(|Y3(o1cF+zkf΀@)])-ߎbv?P7 @ @ @ @X`= |{fy@t/})n'>[zj'O+b/6o)ym幞o>=Mڥ^Wsjը{ڕ3O @ @ @% ^ϻ0޵k׈z۹s1cƠׯ_?h@`s9(>ߜ;i)0\)ܿjw55魴G;r57}^lwظqcvak֬,9sf/g ٹsgtPl.xۮSB BCr.g5{UZ;ں|/顯{ JIŒk+{8餞pY4A0x5aJkk=}sq}WfiMf* @ @ @ @@ xv?႞oKmΟ?n͛SNɌG3wzk|qWM74r˖-tߌ3͙ @C Z\wTϫjj @ @ @@^ܺN6@`ڴi1uXv+O=T/pl޼9^z̲O>93~?_3>ɓcɒ% `"1A(+}rV 6ײr\h..\ָR O8qƍΕe=tkT_ Yg$JoW(tzYC @ @ @b?˜GPz(s~[ߚ3?3s J|,;MozSf΀SR@|)U C#;(j3Gkp5=lz}?o|]6dxvyy֕sOջ~>#@ @ @ @gu VZ2s;#ssύ#<237v]wUUHv<6.4iRf΀ %0 wdP umC9Pp>˅Gqnu7Mɤ.VzSv0!{ioT\']=Ul @ @ @ 0aLn'tR̜93-ZN8g?Jo馛bՙ+\rIf\nO:L>=7Ɗ+zgo?WR _B2s >PXS ]=}}ʂy곮{Lٳ7& l}r(/*QN @ @ @Fښ ɟI7o??o1N9}|}7xGo;39`|%13[ C_veO~},[o5&Nf͊q_ٳg 7;v?WK/:(3g@-P B5]zJ{?pk]/@)8-u `ĝ=VRx%f?7 @ @ @ @:`U?s?m۶E)}8_'x"zX`?Jo+3s?(Sz>w{g~gc}Ss=g)=S گic 0hBEsyhJ8s wv՗ox's @ @ @v?&8_Wsv׮]?'q-{ԩefyL ;3YapYgg?يo̮pi (~Ow33gP\RZ0Gg…Tb&cɴ[mޗԀ @ @ @H@Fʌ\ࠃ Q_UV*?O̙32u]w]|ߎ[n%6oޜθq.% @ @ @v>ۦ:Y)}?zk<ׯ7Ɣ)Sb?3f̈R_|&M.5kҥKcٲejժ8qb~q1駟&LV%@]׋[%[p h,W yjkpsj%q\ҥJaA7l<լtOߨty @ @ @ 0cmӦMy>ޟwc h_?@)稣?w Mӵa&:z\yaM*ހ].\t='`=lOҰY@ @ @ @j- ]kQ @@N<@wP(s-?-ص|:Y'Myhu&~-n;H @ @ @m-֧wx @@jn1lXTD.F.7׿^]jqiz~~JC =ez}*Karrsy{WkB @ @ @ @` { mE#0pvԵGZ T 9WAFq#o݁T3tShRz[]*ը4?>*o!2@IDATL^k @ @ @ @F ui<  @ &нH?ˠJuC;Ե5G;{Sz0G @ @ @Nu @@j>ԩ*0(\Қ]\Tw_Ͳg `Է%dVeRo @ @ @R#|r (x9sf{'.̜ @3R!劫*MG-;PJAJ;ײV= @ @ @ @Z `RS- n  @ @ @ @ @l:( @ @ @ @ @F) =J@ @ @ @ @ @ >󬝔 @ @ @ @ @Q ` @ @ @ @ @vI  @/_GqD{m9 @ @ @ @C`|sK @$6l`ٳ'36 @ @ @ @ @ xvlU&@ @ @ @ @ @[: @ @ @ @ @_* @2eJ|̔}ߜ @ @ @ @ @@g2@)}׼ @ @ @ @ O32 @ @ @ @ @ @@w @ @ @ @ @9sBYF @ @ @ @ @l @ @ @ @ @ e @ @ @ @ @} @ @ @ @ @ S@;'e @ @ @ @ @ @ @ @ @ @ @@NP @ @ @ @ @ @@w @ @ @ @ @9sBYF @ @ @ @ @ @طo_,Y$ibĉ9 @ @ @ @v}\U%@uXbE̜93SYfe  @ @ @ @ @>)* @ @ @ @ @ZO@ @ @ @ @ @ P':*K @ @ @ @ @@ o#9h]S=ܓ9g @ @ @ @ @@g2]tQ*H @ @ @ @:- @ @ @ @ @} @ @ @ @ @ S@;'e @ @ @ @ @ @ @ @ @ @ @@NP @ @ @ @ @ @@w @ @ @ @ @9\g @@ wǹO09@ @ @ @ @kدY ВC0v @ @ @ @ t2C Pu`u3䞼#@ @ @ @ O(#0h/Ӓ) @ @ @ @-! ! @ *<]:u/ @ @ @ @/0 @}v73>sb9uhTo%s  @ @ @ @ bH,nݺK2-u]Z aZT= @ @ @ @flN @~Ze @ @ @ @ ' }~ @T?qHW\ @ @ @ @Vn'\ @ `a_TLZ{0{ @ @ @ @hA|D+pڵk3ꗫR @ @ @ @,nk:#@hzs#=~Hg7q @ @ @ @ @@6?=H~v @ @ @ @ P':*Kh-g#~+N~\ @ @ @ @C1Ķ @^/S=uS_?;ң-_-sk[[5 @ @ @ @u# @Vx 9ʺ9őί @ @ @ @v 1"@@wۑ~H/} @ @ @ @Q`ϭ @" y'iAZϑiކ}s_cMlx(FS؈  @ @ @ @Y @fH;_ܧkiG/T @ @ @ @@U`YJh@ZpUDFvFz^x}ۋ  @ @ @ @N`|۝؁  @@ pqgN0qؠu{#^nړ-!Ҷy'U{ @ @ @ @F$ ="67 @s1/6fs6T u튴6BnJO]o ai @ @ @ zw$'"@@z]K[`8і'#=H]kQM  @ @ @ @C `" @iG[_7R6 ߑK @ @ @ @v z'@&/xsEkuߌ9 @ @ @ @ې\`qYge~̙3,@ZpeDϛ}(okG 븉 @ @ @ @,0l @?xX7ň S 6g ~MkK @ @ @ `on= @ u1WEzcn/ @ @ @ @@+`St @Ң"vl34ei5e&@ @ @ @hmmg @Z'>mӧOό K m_盫Vv#M9#:;t*g!@ @ @ @vq&@8#;uY(\^i`N>184 @ @ @ @v @uH~v]j+Z@HONR @ @ @ @vn' @@/5 *{y)u#!@ @ @ @ 0<. @#^[)zF^7{E @ @ @ 6m(ʯGt)TKxHk} @ @ @ @* `Wq P7ⶺVxtDھptEM @ @ @ в-h(@t֟=}umőmcA @ @ @ @`  @ xu}}kR}HOaMJ)B @ @ @ Zح<(@R{k酿A @ @ @ @ # 0 @Y'6yk%6ٵ* @ @ @ @@ `Ct @yۚYtGFڵ @ @ @ @^l_ @ K#6|vM^K"uYI @ @ @ @W@y  @MO24ӊۛoMli( @ @ @ @/h"%Kĸq2?w}w}[M;bŗNHN  @ @ @ @[  @?{eS -*ٜ @ @ @ @D@{LmB@Z~[D{iWZi6Wp| @ @ @ @@koc8hiӦţ>9'4HѠm[x}["Ϳ":vG[  @ @ @ @CJ %0a„8 Փf~*Vމk׹J @ @ @ PhBw9 @@}#6=ji^6O @ @ @ 0 Q๕ +i  Y_g @ @ @ @@a h4F4@0YZgk= @ @ @ @@@{hn!@d?N =H]{[: @ @ @ @@ PD4@ڽ:bӰN!cQo1z @ @ @ @@UUqYL @ s -ȽB @ @ @ @b`9hR~Nv }~Hh @ @ @ @ v~++  @ @* 5Wi'򮶎 @ @ @ @ ~'@W mӼXi׊Փn @ @ @ @ /;k(֭[_b.(N8̜ARވ#;@z#/o3;( @ @ @ @V`ƍqg?c  6=ѵs6M[iGiuH @ @ @ @@ t6k&@4R ۻUV}5ҺZtE @ @ @h xA9c C x$oWo @ @ @ @@S `7c4 Hʦ-O5{e~Ol @ @ @ @kq)6;u<>iioFǔΙ @ @ @ "ހ"1 @HԦݑh?j;6 @ @ @ @}6:#@*aNQ;W+ l[DB @ @ @h xA@ڹ$bKc}\ ->Ҟ\  @ @ @ @.  PtޡZI`HE+Y @ @ @ @M/  @HE b坑6 @ @ @ @@A A_ Q@yrr  @ @ @ @@3 `7S3 -s#^ԘE,  @ @ @ P<m @M ~v4VH ?iϺV=s @ @ @ @F@iF  @F 6vpv @ @ @ @@! 4A] uX_ JM?jS: @ @ @ @؅~<#@ #iG#+])u/ @ @ @ @, `{ @9Ѩ.[_`3K @ @ @ @ /h_"@[.>яf\qqYge :UDLYw @ @ @ @X@{tn$@c/cǎ׾vFg]Ķ/" 鹫i @ @ @ @Ps >gYyV~9Ҧǚ_ @ @ @ @ZD@Ec @HUyTiRרj;ҳ,M ˒(FE@ EqO[<imc5aܠ֝" (XDE‡N6B,YfϤ_y3̒Y~9羟{=9W!@ @ @ @'0vxÍ&@)0~8+B8蠃*5XZ͏E,&b5 @ @ @ @ {H @L2%xS8RKceUH3" '3Q @ @ @ @r&0&g  0F`#pgO @ @ @ 0B#3(@ZuO9ei}'@ @ @ @";/'%N @`RWGF}_@/RHC @ @ @ 0 2(":[Jts+Xkr  @ @ @ @yP' 0iݣ @3#ҦU @ @ @ @(k @)qRϥ@ǺHe&@ @ @ @E@v^NJ @ -=mF*\,e @ @ @ @ !@D/"u CO0n! @ @ @ @!;$J @`Ҫ{FyG@? H+ Z @ @ @ @`m~ @ (9"umaB&@ @ @ @d[@vGt @@R֦:lKUhU\R @ @ @ @=  @p"9HsiUN6 @ @ @ @  y."@ ,Y$NZo~3X#H Ggf:#5VL!@ @ @ @\`l>(@GGG,Z"֊Ʈ "V׮-b6, `DI tAqUWѨGj Om^oE<# @ @ @ @)@R @TE uG4Ve-Ȣ@{Eͫ @ @ @ @P( PsǺ66 P7gm{ @ @ @ @ ( @:gUgȲk#mx* @ @ @ iؙ> @)`&&Omw @ @ @ @.;'(~ @z͏To-+Ȳ#={G# @ @ @ @  3{4#@FS unh3[ڋ@]ERlN @ @ @ȣ<  @ lx,"uV]+Ȫ@kSĢf5:q @ @ @ @2+;G#0 @`TlF HWg!1 @ @ @ @r#;7G%P @Iv-yUu.jt"@ @ @ @dR@v&EP @ (urfD`5Zd$a @ @ @ @/;g$B @ksDS52*:#=', @ @ @ @@f/$ @;{Ǐ@c 'P U]0JJ* @ @ @ @6V%@5xgbʔ)o&{jYJWHOk5+} @ @ @ @}`HS ˚@_ 7/og @ @ @ @`(GKt ,gF8K @ @ @ @[`E @J-D  @Dy)]HMFhمL%@ @ @ @G@vqR& @p6<>("Ϳ˜ @ @ @ G@v  @@g(YqE @ @ @ @  }~'@F(+!ieltIY7 @ @ @ @W`l @ mmmqwVy'ǔ)S*4 {HN#MP4^h @ @ @ @# _GZ}ߐH @ @ @(좝| @|P =}Qv  @ @ @ @@`tF (?:`N(1,F @ @ @(b# PlC=4͛Wɓ+C)!@`Ҝ/Da̸]Zd @ @ @ @@`K;vlV/~qtAt?kvwyw~~ 0DԶ cGF?i#n" @ @ @ @ c-'gHe/{Yc9&Ǝ_ =ӯວ裏SO=blb-RFccc|{ &= @@+i G,v2# @ @ @ P2+]K"+6;ꨣ~=܊͋ŋWղiӦuwttnO~2g޶T[`vI&U|Ǐ_m ^j?[./ Ⱥ@H[e=L @ @ @ @%{X\WS'XNh֘>}z7bUk7Qq8Sk  vX\AdDc]y_%@ @ @ @K@vKebݺO~C,YүZ/]m =6^`""P&qF2+ @ @ @ P`>,Zĉ+CmL0Ж~}){7n\k;dP` %$%XHTĥL @ @ @M@vN4'l_${(ޯoW;:::bƌqޥŴiz @ i# LTJ(\\¬L @ @ @M@vN4'UDsH>[$=5suœO>Ns92,h }.Y%@ @ @ @&h'|{@վ'|&z< @@܀ZҜEJ˙ @ @ @(dشiSEȻ{E{cٯo=7uϘ1#zG?'Om{ @ "6?EFͳ"V˙ @ @ @(ds=+B޼ysE{-[ 㪫e˺3Έ7 ۚ~ @@wz 98%(  @ @ @ @ }Mn"ojn>CqWU &>޶Ⱦ@RCa9Z"˚ @ @ @Ƚa>ؾ{Bd6м{(Sw:fժUqWT?_Ed\ ?!X 5]kdlR'@ @ @ @2 061`H߼]-N)ť^ͽkmoWm>{nNAA@V6.X|Md5Bq @ @ @ @P= Z L8b{=ʕ+ ?|u[[[+Qcz~s7+i @`(=`{i˺M @ i"=/_0pB#@ @ @ @ &`tMVjύ#l?oܸq}qpmii7巿mv̟??z}?{  P 9X՚TS`s?[͈#?VUE @ @ @nq;:ujś͛7ǚ5k*XbEŰ:*Ǝ *P4 PVƲf.oH󯊴emb, @ @ @ Pn>e =̞=;N;aOT?*(^{oy[*Қ2eJE[Rk  б>ҼE ?hH @ @ @~ "S,8yxg{ӟ4uł z/9%s'[}0O]&@ @ @ @'|g8㌸馛zcvý[z̘11}􊾑48s뭷V`}#]<G*gj4h8K  @ @ @ @3k^󚊵-[wygEߎq 7T4iRES ΈL^*Hm  @ @ @ @ (.ag-c=6:ꨊ=Ν[ѷ}+/+^]hH)E@c @@ZG-HD J$?%,U @ @ @ @  zrhE&֭ . fϞ]ѿs3oֵ+^~?яկ~uŷۇ (TDKo2J @ @ @ȳ</ /7Mqw&aÆ)~_//}i\2z衸{'0a„?^ѧA%hm,9 U+Rh8ᆼ& n @ @ @ @ KpYOc1k֬P[oa=+2&O<[] PV첞 H_Vd@ @ @ @Q`LScEԯ~xO8ꨣ5`(KpR,@"'7 @ @ @ @ n%"K.$kcΜ9;Lm};/>7nyA%pv_XuW5GA*D: @ @ @ @%А?JI6EX|y<ñjժXfMpqamq{!ͪ0w~vmqYgUu @ iHw0G=׮yY ;7:y1^%_c^y(mf @ @ @ @܀=t+#GQ`ʔ)񖷼ewFeE09J@>i寣7![9 @ @ @ @9XJ\q1F 4gF=8*A @ @ @ @R (.qK_ 6?I(#RlI @ @ @D@vNJ @G`ű^{U|o68}Z`L H]yOC @ @ @ @@`0BoGĊwv ΍Xܧ! @ @ @ @8 s2!@H3mA(@{yMEKK> @ @ @ @@N`M :/"|]-qi; @ @ @ @[L$BJ p̙3+2=*ڥn6:}(@Ώ{9M @ @ @ @9PC"&Dž^- '&Pͫ#~3ȏ&% @ @ @ @ϰEM/܀E WGڲ@I @ @ @ȣ<  @ZK@1:EoE @ @ @ @@n`NhۯKXHW,) @ @ @ @yP+ C2wtF¤# @ @ @ @  wf"&@hiWEXH139 @ @ @ @9PC" 0! 2Btm4B"  @ @ @ @  wf"&@Hn@E =,x @ @ @ @P= N @ O1Oንp/*Vzmbo @ @ @ؙxGC 8'Q#?zUl+v) @ @ @ @\cʕl  @B 62-I 0<4 #.ӶB}  @ @ @ @܀MO C9$ΊH_THWGlYSK~{Nwo6 vx]=En @ @ @ @, r$@Bqg"%YZ@ vz"m~ @ @ @ @}mx&@N1w! L{pA" @ @ @ @`"@#܀) ֽznj-> @ @ @ @ jx&@' TY`ڃn¯2 @ @ @ @( W @@Zr umc: @ @ @ Wy=9q @:" @K+ @ @ @QĶ PeʋZ @ @ @ @;Pco @ 4f=B @ @ @ @ P0;P @R 6*] @ @ @ @ P? @#H G(g @ @ @ @#P=R9 @ 4?   @ @ @ @, r$@Eh[ĬDo4Y& @ @ @ @F"0v$!@#7xc{bԩ}ehM")Cr$@`'+=xQ#{G6, @ @ @ @ {#@" Z*Uv7;Z*4(@?ʈ߆Cȟ @ @ @oy @@mZkU ȥN莻ۯFi! @ @ @ P(؅:N @$7`eJ` N={׋_0 @ @ @ PB%wѾjY ,8ȭIM{paML{: @ @ @ @ @ ͏H [dW@uvFd @ @ @ @ k v"!@hi| @ @ @ @Z@kc7< @ @ @ @P=^ @  > @ @ @ @(b @@1܀]s @ @ @ @(! Nuv+%@ @ @ @J&d.] wiUĖyOC @ @ @ @T@vNN @M]N 5?VŭL @ @ @J@vS2 @-M%HR@jd @ @ @ S9=8a @ $7`M+au @ @ @ @ q @%huvN[FU 5lF @ @ @S`l>5(իDEЇN+tI: ;Қ?DAY lM @ @ @d]@vOH| @ ??Do.MvѶ" TS 5ΈS"@ @ @ @ &0`H(@ۂ캊#Q؟ @ @ @Ȱ  @Z$@@R/jE @ @ @ @0c D @@ ƍ/zы*2o*څn6:= uFZh8 H @ @ @ @@`g4BxgdTq_'7`peF c; @ @ @ @J @ *A @J͏FZq[  @ @ @ P$E:M @ 4=C ![SJH( @ @ @ @@`g@ *6=ѱnq @j-OE,jY @ @ @(b, @@Z Ȝ@j%  @ @ @ @~ gog @`8-Mm,#ߞ?ZV!@ @ @ @ !(  P|SC:#uuag[ @ @ @ @YPS _@ˆ%7N @ @ @ @r ;$D @[ ~ @{E-؛  @ @ @ @(Iء֢Ƕ;|j.qI| @ @ @ @P3! :۠*})Rƺ`s @ @ @ @ " @hml[}@ @ @ @dZ@vGp @V~Ȇ@HF @ @ @ @@]`ׅݦ @`d˖-?ndhVj[hJ@6ۅNQr @ @ @ @ @@6ogϮ]FB%))_q?D3Q @ @ @ @$]3ţM 0$-k#~cHC "@ @ @ @'xg*# P("6.-TN!@ i#b @ @ @ @[%Lr,Wd0uԊv=שpiI t4Gu4sq> @ @ @ 0\3Q`„ q51:lݶڒCXH> & a! @ @ @ @@Q%y @hW]Г tF! @ @ @ @`X e0 0G}K @`iӳCn  @ @ @ ?C @B 6؅>`Ȼ@Hs,O @ @ @ C@0 %@ оڒx?"/C  @ @ @ @< (鉝A e8e9ȷ@[w'@ @ @ @,{T @-RgĦe 0|%Gj[8yf @ @ @ @P#0(@"ld] uDjb֣ @ @ @ PU@ P#E5Zز#έ–$@ @ @ @$;K! @RMv%l(: @ @ @ @``2 @Z ŵZںETmֶ* @ @ @ ؙ8A @ (E'YHݷ`_F @ @ @@ 7l\sM!@v.Rogg'm:N=}x&@. (@jQF @ @ @+q??!|;;.X}< @B -*dZ"@D%JX @ @ @ @c 뮋q=참=~mzw;?d; @8qb|;ߩNhѾ0H ܂p9 @ @ @(@Cd%%K 7_}gώz(.4iNCCs=7~.% -7`g8CxGqo @ ;kKĦ H$UG#宮b> @ @ @ \`z ^bO}SM6O~8 /W @2"suH0 @@uRH۪i @ @ @ P?`o#khhSN9%.처={v455ŗ8cv6eK/#<2^OSbWi @: -s'@@ ZX~s $ @ @ @ 0/Nz{nsΉ>:oFGGG!  @zlۓHMu߂YMN @ @ @T=EwuW|#Zt}'̙3cCƛ?~|zO<1y @Hn Ȅ@kSқ2  @ @ @ @ ٴ깽n!~ڵk jw:+g[ߜ~8z ?3<~u @ Q@HM_x90fz`_ @ @ @ @`rwٳ3LL:5N?w;hK^׾˖-o9XbE|ߏSO=ߦMmo{[ӟf͊'{=y[s;_ܷ3 0Z G>G ͽ"RlnW @ @ @ @`NްaCr-0tv-7ĸq3N7qgDϾ>z[mU`ƍqW0}4iRE_[ 7=N6.xS?X# @ @ @ @L dck!tOuOs[[ې^w^L2eHs<ַ_*O?t(%@uXbEyQ|qgWѾrO>iޗ";/v۳OG @ @ @ @ (~t}M7s=7$/wl| 6褓N(lٲyOTS}Q5W+sF<(2 @ @ @ @@ W\rJhhh׼5[{nsw1/xA> @@ ܀]C\K 54}4'k @ @ @؁@ wWEiϏ=qGTfcˍ3&O^ѧAV V'@ SWG,fđTX!@ @ @ @v,+oOۯky駷n1iҤ8N޻Z Y//G?uԊvnJ qa7h @ @ @ @.+~ի^sΉ}wTQ>Oƌ3b=}mF*3{ Pu_ kQ2 @ @ @(@& {n<Ϗ>n=7_ @uh_TlO:,fiq갹-  @ @ @ @Խ{ĉx3fp6(@f&% "iWؙ  @ @ @@ GzʕOnΙ3'z۟H}@ PE߉DW @ @ @ @ uv瞋=ܳ|?'O38#>W_={ @h[DQim @ @ @ @ Խ;7nn޼y 8׿x5 @YpvNA SGj_RM @ @ @ "PAכ6m귆~$: @@&RL!Mks-ؗm{ @ @ @ @ s A6""$F[`#]G @ @ @ Q`ǍhXccc tuV^ݷk׮ohii~8.~'OܯO 7`g@@Rgˢ߭{( @ @ @ @ Դ?q|Nz~GϷVv-9Z-o] @`W`ؿK@IDATI`O"hRc  @ @ @C`L-'>Gyd-گ{bĉÞg P[/cvG @ )R,(6 @ @ @ PZ`?>^qWf& @}ix$@Xqk@ @ @ @ @[x7^v ^k8/  @@֯__+B|sLE_. s  PK[NI-6 @ @ @ 0L`}-N:`hmmmoq{#yc=;&N'x´1cjzHB5 K`ڵqEU9cQs @Vh8$  @ޝUB٤PJˢvX* b( . ȈeQQbQٔmҍtIZR mMriIR4K=w3o @ @ @@N ƍk3  sϵms @@Q$5"I @)WFٞiG @ @ @#0 @jfu#@@H[$#  @ @ @ `ww((!ݻwӣGV]/RdC zE65' @ @ @ 1K/.]4ltH <8Ӎ.LAxH9}6# @ @ @ !`E>}:i  @HEZ\\IɆ],L.65 @ @ @Xd  @K~ݥ&#@H{9*E @ @ @@[ś ЅS$ME @ @ @tT 8 V[[{o- '%OtD җRX:1b}U r'@ @ @ @yZ_>l*?U'xb_6?@c`z PɴD 82z  @ @ @ @@u  @Mճn @:O::yL @ @ @dK@vdK_Fv$@@D2퇑4BA @ @ @A@v-IݢAH*ŕ9. @ @ @ @δ\pA̟??5!CRq&dM[niծ( duKJ#YY @ 7#bQc.T @ @ @ @V~]k7>ݻwq P5N.·*%r!b/yvgb5k @ @ @ @'PN WYy]q-); @ @ @v +a Pd J\ Z1\h- @ @ @ P%/t# ikRm)Hjfw+ N melQp{! @ @ @ P ʉV:xT~rJ*vA;a KH_e;^^X @ @ @ PŐO?{l|c>}Đ!CCn!2j. @`۱5dł[$@ @ @ @Z '.3fLk^res1~~x7b1{g}vlq]wu @< ,O"k ) @ @ @ @(-VVVƹ&L$I6u5jTmf _~ճ .O<1͛w^G  @@p H_~;ɪ%uu-+ W`ί"(=phg @ @ @ @ ;S )({7SӧOOkǯzMLc=vMo O>dZ7\3{< @ 4\} ?@  @ @ @ @ws6;Uuf ;Zӻw6eN^lY4 @yE-I"{g$%"Zj @ @ @ @ Q}?fb_ט3gN8sbtxL뮻.& @(P;&@H3 @ @ @(( NhM@ $LX @ @ @Ȼ@ |hhhh߿\~Mq˛Lvh5bĈ5jTCQGgn~T, @$PV,\"YR')= @ @ @ `ꫩO?ݻwy#4?ϴjkް;7cX@IfN,_)eH @ @ @{ERe>؃ JM;! @yHVuKE  PgJ"UI @ @ @ @\ \!C֚ ⥗FW^quL[lz|T, @ P3;Z%L- @ @ @ȁ@ Riե?I4o+zjk̙3'я~4  @<Tâ$@@ |$ TbIK @ @ @dW m]*yc=;[]k뮋=ܳœw1Uݷo߸{c; Mb꫻m[v3 ȭ@2}\/GY&]j @ @ @ @H ;cz1QGO @ @ @ @@(]644os΍{/V\ɴw:;; @ T+^_: I}$S]S @ @ @@`/^8nָc̙YqWV @ n_? @ 7+aF٦zV!@ @ @ @\ /7n\tsV'@&8{m6  /dQ6wZ޺ @ @ @ @[ n=ܸꪫ_  -j'`gּXoF=@ @ @ @ PJQsu]WJr%@+}2'@)l @ @ @@E!l /lsmYﾱn[lniٳ;  @@)mQH?Im H>e.lH @ @ @[ s΍~Ugyf|o,nP(Q?7 {cǦ 6X aEn PS`O  @ @ @ @`]>`%ō7ި j*yO"xH_IJ @ @ @tN ؓ'ONeЧOkRm @Hj`ɛE,L23 @ @ @@ ϟ _S" PD eJX>5MOb @ @ @ @kkkSS ><  @jA=3r(.cohH^1QV޳  @ @ @ y/fmRb 7L @6(<]mUw۱ @4jDUĶ_+eM @ @ @>DCG?:oF* @E$PSYDH-Hw#@ @ @ @!?'b PDN.)^`ˆn)4%H @ @ @:*}'vۦ}+k5n @H$bEUq$# @2HV-)lI @ @ @'첲83v[WWo!@D`墈E4 P"uEE @ @ @| V>3fLӮz7n\S("HB (A7GL\ @ @ @ @m(.//СCvyy''OnjsCtc:%-PɴK@ @ @ @ @@E ^x!Ľ[w"V- @n*Pm}X7M  @ @ @ @@;7h @@;~$] })WD4t ) @ @ @B]i* @`-5kyIww˭4 @ @ @謀 O[j} @n%L:j6K @ @ @B+&1 AżyRm ؅^1Cѩi &@ @ @ @M $ɓ'3<?|TUUŻ/xGcM<@444>(/ww( =zD_.N~̎  dN>Mgm IK @ @ @  {ҥ_*nᆘ9sZWXz#7C3<3N=tMS} @@jxA @@NV.5k]NAZi< @ @ @ @n*PGDO0! g}_e[o56g=m:=gxS @ 59\R 9z?e^.Sl @ @ @ @@T7͸[:E̛7/o?EQ @ $VRUCMV B`a^&/nYG5 @ @ @ @n!P0ƍlֳg8#/x cV}4$Iw_~k3'j_tEM @ G5U9Z2 9zLu犯\ @ @ @ @ DvK/4eWVV|L4)?<<Ȍ #s W\Cŋ/ؼ= mڹ^ #9}bJ=Vՙgpc  @ @ @ @@ .T;3nT{{6ڨ;ԐI. @ NΡ e_,o @ @ @ @ +y/^re}ݩ>F( '- |XhQg6h@R[Ξ @@! 9,_;߼ @ @ @ @@K`w,[i_k=  @, 8;&@@.XXv s @ @ @ @@gʹojLЧO8cRS̘1#  @, 8;&@@.LZ @ @ @ @`yϟ??O~򓩸+#FQ @ f'@ 8:GЖ!@ @ @ @,XB6 Zc֬YX@ŋ/OmSO#G **  @ @ @ @:#슊/_ޙ|6ڨ~  @@ q7lv꽈g{ @@ @ @ @ @ p6zS?"xWS/  @, 8:K%@ @ @ @ @ _y/0`@*l`K5Zz( @N2Y '@ @ @ @!Pm-<3Fj_;I&\3P@ X"Fm *pvA!@@OY1 @ @ @ts`^|$/^Hjժ/Bd:s͞=;onbذa6.YfuFR3F  @=sS @ @ @ PαGqI'/׾Iw$;.{԰O<1  @, VfqrS @@V^2e$u&$@ @ @ @]K.$nTO?t׿)o.,-I{ Rwމ<2'ϙ3'2z~ŠAv-giӦ51sm}6qvOѿ)T*Y+0衧V}E @ @ @ @}Q[W_7R:uj3&FX)^tiOv+D~8xT5W\mٚw TWWwo2دj<w^=Ul6d~~4_\'Sgl,?cС-  P:N.w-SJG/>xu]Sё) @ @ @E,Y}J2bnCٳg\rcN?~:G*oƢE:c=q\O^jU\yOvhqסq7ߌÇ}s6r)s"p]W?YWGjCXqs9e3c]i>&Z @ @ @ @ iƍR{3ů7tS9w^m_+>OG>67t=m泮llU|ݣGvmc=m&Zg~>3?{S](5nR{%@d=4-=|Vwz_̏D  @ @ @ PtQyyyg?8 կF03Wx?q ɝ Ņ^sI-뮻g;CTT̙3[\g#Fľ?ݻwGٴLƂwА)Fo>F7_s!J\`C9Za՟u)Ԯ e.q9 @ @ @ @@w(@s11cƌꪫbkݧO8sbԩۭӟbĉkcXyС|%.Ȝ_#rY$as{F @ @ @r%AhVl:"׋/8z~vX΍Eٙӭ3[necƌ . xq۹n]y睩we+gϞ_~ywں"ק[ouenj2eJL  PN.+9jz7 @ @ @["XBۯ񳮾w/~:f͚:9:Y9%{=Mw_qMqW/IMѣSmk 2ǏO=~cȑ6VhStN zeĀ#|xٹ&@ @ @ @( EࡇJme9TӧٳSm ښo}ilIlVsM@RʍYo @ @ @ @| (Ηu7H)|L 2'IgNHo~mv~ 6O>92^o6seNȵ曧{X@pvQ^ @ɛINc< @ @ @ȹ@EW UUUdɒŨQRL?x嗛kMяWca L4)^z[ljkOBGGOn:S[[7pCjX&|36:*bŊxR2-+KBۣ @@E2([ @ @ @ @[vCCC}ݍE/Rd^S^^ԧ_ry䑑)vﾛRq{ڪU׹s[窡:.x7RKuQ(VbL^ s~;qz+#@ @ @ @(oO>F'xbPu[{o?/~1~;cmg5^[/_Zo߾[n٪eZ!s/~8裛~9`ͺ{w|_]&@@ *.,Ct@Rɔ˻h2 @ @ @ @ %Kرc'Zf?⮻!Cdm-@"=W^6QSSӪ-[ W_}uL4)bŊm.sGYg=zhFtD`7c9&5d lF`,y16ml @ @ @ P9+~3^{-'>l?!F5-~T={mmN{wmsKCiF@~{YS[F^ (pC @ @ @ P9)6mZcY*)Vf[ouw~M7KFg /DW^+W9otP=أ>#Nn* ؙB_gW\qE<#qQG>Ӟ!@@Q$N.( T`"YxmuhN @ @ @@ 3cǎ_1"N9җ\rԳ;1}q׷yvG/bl69XbEj 6 7h#\__E78  ̩3f̈iI4#2E-~#@@)ETgk  @ @ @ @N ^ ~믿n\e gַYGz_W?>`vi95o޼K[om>9|͵S<_UZ=̝k裏Zߏn)~8_7~gE'P3R@`Ĉʻ",A @ @ @O NJM>=2-i֙_W^y%O^xqv hY$D>}wx>ni|n={ָ{cҤI6R EZ%E\$SI}m. @ @ @X/+HkփƏ-O(>3q- Gy$>Of_W6AZ`UHݞݵ5n7nЬs=Ofo[ (6ƢU~ޫ| 3/̼)gY @ @ @tT w}w\z饱;jʆLq=-O(~ ]Sev@~}V ;; /oo (ʢIE" du|'?[ @ @ @C kدZL2%>8Sm vi?~̙?9&ȏ@߾}S /\07X`ATݣGw}[qΜ94 @h2' @@gޏd5X @ @ @ 5`I'lAŧ~z3/0t&~Tޠ帞={FΕ~Æ k5uea[h @xjO.2!@ e$go}+ @ @ @ @d7lѣ[eaz*G`mM-rXxq=S݆ $YjܢEZi @@8hޥD O.)M @ @ @NfΜZ0S=jԨT[7<~6mZR'Onw?'`gv2q3fL6ղcXX &Ĕ)S3rȸ+>lH2[^mY&1F uѼL @ ɒDNO @ @ @ve˚lFTc'-9X0`@l֩n/r*^WdɒV;󺆵I^{-yxcŊc[wc(>ֿxR|Iʈr%L$WKY @ @ @K k555 l&8WnZjҥX?<0> zȜRU{쑚*3/KnweTE%z!@@}.6l @ @ @(얅-O^;tPjѪӟj[[PWWǏO=>_~Fj5{VkkxGW^I=o6+[oE9M?عq JH HJ(c @ @ @ @@! d6os\7S* v)M7ofe)kc޼yG'xb*n+H$곦o߾; 3w}wmm… olSNiզ"ԯXXґis~S( @ @ @(q`t-/R3' WsImnɒ%qYgĉSkLW^={gb5c|u]~>.p S]~_ă>Xȝz,xꩧ+_J,]YkĘ1cS+ X Hm @ @ @JETga |GyiLa{.`x#:@IDATSo4l勇 \pA\qMS5\?p;6n߿TVVƴi矏'|L|;kB(NZbeEX07DN]o @ @ @ P KF{n̛7/^}զ ijlw(z6vM!ZOMi|s 6,?#6xtׇkG>ƍK=9rd*kPS-NE.0' 9-ze\Pz @ @ @  p ;[:s;dewuO~ .<ϏL.tV`M7m+'k㝀5Z @jH~?> @ @ @ @ o Fo䫮*y晸bʔ)7d8餓bرѳgԳlx`=:~Ą bʕk]);Zy@bHj[J!@BsG$C-B{5C @ @ @RP]*o>D3o޼x饗bѢEx|cРA!CD޽;Og̺_Ox뭷b֬Yh9lذe]kٛ(ʂ؆M @@1 4D2Q6bNRn @ @ @ P  ~x#)M!P[UI&H[moe._ @ @ @(`/Y$3qGN?OаE_`ł. Adꕫt'@ @ @ @y/r-7M|Q^]wzh 2$.:uwHS2[̸~I @ @ @%+#N:f͊:vy]}ܹva{?y{:C P nmק>cǎ_jU[ @3n/ux @ @ @@ 80.袘8qbqYgE~wiusg/~cECCC~ @@dbDO^rv^-Nhdw;9 @ @ @ PjUwn!*++c}ѫW]R6>vL<9G@t@kAFɒ~]+ @ @ @ @@(5lA|s &[n{63E?cvѣG7YdI}5 @`C  @@a$o\If @ @ @ ^ nqg3<of\vev5^ѿ8cGV4 @!@3 N sꓰ] @ @ @ @=ݪyBÆ }{=\\tE;7_bEw~1xw3fH @  @@a $S.07gW @ @ @ PPݶ{bYYY=:8qbL6-~=zX-]UU?b>8<씐[ I҃@:̸{.  @ @ @ @ ݾ^:S|=f̘Ɠ[>og 1#Fo9wqOM`墈dڞj'@N q}$ݾm @ @ @r+Pؙ'x"<ƢQF9sf5g̘7O~=NG PB] @#bH. @ @ @ ,̙)3W?1~xw׹lO>q}ŲeZy饗"SƧ>V5 @'ۏ@ݑ 9#6߭ @ @ @t@;{ĉqǶnXg˿_UUUqo~?~׿}ݷ+ _BlL 5N@)L8 @ @ @t@(7o^7.vm?W_}u̞=Cr83_W_}5oE߾}lq'7SOE+s:e]ּ= L qv3  PTɼ*% @ @ @ @@ TtT];ҥK;3xhhhX=zO/98ٳ:d:3&{8#o<5{mYX#{o(Bdҥ[}6zlXI @ @ @:#PPuuuЙLsuuurqSNN:) Ю1-;qGw(I9 Ҟ!g٩q1rTHV-FA_`H|5?{eY&P@A9 **jR+yHLmPk-]]EMs`vjiiKs]3 $qPQ*|s`޿#/30}~u};{?{rawW~*$@ @ @ @ l;vZi{"wu?=\=#>i  @{qƥ805A[ (@ɼ#s/  @ @ @ @$Joi?V.,+ۭڌtT`wgy ~YbLJM`H?Zjɇ @ @ @ P Ç3<3>O~Wn;ڇ@,!@# @@˺G  @@ 4k4yi @ @ @ @@ހ$IdoCCCjk3dȐ6,Yf ٺXl) ~?WPAJ!@ @ @ @(z&<  }۷j P1I$s.jB @ @ @/P ؏?xܩ> @@Z9ZjמJD  @ @ @ xÏ< ԛXrxb֬Y455śo3f̈+Cm3g@򈤩-#@)<'FǎY @ @ @ @`mꫯO~o>=z1c* @_  @K#yٯ/nQ  @ @ @ @j ɓc})`n @ d @r)KX @ @ @ @@ wq7 ;SL)|$BR^vY7I @@svaE$@ @ @ @@i ;W>8qbF/㠃*z. @,8_  @ uG|G @ @ @JXgw??{պu[Vwqqǵ;sѧOȝvN;nƍ1cDMM;g @@.]Gydj78Ss8 @@ $s'GDd2=/y @ @ @ @v tK{_WMW_M5`׶$"Xpakצ86 @2X3'b)ĥK @ @ @p$tg:5f{Mz0iҤBo!>LeY @@>/XxK>3X @ @ @ P"kO>d̓N:MիOO+@v'@JHZ @@^o1)2}ޑ׸ @ @ @ @@j  @֕M%@Eذ.PlN @ @ @Ѐ]WQ  @@e /̺TE !PH^BD @ @ @(&@e'Հ]vL PTdH`s @ @ @ȯ@{;ɓ퉷Fo~mM @%(_ @Vόxgt#@ @ @ @ h۷owyZk P<͈ o}} @H_1]YL @ @ @)PSiɊ(9lmɥ$! P +"yᆲHU @ @ @ m 6 q @:+٧=G @ @ @%$гr  XbEj;{Nd산 JU"ld%9*)X @ @ @\'`WUT%KbСvS#W GJI Н^ @ @ @ P @T@RRV+#iZۭ{ڌ @ @ @+; @Vnm*#@%?O]ه @ @ @ г1[BΞ=;֬YS];a„.=a Pٺ,[ @  3">y-  @ @ @^` w^<䓅;$I҉r? Qn㕟 @@>#{Yd(Q"@ @ @ @ 0 @@dk+u @xH?\zyɈ @ @ @Ѐ.I @`S$lӡk @ S>餓4`^:N?ԺB4`ZX|(W*'CJY sIOF`^ˍ @ @ @%/+ x[`퉷ƏÆ KuP,#@!sX6 @ @ @C@v1I:)+'z{SO=55AVv^=#@H^!L!Xm  @ @ @t@Mwnf/ @ 4`K2@ӚHBٗ @ @ @T@Nȣ@Ϟ=c}cv`% @@nxiBm!. @ @ @l@vFl]5Vf P:F2G& @ @ @r U@ @`kɆMolm{ @@wvN @ @ @ @mnjj?1}xcٲerXzuN1p&Lh>yKT@"PdDtdzr@ @ @ @( 6~kcѢE~衇Z~qEĉgϒ-5_ @dJ65 @X|5b˫t @ @ @ @jJ)\.qwguV7!wZ?8g1 Q'`wT: -ɋ7Fnae @ @ @h_kkkI& /~1; {ԩ @@@vY  @#sI $" @ @ @T@4`ű>lFMMRollK/4Lҡ @o $uo\ @!H(\dA @ @ @*Y*5y1v;vl|QFȑ#[ÇXdI,^;o+V3y1bDK67M @ dk۟7KU {YnLϝ  @ @ @ P%р}?*N9d2m+ƌxꫯ[n%NV8 /?> 7 @ ]  @ dFi؜ @ @ @(PS E_wumҸcƌ1qv<~W\-:*,w25\3 @"P_n @EXtk$k5 @ @ @ @ހ`9sf#H\?5jTiӦEcccj΀؂c@ɜ/D@ @ @ @YrR>|xqQSǏom^jUIk|(,+2?Q%@ @ @ @ހpTJc wǸq⩧j jnpA$kҗJC)Hv8:l@JU weĐE. @ @ @ PQ]?f~xj173{A*N@vŽR @@ 4dZ @ @ @ PzEoޜd|C=4cݺu Ў@v&M @%)?dj"@ @ @ @@ {)?)xթ=63uӀ@=b]wM}{]]WQ  @@AHf. %@ @ @ @ހ=vطyjq>gN{Sc P.#G+V ~  @ Lj%-Xx  @ @ @ @Eo>Scvh}>_bʕN;e]Z. @-8{ 0  @@ 4sWpR#@ @ @ @@ ;G8eʔ6lX3<sN455u[oS>:dȐ[. @h [ @-F @ @ @()w_ 0UsڴiqwͭO}Sq.۷oKCι @Hj7 @%/̾8 %  @ @ @ P= O<Vڮ^xa\wu,X 8㌸⬳ΊѣGǞ{e]Z֭]6/_+V3gƝw=Xi;w<Ǐo؊@[Ɇ,p(i "yNSr @ @ @(G5`_veOdܹq%bNnhhl6oor8[o嚶} @/M @W"yi_Y+I @ @ @@M$yWPuXn]wX @f&  @hnde  @ @ @ Peۀ]#@e-+%OM`| @ @ @ȣmL@Vv9&9 @ 4\vr @ @ @ @`k'?%@JW@v @,ɈI< @ @ @Dfk @ ג @*L }Q$ Vr @ @ @ ;K#|W^y%&M*k#iٺ @@}!ůD{y @ @ @O@vL[`6g?ԸdC}D㪮< PɋS#qZdvڧ @ @ @C<Ҕ% m˺m+ @,싻yS @ @ @ @)~_ĤI* [ [ @$#YzW)e$ @ @ @@R7ވEʕ+>cÆ [L7IhnnnYozK|0/_iӶ  P;cx≩ wy. @J] GfA @ @ @ Pr%׀=gΜ:ujy-M%'&! PD!CD 4 @@ 4/D]@2R @ @ @ @@y Luⓟd%([ PaI*R Ю?dĤ zoM @ @ @ @@5OwI4_w?  @@[z'`E1C*S ua$ Y @ @ @ P h/?O T_xqC=T}'@e/]V%(#rS[F @ @ @9p׷Ƙ1c]zW=:v[,Yem=⪫j^zuZ*.]O}NX"մkVf͚M  @@477ڵkSߦ;" @rX3'/7{'@ @ @ @@ހ/U}/rjnA&O~7]^H͍9256 @"$CAhH|97Nz @ @ @T C8?wofƍKM~;O[oMg}Rc @-oua4m @@ 4G2¿VW @ @ @E ع*9T1/#z*5qp 'llcW\8馛b̙-?G @r8p`\{'( @@e *& @ @ @ @ NN|^]n]^ꫯ;{ԩq'۰aCN^hQ\ST| &#w2Ԛ>}D]]]Ωy.`w}Se<|$5g@- $2?||K͗W 2ۨbAvmq@y ̢X8~mq{k/}noy䃿ZJYVYʍ @ @ @"P'`1eʔv 7o^K7#>m:rk>Scw>Mun_  @ @}Ց%@ @ @ @@ Dv3ό뮻]޻g#Fh3!C?-qT@] @^Y$u?:+ @ @ @ P%Ӏs+?A +G5N1}koW^qM7EۻmT@z @r`'ol} @ @ @pjYqǗ8âG^{c& &{d;׬OO$@6m>cLH E9# @ @ @T@5`sTO<9zXlYgeРA裏8ccȐ!dZ? 7ӟb[ @2  @m t{$:+ @ @ @ P=Ko3޽{Ǚg-ްaC| @ml׮ @[Hf[OFGﭬr @ @ @)P'`wG] y PUIscDÊY @@־ɂ/w!G  @ @ @ Pـ]C @HuEض @@ "Y=lӗ8 @ @ @:+r#@$]VIը)YDlA @ @ @Y2l!ӧO~:-[+WիWN;l1a„÷4 Юe1IlC EX6 @ @ @*Gd7l?kEmSj]sE]'N=K|] @ dk @H>b#>Y  @ @ @ %ם?яk^xa;iٹӦMw* @@ 466?Jkȑ1`}z @_~L  @ @ @*^*>8&MM5pNÞ:uӮ  @@ ,]4:7M멯z  @xŷUo*'@ @ @ @J.=xg;jj:zK/4Lҡ @Veي&@'H-_@ @ @ @ P=K%3<3ϟn:cǎO|1jԨ9rdwK,ŋ|s'^~bŊ6q&O#Fh  Pe.~ @E2"t5  @ @ @ P%р}?*N9d2m+ƌxꫯ[n%NV8 /?> 7 @U/P @XH|?2{|* @ @ @ @@I ԔBV]w]4.1cFL86m_~qWĢE⨣J-˝}5פ  @@9 6,~_GqDJHF4R  @6 $]IvO @ @ @T@O^`A̜93|$sO?>/^io> @w\~vu~=E#@.д:YEf]B @ @ @T@O>|xqQSzժU裏4 @U-~iUx @һ XH @ @ @_]]a…c wǸqR!}؀T%U]  @$s/ @ @ @E(zvmmm?<5`= @e+P_WK(a"NPj @ @ @@7O{|C=4cݺuf$ejP; gW~ɲ9p @ @ @(@ӟczTL4 @&]VmFdDҰw @ @ @ +PcǦ*>}zjٳSa{؀T@}]Ux @ +";O @ @ @(z;Ckŏ>_bʷN;-ve|@$ ˾ @/̾8K?Q @ @ @ @`Eo7eʔ6lXk @|͸SQF:[  @ @ @)P`b @e&P_Wf Kd4v+nu @ @ @ Pt^ z H]ѕ%@ @ @ @@Qzj??&NX @# @ H!wyO @ @ @ @k'?YrlI*[`ԨQoqSmr  @Hf[QOG| @ @ @)HTA  @d20`@۳g~*inh| y J[̙ @ @ @ @O%]ZKH IsF @ @ @(Q %bE .]V-l@@2HVvtu @ @ @(@Y6`_>"Ӈ褀Ny(@Hf{AB J @ @ @| gBZ`AW{,~xW#Ͷnկ_}ć>+b[|  P@)؃L% @ @ @nR+)&Ozh'o|-;!;_򗣹yKK @Ѐ]^ @WE2RPn @ @ @T@I5`Y&>Ĕ)SZ/N8!rM> @&M.  @%$ʃ,Q %$ @ @ @-P2 عS){챷Հbر{G^~8.袷'\ @u @%+̙dߏ @ @ @T@4`_uUC.:я~=ƻvcvmqw{$JWlE @e"z$.,dI @ @ @@5 DEolk~[N7n\뮩u5551|x{3gli3fLj]nz6& @@ $GlX[me(7忊[%@ @ @ @Jk駟ӟOLokd"׬=gΜ8S׬YӦMK @.ʲM@2Hֿ\~˘ @ @ @(zv}}}s=)<0oEt~zcJRc PN+Ws=7v4`o7 @" 4dEܶ @ @ @h+гTv @]oUM @WE2ȌTO @ @ @@LvMMM<MMMMk};9C?qKvGT} #@U-H'2Ωj @ @ @ PxoOCX|&O6VMDJ U& Pmɼ+#YV/ @ @ @,PR ع &to=z8$@'Dhh^s#I6!@ @ @ @@z,r{Oƌ3Zyx_o7nҰ}Gć?x;: @憈ULv @CĂ)^^镪 @ @ @" lFC9$rɓ'L566ƪUbʕ-Ar~XdIKtҖ;x9rd>82LѪ .l_ܷG{~o3fLr1)P[['pB~-ۘ [;  @#,r"SB @ @ @(h/?xylXիW :[:2ɇu⮻Gfۄ5bϜ93~Űa??kgώ[n%Ν6F?sL\p1dȐS~ @K 1k֬T7x#5 [n @*B ɳqѷ"JR @ @ @#PS g|K_?&L7cI wI{^כQWW^zi|k_$I6kW_}u|3bu{>q駷4755W n7 @hk_乫  @ @ @\7`?U"אdZ\T@K.$VXѦ޽{رccРAm&۽f>oqvء͒/|_|;m @@ du6$@M`"YHѶ1 @ @ @)гeM>M g}vӧͼȝ }eK/*=yOwy1f̘L.\yunk~>#R15;bƌpr'[r)뮻5k/Z(n/yqaߵwAׯ_|ӟN=6jԨxkDx#@*P FTdvx*L% @ @ @ ЍEo7o^rǍfDe <1gΜTq{ꫯns^{#K_Rlذ}k-tb֬Y~7e\6{7xchs$I뮋}{k!@@gvm_θ{(cHf]C*"N @ @ @@) ;׷IamLT@!yڴirC_{m7]tqMbҥC1뮻R޹[CP|O-{WL @[ݭ6#@JD#YL @ @ @@86l/B9'ŋS}ّ;Ez[)هzhj}ݗwuk9sf*'cǎMmmpyEM??C^ m7 @dWD+" @ @ @e,NwYgE^RvmAe l~;'>Z/ƒ%KRs]Y&@j;Цa['@4 @h^̳"in(%F @ @ @@y{=S~8s7LTܹsS?>5]zW7wtإOs=;f|OI~) -6!@JS`#mi&+ @ @ @F 9 /0nT35j$)PvL6^qƥ䚯:ԲYf]5*&M|r!q;d6M= N\K =uݳ] @,HV1bĈd2J?PS\9sI ^{cc-jED==ϟ5?5g@nv66!@@yG>v-TG @ @ @@ {ժU~&wuMMMN Yn]N6N([Km޻wN.=tTX~}75_A}}}̝;7}gS  Y>9 @@e 7$.!wUV]!@ @ @ @[ހԔ:[I^{T{j!C,}[NJoswuWY&G @4`w @2xH|72{UJ @ @ @R)dR=k׮Mn?{wfgY&9J*`#3ʯ\j㏎8FNk+ .Hhˌ¯Ҹ42@HHNJe%kթTy0|99Ugss]u{]~"zSkê[:֭[w2{̜93s{,܀db @H?i#Z @ @ @[@vOK߽Hz}ٳ VR?(˙=8#3}hm# @ H7Re{A& @ @ @ymwp@\y-8k֬LDv/zuF׾wygf>w;ӧA (n) @l^0  @ @ @]_\qm@kv{khv߀} 7wL3gx`_ b΍3tƌ/5j1F @Q`ɗ"GQ:ݘ  @ @ @ShPf|z{`ttt*K5d΍7_}Z^zitIU: Peb|r-.3^C'g @[}}/o @ @ @P]w}3m߾=Ӯ1<<\5t4c_r|ߨZ/3<_Z*}mDi6#@J`?*d @ @ @ q]w/FZ&*>jސqEW^ye|߯Z.s9_Z.Pk6$@N`#-f0 @ @ @PZo '*ky-S2fӦMq%mݖY'.8s3h@yU۶1 @Hi#m}H! @ @ @ xۭ]6~ŋcʕq8SNua#4{H`)<00P5U˗/.,Ξ=;>OgQLW`뮻.K_L{Ɛ ]t @v F(6 @ @ @͋+"n?s}Ygŗ8c2!pg/ʟg͚5UZQ='>[l>83h^.n3 @.ؼ CK>R'@ @ @ @`O={z7/[ozn8餓_bN4D_?LWδkm>o֬Y{qwk:n.䒪룏>:)8Z+zۍ(үFZsk @ @ @ hzvR??暺 nݺOM65ȥsy,"@- R/A @ @ @ 4/}{JlΜ9w;RJZ~xd-; f|əv#w뮫Zw~AUA(Q(HQ)PB%@ @ @ @M-^ti| _co~q9ċ_1cƄӟ_?;8ꨣ#>o޼L{ƍcɒ%a/yK2F5~Wժow'?fͪzpscC0 @@6 X @ @ @4[W]uU W׾6X`A?z(㬳Ϊ3qNد~ݵkϿo2{zz2}hۿZ#H}RTN$*cC 05Ց } @ @ @ 0&дR|Uw^?S򕯬z7qǞn^hQWp u׷{#ӹH|μ}k^GqDokg?٪eom݇pu!I @@*{o @ @ @h@ X>?&_(1cƤ}?v]8餓ND|%{LJ\sMZ*]zW=Qcvḫ}㷸oٲe׮83xK{f"0e^ @PcJ >XK @ @ @@szlĝwY>ԧn3g3\rI\p;3ٸqc|#q'ao* ktMqueodЇ>{16wg;~=C},\0_oc|N3S(OmY @Y5FZ(?Gfk @ @ @ ЩM+^|yٛu߀})d]w/|/pꩧ/3 _ik֬7xc;참2}hp Ulذ!.袪z;n8f<&P< @C8Q:Ut @ @ @ M+^bEFۃmx`KS~jժwF888rˎ<;n>#'x;]Jf @ihU @SpqoMtʱʃ @ @ @@== g͛39LG]5tӦMU}:+>(~_]WEW_}u7dɒF/i=O}v&@:R`H /$E @ @ @M{hh(xT>sLմ݋(UW]wqG|ߌ~x9~~gfP==s h@\+)GqD/P @4D{M}wC @ @ @hYٳ2 DYIzիbkժU1wXn]lذ!>8cw|/}ݷ|wW-71C ^LX?яvPJsƐwLh@Z|Y!'6jI @ @ @ P`dɴkmLtk׺q8ꨣo|cq),Pstb#@W`t }Ҍ_M^ @ @ @W`jU%s P(4%btkb, @P[EzB,X @ @ @'{z~f @| W;> @:A` ȁ @ @ @zkc ?q}e93LCvC ,C}_Ь-K @ @ @@N` Aj5kVvi }zP_c$@ȦH7_Fg1 @ @ @ >B @S(O} @ l'ßo @ @ @N@vL @vTvvZF @ ˑV Y @ @ @ (Ɉ4B`hU#V @@i" ,c @ @ @I@vNK @^zɌ'@L[`dS4Re @ @ @mUH7n[nު9ocUvouq @ }~'@+H?SPDN @ @ @-+~'-oy˄Ay;%3>ik @NNLMN @b,>agD騳(  @ @ @IQ @ؾ." /n @:H -0Ҷ:(# @ @ @ TU @i޻#H  @ @ @ثxI ,P+pB'@tE]A I @ @ @@w 6+Ee˖f-o] @`2rd#'@h/agD跷jG @ @ @ $`xM ٲ @@- ص0Ch@z4J~ @ @ @hZvC" iӦW8sOh C >`yxկԻ3 @ @ @P=->  @@kz꩸3/ܟA mDZxqNF @ @ @S$s @   @](H˿ՅK @ @ @@g(sZUݧ @ ie6?XA @ @ @@} 2UT*ٳ3_3f̨)U#A PyGޜA @ @ @@4h _(˓2?# @+0x.8N @ @ @@]n` Pr_A& @!A @ @ @%X%Z P@ صAEh@zH~@D@ @ @ @@M kb2L` ;1 @߄@IDAT,F"w~5ݬ w @ @ @P](] W>H @ G7V]i," @ @ @ @` %(@  OOv1  @ @ @C@v1I @>M %_|"  @ @ @&P=!N Pp' | @@ DpȜ @ @ @@`G${Jl& @r!0-wDْpA @ @ @@V@vC^ l!@(Gc&l @ @ @';g"" 0=rM ["=qm>b @ @ @;`@:D`C @@zӑo @ @ @H@vC( @!U Y" @9HH @ @ @zA @XfM//u @ @ @ ]5< @ (.ɉ  "H)'& @ @ @ȡ @@=id[ȖzK @`b?ȕK @ @ @ؾ @@,z'@ȓ㟏Ց-@}&@ @ @  ;G] Y @6 li"ԦlK @ @ @  w&""@ oo @HU=3%@ @ @  @@ <ύG^ɴ5 @4\k"ot̻  @ @ @M@vNL _}mti @h@z`ϝ Jk[ @ @ @@zX  @@ @ @ @\ (L"P^9  @4P`dS{ύ4Z @ @ @@`DKٶ @f . Hfd} @ @ @PcQ`Ɓ @h{"H)5pQK @ @ @(b(  @ $@h@͑L 6 @ @ @| (y'Pvv}`F @4T/DzƆ.i1 @ @ @yP؛ @@ ‹#U v @ @ @|(9LM`pE @Qi$ҼwEPV @ @ @\ (L"0j^ @hHs΍4ق @ @ @@{` @`ixSȖ)7 @@Ca-`C @ @ @ (ۉ*P^YH @F`ӜH)g @ @ @mmÞ$@(m۶~cv4?̈c3US$5 @DzQj#@ @ @ ع8A @֮]w^f/GvFD @O\iEP@ @ @ @l @ @"-$ҚH @ @ @8w"@ @@ FH ! @ @ @hYZ @ @`WсHs΍4d^ @ @ @ -[OLc+WȺrןDz`K P("sv+oҬ `  @ @ @L${"} @ 3f̈?;>b_ENJX @ <>vxϢ4c]x&@ @ @ P8U[;2 @4TV @#H'R-N"%@ @ @ 0 Pt @ >D @XH.A @ @ @H tZb%@WbD] @@G HsEuTj!@ @ @(➝  @ 9Xߏx 2 @@W nt9mQ:Į$4 @ @ @@zh @I}1 @@G ot[" 쨴$C @ @ PL<7Q @@ #*]  @Zb&"A @ @ @P3]׵[I y[4筑F:/7 @ @ @F@vaJ @`L`p @-Hs2'@ @ @hۘLA S@3 @i"qI @ @ @  F"$@;R ;1< @t@#-6= @ @ @@[`ݦ @`n"i @)k @ @ @+;g#2 P-0j= @,2ov3  @ @ @Z,#@(t  @t@Zxqubjr"@ @ @ȡ @}{| @H/_v/  @ @ @Z&e6"@HGT[l @*F"w~ E @ @ 99a @I+'b @ EHO '@ @ @h@os: 0ѿ\5Ylvߧ-=A н"{n?sN^ @ @ @4M@Vh-L,Ppd^9e @^`dc{!@ s'#-rΣ @ @ @@`K޾ @V] Č3dns֕#@ @F呖~ц @ @ @tn:m @@1W;|z!MkO @LQ -,5٦ @ @ @tN=Yy @@]n$B @ iő  @ @ @ [l 03 @ic @ @ @4dA:X`p=Wwéȴ5 @h@=36zq @ @ @L@vL Ѕ܀J_ΙՅR&@ n"QQg; @ @ @Q{ۚD Qd @F2VHnivv!@ @ @ȥ\ @ؾ6" @ @ /itƊA @ @ b-K @ "na 6 @ @ @@`DCvT+g @݄H+DB @ @ -a @y'F @@ƊEiVv @ @ @ȍ@ @@@*ZE @< H .y J, @ @ @MPD\K @i * @4]` #-Vw @ @ @@` D@,=xC @ giG"-9J8 @ @ @PhQ @F (n @4] -$ү7} @ @ @O@vL*R(/  @ȟ@Z|Y%__`""@ @ @h0Z4A`4܄-I @@҃h6'@ @ @h@o% PQۇS_RQ=qȁL @H]1CQzF @ @ @ P0J  @ ېK2?|8U33} @C =ɧ|$  @ @ @i L{  @(W߀ݜJ @@3# @ @ @-PBl[ @z` 7 @GCca @ @ @^@vP бnأ @@ <Ũ,/RRi @ @ @:C3Ґ@ʪ:fO:vFA @@]сSGJ, @ @ @` Hh`u왥8d}dlO @`z+id[iGg2 @ @ @=-ц @)U"VM: @ *sy {  @ @ н eNyZcW9B @ 0]5FsӷaOw-  @ @ @Z&e6"@uW1P @ +ב}KMMA @ @ @nPm'._(@q @ kҖ( @ @ @J}'@ ~]ٵwF)v*JUct @ %tihm$,M @ @ @@` D@X' @"yA^i`:} @ @ @-'@  @ @`L`"i˃8 @ @ @,'@$7`e, @ G=z&@ @ @hZLK@L&@ OEM @ @ @P,Y @ .,s @ @e0Ҝ"->O @ @ @ P0J  @ (n% @JgY @ @ @4X@vA-G*FF ot @ P%0^]yHi @ @ @ (Y @K  @ 䍑id  @ @ @(n% @@C6d @ @J`?FUA @ @ P&@P<[+ @ in8Ҷ'h @ @ @LC@4L%@H @ P-0EVC @ @ P@oM "@/P 6UⒿr[fſ=aFO @{ؾ.gF(=O8  @ @ @`O좗^创~5W*Έh @ 0@Erm= @ @ @<+' @Ou{ @ ei4Fzs]t  @ @ @P==?  @@CR?2ؐ,B @zң>i ۇ @ @ @`rɇA4]`piM[̞e~J55 @{xHUc(a^ @ @ @D(]@ 0(:'|iD @?w?>ϯk @ @ @n^M˕I``Y  @*Hw6* o @ @ @ '%24_ *n @I`hՎӚ[kn @ @ @`wۉ˗)0$q @iy~;5 @ @ @`/ hm# @jDZ|YTeTqa @ @ @Pg,Cȹ@Dr @ZEH#ۺ@ @ @ @]`C`pkɵޞ @(旑~"W80 @ @ @@ (ܳE``ۇ @9 @ @ Ma(C``Y %@ @@*}4*^)U @ @ @-P2j @= .  @ȹ/G{^-9Tx @ @ @ (n @܀=57 @ȇ[#G#Q @ @ @,-OE lްW+U59ʇ3( @V`Cxm~;JڽF @ @hjێd!nx4Yb`yA @V pi?F7Qz{Z} @ @ @-i6$@X' @] DZxQT]) @ @ @`wJ $P L @tGHYA @ @ @@ vh^"@H݀J3gfr{Q~*A @@>k;_E( @ @ @ PDK @) W}聥Ly;  @ RmaQK#~!@ @ @t+3;@XRN @F6EHKa! @ @ @ (:Y`NNnΪLU*aHH D@EAAm۶h[[p{vh}oڷۡE{m/HH$$HeNeT%57'c w^uwϮE֢E @H~"*pJ @ @ @@S (n<4@ڹ6) @XH Իqx&@ @ @H@vC( bK[,a @ @ =mGz? @ @ @@S (nc4B{y)Ґ @-г"GÞj @ @ @`:[`ƍ_2VX+WUVĉcO<1.8#˲y;N?e]\s͘$ ,н  @u숴MEvg3Z @ @ PصqJ w/?;v`!}?U|3nz\o}k5``1>ڨ-C@Y`$A @@-v4H~XլA @ @@{V0!'>Xre:+)M.]r>׃/yܹsWߟ\/ C U#vt c @hʎH 4 N8u)W@IDAT @ @ @pvYcѢEUI]|/9N?tIw;*ƍW5_j s75X4>X$~=4r[{ Py&d# @V`"Hk @ @ @5P]DKL &y|&&LP|_|VnY=;7q{X2 t/QvJ[[o_Z& @ @D]a:N @ @ @-'厼8 ϙ3'/_^{hk;-/yK?ףf͚]^{mtwwc k *=j+֧8]Uؿ0X#@ @v<ieV`KY @ @ P+CWj'Koz2k֬{UCo^bEճZu_z\uU_je8y$#  @ @`OH ET {xO @ @qk.V9wyUCu8㌘0aBհUZuou]}}}UKN81?U @#k @eXO~kʜ @ @ @&PT;::bU{UCu_V ~WկU'Rg}v|ߍ+r< @!z` @-9/ #m' @ @ @ a6S`ѢE{vw?yvs瞧-[zs)Ļ 뵅u he#򘣲Փ;k\U_ @]߄}E)xGeNWr @ @ @@`LZ"ŋW9qĘ6mZճtfΜY5l͚5'Oz^駟|; .r @RWDߦ L;.?& @ @<H]9?3G'5 @ @ @P]#*gUUv=}>1k֬}fOs (o. @ 02u7E-#f @ @ @)6۫֙1cFUӧ3+YƯ],G@`4B @X t/tV~w#? @ @ " [䠋Eғ&MQ'Ng^OO>< @@z* @ @*;#QCv4}: @ @ @-S躻r0aBU۱نgc#܀=6v%@ @O۰[ @ @ @P]/YT`wAx`{(r 0t{ @ @~iEX4%G @ @챳owYC3t```g @P= ` @ P:-~kT\)E;_  @ @ @1P=ЪO<*ުP;}}} {}x@pX  @hǿiviI @ @4@@vmE{߈?_ @iڈʎD" @,_H$@ @ @-߯+Ľoޔ)SK t/+P0B!@ @@ntQyS*-4  @ @ @z (u*wvOOA}>RI@vNC, @cik#S oPv @"6͋8[0 @ @ |7`hѢaT9ӫ:(@…$  @#}E?ki @ @ @CP=t+#k(p̙3V{l޼9.]Z5/xAU_EHX @ @`PK{$*4  @ @ @ z UZog̞=㶶83 @P=+p* I0 @ oDwi[ @ @ @@j \r%Uutt7\@W+_8c @P=G 3XSgz]  @ @[4HGB @ @دxN;-f͚U??ƣJ_cUsWI)Şmc<#@@zqY7og-zTg~q7>h?by뮋. |{ @Q؍> @ t\i΅:A @ @xZwE׾6~_u]guAEH"6%q @ @HDQYH]#]< @ @ @ڛ8vP /zcÆ iӦ:ujx≻ڳ @@l)  @ @@A:#ΨH}  @ @ @ ( @`(=ˆ2 @(@ \ioʐ @ @ @ @^QU7w[[/nӞ5 @Hwagid~6q8  @ @ @P]+I @k#*=tx7oOV`6c4 @Xϑ6l9N @ @ @@궲  @H @ @@+ l$ҼWGG  @ @ @@)`%A^^G @ H~!/ľ4R  @ @ @@`Kֺ @)eO׶,)m @4{#}ye_Rs,J @ @ @JC\ g~tDc  @4P#҃X{S_l V @ @ @h܀=ZA  @j  @ @6iK#A+f/g @ @ д NM#P&g @ @DZH; mQ @ @ @ (S~ @@R7bǪ)? @_Da| @ @  @@#y: @ YaQ~!O3 @ @hzۍZMkqe,_ @omO|+O @ @A@vP-IH`?e+ @ CK?;S~v0&J @ @[@vO-> @ @`# HO|o+O @ @H@v -C+еd=$@ @Cuo~SUCf  @ @ Pq*T^J @F`͑anmֳ  @ @ 0"#b3 A롈40 @ @! oG7a?1I @ @ @P]KMk @=-޳= @_E}^e3Rn]+ @ @ @P}H" @RəE @CEwy$<$2 @ @ @@-k5 @k;+/ڷM _* @;"}y]mB+e/W @ @ pZ '!@C5O7W Tץ @@x V4⌯F6D2 @ @h@[c h-43{ik%-[ @{GwyT]# @ @ PB%/Қԩ @ @V@h'@{ @ @@IzVD窨qeGJ @ @ @`ǧ @`x[b]%zËh @ 0Z 4炨,6RѮf> @ @h*Mu\%@ t-kS^ @ @/DH?n#@ @ @c&{mLeuW @ @@K \wGe"m{R, @ @X͈|!i7O"%@ @ @pe!|L,Ѐ @ @[4ﲨH=O!"1 @ @ @Q (5 @ @ @'qC[ώß4н @ @ @P4G%P(@&" @ @`*;"®BH)q@'@ @ @#P=27 @@@ۯA @ @vtDZH^i1 @ @(➍ @)n+ @@ /N_b(ۋ @ @4f9)q @@RגB'8 @ PX#H|!@Oa @ @xJ@S @{4z @ @@ TzGH~)V? @ @X@vGh D](X @ @ Xi{#H4Ha @ @ @@ (n @Rֈ^ @ @[uQ-B @ @ %P!hJ%M  @ @@"?sm  @ @8gY @@=`S @ ߊ3#="ooy @ @ 0c  @@ mD_G;<:aF[qXo  @ @@ *1D'eJ @ @ @ ~B#@ t5{/`w op|3 @ PZk#=g1Fv6U @ @ @@1ڊ @@ 4&R* @@CH[^V'@ @ @{([ 0\Է%bN3 @9n8*+ju @ @ @` @`]0 @ @iQy/"u @ @ZXs:%_c+̜ō\5}* @h]4_#=q]| }$ZC @ @ Pua(@j ؓ'f{UI @#x+V|+q#w3 @ @T 2C O`7 @h@H:-gDZHm' @ @( @! !9ل @Mw]EDH*eP> @ @ @ ĶK mع\IɆ @YgY4HkQLF @ @uP]G\K @@-.y#@ @%ض(oʼ"m]$E @ @P]/Y @@`eH @\i2u6+u#@ @ @ ( @[ĥK @47D?Ҧ)1 @ @8ZZQ حxr&@ @2 lM/ʝ)Җ{˜ @ @ @` Gg*%- } @ PR鶋r[#m}IJ @ @F*{r @@K MZ@ @ @ko4eQ"v[ @ @JGr @ @R ߑR*9 @ @8CAضxg @ @%H7D}^^y!%Uj @ @ p0}3 @`kl zR0*KϞwPt @ @@*y!#u\7Ev";ⴺfa @ @(❉ @ [S+;n$U": @ @ثiFll @ @ce؞T`nnR-a @ @r YF?r*; @ @ؾ  @0Rƈ Üe8 @ Pzu7EH,}$@ @ @@ (nՓ7\`5 @(_FҨ6+2$@ @ @@ X%@gaʤ @ P 4؎~Ed>8 @ @ @` Gg*@ڲZ]ݚ k @ LDZ/yWGȲ2+ @ @!ж{o  @ C  @ @tGsAUG4Pa @ @ @`Lg @`]K3 @ @_N 3#-FCg @ @B@v!A ,iލ8  @ @" H鱿Էъ @ @P[ G ʋ @ PSԮB_"@ @ @ (. )Mv!EP @ @ [#o¾QyHː @ @ P:إ;R  @@=Rגz.om @ @@DegĊoF̨H[B @ @P] 4H @J"":~iˣ"UI @ @[@vs  @nn @ @At2HO\Dž @ @H@ۖO \ѷ1 @ PmFnyaǾoKyr  @ @D@v0  @ ! @ @r#=tmߜşԳ  @ @4H@vmC%R]S @(@WүFQ=,,W~!@ @ @@  @@!R'~qkݝUa獫zC @@!`~qd'}8#˲. @ @/v @ls3֓WegS]%C @Z\`㭑SNx"Nx[dSZE @ @@[햲(@Q+,3 @ @G#Ԩ,/zV|  @ @ @`˙/|N<3 @ @c-ПbtQ6>ٟ @ @M- 4H mߠqU :~Շ: @ @*k=`;ő=xsdm  @ @Z@ @ m"A @ @M,ua?ڈg7Yl1M  @ @ 8me' М ^ @ @ #rZT~0Җ{6g @ @ (m@%C9 @ @y*鶋r%V G @ @:ZJ"9$H @ 0-wEZVSЧ"$C @ @ : [eJ#HG84 @ @@ nxBEFpK'#t @ @N@v,DeؤG+/ @ @`(7F QH)R֡L4 @ @P]cJ m @ @,Dw @ @`h}"HWDZ"U6( @ @4谄JH}]5vS @ @ Hy -/޿RT!@ @4[[o?-3xW1vvM@  @ @hML[ @וc @ @uF,z/m[di @ @ @ k-j=(@r!  @ @@ l'׳6l @ @ UݭO @@'bu۔#;'53 [ @ @ @ TWp @ؼ8-}B&( @ @@?k#t΋qk#7n[Z @ @P}   @eR[6 @ @ +"GEHxs^}UdS-l#@ @ @|mKIF @`G @ @u⛑n$*iGGݷ @ @` @{ ${ @ @ .Huߜ;qC-< @ @UY7Z @ P_בGF:Nx[d.V'@ @ @`qK%vn衆 @ @[#V~'`;줈gQdYE\| @ @\ 4V׍ @ @K#bDWFZH;7bg{ @ @ PB%v!@ @he]/"=HmEI @ @@`׍ ls~CN)ξV-@ @ @@ t=`.ҭgGe+"=H=+>-  @ @ 0|O1O`9:>R<۫ᓓzC @ PG #-\i=M_ęu @ @E@vQNB 0]K"7m v'@ @h> "-D鯈{y1E @ @ ImH "@e_ G @ PW/m?듣H%u @ @4^@vHH x*B"@ @4@%/ƾ5Ң.ƞy1fMH @ @!о{o  @@ lO?"ĪX| @ @@7͍XH^WFM:H @ @! ("a P^]7,k8, M  @ @ȋ;oxcy1y1"̽ @ @ PP=a @@؊ @ @b2QWWD6Fn @ @F({p @@yv<Ȅ @ @)o_G:Ԉy!qQ/nlL @ @ K}#@! 2E @ @(]K"RI'{vi/,k+J @ @ в [%Ni;bB @ @)ceIJE[Li"oǎmB1c @ @ (.K!9i|L @ @"V~7RޢH\c~S  @ @8gY @:  @ @W[F[d"}adǾ.bÞSܸEF @ @ KpR @ MF>L @ @E ogG[,H;/Ǝ΍,ˊ @ @F@viR" 0\*4  @;@IDAT @[kqDc1H3_v/˞\EG @ @ `7! $mQj"@ @ PVu+)o69ҌWE6x31G6鸲f-/ @ @uP]W^ @@::< @ @@'bM6JG8c&s"j @ @U@vYOV^ pHF @ @X`ˆG6bHbcϸ$SK @ @N@&@f4ћbCUqqۉPt @ @'л1b"-q]ߋS @ @J.,=ؿ@YXk:S\u''/T @ @HnXrmϊof:bEO @ @hzM @ t4 @ @@ϊ߈G:ecsY~; ZC @ @` @HZ2oI @ @@xkŒ4yAe3^gO& @ @hpJb$@ V$@ @h=#Hyh4':3LdL @ Pzإ?b  @[~gŝaU>8?Ī!@ @#JDHy&bёf\d_1UM~e[ @ @P][O @@3lG0 _gq0r! @ @@ߦ?W _Y-G"a @ @r(.9ʂ!Vd %@ @ @&[ZOW_Gz^^ߎ=xCQgGx&!@ @ۀ$#XB @ @RDHyG>~T.oΦ̶g: @ @B롈k4'oȾpß?M%@ @hv~'@C rL ش-']]=m I @ М;VFt\)o4az#;kގ:+q37Q @ @ [@L @fH[7,iJ @ @@z7F)Rv&D:iD6k^=g!> @ @ (!i i (  @ @h^JW6/iÞ;/,̎O,˚7G @ @<-i o @?)UZ?VR^O @ @"V]{"$oD61 ͦ @ @P=:?  @󎈞p={f[O4 @ @Hy{[8;?5%ۍ OJ @(좞 @`Qa @ @M롈'mGD:Ꜽ(;){-F6azݶ0 @ @`,(@JZ(G @ @=El|{B쩃y;Mc @ @Phq @@c6Ύ]ߘB @ @z t?qHG(");U}nĔGe @ @{ ( D!:~\DdA @ @=RĖ{w⛻?i?"Qg=Yd٤g9{ @ @ (! @ߋ( @ @ Pom0oɽ#U=X}Vdw$'@ @8fI @2gN;Igń bDq_EfFп;8.": F/:U[I;U>}={9:U:w& @ @ @J`ˆEF1[KqY,}d)]6|ؖ @ @N:4#@(οq: @ @+s#/*w,د}vJ({ZC @ Q@h`Y]G @ @C5#MC/.G2}춉v @ @. '@`xkۨ @ @}'P erb v.اr @ @6V4@qO`H @ @>X[n]k~QiB);B;v @ @[ow#@^(_7x&@ @ @gwr(;ZGq̡YQִ1Eaiv @ @. 诠 @V7G7n-#@ @ @ؼ6bzP-4Sa:- ۾ @ @{e @oNrY9ξb].ߛ1/H @ @K`Z\xS_šfcٲ6);Ƽ #+m @ @@|U,P\;?b=]>NXMsg~ ؍Z/ @ @ذ4\ҺuBGeegB):br '@ @ :]aG;{9 @ @ @@dz޼X%,}H~ۄm @ @H@݆zW'{W'@ @ @ش*bz*,]cg샣0t; @ @^@{пH/PLh6C#X'ⱛ9 @ @G`%+`ۃc0v)Fud) @ kؽF ggwm] >{o @ @)vnDZ- Q_~A>( vэ9N&@ @E@_ݔzR8k @ @ @Ȣkl_gU0;8|-d샶 J "@ @vN@{M,P|O^= @ @49ٌ`vٲcQʅ{4pu @9s6ٯp{ @ @ fu #Һ|0u0Pv)=r( v0% @$> @(n\1 @ @ @@ lz.bŃX=(1jjО͚m - @ @ , / @!bfg0~ @ @(ōm_!cKu`vҎ4kv2 @ @Ix5s"f]1:G @ @ @3#WZ(7)l}~~~ִ_Z|: @ ПޟM(墈k}  @ @ @kf5; C8rr%] go jPhC  @ dM.@q#0c @ @ @(nXXL-òp-P?+guٌf6# @ @`gwV Чb13>ڧt3 @ @ 06xnfu.G{RhأR8{K0{p(mmk @貀vɜ@*0kܜ @ @ h⦈Ogg/+ gO. icT9{J&d-, @ @ (UQTt @ @4yi]zwpv-6ٚ͞B#B˰ @ @fnw @O|)b݂걮 @ @ @ش*b5z{fa}Pvִf.ZkP$@ @O@{FDA)P\37/ʱuePsoceuo/=@ @ @#v~6{v.}v.' cv6[vi# hN\ @Vbt_"6ə7E,\8;֬˗P  @ @M}5{O C[F4vN3h -n]  @ Ќڌ1 @' k%@ @ @rōhGK޳=] eS@; mma% @ @@`{ @@b13>Zw{  @ @ @FvnJE8dl{ 4{v ho gfn= Fo @hytM+0G+oy# qCs @ @ ^#VkQhbYH{lN!lV~VvBڅkdd @ ؽN ]Q>(7=sA @ @ @(n:vt!QQH)6N.@ @A* =H_X"@`(>Ca(@ @ @ ↈ5O[1=$I{,ٌٶPgvf3mZO(C @]uu@qͼ'ͳF @ @ ƪۯ!UM(g޽=C6Bq* @ 43?y  @ @ @X8"+.vnM{K0;YfniBԶ @ @@c`7뤗h*"l @ @ @ (nfӞӾnbgAb˰l,]ggB hݲͺ]( R,"@ @@c`7뤗hbi( @ @ @$y}]A툖lFݶΠ]I{ְv)=t0d\ @^@uI 7D- @ @ @lXttV,ݖ@vZ(mYұBʵ @ @(@qӚ(Xѭ @ @ @X`Ӫճ-,[Go igkBm{XnQ:n @v, c#- @rhy}u7!@ @ @( lz. jrMiY`XȢPv>]HuƗB1, k0$B @A$ =^LC!@@# Ώ_l!; @ @ @9#-h_FYX;. NB[)ݖ[ Cw] @ <N(>knL @ @fOAӾV vlڥSp{|J[M_hm] @v:@ay=)b;h0 @ @ @@S7dk/l_vjRlȮ fB)K3l˶)B#n @ `o%@q,|#ܦMŘ4] 10xmd @ @ @ lZ&OZUbK6k0mN~ nln  @M- / @g#VNN4,.>"K @ @رu, ך nٶcX9fvlֶ}- ]sE @U@Q_9&@@ -OsiQ: @ @ @@S ٶӺvno7]"0vm8;faR!cU @Owo4@qGpL @ @ дō l?1=]Q{ky͐]*6Q @ @5s׫N @ @ @ дM l/ CB[ڥvm i.;/tB @Iuܤ/a @g[M|^!~1sP6ぅ @ @ @=v֑[Cڥ1pw!mKMT_nc0dTr @Z@_%KmO=T̙3'͛mmmn>zի#Bo~qcW=^;"0rx!|\6C @ @ @@_ lZu ;fN'#N!v\ s[GWu2~$@ }u ^:cڵIAz(~\pA{fE#7#P|99 @ @ @ ,u;c+]&-*ˡlۚ٬۩.y;WԮfsr=Uh>X]@O Wo;yOu @ @ @ 0,;\WRŖ[B)nuo)W[GdTnoW_{ld{/ @@ `7[n>}z/㢋.aÆLi{K/M6U_c=֮聝Fc %@q?_>Vׇ=rS!@ @ @ @@ l^ &Eޅ`wK9]|ٶtlkS6]BY @~ywb? O~ҲGʹ͋[o57Vzbt ;+Pܔ~w#9 @ @ @SMqeփַt5]jmKڮٶfJػ?<;-J|m)+]%@) M8]wg]3n8͒}Gǽ[o؍  Pܸ*oeD_=pK @ @ @hhټucFwK%{*{ h)rP;JmYvt/+zOZ @( =_&-ܒԩS#̀]=~㩧}ݷK]#qЀ@//(κGZB7\ @ @ @t]`,Xv&]]0tKh{k(= )].âP };k]T۔u)P.>V~]l  @@W+Z3r{_+0mڴ6lX_qԺ7Bz@aY: ^-K @ @ @ @&(nȾs֝Xz"n_BMH{KP;+!g e[*Wշ_+]}uy~vɩ @{Ku+0X<<ꨣ{N>z+;}1:@Kg @ @ @ @`dQMO])]E*rh;mC5J!-59) :xyMf,_-#]g~[ږ_h)Ö@_} >}zpvTΩ`?;:Ǻ!n ='Է"6UF @ @ @@qcYBOkGW]NNNT.vJ]UR]k}t-m+~=QKUr\guڗZ&h!s7mkkq)L4)l…f͚1bD;Fcw(zPW:Wڕۗ[/m־gVsr}5|> 2O nk0uuժUL0!W0~M{uݩh>h\/HH5{aCQXLjU*{'{E`Ҏ3/yswh ]:vM1wRþ:ީ!ݞN=Ěَ U6 @ @ @ # {ӳ/U9[)POT\ }ojW8Q6gj )0jԨ7w  hN׆ޭAu8o͚Qq;j8@쯦`mZ-'r_Dz_m4!X~]LitvUzWվ] @ @ @@}ʭ]t@ ~~W\BV^arz vm<ڢXv @ @ @ @ @=# 3E٥;ɺKvbLs)5e~ @ @ @ @ @Q`H3ژ_`ݺuN :4W0dHǷM=}hmm޻T- @ @ @ @ @=/1pEF˗/ԯ_ߕ 6thK#q[ַmUO @ @ @ @l'O! ` oO6$ݰpgѣGouk>nk0o|uH= @ @ @ @ @NĹN%mpsgAz.yFi>p @ @ @ @ @vrX5k{jիsT@c @ @ @ @ @U^um L0!wgɕ-,ZCӞ `7B; ^ @ @ @ @ @@ `*oK`ʔ)CO?t\oaÆEmpkնk>Y @ @ @ @ @w{շ!0yܑҥKsu.\k6u2dHFcw< @ @ @ @ @ `wY;)P;tӻ|Gy$wΡ+L3s. @ @ @ @ @@nc=bҤI+= ˗/Yfr!;3> @ @ @ @ @t]@f!N8!w{'6mڔ^w]pKKKL6-WFΎ @ @ @ @ @ `oe ]qqUظqc\{ïx+bvlct> @ @ @ @ @@[i|pL:5w+2{\]ma}.,X;tiʝbT>V> @ @ @ @ @XG@n˗/s=7O/_|qr-c5 ?ϭ)𽣥/8N @ @ @ @ пϖ킻7Ib…Yׯ_o駟uرc㩧_W}-?Ə]vY=:W_[xUvaqGj }{+ @ @ @ @ @ ,!;zӌ~,X z׬Y7|siTv3bĈ#{si>] @ @ @ @ @]>|x)D}w+)t|&NڥӸ؝q9 @ @ @ @ @kfֽ$Η\rI}q5̙3y1c駟'|r 6lz@#z @ @ @ @ @yB1[UJ_`ŋcҥ1vg}J~#FN6BI @ @ @ @ @L@{C @ @ @ @ @@ K2 SK,n-z꩘3gN̛7/bv+=UzUyQ(zꖮCU?f͚Ufܹw}+tP  @}!?1ʭ^ĩZ)!@ TG}4Θ1cF𥳐/_ƍ}~sqEKK@~ @*3gΌGy$fϞ]ZSg]vɓ'~Ws11r9vlK ےQOի뮋믿>֮]qıv @S }uW'pB'\ @x]zW,Zҷ>s*e; @&>)%sύiӦ @~XlY\y_jOIwyqﰭ- ܯ @?~}ŋwo}[K Kl @,>wqG4bĈx{oy[b2 @~'>s}q( @HX,~< 7tW'xb|C.9M_u|Wm&LЕӴm"֏gKP  @@CXk vo[[[r!qXfMӧO/q @͛ /{ۏ3&LIcǎ+WƦMr=w_:*wL 0nk:tC8[  @` g?ٸ馛:tkذa1y:ujlذ!VZա_Hc   @?>X~}?ISuԜ9s `( 0Rp?䪗>묳J̏f*"YE^*xqqU_> @_xrNϜvi7)\%|L{o{l~z @@x@> @:wieԨQpN9HO)+/ig7g?Y7f>ɱ( @ |K;9(Ϗ=ܳr,M~H|.1cF~b}*Ȭ}E @H .?AGiO~ _Ư}kDyŭޚS @u] __xᅱujIKI[nOpom\gu | _ȅl_җNpiO>9gJO8 @K =}E/zQS[XKٯ*J @` u]1{\cLүv>\o1WV @@qYmo|c/guVL0!k@Hoo~.;6җw @@xu|gxmٵeVs @^H?۰aC>vZYr 88ꨣrfΜ++H;Nsq"@Lv6ǩSFo{?O=TN Wo+WnW:WQaذa;Rs/u֕dfY*/c- @` 8qO%^ΦMk"P @X:蠺{QCG}4LC  @1cF/~s҇[)~JqWv @}%P;uɓ|;r^Y 7U @UW]{8ꫯ @@o=Wꩧvs . }xWZnj @/-Z]P#GW4iRڵkcҥښktM0 Tsݫ}I`'>}+v @})~;Xxqi]fM7]HjU/i3j @@ YoJ7s8s+e; @(cEm@OzS@IDATquGC @!~tOF`Kkkk㪾' =^S#"@>}zpvTΩ`Q'@@zGWٽgΜN?:3RDg.ҋ4ҿvifv @}(رccOh8}ݷC?Na?OkH!l j} @?nft AYpa&- @FXn]̘1#H-w @@ |-=|iӦ @+OvGD1YgKi֬Yuʕ5QGrH~o;~?q9餓Y&s @},pgą^Xk1YzbE]Ϳ]?3?rN?~|Mo)H @`Z*ד &~s=W[L/~:4^ @%~|raÆſǐ!~!@SO=.R*W\fZ ?O?i|qgG{BbsNorfΜ~SN;,&OW{ｷܴ;vl|_Ç$z @"PommmF>$ @I`qڵks~iv%  @6n_|q1eʔ @~*,Xb޼yu]gӦMq 7D 4]veQquF @^8ScܸqqWǢEJwڰaC\;G\p6g4-~HD z W\} @@Hs=M81w @%~7f̘Q}R.}g!@4@$>C:MfH?.;ӄRkF5 @!WBFY Ϻs] @B }Kz\[Ls/86o\>4iRl OgM}.>xV ^ǔ>O:~ӟF+"=X?/ @"G>;qɓc㏗6l(M,D@DŽ @_FQ|+,?M׶ @@M ͚C7_%7tWA0?~'pBu @E:4]SN9%CNy>YlY|߈?C{ @XreϜ93w'G?8ꨣrW_}uf7n.,W( ? !`gѣG{v @>H? ԧ>܉􅟅 0θ[+]I%} @IrS0nĮk>WV @w뗽euȑ#K? KO٤}򓟌 ܫEEh: R#yFTm @}.bŊ v[---qě\ @/^gsO3&.: @@~7UR\6}%,֮]S @%K⦛njv /q?HU/)}VW' @`~ȵf͚n,=vQ&@SO=}{sikkK.$7 @%P,K/g}҅N:)9J @0P[)S:={v: @曣v}CYwԇ׿fh)m!PRޱ%@W`„ <3rEuh*݁D )tf\re'cǎOq衇 @)pw}ݗªU/mP׽u1mڴm]B= @Wƌ֭]{ɹr=}٧CYfAԡ^ @7;/yKruNBH=\vmx'",] b//^\W^iܸqr;{gMԡ  @@ ̛7/w?W?CkwhZjK@lq(K.r.\;gԩ1d\P @~'6|0 _+ @ @@3 SW2;뮻vSAmLm1r\ - ܯ @;um]#<;C͕ @%pu׾__җy{^c* @ @zO,XΙ39'NP Çݢ;?.KH [.w- 8`:̦ @"{ĤI駟tevf5;Cre @@xqUWu駟B1 @"pǹ|ߏe˖U?㏯ӎ8 @>HO%]': f׶.ϝ;XO}Y @}-±dɒm;XvvfϞ6mʵ?~|= 0N8!JxwniiiӦ @}-p]wM!-U @~ir7x< @Gwx ^_*vZ\NwT'O}٧S!@@G\33s=+uT}TnAwm D  @`u&xUظqc\{ïx+bv) @Rg.-?|** @ @}/׾6w<~_W}I5s @(җի'Cp{.o玌3&:{zHBS `7m 0lNW^=Xy> , @= p%ʕ+sWz'tRN @ @^رcs7WZ)2WIaݺuqW 2$s$  @@ }ӟƶץMdzIms,e [ 0@>z|8scr!|}-R*m9a\ @@/ 뮻{Gbg垅 @ @`lw^B>l}~*5;wnuY1kܹ֬y{bҤI: @@_ ??u݅^7tSe˖>[cܸqw#W@P  @K;>|x.իs_W_z @@_ YwXE/zQ)WO_׸bŊs_җbڴizC @PϏ Kk֬on)} _o1 @҇Uλ @ @ R%~TF;Kkr;'OO~QMXvmg?8?UHO G>"|-&oi>iN3 teIsg>SNi @z\ѳ=~$@ @Q!CD a4cW%c- @>E {}}^Wǵ^No䄆0vþt:N] /䒸k3gnsw~z|1lذms W}%> @ @HA3<3^ǷHOirG)w\imSO/?u#F A! @ @ @@_>|3gN)鉬i?ݚMa @Xre<䓥u1rR:eoROHUv]L @ @ @ @ @ @  @ @ @ @ @' ]V @ @ @ @ @0 @ @ @ @ @0vR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JiG @ @ @ @ @@ `7[ @ @ @ @ @ `+ @ @ @ @ @M/ o @ @ @ @ @+ ]v @ @ @ @ @4vӿ @ @ @ @ @ PvR @ @ @ @ @ M@ @ @ @ @ @@JyU3 j+SOYRZ"-KQJ4E\E4y5(EQBQTbߜ[3wfw;y=9U? @ @ @ @ @. @ @ @ @ @ PB#@ @ @ @ @ @ H[ @ @ @ @ @ H.TJ? @ @ @ @ @. @ @ @ @ @ PB#@ @ @ @ @ @ H[ @ @ @ @ @ H.TJ? @ @ @ @ @. @ @ @ @ @ PB#@ @ @ @ @ @ H[ @ @ @ @ @ H.TJ? @ @ @ @ @. @ @ @ @ @ P@B;G @ @83.(+"g?UsN:o;Q>~L{)hѢp'۷o8A  @ @2m @ @T^>gbŊ0k֬pEqF&@@e lC gNLpƌ%OC}}}9ƍ  H4 @ @@7 @ @ P Ǐ=X8cSٰaC:uj*.@@e L4)5X cɹ!m @ @+ V @ @ @@t=|pjEo²eRq*Wpb-\vm;4̙}#FcƌI4 @ @Y8#@ @ @@ $s=7ׇ+ЫWO:5:M*_T' @ @]X@v~N @ @@m ~avK-n-0qx /~pw$nٳg?~|"A @ @@RGE @ @#|ͦћoyS;ׇ|0aɒ%aҥw|gyرcÐ!CTB#OL%ο_ά' j'/ 0 5zpAZ{ի[oԭGaРAMŋG۷ox{p4iCk}֭[0o޼״bŊ6ۄm6} rH|p]w dƈ{0{vء aÆ0w;{=[nefG1cƄX#~-[5#W^y)\WWbvk's:bf?/ȑ#3n]opYg5r<[ﴭ*+Q[6p̋9VZOіq/~m|O @ @ H.' @ @ P_}8Ӛf;~:޸qc+hѢ>'3 ]tQw}s/wZ;&zn(o;&-^{!B4N?Bn _~y7wԨQk}UW|+=y{o7NɲOO⋙$ۘ|wDɓ'cR|[}熛o9 ni89z떺fW[K=cdD65gkf?I&x۝}M7R1GG~ߊW^xa▇z;|'Xě;b&&A @ PVne @ @BXbu̙opg6:O!&vaÆe^hu3VGqDG?ZPmss駟7:?)|G%?+&wZL}ϟIhٳ^{합t\ue*k& ><:wkG,e]Z\9gc x;D{,++7Ip?7V- lt~@S"@ @T@ @ @@)-[In.gVmo=G뮩Xv &?>+? 1K_Rx≩>08{.S |޼y9cUxD#<2,_[^z0a„f͚DF~gSN9%\nWZI>6llR^9gբ_~DP@ =u+?U-{v^ L̇ @ P+=je!A @ @ *G2 c#Sxȑa]v On,JG+a4(Rc3ᨣ ;s߿&TN,#§>Leq{g}3 ޿hѢLUo|6/~1ʼGϞ=3c=B򗿄?ϙ*ٱ&N=V/"իWyIG9qr>iҤp7&nO~.o6mZv33FJ\iT-gZZq &D @%,t @ @ @K \uU ATPI:MCʿyޓmR6T=q y|7Sq/B{WoHtMStI~{{*& I7pCL~gÛo*y̹{T v1}Pn)'BJ2S)9 @ @( +uk&@ @ @EO<1y-iP!7lfs=ϟ?!|SNI="rhԜ7%l>cN;픸-Z~e]k޽CL>*mqnG}tw=x~g䆚 CCev=#4TN]zgS^J1bDfѣ[ U9;D?q"VF͹=Z*OӡgϞÇ5k$b-5nKtb-2{6lQ߷fiJۯ @ @h_RkxF @ @\\:eʔpX {oϋ/lDǬƜ9sڵk"Oc%K2?9O+;Roy'IJܯD @ @]ӯ @ @(V Vy睋mԨQYq%{K{pꩧ6/V]jU 'VNa҅Ç.dbM6$3[*mqC 1c뭷NU 7n\w] {K.M\g}N*GqDƋ?Ynn\mfYmO4)1cF ӦMK=;YQ߷Bݑ}*mv= @ Е$`wm @ @*=%uQ[n ݻwoqX9& 4o|U#'7c5bJw^̱6ۤ V~?xγ=zt";^h^~F͹-{4{==?3I ~_2k!>W^ w_v(EJ%SJۯ@b  @ @V( @ @Q1O=3G_"lf2bŊL5N;-ܱ7lؐj-R?>jĈ-<1}O>`.]ѷoBfs;';V=ΝjW sG\ǏO;3׈ׯ_4yDr|9߶]i-kp @ @@*`n @ @]H _2ukիWƍSr b%XC K/ z*neݻ wHl]v p@<+CVZnp嗇Eb,&_>]2dHk]^ tMcg_(urtK@ׯX.#?IDAT={5oҤIXy[o SL{{niy[!s>_;rE @Jݺb @ @ ,^8O/8:&^ԩSSեb-8V?Χ[u5I9u殫c9& 0 1̌3F|'wwэ][QoCbw6,- @ @]. @ @eX /b}{;ߑV j#{I/ex޽/I5ιnm}?>\}M]|0o޼{6ٳ+ m9{Ebť3 @ @j$`W3q @ @_`ڵaرgj1cƄ &~amI] Ж -}-,,rCWQs(ˉ'&sOJ馛S'pB"VHڿomNB~mpB @i 4 @ @ @2n0wdwa%_becƍ}%(`:{*VIjsG=:l}m%!&Ϛ5+1qƅ$b4VWWZRbbb'@ @T|ofM @ @L6-5NL Cn%KRcv?VzT@oG5ιPR4iRb=|ᇛbw}wM<>䓛sRM߷޽{f͚T… [뒸n&84 @ @5+Pܿ, @ @ @k <}ѩXk~;̙3'mÆ X)>RZ2ց_2_>/$7t0rpGSN9%ĄR8RN8ЧODM3g6Ǔ#F:(+QM߷| K.-t~c=V=kQ\: @ @V@vվ:'@ @ @@breR뮻B겹wsnkW߮ŷx燫*;Tիe]VZw_kBKUsZK9щ9 x_*q-bvb j <8~:k)0k֬s{|*b @ @]{Ԋ @ @ P@vmSOb-^zpgRj^2N>S/,Y$o)p饗 :fodMRzT,;sΞK&U/\09d*0PWW&NO~0{D,_DV}d0yԊ~!ׇ;3um=b'@ @T@꛲ @ @ @@N9(<쳉!//|!!&\2 a޼yᦛn .Lܳ뮻'x" <}ii^?o=-O}S!&=:瞙?;˗/Ou{ｳիW_~9U朚pƏJq ,Xn;DF}>φ /0lذ!K.${`~3U|0,Y$ .guV"VH~-DI @ @@ Hwg @ @h@~Bu%ƋֹYN;-\|řodǪ=z矣}MPpr-dc~#ğӧ^J~_eSs;Sssrp9&Q/ 'LI4{`}y晙MKl0sp%;d&85 @ @5%ЭVc1 @ @ P>n jg͚ЫWp衇&nYlY2r"XFϿ׳gpuׅaРAߗCPxB~^ѭ[p7M6٤I;cϯI&bt8qbkvESݻ,VɎߍk{K @l ؕ~̎ @ @"O~2<3_zӧOόɜ1 3Vw}'رc&` TQn'>6.$} _ . g}v~ 3Gy$s='_7|?Oo6)jw<ꨣ[l>w;okھo{nxGG>лwfǍٟ_C]]]}`/ @ @:ꘪY @ @ @@G\2g}6xЯ_Lb!6|JQoӢKxS|ﱪ+^:O./_k/r&uС!K"n9U7 g ,K. 7n C ;C~ٯ]b @ @@ H7j= @ @ @ @ @M[F60 @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|gkd @ @ @ @ @jL@vP!@ @ @ @ @ @|IENDB`bayestestR/man/reexports.Rd0000644000176200001440000000077014413221117015474 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print_html.R, R/print_md.R \docType{import} \name{reexports} \alias{reexports} \alias{print_html} \alias{print_md} \title{Objects exported from other packages} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{insight}{\code{\link[insight:display]{print_html}}, \code{\link[insight:display]{print_md}}} }} bayestestR/man/reshape_iterations.Rd0000644000176200001440000000262214307033605017334 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reshape_iterations.R \name{reshape_iterations} \alias{reshape_iterations} \alias{reshape_draws} \title{Reshape estimations with multiple iterations (draws) to long format} \usage{ reshape_iterations(x, prefix = c("draw", "iter", "iteration", "sim")) reshape_draws(x, prefix = c("draw", "iter", "iteration", "sim")) } \arguments{ \item{x}{A data.frame containing posterior draws obtained from \code{estimate_response} or \code{estimate_link}.} \item{prefix}{The prefix of the draws (for instance, \code{"iter_"} for columns named as \verb{iter_1, iter_2, iter_3}). If more than one are provided, will search for the first one that matches.} } \value{ Data frame of reshaped draws in long format. } \description{ Reshape a wide data.frame of iterations (such as posterior draws or bootsrapped samples) as columns to long format. Instead of having all iterations as columns (e.g., \verb{iter_1, iter_2, ...}), will return 3 columns with the \verb{\\*_index} (the previous index of the row), the \verb{\\*_group} (the iteration number) and the \verb{\\*_value} (the value of said iteration). } \examples{ \donttest{ if (require("rstanarm")) { model <- stan_glm(mpg ~ am, data = mtcars, refresh = 0) draws <- insight::get_predicted(model) long_format <- reshape_iterations(draws) head(long_format) } } } bayestestR/man/unupdate.Rd0000644000176200001440000000246214276606713015306 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/unupdate.R \name{unupdate} \alias{unupdate} \alias{unupdate.stanreg} \alias{unupdate.brmsfit} \alias{unupdate.brmsfit_multiple} \alias{unupdate.blavaan} \title{Un-update Bayesian models to their prior-to-data state} \usage{ unupdate(model, verbose = TRUE, ...) \method{unupdate}{stanreg}(model, verbose = TRUE, ...) \method{unupdate}{brmsfit}(model, verbose = TRUE, ...) \method{unupdate}{brmsfit_multiple}(model, verbose = TRUE, newdata = NULL, ...) \method{unupdate}{blavaan}(model, verbose = TRUE, ...) } \arguments{ \item{model}{A fitted Bayesian model.} \item{verbose}{Toggle warnings.} \item{...}{Not used} \item{newdata}{List of \code{data.frames} to update the model with new data. Required even if the original data should be used.} } \value{ A model un-fitted to the data, representing the prior model. } \description{ As posteriors are priors that have been updated after observing some data, the goal of this function is to un-update the posteriors to obtain models representing the priors. These models can then be used to examine the prior predictive distribution, or to compare priors with posteriors. \cr\cr This function in used internally to compute Bayes factors. } \keyword{internal} bayestestR/man/diagnostic_posterior.Rd0000644000176200001440000001114514307033605017676 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/diagnostic_posterior.R \name{diagnostic_posterior} \alias{diagnostic_posterior} \alias{diagnostic_posterior.stanreg} \alias{diagnostic_posterior.brmsfit} \title{Posteriors Sampling Diagnostic} \usage{ diagnostic_posterior(posteriors, diagnostic = c("ESS", "Rhat"), ...) \method{diagnostic_posterior}{stanreg}( posteriors, diagnostic = "all", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) \method{diagnostic_posterior}{brmsfit}( posteriors, diagnostic = "all", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ... ) } \arguments{ \item{posteriors}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, or \code{blavaan} object.} \item{diagnostic}{Diagnostic metrics to compute. Character (vector) or list with one or more of these options: \code{"ESS"}, \code{"Rhat"}, \code{"MCSE"} or \code{"all"}.} \item{...}{Currently not used.} \item{effects}{Should parameters for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Which type of parameters to return, such as parameters for the conditional model, the zero-inflated part of the model, the dispersion term, the instrumental variables or marginal effects be returned? Applies to models with zero-inflated and/or dispersion formula, or to models with instrumental variables (so called fixed-effects regressions), or models with marginal effects from \pkg{mfx}. May be abbreviated. Note that the \emph{conditional} component is also called \emph{count} or \emph{mean} component, depending on the model. There are three convenient shortcuts: \code{component = "all"} returns all possible parameters. If \code{component = "location"}, location parameters such as \code{conditional}, \code{zero_inflated}, \code{smooth_terms}, or \code{instruments} are returned (everything that are fixed or random effects - depending on the \code{effects} argument - but no auxiliary parameters). For \code{component = "distributional"} (or \code{"auxiliary"}), components like \code{sigma}, \code{dispersion}, \code{beta} or \code{precision} (and other auxiliary parameters) are returned.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned.} } \description{ Extract diagnostic metrics (Effective Sample Size (\code{ESS}), \code{Rhat} and Monte Carlo Standard Error \code{MCSE}). } \details{ \strong{Effective Sample (ESS)} should be as large as possible, although for most applications, an effective sample size greater than 1000 is sufficient for stable estimates (Bürkner, 2017). The ESS corresponds to the number of independent samples with the same estimation power as the N autocorrelated samples. It is is a measure of \dQuote{how much independent information there is in autocorrelated chains} (\cite{Kruschke 2015, p182-3}). \cr \cr \strong{Rhat} should be the closest to 1. It should not be larger than 1.1 (\cite{Gelman and Rubin, 1992}) or 1.01 (\cite{Vehtari et al., 2019}). The split Rhat statistic quantifies the consistency of an ensemble of Markov chains. \cr \cr \strong{Monte Carlo Standard Error (MCSE)} is another measure of accuracy of the chains. It is defined as standard deviation of the chains divided by their effective sample size (the formula for \code{mcse()} is from Kruschke 2015, p. 187). The MCSE \dQuote{provides a quantitative suggestion of how big the estimation noise is}. } \examples{ \dontrun{ # rstanarm models # ----------------------------------------------- if (require("rstanarm", quietly = TRUE)) { model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) diagnostic_posterior(model) } # brms models # ----------------------------------------------- if (require("brms", quietly = TRUE)) { model <- brms::brm(mpg ~ wt + cyl, data = mtcars) diagnostic_posterior(model) } } } \references{ \itemize{ \item Gelman, A., & Rubin, D. B. (1992). Inference from iterative simulation using multiple sequences. Statistical science, 7(4), 457-472. \item Vehtari, A., Gelman, A., Simpson, D., Carpenter, B., and Bürkner, P. C. (2019). Rank-normalization, folding, and localization: An improved Rhat for assessing convergence of MCMC. arXiv preprint arXiv:1903.08008. \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. } } bayestestR/man/p_direction.Rd0000644000176200001440000002054614276606713015763 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/p_direction.R \name{p_direction} \alias{p_direction} \alias{pd} \alias{p_direction.numeric} \alias{p_direction.data.frame} \alias{p_direction.MCMCglmm} \alias{p_direction.emmGrid} \alias{p_direction.stanreg} \alias{p_direction.brmsfit} \alias{p_direction.BFBayesFactor} \title{Probability of Direction (pd)} \usage{ p_direction(x, ...) pd(x, ...) \method{p_direction}{numeric}(x, method = "direct", null = 0, ...) \method{p_direction}{data.frame}(x, method = "direct", null = 0, ...) \method{p_direction}{MCMCglmm}(x, method = "direct", null = 0, ...) \method{p_direction}{emmGrid}(x, method = "direct", null = 0, ...) \method{p_direction}{stanreg}( x, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, method = "direct", null = 0, ... ) \method{p_direction}{brmsfit}( x, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, method = "direct", null = 0, ... ) \method{p_direction}{BFBayesFactor}(x, method = "direct", null = 0, ...) } \arguments{ \item{x}{Vector representing a posterior distribution. Can also be a Bayesian model (\code{stanreg}, \code{brmsfit} or \code{BayesFactor}).} \item{...}{Currently not used.} \item{method}{Can be \code{"direct"} or one of methods of \link[=estimate_density]{density estimation}, such as \code{"kernel"}, \code{"logspline"} or \code{"KernSmooth"}. If \code{"direct"} (default), the computation is based on the raw ratio of samples superior and inferior to 0. Else, the result is based on the \link[=auc]{Area under the Curve (AUC)} of the estimated \link[=estimate_density]{density} function.} \item{null}{The value considered as a "null" effect. Traditionally 0, but could also be 1 in the case of ratios.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ Values between 0.5 and 1 corresponding to the probability of direction (pd). \cr\cr Note that in some (rare) cases, especially when used with model averaged posteriors (see \code{\link[=weighted_posteriors]{weighted_posteriors()}} or \code{brms::posterior_average}), \code{pd} can be smaller than \code{0.5}, reflecting high credibility of \code{0}. To detect such cases, the \code{method = "direct"} must be used. } \description{ Compute the \strong{Probability of Direction} (\emph{\strong{pd}}, also known as the Maximum Probability of Effect - \emph{MPE}). It varies between \verb{50\%} and \verb{100\%} (\emph{i.e.}, \code{0.5} and \code{1}) and can be interpreted as the probability (expressed in percentage) that a parameter (described by its posterior distribution) is strictly positive or negative (whichever is the most probable). It is mathematically defined as the proportion of the posterior distribution that is of the median's sign. Although differently expressed, this index is fairly similar (\emph{i.e.}, is strongly correlated) to the frequentist \strong{p-value}. \cr\cr Note that in some (rare) cases, especially when used with model averaged posteriors (see \code{\link[=weighted_posteriors]{weighted_posteriors()}} or \code{brms::posterior_average}), \code{pd} can be smaller than \code{0.5}, reflecting high credibility of \code{0}. } \details{ \subsection{What is the \emph{pd}?}{ The Probability of Direction (pd) is an index of effect existence, ranging from \verb{50\%} to \verb{100\%}, representing the certainty with which an effect goes in a particular direction (\emph{i.e.}, is positive or negative). Beyond its simplicity of interpretation, understanding and computation, this index also presents other interesting properties: \itemize{ \item It is independent from the model: It is solely based on the posterior distributions and does not require any additional information from the data or the model. \item It is robust to the scale of both the response variable and the predictors. \item It is strongly correlated with the frequentist p-value, and can thus be used to draw parallels and give some reference to readers non-familiar with Bayesian statistics. } } \subsection{Relationship with the p-value}{ In most cases, it seems that the \emph{pd} has a direct correspondence with the frequentist one-sided \emph{p}-value through the formula \ifelse{html}{\out{pone sided = 1 - p(d)/100}}{\eqn{p_{one sided}=1-\frac{p_{d}}{100}}} and to the two-sided p-value (the most commonly reported one) through the formula \ifelse{html}{\out{ptwo sided = 2 * (1 - p(d)/100)}}{\eqn{p_{two sided}=2*(1-\frac{p_{d}}{100})}}. Thus, a two-sided p-value of respectively \code{.1}, \code{.05}, \code{.01} and \code{.001} would correspond approximately to a \emph{pd} of \verb{95\%}, \verb{97.5\%}, \verb{99.5\%} and \verb{99.95\%}. See also \code{\link[=pd_to_p]{pd_to_p()}}. } \subsection{Methods of computation}{ The most simple and direct way to compute the \emph{pd} is to 1) look at the median's sign, 2) select the portion of the posterior of the same sign and 3) compute the percentage that this portion represents. This "simple" method is the most straightforward, but its precision is directly tied to the number of posterior draws. The second approach relies on \link[=estimate_density]{density estimation}. It starts by estimating the density function (for which many methods are available), and then computing the \link[=area_under_curve]{area under the curve} (AUC) of the density curve on the other side of 0. } \subsection{Strengths and Limitations}{ \strong{Strengths:} Straightforward computation and interpretation. Objective property of the posterior distribution. 1:1 correspondence with the frequentist p-value. \cr \cr \strong{Limitations:} Limited information favoring the null hypothesis. } } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ library(bayestestR) # Simulate a posterior distribution of mean 1 and SD 1 # ---------------------------------------------------- posterior <- rnorm(1000, mean = 1, sd = 1) p_direction(posterior) p_direction(posterior, method = "kernel") # Simulate a dataframe of posterior distributions # ----------------------------------------------- df <- data.frame(replicate(4, rnorm(100))) p_direction(df) p_direction(df, method = "kernel") \dontrun{ # rstanarm models # ----------------------------------------------- if (require("rstanarm")) { model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars, chains = 2, refresh = 0 ) p_direction(model) p_direction(model, method = "kernel") } # emmeans # ----------------------------------------------- if (require("emmeans")) { p_direction(emtrends(model, ~1, "wt")) } # brms models # ----------------------------------------------- if (require("brms")) { model <- brms::brm(mpg ~ wt + cyl, data = mtcars) p_direction(model) p_direction(model, method = "kernel") } # BayesFactor objects # ----------------------------------------------- if (require("BayesFactor")) { bf <- ttestBF(x = rnorm(100, 1, 1)) p_direction(bf) p_direction(bf, method = "kernel") } } } \references{ Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} } \seealso{ \code{\link[=pd_to_p]{pd_to_p()}} to convert between Probability of Direction (pd) and p-value. } bayestestR/man/simulate_correlation.Rd0000644000176200001440000000440414307033605017670 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/simulate_data.R \name{simulate_correlation} \alias{simulate_correlation} \alias{simulate_ttest} \alias{simulate_difference} \title{Data Simulation} \usage{ simulate_correlation(n = 100, r = 0.5, mean = 0, sd = 1, names = NULL, ...) simulate_ttest(n = 100, d = 0.5, names = NULL, ...) simulate_difference(n = 100, d = 0.5, names = NULL, ...) } \arguments{ \item{n}{The number of observations to be generated.} \item{r}{A value or vector corresponding to the desired correlation coefficients.} \item{mean}{A value or vector corresponding to the mean of the variables.} \item{sd}{A value or vector corresponding to the SD of the variables.} \item{names}{A character vector of desired variable names.} \item{...}{Arguments passed to or from other methods.} \item{d}{A value or vector corresponding to the desired difference between the groups.} } \description{ Simulate data with specific characteristics. } \examples{ # Correlation -------------------------------- data <- simulate_correlation(r = 0.5) plot(data$V1, data$V2) cor.test(data$V1, data$V2) summary(lm(V2 ~ V1, data = data)) # Specify mean and SD data <- simulate_correlation(r = 0.5, n = 50, mean = c(0, 1), sd = c(0.7, 1.7)) cor.test(data$V1, data$V2) round(c(mean(data$V1), sd(data$V1)), 1) round(c(mean(data$V2), sd(data$V2)), 1) summary(lm(V2 ~ V1, data = data)) # Generate multiple variables cor_matrix <- matrix( c( 1.0, 0.2, 0.4, 0.2, 1.0, 0.3, 0.4, 0.3, 1.0 ), nrow = 3 ) data <- simulate_correlation(r = cor_matrix, names = c("y", "x1", "x2")) cor(data) summary(lm(y ~ x1, data = data)) # t-test -------------------------------- data <- simulate_ttest(n = 30, d = 0.3) plot(data$V1, data$V0) round(c(mean(data$V1), sd(data$V1)), 1) diff(t.test(data$V1 ~ data$V0)$estimate) summary(lm(V1 ~ V0, data = data)) summary(glm(V0 ~ V1, data = data, family = "binomial")) # Difference -------------------------------- data <- simulate_difference(n = 30, d = 0.3) plot(data$V1, data$V0) round(c(mean(data$V1), sd(data$V1)), 1) diff(t.test(data$V1 ~ data$V0)$estimate) summary(lm(V1 ~ V0, data = data)) summary(glm(V0 ~ V1, data = data, family = "binomial")) } bayestestR/man/disgust.Rd0000644000176200001440000000173014357655465015150 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/datasets.R \docType{data} \name{disgust} \alias{disgust} \title{Moral Disgust Judgment} \format{ A data frame with 500 rows and 5 variables: \describe{ \item{score}{Score on the questionnaire, which ranges from 0 to 50 with higher scores representing harsher moral judgment} \item{condition}{one of three conditions, differing by the odor present in the room: a pleasant scent associated with cleanliness (lemon), a disgusting scent (sulfur), and a control condition in which no unusual odor is present} } \if{html}{\out{

}}\preformatted{data("disgust") head(disgust, n = 5) #> score condition #> 1 13 control #> 2 26 control #> 3 30 control #> 4 23 control #> 5 34 control }\if{html}{\out{
}} } \description{ A sample (simulated) dataset, used in tests and some examples. } \author{ Richard D. Morey } \keyword{data} bayestestR/man/dot-extract_priors_rstanarm.Rd0000644000176200001440000000057014276606713021222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sensitivity_to_prior.R \name{.extract_priors_rstanarm} \alias{.extract_priors_rstanarm} \title{Extract and Returns the priors formatted for rstanarm} \usage{ .extract_priors_rstanarm(model, ...) } \description{ Extract and Returns the priors formatted for rstanarm } \keyword{internal} bayestestR/man/p_rope.Rd0000644000176200001440000000475214276606713014751 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/p_rope.R \name{p_rope} \alias{p_rope} \alias{p_rope.numeric} \alias{p_rope.stanreg} \alias{p_rope.brmsfit} \title{Probability of being in the ROPE} \usage{ p_rope(x, ...) \method{p_rope}{numeric}(x, range = "default", ...) \method{p_rope}{stanreg}( x, range = "default", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) \method{p_rope}{brmsfit}( x, range = "default", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution. Can also be a \code{stanreg} or \code{brmsfit} model.} \item{...}{Currently not used.} \item{range}{ROPE's lower and higher bounds. Should be \code{"default"} or depending on the number of outcome variables a vector or a list. In models with one response, \code{range} should be a vector of length two (e.g., \code{c(-0.1, 0.1)}). In multivariate models, \code{range} should be a list with a numeric vectors for each response variable. Vector names should correspond to the name of the response variables. If \code{"default"} and input is a vector, the range is set to \code{c(-0.1, 0.1)}. If \code{"default"} and input is a Bayesian model, \code{\link[=rope_range]{rope_range()}} is used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ Compute the proportion of the whole posterior distribution that doesn't lie within a region of practical equivalence (ROPE). It is equivalent to running \code{rope(..., ci = 1)}. } \examples{ library(bayestestR) p_rope(x = rnorm(1000, 0, 0.01), range = c(-0.1, 0.1)) p_rope(x = mtcars, range = c(-0.1, 0.1)) } bayestestR/man/bayesfactor_inclusion.Rd0000644000176200001440000000755114407021360020033 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bayesfactor_inclusion.R \name{bayesfactor_inclusion} \alias{bayesfactor_inclusion} \alias{bf_inclusion} \title{Inclusion Bayes Factors for testing predictors across Bayesian models} \usage{ bayesfactor_inclusion(models, match_models = FALSE, prior_odds = NULL, ...) bf_inclusion(models, match_models = FALSE, prior_odds = NULL, ...) } \arguments{ \item{models}{An object of class \code{\link[=bayesfactor_models]{bayesfactor_models()}} or \code{BFBayesFactor}.} \item{match_models}{See details.} \item{prior_odds}{Optional vector of prior odds for the models. See \verb{BayesFactor::priorOdds<-}.} \item{...}{Arguments passed to or from other methods.} } \value{ a data frame containing the prior and posterior probabilities, and log(BF) for each effect (Use \code{as.numeric()} to extract the non-log Bayes factors; see examples). } \description{ The \verb{bf_*} function is an alias of the main function. \cr \cr For more info, see \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}. } \details{ Inclusion Bayes factors answer the question: Are the observed data more probable under models with a particular effect, than they are under models without that particular effect? In other words, on average - are models with effect \eqn{X} more likely to have produced the observed data than models without effect \eqn{X}? \subsection{Match Models}{ If \code{match_models=FALSE} (default), Inclusion BFs are computed by comparing all models with a term against all models without that term. If \code{TRUE}, comparison is restricted to models that (1) do not include any interactions with the term of interest; (2) for interaction terms, averaging is done only across models that containe the main effect terms from which the interaction term is comprised. } } \note{ Random effects in the \code{lmer} style are converted to interaction terms: i.e., \code{(X|G)} will become the terms \code{1:G} and \code{X:G}. } \section{Interpreting Bayes Factors}{ A Bayes factor greater than 1 can be interpreted as evidence against the null, at which one convention is that a Bayes factor greater than 3 can be considered as "substantial" evidence against the null (and vice versa, a Bayes factor smaller than 1/3 indicates substantial evidence in favor of the null-model) (\cite{Wetzels et al. 2011}). } \examples{ library(bayestestR) # Using bayesfactor_models: # ------------------------------ mo0 <- lm(Sepal.Length ~ 1, data = iris) mo1 <- lm(Sepal.Length ~ Species, data = iris) mo2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) mo3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) BFmodels <- bayesfactor_models(mo1, mo2, mo3, denominator = mo0) (bf_inc <- bayesfactor_inclusion(BFmodels)) as.numeric(bf_inc) \dontrun{ # BayesFactor # ------------------------------- library(BayesFactor) BF <- generalTestBF(len ~ supp * dose, ToothGrowth, progress = FALSE) bayesfactor_inclusion(BF) # compare only matched models: bayesfactor_inclusion(BF, match_models = TRUE) } } \references{ \itemize{ \item Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25). A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64} \item Clyde, M. A., Ghosh, J., & Littman, M. L. (2011). Bayesian adaptive sampling for variable selection and model averaging. Journal of Computational and Graphical Statistics, 20(1), 80-101. \item Mathot, S. (2017). Bayes like a Baws: Interpreting Bayesian Repeated Measures in JASP. \href{https://www.cogsci.nl/blog/interpreting-bayesian-repeated-measures-in-jasp}{Blog post}. } } \seealso{ \code{\link[=weighted_posteriors]{weighted_posteriors()}} for Bayesian parameter averaging. } \author{ Mattan S. Ben-Shachar } bayestestR/man/describe_prior.Rd0000644000176200001440000000353514276606713016456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/describe_prior.R \name{describe_prior} \alias{describe_prior} \alias{describe_prior.brmsfit} \title{Describe Priors} \usage{ describe_prior(model, ...) \method{describe_prior}{brmsfit}( model, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all", "location", "distributional", "auxiliary"), parameters = NULL, ... ) } \arguments{ \item{model}{A Bayesian model.} \item{...}{Currently not used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ Returns a summary of the priors used in the model. } \examples{ \dontrun{ library(bayestestR) # rstanarm models # ----------------------------------------------- if (require("rstanarm")) { model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) describe_prior(model) } # brms models # ----------------------------------------------- if (require("brms")) { model <- brms::brm(mpg ~ wt + cyl, data = mtcars) describe_prior(model) } # BayesFactor objects # ----------------------------------------------- if (require("BayesFactor")) { bf <- ttestBF(x = rnorm(100, 1, 1)) describe_prior(bf) } } } bayestestR/man/rope_range.Rd0000644000176200001440000000562414307033605015572 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rope_range.R \name{rope_range} \alias{rope_range} \alias{rope_range.default} \title{Find Default Equivalence (ROPE) Region Bounds} \usage{ rope_range(x, ...) \method{rope_range}{default}(x, verbose = TRUE, ...) } \arguments{ \item{x}{A \code{stanreg}, \code{brmsfit} or \code{BFBayesFactor} object.} \item{...}{Currently not used.} \item{verbose}{Toggle warnings.} } \description{ This function attempts at automatically finding suitable "default" values for the Region Of Practical Equivalence (ROPE). } \details{ \cite{Kruschke (2018)} suggests that the region of practical equivalence could be set, by default, to a range from \code{-0.1} to \code{0.1} of a standardized parameter (negligible effect size according to Cohen, 1988). \itemize{ \item For \strong{linear models (lm)}, this can be generalised to \ifelse{html}{\out{-0.1 * SDy, 0.1 * SDy}}{\eqn{[-0.1*SD_{y}, 0.1*SD_{y}]}}. \if{html}{\out{
}}\preformatted{\\item For **logistic models**, the parameters expressed in log odds ratio can be converted to standardized difference through the formula \ifelse{html}{\out{π/√(3)}}{\eqn{\pi/\sqrt{3}}}, resulting in a range of `-0.18` to `0.18`. \\item For other models with **binary outcome**, it is strongly recommended to manually specify the rope argument. Currently, the same default is applied that for logistic models. \\item For models from **count data**, the residual variance is used. This is a rather experimental threshold and is probably often similar to `-0.1, 0.1`, but should be used with care! \\item For **t-tests**, the standard deviation of the response is used, similarly to linear models (see above). \\item For **correlations**, `-0.05, 0.05` is used, i.e., half the value of a negligible correlation as suggested by Cohen's (1988) rules of thumb. \\item For all other models, `-0.1, 0.1` is used to determine the ROPE limits, but it is strongly advised to specify it manually. }\if{html}{\out{
}} } } \examples{ \dontrun{ if (require("rstanarm")) { model <- stan_glm( mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0 ) rope_range(model) model <- stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0) rope_range(model) } if (require("brms")) { model <- brm(mpg ~ wt + cyl, data = mtcars) rope_range(model) } if (require("BayesFactor")) { model <- ttestBF(mtcars[mtcars$vs == 1, "mpg"], mtcars[mtcars$vs == 0, "mpg"]) rope_range(model) model <- lmBF(mpg ~ vs, data = mtcars) rope_range(model) } } } \references{ Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. } bayestestR/man/rope.Rd0000644000176200001440000001771014407021361014412 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rope.R \name{rope} \alias{rope} \alias{rope.numeric} \alias{rope.stanreg} \alias{rope.brmsfit} \title{Region of Practical Equivalence (ROPE)} \usage{ rope(x, ...) \method{rope}{numeric}(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) \method{rope}{stanreg}( x, range = "default", ci = 0.95, ci_method = "ETI", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ... ) \method{rope}{brmsfit}( x, range = "default", ci = 0.95, ci_method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ... ) } \arguments{ \item{x}{Vector representing a posterior distribution. Can also be a \code{stanreg} or \code{brmsfit} model.} \item{...}{Currently not used.} \item{range}{ROPE's lower and higher bounds. Should be \code{"default"} or depending on the number of outcome variables a vector or a list. In models with one response, \code{range} should be a vector of length two (e.g., \code{c(-0.1, 0.1)}). In multivariate models, \code{range} should be a list with a numeric vectors for each response variable. Vector names should correspond to the name of the response variables. If \code{"default"} and input is a vector, the range is set to \code{c(-0.1, 0.1)}. If \code{"default"} and input is a Bayesian model, \code{\link[=rope_range]{rope_range()}} is used.} \item{ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.} \item{ci_method}{The type of interval to use to quantify the percentage in ROPE. Can be 'HDI' (default) or 'ETI'. See \code{\link[=ci]{ci()}}.} \item{verbose}{Toggle off warnings.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ Compute the proportion of the HDI (default to the \verb{89\%} HDI) of a posterior distribution that lies within a region of practical equivalence. } \details{ \subsection{ROPE}{ Statistically, the probability of a posterior distribution of being different from 0 does not make much sense (the probability of a single value null hypothesis in a continuous distribution is 0). Therefore, the idea underlining ROPE is to let the user define an area around the null value enclosing values that are \emph{equivalent to the null} value for practical purposes (\cite{Kruschke 2010, 2011, 2014}). \cr \cr Kruschke (2018) suggests that such null value could be set, by default, to the -0.1 to 0.1 range of a standardized parameter (negligible effect size according to Cohen, 1988). This could be generalized: For instance, for linear models, the ROPE could be set as \verb{0 +/- .1 * sd(y)}. This ROPE range can be automatically computed for models using the \link{rope_range} function. \cr \cr Kruschke (2010, 2011, 2014) suggests using the proportion of the \verb{95\%} (or \verb{89\%}, considered more stable) \link[=hdi]{HDI} that falls within the ROPE as an index for "null-hypothesis" testing (as understood under the Bayesian framework, see \code{\link[=equivalence_test]{equivalence_test()}}). } \subsection{Sensitivity to parameter's scale}{ It is important to consider the unit (i.e., the scale) of the predictors when using an index based on the ROPE, as the correct interpretation of the ROPE as representing a region of practical equivalence to zero is dependent on the scale of the predictors. Indeed, the percentage in ROPE depend on the unit of its parameter. In other words, as the ROPE represents a fixed portion of the response's scale, its proximity with a coefficient depends on the scale of the coefficient itself. } \subsection{Multicollinearity: Non-independent covariates}{ When parameters show strong correlations, i.e. when covariates are not independent, the joint parameter distributions may shift towards or away from the ROPE. Collinearity invalidates ROPE and hypothesis testing based on univariate marginals, as the probabilities are conditional on independence. Most problematic are parameters that only have partial overlap with the ROPE region. In case of collinearity, the (joint) distributions of these parameters may either get an increased or decreased ROPE, which means that inferences based on \code{rope()} are inappropriate (\cite{Kruschke 2014, 340f}). \cr \cr \code{rope()} performs a simple check for pairwise correlations between parameters, but as there can be collinearity between more than two variables, a first step to check the assumptions of this hypothesis testing is to look at different pair plots. An even more sophisticated check is the projection predictive variable selection (\cite{Piironen and Vehtari 2017}). } \subsection{Strengths and Limitations}{ \strong{Strengths:} Provides information related to the practical relevance of the effects. \cr \cr \strong{Limitations:} A ROPE range needs to be arbitrarily defined. Sensitive to the scale (the unit) of the predictors. Not sensitive to highly significant effects. } } \note{ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. } \examples{ library(bayestestR) rope(x = rnorm(1000, 0, 0.01), range = c(-0.1, 0.1)) rope(x = rnorm(1000, 0, 1), range = c(-0.1, 0.1)) rope(x = rnorm(1000, 1, 0.01), range = c(-0.1, 0.1)) rope(x = rnorm(1000, 1, 1), ci = c(.90, .95)) \dontrun{ library(rstanarm) model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) rope(model) rope(model, ci = c(.90, .95)) library(emmeans) rope(emtrends(model, ~1, "wt"), ci = c(.90, .95)) library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) rope(model) rope(model, ci = c(.90, .95)) library(brms) model <- brms::brm(brms::mvbind(mpg, disp) ~ wt + cyl, data = mtcars) rope(model) rope(model, ci = c(.90, .95)) library(BayesFactor) bf <- ttestBF(x = rnorm(100, 1, 1)) rope(bf) rope(bf, ci = c(.90, .95)) } } \references{ \itemize{ \item Cohen, J. (1988). Statistical power analysis for the behavioural sciences. \item Kruschke, J. K. (2010). What to believe: Bayesian methods for data analysis. Trends in cognitive sciences, 14(7), 293-300. \doi{10.1016/j.tics.2010.05.001}. \item Kruschke, J. K. (2011). Bayesian assessment of null values via parameter estimation and model comparison. Perspectives on Psychological Science, 6(3), 299-312. \doi{10.1177/1745691611406925}. \item Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. \doi{10.1177/2515245918771304}. \item Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. \item Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} \item Piironen, J., & Vehtari, A. (2017). Comparison of Bayesian predictive methods for model selection. Statistics and Computing, 27(3), 711–735. \doi{10.1007/s11222-016-9649-y} } } bayestestR/man/density_at.Rd0000644000176200001440000000170614307033605015611 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/estimate_density.R \name{density_at} \alias{density_at} \title{Density Probability at a Given Value} \usage{ density_at(posterior, x, precision = 2^10, method = "kernel", ...) } \arguments{ \item{posterior}{Vector representing a posterior distribution.} \item{x}{The value of which to get the approximate probability.} \item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.} \item{method}{Density estimation method. Can be \code{"kernel"} (default), \code{"logspline"} or \code{"KernSmooth"}.} \item{...}{Currently not used.} } \description{ Compute the density value at a given point of a distribution (i.e., the value of the \code{y} axis of a value \code{x} of a distribution). } \examples{ library(bayestestR) posterior <- distribution_normal(n = 10) density_at(posterior, 0) density_at(posterior, c(0, 1)) } bayestestR/man/simulate_prior.Rd0000644000176200001440000000154714276606713016522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/simulate_priors.R \name{simulate_prior} \alias{simulate_prior} \title{Returns Priors of a Model as Empirical Distributions} \usage{ simulate_prior(model, n = 1000, ...) } \arguments{ \item{model}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, \code{blavaan}, or \code{MCMCglmm} object.} \item{n}{Size of the simulated prior distributions.} \item{...}{Currently not used.} } \description{ Transforms priors information to actual distributions. } \examples{ \dontrun{ library(bayestestR) if (require("rstanarm")) { model <- stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) simulate_prior(model) } } } \seealso{ \code{\link[=unupdate]{unupdate()}} for directly sampling from the prior distribution (useful for complex priors and designs). } bayestestR/man/bic_to_bf.Rd0000644000176200001440000000232014276606713015360 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bic_to_bf.R \name{bic_to_bf} \alias{bic_to_bf} \title{Convert BIC indices to Bayes Factors via the BIC-approximation method.} \usage{ bic_to_bf(bic, denominator, log = FALSE) } \arguments{ \item{bic}{A vector of BIC values.} \item{denominator}{The BIC value to use as a denominator (to test against).} \item{log}{If \code{TRUE}, return the \code{log(BF)}.} } \value{ The Bayes Factors corresponding to the BIC values against the denominator. } \description{ The difference between two Bayesian information criterion (BIC) indices of two models can be used to approximate Bayes factors via: \cr \deqn{BF_{10} = e^{(BIC_0 - BIC_1)/2}}{BF10 = exp((BIC0-BIC1)/2)} } \examples{ bic1 <- BIC(lm(Sepal.Length ~ 1, data = iris)) bic2 <- BIC(lm(Sepal.Length ~ Species, data = iris)) bic3 <- BIC(lm(Sepal.Length ~ Species + Petal.Length, data = iris)) bic4 <- BIC(lm(Sepal.Length ~ Species * Petal.Length, data = iris)) bic_to_bf(c(bic1, bic2, bic3, bic4), denominator = bic1) } \references{ Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values. Psychonomic bulletin & review, 14(5), 779-804 } bayestestR/man/map_estimate.Rd0000644000176200001440000000707114276606713016132 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map_estimate.R \name{map_estimate} \alias{map_estimate} \alias{map_estimate.numeric} \alias{map_estimate.stanreg} \alias{map_estimate.brmsfit} \alias{map_estimate.data.frame} \title{Maximum A Posteriori probability estimate (MAP)} \usage{ map_estimate(x, precision = 2^10, method = "kernel", ...) \method{map_estimate}{numeric}(x, precision = 2^10, method = "kernel", ...) \method{map_estimate}{stanreg}( x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) \method{map_estimate}{brmsfit}( x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ... ) \method{map_estimate}{data.frame}(x, precision = 2^10, method = "kernel", ...) } \arguments{ \item{x}{Vector representing a posterior distribution, or a data frame of such vectors. Can also be a Bayesian model. \strong{bayestestR} supports a wide range of models (see, for example, \code{methods("hdi")}) and not all of those are documented in the 'Usage' section, because methods for other classes mostly resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.} \item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.} \item{method}{Density estimation method. Can be \code{"kernel"} (default), \code{"logspline"} or \code{"KernSmooth"}.} \item{...}{Currently not used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \value{ A numeric value if \code{x} is a vector. If \code{x} is a model-object, returns a data frame with following columns: \itemize{ \item \code{Parameter} The model parameter(s), if \code{x} is a model-object. If \code{x} is a vector, this column is missing. \item \code{MAP_Estimate} The MAP estimate for the posterior or each model parameter. } } \description{ Find the \strong{Highest Maximum A Posteriori probability estimate (MAP)} of a posterior, i.e., the value associated with the highest probability density (the "peak" of the posterior distribution). In other words, it is an estimation of the \emph{mode} for continuous parameters. Note that this function relies on \link{estimate_density}, which by default uses a different smoothing bandwidth (\code{"SJ"}) compared to the legacy default implemented the base R \link{density} function (\code{"nrd0"}). } \examples{ \dontrun{ library(bayestestR) posterior <- rnorm(10000) map_estimate(posterior) plot(density(posterior)) abline(v = map_estimate(posterior), col = "red") library(rstanarm) model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) map_estimate(model) library(brms) model <- brms::brm(mpg ~ wt + cyl, data = mtcars) map_estimate(model) } } bayestestR/man/check_prior.Rd0000644000176200001440000000417114407021360015731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/check_prior.R \name{check_prior} \alias{check_prior} \title{Check if Prior is Informative} \usage{ check_prior(model, method = "gelman", simulate_priors = TRUE, ...) } \arguments{ \item{model}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, \code{blavaan}, or \code{MCMCglmm} object.} \item{method}{Can be \code{"gelman"} or \code{"lakeland"}. For the \code{"gelman"} method, if the SD of the posterior is more than 0.1 times the SD of the prior, then the prior is considered as informative. For the \code{"lakeland"} method, the prior is considered as informative if the posterior falls within the \verb{95\%} HDI of the prior.} \item{simulate_priors}{Should prior distributions be simulated using \code{\link[=simulate_prior]{simulate_prior()}} (default; faster) or sampled via \code{\link[=unupdate]{unupdate()}} (slower, more accurate).} \item{...}{Currently not used.} } \value{ A data frame with two columns: The parameter names and the quality of the prior (which might be \code{"informative"}, \code{"uninformative"}) or \code{"not determinable"} if the prior distribution could not be determined). } \description{ Performs a simple test to check whether the prior is informative to the posterior. This idea, and the accompanying heuristics, were discussed in \href{https://statmodeling.stat.columbia.edu/2019/08/10/}{this blogpost}. } \examples{ \dontrun{ library(bayestestR) if (require("rstanarm")) { model <- stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) check_prior(model, method = "gelman") check_prior(model, method = "lakeland") # An extreme example where both methods diverge: model <- stan_glm(mpg ~ wt, data = mtcars[1:3, ], prior = normal(-3.3, 1, FALSE), prior_intercept = normal(0, 1000, FALSE), refresh = 0 ) check_prior(model, method = "gelman") check_prior(model, method = "lakeland") # can provide visual confirmation to the Lakeland method plot(si(model, verbose = FALSE)) } } } \references{ https://statmodeling.stat.columbia.edu/2019/08/10/ } bayestestR/man/as.numeric.p_direction.Rd0000644000176200001440000000125114276606712020015 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map_estimate.R, R/p_direction.R, R/p_map.R, % R/p_significance.R \name{as.numeric.map_estimate} \alias{as.numeric.map_estimate} \alias{as.numeric.p_direction} \alias{as.numeric.p_map} \alias{as.numeric.p_significance} \title{Convert to Numeric} \usage{ \method{as.numeric}{map_estimate}(x, ...) \method{as.numeric}{p_direction}(x, ...) \method{as.numeric}{p_map}(x, ...) \method{as.numeric}{p_significance}(x, ...) } \arguments{ \item{x}{object to be coerced or tested.} \item{...}{further arguments passed to or from other methods.} } \description{ Convert to Numeric } bayestestR/man/mcse.Rd0000644000176200001440000000366514276606713014416 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mcse.R \name{mcse} \alias{mcse} \alias{mcse.stanreg} \title{Monte-Carlo Standard Error (MCSE)} \usage{ mcse(model, ...) \method{mcse}{stanreg}( model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ... ) } \arguments{ \item{model}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, \code{blavaan}, or \code{MCMCglmm} object.} \item{...}{Currently not used.} \item{effects}{Should results for fixed effects, random effects or both be returned? Only applies to mixed models. May be abbreviated.} \item{component}{Should results for all parameters, parameters for the conditional model or the zero-inflated part of the model be returned? May be abbreviated. Only applies to \pkg{brms}-models.} \item{parameters}{Regular expression pattern that describes the parameters that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are filtered by default, so only parameters that typically appear in the \code{summary()} are returned. Use \code{parameters} to select specific parameters for the output.} } \description{ This function returns the Monte Carlo Standard Error (MCSE). } \details{ \strong{Monte Carlo Standard Error (MCSE)} is another measure of accuracy of the chains. It is defined as standard deviation of the chains divided by their effective sample size (the formula for \code{mcse()} is from Kruschke 2015, p. 187). The MCSE \dQuote{provides a quantitative suggestion of how big the estimation noise is}. } \examples{ \dontrun{ library(bayestestR) library(rstanarm) model <- stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) mcse(model) } } \references{ Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. } bayestestR/man/sensitivity_to_prior.Rd0000644000176200001440000000327414407021361017754 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sensitivity_to_prior.R \name{sensitivity_to_prior} \alias{sensitivity_to_prior} \title{Sensitivity to Prior} \usage{ sensitivity_to_prior(model, index = "Median", magnitude = 10, ...) } \arguments{ \item{model}{A Bayesian model (\code{stanreg} or \code{brmsfit}).} \item{index}{The indices from which to compute the sensitivity. Can be one or multiple names of the columns returned by \code{describe_posterior}. The case is important here (e.g., write 'Median' instead of 'median').} \item{magnitude}{This represent the magnitude by which to shift the antagonistic prior (to test the sensitivity). For instance, a magnitude of 10 (default) means that the mode wil be updated with a prior located at 10 standard deviations from its original location.} \item{...}{Arguments passed to or from other methods.} } \description{ Computes the sensitivity to priors specification. This represents the proportion of change in some indices when the model is fitted with an antagonistic prior (a prior of same shape located on the opposite of the effect). } \examples{ \dontrun{ library(bayestestR) # rstanarm models # ----------------------------------------------- if (require("rstanarm")) { model <- rstanarm::stan_glm(mpg ~ wt, data = mtcars) sensitivity_to_prior(model) model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) sensitivity_to_prior(model, index = c("Median", "MAP")) } # brms models # ----------------------------------------------- if (require("brms")) { model <- brms::brm(mpg ~ wt + cyl, data = mtcars) # sensitivity_to_prior(model) } } } \seealso{ DescTools } bayestestR/DESCRIPTION0000644000176200001440000001114214414032242014100 0ustar liggesusersType: Package Package: bayestestR Title: Understand and Describe Bayesian Models and Posterior Distributions Version: 0.13.1 Authors@R: c(person(given = "Dominique", family = "Makowski", role = c("aut", "cre"), email = "dom.makowski@gmail.com", comment = c(ORCID = "0000-0001-5375-9967", Twitter = "@Dom_Makowski")), person(given = "Daniel", family = "Lüdecke", role = "aut", email = "d.luedecke@uke.de", comment = c(ORCID = "0000-0002-8895-3206", Twitter = "@strengejacke")), person(given = "Mattan S.", family = "Ben-Shachar", role = "aut", email = "matanshm@post.bgu.ac.il", comment = c(ORCID = "0000-0002-4287-4801", Twitter = "@mattansb")), person(given = "Indrajeet", family = "Patil", role = "aut", email = "patilindrajeet.science@gmail.com", comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")), person(given = "Michael D.", family = "Wilson", role = "aut", email = "michael.d.wilson@curtin.edu.au", comment = c(ORCID = "0000-0003-4143-7308")), person(given = "Brenton M.", family = "Wiernik", role = "aut", email = "brenton@wiernik.org", comment = c(ORCID = "0000-0001-9560-6336", Twitter = "@bmwiernik")), person(given = "Paul-Christian", family = "Bürkner", role = "rev", email = "paul.buerkner@gmail.com"), person(given = "Tristan", family = "Mahr", role = "rev", email = "tristan.mahr@wisc.edu", comment = c(ORCID = "0000-0002-8890-5116")), person(given = "Henrik", family = "Singmann", role = "ctb", email = "singmann@gmail.com", comment = c(ORCID = "0000-0002-4842-3657")), person(given = "Quentin F.", family = "Gronau", role = "ctb", comment = c(ORCID = "0000-0001-5510-6943")), person(given = "Sam", family = "Crawley", role = "ctb", email = "sam@crawley.nz", comment = c(ORCID = "0000-0002-7847-0411"))) Maintainer: Dominique Makowski Description: Provides utilities to describe posterior distributions and Bayesian models. It includes point-estimates such as Maximum A Posteriori (MAP), measures of dispersion (Highest Density Interval - HDI; Kruschke, 2015 ) and indices used for null-hypothesis testing (such as ROPE percentage, pd and Bayes factors). References: Makowski et al. (2021) . Depends: R (>= 3.6) Imports: insight (>= 0.19.1), datawizard (>= 0.7.0), graphics, methods, stats, utils Suggests: BayesFactor (>= 0.9.12-4.4), bayesQR, bayesplot, BH, blavaan, bridgesampling, brms, curl, effectsize, emmeans, gamm4, ggdist, ggplot2, glmmTMB, httr, KernSmooth, knitr, lavaan, lme4, logspline, MASS, mclust, mediation, modelbased, parameters, patchwork, performance, quadprog, posterior, RcppEigen, rmarkdown, rstan, rstanarm, see (>= 0.7.5), testthat, tweedie License: GPL-3 URL: https://easystats.github.io/bayestestR/ BugReports: https://github.com/easystats/bayestestR/issues VignetteBuilder: knitr Encoding: UTF-8 Language: en-US RoxygenNote: 7.2.3.9000 Config/testthat/edition: 3 Config/testthat/parallel: true Config/rcmdcheck/ignore-inconsequential-notes: true Config/Needs/website: rstudio/bslib, r-lib/pkgdown, easystats/easystatstemplate NeedsCompilation: no Packaged: 2023-04-06 11:19:35 UTC; domma Author: Dominique Makowski [aut, cre] (, @Dom_Makowski), Daniel Lüdecke [aut] (, @strengejacke), Mattan S. Ben-Shachar [aut] (, @mattansb), Indrajeet Patil [aut] (, @patilindrajeets), Michael D. Wilson [aut] (), Brenton M. Wiernik [aut] (, @bmwiernik), Paul-Christian Bürkner [rev], Tristan Mahr [rev] (), Henrik Singmann [ctb] (), Quentin F. Gronau [ctb] (), Sam Crawley [ctb] () Repository: CRAN Date/Publication: 2023-04-07 15:20:02 UTC bayestestR/build/0000755000176200001440000000000014413525306013501 5ustar liggesusersbayestestR/build/vignette.rds0000644000176200001440000000033014413525306016034 0ustar liggesusersb```b`a@&0`b fd`aҒeEeiey%%zA)h E ` Ia7-$7M8{n+(Xs1lewI-HK î?"5lP5,n90{C2K7(1 棸(\^P4@btr$$ ^bayestestR/build/partial.rdb0000644000176200001440000000007314413525273015631 0ustar liggesusersb```b`a 0X84k^bnj1!d7bayestestR/tests/0000755000176200001440000000000014410351152013535 5ustar liggesusersbayestestR/tests/testthat/0000755000176200001440000000000014414032242015375 5ustar liggesusersbayestestR/tests/testthat/test-bayesfactor_parameters.R0000644000176200001440000001004414410351152023221 0ustar liggesuserstest_that("bayesfactor_parameters data frame", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BayesFactor") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("brms") Xprior <- data.frame( x = distribution_normal(1e4), y = distribution_normal(1e4) ) Xposterior <- data.frame( x = distribution_normal(1e4, mean = 0.5), y = distribution_normal(1e4, mean = -0.5) ) # point bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = 0, verbose = FALSE) expect_equal(bfsd$log_BF, c(0.12, 0.12), tolerance = 0.1) bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = 1, verbose = FALSE) expect_equal(bfsd$log_BF, c(0.44, -0.35), tolerance = 0.1) bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = -1, verbose = FALSE) expect_equal(bfsd$log_BF, c(-0.35, 0.44), tolerance = 0.1) bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0.5, direction = 0, verbose = FALSE) expect_equal(bfsd$log_BF, c(-0.12, 0.37), tolerance = 0.1) expect_warning(bayesfactor_parameters(Xposterior, Xprior)) w <- capture_warnings(bfsd <- bayesfactor_parameters(Xposterior)) expect_match(w, "Prior", all = FALSE) expect_match(w, "40", all = FALSE) expect_equal(bfsd$log_BF, c(0, 0), tolerance = 0.1) # interval expect_warning( bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = 0), regexp = NA ) expect_equal(bfsd$log_BF, c(0.13, 0.13), tolerance = 0.1) bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = 1) expect_equal(bfsd$log_BF, c(0.47, -0.39), tolerance = 0.1) bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = -1) expect_equal(bfsd$log_BF, c(-0.39, 0.47), tolerance = 0.1) # interval with inf bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, Inf)) expect_equal(bfsd$log_BF, c(-0.81, 0.80), tolerance = 0.1) bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-Inf, .1)) expect_equal(bfsd$log_BF, c(0.80, -0.81), tolerance = 0.1) }) test_that("bayesfactor_parameters RSTANARM", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BayesFactor") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("brms") fit <- suppressMessages(stan_glm(mpg ~ ., data = mtcars, refresh = 0)) set.seed(333) fit_p <- unupdate(fit, verbose = FALSE) expect_warning(BF2 <- bayesfactor_parameters(fit, fit_p)) set.seed(333) BF1 <- bayesfactor_parameters(fit, verbose = FALSE) expect_equal(BF1, BF2) model_flat <- suppressMessages( stan_glm(extra ~ group, data = sleep, prior = NULL, refresh = 0) ) suppressMessages( expect_error(bayesfactor_parameters(model_flat)) ) skip_on_ci() fit10 <- update(fit, chains = 10, iter = 5100, warmup = 100) suppressMessages( expect_warning(bayesfactor_parameters(fit10), regexp = NA) ) }) # bayesfactor_parameters BRMS --------------------------------------------- # # test_that("bayesfactor_parameters BRMS", { # skip_if_offline() # skip_if_not_or_load_if_installed("rstanarm") # skip_if_not_or_load_if_installed("BayesFactor") # skip_if_not_or_load_if_installed("httr") # skip_if_not_or_load_if_installed("brms") # # brms_mixed_6 <- insight::download_model("brms_mixed_6") # # set.seed(222) # brms_mixed_6_p <- unupdate(brms_mixed_6) # bfsd1 <- bayesfactor_parameters(brms_mixed_6, brms_mixed_6_p, effects = "fixed") # # set.seed(222) # bfsd2 <- bayesfactor_parameters(brms_mixed_6, effects = "fixed") # # expect_equal(log(bfsd1$BF), log(bfsd2$BF), tolerance = .11) # # # brms_mixed_1 <- insight::download_model("brms_mixed_1") # expect_error(bayesfactor_parameters(brms_mixed_1)) # }) bayestestR/tests/testthat/test-estimate_density.R0000644000176200001440000000262314410351152022052 0ustar liggesuserstest_that("estimate_density", { skip_if_not_or_load_if_installed("logspline") skip_if_not_or_load_if_installed("KernSmooth") skip_if_not_or_load_if_installed("mclust") set.seed(333) x <- distribution_normal(500, 1) # Methods density_kernel <- estimate_density(x, method = "kernel") density_logspline <- estimate_density(x, method = "logspline") density_KernSmooth <- estimate_density(x, method = "KernSmooth") density_mixture <- estimate_density(x, method = "mixture") expect_equal(mean(density_kernel$y - density_logspline$y), 0, tolerance = 0.1) expect_equal(mean(density_kernel$y - density_KernSmooth$y), 0, tolerance = 0.1) expect_equal(mean(density_kernel$y - density_mixture$y), 0, tolerance = 0.1) x <- iris x$Fac <- rep(c("A", "B"), length.out = 150) rez <- estimate_density(x, select = "Sepal.Length") expect_equal(dim(rez), c(1024, 3)) rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length")) expect_equal(dim(rez), c(2048, 3)) rez <- estimate_density(x, select = "Sepal.Length", at = "Species") expect_equal(dim(rez), c(1024 * 3, 4)) rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length"), at = "Species") expect_equal(dim(rez), c(2048 * 3, 4)) rez <- estimate_density(x, select = "Sepal.Length", at = c("Species", "Fac"), method = "KernSmooth") expect_equal(dim(rez), c(1024 * 3 * 2, 5)) }) bayestestR/tests/testthat/test-p_to_bf.R0000644000176200001440000000066114410351152020110 0ustar liggesuserstest_that("p_to_bf works", { skip_if_not_or_load_if_installed("parameters") m <- lm(mpg ~ hp + cyl + am, data = mtcars) p <- coef(summary(m))[-1, 4] # BF by hand bfs <- 3 * p * sqrt(insight::n_obs(m)) expect_equal(p_to_bf(m, log = FALSE)[-1, ]$BF, exp(-log(bfs)), tolerance = 1e-4, ignore_attr = TRUE) expect_equal(p_to_bf(m, log = TRUE)[-1, ]$log_BF, -log(bfs), tolerance = 1e-4, ignore_attr = TRUE) }) bayestestR/tests/testthat/test-si.R0000644000176200001440000000343514357655465017145 0ustar liggesuserstest_that("si.numeric", { skip_if_not_installed("logspline") set.seed(333) prior <- distribution_normal(1000, mean = 0, sd = 1) posterior <- distribution_normal(1000, mean = .5, sd = .3) expect_warning(res <- si(posterior, prior), regexp = "40") expect_equal(res$CI_low, 0.043, tolerance = 0.02) expect_equal(res$CI_high, 1.053103, tolerance = 0.02) expect_s3_class(res, c("bayestestR_si")) res <- si(posterior, prior, BF = 3, verbose = FALSE) expect_equal(res$CI_low, 0.35, tolerance = 0.02) expect_equal(res$CI_high, 0.759, tolerance = 0.02) res <- si(posterior, prior, BF = 100, verbose = FALSE) expect_true(all(is.na(res$CI_low))) expect_true(all(is.na(res$CI_high))) res <- si(posterior, prior, BF = c(1 / 3, 1, 3), verbose = FALSE) expect_equal(res$CI, c(1 / 3, 1, 3), tolerance = 0.02) expect_equal(res$CI_low, c(-0.1277, 0.0426, 0.3549), tolerance = 0.02) expect_equal(res$CI_high, c(1.213, 1.053, 0.759), tolerance = 0.02) }) test_that("si.rstanarm", { skip_on_cran() skip_if_not_installed("rstanarm") data(sleep) contrasts(sleep$group) <- contr.equalprior_pairs # See vignette stan_model <- rstanarm::stan_glmer(extra ~ group + (1 | ID), data = sleep, refresh = 0) set.seed(333) stan_model_p <- update(stan_model, prior_PD = TRUE) res1 <- si(stan_model, stan_model_p, verbose = FALSE) set.seed(333) res2 <- si(stan_model, verbose = FALSE) expect_s3_class(res1, c("bayestestR_si")) expect_equal(res1, res2) skip_if_not_installed("emmeans") set.seed(123) group_diff <- pairs(emmeans::emmeans(stan_model, ~group)) res3 <- si(group_diff, prior = stan_model, verbose = FALSE) expect_equal(res3$CI_low, -2.746, tolerance = 0.3) expect_equal(res3$CI_high, -0.4, tolerance = 0.3) }) bayestestR/tests/testthat/test-effective_sample.R0000644000176200001440000000164714410351152022006 0ustar liggesuserstest_that("effective_sample", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("rstan") brms_1 <- insight::download_model("brms_1") res <- effective_sample(brms_1) expect_equal( res, data.frame( Parameter = c("b_Intercept", "b_wt", "b_cyl"), ESS = c(5242, 2071, 1951), stringsAsFactors = F ) ) brms_null_1 <- insight::download_model("brms_null_1") res <- effective_sample(brms_null_1) expect_equal( res, data.frame( Parameter = c("b_Intercept"), ESS = c(2888), stringsAsFactors = F ) ) brms_null_2 <- insight::download_model("brms_null_2") res <- effective_sample(brms_null_2) expect_equal( res, data.frame( Parameter = c("b_Intercept"), ESS = c(1059), stringsAsFactors = F ) ) }) bayestestR/tests/testthat/test-rstanarm.R0000644000176200001440000001077014410351152020331 0ustar liggesuserstest_that("rstanarm", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("stanreg_lm_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1) model <- insight::download_model("stanreg_meanfield_lm_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1) model <- insight::download_model("stanreg_fullrank_lm_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1) model <- insight::download_model("stanreg_lmerMod_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.097, tolerance = 0.1) model <- insight::download_model("stanreg_glm_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.18, tolerance = 0.1) model <- insight::download_model("stanreg_merMod_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.18, tolerance = 0.1) model <- insight::download_model("stanreg_gamm4_1") expect_equal(rope_range(model, verbose = FALSE)[1], -0.043, tolerance = 0.1) model <- insight::download_model("stanreg_gam_1") invisible(capture.output( expect_warning(params <- describe_posterior(model, centrality = "all", test = "all", dispersion = TRUE )) )) expect_equal(c(nrow(params), ncol(params)), c(4, 22)) expect_s3_class(hdi(model), "data.frame") expect_s3_class(ci(model), "data.frame") expect_s3_class(rope(model, verbose = FALSE), "data.frame") # expect_true("equivalence_test" %in% class(equivalence_test(model))) expect_s3_class(map_estimate(model), "data.frame") expect_s3_class(p_map(model), "data.frame") expect_s3_class(p_direction(model), "data.frame") # expect_error(equivalence_test(model, range = c(.1, .3, .5))) # print(equivalence_test(model, ci = c(.1, .3, .5))) }) test_that("rstanarm", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("stanreg_glm_3") out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean") s <- summary(model) expect_identical(colnames(out), c( "Parameter", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS" )) expect_equal(as.vector(s[1:4, 1, drop = TRUE]), out$Mean, tolerance = 1e-3) expect_equal(as.vector(s[1:4, 8, drop = TRUE]), out$Rhat, tolerance = 1e-1) }) test_that("rstanarm", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("stanreg_merMod_3") out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean") s <- summary(model) expect_identical(colnames(out), c( "Parameter", "Effects", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS" )) expect_equal(as.vector(s[1:8, 1, drop = TRUE]), out$Mean, tolerance = 1e-3) expect_equal(as.vector(s[1:8, 8, drop = TRUE]), out$Rhat, tolerance = 1e-1) }) test_that("rstanarm", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("stanmvreg_1") out <- describe_posterior(model, effects = "fixed", component = "all", centrality = "mean", test = NULL) s <- summary(model) expect_identical(colnames(out), c( "Parameter", "Response", "Mean", "CI", "CI_low", "CI_high", "Rhat", "ESS" )) expect_equal(as.vector(s[c(1:2, 5:7), 1, drop = TRUE]), out$Mean, tolerance = 1e-3) expect_equal(as.vector(s[c(1:2, 5:7), 10, drop = TRUE]), out$Rhat, tolerance = 1e-1) }) test_that("rstanarm", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("stanmvreg_1") out <- describe_posterior( model, effects = "fixed", component = "all", centrality = "mean", test = NULL, priors = TRUE ) expect_identical(colnames(out), c( "Parameter", "Response", "Mean", "CI", "CI_low", "CI_high", "Rhat", "ESS", "Prior_Distribution", "Prior_Location", "Prior_Scale" )) expect_equal(nrow(out), 5) }) bayestestR/tests/testthat/test-p_direction.R0000644000176200001440000000244014410351152020774 0ustar liggesuserstest_that("p_direction", { skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") set.seed(333) x <- distribution_normal(10000, 1, 1) pd <- p_direction(x) expect_equal(as.numeric(pd), 0.842, tolerance = 0.1) expect_equal(as.numeric(p_direction(x, method = "kernel")), 0.842, tolerance = 0.1) expect_equal(nrow(p_direction(data.frame(replicate(4, rnorm(100))))), 4) expect_s3_class(pd, "p_direction") expect_equal(tail(capture.output(print(pd)), 1), "Probability of Direction: 0.84") }) test_that("p_direction", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( p_direction(m, effects = "all")$pd, p_direction(p)$pd, tolerance = 1e-3 ) }) test_that("p_direction", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( p_direction(m, effects = "all", component = "all")$pd, p_direction(p)$pd, tolerance = 1e-3 ) }) bayestestR/tests/testthat/test-rope_range.R0000644000176200001440000000305714410351152020623 0ustar liggesuserstest_that("rope_range cor", { x <- cor.test(ToothGrowth$len, ToothGrowth$dose) expect_equal(rope_range(x), c(-0.05, 0.05), tolerance = 1e-3) }) test_that("rope_range gaussian", { data(mtcars) mod <- lm(mpg ~ gear + hp, data = mtcars) expect_equal(rope_range(mod), c(-0.1 * sd(mtcars$mpg), 0.1 * sd(mtcars$mpg)), tolerance = 1e-3) }) test_that("rope_range log gaussian", { data(iris) mod <- lm(log(Sepal.Length) ~ Species, data = iris) expect_equal(rope_range(mod), c(-0.01, 0.01), tolerance = 1e-3) }) test_that("rope_range log gaussian 2", { data(mtcars) mod <- glm(mpg ~ gear + hp, data = mtcars, family = gaussian("log")) expect_equal(rope_range(mod), c(-0.01, 0.01), tolerance = 1e-3) }) test_that("rope_range logistic", { data(mtcars) mod <- glm(am ~ gear + hp, data = mtcars, family = binomial()) expect_equal(rope_range(mod), c(-1 * 0.1 * pi / sqrt(3), 0.1 * pi / sqrt(3)), tolerance = 1e-3) }) # if ( skip_if_not_or_load_if_installed("brms")) { # test_that("rope_range", { # model <- brm(mpg ~ wt + gear, data = mtcars, iter = 300) # # expect_equal( # rope_range(model), # c(-0.6026948, 0.6026948), # tolerance = 0.01 # ) # }) # # test_that("rope_range (multivariate)", { # model <- brm(mvbind(mpg, disp) ~ wt + gear, data = mtcars, iter = 300) # # expect_equal( # rope_range(model), # list( # mpg = c(-0.602694, 0.602694), # disp = c(-12.393869, 12.393869) # ), # tolerance = 0.01 # ) # }) # } bayestestR/tests/testthat/test-check_prior.R0000644000176200001440000001020614413221117020764 0ustar liggesuserstest_that("check_prior - stanreg", { skip_on_cran() skip_on_os(os = "windows") skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BH") skip_if_not_or_load_if_installed("RcppEigen") skip_if_not_or_load_if_installed("brms") set.seed(333) model1 <- insight::download_model("stanreg_lm_1") expect_equal( check_prior(model1)$Prior_Quality, c("informative", "uninformative") ) expect_equal( check_prior(model1, method = "lakeland")$Prior_Quality, c("informative", "informative") ) }) test_that("check_prior - brms (linux)", { skip("TODO: check hard-coded values") skip_on_cran() skip_on_os(os = c("windows", "mac", "solaris")) skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BH") skip_if_not_or_load_if_installed("RcppEigen") skip_if_not_or_load_if_installed("brms") # all `brms` examples in circus have uniform prior distribution, so # need to use a custom example here set.seed(333) suppressMessages({ model2 <- brm(rating ~ period + carry + cs(treat), data = inhaler, family = sratio("logit"), prior = set_prior("normal(0,5)"), chains = 2, silent = TRUE, refresh = 0 ) }) expect_warning(expect_equal( check_prior(model2)$Prior_Quality, c( "uninformative", "informative", "informative", "uninformative", "uninformative", "not determinable", "not determinable", "not determinable" ) )) expect_warning(expect_equal( check_prior(model2, method = "lakeland")$Prior_Quality, c( "informative", "informative", "informative", "informative", "informative", "not determinable", "not determinable", "not determinable" ) )) }) test_that("check_prior - brms (linux)", { skip_on_cran() skip_on_os(os = c("windows", "mac", "solaris")) skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BH") skip_if_not_or_load_if_installed("RcppEigen") skip_if_not_or_load_if_installed("brms") # all `brms` examples in circus have uniform prior distribution, so # need to use a custom example here set.seed(333) model2 <- brm(rating ~ period + carry + cs(treat), data = inhaler, family = sratio("logit"), prior = set_prior("normal(0,5)"), chains = 2, silent = TRUE, refresh = 0 ) # TODO: check hard-coded values") # expect_warning(expect_equal( # check_prior(model2)$Prior_Quality, # c( # "uninformative", "informative", "informative", "uninformative", # "uninformative", "not determinable", "not determinable", "not determinable" # ) # )) expect_warning(expect_equal( check_prior(model2, method = "lakeland")$Prior_Quality, c( "informative", "informative", "informative", "informative", "informative", "not determinable", "not determinable", "not determinable" ) )) }) test_that("check_prior - brms (not linux or windows)", { skip_on_cran() skip_on_os(os = c("linux", "windows")) skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BH") skip_if_not_or_load_if_installed("RcppEigen") skip_if_not_or_load_if_installed("brms") # all `brms` examples in circus have uniform prior distribution, so # need to use a custom example here set.seed(333) suppressMessages({ model2 <- brm(rating ~ period + carry + cs(treat), data = inhaler, family = sratio("logit"), prior = set_prior("normal(0,5)"), chains = 2, silent = TRUE, refresh = 0 ) }) expect_warning(expect_equal( check_prior(model2)$Prior_Quality, c( "uninformative", "uninformative", "informative", "uninformative", "uninformative", "not determinable", "not determinable", "not determinable" ) )) expect_warning(expect_equal( check_prior(model2, method = "lakeland")$Prior_Quality, c( "informative", "informative", "informative", "informative", "informative", "not determinable", "not determinable", "not determinable" ) )) }) bayestestR/tests/testthat/test-hdi.R0000644000176200001440000000503614410351152017245 0ustar liggesusers# numeric ------------------------------- test_that("hdi", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") expect_equal(hdi(distribution_normal(1000), ci = .90)$CI_low[1], -1.64, tolerance = 0.02) expect_equal(nrow(hdi(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01) expect_equal(hdi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02) expect_equal(nchar(capture.output(print(hdi(distribution_normal(1000))))), 22) expect_equal(length(capture.output(print(hdi(distribution_normal(1000), ci = c(.80, .90))))), 5) expect_warning(hdi(c(2, 3, NA))) expect_warning(hdi(c(2, 3))) expect_warning(hdi(distribution_normal(1000), ci = 0.0000001)) expect_warning(hdi(distribution_normal(1000), ci = 950)) expect_warning(hdi(c(0, 0, 0))) }) # stanreg --------------------------- test_that("ci", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( hdi(m, ci = c(0.5, 0.8), effects = "all")$CI_low, hdi(p, ci = c(0.5, 0.8))$CI_low, tolerance = 1e-3 ) }) # brms --------------------------- test_that("rope", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( hdi(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, hdi(p, ci = c(0.5, 0.8))$CI_low, tolerance = 1e-3 ) }) # BayesFactor --------------------------- test_that("ci - BayesFactor", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") mod_bf <- proportionBF(y = 15, N = 25, p = .5) p_bf <- insight::get_parameters(mod_bf) expect_equal( hdi(mod_bf, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, hdi(p_bf, ci = c(0.5, 0.8))$CI_low, tolerance = 0.1 ) }) bayestestR/tests/testthat/test-distributions.R0000644000176200001440000000312614357655465021431 0ustar liggesuserstest_that("distributions", { tolerance <- 0.01 expect_equal(mean(distribution_normal(10)), 0, tolerance = tolerance) expect_equal(length(distribution_normal(10, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_beta(10, 1, 1)), 0.5, tolerance = tolerance) expect_equal(length(distribution_normal(10, 1, 1, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_binomial(10, 0, 0.5)), 0, tolerance = tolerance) expect_equal(length(distribution_binomial(10, 0, 0.5, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_cauchy(10)), 0, tolerance = tolerance) expect_equal(length(distribution_cauchy(10, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_chisquared(10, 1)), 0.893, tolerance = tolerance) expect_equal(length(distribution_chisquared(10, 1, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_gamma(10, 1)), 0.9404, tolerance = tolerance) expect_equal(length(distribution_gamma(10, 1, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_poisson(10)), 1, tolerance = tolerance) expect_equal(length(distribution_poisson(10, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_student(10, 1)), 0, tolerance = tolerance) expect_equal(length(distribution_student(10, 1, random = TRUE)), 10, tolerance = tolerance) expect_equal(mean(distribution_uniform(10)), 0.5, tolerance = tolerance) expect_equal(length(distribution_uniform(10, random = TRUE)), 10, tolerance = tolerance) }) bayestestR/tests/testthat/test-contr.R0000644000176200001440000000346514357655465017662 0ustar liggesuserstest_that("contr.equalprior | gen", { skip_on_cran() set.seed(1234) k <- 3 g <- 4.1 contr1 <- contr.equalprior(k, contrasts = TRUE) contr2 <- contr.equalprior(k, contrasts = FALSE) samps1 <- replicate(ncol(contr1), { rnorm(4e3, 0, g) }) samps2 <- replicate(ncol(contr2), { rnorm(4e3, 0, g) }) means1 <- t(contr1 %*% t(samps1)) means2 <- t(contr2 %*% t(samps2)) expect_equal(mean(apply(means1, 2, sd)), mean(apply(means2, 2, sd)), tolerance = 0.1) }) test_that("contr.equalprior | pairs", { skip_on_cran() set.seed(1234) k <- 3 g <- 4.1 contr1 <- contr.equalprior_pairs(k, contrasts = TRUE) contr2 <- contr.equalprior_pairs(k, contrasts = FALSE) samps1 <- replicate(ncol(contr1), { rnorm(4e3, 0, g) }) samps2 <- replicate(ncol(contr2), { rnorm(4e3, 0, g) }) means1 <- t(contr1 %*% t(samps1)) means2 <- t(contr2 %*% t(samps2)) w <- matrix(c( -1, 1, 0, 1, 0, -1, 0, -1, 1 ), 3, 3) pairs1 <- t(w %*% t(means1)) pairs2 <- t(w %*% t(means2)) expect_equal(mean(apply(pairs1, 2, sd)), g, tolerance = 0.1) expect_equal(mean(apply(pairs1, 2, sd)), mean(apply(pairs2, 2, sd)), tolerance = 0.1) }) test_that("contr.equalprior | dev", { skip_on_cran() set.seed(1234) k <- 3 g <- 4.1 contr1 <- contr.equalprior_deviations(k, contrasts = TRUE) contr2 <- contr.equalprior_deviations(k, contrasts = FALSE) samps1 <- replicate(ncol(contr1), { rnorm(4e3, 0, g) }) samps2 <- replicate(ncol(contr2), { rnorm(4e3, 0, g) }) means1 <- t(contr1 %*% t(samps1)) means2 <- t(contr2 %*% t(samps2)) expect_equal(mean(apply(means1, 2, sd)), g, tolerance = 0.1) expect_equal(mean(apply(means1, 2, sd)), mean(apply(means2, 2, sd)), tolerance = 0.1) }) bayestestR/tests/testthat/test-spi.R0000644000176200001440000000465414410351152017301 0ustar liggesusers# numeric ------------------------------- test_that("spi", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") expect_equal(spi(distribution_normal(1000), ci = .90)$CI_low[1], -1.65, tolerance = 0.02) expect_equal(nrow(spi(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01) expect_equal(spi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02) expect_equal(nchar(capture.output(print(spi(distribution_normal(1000))))), 22) expect_equal(length(capture.output(print(spi(distribution_normal(1000), ci = c(.80, .90))))), 5) expect_error(spi(c(2, 3, NA))) expect_warning(spi(c(2, 3))) expect_message(spi(distribution_normal(1000), ci = 0.0000001)) expect_warning(spi(distribution_normal(1000), ci = 950)) expect_message(spi(c(0, 0, 0))) }) test_that("ci", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( spi(m, ci = c(0.5, 0.8), effects = "all")$CI_low, spi(p, ci = c(0.5, 0.8))$CI_low, tolerance = 1e-3 ) }) test_that("spi brms", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( spi(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, spi(p, ci = c(0.5, 0.8))$CI_low, tolerance = 1e-3 ) }) test_that("ci - BayesFactor", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") mod_bf <- proportionBF(y = 15, N = 25, p = .5) p_bf <- insight::get_parameters(mod_bf) expect_equal( spi(mod_bf, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, spi(p_bf, ci = c(0.5, 0.8))$CI_low, tolerance = 0.1 ) }) bayestestR/tests/testthat/test-describe_prior.R0000644000176200001440000001041014410351152021464 0ustar liggesuserstest_that("describe_prior", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") # Bayes Factor ---------------------------------------- expect_equal( describe_prior(correlationBF(mtcars$wt, mtcars$mpg, rscale = 0.5)), structure(list( Parameter = "rho", Prior_Distribution = "beta", Prior_Location = 2, Prior_Scale = 2 ), class = "data.frame", row.names = c( NA, -1L )) ) expect_equal( describe_prior(ttestBF(mtcars$wt, mu = 3)), structure(list( Parameter = "Difference", Prior_Distribution = "cauchy", Prior_Location = 0, Prior_Scale = 0.707106781186548 ), class = "data.frame", row.names = c( NA, -1L )) ) expect_equal( describe_prior(contingencyTableBF( x = table(mtcars$am, mtcars$cyl), sampleType = "poisson" )), structure(list( Parameter = "Ratio", Prior_Distribution = "poisson", Prior_Location = 0, Prior_Scale = 1 ), class = "data.frame", row.names = c( NA, -1L )) ) expect_equal( describe_prior(contingencyTableBF( x = table(mtcars$am, mtcars$cyl), sampleType = "indepMulti", fixedMargin = "cols", priorConcentration = 1.6 )), structure(list( Parameter = "Ratio", Prior_Distribution = "independent multinomial", Prior_Location = 0, Prior_Scale = 1.6 ), class = "data.frame", row.names = c( NA, -1L )) ) expect_equal( describe_prior(anovaBF(extra ~ group, data = sleep, progress = FALSE)), structure(list(Parameter = c( "group-1", "group-2", "mu", "sig2", "g_group" ), Prior_Distribution = c( "cauchy", "cauchy", NA, NA, NA ), Prior_Location = c(0, 0, NA, NA, NA), Prior_Scale = c( 0.5, 0.5, NA, NA, NA )), row.names = c(NA, -5L), class = "data.frame") ) # brms ---------------------------------------- mod_brms <- insight::download_model("brms_1") expect_equal( describe_prior(mod_brms), structure( list( Parameter = c("b_Intercept", "b_wt", "b_cyl", "sigma"), Prior_Distribution = c("student_t", "uniform", "uniform", "student_t"), Prior_Location = c(19.2, NA, NA, 0), Prior_Scale = c(5.4, NA, NA, 5.4), Prior_df = c(3, NA, NA, 3) ), row.names = c(NA, -4L), class = "data.frame", priors = structure( list( prior = c( "(flat)", "(flat)", "(flat)", "student_t(3, 19.2, 5.4)", "student_t(3, 0, 5.4)" ), class = c("b", "b", "b", "Intercept", "sigma"), coef = c("", "cyl", "wt", "", ""), group = c("", "", "", "", ""), resp = c("", "", "", "", ""), dpar = c("", "", "", "", ""), nlpar = c("", "", "", "", ""), bound = c("", "", "", "", ""), source = c( "(unknown)", "(vectorized)", "(vectorized)", "(unknown)", "(unknown)" ), Parameter = c("b_", "b_cyl", "b_wt", "b_Intercept", "sigma") ), special = list(mu = list()), row.names = c(NA, -5L), sample_prior = "no", class = "data.frame" ) ), ignore_attr = TRUE, tolerance = 1e-2 ) # stanreg ---------------------------------------- mod_stanreg1 <- insight::download_model("stanreg_gamm4_1") mod_stanreg2 <- insight::download_model("stanreg_merMod_1") expect_equal( describe_prior(mod_stanreg1), structure(list( Parameter = "(Intercept)", Prior_Distribution = "normal", Prior_Location = 3.05733333333333, Prior_Scale = 1.08966571234175 ), row.names = c( NA, -1L ), class = "data.frame") ) expect_equal( describe_prior(mod_stanreg2), structure( list( Parameter = c("(Intercept)", "cyl"), Prior_Distribution = c( "normal", "normal" ), Prior_Location = c(0, 0), Prior_Scale = c(2.5, 1.39983744766986) ), row.names = c(NA, -2L), class = "data.frame" ) ) }) bayestestR/tests/testthat/test-as.data.frame.density.R0000644000176200001440000000017614276606713022603 0ustar liggesuserstest_that("as.data.frame.density", { expect_s3_class(as.data.frame(density(distribution_normal(1000))), "data.frame") }) bayestestR/tests/testthat/test-describe_posterior.R0000644000176200001440000004207714410351152022375 0ustar liggesuserstest_that("describe_posterior", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") set.seed(333) # numeric ------------------------------------------------- x <- distribution_normal(4000) describe_posterior( x, centrality = "all", dispersion = TRUE, test = "all", ci = 0.89, verbose = FALSE ) rez <- as.data.frame(suppressWarnings(describe_posterior( x, centrality = "all", dispersion = TRUE, test = "all", ci = 0.89 ))) expect_equal(dim(rez), c(1, 19)) expect_identical(colnames(rez), c( "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low", "CI_high", "p_map", "pd", "p_ROPE", "ps", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "log_BF" )) expect_warning(expect_warning(describe_posterior( x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9) ))) # rez <- suppressWarnings(describe_posterior( # x, # centrality = "all", # dispersion = TRUE, # test = "all", # ci = c(0.8, 0.9) # )) # expect_equal(dim(rez), c(2, 19)) rez <- describe_posterior( x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method = "quantile", verbose = FALSE ) expect_equal(dim(rez), c(1, 4)) # dataframes ------------------------------------------------- x <- data.frame(replicate(4, rnorm(100))) expect_warning(expect_warning( describe_posterior( x, centrality = "all", dispersion = TRUE, test = "all" ) )) # rez <- suppressWarnings(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")) # expect_equal(dim(rez), c(4, 19)) expect_warning(expect_warning( describe_posterior( x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9) ) )) # rez <- suppressWarnings(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9))) # expect_equal(dim(rez), c(8, 19)) rez <- describe_posterior( x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method = "quantile" ) expect_equal(dim(rez), c(4, 4)) }) test_that("describe_posterior", { skip_if(Sys.info()["sysname"] == "Darwin", "Don't run on Darwin") skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") set.seed(333) # Rstanarm x <- rstanarm::stan_glm(mpg ~ wt, data = mtcars, refresh = 0, iter = 500) expect_warning(rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")) expect_equal(dim(rez), c(2, 21)) expect_equal(colnames(rez), c( "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low", "CI_high", "p_MAP", "pd", "p_ROPE", "ps", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "log_BF", "Rhat", "ESS" )) expect_warning(rez <- describe_posterior( x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9) )) expect_equal(dim(rez), c(4, 21)) rez <- describe_posterior( x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method = "quantile", diagnostic = NULL, priors = FALSE ) expect_equal(dim(rez), c(2, 4)) # brms ------------------------------------------------- # x <- brms::brm(mpg ~ wt + (1 | cyl) + (1 + wt | gear), data = mtcars, refresh = 0) # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, ci = c(0.8, 0.9)) # # expect_equal(dim(rez), c(4, 16)) # expect_equal(colnames(rez), c( # "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low", # "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", # "Rhat", "ESS" # )) # # rez <- describe_posterior( # x, # centrality = NULL, # dispersion = TRUE, # test = NULL, # ci_method = "quantile", # diagnostic = NULL # ) # # expect_equal(dim(rez), c(2, 4)) # # model <- brms::brm( # mpg ~ drat, # data = mtcars, # chains = 2, # algorithm = "meanfield", # refresh = 0 # ) # # expect_equal(nrow(describe_posterior(model)), 2) # rstanarm ------------------------------------------------- model <- rstanarm::stan_glm(mpg ~ drat, data = mtcars, algorithm = "meanfield", refresh = 0 ) expect_equal(nrow(describe_posterior(model)), 2) model <- suppressWarnings(rstanarm::stan_glm(mpg ~ drat, data = mtcars, algorithm = "optimizing", refresh = 0 )) expect_equal(nrow(describe_posterior(model)), 2) model <- rstanarm::stan_glm(mpg ~ drat, data = mtcars, algorithm = "fullrank", refresh = 0 ) expect_equal(nrow(describe_posterior(model)), 2) # model <- brms::brm(mpg ~ drat, data = mtcars, chains=2, algorithm="fullrank", refresh=0) # expect_equal(nrow(describe_posterior(model)), 2) # BayesFactor # library(BayesFactor) # x <- BayesFactor::ttestBF(x = rnorm(100, 1, 1)) # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all") # expect_equal(dim(rez), c(4, 16)) # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9)) # expect_equal(dim(rez), c(8, 16)) # rez <- describe_posterior(x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method="quantile") # expect_equal(dim(rez), c(4, 4)) }) test_that("describe_posterior", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( describe_posterior(m, effects = "all", verbose = FALSE)$Median, describe_posterior(p, verbose = FALSE)$Median, tolerance = 1e-3 ) }) test_that("describe_posterior", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( suppressWarnings(describe_posterior(m, effects = "all", component = "all", verbose = FALSE)$Median), suppressWarnings(describe_posterior(p, verbose = FALSE)$Median), tolerance = 1e-3 ) }) test_that("describe_posterior w/ BF+SI", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") x <- insight::download_model("stanreg_lm_1") set.seed(555) expect_warning(expect_warning(rez <- describe_posterior(x, ci_method = "SI", test = "bf"))) # test si set.seed(555) suppressMessages( expect_warning(rez_si <- si(x)) ) expect_equal(rez$CI_low, rez_si$CI_low, tolerance = 0.1) expect_equal(rez$CI_high, rez_si$CI_high, tolerance = 0.1) # test BF set.seed(555) rez_bf <- suppressWarnings(bayesfactor_parameters(x, verbose = FALSE)) expect_equal(rez$log_BF, log(as.numeric(rez_bf)), tolerance = 0.1) }) # BayesFactor ------------------------------------------------- test_that("describe_posterior: BayesFactor", { skip_if_not(getRversion() >= "4.0", "Don't run with R < 4.0") skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("BayesFactor") set.seed(123) expect_equal( as.data.frame(describe_posterior(correlationBF( mtcars$wt, mtcars$mpg, rscale = 0.5 ))), structure( list( Parameter = "rho", Median = -0.833281858269296, CI = 0.95, CI_low = -0.919418102114416, CI_high = -0.715602277241063, pd = 1, ROPE_CI = 0.95, ROPE_low = -0.05, ROPE_high = 0.05, ROPE_Percentage = 0, log_BF = 17.328704623688, BF = 33555274.5519413, Prior_Distribution = "beta", Prior_Location = 2, Prior_Scale = 2 ), row.names = 1L, class = "data.frame", ci_method = "hdi" ), tolerance = 0.1, ignore_attr = TRUE ) set.seed(123) expect_equal( describe_posterior(ttestBF(mtcars$wt, mu = 3), ci = 0.95, ci_method = "hdi"), structure( list( Parameter = "Difference", Median = 0.192275922178887, CI = 0.95, CI_low = -0.172955539648102, CI_high = 0.526426796879103, pd = 0.85875, ROPE_CI = 0.95, ROPE_low = -0.0978457442989697, ROPE_high = 0.0978457442989697, ROPE_Percentage = 0.257300710339384, log_BF = -0.94971351422473, BF = 0.386851835128661, Prior_Distribution = "cauchy", Prior_Location = 0, Prior_Scale = 0.707106781186548 ), row.names = 1L, class = c("describe_posterior", "see_describe_posterior", "data.frame"), ci_method = "hdi", object_name = "ttestBF(mtcars$wt, mu = 3)" ), tolerance = 0.1, ignore_attr = TRUE ) set.seed(123) expect_warning(expect_equal( describe_posterior( contingencyTableBF( x = table(mtcars$am, mtcars$cyl), sampleType = "poisson" ), ci = 0.95, ci_method = "hdi" ), structure( list( Parameter = c( "cell[1,1]", "cell[2,1]", "cell[1,2]", "cell[2,2]", "cell[1,3]", "cell[2,3]", "Ratio" ), Median = c( 3.04620767622137, 7.33170140780154, 3.96252503900368, 3.06206636495483, 10.7088156207511, 2.26008072419983, NA ), CI = c( 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, NA ), CI_low = c( 0.537476720942068, 3.33553818106395, 1.05013765177975, 0.746538992318074, 5.49894434136364, 0.275642629940081, NA ), CI_high = c( 6.62852027141624, 12.6753970192515, 7.74693313388489, 6.87239730676778, 16.9198964674968, 5.4533083861175, NA ), pd = c(1, 1, 1, 1, 1, 1, NA), ROPE_CI = c( 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, NA ), ROPE_low = c( -0.1, -0.1, -0.1, -0.1, -0.1, -0.1, NA ), ROPE_high = c( 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, NA ), ROPE_Percentage = c(0, 0, 0, 0, 0, 0, NA), log_BF = c( 3.84187678153378, 3.84187678153378, 3.84187678153378, 3.84187678153378, 3.84187678153378, 3.84187678153378, NA ), BF = c( 46.6128745808996, 46.6128745808996, 46.6128745808996, 46.6128745808996, 46.6128745808996, 46.6128745808996, NA ), Prior_Distribution = c(NA, NA, NA, NA, NA, NA, "poisson"), Prior_Location = c(NA, NA, NA, NA, NA, NA, 0), Prior_Scale = c( NA, NA, NA, NA, NA, NA, 1 ) ), row.names = c( 1L, 4L, 2L, 5L, 3L, 6L, 7L ), class = c("describe_posterior", "see_describe_posterior") ), tolerance = 0.1, ignore_attr = TRUE )) set.seed(123) expect_warning(expect_equal( describe_posterior(contingencyTableBF( x = table(mtcars$am, mtcars$cyl), sampleType = "indepMulti", fixedMargin = "cols", priorConcentration = 1.6 ), ci = 0.95), structure( list( Parameter = c( "cell[1,1]", "cell[2,1]", "cell[1,2]", "cell[2,2]", "cell[1,3]", "cell[2,3]", "Ratio" ), Median = c( 3.33359102240953, 7.27094924961528, 4.13335763121549, 3.36172537199681, 10.3872621523407, 2.56061336771352, NA ), CI = c( 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, NA ), CI_low = c( 0.912122089726423, 3.51744611674693, 1.39218072401004, 0.923175932880601, 6.18021898129278, 0.465587711080369, NA ), CI_high = c( 6.61128887457661, 11.4058892728414, 7.61378018576518, 6.65522159416386, 15.1209075845299, 5.35853420162441, NA ), pd = c(1, 1, 1, 1, 1, 1, NA), ROPE_CI = c( 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, NA ), ROPE_low = c( -0.1, -0.1, -0.1, -0.1, -0.1, -0.1, NA ), ROPE_high = c( 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, NA ), ROPE_Percentage = c(0, 0, 0, 0, 0, 0, NA), log_BF = c( 2.49338780738881, 2.49338780738881, 2.49338780738881, 2.49338780738881, 2.49338780738881, 2.49338780738881, NA ), BF = c( 12.1022066941064, 12.1022066941064, 12.1022066941064, 12.1022066941064, 12.1022066941064, 12.1022066941064, NA ), Prior_Distribution = c(NA, NA, NA, NA, NA, NA, "independent multinomial"), Prior_Location = c(NA, NA, NA, NA, NA, NA, 0), Prior_Scale = c( NA, NA, NA, NA, NA, NA, 1.6 ) ), row.names = c( 1L, 4L, 2L, 5L, 3L, 6L, 7L ), class = c( "describe_posterior", "see_describe_posterior", "data.frame" ), ci_method = "hdi", object_name = "contingencyTableBF(x = table(mtcars$am, mtcars$cyl), sampleType = \"indepMulti\", fixedMargin = \"cols\", priorConcentration = 1.6)" ), tolerance = 0.1, ignore_attr = TRUE )) set.seed(123) expect_equal( describe_posterior(anovaBF(extra ~ group, data = sleep, progress = FALSE), ci_method = "hdi", ci = 0.95), structure( list( Parameter = c( "mu", "group-1", "group-2", "sig2", "g_group" ), Median = c( 1.53667371296145, -0.571674439385088, 0.571674439385088, 3.69268743002151, 0.349038661644431 ), CI = c( 0.95, 0.95, 0.95, 0.95, 0.95 ), CI_low = c( 0.691696017646264, -1.31604531656452, -0.229408603643392, 1.75779899540302, 0.0192738130412634 ), CI_high = c( 2.43317955922589, 0.229408603643392, 1.31604531656452, 6.88471056133351, 5.30402785651874 ), pd = c(0.99975, 0.927, 0.927, 1, 1), ROPE_CI = c( 0.95, 0.95, 0.95, 0.95, 0.95 ), ROPE_low = c( -0.201791972090071, -0.201791972090071, -0.201791972090071, -0.201791972090071, -0.201791972090071 ), ROPE_high = c( 0.201791972090071, 0.201791972090071, 0.201791972090071, 0.201791972090071, 0.201791972090071 ), ROPE_Percentage = c( 0, 0.162325703762168, 0.162325703762168, 0, 0.346487766377269 ), log_BF = c( 0.235803198474248, 0.235803198474248, 0.235803198474248, 0.235803198474248, 0.235803198474248 ), BF = c( 1.26592514964916, 1.26592514964916, 1.26592514964916, 1.26592514964916, 1.26592514964916 ), Prior_Distribution = c(NA, "cauchy", "cauchy", NA, NA), Prior_Location = c(NA, 0, 0, NA, NA), Prior_Scale = c( NA, 0.5, 0.5, NA, NA ) ), row.names = c(4L, 2L, 3L, 5L, 1L), class = c( "describe_posterior", "see_describe_posterior", "data.frame" ), ci_method = "hdi", object_name = "anovaBF(extra ~ group, data = sleep, progress = FALSE)" ), tolerance = 0.1, ignore_attr = TRUE ) }) bayestestR/tests/testthat/test-density_at.R0000644000176200001440000000031414276606713020656 0ustar liggesuserstest_that("density_at", { expect_equal(density_at(distribution_normal(1000), 0), 0.389, tolerance = 0.1) expect_equal(density_at(distribution_normal(1000), c(0, 1))[1], 0.389, tolerance = 0.1) }) bayestestR/tests/testthat/test-different_models.R0000644000176200001440000000412114410351152022004 0ustar liggesuserstest_that("insight::get_predicted", { skip_on_os("mac") skip_if_not_or_load_if_installed("rstanarm") x <- suppressWarnings( insight::get_predicted( stan_glm(hp ~ mpg, data = mtcars, iter = 500, refresh = 0) ) ) rez <- point_estimate(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 4)) rez <- hdi(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 4)) rez <- eti(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 4)) rez <- ci(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 4)) rez <- map_estimate(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 2)) rez <- p_direction(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 2)) # rez <- p_map(x) # expect_equal(c(nrow(rez), ncol(rez)), c(2, 2)) # # rez <- p_significance(x) # expect_equal(c(nrow(rez), ncol(rez)), c(2, 2)) # # rez <- rope(x) # expect_equal(c(nrow(rez), ncol(rez)), c(2, 5)) rez <- describe_posterior(x) expect_equal(c(nrow(rez), ncol(rez)), c(32, 5)) # rez <- estimate_density(x) # expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3)) }) test_that("bayesQR", { skip_on_os("mac") skip_if_not_or_load_if_installed("bayesQR") invisible(capture.output( x <- bayesQR(Sepal.Length ~ Petal.Width, data = iris, quantile = 0.1, alasso = TRUE, ndraw = 500 ) )) rez <- p_direction(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 2)) rez <- p_map(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 2)) rez <- p_significance(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 2)) rez <- rope(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 5)) rez <- hdi(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 4)) rez <- eti(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 4)) rez <- map_estimate(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 2)) rez <- point_estimate(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 4)) rez <- describe_posterior(x) expect_equal(c(nrow(rez), ncol(rez)), c(2, 10)) rez <- estimate_density(x) expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3)) }) bayestestR/tests/testthat/test-simulate_data.R0000644000176200001440000000141314307033605021315 0ustar liggesuserstest_that("simulate_correlation", { set.seed(333) data <- simulate_correlation(r = 0.5, n = 50) expect_equal(as.numeric(cor.test(data$V1, data$V2)$estimate), 0.5, tolerance = 0.001) data <- simulate_correlation(r = 0.5, n = 50, mean = c(0, 1), sd = c(0.7, 1.7)) expect_equal(as.numeric(cor.test(data$V1, data$V2)$estimate), 0.5, tolerance = 0.001) expect_equal(c(mean(data$V1), sd(data$V1)), c(0, 0.7), tolerance = 0.001) expect_equal(c(mean(data$V2), sd(data$V2)), c(1, 1.7), tolerance = 0.001) cor_matrix <- matrix( c( 1.0, 0.2, 0.4, 0.2, 1.0, 0.3, 0.4, 0.3, 1.0 ), nrow = 3 ) data <- simulate_correlation(r = cor_matrix) expect_equal(matrix(cor(data), nrow = 3), cor_matrix, tolerance = 0.001) }) bayestestR/tests/testthat/test-blavaan.R0000644000176200001440000000557314410351152020113 0ustar liggesuserstest_that("blavaan, all", { skip_on_cran() skip_if_not_or_load_if_installed("blavaan") skip_if_not_or_load_if_installed("lavaan") skip_if_not_or_load_if_installed("cmdstanr") skip_if_not_or_load_if_installed("rstan") data("PoliticalDemocracy", package = "lavaan") model <- " # latent variable definitions dem60 =~ y1 + a*y2 dem65 =~ y5 + a*y6 # regressions dem65 ~ dem60 # residual correlations y1 ~~ y5 " model2 <- " # latent variable definitions dem60 =~ y1 + a*y2 dem65 =~ y5 + a*y6 # regressions dem65 ~ 0*dem60 # residual correlations y1 ~~ 0*y5 " suppressWarnings(capture.output({ bfit <- blavaan::bsem(model, data = PoliticalDemocracy, n.chains = 1, burnin = 50, sample = 100 ) bfit2 <- blavaan::bsem(model2, data = PoliticalDemocracy, n.chains = 1, burnin = 50, sample = 100 ) })) x <- point_estimate(bfit, centrality = "all", dispersion = TRUE) expect_true(all(c("Median", "MAD", "Mean", "SD", "MAP", "Component") %in% colnames(x))) expect_equal(nrow(x), 14) x <- eti(bfit) expect_equal(nrow(x), 14) x <- hdi(bfit) expect_equal(nrow(x), 14) x <- p_direction(bfit) expect_equal(nrow(x), 14) x <- rope(bfit, range = c(-.1, .1)) expect_equal(nrow(x), 14) x <- p_rope(bfit, range = c(-.1, .1)) expect_equal(nrow(x), 14) x <- p_map(bfit) expect_equal(nrow(x), 14) x <- p_significance(bfit, threshold = c(-.1, .1)) expect_equal(nrow(x), 14) x <- equivalence_test(bfit, range = c(-.1, .1)) expect_equal(nrow(x), 14) x <- estimate_density(bfit) expect_equal(length(unique(x$Parameter)), 14) ## Bayes factors ---- expect_warning(bayesfactor_models(bfit, bfit2)) x <- suppressWarnings(bayesfactor_models(bfit, bfit2)) expect_true(x$log_BF[2] < 0) expect_warning(weighted_posteriors(bfit, bfit2)) x <- suppressWarnings(weighted_posteriors(bfit, bfit2)) expect_equal(ncol(x), 14) # bfit_prior <- unupdate(bfit) # capture.output(x <- expect_warning(bayesfactor_parameters(bfit, prior = bfit_prior))) # expect_equal(nrow(x), 14) # # x <- expect_warning(si(bfit, prior = bfit_prior)) # expect_equal(nrow(x), 14) # # ## Prior/posterior checks ---- # suppressWarnings(x <- check_prior(bfit)) # expect_equal(nrow(x), 13) # # x <- check_prior(bfit, simulate_priors = FALSE) # expect_equal(nrow(x), 14) x <- diagnostic_posterior(bfit) expect_equal(nrow(x), 14) x <- simulate_prior(bfit) expect_equal(ncol(x), 13) # YES this is 13! We have two parameters with the same prior. x <- describe_prior(bfit) expect_equal(nrow(x), 13) # YES this is 13! We have two parameters with the same prior. # x <- describe_posterior(bfit, test = "all", rope_range = c(-.1, .1)) # expect_equal(nrow(x), 14) }) bayestestR/tests/testthat/test-p_map.R0000644000176200001440000000247014410351152017574 0ustar liggesuserstest_that("p_map", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") expect_equal(as.numeric(p_map(distribution_normal(1000))), 1, tolerance = 0.1) expect_equal(as.numeric(p_map(distribution_normal(1000, 1, 1))), 0.62, tolerance = 0.1) expect_equal(as.numeric(p_map(distribution_normal(1000, 2, 1))), 0.15, tolerance = 0.1) expect_equal(as.numeric(p_map(distribution_normal(1000, 3, 0.01))), 0, tolerance = 0.1) }) test_that("p_map", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( p_map(m, effects = "all")$p_MAP, p_map(p)$p_MAP, tolerance = 0.1 ) }) test_that("p_map", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( p_map(m, effects = "all", component = "all")$p_MAP, p_map(p)$p_MAP, tolerance = 0.1 ) }) test_that("p_map | null", { x <- distribution_normal(4000, mean = 1) expect_equal(p_map(x), 0.6194317, ignore_attr = TRUE, tolerance = 0.01) expect_equal(p_map(x, null = 1), 1, ignore_attr = TRUE, tolerance = 0.01) }) bayestestR/tests/testthat/test-bayesfactor_models.R0000644000176200001440000001511214410351152022342 0ustar liggesusers# bayesfactor_models BIC -------------------------------------------------- test_that("bayesfactor_models BIC", { skip_if_not_or_load_if_installed("lme4") set.seed(444) void <- suppressMessages(capture.output({ mo1 <- lme4::lmer(Sepal.Length ~ (1 | Species), data = iris) mo2 <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) mo3 <- lme4::lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris) mo4 <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + (Petal.Length | Species), data = iris) mo5 <- lme4::lmer(Sepal.Length ~ Petal.Length * Petal.Width + (Petal.Length | Species), data = iris) mo4_e <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + (Petal.Length | Species), data = iris[-1, ]) })) # both uses of denominator BFM1 <<- bayesfactor_models(mo2, mo3, mo4, mo1, denominator = 4) BFM2 <- bayesfactor_models(mo2, mo3, mo4, denominator = mo1) BFM3 <- bayesfactor_models(mo2, mo3, mo4, mo1, denominator = mo1) BFM4 <<- bayesfactor_models(mo2, mo3, mo4, mo5, mo1, denominator = mo1) expect_equal(BFM1, BFM2) expect_equal(BFM1, BFM3) expect_equal(BFM1, bayesfactor_models(list(mo2 = mo2, mo3 = mo3, mo4 = mo4, mo1 = mo1), denominator = 4)) # only on same data! expect_warning(bayesfactor_models(mo1, mo2, mo4_e)) # update models expect_equal(update(BFM2, subset = c(1, 2))$log_BF, c(1, 57.3, 54.52), tolerance = 0.1) # update reference expect_equal(update(BFM2, reference = 1)$log_BF, c(0, -2.8, -6.2, -57.4), tolerance = 0.1 ) }) test_that("bayesfactor_models BIC, transformed responses", { skip_if_not_or_load_if_installed("lme4") m1 <- lm(mpg ~ 1, mtcars) m2 <- lm(sqrt(mpg) ~ 1, mtcars) BF1 <- bayesfactor_models(m1, m2, check_response = TRUE) expect_equal(BF1$log_BF[2], 2.4404 / 2, tolerance = 0.01) BF2 <- bayesfactor_models(m1, m2, check_response = FALSE) expect_false(isTRUE(all.equal(BF1, BF2))) }) test_that("bayesfactor_models BIC (unsupported / diff nobs)", { skip_if_not_or_load_if_installed("lme4") skip_on_cran() set.seed(444) fit1 <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, iris) fit2a <- lm(Sepal.Length ~ Sepal.Width, iris[-1, ]) # different number of objects fit2b <- lm(Sepal.Length ~ Sepal.Width, iris) # not supported class(fit2b) <- "NOTLM" logLik.NOTLM <<- function(...) { stats:::logLik.lm(...) } # Should warm expect_warning(bayesfactor_models(fit1, fit2a)) # Should fail suppressWarnings(expect_message(bayesfactor_models(fit1, fit2b), "Unable")) }) # bayesfactor_models STAN --------------------------------------------- test_that("bayesfactor_models STAN", { skip_if_not_or_load_if_installed("lme4") skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("bridgesampling") skip_if_not_or_load_if_installed("brms") skip_on_cran() set.seed(333) stan_bf_0 <- rstanarm::stan_glm( Sepal.Length ~ 1, data = iris, refresh = 0, iter = 500, diagnostic_file = file.path(tempdir(), "df0.csv") ) stan_bf_1 <- suppressWarnings(rstanarm::stan_glm( Sepal.Length ~ Species, data = iris, refresh = 0, iter = 500, diagnostic_file = file.path(tempdir(), "df1.csv") )) set.seed(333) # compare against bridgesampling bridge_BF <- bridgesampling::bayes_factor( bridgesampling::bridge_sampler(stan_bf_1, silent = TRUE), bridgesampling::bridge_sampler(stan_bf_0, silent = TRUE) ) set.seed(333) suppressMessages({ expect_warning( stan_models <- bayesfactor_models(stan_bf_0, stan_bf_1) ) }) expect_s3_class(stan_models, "bayesfactor_models") expect_equal(length(stan_models$log_BF), 2) expect_equal(stan_models$log_BF[2], log(bridge_BF$bf), tolerance = 0.1) }) test_that("bayesfactor_models BRMS", { # Checks for brms models skip_on_cran() skip_on_ci() skip_if_not_or_load_if_installed("lme4") skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("bridgesampling") skip_if_not_or_load_if_installed("brms") set.seed(333) stan_brms_model_0 <- suppressWarnings(brms::brm( Sepal.Length ~ 1, data = iris, iter = 500, refresh = 0, save_pars = brms::save_pars(all = TRUE), silent = 2 )) stan_brms_model_1 <- suppressWarnings(brms::brm( Sepal.Length ~ Petal.Length, data = iris, iter = 500, refresh = 0, save_pars = brms::save_pars(all = TRUE), silent = 2 )) set.seed(444) suppressMessages( expect_message( bfm <- bayesfactor_models(stan_brms_model_0, stan_brms_model_1), regexp = "marginal" ) ) set.seed(444) stan_brms_model_0wc <- brms::add_criterion( stan_brms_model_0, criterion = "marglik", repetitions = 5, silent = 2 ) stan_brms_model_1wc <- brms::add_criterion( stan_brms_model_1, criterion = "marglik", repetitions = 5, silent = 2 ) expect_message(bfmwc <- bayesfactor_models(stan_brms_model_0wc, stan_brms_model_1wc), regexp = NA) expect_equal(bfmwc$log_BF, bfm$log_BF, tolerance = 0.01) }) # bayesfactor_inclusion --------------------------------------------------- test_that("bayesfactor_inclusion | BayesFactor", { skip_if_not_or_load_if_installed("lme4") skip_if_not_or_load_if_installed("BayesFactor") set.seed(444) # BayesFactor ToothGrowth$dose <- as.factor(ToothGrowth$dose) BF_ToothGrowth <- BayesFactor::anovaBF(len ~ dose * supp, ToothGrowth) expect_equal( bayesfactor_inclusion(BF_ToothGrowth), bayesfactor_inclusion(bayesfactor_models(BF_ToothGrowth)) ) }) test_that("bayesfactor_inclusion | LMM", { skip_if_not_or_load_if_installed("lme4") skip_if_not_or_load_if_installed("BayesFactor") # with random effects in all models: expect_true(is.nan(bayesfactor_inclusion(BFM1)["1:Species", "log_BF"])) bfinc_all <- bayesfactor_inclusion(BFM4, match_models = FALSE) expect_equal(bfinc_all$p_prior, c(1, 0.8, 0.6, 0.4, 0.2), tolerance = 0.1) expect_equal(bfinc_all$p_posterior, c(1, 1, 0.12, 0.01, 0), tolerance = 0.1) expect_equal(bfinc_all$log_BF, c(NaN, 57.651, -2.352, -4.064, -4.788), tolerance = 0.1) # + match_models bfinc_matched <- bayesfactor_inclusion(BFM4, match_models = TRUE) expect_equal(bfinc_matched$p_prior, c(1, 0.2, 0.6, 0.2, 0.2), tolerance = 0.1) expect_equal(bfinc_matched$p_posterior, c(1, 0.875, 0.125, 0.009, 0.002), tolerance = 0.1) expect_equal(bfinc_matched$log_BF, c(NaN, 58.904, -3.045, -3.573, -1.493), tolerance = 0.1) }) bayestestR/tests/testthat/test-map_estimate.R0000644000176200001440000000263214410351152021150 0ustar liggesusers# numeric ---------------------- test_that("map_estimate", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") expect_equal( as.numeric(map_estimate(distribution_normal(1000))), 0, tolerance = 0.01 ) }) # stanreg ---------------------- test_that("map_estimate", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("stanreg_merMod_5") expect_equal( map_estimate(m, effects = "all")$Parameter, colnames(as.data.frame(m))[1:21] ) }) # brms ---------------------- test_that("map_estimate", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("BayesFactor") m <- insight::download_model("brms_zi_3") expect_equal( map_estimate(m, effects = "all", component = "all")$Parameter, c( "b_Intercept", "b_child", "b_camper", "r_persons[1,Intercept]", "r_persons[2,Intercept]", "r_persons[3,Intercept]", "r_persons[4,Intercept]", "sd_persons__Intercept", "b_zi_Intercept", "b_zi_child", "b_zi_camper", "r_persons__zi[1,Intercept]", "r_persons__zi[2,Intercept]", "r_persons__zi[3,Intercept]", "r_persons__zi[4,Intercept]", "sd_persons__zi_Intercept" ) ) m <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) expect_error(map_estimate(m)) }) bayestestR/tests/testthat/test-p_significance.R0000644000176200001440000000175314410351152021444 0ustar liggesuserstest_that("p_significance", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") # numeric set.seed(333) x <- distribution_normal(10000, 1, 1) ps <- p_significance(x) expect_equal(as.numeric(ps), 0.816, tolerance = 0.1) expect_equal(nrow(p_significance(data.frame(replicate(4, rnorm(100))))), 4) expect_s3_class(ps, "p_significance") expect_equal(tail(capture.output(print(ps)), 1), "Practical Significance (threshold: 0.10): 0.82") }) test_that("stanreg", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") m <- insight::download_model("stanreg_merMod_5") expect_equal( p_significance(m, effects = "all")$ps[1], 0.99, tolerance = 1e-2 ) }) test_that("brms", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") m2 <- insight::download_model("brms_1") expect_equal( p_significance(m2, effects = "all")$ps, c(1.0000, 0.9985, 0.9785), tolerance = 0.01 ) }) bayestestR/tests/testthat/test-overlap.R0000644000176200001440000000030514276606714020164 0ustar liggesuserstest_that("overlap", { set.seed(333) x <- distribution_normal(1000, 2, 0.5) y <- distribution_normal(1000, 0, 1) expect_equal(as.numeric(overlap(x, y)), 0.185, tolerance = 0.01) }) bayestestR/tests/testthat/test-brms.R0000644000176200001440000000715214410351152017445 0ustar liggesuserstest_that("brms", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("brms_mixed_1") expect_s3_class(hdi(model), "data.frame") expect_s3_class(ci(model), "data.frame") expect_s3_class(rope(model, verbose = FALSE), "data.frame") # expect_true("equivalence_test" %in% class(equivalence_test(model))) expect_s3_class(map_estimate(model), "data.frame") expect_s3_class(p_map(model), "data.frame") expect_s3_class(p_direction(model), "data.frame") expect_identical(colnames(hdi(model)), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component")) expect_identical(colnames(hdi(model, effects = "all")), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component")) # expect_equal(nrow(equivalence_test(model)), 2) out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean") suppressWarnings({ s <- summary(model) }) expect_identical(colnames(out), c( "Parameter", "Effects", "Component", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS" )) expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean[1:2], tolerance = 1e-3) expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat[1:2], tolerance = 1e-1) expect_equal(as.vector(s$random$cyl[, 1, drop = TRUE]), out$Mean[12], tolerance = 1e-3) expect_equal(as.vector(s$random$gear[, 1, drop = TRUE]), out$Mean[13:15], tolerance = 1e-3) }) test_that("brms", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("brms_1") out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean") s <- summary(model) expect_identical(colnames(out), c( "Parameter", "Component", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS" )) expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean[1:3], tolerance = 1e-3) expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat[1:3], tolerance = 1e-1) }) test_that("brms", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("brms_mv_2") out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean", test = NULL) s <- suppressWarnings(summary(model)) expect_identical(colnames(out), c( "Parameter", "Effects", "Component", "Mean", "CI", "CI_low", "CI_high", "Rhat", "ESS" )) known <- s$fixed unknown <- out[out$Effects == "fixed" & out$Component == "conditional", ] idx <- match(row.names(known), gsub("b_", "", unknown$Parameter, fixed = TRUE)) unknown <- unknown[idx, ] expect_equal(unknown$Mean, known$Estimate, ignore_attr = TRUE) expect_equal(unknown$Rhat, known$Rhat, tolerance = 1e-2, ignore_attr = TRUE) }) test_that("brms", { skip_on_cran() skip_if_offline() skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") set.seed(333) model <- insight::download_model("brms_2") out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean", test = NULL) s <- summary(model) expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean, tolerance = 1e-3) expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat, tolerance = 1e-1) }) bayestestR/tests/testthat/test-weighted_posteriors.R0000644000176200001440000000520114410351152022564 0ustar liggesuserstest_that("weighted_posteriors for BayesFactor", { skip_on_cran() skip_if_not_or_load_if_installed("BayesFactor") set.seed(123) # compute Bayes Factor for 31 different regression models null_den <- regressionBF( mpg ~ cyl + disp + hp + drat + wt, data = mtcars, progress = FALSE ) wBF <- weighted_posteriors(null_den) expect_s3_class(wBF, "data.frame") expect_equal( attr(wBF, "weights")$weights, c( 0, 13, 9, 0, 0, 55, 11, 4, 4, 1246, 6, 2, 38, 4, 946, 12, 3, 3, 209, 3, 491, 174, 4, 134, 7, 293, 1, 123, 35, 92, 51, 27 ) ) }) test_that("weighted_posteriors for BayesFactor (intercept)", { # fails for win old-release skip_on_ci() skip_on_cran() skip_if_not_or_load_if_installed("BayesFactor") set.seed(123) dat <- data.frame( x1 = rnorm(10), x2 = rnorm(10), y = rnorm(10) ) BFmods <- regressionBF(y ~ x1 + x2, data = dat, progress = FALSE) res <- weighted_posteriors(BFmods) expect_equal(attr(res, "weights")$weights, c(1032, 805, 1388, 775)) wHDI <- hdi(res[c("x1", "x2")], ci = 0.9) expect_equal(wHDI$CI_low, c(-0.519, -0.640), tolerance = 0.01) expect_equal(wHDI$CI_high, c(0.150, 0.059), tolerance = 0.01) }) test_that("weighted_posteriors for nonlinear BayesFactor", { skip_on_cran() skip_if_not_or_load_if_installed("BayesFactor") set.seed(123) data(sleep) BFS <- ttestBF( x = sleep$extra[sleep$group == 1], y = sleep$extra[sleep$group == 2], nullInterval = c(-Inf, 0), paired = TRUE ) res <- weighted_posteriors(BFS) expect_equal(attributes(res)$weights$weights, c(113, 3876, 11)) }) test_that("weighted_posteriors vs posterior_average", { skip("Test creates error, must check why...") skip_on_cran() skip_if_not_or_load_if_installed("BayesFactor") skip_if_not_or_load_if_installed("brms") fit1 <- brm(rating ~ treat + period + carry, data = inhaler, refresh = 0, silent = TRUE, save_pars = save_pars(all = TRUE) ) fit2 <- brm(rating ~ period + carry, data = inhaler, refresh = 0, silent = TRUE, save_pars = save_pars(all = TRUE) ) set.seed(444) expect_warning(res_BT <- weighted_posteriors(fit1, fit2)) set.seed(444) res_brms <- brms::posterior_average(fit1, fit2, weights = "bma", missing = 0) res_brms <- res_brms[, 1:4] res_BT1 <- eti(res_BT) res_brms1 <- eti(res_brms) expect_equal(res_BT1$Parameter, res_brms1$Parameter) expect_equal(res_BT1$CI, res_brms1$CI) expect_equal(res_BT1$CI_low, res_brms1$CI_low) expect_equal(res_BT1$CI_high, res_brms1$CI_high) }) bayestestR/tests/testthat/helper.R0000644000176200001440000000050414410351152016776 0ustar liggesusersskip_if_not_or_load_if_installed <- function(package, minimum_version = NULL) { testthat::skip_if_not_installed(package, minimum_version = minimum_version) suppressMessages(suppressWarnings(suppressPackageStartupMessages( require(package, warn.conflicts = FALSE, character.only = TRUE, quietly = TRUE) ))) } bayestestR/tests/testthat/test-posterior.R0000644000176200001440000001073214410351152020526 0ustar liggesuserstest_that("mp-posterior-draws", { skip_if_offline() skip_if_not_or_load_if_installed("posterior") skip_if_not_or_load_if_installed("brms") model <- insight::download_model("brms_1") x <- posterior::as_draws(model) mp <- describe_posterior(x) expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE) expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE) expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__")) expect_identical( colnames(mp), c( "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) ) }) test_that("mp-posterior-draws_list", { skip_if_offline() skip_if_not_or_load_if_installed("posterior") skip_if_not_or_load_if_installed("brms") model <- insight::download_model("brms_1") x <- posterior::as_draws_list(model) mp <- describe_posterior(x) expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE) expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE) expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__")) expect_identical( colnames(mp), c( "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) ) }) test_that("mp-posterior-draws_df", { skip_if_offline() skip_if_not_or_load_if_installed("posterior") skip_if_not_or_load_if_installed("brms") model <- insight::download_model("brms_1") x <- posterior::as_draws_df(model) mp <- describe_posterior(x) expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE) expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE) expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__")) expect_identical( colnames(mp), c( "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) ) }) test_that("mp-posterior-draws_matrix", { skip_if_offline() skip_if_not_or_load_if_installed("posterior") skip_if_not_or_load_if_installed("brms") model <- insight::download_model("brms_1") x <- posterior::as_draws_matrix(model) mp <- describe_posterior(x) expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE) expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE) expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__")) expect_identical( colnames(mp), c( "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) ) }) test_that("mp-posterior-draws_array", { skip_if_offline() skip_if_not_or_load_if_installed("posterior") skip_if_not_or_load_if_installed("brms") model <- insight::download_model("brms_1") x <- posterior::as_draws_array(model) mp <- describe_posterior(x) expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE) expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE) expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__")) expect_identical( colnames(mp), c( "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) ) }) test_that("mp-posterior-draws_rvar", { skip_if_offline() skip_if_not_or_load_if_installed("posterior") skip_if_not_or_load_if_installed("brms") model <- insight::download_model("brms_1") # Create random vectors by adding an additional dimension: n <- 4 # length of output vector set.seed(123) x <- rvar(array(rnorm(4000 * n, mean = rep(1:n, each = 4000), sd = 1), dim = c(4000, n))) mp <- describe_posterior(x) expect_equal(mp$Median, c(0.99503, 1.99242, 2.9899, 3.99362), tolerance = 1e-2, ignore_attr = TRUE) expect_identical(mp$Parameter, c("x[1]", "x[2]", "x[3]", "x[4]")) expect_identical( colnames(mp), c( "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage" ) ) }) bayestestR/tests/testthat/test-BFBayesFactor.R0000644000176200001440000000536014410351152021113 0ustar liggesuserstest_that("p_direction", { skip_if_not_or_load_if_installed("BayesFactor") set.seed(333) x <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) expect_equal(as.numeric(p_direction(x)), 0.9225, tolerance = 1) }) test_that("p_direction: BF t.test one sample", { skip_if_not_or_load_if_installed("BayesFactor") data(sleep) diffScores <- sleep$extra[1:10] - sleep$extra[11:20] x <- ttestBF(x = diffScores) expect_equal(as.numeric(p_direction(x)), 0.99675, tolerance = 1) }) test_that("p_direction: BF t.test two samples", { skip_if_not_or_load_if_installed("BayesFactor") data(chickwts) chickwts <- chickwts[chickwts$feed %in% c("horsebean", "linseed"), ] chickwts$feed <- factor(chickwts$feed) x <- ttestBF(formula = weight ~ feed, data = chickwts) expect_equal(as.numeric(p_direction(x)), 1, tolerance = 1) }) test_that("p_direction: BF t.test meta-analytic", { skip_if_not_or_load_if_installed("BayesFactor") t <- c(-.15, 2.39, 2.42, 2.43) N <- c(100, 150, 97, 99) x <- meta.ttestBF(t = t, n1 = N, rscale = 1) expect_equal(as.numeric(p_direction(x)), 0.99975, tolerance = 1) }) # # --------------------------- # # "BF ANOVA" # data(ToothGrowth) # ToothGrowth$dose <- factor(ToothGrowth$dose) # levels(ToothGrowth$dose) <- c("Low", "Medium", "High") # x <- BayesFactor::anovaBF(len ~ supp*dose, data=ToothGrowth) # test_that("p_direction", { # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1) # }) # # # --------------------------- # # "BF ANOVA Random" # data(puzzles) # x <- BayesFactor::anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID") # test_that("p_direction", { # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1) # }) # # # # --------------------------- # # "BF lm" # x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth) # test_that("p_direction", { # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1) # }) # # # x2 <- BayesFactor::lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth) # x <- x / x2 # test_that("p_direction", { # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1) # }) test_that("rope_range", { skip_if_not_or_load_if_installed("BayesFactor") x <- lmBF(len ~ supp + dose, data = ToothGrowth) expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10) x <- ttestBF( ToothGrowth$len[ToothGrowth$supp == "OJ"], ToothGrowth$len[ToothGrowth$supp == "VC"] ) expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10) x <- ttestBF(formula = len ~ supp, data = ToothGrowth) expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10) # else x <- correlationBF(ToothGrowth$len, ToothGrowth$dose) expect_equal(rope_range(x, verbose = FALSE), c(-0.05, 0.05)) }) bayestestR/tests/testthat/test-point_estimate.R0000644000176200001440000000157614410351152021532 0ustar liggesuserstest_that("point_estimate: stanreg", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( point_estimate(m, effects = "all")$Median, point_estimate(p)$Median, tolerance = 1e-3 ) }) test_that("point_estimate: brms", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") skip_if_not_or_load_if_installed("httr") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( point_estimate(m, effects = "all", component = "all")$Median, point_estimate(p)$Median, tolerance = 1e-3 ) }) bayestestR/tests/testthat/test-rope.R0000644000176200001440000000773214410351152017453 0ustar liggesuserstest_that("rope", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") expect_equal(as.numeric(rope(distribution_normal(1000, 0, 1), verbose = FALSE)), 0.084, tolerance = 0.01) expect_equal(equivalence_test(distribution_normal(1000, 0, 1))$ROPE_Equivalence, "Undecided") expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000))))), 9) expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000), ci = c(0.8, 0.9) )))), 14) expect_equal(as.numeric(rope(distribution_normal(1000, 2, 0.01), verbose = FALSE)), 0, tolerance = 0.01) expect_equal(equivalence_test(distribution_normal(1000, 2, 0.01))$ROPE_Equivalence, "Rejected") expect_equal(as.numeric(rope(distribution_normal(1000, 0, 0.001), verbose = FALSE)), 1, tolerance = 0.01) expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001))$ROPE_Equivalence, "Accepted") expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001), ci = 1)$ROPE_Equivalence, "Accepted") # print(rope(rnorm(1000, mean = 0, sd = 3), ci = .5)) expect_equal(rope(rnorm(1000, mean = 0, sd = 3), ci = c(.1, .5, .9), verbose = FALSE)$CI, c(.1, .5, .9)) x <- equivalence_test(distribution_normal(1000, 1, 1), ci = c(.50, .99)) expect_equal(x$ROPE_Percentage[2], 0.0484, tolerance = 0.01) expect_equal(x$ROPE_Equivalence[2], "Undecided") expect_error(rope(distribution_normal(1000, 0, 1), range = c(0.0, 0.1, 0.2))) set.seed(333) expect_s3_class(rope(distribution_normal(1000, 0, 1), verbose = FALSE), "rope") expect_error(rope(distribution_normal(1000, 0, 1), range = c("A", 0.1))) expect_equal( as.numeric(rope(distribution_normal(1000, 0, 1), range = c(-0.1, 0.1) )), 0.084, tolerance = 0.01 ) }) test_that("rope", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( # fix range to -.1/.1, to compare to data frame method rope(m, range = c(-.1, .1), effects = "all", verbose = FALSE)$ROPE_Percentage, rope(p, verbose = FALSE)$ROPE_Percentage, tolerance = 1e-3 ) }) test_that("rope", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("brms") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( rope(m, effects = "all", component = "all", verbose = FALSE)$ROPE_Percentage, rope(p, verbose = FALSE)$ROPE_Percentage, tolerance = 1e-3 ) }) # if ( skip_if_not_or_load_if_installed("brms")) { # set.seed(123) # model <- brm(mpg ~ wt + gear, data = mtcars, iter = 500) # rope <- rope(model, verbose = FALSE) # # test_that("rope (brms)", { # expect_equal(rope$ROPE_high, -rope$ROPE_low, tolerance = 0.01) # expect_equal(rope$ROPE_high[1], 0.6026948) # expect_equal(rope$ROPE_Percentage, c(0.00, 0.00, 0.50), tolerance = 0.1) # }) # # model <- brm(mvbind(mpg, disp) ~ wt + gear, data = mtcars, iter = 500) # rope <- rope(model, verbose = FALSE) # # test_that("rope (brms, multivariate)", { # expect_equal(rope$ROPE_high, -rope$ROPE_low, tolerance = 0.01) # expect_equal(rope$ROPE_high[1], 0.6026948, tolerance = 0.01) # expect_equal(rope$ROPE_high[4], 12.3938694, tolerance = 0.01) # expect_equal( # rope$ROPE_Percentage, # c(0, 0, 0.493457, 0.072897, 0, 0.508411), # tolerance = 0.1 # ) # }) # } test_that("BayesFactor", { skip_if_not_or_load_if_installed("BayesFactor") mods <- regressionBF(mpg ~ am + cyl, mtcars, progress = FALSE) rx <- suppressMessages(rope(mods, verbose = FALSE)) expect_equal(rx$ROPE_high, -rx$ROPE_low, tolerance = 0.01) expect_equal(rx$ROPE_high[1], 0.6026948, tolerance = 0.01) }) bayestestR/tests/testthat/test-bayesfactor_restricted.R0000644000176200001440000000312114357655465023254 0ustar liggesusers# bayesfactor_restricted data.frame --------------------------------------- test_that("bayesfactor_restricted df", { prior <- data.frame( X = distribution_normal(100), X1 = c(distribution_normal(50), distribution_normal(50)), X3 = c(distribution_normal(80), distribution_normal(20)) ) posterior <- data.frame( X = distribution_normal(100, .4, .2), X1 = distribution_normal(100, -.2, .2), X3 = distribution_normal(100, .2) ) hyps <- c( "X > X1 & X1 > X3", "X > X1" ) bfr <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior) expect_equal(bfr$p_prior, c(0.2, 0.5), tolerance = 0.1) expect_equal(bfr$p_posterior, c(0.31, 1), tolerance = 0.1) expect_equal(bfr$log_BF, c(0.43, 0.69), tolerance = 0.1) expect_equal(exp(bfr$log_BF), bfr$p_posterior / bfr$p_prior, tolerance = 0.1) expect_error(bayesfactor_restricted(posterior, prior, hypothesis = "Y < 0")) }) # bayesfactor_restricted RSTANARM ----------------------------------------- test_that("bayesfactor_restricted RSTANARM", { skip_on_cran() skip_if_not_installed("rstanarm") suppressWarnings( fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am, data = mtcars, refresh = 0, iter = 200) ) hyps <- c( "am > 0 & cyl < 0", "cyl < 0", "wt - cyl > 0" ) set.seed(444) fit_p <- suppressMessages(unupdate(fit_stan)) bfr1 <- bayesfactor_restricted(fit_stan, prior = fit_p, hypothesis = hyps) set.seed(444) bfr2 <- bayesfactor_restricted(fit_stan, hypothesis = hyps) expect_equal(bfr1, bfr2) }) bayestestR/tests/testthat/test-ci.R0000644000176200001440000000356214410351152017076 0ustar liggesuserstest_that("ci", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("brms") expect_equal(ci(distribution_normal(1000), ci = .90)$CI_low[1], -1.6361, tolerance = 0.02) expect_equal(nrow(ci(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01) expect_equal(ci(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02) # expect_equal(length(capture.output(print(ci(distribution_normal(1000)))))) # expect_equal(length(capture.output(print(ci(distribution_normal(1000), ci = c(.80, .90)))))) expect_equal(ci(c(2, 3, NA))$CI_low, 2.02, tolerance = 1e-2) expect_warning(ci(c(2, 3))) expect_warning(ci(distribution_normal(1000), ci = 950)) x <- data.frame(replicate(4, rnorm(100))) x <- ci(x, ci = c(0.68, 0.89, 0.95)) a <- datawizard::reshape_ci(x) expect_equal(c(nrow(x), ncol(x)), c(12, 4)) expect_true(all(datawizard::reshape_ci(a) == x)) }) test_that("ci", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("brms") m <- insight::download_model("stanreg_merMod_5") p <- insight::get_parameters(m, effects = "all") expect_equal( ci(m, ci = c(0.5, 0.8), effects = "all")$CI_low, ci(p, ci = c(0.5, 0.8))$CI_low, tolerance = 1e-3 ) }) test_that("rope", { skip_if_offline() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("httr") skip_if_not_or_load_if_installed("brms") m <- insight::download_model("brms_zi_3") p <- insight::get_parameters(m, effects = "all", component = "all") expect_equal( ci(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, ci(p, ci = c(0.5, 0.8))$CI_low, tolerance = 1e-3 ) }) bayestestR/tests/testthat/test-emmGrid.R0000644000176200001440000001521514413523767020105 0ustar liggesusers# TODO: decide how to rearrange the tests skip_on_ci() skip_if_not_or_load_if_installed("rstanarm") skip_if_not_or_load_if_installed("emmeans") set.seed(300) model <- stan_glm(extra ~ group, data = sleep, refresh = 0, chains = 6, iter = 7000, warmup = 200 ) em_ <- emmeans(model, ~group) c_ <- pairs(em_) emc_ <- emmeans(model, pairwise ~ group) all_ <- rbind(em_, c_) all_summ <- summary(all_) set.seed(4) model_p <- unupdate(model, verbose = FALSE) set.seed(300) # estimate + hdi ---------------------------------------------------------- test_that("emmGrid hdi", { xhdi <- hdi(all_, ci = 0.95) expect_equal(xhdi$CI_low, all_summ$lower.HPD, tolerance = 0.1) expect_equal(xhdi$CI_high, all_summ$upper.HPD, tolerance = 0.1) xhdi2 <- hdi(emc_, ci = 0.95) expect_equal(xhdi$CI_low, xhdi2$CI_low) }) test_that("emmGrid point_estimate", { xpest <- point_estimate(all_, centrality = "all", dispersion = TRUE) expect_equal(xpest$Median, all_summ$emmean, tolerance = 0.1) xpest2 <- point_estimate(emc_, centrality = "all", dispersion = TRUE) expect_equal(xpest$Median, xpest2$Median) }) # Basics ------------------------------------------------------------------ test_that("emmGrid ci", { xci <- ci(all_, ci = 0.9) expect_equal(length(xci$CI_low), 3) expect_equal(length(xci$CI_high), 3) }) test_that("emmGrid eti", { xeti <- eti(all_, ci = 0.9) expect_equal(length(xeti$CI_low), 3) expect_equal(length(xeti$CI_high), 3) }) test_that("emmGrid equivalence_test", { xeqtest <- equivalence_test(all_, ci = 0.9, range = c(-0.1, 0.1)) expect_equal(length(xeqtest$ROPE_Percentage), 3) expect_equal(length(xeqtest$ROPE_Equivalence), 3) }) test_that("emmGrid estimate_density", { xestden <- estimate_density(c_, method = "logspline", precision = 5) expect_equal(length(xestden$x), 5) }) test_that("emmGrid map_estimate", { xmapest <- map_estimate(all_, method = "kernel") expect_equal(length(xmapest$MAP_Estimate), 3) }) test_that("emmGrid p_direction", { xpd <- p_direction(all_, method = "direct") expect_equal(length(xpd$pd), 3) }) test_that("emmGrid p_map", { xpmap <- p_map(all_, precision = 2^9) expect_equal(length(xpmap$p_MAP), 3) }) test_that("emmGrid p_rope", { xprope <- p_rope(all_, range = c(-0.1, 0.1)) expect_equal(length(xprope$p_ROPE), 3) }) test_that("emmGrid p_significance", { xsig <- p_significance(all_, threshold = c(-0.1, 0.1)) expect_equal(length(xsig$ps), 3) }) test_that("emmGrid rope", { xrope <- rope(all_, range = "default", ci = .9) expect_equal(length(xrope$ROPE_Percentage), 3) }) # describe_posterior ------------------------------------------------------ test_that("emmGrid describe_posterior", { expect_equal( describe_posterior(all_)$median, describe_posterior(emc_)$median ) skip_on_cran() expect_equal( describe_posterior(all_, bf_prior = model_p, test = "bf")$log_BF, describe_posterior(emc_, bf_prior = model_p, test = "bf")$log_BF ) }) # BFs --------------------------------------------------------------------- test_that("emmGrid bayesfactor_parameters", { skip_on_cran() set.seed(4) expect_equal( bayesfactor_parameters(all_, prior = model, verbose = FALSE), bayesfactor_parameters(all_, prior = model_p, verbose = FALSE), tolerance = 0.001 ) emc_p <- emmeans(model_p, pairwise ~ group) xbfp <- bayesfactor_parameters(all_, prior = model_p, verbose = FALSE) xbfp2 <- bayesfactor_parameters(emc_, prior = model_p, verbose = FALSE) xbfp3 <- bayesfactor_parameters(emc_, prior = emc_p, verbose = FALSE) expect_equal(xbfp$log_BF, xbfp2$log_BF, tolerance = 0.1) expect_equal(xbfp$log_BF, xbfp3$log_BF, tolerance = 0.1) expect_warning( suppressMessages( bayesfactor_parameters(all_) ), regexp = "Prior not specified" ) # error - cannot deal with regrid / transform e <- capture_error(suppressMessages(bayesfactor_parameters(regrid(all_), prior = model))) expect_match(as.character(e), "Unable to reconstruct prior estimates") }) test_that("emmGrid bayesfactor_restricted", { skip_on_cran() set.seed(4) hyps <- c("`1` < `2`", "`1` < 0") xrbf <- bayesfactor_restricted(em_, prior = model_p, hypothesis = hyps) expect_equal(length(xrbf$log_BF), 2) expect_equal(length(xrbf$p_prior), 2) expect_equal(length(xrbf$p_posterior), 2) expect_warning(bayesfactor_restricted(em_, hypothesis = hyps)) xrbf2 <- bayesfactor_restricted(emc_, prior = model_p, hypothesis = hyps) expect_equal(xrbf, xrbf2, tolerance = 0.1) }) test_that("emmGrid si", { skip_on_cran() set.seed(4) xrsi <- si(all_, prior = model_p, verbose = FALSE) expect_equal(length(xrsi$CI_low), 3) expect_equal(length(xrsi$CI_high), 3) xrsi2 <- si(emc_, prior = model_p, verbose = FALSE) expect_equal(xrsi$CI_low, xrsi2$CI_low) expect_equal(xrsi$CI_high, xrsi2$CI_high) }) # For non linear models --------------------------------------------------- set.seed(333) df <- data.frame( G = rep(letters[1:3], each = 2), Y = rexp(6) ) fit_bayes <- stan_glm(Y ~ G, data = df, family = Gamma(link = "identity"), refresh = 0 ) fit_bayes_prior <- unupdate(fit_bayes, verbose = FALSE) bayes_sum <- emmeans(fit_bayes, ~G) bayes_sum_prior <- emmeans(fit_bayes_prior, ~G) test_that("emmGrid bayesfactor_parameters", { set.seed(333) skip_on_cran() xsdbf1 <- bayesfactor_parameters(bayes_sum, prior = fit_bayes, verbose = FALSE) xsdbf2 <- bayesfactor_parameters(bayes_sum, prior = bayes_sum_prior, verbose = FALSE) expect_equal(xsdbf1$log_BF, xsdbf2$log_BF, tolerance = 0.1) }) # link vs response test_that("emmGrid bayesfactor_parameters / describe w/ nonlinear models", { skip_on_cran() model <- stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0 ) probs <- emmeans(model, "mpg", type = "resp") link <- emmeans(model, "mpg") probs_summ <- summary(probs) link_summ <- summary(link) xhdi <- hdi(probs, ci = 0.95) xpest <- point_estimate(probs, centrality = "median", dispersion = TRUE) expect_equal(xhdi$CI_low, probs_summ$lower.HPD, tolerance = 0.1) expect_equal(xhdi$CI_high, probs_summ$upper.HPD, tolerance = 0.1) expect_equal(xpest$Median, probs_summ$prob, tolerance = 0.1) xhdi <- hdi(link, ci = 0.95) xpest <- point_estimate(link, centrality = "median", dispersion = TRUE) expect_equal(xhdi$CI_low, link_summ$lower.HPD, tolerance = 0.1) expect_equal(xhdi$CI_high, link_summ$upper.HPD, tolerance = 0.1) expect_equal(xpest$Median, link_summ$emmean, tolerance = 0.1) }) bayestestR/tests/testthat.R0000644000176200001440000000010414410351152015513 0ustar liggesuserslibrary(testthat) library(bayestestR) test_check("bayestestR") bayestestR/vignettes/0000755000176200001440000000000014413525307014413 5ustar liggesusersbayestestR/vignettes/overview_of_vignettes.Rmd0000644000176200001440000000410014276606714021505 0ustar liggesusers--- title: "Overview of Vignettes" output: rmarkdown::html_vignette: vignette: > %\VignetteIndexEntry{Overview of Vignettes} \usepackage[utf8]{inputenc} %\VignetteEngine{knitr::rmarkdown} editor_options: chunk_output_type: console --- ```{r message=FALSE, warning=FALSE, include=FALSE} library(knitr) knitr::opts_chunk$set( echo = TRUE, collapse = TRUE, warning = FALSE, message = FALSE, comment = "#>", eval = TRUE ) ``` All package vignettes are available at [https://easystats.github.io/bayestestR/](https://easystats.github.io/bayestestR/). ## Function Overview * [Function Reference](https://easystats.github.io/bayestestR/reference/index.html) ## Get Started * [Get Started with Bayesian Analysis](https://easystats.github.io/bayestestR/articles/bayestestR.html) ## Examples 1. [Initiation to Bayesian models](https://easystats.github.io/bayestestR/articles/example1.html) 2. [Confirmation of Bayesian skills](https://easystats.github.io/bayestestR/articles/example2.html) 3. [Become a Bayesian master](https://easystats.github.io/bayestestR/articles/example3.html) ## Articles * [Credible Intervals (CI))](https://easystats.github.io/bayestestR/articles/credible_interval.html) * [Region of Practical Equivalence (ROPE)](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html) * [Probability of Direction (pd)](https://easystats.github.io/bayestestR/articles/probability_of_direction.html) * [Bayes Factors](https://easystats.github.io/bayestestR/articles/bayes_factors.html) ## In-Depths * [Comparison of Point-Estimates](https://easystats.github.io/bayestestR/articles/web_only/indicesEstimationComparison.html) * [Indices of Effect Existence and Significance in the Bayesian Framework](https://www.frontiersin.org/articles/10.3389/fpsyg.2019.02767/full) * [Mediation Analysis using Bayesian Regression Models](https://easystats.github.io/bayestestR/articles/mediation.html) ## Guidelines * [Reporting Guidelines](https://easystats.github.io/bayestestR/articles/guidelines.html) bayestestR/R/0000755000176200001440000000000014413525307012604 5ustar liggesusersbayestestR/R/p_significance.R0000644000176200001440000002335714407021360015673 0ustar liggesusers#' Practical Significance (ps) #' #' Compute the probability of **Practical Significance** (***ps***), which can be conceptualized as a unidirectional equivalence test. It returns the probability that effect is above a given threshold corresponding to a negligible effect in the median's direction. Mathematically, it is defined as the proportion of the posterior distribution of the median sign above the threshold. #' #' @inheritParams rope #' @param threshold The threshold value that separates significant from negligible effect. If `"default"`, the range is set to `0.1` if input is a vector, and based on [`rope_range()`][rope_range] if a Bayesian model is provided. #' #' @return Values between 0 and 1 corresponding to the probability of practical significance (ps). #' #' @details `p_significance()` returns the proportion of a probability #' distribution (`x`) that is outside a certain range (the negligible #' effect, or ROPE, see argument `threshold`). If there are values of the #' distribution both below and above the ROPE, `p_significance()` returns #' the higher probability of a value being outside the ROPE. Typically, this #' value should be larger than 0.5 to indicate practical significance. However, #' if the range of the negligible effect is rather large compared to the #' range of the probability distribution `x`, `p_significance()` #' will be less than 0.5, which indicates no clear practical significance. #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @examples #' library(bayestestR) #' #' # Simulate a posterior distribution of mean 1 and SD 1 #' # ---------------------------------------------------- #' posterior <- rnorm(1000, mean = 1, sd = 1) #' p_significance(posterior) #' #' # Simulate a dataframe of posterior distributions #' # ----------------------------------------------- #' df <- data.frame(replicate(4, rnorm(100))) #' p_significance(df) #' \dontrun{ #' # rstanarm models #' # ----------------------------------------------- #' if (require("rstanarm")) { #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, #' data = mtcars, #' chains = 2, refresh = 0 #' ) #' p_significance(model) #' } #' } #' @export p_significance <- function(x, ...) { UseMethod("p_significance") } #' @export p_significance.default <- function(x, ...) { insight::format_error( paste0("'p_significance()' is not yet implemented for objects of class '", class(x)[1], "'.") ) } #' @rdname p_significance #' @export p_significance.numeric <- function(x, threshold = "default", ...) { threshold <- .select_threshold_ps(threshold = threshold) psig <- max( c( length(x[x > abs(threshold)]) / length(x), # ps positive length(x[x < -abs(threshold)]) / length(x) # ps negative ) ) attr(psig, "threshold") <- threshold attr(psig, "data") <- x class(psig) <- unique(c("p_significance", "see_p_significance", class(psig))) psig } #' @export p_significance.data.frame <- function(x, threshold = "default", ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) threshold <- .select_threshold_ps(threshold = threshold) x <- .select_nums(x) if (ncol(x) == 1) { ps <- p_significance(x[, 1], threshold = threshold, ...) } else { ps <- sapply(x, p_significance, threshold = threshold, simplify = TRUE, ...) } out <- data.frame( "Parameter" = names(x), "ps" = as.numeric(ps), row.names = NULL, stringsAsFactors = FALSE ) attr(out, "threshold") <- threshold attr(out, "object_name") <- obj_name class(out) <- unique(c("p_significance", "see_p_significance", class(out))) out } #' @export p_significance.draws <- function(x, threshold = "default", ...) { p_significance(.posterior_draws_to_df(x), threshold = threshold, ...) } #' @export p_significance.rvar <- p_significance.draws #' @export p_significance.parameters_simulate_model <- function(x, threshold = "default", ...) { obj_name <- attr(x, "object_name") if (!is.null(obj_name)) { # first try, parent frame model <- .safe(get(obj_name, envir = parent.frame())) if (is.null(model)) { # second try, global env model <- .safe(get(obj_name, envir = globalenv())) } } threshold <- .select_threshold_ps(model = model, threshold = threshold) out <- p_significance.data.frame(x, threshold = threshold) attr(out, "object_name") <- obj_name out } #' @export p_significance.MCMCglmm <- function(x, threshold = "default", ...) { nF <- x$Fixed$nfl out <- p_significance(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), threshold = threshold, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_significance.BFBayesFactor <- function(x, threshold = "default", ...) { out <- p_significance(insight::get_parameters(x), threshold = threshold, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_significance.mcmc <- function(x, threshold = "default", ...) { p_significance(as.data.frame(x), threshold = threshold, ...) } #' @export p_significance.bamlss <- function(x, threshold = "default", component = c("all", "conditional", "location"), ...) { out <- p_significance(insight::get_parameters(x, component = component), threshold = threshold, ...) out <- .add_clean_parameters_attribute(out, x) out } #' @export p_significance.bcplm <- function(x, threshold = "default", ...) { p_significance(insight::get_parameters(x), threshold = threshold, ...) } #' @export p_significance.mcmc.list <- p_significance.bcplm #' @export p_significance.bayesQR <- p_significance.bcplm #' @export p_significance.blrm <- p_significance.bcplm #' @export p_significance.BGGM <- p_significance.bcplm #' @export p_significance.emmGrid <- function(x, threshold = "default", ...) { xdf <- insight::get_parameters(x) out <- p_significance(xdf, threshold = threshold, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_significance.emm_list <- p_significance.emmGrid #' @rdname p_significance #' @export p_significance.stanreg <- function(x, threshold = "default", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) threshold <- .select_threshold_ps(model = x, threshold = threshold, verbose = verbose) data <- p_significance( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), threshold = threshold ) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output(data, cleaned_parameters, inherits(x, "stanmvreg")) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "threshold") <- threshold attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- class(data) out } #' @export p_significance.stanfit <- p_significance.stanreg #' @export p_significance.blavaan <- p_significance.stanreg #' @rdname p_significance #' @export p_significance.brmsfit <- function(x, threshold = "default", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) threshold <- .select_threshold_ps(model = x, threshold = threshold, verbose = verbose) data <- p_significance( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), threshold = threshold ) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output(data, cleaned_parameters) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "threshold") <- threshold attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- class(data) out } # methods --------------------------- #' @rdname as.numeric.p_direction #' @export as.numeric.p_significance <- function(x, ...) { if (inherits(x, "data.frame")) { return(as.numeric(as.vector(x$ps))) } else { return(as.vector(x)) } } #' @method as.double p_significance #' @export as.double.p_significance <- as.numeric.p_significance # helpers -------------------------- #' @keywords internal .select_threshold_ps <- function(model = NULL, threshold = "default", verbose = TRUE) { # If a range is passed if (length(threshold) > 1) { if (length(unique(abs(threshold))) == 1) { # If symmetric range threshold <- abs(threshold[2]) } else { insight::format_error("`threshold` should be 'default' or a numeric value (e.g., 0.1).") } } # If default if (all(threshold == "default")) { if (!is.null(model)) { threshold <- rope_range(model, verbose = verbose)[2] } else { threshold <- 0.1 } } else if (!all(is.numeric(threshold))) { insight::format_error("`threshold` should be 'default' or a numeric value (e.g., 0.1).") } threshold } bayestestR/R/print.R0000644000176200001440000001564014407021360014062 0ustar liggesusers#' @export print.describe_posterior <- function(x, digits = 2, caption = "Summary of Posterior Distribution", ...) { .print_default( x = x, digits = digits, caption = caption, ... ) } #' @export print.point_estimate <- function(x, digits = 2, caption = "Point Estimate", ...) { .print_default( x = x, digits = digits, caption = caption, ... ) } #' @export print.p_direction <- function(x, digits = 2, caption = "Probability of Direction", ...) { .print_default( x = x, digits = digits, caption = caption, ... ) } #' @export print.p_map <- function(x, digits = 2, caption = "MAP-based p-value", ...) { .print_default( x = x, digits = digits, caption = caption, ... ) } #' @export print.map_estimate <- function(x, digits = 2, caption = "MAP Estimate", ...) { .print_default( x = x, digits = digits, caption = caption, ... ) } #' @export print.p_rope <- function(x, digits = 2, ...) { caption <- sprintf( "Proportion of samples inside the ROPE [%.*f, %.*f]", digits, x$ROPE_low[1], digits, x$ROPE_high[1] ) x$ROPE_low <- x$ROPE_high <- NULL .print_default( x = x, digits = digits, caption = caption, ci_string = "ROPE", ... ) } #' @export print.p_significance <- function(x, digits = 2, ...) { caption <- sprintf( "Practical Significance (threshold: %s)", insight::format_value(attributes(x)$threshold, digits = digits) ) .print_default( x = x, digits = digits, caption = caption, ... ) } #' @export print.bayestestR_hdi <- function(x, digits = 2, caption = "Highest Density Interval", ...) { ci_string <- "HDI" if (inherits(x, "bayestestR_spi")) { caption <- "Shortest Probability Interval" ci_string <- "SPI" } .print_default( x = x, digits = digits, caption = caption, ci_string = ci_string, ... ) } #' @export print.bayestestR_eti <- function(x, digits = 2, caption = "Equal-Tailed Interval", ...) { .print_default( x = x, digits = digits, caption = caption, ci_string = "ETI", ... ) } #' @export print.bayestestR_si <- function(x, digits = 2, caption = "Support Interval", ...) { .print_default( x = x, digits = digits, caption = caption, ci_string = "SI", ... ) } # special handling for bayes factors ------------------ #' @export print.bayesfactor_models <- function(x, digits = 3, log = FALSE, show_names = TRUE, caption = "Bayes Factors for Model Comparison", ...) { show_names <- show_names & !attr(x, "unsupported_models") .print_bf_default( x = x, digits = digits, log = log, show_names = show_names, caption = caption, align = "llr", ... ) } #' @export print.bayesfactor_inclusion <- function(x, digits = 3, log = FALSE, caption = "Inclusion Bayes Factors (Model Averaged)", ...) { .print_bf_default( x = x, digits = digits, log = log, caption = caption, ... ) } #' @export print.bayesfactor_restricted <- function(x, digits = 3, log = FALSE, caption = "Bayes Factor (Order-Restriction)", ...) { .print_bf_default( x = x, digits = digits, log = log, caption = caption, ... ) } #' @export print.bayesfactor_parameters <- function(x, digits = 3, log = FALSE, ...) { # retrieve information with cleaned parameter names cp <- attr(x, "clean_parameters") # format data frame and columns formatted_table <- format( x, cp = cp, digits = digits, log = log, format = "text", ... ) cat(insight::export_table(formatted_table, format = "text")) invisible(x) } # util --------------------- .print_default <- function(x, digits = 2, caption = NULL, subtitles = NULL, ci_string = "CI", ...) { # retrieve information with cleaned parameter names cp <- attr(x, "clean_parameters") # format data frame and columns formatted_table <- format( x, cp = cp, digits = digits, format = "text", ci_string = ci_string, caption = caption, subtitles = subtitles, ... ) # check if we have a 1x1 data frame (i.e. a numeric input) if (is.data.frame(formatted_table) && nrow(formatted_table) == 1 && ncol(formatted_table) == 1) { # print for numeric caption <- attr(formatted_table, "table_caption") # if we have no useful column name and a caption, use caption if (!is.null(caption) && !endsWith(colnames(formatted_table), ci_string)) { cat(paste0(caption, ": ")) } else { cat(paste0(colnames(formatted_table), ": ")) } cat(formatted_table[1, 1]) } else { # print for data frame cat(insight::export_table( formatted_table, caption = caption )) } invisible(x) } .print_bf_default <- function(x, digits = 3, log = FALSE, caption = NULL, align = NULL, ...) { # format data frame and columns formatted_table <- format( x, digits = digits, log = log, format = "text", caption = caption, ... # pass show_names ) cat(insight::export_table( formatted_table, sep = " ", header = NULL, format = "text", align = align, )) invisible(x) } bayestestR/R/print.rope.R0000644000176200001440000000547414311464510015034 0ustar liggesusers#' @export print.rope <- function(x, digits = 2, ...) { orig_x <- x # If the model is multivariate, we have have different ROPES depending on # the outcome variable. is_multivariate <- length(unique(x$Response)) > 1 if (isTRUE(is_multivariate)) { insight::print_color(sprintf( "# Proportion%s of samples inside the ROPE.\nROPE with depends on outcome variable.\n\n", ifelse(all(x$CI[1] == x$CI), "", "s") ), "blue") } else { insight::print_color(sprintf( "# Proportion%s of samples inside the ROPE [%.*f, %.*f]:\n\n", ifelse(all(x$CI[1] == x$CI), "", "s"), digits, x$ROPE_low[1], digits, x$ROPE_high[1] ), "blue") } # I think this is something nobody will understand and we'll probably forget # why we did this, so I'll comment a bit... # These are the base columns we want to print cols <- c( "Parameter", "ROPE_Percentage", "Effects", "Component", if (is_multivariate) c("ROPE_low", "ROPE_high") ) # In case we have ropes for different CIs, we also want this information # So we first check if values in the CI column differ, and if so, we also # keep this column for printing if (!all(x$CI[1] == x$CI)) { cols <- c("CI", cols) } # Either way, we need to know the different CI-values, so we can # split the data frame for printing later... ci <- unique(x$CI) # now we check which of the requested columns are actually in our data frame "x" # "x" may differ, depending on if "rope()" was called with a model-object, # or with a simple vector. So we can't hard-code this x <- subset(x, select = intersect(cols, colnames(x))) # This is just cosmetics, to have nicer column names and values x$ROPE_Percentage <- sprintf("%.*f %%", digits, x$ROPE_Percentage * 100) colnames(x)[which(colnames(x) == "ROPE_Percentage")] <- "inside ROPE" # Add ROPE width for multivariate models if (isTRUE(is_multivariate)) { # This is just cosmetics, to have nicer column names and values x$ROPE_low <- sprintf("[%.*f, %.*f]", digits, x$ROPE_low, digits, x$ROPE_high) colnames(x)[which(colnames(x) == "ROPE_low")] <- "ROPE width" x$ROPE_high <- NULL } # In case we have multiple CI values, we create a subset for each CI value. # Else, parameter-rows would be mixed up with both CIs, which is a bit # more difficult to read... if (length(ci) == 1) { # print complete data frame, because we have no different CI values here .print_data_frame(x, digits = digits) } else { for (i in ci) { xsub <- x[x$CI == i, -which(colnames(x) == "CI"), drop = FALSE] insight::print_color(sprintf("ROPE for the %s%% HDI:\n\n", 100 * i), "cyan") .print_data_frame(xsub, digits = digits) cat("\n") } } invisible(orig_x) } bayestestR/R/diagnostic_posterior.R0000644000176200001440000002725014407021360017160 0ustar liggesusers#' Posteriors Sampling Diagnostic #' #' Extract diagnostic metrics (Effective Sample Size (`ESS`), `Rhat` and Monte #' Carlo Standard Error `MCSE`). #' #' @param posteriors A `stanreg`, `stanfit`, `brmsfit`, or `blavaan` object. #' @param diagnostic Diagnostic metrics to compute. Character (vector) or list #' with one or more of these options: `"ESS"`, `"Rhat"`, `"MCSE"` or `"all"`. #' #' @details #' **Effective Sample (ESS)** should be as large as possible, although for #' most applications, an effective sample size greater than 1000 is sufficient #' for stable estimates (Bürkner, 2017). The ESS corresponds to the number of #' independent samples with the same estimation power as the N autocorrelated #' samples. It is is a measure of \dQuote{how much independent information #' there is in autocorrelated chains} (\cite{Kruschke 2015, p182-3}). #' \cr \cr #' **Rhat** should be the closest to 1. It should not be larger than 1.1 #' (\cite{Gelman and Rubin, 1992}) or 1.01 (\cite{Vehtari et al., 2019}). The #' split Rhat statistic quantifies the consistency of an ensemble of Markov #' chains. #' \cr \cr #' **Monte Carlo Standard Error (MCSE)** is another measure of accuracy of the #' chains. It is defined as standard deviation of the chains divided by their #' effective sample size (the formula for `mcse()` is from Kruschke 2015, p. #' 187). The MCSE \dQuote{provides a quantitative suggestion of how big the #' estimation noise is}. #' #' #' @examples #' \dontrun{ #' # rstanarm models #' # ----------------------------------------------- #' if (require("rstanarm", quietly = TRUE)) { #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' diagnostic_posterior(model) #' } #' #' # brms models #' # ----------------------------------------------- #' if (require("brms", quietly = TRUE)) { #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' diagnostic_posterior(model) #' } #' } #' @references #' \itemize{ #' \item Gelman, A., & Rubin, D. B. (1992). Inference from iterative simulation using multiple sequences. Statistical science, 7(4), 457-472. #' \item Vehtari, A., Gelman, A., Simpson, D., Carpenter, B., and Bürkner, P. C. (2019). Rank-normalization, folding, and localization: An improved Rhat for assessing convergence of MCMC. arXiv preprint arXiv:1903.08008. #' \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. #' } #' @export diagnostic_posterior <- function(posteriors, diagnostic = c("ESS", "Rhat"), ...) { UseMethod("diagnostic_posterior") } #' @export diagnostic_posterior.default <- function(posteriors, diagnostic = c("ESS", "Rhat"), ...) { insight::format_error("'diagnostic_posterior()' only works with rstanarm, brms or blavaan models.") } #' @inheritParams insight::get_parameters.BFBayesFactor #' @inheritParams insight::get_parameters #' @rdname diagnostic_posterior #' @export diagnostic_posterior.stanreg <- function(posteriors, diagnostic = "all", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { # Find parameters effects <- match.arg(effects) component <- match.arg(component) params <- insight::find_parameters( posteriors, effects = effects, component = component, parameters = parameters, flatten = TRUE ) # If no diagnostic if (is.null(diagnostic)) { return(data.frame("Parameter" = params)) } diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) if ("all" %in% diagnostic) { diagnostic <- c("ESS", "Rhat", "MCSE", "khat") } else { diagnostic <- diagnostic if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat") } # Get indices and rename diagnostic_df <- as.data.frame(posteriors$stan_summary) diagnostic_df$Parameter <- row.names(diagnostic_df) if ("n_eff" %in% names(diagnostic_df)) { diagnostic_df$ESS <- diagnostic_df$n_eff } # special handling for MCSE, due to some parameters (like lp__) missing in rows MCSE <- mcse(posteriors, effects = "all") diagnostic_df <- merge(diagnostic_df, MCSE, by = "Parameter", all = FALSE) # Select columns available_columns <- intersect(colnames(diagnostic_df), c("Parameter", diagnostic)) diagnostic_df <- diagnostic_df[available_columns] names(diagnostic_df)[available_columns == "khat"] <- "Khat" row.names(diagnostic_df) <- NULL # Remove columns with all Nans diagnostic_df <- diagnostic_df[!sapply(diagnostic_df, function(x) all(is.na(x)))] # Select rows diagnostic_df[diagnostic_df$Parameter %in% params, ] } #' @inheritParams insight::get_parameters #' @export diagnostic_posterior.stanmvreg <- function(posteriors, diagnostic = "all", effects = c("fixed", "random", "all"), parameters = NULL, ...) { # Find parameters effects <- match.arg(effects) all_params <- insight::find_parameters( posteriors, effects = effects, parameters = parameters, flatten = FALSE ) params <- unlist(lapply(names(all_params), function(i) { all_params[[i]]$sigma <- NULL unlist(all_params[[i]], use.names = FALSE) }), use.names = FALSE) # If no diagnostic if (is.null(diagnostic)) { return(data.frame("Parameter" = params)) } diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) if ("all" %in% diagnostic) { diagnostic <- c("ESS", "Rhat", "MCSE", "khat") } else { diagnostic <- diagnostic if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat") } # Get indices and rename diagnostic_df <- as.data.frame(posteriors$stan_summary) diagnostic_df$Parameter <- row.names(diagnostic_df) if ("n_eff" %in% names(diagnostic_df)) { diagnostic_df$ESS <- diagnostic_df$n_eff } # special handling for MCSE, due to some parameters (like lp__) missing in rows MCSE <- mcse(posteriors, effects = effects) diagnostic_df <- merge(diagnostic_df, MCSE, by = "Parameter", all = FALSE) # Select columns available_columns <- intersect(colnames(diagnostic_df), c("Parameter", diagnostic)) diagnostic_df <- diagnostic_df[available_columns] names(diagnostic_df)[available_columns == "khat"] <- "Khat" row.names(diagnostic_df) <- NULL # Remove columns with all Nans diagnostic_df <- diagnostic_df[!sapply(diagnostic_df, function(x) all(is.na(x)))] diagnostic_df$Response <- gsub("(b\\[)*(.*)\\|(.*)", "\\2", diagnostic_df$Parameter) for (i in unique(diagnostic_df$Response)) { diagnostic_df$Parameter <- gsub(sprintf("%s|", i), "", diagnostic_df$Parameter, fixed = TRUE) } # Select rows diagnostic_df[diagnostic_df$Parameter %in% params, ] } #' @inheritParams insight::get_parameters #' @rdname diagnostic_posterior #' @export diagnostic_posterior.brmsfit <- function(posteriors, diagnostic = "all", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { # Find parameters effects <- match.arg(effects) component <- match.arg(component) params <- insight::find_parameters(posteriors, effects = effects, component = component, parameters = parameters, flatten = TRUE ) # If no diagnostic if (is.null(diagnostic)) { return(data.frame("Parameter" = params)) } # Get diagnostic diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) if ("all" %in% diagnostic) { diagnostic <- c("ESS", "Rhat", "MCSE", "khat") # Add MCSE } else { if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat") } insight::check_if_installed("rstan") # Get indices and rename diagnostic_df <- as.data.frame(rstan::summary(posteriors$fit)$summary) diagnostic_df$Parameter <- row.names(diagnostic_df) diagnostic_df$ESS <- diagnostic_df$n_eff # special handling for MCSE, due to some parameters (like lp__) missing in rows MCSE <- mcse(posteriors, effects = "all", component = "all") diagnostic_df <- merge(diagnostic_df, MCSE, by = "Parameter", all = FALSE) # Select columns available_columns <- intersect(colnames(diagnostic_df), c("Parameter", diagnostic)) diagnostic_df <- diagnostic_df[available_columns] names(diagnostic_df)[available_columns == "khat"] <- "Khat" row.names(diagnostic_df) <- NULL # Remove columns with all Nans diagnostic_df <- diagnostic_df[!sapply(diagnostic_df, function(x) all(is.na(x)))] # Select rows diagnostic_df[diagnostic_df$Parameter %in% params, ] } #' @inheritParams insight::get_parameters #' @export diagnostic_posterior.stanfit <- function(posteriors, diagnostic = "all", effects = c("fixed", "random", "all"), parameters = NULL, ...) { # Find parameters effects <- match.arg(effects) params <- insight::find_parameters(posteriors, effects = effects, parameters = parameters, flatten = TRUE) # If no diagnostic if (is.null(diagnostic)) { return(data.frame("Parameter" = params)) } # Get diagnostic diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) if ("all" %in% diagnostic) { diagnostic <- c("ESS", "Rhat", "MCSE") } insight::check_if_installed("rstan") all_params <- insight::find_parameters(posteriors, effects = effects, flatten = TRUE ) diagnostic_df <- data.frame( Parameter = all_params, stringsAsFactors = FALSE ) if ("ESS" %in% diagnostic) { diagnostic_df$ESS <- effective_sample(posteriors, effects = effects)$ESS } if ("MCSE" %in% diagnostic) { diagnostic_df$MCSE <- mcse(posteriors, effects = effects)$MCSE } if ("Rhat" %in% diagnostic) { s <- as.data.frame(rstan::summary(posteriors)$summary) diagnostic_df$Rhat <- s[rownames(s) %in% all_params, ]$Rhat } # Remove columns with all Nans diagnostic_df <- diagnostic_df[!sapply(diagnostic_df, function(x) all(is.na(x)))] # Select rows diagnostic_df[diagnostic_df$Parameter %in% params, ] } #' @export diagnostic_posterior.blavaan <- function(posteriors, diagnostic = "all", ...) { # Find parameters params <- suppressWarnings(insight::find_parameters(posteriors, flatten = TRUE)) out <- data.frame("Parameter" = params) # If no diagnostic if (is.null(diagnostic)) { return(out) } diagnostic <- match.arg(diagnostic, c("ESS", "Rhat", "MCSE", "all"), several.ok = TRUE) if ("all" %in% diagnostic) { diagnostic <- c("ESS", "Rhat", "MCSE") } else { diagnostic <- diagnostic if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat") } # Get indices if ("Rhat" %in% diagnostic) { insight::check_if_installed("blavaan") Rhat <- blavaan::blavInspect(posteriors, what = "psrf") Rhat <- data.frame( Parameter = colnames(insight::get_parameters(posteriors)), Rhat = Rhat ) out <- merge(out, Rhat, by = "Parameter", all = TRUE) } if ("ESS" %in% diagnostic) { ESS <- effective_sample(posteriors) out <- merge(out, ESS, by = "Parameter", all = TRUE) } if ("MCSE" %in% diagnostic) { MCSE <- mcse(posteriors) out <- merge(out, MCSE, by = "Parameter", all = TRUE) } unique(out) } bayestestR/R/simulate_priors.R0000644000176200001440000000725214307033605016153 0ustar liggesusers#' Returns Priors of a Model as Empirical Distributions #' #' Transforms priors information to actual distributions. #' #' @inheritParams effective_sample #' @param n Size of the simulated prior distributions. #' #' @seealso [unupdate()] for directly sampling from the prior #' distribution (useful for complex priors and designs). #' #' @examples #' \dontrun{ #' library(bayestestR) #' if (require("rstanarm")) { #' model <- stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) #' simulate_prior(model) #' } #' } #' @export simulate_prior <- function(model, n = 1000, ...) { UseMethod("simulate_prior") } #' @export simulate_prior.stanreg <- function(model, n = 1000, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) priors <- insight::get_priors( model, effects = effects, component = component, parameters = parameters, verbose = verbose ) .simulate_prior(priors, n = n, verbose = verbose) } #' @export simulate_prior.blavaan <- simulate_prior.stanreg #' @export simulate_prior.brmsfit <- function(model, n = 1000, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) priors <- insight::get_priors( model, effects = effects, component = component, parameters = parameters, verbose = verbose, ) .simulate_prior(priors, n = n, verbose = verbose) } #' @export simulate_prior.bcplm <- function(model, n = 1000, verbose = TRUE, ...) { .simulate_prior(insight::get_priors(model, verbose = verbose), n = n, verbose = verbose) } #' @keywords internal .simulate_prior <- function(priors, n = 1000, verbose = TRUE) { simulated <- data.frame(.bamboozled = 1:n) sim_error_msg <- FALSE # iterate over parameters for (param in priors$Parameter) { prior <- priors[priors$Parameter == param, ] # edge cases if (nrow(prior) > 1) { prior <- prior[1, ] } # Get actual scale if ("Adjusted_Scale" %in% names(prior)) { scale <- prior$Adjusted_Scale # is autoscale = FALSE, scale contains NA values - replace # with non-adjusted then. if (anyNA(scale)) scale[is.na(scale)] <- prior$Scale[is.na(scale)] } else { scale <- prior$Scale } # Simulate prior prior <- tryCatch( { if (prior$Distribution %in% c("t", "student_t", "Student's t")) { distribution(prior$Distribution, n, prior$df, prior$Location) } else { distribution(prior$Distribution, n, prior$Location, scale) } }, error = function(e) { sim_error_msg <- TRUE NA } ) simulated[param] <- prior } if (sim_error_msg && verbose) { warning(paste0("Can't simulate priors from a ", prior$Distribution, " distribution."), call. = FALSE) } simulated$.bamboozled <- NULL simulated } bayestestR/R/area_under_curve.R0000644000176200001440000000402314407021360016230 0ustar liggesusers#' Area under the Curve (AUC) #' #' Based on the DescTools `AUC` function. It can calculate the area under the #' curve with a naive algorithm or a more elaborated spline approach. The curve #' must be given by vectors of xy-coordinates. This function can handle unsorted #' x values (by sorting x) and ties for the x values (by ignoring duplicates). #' #' @param x Vector of x values. #' @param y Vector of y values. #' @param method Method to compute the Area Under the Curve (AUC). Can be #' `"trapezoid"` (default), `"step"` or `"spline"`. If "trapezoid", the curve #' is formed by connecting all points by a direct line (composite trapezoid #' rule). If "step" is chosen then a stepwise connection of two points is #' used. For calculating the area under a spline interpolation the splinefun #' function is used in combination with integrate. #' @param ... Arguments passed to or from other methods. #' #' #' @examples #' library(bayestestR) #' posterior <- distribution_normal(1000) #' #' dens <- estimate_density(posterior) #' dens <- dens[dens$x > 0, ] #' x <- dens$x #' y <- dens$y #' #' area_under_curve(x, y, method = "trapezoid") #' area_under_curve(x, y, method = "step") #' area_under_curve(x, y, method = "spline") #' @seealso DescTools #' @export area_under_curve <- function(x, y, method = c("trapezoid", "step", "spline"), ...) { # Stolen from DescTools: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r if (length(x) != length(y)) { insight::format_error("Length of x must be equal to length of y.") } idx <- order(x) x <- x[idx] y <- y[idx] switch(match.arg(arg = method, choices = c("trapezoid", "step", "spline")), "trapezoid" = sum((rowMeans(cbind(y[-length(y)], y[-1]))) * (x[-1] - x[-length(x)])), "step" = sum(y[-length(y)] * (x[-1] - x[-length(x)])), "spline" = stats::integrate(stats::splinefun(x, y, method = "natural"), lower = min(x), upper = max(x))$value ) } #' @rdname area_under_curve #' @export auc <- area_under_curve bayestestR/R/diagnostic_draws.R0000644000176200001440000000304714276606712016266 0ustar liggesusers#' Diagnostic values for each iteration #' #' Returns the accumulated log-posterior, the average Metropolis acceptance rate, divergent transitions, treedepth rather than terminated its evolution normally. #' @inheritParams diagnostic_posterior #' #' @examples #' \dontrun{ #' set.seed(333) #' #' if (require("brms", quietly = TRUE)) { #' model <- brm(mpg ~ wt * cyl * vs, #' data = mtcars, #' iter = 100, control = list(adapt_delta = 0.80), #' refresh = 0 #' ) #' diagnostic_draws(model) #' } #' } #' #' @export diagnostic_draws <- function(posteriors, ...) { UseMethod("diagnostic_draws") } #' @export diagnostic_draws.brmsfit <- function(posteriors, ...) { insight::check_if_installed("brms") data <- brms::nuts_params(posteriors) data$idvar <- paste0(data$Chain, "_", data$Iteration) out <- stats::reshape( data, v.names = "Value", idvar = "idvar", timevar = "Parameter", direction = "wide" ) out$idvar <- NULL out <- merge(out, brms::log_posterior(posteriors), by = c("Chain", "Iteration"), sort = FALSE) # Rename names(out)[names(out) == "Value.accept_stat__"] <- "Acceptance_Rate" names(out)[names(out) == "Value.treedepth__"] <- "Tree_Depth" names(out)[names(out) == "Value.stepsize__"] <- "Step_Size" names(out)[names(out) == "Value.divergent__"] <- "Divergent" names(out)[names(out) == "Value.n_leapfrog__"] <- "n_Leapfrog" names(out)[names(out) == "Value.energy__"] <- "Energy" names(out)[names(out) == "Value"] <- "LogPosterior" out } bayestestR/R/map_estimate.R0000644000176200001440000001341714407021360015376 0ustar liggesusers#' Maximum A Posteriori probability estimate (MAP) #' #' Find the **Highest Maximum A Posteriori probability estimate (MAP)** of a posterior, i.e., the value associated with the highest probability density (the "peak" of the posterior distribution). In other words, it is an estimation of the *mode* for continuous parameters. Note that this function relies on [estimate_density], which by default uses a different smoothing bandwidth (`"SJ"`) compared to the legacy default implemented the base R [density] function (`"nrd0"`). #' #' @inheritParams hdi #' @inheritParams estimate_density #' #' @return A numeric value if `x` is a vector. If `x` is a model-object, #' returns a data frame with following columns: #' \itemize{ #' \item `Parameter` The model parameter(s), if `x` is a model-object. If `x` is a vector, this column is missing. #' \item `MAP_Estimate` The MAP estimate for the posterior or each model parameter. #' } #' #' @examples #' \dontrun{ #' library(bayestestR) #' #' posterior <- rnorm(10000) #' map_estimate(posterior) #' #' plot(density(posterior)) #' abline(v = map_estimate(posterior), col = "red") #' #' library(rstanarm) #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) #' map_estimate(model) #' #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' map_estimate(model) #' } #' #' @export map_estimate <- function(x, precision = 2^10, method = "kernel", ...) { UseMethod("map_estimate") } # numeric ----------------------- #' @rdname map_estimate #' @export map_estimate.numeric <- function(x, precision = 2^10, method = "kernel", ...) { d <- estimate_density(x, precision = precision, method = method, ...) hdp_x <- d$x[which.max(d$y)] hdp_y <- max(d$y) out <- hdp_x attr(out, "MAP_density") <- hdp_y attr(out, "data") <- x attr(out, "centrality") <- "map" class(out) <- unique(c("map_estimate", "see_point_estimate", class(out))) out } # other models ----------------------- #' @export map_estimate.bayesQR <- function(x, precision = 2^10, method = "kernel", ...) { x <- insight::get_parameters(x) map_estimate(x, precision = precision, method = method) } #' @export map_estimate.BGGM <- map_estimate.bayesQR #' @export map_estimate.mcmc <- map_estimate.bayesQR #' @export map_estimate.bamlss <- map_estimate.bayesQR #' @export map_estimate.bcplm <- map_estimate.bayesQR #' @export map_estimate.blrm <- map_estimate.bayesQR #' @export map_estimate.mcmc.list <- map_estimate.bayesQR # stan / posterior models ----------------------- #' @keywords internal .map_estimate_models <- function(x, precision, method, ...) { l <- sapply(x, map_estimate, precision = precision, method = method, simplify = FALSE, ...) out <- data.frame( Parameter = colnames(x), MAP_Estimate = unlist(l, use.names = FALSE), stringsAsFactors = FALSE, row.names = NULL ) out <- .add_clean_parameters_attribute(out, x) attr(out, "MAP_density") <- sapply(l, attr, "MAP_density") attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) attr(out, "centrality") <- "map" class(out) <- unique(c("map_estimate", "see_point_estimate", class(out))) out } #' @rdname map_estimate #' @export map_estimate.stanreg <- function(x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) .map_estimate_models( x = insight::get_parameters(x, effects = effects, component = component, parameters = parameters), precision = precision, method = method ) } #' @export map_estimate.stanfit <- map_estimate.stanreg #' @export map_estimate.blavaan <- map_estimate.stanreg #' @rdname map_estimate #' @export map_estimate.brmsfit <- function(x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) .map_estimate_models( x = insight::get_parameters(x, effects = effects, component = component, parameters = parameters), precision = precision, method = method ) } #' @rdname map_estimate #' @export map_estimate.data.frame <- function(x, precision = 2^10, method = "kernel", ...) { .map_estimate_models(x, precision = precision, method = method) } #' @export map_estimate.draws <- function(x, precision = 2^10, method = "kernel", ...) { .map_estimate_models(.posterior_draws_to_df(x), precision = precision, method = method) } #' @export map_estimate.rvar <- map_estimate.draws #' @export map_estimate.emmGrid <- function(x, precision = 2^10, method = "kernel", ...) { x <- insight::get_parameters(x) .map_estimate_models(x, precision = precision, method = method) } #' @export map_estimate.emm_list <- map_estimate.emmGrid #' @export map_estimate.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { map_estimate(as.data.frame(t(attributes(x)$iterations)), ...) } else { insight::format_error("No iterations present in the output.") } } # Methods ----------------------------------------------------------------- #' @rdname as.numeric.p_direction #' @method as.numeric map_estimate #' @export as.numeric.map_estimate <- function(x, ...) { if (inherits(x, "data.frame")) { me <- as.numeric(as.vector(x$MAP_Estimate)) names(me) <- x$Parameter me } else { as.vector(x) } } #' @method as.double map_estimate #' @export as.double.map_estimate <- as.numeric.map_estimate bayestestR/R/p_to_bf.R0000644000176200001440000001017214413221117014330 0ustar liggesusers#' Convert p-values to (pseudo) Bayes Factors #' #' Convert p-values to (pseudo) Bayes Factors. This transformation has been #' suggested by Wagenmakers (2022), but is based on a vast amount of assumptions. #' It might therefore be not reliable. Use at your own risks. For more accurate #' approximate Bayes factors, use [bic_to_bf()] instead. #' #' @param x A (frequentist) model object, or a (numeric) vector of p-values. #' @param n_obs Number of observations. Either length 1, or same length as `p`. #' @param log Wether to return log Bayes Factors. **Note:** The `print()` method #' always shows `BF` - the `"log_BF"` column is only accessible from the returned #' data frame. #' @param ... Other arguments to be passed (not used for now). #' #' @references #' - Wagenmakers, E.J. (2022). Approximate objective Bayes factors from p-values #' and sample size: The 3p(sqrt(n)) rule. Preprint available on ArXiv: #' https://psyarxiv.com/egydq #' #' @examples #' if (requireNamespace("parameters", quietly = TRUE)) { #' data(iris) #' model <- lm(Petal.Length ~ Sepal.Length + Species, data = iris) #' p_to_bf(model) #' #' # Examples that demonstrate comparison between #' # BIC-approximated and pseudo BF #' # -------------------------------------------- #' m0 <- lm(mpg ~ 1, mtcars) #' m1 <- lm(mpg ~ am, mtcars) #' m2 <- lm(mpg ~ factor(cyl), mtcars) #' #' # In this first example, BIC-approximated BF and #' # pseudo-BF based on p-values are close... #' #' # BIC-approximated BF, m1 against null model #' bic_to_bf(BIC(m1), denominator = BIC(m0)) #' #' # pseudo-BF based on p-values - dropping intercept #' p_to_bf(m1)[-1, ] #' #' # The second example shows that results from pseudo-BF are less accurate #' # and should be handled wit caution! #' bic_to_bf(BIC(m2), denominator = BIC(m0)) #' p_to_bf(anova(m2), n_obs = nrow(mtcars)) #' } #' #' @return A data frame with the p-values and pseudo-Bayes factors (against the null). #' #' @seealso [bic_to_bf()] for more accurate approximate Bayes factors. #' #' @export p_to_bf <- function(x, log = FALSE, ...) { UseMethod("p_to_bf") } #' @export #' @rdname p_to_bf p_to_bf.numeric <- function(x, log = FALSE, n_obs = NULL, ...) { p <- x # Validate n_obs if (is.null(n_obs)) { insight::format_error("Argument `n_obs` must be specified.") } else if (length(n_obs) == 1L) { n_obs <- rep(n_obs, times = length(p)) } else if (length(n_obs) != length(p)) { insight::format_error("`n_obs` must be of length 1 or same length as `p`.") } # Convert log_BF <- vector("numeric", length = length(p)) for (i in seq_along(p)) { if (p[i] <= 0.1) { log_BF[i] <- log(3 * p[i] * sqrt(n_obs[i])) } else if (p[i] <= 0.5) { # log_BF[i] <- log((4 / 3) * p[i] ^ (2 / 3) * sqrt(n_obs[i])) log_BF[i] <- log(p[i]) * (2 / 3) + log(sqrt(n_obs[i]) * (4 / 3)) } else { # log_BF[i] <- p[i] ^ .25 * sqrt(n_obs[i]) log_BF[i] <- log(p[i]) / 4 + log(sqrt(n_obs[i])) } } # Clean up out <- data.frame( p = p, # IMPORTANT! This is BF10! log_BF = -log_BF, stringsAsFactors = FALSE ) if (!log) { out$BF <- exp(out$log_BF) out$log_BF <- NULL } class(out) <- c("p_to_pseudo_bf", "data.frame") out } #' @export #' @rdname p_to_bf p_to_bf.default <- function(x, log = FALSE, ...) { if (insight::is_model(x)) { insight::check_if_installed("parameters") params <- parameters::p_value(x) p <- params$p n_obs <- insight::n_obs(x) # sanity check if (is.null(n_obs)) { # user may also pass n_obs via dots... n_obs <- list(...)$n_obs } } else { insight::format_error("Argument `x` must be a model object, or a numeric vector of p-values.") } out <- p_to_bf(p, n_obs = n_obs, log = log) out <- cbind(params, out[, -1, drop = FALSE]) class(out) <- c("p_to_pseudo_bf", "data.frame") out } # methods --------------- #' @export print.p_to_pseudo_bf <- function(x, ...) { cat(insight::export_table(insight::format_table(x), caption = "Pseudo-BF (against NULL)")) } bayestestR/R/utils_check_collinearity.R0000644000176200001440000000466414407021360020005 0ustar liggesusers#' @keywords internal .check_multicollinearity <- function(model, method = "equivalence_test", threshold = 0.7, ...) { valid_parameters <- insight::find_parameters(model, parameters = "^(?!(r_|sd_|prior_|cor_|lp__|b\\[))", flatten = TRUE) if (inherits(model, "stanfit")) { dat <- insight::get_parameters(model)[, valid_parameters, drop = FALSE] } else { dat <- as.data.frame(model, optional = FALSE)[, valid_parameters, drop = FALSE] } # need at least three columns, one is removed anyway... if (ncol(dat) > 2) { dat <- dat[, -1, drop = FALSE] if (ncol(dat) > 1) { parameter_correlation <- stats::cor(dat) parameter <- expand.grid(colnames(dat), colnames(dat), stringsAsFactors = FALSE) results <- cbind( parameter, corr = abs(as.vector(expand.grid(parameter_correlation)[[1]])), pvalue = apply(parameter, 1, function(r) stats::cor.test(dat[[r[1]]], dat[[r[2]]])$p.value) ) # Filter results <- results[results$pvalue < 0.05 & results$Var1 != results$Var2, ] if (nrow(results) > 0) { # Remove duplicates results$where <- paste0(results$Var1, " and ", results$Var2) results$where2 <- paste0(results$Var2, " and ", results$Var1) to_remove <- NULL for (i in seq_len(nrow(results))) { if (results$where2[i] %in% results$where[1:i]) { to_remove <- c(to_remove, i) } } results <- results[-to_remove, ] # Filter by first threshold threshold <- pmin(threshold, 0.9) results <- results[results$corr > threshold & results$corr <= 0.9, ] if (nrow(results) > 0) { where <- paste0("between ", toString(paste0(results$where, " (r = ", round(results$corr, 2), ")")), "") message("Possible multicollinearity ", where, ". This might lead to inappropriate results. See 'Details' in '?", method, "'.") } # Filter by second threshold results <- results[results$corr > 0.9, ] if (nrow(results) > 0) { where <- paste0("between ", toString(paste0(results$where, " (r = ", round(results$corr, 2), ")")), "") warning("Probable multicollinearity ", where, ". This might lead to inappropriate results. See 'Details' in '?", method, "'.", call. = FALSE) } } } } } bayestestR/R/mcse.R0000644000176200001440000000550514276606712013672 0ustar liggesusers#' Monte-Carlo Standard Error (MCSE) #' #' This function returns the Monte Carlo Standard Error (MCSE). #' #' @inheritParams effective_sample #' #' #' @details **Monte Carlo Standard Error (MCSE)** is another measure of #' accuracy of the chains. It is defined as standard deviation of the chains #' divided by their effective sample size (the formula for `mcse()` is #' from Kruschke 2015, p. 187). The MCSE \dQuote{provides a quantitative #' suggestion of how big the estimation noise is}. #' #' @references Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. #' #' @examples #' \dontrun{ #' library(bayestestR) #' library(rstanarm) #' #' model <- stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) #' mcse(model) #' } #' @export mcse <- function(model, ...) { UseMethod("mcse") } #' @export mcse.brmsfit <- function(model, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) params <- insight::get_parameters( model, effects = effects, component = component, parameters = parameters ) ess <- effective_sample( model, effects = effects, component = component, parameters = parameters ) .mcse(params, stats::setNames(ess$ESS, ess$Parameter)) } #' @rdname mcse #' @export mcse.stanreg <- function(model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) params <- insight::get_parameters( model, effects = effects, component = component, parameters = parameters ) ess <- effective_sample( model, effects = effects, component = component, parameters = parameters ) .mcse(params, stats::setNames(ess$ESS, ess$Parameter)) } #' @export mcse.stanfit <- mcse.stanreg #' @export mcse.blavaan <- mcse.stanreg #' @keywords internal .mcse <- function(params, ess) { # get standard deviations from posterior samples stddev <- sapply(params, stats::sd) # check proper length, and for unequal length, shorten all # objects to common parameters if (length(stddev) != length(ess)) { common <- stats::na.omit(match(names(stddev), names(ess))) stddev <- stddev[common] ess <- ess[common] params <- params[common] } # compute mcse data.frame( Parameter = colnames(params), MCSE = stddev / sqrt(ess), stringsAsFactors = FALSE, row.names = NULL ) } bayestestR/R/bayesfactor_parameters.R0000644000176200001440000005063314407021360017454 0ustar liggesusers#' Bayes Factors (BF) for a Single Parameter #' #' This method computes Bayes factors against the null (either a point or an #' interval), based on prior and posterior samples of a single parameter. This #' Bayes factor indicates the degree by which the mass of the posterior #' distribution has shifted further away from or closer to the null value(s) #' (relative to the prior distribution), thus indicating if the null value has #' become less or more likely given the observed data. #' \cr \cr #' When the null is an interval, the Bayes factor is computed by comparing the #' prior and posterior odds of the parameter falling within or outside the null #' interval (Morey & Rouder, 2011; Liao et al., 2020); When the null is a point, #' a Savage-Dickey density ratio is computed, which is also an approximation of #' a Bayes factor comparing the marginal likelihoods of the model against a #' model in which the tested parameter has been restricted to the point null #' (Wagenmakers et al., 2010; Heck, 2019). #' \cr \cr #' Note that the `logspline` package is used for estimating densities and #' probabilities, and must be installed for the function to work. #' \cr \cr #' `bayesfactor_pointnull()` and `bayesfactor_rope()` are wrappers #' around `bayesfactor_parameters` with different defaults for the null to #' be tested against (a point and a range, respectively). Aliases of the main #' functions are prefixed with `bf_*`, like `bf_parameters()` or #' `bf_pointnull()`. #' \cr \cr #' \strong{For more info, in particular on specifying correct priors for factors #' with more than 2 levels, see #' [the #' Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html).} #' #' @param posterior A numerical vector, `stanreg` / `brmsfit` object, #' `emmGrid` or a data frame - representing a posterior distribution(s) #' from (see 'Details'). #' @param prior An object representing a prior distribution (see 'Details'). #' @param direction Test type (see 'Details'). One of `0`, #' `"two-sided"` (default, two tailed), `-1`, `"left"` (left #' tailed) or `1`, `"right"` (right tailed). #' @param null Value of the null, either a scalar (for point-null) or a range #' (for a interval-null). #' @param ... Arguments passed to and from other methods. (Can be used to pass #' arguments to internal [logspline::logspline()].) #' @inheritParams hdi #' #' @return A data frame containing the (log) Bayes factor representing evidence #' *against* the null (Use `as.numeric()` to extract the non-log Bayes #' factors; see examples). #' #' @note There is also a #' [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) #' implemented in the #' \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @details #' This method is used to compute Bayes factors based on prior and posterior #' distributions. #' #' \subsection{One-sided & Dividing Tests (setting an order restriction)}{ #' One sided tests (controlled by `direction`) are conducted by restricting #' the prior and posterior of the non-null values (the "alternative") to one #' side of the null only (\cite{Morey & Wagenmakers, 2014}). For example, if we #' have a prior hypothesis that the parameter should be positive, the #' alternative will be restricted to the region to the right of the null (point #' or interval). For example, for a Bayes factor comparing the "null" of `0-0.1` #' to the alternative `>0.1`, we would set #' `bayesfactor_parameters(null = c(0, 0.1), direction = ">")`. #' \cr\cr #' It is also possible to compute a Bayes factor for **dividing** #' hypotheses - that is, for a null and alternative that are complementary, #' opposing one-sided hypotheses (\cite{Morey & Wagenmakers, 2014}). For #' example, for a Bayes factor comparing the "null" of `<0` to the alternative #' `>0`, we would set `bayesfactor_parameters(null = c(-Inf, 0))`. #' } #' #' @section Setting the correct `prior`: #' For the computation of Bayes factors, the model priors must be proper priors #' (at the very least they should be *not flat*, and it is preferable that #' they be *informative*); As the priors for the alternative get wider, the #' likelihood of the null value(s) increases, to the extreme that for completely #' flat priors the null is infinitely more favorable than the alternative (this #' is called *the Jeffreys-Lindley-Bartlett paradox*). Thus, you should #' only ever try (or want) to compute a Bayes factor when you have an informed #' prior. #' \cr\cr #' (Note that by default, `brms::brm()` uses flat priors for fixed-effects; #' See example below.) #' \cr\cr #' It is important to provide the correct `prior` for meaningful results. #' \itemize{ #' \item When `posterior` is a numerical vector, `prior` should also be a numerical vector. #' \item When `posterior` is a `data.frame`, `prior` should also be a `data.frame`, with matching column order. #' \item When `posterior` is a `stanreg`, `brmsfit` or other supported Bayesian model: \itemize{ #' \item `prior` can be set to `NULL`, in which case prior samples are drawn internally. #' \item `prior` can also be a model equivalent to `posterior` but with samples from the priors *only*. See [unupdate()]. #' \item **Note:** When `posterior` is a `brmsfit_multiple` model, `prior` **must** be provided. #' } #' \item When `posterior` is an `emmGrid` / `emm_list` object: \itemize{ #' \item `prior` should also be an `emmGrid` / `emm_list` object equivalent to `posterior` but created with a model of priors samples *only*. See [unupdate()]. #' \item `prior` can also be the original (posterior) *model*. If so, the function will try to update the `emmGrid` / `emm_list` to use the [unupdate()]d prior-model. (*This cannot be done for `brmsfit` models.*) #' \item **Note**: When the `emmGrid` has undergone any transformations (`"log"`, `"response"`, etc.), or `regrid`ing, then `prior` must be an `emmGrid` object, as stated above. #' } #' } #' #' @section Interpreting Bayes Factors: #' A Bayes factor greater than 1 can be interpreted as evidence against the #' null, at which one convention is that a Bayes factor greater than 3 can be #' considered as "substantial" evidence against the null (and vice versa, a #' Bayes factor smaller than 1/3 indicates substantial evidence in favor of the #' null-model) (\cite{Wetzels et al. 2011}). #' #' @examples #' library(bayestestR) #' if (require("logspline")) { #' prior <- distribution_normal(1000, mean = 0, sd = 1) #' posterior <- distribution_normal(1000, mean = .5, sd = .3) #' (BF_pars <- bayesfactor_parameters(posterior, prior, verbose = FALSE)) #' #' as.numeric(BF_pars) #' } #' \dontrun{ #' # rstanarm models #' # --------------- #' if (require("rstanarm") && require("emmeans") && require("logspline")) { #' contrasts(sleep$group) <- contr.equalprior_pairs # see vingette #' stan_model <- suppressWarnings(stan_lmer( #' extra ~ group + (1 | ID), #' data = sleep, #' refresh = 0 #' )) #' bayesfactor_parameters(stan_model, verbose = FALSE) #' bayesfactor_parameters(stan_model, null = rope_range(stan_model)) #' #' # emmGrid objects #' # --------------- #' group_diff <- pairs(emmeans(stan_model, ~group)) #' bayesfactor_parameters(group_diff, prior = stan_model, verbose = FALSE) #' #' # Or #' group_diff_prior <- pairs(emmeans(unupdate(stan_model), ~group)) #' bayesfactor_parameters(group_diff, prior = group_diff_prior, verbose = FALSE) #' } #' #' # brms models #' # ----------- #' if (require("brms")) { #' contrasts(sleep$group) <- contr.equalprior_pairs # see vingette #' my_custom_priors <- #' set_prior("student_t(3, 0, 1)", class = "b") + #' set_prior("student_t(3, 0, 1)", class = "sd", group = "ID") #' #' brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID), #' data = sleep, #' prior = my_custom_priors, #' refresh = 0 #' )) #' bayesfactor_parameters(brms_model, verbose = FALSE) #' } #' } #' @references #' \itemize{ #' \item Wagenmakers, E. J., Lodewyckx, T., Kuriyal, H., and Grasman, R. (2010). #' Bayesian hypothesis testing for psychologists: A tutorial on the #' Savage-Dickey method. Cognitive psychology, 60(3), 158-189. #' \item Heck, D. W. (2019). A caveat on the Savage–Dickey density ratio: The #' case of computing Bayes factors for regression parameters. British Journal of #' Mathematical and Statistical Psychology, 72(2), 316-333. #' \item Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between #' Bayesian order-restricted and point-null hypothesis tests. Statistics & #' Probability Letters, 92, 121-124. #' \item Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for #' testing interval null hypotheses. Psychological methods, 16(4), 406. #' \item Liao, J. G., Midya, V., & Berg, A. (2020). Connecting and contrasting #' the Bayes factor and a modified ROPE procedure for testing interval null #' hypotheses. The American Statistician, 1-19. #' \item Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and #' Wagenmakers, E.-J. (2011). Statistical Evidence in Experimental Psychology: #' An Empirical Comparison Using 855 t Tests. Perspectives on Psychological #' Science, 6(3), 291–298. \doi{10.1177/1745691611406923} #' } #' #' @author Mattan S. Ben-Shachar #' #' @export bayesfactor_parameters <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { UseMethod("bayesfactor_parameters") } #' @rdname bayesfactor_parameters #' @export bayesfactor_pointnull <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { if (length(null) > 1 && verbose) { message("'null' is a range - computing a ROPE based Bayes factor.") } bayesfactor_parameters( posterior = posterior, prior = prior, direction = direction, null = null, verbose = verbose, ... ) } #' @rdname bayesfactor_parameters #' @export bayesfactor_rope <- function(posterior, prior = NULL, direction = "two-sided", null = rope_range(posterior), verbose = TRUE, ...) { if (length(null) < 2 && verbose) { insight::format_alert("'null' is a point - computing a Savage-Dickey (point null) Bayes factor.") } bayesfactor_parameters( posterior = posterior, prior = prior, direction = direction, null = null, verbose = verbose, ... ) } #' @rdname bayesfactor_parameters #' @export bf_parameters <- bayesfactor_parameters #' @rdname bayesfactor_parameters #' @export bf_pointnull <- bayesfactor_pointnull #' @rdname bayesfactor_parameters #' @export bf_rope <- bayesfactor_rope #' @rdname bayesfactor_parameters #' @export bayesfactor_parameters.numeric <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { # nm <- insight::safe_deparse(substitute(posterior) if (is.null(prior)) { prior <- posterior if (verbose) { insight::format_warning( "Prior not specified! Please specify a prior (in the form 'prior = distribution_normal(1000, 0, 1)') to get meaningful results." ) } } prior <- data.frame(X = prior) posterior <- data.frame(X = posterior) # colnames(posterior) <- colnames(prior) <- nm # Get BFs sdbf <- bayesfactor_parameters.data.frame( posterior = posterior, prior = prior, direction = direction, null = null, verbose = verbose, ... ) sdbf$Parameter <- NULL sdbf } #' @rdname bayesfactor_parameters #' @export bayesfactor_parameters.stanreg <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "location", "smooth_terms", "sigma", "zi", "zero_inflated", "all"), parameters = NULL, ...) { cleaned_parameters <- insight::clean_parameters(posterior) effects <- match.arg(effects) component <- match.arg(component) samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose, effects = effects, component = component, parameters = parameters ) # Get BFs temp <- bayesfactor_parameters.data.frame( posterior = samps$posterior, prior = samps$prior, direction = direction, null = null, verbose = verbose, ... ) bf_val <- .prepare_output(temp, cleaned_parameters, inherits(posterior, "stanmvreg")) class(bf_val) <- class(temp) attr(bf_val, "clean_parameters") <- cleaned_parameters attr(bf_val, "hypothesis") <- attr(temp, "hypothesis") # don't change the name of this attribute - it is used only internally for "see" and printing attr(bf_val, "direction") <- attr(temp, "direction") attr(bf_val, "plot_data") <- attr(temp, "plot_data") bf_val } #' @rdname bayesfactor_parameters #' @export bayesfactor_parameters.brmsfit <- bayesfactor_parameters.stanreg #' @rdname bayesfactor_parameters #' @export bayesfactor_parameters.blavaan <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { cleaned_parameters <- insight::clean_parameters(posterior) samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose ) # Get BFs temp <- bayesfactor_parameters.data.frame( posterior = samps$posterior, prior = samps$prior, direction = direction, null = null, verbose = verbose, ... ) bf_val <- .prepare_output(temp, cleaned_parameters) class(bf_val) <- class(temp) attr(bf_val, "clean_parameters") <- cleaned_parameters attr(bf_val, "hypothesis") <- attr(temp, "hypothesis") # don't change the name of this attribute - it is used only internally for "see" and printing attr(bf_val, "direction") <- attr(temp, "direction") attr(bf_val, "plot_data") <- attr(temp, "plot_data") bf_val } #' @export bayesfactor_parameters.emmGrid <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose ) # Get BFs bayesfactor_parameters.data.frame( posterior = samps$posterior, prior = samps$prior, direction = direction, null = null, verbose = verbose, ... ) } #' @export bayesfactor_parameters.emm_list <- bayesfactor_parameters.emmGrid #' @rdname bayesfactor_parameters #' @export bayesfactor_parameters.data.frame <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { # find direction direction <- .get_direction(direction) if (is.null(prior)) { prior <- posterior if (verbose) { insight::format_warning( "Prior not specified! Please specify priors (with column order matching 'posterior') to get meaningful results." ) } } if (verbose && length(null) == 1L && (nrow(posterior) < 4e4 || nrow(prior) < 4e4)) { insight::format_warning( "Bayes factors might not be precise.", "For precise Bayes factors, sampling at least 40,000 posterior samples is recommended." ) } sdbf <- numeric(ncol(posterior)) for (par in seq_along(posterior)) { sdbf[par] <- .bayesfactor_parameters( posterior[[par]], prior[[par]], direction = direction, null = null, ... ) } bf_val <- data.frame( Parameter = colnames(posterior), log_BF = log(sdbf), stringsAsFactors = FALSE ) class(bf_val) <- unique(c( "bayesfactor_parameters", "see_bayesfactor_parameters", class(bf_val) )) attr(bf_val, "hypothesis") <- null # don't change the name of this attribute - it is used only internally for "see" and printing attr(bf_val, "direction") <- direction attr(bf_val, "plot_data") <- .make_BF_plot_data(posterior, prior, direction, null, ...) bf_val } #' @export bayesfactor_parameters.draws <- function(posterior, prior = NULL, direction = "two-sided", null = 0, verbose = TRUE, ...) { bayesfactor_parameters( .posterior_draws_to_df(posterior), prior = prior, direction = direction, null = null, verbose = verbose, ... ) } #' @export bayesfactor_parameters.rvar <- bayesfactor_parameters.draws #' @keywords internal .bayesfactor_parameters <- function(posterior, prior, direction = 0, null = 0, ...) { stopifnot(length(null) %in% c(1, 2)) if (isTRUE(all.equal(posterior, prior))) { return(1) } insight::check_if_installed("logspline") if (length(null) == 1) { relative_density <- function(samples) { f_samples <- .logspline(samples, ...) d_samples <- logspline::dlogspline(null, f_samples) if (direction < 0) { norm_samples <- logspline::plogspline(null, f_samples) } else if (direction > 0) { norm_samples <- 1 - logspline::plogspline(null, f_samples) } else { norm_samples <- 1 } d_samples / norm_samples } return(relative_density(prior) / relative_density(posterior)) } else if (length(null) == 2) { null <- sort(null) null[is.infinite(null)] <- 1.797693e+308 * sign(null[is.infinite(null)]) f_prior <- .logspline(prior, ...) f_posterior <- .logspline(posterior, ...) h0_prior <- diff(logspline::plogspline(null, f_prior)) h0_post <- diff(logspline::plogspline(null, f_posterior)) BF_null_full <- h0_post / h0_prior if (direction < 0) { h1_prior <- logspline::plogspline(min(null), f_prior) h1_post <- logspline::plogspline(min(null), f_posterior) } else if (direction > 0) { h1_prior <- 1 - logspline::plogspline(max(null), f_prior) h1_post <- 1 - logspline::plogspline(max(null), f_posterior) } else { h1_prior <- 1 - h0_prior h1_post <- 1 - h0_post } BF_alt_full <- h1_post / h1_prior return(BF_alt_full / BF_null_full) } } # Bad Methods ------------------------------------------------------------- #' @export bayesfactor_parameters.bayesfactor_models <- function(...) { insight::format_error( "Oh no, 'bayesfactor_parameters()' does not know how to deal with multiple models :(", "You might want to use 'bayesfactor_inclusion()' here to test specific terms across models." ) } #' @export bayesfactor_parameters.sim <- function(...) { insight::format_error( "Bayes factors are based on the shift from a prior to a posterior.", "Since simulated draws are not based on any priors, computing Bayes factors does not make sense :(", "You might want to try `rope`, `ci`, `pd` or `pmap` for posterior-based inference." ) } #' @export bayesfactor_parameters.sim.merMod <- bayesfactor_parameters.sim bayestestR/R/bayesfactor_restricted.R0000644000176200001440000002161414407021360017456 0ustar liggesusers#' Bayes Factors (BF) for Order Restricted Models #' #' This method computes Bayes factors for comparing a model with an order restrictions on its parameters #' with the fully unrestricted model. *Note that this method should only be used for confirmatory analyses*. #' \cr \cr #' The `bf_*` function is an alias of the main function. #' \cr \cr #' \strong{For more info, in particular on specifying correct priors for factors with more than 2 levels, see [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html).} #' #' @param posterior A `stanreg` / `brmsfit` object, `emmGrid` or a data frame - representing a posterior distribution(s) from (see Details). #' @param hypothesis A character vector specifying the restrictions as logical conditions (see examples below). #' @param prior An object representing a prior distribution (see Details). #' @inheritParams hdi #' #' @details This method is used to compute Bayes factors for order-restricted models vs un-restricted #' models by setting an order restriction on the prior and posterior distributions #' (\cite{Morey & Wagenmakers, 2013}). #' \cr\cr #' (Though it is possible to use `bayesfactor_restricted()` to test interval restrictions, #' it is more suitable for testing order restrictions; see examples). #' #' @inheritSection bayesfactor_parameters Setting the correct `prior` #' #' @inheritSection bayesfactor_parameters Interpreting Bayes Factors #' #' @return A data frame containing the (log) Bayes factor representing evidence #' *against* the un-restricted model (Use `as.numeric()` to extract the #' non-log Bayes factors; see examples). (A `bool_results` attribute contains #' the results for each sample, indicating if they are included or not in the #' hypothesized restriction.) #' #' @examples #' set.seed(444) #' library(bayestestR) #' prior <- data.frame( #' A = rnorm(1000), #' B = rnorm(1000), #' C = rnorm(1000) #' ) #' #' posterior <- data.frame( #' A = rnorm(1000, .4, 0.7), #' B = rnorm(1000, -.2, 0.4), #' C = rnorm(1000, 0, 0.5) #' ) #' #' hyps <- c( #' "A > B & B > C", #' "A > B & A > C", #' "C > A" #' ) #' #' #' (b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior)) #' #' bool <- as.logical(b, which = "posterior") #' head(bool) #' #' @examplesIf require("see") && require("patchwork") #' #' see::plots( #' plot(estimate_density(posterior)), #' # distribution **conditional** on the restrictions #' plot(estimate_density(posterior[bool[, hyps[1]], ])) + ggplot2::ggtitle(hyps[1]), #' plot(estimate_density(posterior[bool[, hyps[2]], ])) + ggplot2::ggtitle(hyps[2]), #' plot(estimate_density(posterior[bool[, hyps[3]], ])) + ggplot2::ggtitle(hyps[3]), #' guides = "collect" #' ) #' #' @examplesIf require("rstanarm") #' \dontrun{ #' # rstanarm models #' # --------------- #' data("mtcars") #' #' fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am, #' data = mtcars, refresh = 0 #' ) #' hyps <- c( #' "am > 0 & cyl < 0", #' "cyl < 0", #' "wt - cyl > 0" #' ) #' #' bayesfactor_restricted(fit_stan, hypothesis = hyps) #' } #' #' @examplesIf require("rstanarm") && require("emmeans") #' \dontrun{ #' # emmGrid objects #' # --------------- #' # replicating http://bayesfactor.blogspot.com/2015/01/multiple-comparisons-with-bayesfactor-2.html #' data("disgust") #' contrasts(disgust$condition) <- contr.equalprior_pairs # see vignette #' fit_model <- rstanarm::stan_glm(score ~ condition, data = disgust, family = gaussian()) #' #' em_condition <- emmeans::emmeans(fit_model, ~condition) #' hyps <- c("lemon < control & control < sulfur") #' #' bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps) #' # > # Bayes Factor (Order-Restriction) #' # > #' # > Hypothesis P(Prior) P(Posterior) BF #' # > lemon < control & control < sulfur 0.17 0.75 4.49 #' # > --- #' # > Bayes factors for the restricted model vs. the un-restricted model. #' } #' #' @references #' - Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124. #' - Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. Psychological methods, 16(4), 406. #' - Morey, R. D. (Jan, 2015). Multiple Comparisons with BayesFactor, Part 2 – order restrictions. Retrieved from https://richarddmorey.org/category/order-restrictions/. #' #' @export bayesfactor_restricted <- function(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) { UseMethod("bayesfactor_restricted") } #' @rdname bayesfactor_restricted #' @export bf_restricted <- bayesfactor_restricted #' @rdname bayesfactor_restricted #' @export bayesfactor_restricted.stanreg <- function(posterior, hypothesis, prior = NULL, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), ...) { effects <- match.arg(effects) component <- match.arg(component) samps <- .clean_priors_and_posteriors(posterior, prior, effects, component, verbose = verbose ) # Get savage-dickey BFs bayesfactor_restricted.data.frame( posterior = samps$posterior, prior = samps$prior, hypothesis = hypothesis ) } #' @rdname bayesfactor_restricted #' @export bayesfactor_restricted.brmsfit <- bayesfactor_restricted.stanreg #' @rdname bayesfactor_restricted #' @export bayesfactor_restricted.blavaan <- function(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) { samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose ) # Get savage-dickey BFs bayesfactor_restricted.data.frame( posterior = samps$posterior, prior = samps$prior, hypothesis = hypothesis ) } #' @rdname bayesfactor_restricted #' @export bayesfactor_restricted.emmGrid <- function(posterior, hypothesis, prior = NULL, verbose = TRUE, ...) { samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose ) bayesfactor_restricted.data.frame( posterior = samps$posterior, prior = samps$prior, hypothesis = hypothesis ) } #' @export bayesfactor_restricted.emm_list <- bayesfactor_restricted.emmGrid #' @export bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NULL, ...) { p_hypothesis <- parse(text = hypothesis) if (is.null(prior)) { prior <- posterior insight::format_warning( "Prior not specified! ", "Please specify priors (with column names matching 'posterior')", " to get meaningful results." ) } .test_hypothesis <- function(x, data) { x_logical <- try(eval(x, envir = data), silent = TRUE) if (inherits(x_logical, "try-error")) { cnames <- colnames(data) is_name <- make.names(cnames) == cnames cnames[!is_name] <- paste0("`", cnames[!is_name], "`") insight::format_error( x_logical, paste("Available parameters are:", toString(cnames)) ) } else if (!all(is.logical(x_logical))) { insight::format_error("Hypotheses must be logical.") } x_logical } posterior_l <- as.data.frame(lapply(p_hypothesis, .test_hypothesis, data = posterior)) prior_l <- as.data.frame(lapply(p_hypothesis, .test_hypothesis, data = prior)) colnames(posterior_l) <- colnames(prior_l) <- if (!is.null(names(hypothesis))) names(hypothesis) else hypothesis posterior_p <- sapply(posterior_l, mean) prior_p <- sapply(prior_l, mean) BF <- posterior_p / prior_p res <- data.frame( Hypothesis = hypothesis, p_prior = prior_p, p_posterior = posterior_p, log_BF = log(BF) ) attr(res, "bool_results") <- list(posterior = posterior_l, prior = prior_l) class(res) <- unique(c( "bayesfactor_restricted", class(res) )) res } #' @export bayesfactor_restricted.draws <- function(posterior, hypothesis, prior = NULL, ...) { bayesfactor_restricted(.posterior_draws_to_df(posterior), hypothesis = hypothesis, prior = prior, ...) } #' @export bayesfactor_restricted.rvar <- bayesfactor_restricted.draws # Methods ----------------------------------------------------------------- #' @export #' @rdname bayesfactor_restricted #' @param x An object of class `bayesfactor_restricted` #' @param which Should the logical matrix be of the posterior or prior distribution(s)? as.logical.bayesfactor_restricted <- function(x, which = c("posterior", "prior"), ...) { which <- match.arg(which) as.matrix(attr(x, "bool_results")[[which]]) } bayestestR/R/utils.R0000644000176200001440000001037514407021360014066 0ustar liggesusers# small wrapper around this commonly used try-catch .safe <- function(code, on_error = NULL) { tryCatch(code, error = function(e) on_error) } # select rows where values in "variable" match "value" #' @keywords internal .select_rows <- function(data, variable, value) { data[which(data[[variable]] == value), ] } #' select numerics columns #' @keywords internal .select_nums <- function(x) { x[unlist(lapply(x, is.numeric))] } #' @keywords internal .get_direction <- function(direction) { if (length(direction) > 1) { insight::format_warning("Using first 'direction' value.") } if (is.numeric(direction[1])) { return(sign(direction[1])) } Value <- c( "left" = -1, "right" = 1, "two-sided" = 0, "twosided" = 0, "one-sided" = 1, "onesided" = 1, "<" = -1, ">" = 1, "=" = 0, "==" = 0, "-1" = -1, "0" = 0, "1" = 1, "+1" = 1 ) direction <- Value[tolower(direction[1])] if (is.na(direction)) { stop("Unrecognized 'direction' argument.", call. = FALSE) } direction } #' @keywords internal .prepare_output <- function(temp, cleaned_parameters, is_stan_mv = FALSE, is_brms_mv = FALSE) { if (is.null(cleaned_parameters)) { return(temp) } if (isTRUE(is_stan_mv)) { temp$Response <- gsub("(b\\[)*(.*)\\|(.*)", "\\2", temp$Parameter) for (i in unique(temp$Response)) { temp$Parameter <- gsub(sprintf("%s|", i), "", temp$Parameter, fixed = TRUE) } merge_by <- c("Parameter", "Effects", "Component", "Response") remove_cols <- c("Group", "Cleaned_Parameter", "Function", ".roworder") } else if (isTRUE(is_brms_mv)) { temp$Response <- gsub("(.*)_(.*)_(.*)", "\\2", temp$Parameter) # temp$Parameter <- gsub("(.*)_(.*)_(.*)", "\\1_\\3", temp$Parameter) merge_by <- c("Parameter", "Effects", "Component", "Response") remove_cols <- c("Group", "Cleaned_Parameter", "Function", ".roworder") } else { merge_by <- c("Parameter", "Effects", "Component") remove_cols <- c("Group", "Cleaned_Parameter", "Response", "Function", ".roworder") } merge_by <- intersect(merge_by, colnames(temp)) temp$.roworder <- seq_len(nrow(temp)) out <- merge(x = temp, y = cleaned_parameters, by = merge_by, all.x = TRUE) # hope this works for stanmvreg... if ((isTRUE(is_stan_mv) || isTRUE(is_brms_mv)) && all(is.na(out$Effects)) && all(is.na(out$Component))) { out$Effects <- cleaned_parameters$Effects[seq_len(nrow(out))] out$Component <- cleaned_parameters$Component[seq_len(nrow(out))] } # this here is required for multiple response models... if (all(is.na(out$Effects)) || all(is.na(out$Component))) { out <- out[!duplicated(out$.roworder), ] } else { out <- out[!is.na(out$Effects) & !is.na(out$Component) & !duplicated(out$.roworder), ] } attr(out, "Cleaned_Parameter") <- out$Cleaned_Parameter[order(out$.roworder)] datawizard::data_remove(out[order(out$.roworder), ], remove_cols, verbose = FALSE) } #' @keywords internal .merge_and_sort <- function(x, y, by, all) { if (is.null(ncol(y))) { return(x) } x$.rowid <- seq_len(nrow(x)) x <- merge(x, y, by = by, all = all) datawizard::data_remove(x[order(x$.rowid), ], ".rowid", verbose = FALSE) } # returns the variables that were used for grouping data frames (dplyr::group_var()) #' @keywords internal .group_vars <- function(x) { # dplyr < 0.8.0 returns attribute "indices" grps <- attr(x, "groups", exact = TRUE) # dplyr < 0.8.0? if (is.null(grps)) { ## TODO fix for dplyr < 0.8 attr(x, "vars", exact = TRUE) } else { setdiff(colnames(grps), ".rows") } } #' @keywords internal .is_baysian_emmeans <- function(x) { if (inherits(x, "emm_list")) { x <- x[[1]] } post.beta <- methods::slot(x, "post.beta") !(all(dim(post.beta) == 1) && is.na(post.beta)) } # safe add cleaned parameter names to a model object .add_clean_parameters_attribute <- function(params, model) { cp <- tryCatch( { insight::clean_parameters(model) }, error = function(e) { NULL } ) attr(params, "clean_parameters") <- cp params } bayestestR/R/zzz.R0000644000176200001440000000023414276606712013572 0ustar liggesusers.onAttach <- function(libname, pkgname) { if (format(Sys.time(), "%m%d") == "0504") { packageStartupMessage("May the fourth be with you!") } } bayestestR/R/convert_pd_to_p.R0000644000176200001440000000175114276606712016126 0ustar liggesusers#' Convert between Probability of Direction (pd) and p-value. #' #' Enables a conversion between Probability of Direction (pd) and p-value. #' #' @param pd A Probability of Direction (pd) value (between 0 and 1). #' @param p A p-value. #' @param direction What type of p-value is requested or provided. Can be #' `"two-sided"` (default, two tailed) or `"one-sided"` (one tailed). #' @param ... Arguments passed to or from other methods. #' #' @examples #' pd_to_p(pd = 0.95) #' pd_to_p(pd = 0.95, direction = "one-sided") #' @export pd_to_p <- function(pd, direction = "two-sided", ...) { p <- 1 - pmax(pd, 1 - pd) if (.get_direction(direction) == 0) { p <- 2 * p } p } #' @rdname pd_to_p #' @export p_to_pd <- function(p, direction = "two-sided", ...) { if (.get_direction(direction) == 0) { p <- p / 2 } (1 - p) } #' @rdname pd_to_p #' @export convert_p_to_pd <- p_to_pd #' @rdname pd_to_p #' @export convert_pd_to_p <- pd_to_p bayestestR/R/cwi.R0000644000176200001440000000541214407021360013504 0ustar liggesusers#' Curvewise Intervals (CWI) #' #' Compute the **Curvewise interval (CWI)** (also called the "simultaneous interval" or "joint interval") of posterior distributions using \code{ggdist::curve_interval()}. #' Whereas the more typical "pointwise intervals" contain xx% of the posterior for a single parameter, #' joint/curvewise intervals contain xx% of the posterior distribution for **all** parameters. #' #' Applied model predictions, pointwise intervals contain xx% of the predicted response values **conditional** on specific predictor values. #' In contrast, curvewise intervals contain xx% of the predicted response values across all predictor values. #' Put another way, curvewise intervals contain xx% of the full **prediction lines** from the model. #' #' For more details, see the [*ggdist* documentation on curvewise intervals](https://mjskay.github.io/ggdist/articles/lineribbon.html#curve-boxplots-aka-lineribbons-with-joint-intervals-or-curvewise-intervals-). #' #' @inheritParams hdi #' @inherit ci return #' @inherit hdi details #' @inherit hdi seealso #' @family ci #' #' @examples #' \donttest{ #' library(bayestestR) #' #' if (require("ggplot2") && require("rstanarm") && require("ggdist")) { #' # Generate data ============================================= #' k <- 11 # number of curves (iterations) #' n <- 201 # number of rows #' data <- data.frame(x = seq(-15, 15, length.out = n)) #' #' # Simulate iterations as new columns #' for (i in 1:k) { #' data[paste0("iter_", i)] <- dnorm(data$x, seq(-5, 5, length.out = k)[i], 3) #' } #' #' # Note: first, we need to transpose the data to have iters as rows #' iters <- datawizard::data_transpose(data[paste0("iter_", 1:k)]) #' #' # Compute Median #' data$Median <- point_estimate(iters)[["Median"]] #' #' # Compute Credible Intervals ================================ #' #' # Compute ETI (default type of CI) #' data[c("ETI_low", "ETI_high")] <- eti(iters, ci = 0.5)[c("CI_low", "CI_high")] #' #' # Compute CWI #' # ggdist::curve_interval(reshape_iterations(data), iter_value .width = 0.5) #' #' # Visualization ============================================= #' ggplot(data, aes(x = x, y = Median)) + #' geom_ribbon(aes(ymin = ETI_low, ymax = ETI_high), fill = "red", alpha = 0.3) + #' geom_line(linewidth = 1) + #' geom_line( #' data = reshape_iterations(data), #' aes(y = iter_value, group = iter_group), #' alpha = 0.3 #' ) #' } #' } #' @export cwi <- function(x, ...) { UseMethod("cwi") } #' @rdname cwi #' @export cwi.data.frame <- function(x, ci = 0.95, ...) { insight::check_if_installed("ggdist") print("Comming soon!") # @DominiqueMakowski GitBlame says this was 2 years ago - when is "soon"? :-) } bayestestR/R/estimate_density.R0000644000176200001440000004521614407021360016302 0ustar liggesusers#' Density Estimation #' #' This function is a wrapper over different methods of density estimation. By default, it uses the base R `density` with by default uses a different smoothing bandwidth (`"SJ"`) from the legacy default implemented the base R `density` function (`"nrd0"`). However, Deng and Wickham suggest that `method = "KernSmooth"` is the fastest and the most accurate. #' #' @inheritParams hdi #' @inheritParams stats::density #' @param bw See the eponymous argument in `density`. Here, the default has been changed for `"SJ"`, which is recommended. #' @param ci The confidence interval threshold. Only used when `method = "kernel"`. This feature is experimental, use with caution. #' @param method Density estimation method. Can be `"kernel"` (default), `"logspline"` or `"KernSmooth"`. #' @param precision Number of points of density data. See the `n` parameter in `density`. #' @param extend Extend the range of the x axis by a factor of `extend_scale`. #' @param extend_scale Ratio of range by which to extend the x axis. A value of `0.1` means that the x axis will be extended by `1/10` of the range of the data. #' @param select Character vector of column names. If NULL (the default), all numeric variables will be selected. Other arguments from [datawizard::find_columns()] (such as `exclude`) can also be used. #' @param at Optional character vector. If not `NULL` and input is a data frame, density estimation is performed for each group (subsets) indicated by `at`. See examples. #' @param group_by Deprecated in favour of `at`. #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @examplesIf requireNamespace("logspline", quietly = TRUE) && requireNamespace("KernSmooth", quietly = TRUE) && requireNamespace("mclust", quietly = TRUE) #' library(bayestestR) #' #' set.seed(1) #' x <- rnorm(250, mean = 1) #' #' # Basic usage #' density_kernel <- estimate_density(x) # default method is "kernel" #' #' hist(x, prob = TRUE) #' lines(density_kernel$x, density_kernel$y, col = "black", lwd = 2) #' lines(density_kernel$x, density_kernel$CI_low, col = "gray", lty = 2) #' lines(density_kernel$x, density_kernel$CI_high, col = "gray", lty = 2) #' legend("topright", #' legend = c("Estimate", "95% CI"), #' col = c("black", "gray"), lwd = 2, lty = c(1, 2) #' ) #' #' # Other Methods #' density_logspline <- estimate_density(x, method = "logspline") #' density_KernSmooth <- estimate_density(x, method = "KernSmooth") #' density_mixture <- estimate_density(x, method = "mixture") #' #' hist(x, prob = TRUE) #' lines(density_kernel$x, density_kernel$y, col = "black", lwd = 2) #' lines(density_logspline$x, density_logspline$y, col = "red", lwd = 2) #' lines(density_KernSmooth$x, density_KernSmooth$y, col = "blue", lwd = 2) #' lines(density_mixture$x, density_mixture$y, col = "green", lwd = 2) #' #' # Extension #' density_extended <- estimate_density(x, extend = TRUE) #' density_default <- estimate_density(x, extend = FALSE) #' #' hist(x, prob = TRUE) #' lines(density_extended$x, density_extended$y, col = "red", lwd = 3) #' lines(density_default$x, density_default$y, col = "black", lwd = 3) #' #' # Multiple columns #' head(estimate_density(iris)) #' head(estimate_density(iris, select = "Sepal.Width")) #' #' # Grouped data #' head(estimate_density(iris, at = "Species")) #' head(estimate_density(iris$Petal.Width, at = iris$Species)) #' \dontrun{ #' # rstanarm models #' # ----------------------------------------------- #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' head(estimate_density(model)) #' #' library(emmeans) #' head(estimate_density(emtrends(model, ~1, "wt"))) #' #' # brms models #' # ----------------------------------------------- #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' estimate_density(model) #' } #' #' @references Deng, H., & Wickham, H. (2011). Density estimation in R. Electronic publication. #' #' @export estimate_density <- function(x, ...) { UseMethod("estimate_density") } #' @export estimate_density.default <- function(x, ...) { insight::format_error( paste0("`estimate_density()` is not yet implemented for objects of class `", class(x)[1], "`.") ) } #' @keywords internal .estimate_density <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, ...) { method <- match.arg( tolower(method), c("kernel", "logspline", "kernsmooth", "smooth", "mixture", "mclust") ) # Remove NA x <- x[!is.na(x)] if (length(x) < 2) { return(stats::setNames( data.frame(matrix(ncol = 3, nrow = 0)), c("Parameter", "x", "y") )) } # Range x_range <- range(x) if (extend) { extension_scale <- diff(x_range) * extend_scale x_range[1] <- x_range[1] - extension_scale x_range[2] <- x_range[2] + extension_scale } # Replace inf values if needed x_range[is.infinite(x_range)] <- 5.565423e+156 # Kernel if (method == "kernel") { kde <- .estimate_density_kernel(x, x_range, precision, bw, ci, ...) # Logspline } else if (method == "logspline") { kde <- .estimate_density_logspline(x, x_range, precision, ...) # KernSmooth } else if (method %in% c("kernsmooth", "smooth")) { kde <- .estimate_density_KernSmooth(x, x_range, precision, ...) # Mixture } else if (method %in% c("mixture", "mclust")) { kde <- .estimate_density_mixture(x, x_range, precision, ...) } else { insight::format_error("method should be one of 'kernel', 'logspline', 'KernSmooth' or 'mixture'.") } kde } # Methods ----------------------------------------------------------------- #' @export estimate_density.numeric <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, at = NULL, group_by = NULL, ...) { # TODO remove deprecation warning # Sanity if (!is.null(group_by)) { insight::format_warning( "The `group_by` argument is deprecated and might be removed in a future update. Please replace by `at`." ) at <- group_by } if (!is.null(at)) { if (length(at) == 1) { insight::format_error( "`at` must be either the name of a group column if a data frame is entered as input, or in this case (where a single vector was passed) a vector of same length." ) } out <- estimate_density( data.frame(V1 = x, Group = at, stringsAsFactors = FALSE), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, at = "Group", ... ) out$Parameter <- NULL return(out) } out <- .estimate_density( x, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, ... ) class(out) <- .set_density_class(out) out } #' @rdname estimate_density #' @export estimate_density.data.frame <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, select = NULL, at = NULL, group_by = NULL, ...) { # Sanity if (!is.null(group_by)) { insight::format_warning("The 'group_by' argument is deprecated and might be removed in a future update. Please replace by 'at'.") at <- group_by } if (is.null(at)) { # No grouping ------------------- out <- .estimate_density_df( x = x, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, select = select, ... ) } else { # Deal with at- grouping -------- groups <- insight::get_datagrid(x[, at, drop = FALSE], at = at) # Get combinations out <- data.frame() for (row in seq_len(nrow(groups))) { subdata <- datawizard::data_match(x, groups[row, , drop = FALSE]) subdata[names(groups)] <- NULL subdata <- .estimate_density_df( subdata, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, select = select, ... ) out <- rbind(out, merge(subdata, groups[row, , drop = FALSE])) } } class(out) <- .set_density_df_class(out) out } #' @export estimate_density.draws <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, select = NULL, at = NULL, group_by = NULL, ...) { estimate_density( .posterior_draws_to_df(x), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, select = select, at = at, group_by = group_by ) } #' @export estimate_density.rvar <- estimate_density.draws .estimate_density_df <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, select = NULL, ...) { # TODO: replace by exposed select argument if (is.null(select)) { x <- .select_nums(x) } else { x <- datawizard::data_select(x, select, ...) } out <- sapply(x, estimate_density, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, simplify = FALSE) for (i in names(out)) { if (nrow(out[[i]]) == 0) { insight::format_warning(paste0("'", i, "', or one of its 'at' groups, is empty and has no density information.")) } else { out[[i]]$Parameter <- i } } out <- do.call(rbind, out) row.names(out) <- NULL out[, c("Parameter", "x", "y")] } #' @export estimate_density.grouped_df <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, select = NULL, ...) { groups <- .group_vars(x) ungrouped_x <- as.data.frame(x) xlist <- split(ungrouped_x, ungrouped_x[groups]) out <- lapply(names(xlist), function(group) { dens <- estimate_density(xlist[[group]], method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, select = select, ...) dens$Group <- group dens }) do.call(rbind, out) } #' @export estimate_density.emmGrid <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ...) { x <- insight::get_parameters(x) out <- estimate_density(x, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ... ) class(out) <- .set_density_class(out) out } #' @export estimate_density.emm_list <- estimate_density.emmGrid #' @export estimate_density.stanreg <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- estimate_density(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- .set_density_class(out) out } #' @export estimate_density.stanfit <- estimate_density.stanreg #' @export estimate_density.blavaan <- estimate_density.stanreg #' @export estimate_density.brmsfit <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- estimate_density(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- .set_density_class(out) out } #' @export estimate_density.MCMCglmm <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", parameters = NULL, ...) { nF <- x$Fixed$nfl out <- estimate_density(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- .set_density_class(out) out } #' @export estimate_density.mcmc <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", parameters = NULL, ...) { out <- estimate_density(insight::get_parameters(x, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- .set_density_class(out) out } #' @export estimate_density.bayesQR <- estimate_density.mcmc #' @export estimate_density.blrm <- estimate_density.mcmc #' @export estimate_density.bcplm <- estimate_density.mcmc #' @export estimate_density.BGGM <- estimate_density.mcmc #' @export estimate_density.mcmc.list <- estimate_density.mcmc #' @export estimate_density.bamlss <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", component = c("all", "conditional", "location"), parameters = NULL, ...) { component <- match.arg(component) out <- estimate_density( insight::get_parameters(x, component = component, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ... ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- .set_density_class(out) out } #' Coerce to a Data Frame #' #' @inheritParams base::as.data.frame #' @method as.data.frame density #' @export as.data.frame.density <- function(x, ...) { data.frame(x = x$x, y = x$y) } #' Density Probability at a Given Value #' #' Compute the density value at a given point of a distribution (i.e., #' the value of the `y` axis of a value `x` of a distribution). #' #' @param posterior Vector representing a posterior distribution. #' @param x The value of which to get the approximate probability. #' @inheritParams estimate_density #' #' @examples #' library(bayestestR) #' posterior <- distribution_normal(n = 10) #' density_at(posterior, 0) #' density_at(posterior, c(0, 1)) #' @export density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) { density <- estimate_density(posterior, precision = precision, method = method, ...) stats::approx(density$x, density$y, xout = x)$y } # Different functions ----------------------------------------------------- .estimate_density_kernel <- function(x, x_range, precision, bw, ci = 0.95, ...) { # unsupported arguments raise warnings dots <- list(...) dots[c("effects", "component", "parameters")] <- NULL # Get the kernel density estimation (KDE) args <- c(dots, list( x = x, n = precision, bw = bw, from = x_range[1], to = x_range[2] )) fun <- get("density", asNamespace("stats")) kde <- suppressWarnings(do.call("fun", args)) df <- as.data.frame(kde) # Get CI (https://bookdown.org/egarpor/NP-UC3M/app-kde-ci.html) if (!is.null(ci)) { h <- kde$bw # Selected bandwidth # R(K) for a normal Rk <- 1 / (2 * sqrt(pi)) # Estimate the SD sd_kde <- sqrt(df$y * Rk / (length(x) * h)) # CI with estimated variance z_alpha <- stats::qnorm(ci) df$CI_low <- df$y - z_alpha * sd_kde df$CI_high <- df$y + z_alpha * sd_kde } df } .estimate_density_logspline <- function(x, x_range, precision, ...) { insight::check_if_installed("logspline") x_axis <- seq(x_range[1], x_range[2], length.out = precision) y <- logspline::dlogspline(x_axis, logspline::logspline(x, ...), ...) data.frame(x = x_axis, y = y) } .estimate_density_KernSmooth <- function(x, x_range, precision, ...) { insight::check_if_installed("KernSmooth") as.data.frame(KernSmooth::bkde(x, range.x = x_range, gridsize = precision, truncate = TRUE, ...)) } .estimate_density_mixture <- function(x, x_range, precision, ...) { insight::check_if_installed("mclust") x_axis <- seq(x_range[1], x_range[2], length.out = precision) y <- stats::predict(mclust::densityMclust(x, verbose = FALSE, ...), newdata = x_axis, ...) data.frame(x = x_axis, y = y) } # helper ---------------------------------------------------------- .set_density_df_class <- function(out) { setdiff( unique(c("estimate_density_df", "see_estimate_density_df", class(out))), c("estimate_density", "see_estimate_density") ) } .set_density_class <- function(out) { if (is.null(out)) { return(NULL) } setdiff( unique(c("estimate_density", "see_estimate_density", class(out))), c("estimate_density_df", "see_estimate_density_df") ) } bayestestR/R/bayesfactor_models.R0000644000176200001440000005046014407021360016572 0ustar liggesusers#' Bayes Factors (BF) for model comparison #' #' @description This function computes or extracts Bayes factors from fitted models. #' \cr \cr #' The `bf_*` function is an alias of the main function. #' #' @author Mattan S. Ben-Shachar #' #' @param ... Fitted models (see details), all fit on the same data, or a single #' `BFBayesFactor` object (see 'Details'). Ignored in `as.matrix()`, #' `update()`. If the following named arguments are present, they are passed #' to [insight::get_loglikelihood] (see details): #' - `estimator` (defaults to `"ML"`) #' - `check_response` (defaults to `FALSE`) #' @param denominator Either an integer indicating which of the models to use as #' the denominator, or a model to be used as a denominator. Ignored for #' `BFBayesFactor`. #' @param object,x A [bayesfactor_models()] object. #' @param subset Vector of model indices to keep or remove. #' @param reference Index of model to reference to, or `"top"` to #' reference to the best model, or `"bottom"` to reference to the worst #' model. #' @inheritParams hdi #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) #' implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @details #' If the passed models are supported by \pkg{insight} the DV of all models will be tested for equality #' (else this is assumed to be true), and the models' terms will be extracted (allowing for follow-up #' analysis with `bayesfactor_inclusion`). #' #' - For `brmsfit` or `stanreg` models, Bayes factors are computed using the \CRANpkg{bridgesampling} package. #' - `brmsfit` models must have been fitted with `save_pars = save_pars(all = TRUE)`. #' - `stanreg` models must have been fitted with a defined `diagnostic_file`. #' - For `BFBayesFactor`, `bayesfactor_models()` is mostly a wraparound `BayesFactor::extractBF()`. #' - For all other model types, Bayes factors are computed using the BIC approximation. #' Note that BICs are extracted from using [insight::get_loglikelihood], see documentation #' there for options for dealing with transformed responses and REML estimation. #' #' In order to correctly and precisely estimate Bayes factors, a rule of thumb #' are the 4 P's: **P**roper **P**riors and **P**lentiful #' **P**osteriors. How many? The number of posterior samples needed for #' testing is substantially larger than for estimation (the default of 4000 #' samples may not be enough in many cases). A conservative rule of thumb is to #' obtain 10 times more samples than would be required for estimation #' (\cite{Gronau, Singmann, & Wagenmakers, 2017}). If less than 40,000 samples #' are detected, `bayesfactor_models()` gives a warning. #' \cr \cr #' See also [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html). #' #' @inheritSection bayesfactor_parameters Interpreting Bayes Factors #' #' @return A data frame containing the models' formulas (reconstructed fixed and #' random effects) and their `log(BF)`s (Use `as.numeric()` to extract the #' non-log Bayes factors; see examples), that prints nicely. #' #' @examples #' # With lm objects: #' # ---------------- #' lm1 <- lm(mpg ~ 1, data = mtcars) #' lm2 <- lm(mpg ~ hp, data = mtcars) #' lm3 <- lm(mpg ~ hp + drat, data = mtcars) #' lm4 <- lm(mpg ~ hp * drat, data = mtcars) #' (BFM <- bayesfactor_models(lm1, lm2, lm3, lm4, denominator = 1)) #' # bayesfactor_models(lm2, lm3, lm4, denominator = lm1) # same result #' # bayesfactor_models(lm1, lm2, lm3, lm4, denominator = lm1) # same result #' #' #' update(BFM, reference = "bottom") #' as.matrix(BFM) #' as.numeric(BFM) #' #' #' lm2b <- lm(sqrt(mpg) ~ hp, data = mtcars) #' # Set check_response = TRUE for transformed responses #' bayesfactor_models(lm2b, denominator = lm2, check_response = TRUE) #' #' \dontrun{ #' # With lmerMod objects: #' # --------------------- #' if (require("lme4")) { #' lmer1 <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris) #' lmer2 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris) #' lmer3 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species) + (1 | Petal.Width), #' data = iris #' ) #' bayesfactor_models(lmer1, lmer2, lmer3, #' denominator = 1, #' estimator = "REML" #' ) #' } #' #' # rstanarm models #' # --------------------- #' # (note that a unique diagnostic_file MUST be specified in order to work) #' if (require("rstanarm")) { #' stan_m0 <- stan_glm(Sepal.Length ~ 1, #' data = iris, #' family = gaussian(), #' diagnostic_file = file.path(tempdir(), "df0.csv") #' ) #' stan_m1 <- stan_glm(Sepal.Length ~ Species, #' data = iris, #' family = gaussian(), #' diagnostic_file = file.path(tempdir(), "df1.csv") #' ) #' stan_m2 <- stan_glm(Sepal.Length ~ Species + Petal.Length, #' data = iris, #' family = gaussian(), #' diagnostic_file = file.path(tempdir(), "df2.csv") #' ) #' bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE) #' } #' #' #' # brms models #' # -------------------- #' # (note the save_pars MUST be set to save_pars(all = TRUE) in order to work) #' if (require("brms")) { #' brm1 <- brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE)) #' brm2 <- brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE)) #' brm3 <- brm( #' Sepal.Length ~ Species + Petal.Length, #' data = iris, #' save_pars = save_pars(all = TRUE) #' ) #' #' bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE) #' } #' #' #' # BayesFactor #' # --------------------------- #' if (require("BayesFactor")) { #' data(puzzles) #' BF <- anovaBF(RT ~ shape * color + ID, #' data = puzzles, #' whichRandom = "ID", progress = FALSE #' ) #' BF #' bayesfactor_models(BF) # basically the same #' } #' } #' #' @references #' - Gronau, Q. F., Singmann, H., & Wagenmakers, E. J. (2017). Bridgesampling: An R package for estimating #' normalizing constants. arXiv preprint arXiv:1710.08162. #' #' - Kass, R. E., and Raftery, A. E. (1995). Bayes Factors. Journal of the American Statistical Association, #' 90(430), 773-795. #' #' - Robert, C. P. (2016). The expected demise of the Bayes factor. Journal of Mathematical Psychology, #' 72, 33–37. #' #' - Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values. #' Psychonomic bulletin & review, 14(5), 779-804. #' #' - Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011). #' Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests. #' Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923} #' #' @export bayesfactor_models <- function(..., denominator = 1, verbose = TRUE) { UseMethod("bayesfactor_models") } #' @rdname bayesfactor_models #' @export bf_models <- bayesfactor_models #' @export #' @rdname bayesfactor_models bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) { # Organize the models and their names mods <- list(...) denominator <- list(denominator) cl <- match.call(expand.dots = FALSE) estimator <- mods[["estimator"]] check_response <- mods[["check_response"]] if (is.null(estimator)) estimator <- "ML" if (is.null(check_response)) check_response <- FALSE mods[["check_response"]] <- mods[["estimator"]] <- NULL cl$...$estimator <- cl$...$check_response <- NULL names(mods) <- sapply(cl$`...`, insight::safe_deparse) names(denominator) <- insight::safe_deparse(cl$denominator) mods <- .cleanup_BF_models(mods, denominator, cl) mforms <- names(mods) denominator <- attr(mods, "denominator", exact = TRUE) # Get formula / model names # supported models supported_models <- vapply(mods, insight::is_model_supported, TRUE) if (all(supported_models)) { temp_forms <- sapply(mods, .find_full_formula) has_terms <- sapply(temp_forms, nchar) > 0 mforms[has_terms] <- temp_forms[has_terms] supported_models[!has_terms] <- FALSE } objects <- tryCatch(do.call(insight::ellipsis_info, c(mods, verbose = FALSE)), error = function(...) NULL ) if (!is.null(objects)) { were_checked <- inherits(objects, "ListModels") # Validate response if (were_checked && verbose && !isTRUE(attr(objects, "same_response"))) { insight::format_warning( "When comparing models, please note that probably not all models were fit from same data." ) } # Get BIC if (were_checked && estimator == "REML" && any(vapply(mods, insight::is_mixed_model, TRUE)) && !isTRUE(attr(objects, "same_fixef")) && verbose) { insight::format_warning( "Information criteria (like BIC) based on REML fits (i.e. `estimator=\"REML\"`)", "are not recommended for comparison between models with different fixed effects.", "Concider setting `estimator=\"ML\"`." ) } } else if (verbose) { insight::format_alert("Unable to validate that all models were fit with the same data.") } mBIC <- tryCatch(sapply(mods, function(m) { LL <- insight::get_loglikelihood( m, estimator = estimator, check_response = check_response ) stats::BIC(LL) }), error = function(...) NULL) if (is.null(mBIC)) mBIC <- sapply(mods, stats::BIC) # Get BF mBFs <- bic_to_bf(mBIC, denominator = mBIC[denominator], log = TRUE) res <- data.frame( Model = mforms, log_BF = mBFs, stringsAsFactors = FALSE ) .bf_models_output(res, denominator = denominator, bf_method = "BIC approximation", unsupported_models = !all(supported_models), model_names = names(mods) ) } .bayesfactor_models_stan <- function(mods, denominator = 1, verbose = TRUE) { # Warn n_samps <- sapply(mods, function(x) { alg <- insight::find_algorithm(x) if (is.null(alg$iterations)) alg$iterations <- alg$sample (alg$iterations - alg$warmup) * alg$chains }) if (any(n_samps < 4e4) && verbose) { insight::format_warning( "Bayes factors might not be precise.", "For precise Bayes factors, sampling at least 40,000 posterior samples is recommended." ) } if (inherits(mods[[1]], "blavaan")) { res <- .bayesfactor_models_stan_SEM(mods, denominator, verbose) bf_method <- "marginal likelihoods (Laplace approximation)" unsupported_models <- TRUE } else { res <- .bayesfactor_models_stan_REG(mods, denominator, verbose) bf_method <- "marginal likelihoods (bridgesampling)" unsupported_models <- FALSE } .bf_models_output(res, denominator = denominator, bf_method = bf_method, unsupported_models = unsupported_models ) } #' @keywords internal .bayesfactor_models_stan_REG <- function(mods, denominator, verbose = TRUE) { insight::check_if_installed("bridgesampling") # Test that all is good: resps <- lapply(mods, insight::get_response) from_same_data_as_den <- sapply(resps[-denominator], identical, y = resps[[denominator]] ) if (!all(from_same_data_as_den)) { insight::format_error("Models were not computed from the same data.") } mML <- lapply(mods, .get_marglik, verbose = verbose) mBFs <- sapply(mML, function(x) { bf <- bridgesampling::bf(x, mML[[denominator]], log = TRUE) bf[["bf"]] }) # Get formula mforms <- sapply(mods, .find_full_formula) res <- data.frame( Model = mforms, log_BF = mBFs, stringsAsFactors = FALSE ) } .bayesfactor_models_stan_SEM <- function(mods, denominator, verbose = TRUE) { utils::capture.output( suppressWarnings({ mBFs <- sapply(mods, function(m) { blavaan::blavCompare(m, mods[[denominator]])[["bf"]][1] }) }) ) res <- data.frame( Model = names(mods), log_BF = unname(mBFs), stringsAsFactors = FALSE ) } #' @export bayesfactor_models.stanreg <- function(..., denominator = 1, verbose = TRUE) { insight::check_if_installed("rstanarm") # Organize the models and their names mods <- list(...) denominator <- list(denominator) cl <- match.call(expand.dots = FALSE) names(mods) <- sapply(cl$`...`, insight::safe_deparse) names(denominator) <- insight::safe_deparse(cl$denominator) mods <- .cleanup_BF_models(mods, denominator, cl) denominator <- attr(mods, "denominator", exact = TRUE) .bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose) } #' @export bayesfactor_models.brmsfit <- function(..., denominator = 1, verbose = TRUE) { insight::check_if_installed("brms") # Organize the models and their names mods <- list(...) denominator <- list(denominator) cl <- match.call(expand.dots = FALSE) names(mods) <- sapply(cl$`...`, insight::safe_deparse) names(denominator) <- insight::safe_deparse(cl$denominator) mods <- .cleanup_BF_models(mods, denominator, cl) denominator <- attr(mods, "denominator", exact = TRUE) .bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose) } #' @export bayesfactor_models.blavaan <- function(..., denominator = 1, verbose = TRUE) { insight::check_if_installed("blavaan") # Organize the models and their names mods <- list(...) denominator <- list(denominator) cl <- match.call(expand.dots = FALSE) names(mods) <- sapply(cl$`...`, insight::safe_deparse) names(denominator) <- insight::safe_deparse(cl$denominator) mods <- .cleanup_BF_models(mods, denominator, cl) denominator <- attr(mods, "denominator", exact = TRUE) .bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose) } #' @export bayesfactor_models.BFBayesFactor <- function(..., verbose = TRUE) { models <- c(...) insight::check_if_installed("BayesFactor") mBFs <- c(0, BayesFactor::extractBF(models, TRUE, TRUE)) mforms <- sapply(c(models@denominator, models@numerator), function(x) x@shortName) if (!inherits(models@denominator, "BFlinearModel")) { mforms <- .clean_non_linBF_mods(mforms) } else { mforms[mforms == "Intercept only"] <- "1" } res <- data.frame( Model = unname(mforms), log_BF = mBFs, stringsAsFactors = FALSE ) .bf_models_output(res, denominator = 1, bf_method = "JZS (BayesFactor)", unsupported_models = !inherits(models@denominator, "BFlinearModel") ) } # Methods ----------------------------------------------------------------- #' @rdname bayesfactor_models #' @export update.bayesfactor_models <- function(object, subset = NULL, reference = NULL, ...) { if (!is.null(reference)) { if (reference == "top") { reference <- which.max(object$log_BF) } else if (reference == "bottom") { reference <- which.min(object$log_BF) } object$log_BF <- object$log_BF - object$log_BF[reference] attr(object, "denominator") <- reference } denominator <- attr(object, "denominator") if (!is.null(subset)) { if (all(subset < 0)) { subset <- seq_len(nrow(object))[subset] } object_subset <- object[subset, ] if (denominator %in% subset) { attr(object_subset, "denominator") <- which(denominator == subset) } else { object_subset <- rbind(object[denominator, ], object_subset) attr(object_subset, "denominator") <- 1 } object <- object_subset } object } #' @rdname bayesfactor_models #' @export as.matrix.bayesfactor_models <- function(x, ...) { out <- -outer(x$log_BF, x$log_BF, FUN = "-") rownames(out) <- colnames(out) <- x$Model # out <- exp(out) class(out) <- c("bayesfactor_models_matrix", class(out)) out } # Helpers ----------------------------------------------------------------- #' @keywords internal .cleanup_BF_models <- function(mods, denominator, cl) { if (length(mods) == 1 && inherits(mods[[1]], "list")) { mods <- mods[[1]] mod_names <- tryCatch( { sapply(cl$`...`[[1]][-1], insight::safe_deparse) }, error = function(e) { NULL } ) if (!is.null(mod_names) && length(mod_names) == length(mods)) { names(mods) <- mod_names } } if (!is.numeric(denominator[[1]])) { denominator_model <- which(names(mods) == names(denominator)) if (length(denominator_model) == 0) { mods <- c(mods, denominator) denominator <- length(mods) } else { denominator <- denominator_model } } else { denominator <- denominator[[1]] } attr(mods, "denominator") <- denominator mods } #' @keywords internal .bf_models_output <- function(res, denominator = 1, bf_method = "method", unsupported_models = FALSE, model_names = NULL) { attr(res, "denominator") <- denominator attr(res, "BF_method") <- bf_method attr(res, "unsupported_models") <- unsupported_models attr(res, "model_names") <- model_names class(res) <- c("bayesfactor_models", "see_bayesfactor_models", class(res)) res } #' @keywords internal .find_full_formula <- function(mod) { formulas <- insight::find_formula(mod) conditional <- random <- NULL if (!is.null(formulas$conditional)) { conditional <- as.character(formulas$conditional)[3] } if (!is.null(formulas$random)) { if (!is.list(formulas$random)) { formulas$random <- list(formulas$random) } random <- sapply(formulas$random, function(x) { paste0("(", as.character(x)[2], ")") }) } paste(c(conditional, random), collapse = " + ") } #' @keywords internal .clean_non_linBF_mods <- function(m_names) { tryCatch( { m_txt <- character(length = length(m_names)) ## Detect types ## is_null <- startsWith(m_names, "Null") is_rho <- grepl("rho", m_names, fixed = TRUE) is_mu <- grepl("mu", m_names, fixed = TRUE) is_d <- grepl("d", m_names, fixed = TRUE) is_p <- grepl("p", m_names, fixed = TRUE) is_range <- grepl("<", m_names, fixed = TRUE) ## Range Alts ## m_txt[!is_null & is_range] <- sub("^[^\\s]*\\s[^\\s]*\\s", "", m_names[!is_null & is_range]) ## Null models + Not nulls ## if (any(is_d & is_p)) { is_null <- !startsWith(m_names, "Non") temp <- m_names[is_null][1] mi <- gregexpr("\\(.*\\)", temp) aa <- unlist(regmatches(temp, m = mi), use.names = FALSE) m_txt[is_null] <- sub("a=", "a = ", aa, fixed = TRUE) m_txt[!is_null & !is_range] <- sub("a=", "a != ", aa, fixed = TRUE) } else if (any(is_rho)) { m_txt[is_null] <- "rho = 0" m_txt[!is_null & !is_range] <- "rho != 0" m_txt <- sub(" 1)) { stop("'r' should only contain values between -1 and 1.", call. = FALSE) } else { sigma <- r } } else { stop("'r' should be a symetric matrix (relative to the diagonal).", call. = FALSE) } } else if (length(r) == 1L) { if (abs(r) > 1) { stop("'r' should only contain values between -1 and 1.", call. = FALSE) } else { sigma <- matrix(c(1, r, r, 1), nrow = 2) } } else { stop("'r' should be a value (e.g., r = 0.5) or a square matrix.", call. = FALSE) } # Get data data <- MASS::mvrnorm( n = n, mu = rep_len(0, ncol(sigma)), # Means of variables Sigma = sigma, empirical = TRUE ) # Adjust scale if (any(sd != 1)) { data <- t(t(data) * rep_len(sd, ncol(sigma))) } # Adjust mean if (any(mean != 0)) { data <- t(t(data) + rep_len(mean, ncol(sigma))) } data <- as.data.frame(data) # Rename if (!is.null(names)) { if (length(names) == ncol(data)) { names(data) <- names } } data } #' @rdname simulate_correlation #' @export simulate_ttest <- function(n = 100, d = 0.5, names = NULL, ...) { x <- distribution_normal(n, 0, 1) # Continuous variables z <- 0 + d * x # Linear combination pr <- 1 / (1 + exp(-z)) # Pass it through an inverse logit function y <- distribution_binomial(n, 1, pr, random = 3) # Bernoulli response variable data <- data.frame(y = as.factor(y), x = x) names(data) <- paste0("V", 0:(ncol(data) - 1)) if (!is.null(names)) { if (length(names) == ncol(data)) { names(data) <- names } } data } #' @rdname simulate_correlation #' @export simulate_difference <- function(n = 100, d = 0.5, names = NULL, ...) { x <- distribution_normal(round(n / 2), -d / 2, 1) y <- distribution_normal(round(n / 2), d / 2, 1) data <- data.frame( y = as.factor(rep(c(0, 1), each = round(n / 2))), x = c(x, y) ) names(data) <- paste0("V", 0:(ncol(data) - 1)) if (!is.null(names)) { if (length(names) == ncol(data)) { names(data) <- names } } data } # Simulate regression: see https://stats.stackexchange.com/questions/363623/simulate-regression-with-specified-standardized-coefficients/508107#508107 bayestestR/R/weighted_posteriors.R0000644000176200001440000002353014407021360017014 0ustar liggesusers#' Generate posterior distributions weighted across models #' #' Extract posterior samples of parameters, weighted across models. Weighting is #' done by comparing posterior model probabilities, via [bayesfactor_models()]. #' #' @param ... Fitted models (see details), all fit on the same data, or a single #' `BFBayesFactor` object. #' @param missing An optional numeric value to use if a model does not contain a #' parameter that appears in other models. Defaults to 0. #' @param prior_odds Optional vector of prior odds for the models compared to #' the first model (or the denominator, for `BFBayesFactor` objects). For #' `data.frame`s, this will be used as the basis of weighting. #' @param iterations For `BayesFactor` models, how many posterior samples to draw. #' @inheritParams bayesfactor_models #' @inheritParams bayesfactor_parameters #' #' @details #' Note that across models some parameters might play different roles. For #' example, the parameter `A` plays a different role in the model `Y ~ A + B` #' (where it is a main effect) than it does in the model `Y ~ A + B + A:B` #' (where it is a simple effect). In many cases centering of predictors (mean #' subtracting for continuous variables, and effects coding via `contr.sum` or #' orthonormal coding via [`contr.equalprior_pairs`] for factors) can reduce this #' issue. In any case you should be mindful of this issue. #' \cr\cr #' See [bayesfactor_models()] details for more info on passed models. #' \cr\cr #' Note that for `BayesFactor` models, posterior samples cannot be generated #' from intercept only models. #' \cr\cr #' This function is similar in function to `brms::posterior_average`. #' #' @note For `BayesFactor < 0.9.12-4.3`, in some instances there might be #' some problems of duplicate columns of random effects in the resulting data #' frame. #' #' @return A data frame with posterior distributions (weighted across models) . #' #' @seealso [bayesfactor_inclusion()] for Bayesian model averaging. #' #' @examples #' \donttest{ #' if (require("rstanarm") && require("see")) { #' stan_m0 <- stan_glm(extra ~ 1, #' data = sleep, #' family = gaussian(), #' refresh = 0, #' diagnostic_file = file.path(tempdir(), "df0.csv") #' ) #' #' stan_m1 <- stan_glm(extra ~ group, #' data = sleep, #' family = gaussian(), #' refresh = 0, #' diagnostic_file = file.path(tempdir(), "df1.csv") #' ) #' #' res <- weighted_posteriors(stan_m0, stan_m1) #' #' plot(eti(res)) #' } #' #' ## With BayesFactor #' if (require("BayesFactor")) { #' extra_sleep <- ttestBF(formula = extra ~ group, data = sleep) #' #' wp <- weighted_posteriors(extra_sleep) #' #' describe_posterior(extra_sleep, test = NULL) #' describe_posterior(wp$delta, test = NULL) # also considers the null #' } #' #' #' ## weighted prediction distributions via data.frames #' if (require("rstanarm")) { #' m0 <- stan_glm( #' mpg ~ 1, #' data = mtcars, #' family = gaussian(), #' diagnostic_file = file.path(tempdir(), "df0.csv"), #' refresh = 0 #' ) #' #' m1 <- stan_glm( #' mpg ~ carb, #' data = mtcars, #' family = gaussian(), #' diagnostic_file = file.path(tempdir(), "df1.csv"), #' refresh = 0 #' ) #' #' # Predictions: #' pred_m0 <- data.frame(posterior_predict(m0)) #' pred_m1 <- data.frame(posterior_predict(m1)) #' #' BFmods <- bayesfactor_models(m0, m1) #' #' wp <- weighted_posteriors(pred_m0, pred_m1, #' prior_odds = as.numeric(BFmods)[2] #' ) #' #' # look at first 5 prediction intervals #' hdi(pred_m0[1:5]) #' hdi(pred_m1[1:5]) #' hdi(wp[1:5]) # between, but closer to pred_m1 #' } #' } #' @references #' \itemize{ #' \item Clyde, M., Desimone, H., & Parmigiani, G. (1996). Prediction via #' orthogonalized model mixing. Journal of the American Statistical #' Association, 91(435), 1197-1208. #' #' \item Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. #' (2019, March 25). A conceptual introduction to Bayesian Model Averaging. #' \doi{10.31234/osf.io/wgb64} #' #' \item Rouder, J. N., Haaf, J. M., & Vandekerckhove, J. (2018). Bayesian #' inference for psychology, part IV: Parameter estimation and Bayes factors. #' Psychonomic bulletin & review, 25(1), 102-113. #' #' \item van den Bergh, D., Haaf, J. M., Ly, A., Rouder, J. N., & Wagenmakers, #' E. J. (2019). A cautionary note on estimating effect size. #' } #' #' @export weighted_posteriors <- function(..., prior_odds = NULL, missing = 0, verbose = TRUE) { UseMethod("weighted_posteriors") } #' @export #' @rdname weighted_posteriors weighted_posteriors.data.frame <- function(..., prior_odds = NULL, missing = 0, verbose = TRUE) { Mods <- list(...) mnames <- sapply(match.call(expand.dots = FALSE)$`...`, insight::safe_deparse) # find min nrow iterations <- min(sapply(Mods, nrow)) # make weights from prior_odds if (!is.null(prior_odds)) { prior_odds <- c(1, prior_odds) } else { if (verbose) { insight::format_warning( "'prior_odds = NULL'; Using uniform priors odds.\n", "For weighted data frame, 'prior_odds' should be specified as a numeric vector." ) } prior_odds <- rep(1, length(Mods)) } Probs <- prior_odds / sum(prior_odds) weighted_samps <- round(iterations * Probs) # pass to .weighted_posteriors res <- .weighted_posteriors(Mods, weighted_samps, missing) # make weights table attr(res, "weights") <- data.frame(Model = mnames, weights = weighted_samps) return(res) } #' @export #' @rdname weighted_posteriors weighted_posteriors.stanreg <- function(..., prior_odds = NULL, missing = 0, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL) { Mods <- list(...) effects <- match.arg(effects) component <- match.arg(component) # Get Bayes factors BFMods <- bayesfactor_models(..., denominator = 1, verbose = verbose) # Compute posterior model probabilities model_tab <- .get_model_table(BFMods, priorOdds = prior_odds) postProbs <- model_tab$postProbs # Compute weighted number of samples iterations <- min(sapply(Mods, .total_samps)) weighted_samps <- round(iterations * postProbs) # extract parameters params <- lapply(Mods, insight::get_parameters, effects = effects, component = component, parameters = parameters ) res <- .weighted_posteriors(params, weighted_samps, missing) attr(res, "weights") <- data.frame(Model = BFMods$Model, weights = weighted_samps) return(res) } #' @export #' @rdname weighted_posteriors weighted_posteriors.brmsfit <- weighted_posteriors.stanreg #' @export #' @rdname weighted_posteriors weighted_posteriors.blavaan <- weighted_posteriors.stanreg #' @export #' @rdname weighted_posteriors weighted_posteriors.BFBayesFactor <- function(..., prior_odds = NULL, missing = 0, verbose = TRUE, iterations = 4000) { Mods <- c(...) # Get Bayes factors BFMods <- bayesfactor_models(Mods, verbose = verbose) # Compute posterior model probabilities model_tab <- .get_model_table(BFMods, priorOdds = prior_odds, add_effects_table = FALSE) postProbs <- model_tab$postProbs # Compute weighted number of samples weighted_samps <- round(iterations * postProbs) # extract parameters intercept_only <- which(BFMods$Model == "1") params <- vector(mode = "list", length = nrow(BFMods)) for (m in seq_along(params)) { if (length(intercept_only) && m == intercept_only) { # warning( # "Cannot sample from BFBayesFactor model with intercept only (model prob = ", # round(postProbs[m], 3) * 100, "%).\n", # "Omitting the intercept model.", # call. = FALSE # ) params[[m]] <- data.frame( mu = rep(NA, iterations), sig2 = rep(NA, iterations), g = rep(NA, iterations) ) } else if (m == 1) { # If the model is the "den" model params[[m]] <- BayesFactor::posterior(1 / Mods[1], iterations = iterations, progress = FALSE) } else { params[[m]] <- BayesFactor::posterior( Mods[m - 1], iterations = iterations, progress = FALSE ) } } params <- lapply(params, data.frame) res <- .weighted_posteriors(params, weighted_samps, missing) attr(res, "weights") <- data.frame(Model = BFMods$Model, weights = weighted_samps) return(res) } .weighted_posteriors <- function(params, weighted_samps, missing) { par_names <- unique(unlist(sapply(params, colnames), recursive = TRUE)) # remove empty (0 sample) models params <- params[weighted_samps != 0] weighted_samps <- weighted_samps[weighted_samps != 0] for (m in seq_along(weighted_samps)) { temp_params <- params[[m]] i <- sample(nrow(temp_params), size = weighted_samps[m]) temp_params <- temp_params[i, , drop = FALSE] # If any parameters not estimated in the model, they are assumed to be 0 (the default value of `missing`) missing_pars <- setdiff(par_names, colnames(temp_params)) temp_params[, missing_pars] <- missing params[[m]] <- temp_params } # combine all do.call("rbind", params) } #' @keywords internal .total_samps <- function(mod) { x <- insight::find_algorithm(mod) if (is.null(x$iterations)) x$iterations <- x$sample x$chains * (x$iterations - x$warmup) } bayestestR/R/model_to_priors.R0000644000176200001440000000320014276606712016131 0ustar liggesusers#' Convert model's posteriors to priors (EXPERIMENTAL) #' #' Convert model's posteriors to (normal) priors. #' #' @param model A Bayesian model. #' @param scale_multiply The SD of the posterior will be multiplied by this amount before being set as a prior to avoid overly narrow priors. #' @param ... Other arguments for \code{insight::get_prior()} or \code{\link{describe_posterior}}. #' #' @examples #' \dontrun{ #' # brms models #' # ----------------------------------------------- #' if (require("brms")) { #' formula <- brms::brmsformula(mpg ~ wt + cyl, center = FALSE) #' #' model <- brms::brm(formula, data = mtcars, refresh = 0) #' priors <- model_to_priors(model) #' priors <- brms::validate_prior(priors, formula, data = mtcars) #' priors #' #' model2 <- brms::brm(formula, data = mtcars, prior = priors, refresh = 0) #' } #' } #' @export model_to_priors <- function(model, scale_multiply = 3, ...) { UseMethod("model_to_priors") } #' @export model_to_priors.brmsfit <- function(model, scale_multiply = 3, ...) { params <- describe_posterior(model, centrality = "mean", dispersion = TRUE, ci = NULL, test = NULL, ...) priors_params <- attributes(insight::get_priors(model, ...))$priors priors <- brms::prior_summary(model) for (p in priors_params$Parameter) { if (p %in% params$Parameter) { subset <- params[params$Parameter == p, ] priors$prior[priors_params$Parameter == p] <- paste0( "normal(", insight::format_value(subset$Mean), ", ", insight::format_value(subset$SD * scale_multiply), ")" ) } } priors } bayestestR/R/p_map.R0000644000176200001440000002357714407021360014032 0ustar liggesusers#' Bayesian p-value based on the density at the Maximum A Posteriori (MAP) #' #' Compute a Bayesian equivalent of the *p*-value, related to the odds that a #' parameter (described by its posterior distribution) has against the null #' hypothesis (*h0*) using Mills' (2014, 2017) *Objective Bayesian Hypothesis #' Testing* framework. It corresponds to the density value at the null (e.g., 0) #' divided by the density at the Maximum A Posteriori (MAP). #' #' @details Note that this method is sensitive to the density estimation `method` (see the section in the examples below). #' \subsection{Strengths and Limitations}{ #' **Strengths:** Straightforward computation. Objective property of the posterior distribution. #' \cr \cr #' **Limitations:** Limited information favoring the null hypothesis. Relates on density approximation. Indirect relationship between mathematical definition and interpretation. Only suitable for weak / very diffused priors. #' } #' #' @inheritParams hdi #' @inheritParams density_at #' @inheritParams pd #' #' @examples #' library(bayestestR) #' #' p_map(rnorm(1000, 0, 1)) #' p_map(rnorm(1000, 10, 1)) #' \dontrun{ #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' p_map(model) #' #' library(emmeans) #' p_map(emtrends(model, ~1, "wt")) #' #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' p_map(model) #' #' library(BayesFactor) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' p_map(bf) #' #' # --------------------------------------- #' # Robustness to density estimation method #' set.seed(333) #' data <- data.frame() #' for (iteration in 1:250) { #' x <- rnorm(1000, 1, 1) #' result <- data.frame( #' "Kernel" = p_map(x, method = "kernel"), #' "KernSmooth" = p_map(x, method = "KernSmooth"), #' "logspline" = p_map(x, method = "logspline") #' ) #' data <- rbind(data, result) #' } #' data$KernSmooth <- data$Kernel - data$KernSmooth #' data$logspline <- data$Kernel - data$logspline #' #' summary(data$KernSmooth) #' summary(data$logspline) #' boxplot(data[c("KernSmooth", "logspline")]) #' } #' @seealso [Jeff Mill's talk](https://www.youtube.com/watch?v=Ip8Ci5KUVRc) #' #' @references \itemize{ #' \item Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} #' \item Mills, J. A. (2018). Objective Bayesian Precise Hypothesis Testing. University of Cincinnati. #' } #' #' @export p_map <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { UseMethod("p_map") } #' @rdname p_map #' @export p_pointnull <- p_map #' @export p_map.numeric <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { # Density at MAP map <- attributes(map_estimate(x, precision = precision, method = method, ...))$MAP_density # Density at 0 d_0 <- density_at(x, null, precision = precision, method = method, ...) if (is.na(d_0)) d_0 <- 0 # Odds p <- d_0 / map class(p) <- c("p_map", class(p)) p } #' @export p_map.data.frame <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { x <- .select_nums(x) if (ncol(x) == 1) { p_MAP <- p_map(x[, 1], null = null, precision = precision, method = method, ...) } else { p_MAP <- sapply(x, p_map, null = null, precision = precision, method = method, simplify = TRUE, ...) } out <- data.frame( "Parameter" = names(x), "p_MAP" = p_MAP, row.names = NULL, stringsAsFactors = FALSE ) class(out) <- c("p_map", class(out)) out } #' @export p_map.draws <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { p_map(.posterior_draws_to_df(x), null = null, precision = precision, method = method, ...) } #' @export p_map.rvar <- p_map.draws #' @export p_map.emmGrid <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { xdf <- insight::get_parameters(x) out <- p_map(xdf, null = null, precision = precision, method = method, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_map.emm_list <- p_map.emmGrid #' @keywords internal .p_map_models <- function(x, null, precision, method, effects, component, parameters, ...) { p_map( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), null = null, precision = precision, method = method, ... ) } #' @export p_map.mcmc <- function(x, null = 0, precision = 2^10, method = "kernel", parameters = NULL, ...) { out <- .p_map_models( x = x, null = null, precision = precision, method = method, effects = "fixed", component = "conditional", parameters = parameters, ... ) attr(out, "data") <- insight::get_parameters(x, parameters = parameters) out } #' @export p_map.bcplm <- p_map.mcmc #' @export p_map.blrm <- p_map.mcmc #' @export p_map.mcmc.list <- p_map.mcmc #' @export p_map.BGGM <- p_map.mcmc #' @export p_map.bamlss <- function(x, null = 0, precision = 2^10, method = "kernel", component = c("all", "conditional", "location"), parameters = NULL, ...) { component <- match.arg(component) out <- .p_map_models( x = x, null = null, precision = precision, method = method, effects = "all", component = component, parameters = parameters, ... ) out <- .add_clean_parameters_attribute(out, x) attr(out, "data") <- insight::get_parameters(x, parameters = parameters) out } #' @export p_map.sim.merMod <- function(x, null = 0, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), parameters = NULL, ...) { effects <- match.arg(effects) out <- .p_map_models( x = x, null = null, precision = precision, method = method, effects = effects, component = "conditional", parameters = parameters, ... ) attr(out, "data") <- insight::get_parameters(x, effects = effects, parameters = parameters) out } #' @export p_map.sim <- function(x, null = 0, precision = 2^10, method = "kernel", parameters = NULL, ...) { out <- .p_map_models( x = x, null = null, precision = precision, method = method, effects = "fixed", component = "conditional", parameters = parameters, ... ) attr(out, "data") <- insight::get_parameters(x, parameters = parameters) out } #' @rdname p_map #' @export p_map.stanreg <- function(x, null = 0, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( p_map( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), null = null, precision = precision, method = method ), cleaned_parameters, inherits(x, "stanmvreg") ) attr(out, "clean_parameters") <- cleaned_parameters class(out) <- unique(c("p_map", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_map.stanfit <- p_map.stanreg #' @export p_map.blavaan <- p_map.stanreg #' @rdname p_map #' @export p_map.brmsfit <- function(x, null = 0, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( p_map( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), null = null, precision = precision, method = method, ... ), cleaned_parameters ) attr(out, "clean_parameters") <- cleaned_parameters class(out) <- unique(c("p_map", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_map.BFBayesFactor <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { out <- p_map(insight::get_parameters(x), null = null, precision = precision, method = method, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_map.MCMCglmm <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { nF <- x$Fixed$nfl out <- p_map(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), null = null, precision = precision, method = method, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_map.bayesQR <- function(x, null = 0, precision = 2^10, method = "kernel", ...) { out <- p_map(insight::get_parameters(x), null = null, precision = precision, method = method, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @rdname as.numeric.p_direction #' @method as.numeric p_map #' @export as.numeric.p_map <- function(x, ...) { if (inherits(x, "data.frame")) { return(as.numeric(as.vector(x$p_MAP))) } else { return(as.vector(x)) } } #' @method as.double p_map #' @export as.double.p_map <- as.numeric.p_map bayestestR/R/spi.R0000644000176200001440000003416714357655465013555 0ustar liggesusers#' Shortest Probability Interval (SPI) #' #' Compute the **Shortest Probability Interval (SPI)** of posterior distributions. #' The SPI is a more computationally stable HDI. The implementation is based on #' the algorithm from the **SPIn** package. #' #' @inheritParams hdi #' @inherit ci return #' @inherit hdi seealso #' @family ci #' #' @note The code to compute the SPI was adapted from the **SPIn** package, #' and slightly modified to be more robust for Stan models. Thus, credits go #' to Ying Liu for the original SPI algorithm and R implementation. #' #' @details The SPI is an alternative method to the HDI ([hdi()]) to quantify #' uncertainty of (posterior) distributions. The SPI is said to be more stable #' than the HDI, because, the _"HDI can be noisy (that is, have a high Monte Carlo error)"_ #' (Liu et al. 2015). Furthermore, the HDI is sensitive to additional assumptions, #' in particular assumptions related to the different estimation methods, which #' can make the HDI less accurate or reliable (see also discussion #' [here](https://twitter.com/betanalpha/status/1479107186030624771)). #' #' @references #' Liu, Y., Gelman, A., & Zheng, T. (2015). Simulation-efficient shortest probability intervals. Statistics and Computing, 25(4), 809–819. https://doi.org/10.1007/s11222-015-9563-8 #' #' @examplesIf requireNamespace("quadprog", quietly = TRUE) #' library(bayestestR) #' #' posterior <- rnorm(1000) #' spi(posterior) #' spi(posterior, ci = c(0.80, 0.89, 0.95)) #' #' df <- data.frame(replicate(4, rnorm(100))) #' spi(df) #' spi(df, ci = c(0.80, 0.89, 0.95)) #' \dontrun{ #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' spi(model) #' } #' #' @export spi <- function(x, ...) { UseMethod("spi") } #' @export spi.default <- function(x, ...) { stop(insight::format_message(paste0("'spi()' is not yet implemented for objects of class '", class(x)[1], "'.")), call. = FALSE) } #' @rdname spi #' @export spi.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- do.call(rbind, lapply(ci, function(i) { .spi(x = x, ci = i, verbose = verbose) })) class(out) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_ci", "see_ci", "bayestestR_spi", class(out))) attr(out, "data") <- x out } #' @export spi.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "spi") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export spi.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) { hdi(x, ci = ci, verbose = verbose, ci_method = "spi", ...) } #' @export spi.bamlss <- function(x, ci = 0.95, component = c("all", "conditional", "location"), verbose = TRUE, ...) { component <- match.arg(component) hdi(x, ci = ci, component = component, verbose = verbose, ci_method = "spi") } #' @export spi.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) { hdi(x, ci = ci, verbose = verbose, ci_method = "spi", ...) } #' @export spi.bcplm <- spi.mcmc #' @export spi.bayesQR <- spi.mcmc #' @export spi.blrm <- spi.mcmc #' @export spi.mcmc.list <- spi.mcmc #' @export spi.BGGM <- spi.mcmc #' @export spi.sim.merMod <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) hdi(x, ci = ci, effects = effects, parameters = parameters, verbose = verbose, ci_method = "spi", ...) } #' @export spi.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { hdi(x, ci = ci, parameters = parameters, verbose = verbose, ci_method = "spi", ...) } #' @export spi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) out <- spi(xdf, ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export spi.emm_list <- spi.emmGrid #' @rdname spi #' @export spi.stanreg <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( spi( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), ci = ci, verbose = verbose, ... ), cleaned_parameters, inherits(x, "stanmvreg") ) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_spi", class(out))) out } #' @export spi.stanfit <- spi.stanreg #' @export spi.blavaan <- spi.stanreg #' @rdname spi #' @export spi.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( spi( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), ci = ci, verbose = verbose, ... ), cleaned_parameters ) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_spi", class(out))) out } #' @export spi.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- spi(insight::get_parameters(x), ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export spi.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { out <- spi(as.data.frame(t(attributes(x)$iterations)), ...) } else { stop("No iterations present in the output.", call. = FALSE) } attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } # Helper ------------------------------------------------------------------ # Code taken (and slightly simplified) from: # SPIn::SPIn() # Author: Ying Liu yliu@stat.columbia.edu # Reference: Simulation efficient shortest probability intervals. (arXiv:1302.2142) # Code licensed under License: GPL (>= 2) .spi <- function(x, ci, verbose = TRUE) { insight::check_if_installed("quadprog") check_ci <- .check_ci_argument(x, ci, verbose) if (!is.null(check_ci)) { return(check_ci) } dens <- stats::density(x) n.sims <- length(x) conf <- 1 - ci nn <- round(n.sims * conf) # sanity check for very low CI levels if (nn >= n.sims) { nn <- n.sims <- 1 } x <- sort(x) xx <- x[(n.sims - nn):n.sims] - x[1:(nn + 1)] m <- min(xx) k <- which(xx == m)[1] l <- x[k] ui <- n.sims - nn + k - 1 u <- x[ui] bw <- round((sqrt(n.sims) - 1) / 2) k <- which(x == l)[1] ui <- which(x == u)[1] # lower bound if (all(!is.na(k)) && all(k == 1)) { x.l <- l } else { x.l <- tryCatch( { .spi_lower(bw = bw, n.sims = n.sims, k = k, l = l, dens = dens, x = x) }, error = function(e) NULL ) frac <- 1 while (is.null(x.l)) { frac <- frac - .1 x.l <- tryCatch( { .spi_lower(bw = frac * bw, n.sims = n.sims, k = k, l = l, dens = dens, x = x) }, error = function(e) NULL ) if (frac <= .1) { message(insight::color_text(insight::format_message( "Could not find a solution for the SPI lower bound." ), color = "red")) x.l <- NA } } } # upper bound if (all(!is.na(ui)) && all(ui == n.sims)) { x.u <- u } else { x.u <- tryCatch( { .spi_upper(bw = bw, n.sims = n.sims, ui = ui, u = u, dens = dens, x = x) }, error = function(e) NULL ) frac <- 1 while (is.null(x.u)) { frac <- frac - .1 x.u <- tryCatch( { .spi_upper(bw = frac * bw, n.sims = n.sims, ui = ui, u = u, dens = dens, x = x) }, error = function(e) NULL ) if (frac <= .1) { message(insight::color_text(insight::format_message( "Could not find a solution for the SPI upper bound." ), color = "red")) x.u <- NA } } } # output data.frame( "CI" = ci, "CI_low" = x.l, "CI_high" = x.u ) } .spi_lower <- function(bw, n.sims, k, l, dens, x) { l.l <- max(1, k - bw) l.u <- k + (k - l.l) range_ll_lu <- l.u - l.l range_ll_k <- k - l.l n.l <- range_ll_lu + 1 D.l <- matrix(nrow = n.l, ncol = n.l) # create quadratic function p <- (l.l:l.u) / (n.sims + 1) q <- 1 - p Q <- stats::quantile(x, p) d.q <- rep(0, n.l) for (r in 1:n.l) { d.q[r] <- dens$y[which.min(abs(dens$x - Q[r]))] } Q. <- 1 / d.q diag(D.l) <- 2 * (Q^2 + p * q * Q.^2 / (n.sims + 2)) d.l <- 2 * Q * l if (n.l > 1) { for (j in 1:(n.l - 1)) { for (m in (j + 1):n.l) { D.l[j, m] <- Q.[j] * Q.[m] * p[j] * q[m] * 2 / (n.sims + 2) + Q[j] * Q[m] * 2 D.l[m, j] <- D.l[j, m] } } } # create constraint matrix A.l <- matrix(0, nrow = range_ll_lu + 3, ncol = range_ll_lu + 1) A.l[1, ] <- 1 if (bw > 1) { if (k > 2) { for (j in 1:(range_ll_k - 1)) { if (x[l.l + j + 1] == x[l.l + j]) { A.l[1 + j, j + 1] <- 1 A.l[1 + j, j + 2] <- -1 } else { aa <- (x[l.l + j] - x[l.l + j - 1]) / (x[l.l + j + 1] - x[l.l + j]) A.l[1 + j, j] <- 1 A.l[1 + j, j + 1] <- -(aa + 1) A.l[1 + j, j + 2] <- aa } } for (j in 0:(l.u - k - 2)) { if (x[k + j + 1] == x[k + j + 2]) { A.l[range_ll_k + 1 + j, range_ll_k + 2 + j] <- 1 A.l[range_ll_k + 1 + j, range_ll_k + 3 + j] <- -1 } else { aa <- (x[k + j] - x[k + j + 1]) / (x[k + j + 1] - x[k + j + 2]) A.l[range_ll_k + 1 + j, range_ll_k + 1 + j] <- -1 A.l[range_ll_k + 1 + j, range_ll_k + 2 + j] <- aa + 1 A.l[range_ll_k + 1 + j, range_ll_k + 3 + j] <- -aa } } } } if (x[k + 1] == x[k]) { aa <- (x[k] - x[k - 1]) / (x[k + 1] - x[k] + .000001) } else { aa <- (x[k] - x[k - 1]) / (x[k + 1] - x[k]) } A.l[range_ll_lu, range_ll_k + 1] <- aa - 1 A.l[range_ll_lu, range_ll_k] <- 1 A.l[range_ll_lu, range_ll_k + 2] <- -aa A.l[range_ll_lu + 1, range_ll_lu] <- 1 A.l[range_ll_lu + 1, range_ll_lu + 1] <- -1 A.l[range_ll_lu + 2, 1] <- 1 A.l[range_ll_lu + 3, range_ll_lu + 1] <- 1 A.l <- t(A.l) w.l <- quadprog::solve.QP(D.l, d.l, A.l, c(1, rep(0, range_ll_lu + 2)), range_ll_lu) x.l <- w.l$solution %*% x[l.l:l.u] return(x.l) } .spi_upper <- function(bw, n.sims, ui, u, dens, x) { u.u <- min(n.sims, ui + bw) u.l <- ui - (u.u - ui) range_ul_uu <- u.u - u.l range_ul_ui <- ui - u.l n.u <- range_ul_uu + 1 D.u <- matrix(nrow = n.u, ncol = n.u) # create quadratic function p <- (u.l:u.u) / (n.sims + 1) q <- 1 - p Q <- stats::quantile(x, p) d.q <- rep(0, n.u) for (r in 1:n.u) { d.q[r] <- dens$y[which.min(abs(dens$x - Q[r]))] } Q. <- 1 / d.q diag(D.u) <- 2 * (Q^2 + p * q * Q.^2 / (n.sims + 2)) d.u <- 2 * Q * u if (n.u > 1) { for (j in 1:(n.u - 1)) { for (m in (j + 1):n.u) { D.u[j, m] <- Q.[j] * Q.[m] * p[j] * q[m] * 2 / (n.sims + 2) + Q[j] * Q[m] * 2 D.u[m, j] <- D.u[j, m] } } } # create constraint matrix A.u <- matrix(0, nrow = range_ul_uu + 3, ncol = range_ul_uu + 1) A.u[1, ] <- 1 if (bw > 1) { if (range_ul_ui > 1) { for (j in 1:(range_ul_ui - 1)) { if (x[u.l + j + 1] == x[u.l + j]) { A.u[1 + j, j + 1] <- 1 A.u[1 + j, j + 2] <- -1 } else { aa <- (x[u.l + j] - x[u.l + j - 1]) / (x[u.l + j + 1] - x[u.l + j]) A.u[1 + j, j] <- 1 A.u[1 + j, j + 1] <- -(aa + 1) A.u[1 + j, j + 2] <- aa } } i <- 0 for (j in (range_ul_ui):(range_ul_uu - 2)) { if (x[ui + i + 1] == x[ui + i + 2]) { A.u[1 + j, j + 2] <- 1 A.u[1 + j, j + 3] <- -1 } else { aa <- (x[ui + i] - x[ui + i + 1]) / (x[ui + i + 1] - x[ui + i + 2]) A.u[1 + j, j + 1] <- -1 A.u[1 + j, j + 2] <- aa + 1 A.u[1 + j, j + 3] <- -aa } i <- i + 1 } } } if (x[ui + 1] == x[ui]) { aa <- (x[ui] - x[ui - 1]) / (x[ui + 2] - x[ui]) A.u[range_ul_uu, range_ul_ui] <- 1 A.u[range_ul_uu, range_ul_ui + 1] <- aa - 1 A.u[range_ul_uu, range_ul_ui + 3] <- -aa } else { aa <- (x[ui] - x[ui - 1]) / (x[ui + 1] - x[ui]) A.u[range_ul_uu, range_ul_ui] <- 1 A.u[range_ul_uu, range_ul_ui + 1] <- aa - 1 A.u[range_ul_uu, range_ul_ui + 2] <- -aa } A.u[range_ul_uu + 1, range_ul_uu] <- 1 A.u[range_ul_uu + 1, range_ul_uu + 1] <- -1 A.u[range_ul_uu + 2, 1] <- 1 A.u[range_ul_uu + 3, range_ul_uu + 1] <- 1 A.u <- t(A.u) w.u <- quadprog::solve.QP(D.u, d.u, A.u, c(1, rep(0, range_ul_uu + 2)), range_ul_uu) x.u <- w.u$solution %*% x[u.l:u.u] return(x.u) } bayestestR/R/print_md.R0000644000176200001440000001251214307033605014541 0ustar liggesusers# Reexports models ------------------------ #' @importFrom insight print_md #' @export insight::print_md #' @export print_md.describe_posterior <- function(x, digits = 2, caption = "Summary of Posterior Distribution", ...) { .print_md_default(x = x, digits = digits, caption = caption, ...) } #' @export print_md.point_estimate <- function(x, digits = 2, caption = "Point Estimate", ...) { .print_md_default(x = x, digits = digits, caption = caption, ...) } #' @export print_md.map_estimate <- function(x, digits = 2, caption = "MAP Estimate", ...) { .print_md_default(x = x, digits = digits, caption = caption, ...) } #' @export print_md.p_direction <- function(x, digits = 2, caption = "Probability of Direction (pd)", ...) { .print_md_default(x = x, digits = digits, caption = caption, ...) } #' @export print_md.p_map <- function(x, digits = 2, caption = "MAP-based p-value", ...) { .print_md_default(x = x, digits = digits, caption = caption, ...) } #' @export print_md.p_rope <- function(x, digits = 2, ...) { caption <- sprintf( "Proportion of samples inside the ROPE [%.*f, %.*f]", digits, x$ROPE_low[1], digits, x$ROPE_high[1] ) x$ROPE_low <- x$ROPE_high <- NULL .print_md_default(x = x, digits = digits, caption = caption, ci_string = "ROPE", ...) } #' @export print_md.p_significance <- function(x, digits = 2, ...) { caption <- sprintf( "Practical Significance (threshold: %s)", insight::format_value(attributes(x)$threshold, digits = digits) ) .print_md_default(x = x, digits = digits, caption = caption, ...) } #' @export print_md.bayestestR_hdi <- function(x, digits = 2, caption = "Highest Density Interval", ...) { .print_md_default(x = x, digits = digits, caption = caption, ci_string = "HDI", ...) } #' @export print_md.bayestestR_eti <- function(x, digits = 2, caption = "Equal-Tailed Interval", ...) { .print_md_default(x = x, digits = digits, caption = caption, ci_string = "ETI", ...) } #' @export print_md.bayestestR_si <- function(x, digits = 2, caption = "Support Interval", ...) { .print_md_default(x = x, digits = digits, caption = caption, ci_string = "SI", ...) } # special handling for bayes factors ------------------ #' @export print_md.bayesfactor_models <- function(x, digits = 3, log = FALSE, show_names = TRUE, caption = "Bayes Factors for Model Comparison", ...) { .print_bf_md_default( x = x, digits = digits, log = log, show_names = show_names, caption = caption, align = c("llr"), ... ) } #' @export print_md.bayesfactor_inclusion <- function(x, digits = 3, log = FALSE, caption = "Inclusion Bayes Factors (Model Averaged)", ...) { .print_bf_md_default( x = x, digits = digits, log = log, caption = caption, align = c("lrrr"), ... ) } #' @export print_md.bayesfactor_restricted <- function(x, digits = 3, log = FALSE, caption = "Bayes Factor (Order-Restriction)", ...) { .print_bf_md_default(x = x, digits = digits, log = log, caption = caption, ...) } #' @export print_md.bayesfactor_parameters <- function(x, digits = 3, log = FALSE, ...) { # retrieve information with cleaned parameter names cp <- attr(x, "clean_parameters") # format data frame and columns formatted_table <- format( x, cp = cp, digits = digits, log = log, format = "markdown", ... ) insight::export_table(formatted_table, format = "markdown") } # util --------------- .print_md_default <- function(x, digits = 2, caption = NULL, subtitles = NULL, ci_string = "CI", ...) { # retrieve information with cleaned parameter names cp <- attr(x, "clean_parameters") # format data frame and columns formatted_table <- format( x, cp = cp, digits = digits, format = "markdown", ci_string = ci_string, caption = caption, subtitles = subtitles, ... ) # print for data frame - I don't think we need a special handling for # numeric values to have a markdown-table output insight::export_table( formatted_table, caption = caption, format = "markdown" ) } .print_bf_md_default <- function(x, digits = 3, log = FALSE, show_names = NULL, caption = NULL, align = NULL, ...) { formatted_table <- format( x, digits = digits, log = log, show_names = show_names, caption = caption, format = "markdown", ... ) insight::export_table( formatted_table, align = align, caption = caption, format = "markdown" ) } bayestestR/R/utils_bayesfactor.R0000644000176200001440000003107414407021360016447 0ustar liggesusers# clean priors and posteriors --------------------------------------------- #' @keywords internal .clean_priors_and_posteriors <- function(posterior, prior, verbose = TRUE, ...) { UseMethod(".clean_priors_and_posteriors") } #' @keywords internal .clean_priors_and_posteriors.stanreg <- function(posterior, prior, verbose = TRUE, effects, component, ...) { # Get Priors if (is.null(prior)) { prior <- posterior } prior <- try(unupdate(prior, verbose = verbose), silent = TRUE) if (methods::is(prior, "try-error")) { if (grepl("flat priors", prior, fixed = TRUE)) { prior <- paste0( prior, "Could not therefore compute Bayes factors, as these inform about ", "the raltive likelihood of two 'hypotheses', and flat priors provide no ", "likelihood.\n", "See '?bayesfactor_parameters' for more information.\n" ) } insight::format_error(prior) } prior <- insight::get_parameters(prior, effects = effects, component = component, ...) posterior <- insight::get_parameters(posterior, effects = effects, component = component, ...) list( posterior = posterior, prior = prior ) } #' @keywords internal .clean_priors_and_posteriors.brmsfit <- .clean_priors_and_posteriors.stanreg #' @keywords internal .clean_priors_and_posteriors.blavaan <- function(posterior, prior, verbose = TRUE, ...) { # Get Priors if (is.null(prior)) { prior <- posterior } prior <- unupdate(prior, verbose = verbose) prior <- insight::get_parameters(prior) posterior <- insight::get_parameters(posterior) list( posterior = posterior, prior = prior ) } #' @keywords internal .clean_priors_and_posteriors.emmGrid <- function(posterior, prior, verbose = TRUE) { insight::check_if_installed("emmeans") if (is.null(prior)) { prior <- posterior warning( "Prior not specified! ", "Please provide the original model to get meaningful results." ) } if (!inherits(prior, "emmGrid")) { # then is it a model on.exit( stop( "Unable to reconstruct prior estimates.\n", "Perhaps the emmGrid object has been transformed or regrid()-ed?\n", "See function details.\n\n", "Instead, you can reestimate the emmGrid with a prior model, Try:\n", "\tprior_model <- unupdate(mode)\n", "\tprior_emmgrid <- emmeans(prior_model, ...) # pass this as the 'prior' argument.", call. = FALSE ) ) if (inherits(prior, "brmsfit")) { stop("Cannot rebuild prior emmGrid from a brmsfit model.", call. = FALSE) } prior <- try(unupdate(prior, verbose = verbose), silent = TRUE) if (inherits(prior, "try-error")) { on.exit() # undo general error message if (grepl("flat priors", prior, fixed = TRUE)) { prior <- paste0( prior, "Could not therefore compute Bayes factors, as these inform about ", "the raltive likelihood of two 'hypotheses', and flat priors provide no ", "likelihood.\n", "See '?bayesfactor_parameters' for more information.\n" ) } stop(prior, call. = FALSE) } prior <- emmeans::ref_grid(prior) prior <- prior@post.beta if (!isTRUE(all.equal(colnames(prior), colnames(posterior@post.beta)))) { stop("post.beta and prior.beta are non-conformable arguments.", call. = FALSE ) } prior <- stats::update(posterior, post.beta = prior) on.exit() # undo general error message } prior <- insight::get_parameters(prior) posterior <- insight::get_parameters(posterior) list( posterior = posterior, prior = prior ) } .clean_priors_and_posteriors.emm_list <- function(posterior, prior, verbose = TRUE) { if (is.null(prior)) { prior <- posterior warning( "Prior not specified! ", "Please provide the original model to get meaningful results." ) } if (!inherits(prior, "emm_list")) { # prior is a model if (inherits(prior, "brmsfit")) { stop("Cannot rebuild prior emm_list from a brmsfit model.", call. = FALSE) } prior <- try(unupdate(prior, verbose = verbose), silent = TRUE) if (inherits(prior, "try-error")) { if (grepl("flat priors", prior, fixed = TRUE)) { prior <- paste0( prior, "Could not therefore compute Bayes factors, as these inform about ", "the raltive likelihood of two 'hypotheses', and flat priors provide no ", "likelihood.\n", "See '?bayesfactor_parameters' for more information.\n" ) } stop(prior, call. = FALSE) } } # prior is now a model, or emm_list # is it a model? pass_em <- inherits(prior, "emm_list") res <- lapply(seq_along(posterior), function(i) { .clean_priors_and_posteriors.emmGrid( posterior[[i]], prior = if (pass_em) prior[[i]] else prior, verbose = verbose ) }) posterior <- do.call("cbind", lapply(res, "[[", "posterior")) prior <- do.call("cbind", lapply(res, "[[", "prior")) list( posterior = posterior, prior = prior ) } # BMA --------------------------------------------------------------------- #' @keywords internal .get_model_table <- function(BFGrid, priorOdds = NULL, add_effects_table = TRUE, ...) { denominator <- attr(BFGrid, "denominator") BFGrid <- rbind(BFGrid[denominator, ], BFGrid[-denominator, ]) attr(BFGrid, "denominator") <- 1 # This looks like it does nothing, but this is needed to prevent Inf in large BFs. # Small BFs are better than large BFs BFGrid <- stats::update(BFGrid, reference = "top") # Prior and post odds Modelnames <- BFGrid$Model if (!is.null(priorOdds)) { priorOdds <- c(1, priorOdds) } else { priorOdds <- rep(1, length(Modelnames)) } prior_logodds <- log(priorOdds) posterior_logodds <- prior_logodds + BFGrid$log_BF # norm prior_logodds <- prior_logodds - log(sum(exp(prior_logodds))) posterior_logodds <- posterior_logodds - log(sum(exp(posterior_logodds))) df.model <- data.frame( Modelnames, priorProbs = exp(prior_logodds), postProbs = exp(posterior_logodds), stringsAsFactors = FALSE ) # add effects table if (add_effects_table) { for (m in seq_len(nrow(df.model))) { tmp_terms <- .make_terms(df.model$Modelnames[m]) if (length(tmp_terms) > 0) { missing_terms <- !tmp_terms %in% colnames(df.model) if (any(missing_terms)) df.model[, tmp_terms[missing_terms]] <- NA df.model[m, tmp_terms] <- TRUE } } } df.model[is.na(df.model)] <- FALSE df.model } #' @keywords internal .make_terms <- function(formula) { sort_interactions <- function(x) { if (grepl(":", x, fixed = TRUE)) { effs <- unlist(strsplit(x, ":", fixed = TRUE)) x <- paste0(sort(effs), collapse = ":") } x } formula.f <- stats::as.formula(paste0("~", formula)) all.terms <- attr(stats::terms(formula.f), "term.labels") # Fixed fix_trms <- all.terms[!grepl("|", all.terms, fixed = TRUE)] # no random if (length(fix_trms) > 0) { fix_trms <- sapply(fix_trms, sort_interactions) } # Random random_parts <- paste0(grep("|", all.terms, fixed = TRUE, value = TRUE)) # only random if (length(random_parts) == 0) { return(fix_trms) } random_units <- sub("^.+\\|\\s+", "", random_parts) tmp_random <- lapply( sub("\\|.+$", "", random_parts), function(x) stats::as.formula(paste0("~", x)) ) rand_trms <- vector("list", length(random_parts)) for (i in seq_along(random_parts)) { tmp_trms <- attr(stats::terms.formula(tmp_random[[i]]), "term.labels") tmp_trms <- sapply(tmp_trms, sort_interactions) if (!any(unlist(strsplit(as.character(tmp_random[[i]])[[2]], " + ", fixed = TRUE)) == "0")) { tmp_trms <- c("1", tmp_trms) } rand_trms[[i]] <- paste0(tmp_trms, ":", random_units[[i]]) } c(fix_trms, unlist(rand_trms)) } # make_BF_plot_data ------------------------------------------------------- #' @keywords internal .make_BF_plot_data <- function(posterior, prior, direction, null, extend_scale = 0.05, precision = 2^8, ...) { insight::check_if_installed("logspline") estimate_samples_density <- function(samples) { nm <- insight::safe_deparse_symbol(substitute(samples)) samples <- utils::stack(samples) samples <- split(samples, samples$ind) samples <- lapply(samples, function(data) { # 1. estimate density x <- data$values x_range <- range(x) x_rangex <- stats::median(x) + 7 * stats::mad(x) * c(-1, 1) x_range <- c( max(c(x_range[1], x_rangex[1])), min(c(x_range[2], x_rangex[2])) ) x_range <- range(c(x_range, null)[!is.infinite(c(x_range, null))]) extension_scale <- diff(x_range) * extend_scale x_range <- x_range + c(-1, 1) * extension_scale x_axis <- seq(x_range[1], x_range[2], length.out = precision) # x_axis <- sort(unique(c(x_axis, null))) f_x <- .logspline(x, ...) y <- logspline::dlogspline(x_axis, f_x) d_points <- data.frame(x = x_axis, y = y) # 2. estimate points d_null <- stats::approx(d_points$x, d_points$y, xout = null) d_null$y[is.na(d_null$y)] <- 0 # 3. direction? if (direction > 0) { d_points <- d_points[d_points$x >= min(null), , drop = FALSE] if (is.infinite(min(null))) { norm_factor <- 1 } else { norm_factor <- 1 - logspline::plogspline(min(null), f_x) } d_points$y <- d_points$y / norm_factor d_null$y <- d_null$y / norm_factor } else if (direction < 0) { d_points <- d_points[d_points$x <= max(null), , drop = FALSE] if (is.infinite(max(null))) { norm_factor <- 1 } else { norm_factor <- logspline::plogspline(max(null), f_x) } d_points$y <- d_points$y / norm_factor d_null$y <- d_null$y / norm_factor } d_points$ind <- d_null$ind <- data$ind[1] list(d_points, d_null) }) # 4a. organize point0 <- lapply(samples, function(.) as.data.frame(.[[2]])) point0 <- do.call("rbind", point0) samplesX <- lapply(samples, function(.) .[[1]]) samplesX <- do.call("rbind", samplesX) samplesX$Distribution <- point0$Distribution <- nm rownames(samplesX) <- rownames(point0) <- c() list(samplesX, point0) } # 4b. orgenize posterior <- estimate_samples_density(posterior) prior <- estimate_samples_density(prior) list( plot_data = rbind(posterior[[1]], prior[[1]]), d_points = rbind(posterior[[2]], prior[[2]]) ) } # As numeric vector ------------------------------------------------------- #' @export as.numeric.bayesfactor_inclusion <- function(x, log = FALSE, ...) { out <- x[["log_BF"]] if (!log) out <- exp(out) return(out) } #' @export as.numeric.bayesfactor_models <- as.numeric.bayesfactor_inclusion #' @export as.numeric.bayesfactor_parameters <- as.numeric.bayesfactor_inclusion #' @export as.numeric.bayesfactor_restricted <- as.numeric.bayesfactor_inclusion ## Double: #' @export as.double.bayesfactor_inclusion <- as.numeric.bayesfactor_inclusion #' @export as.double.bayesfactor_models <- as.numeric.bayesfactor_inclusion #' @export as.double.bayesfactor_parameters <- as.numeric.bayesfactor_inclusion #' @export as.double.bayesfactor_restricted <- as.numeric.bayesfactor_inclusion # logspline --------------------------------------------------------------- #' @keywords internal .logspline <- function(x, ...) { insight::check_if_installed("logspline") in_args <- list(...) # arg_names <- names(formals(logspline::logspline, envir = parent.frame())) arg_names <- names(formals(logspline::logspline)) in_args <- in_args[names(in_args) %in% arg_names] in_args <- c(list(x = x), in_args) suppressWarnings(do.call(logspline::logspline, in_args)) } bayestestR/R/describe_posterior.R0000644000176200001440000012445714407021360016623 0ustar liggesusers#' Describe Posterior Distributions #' #' Compute indices relevant to describe and characterize the posterior distributions. #' #' @param posteriors A vector, data frame or model of posterior draws. #' **bayestestR** supports a wide range of models (see `methods("describe_posterior")`) #' and not all of those are documented in the 'Usage' section, because methods #' for other classes mostly resemble the arguments of the `.numeric` method. #' @param ci_method The type of index used for Credible Interval. Can be #' `"ETI"` (default, see [bayestestR::eti()]), `"HDI"` #' (see [bayestestR::hdi()]), `"BCI"` (see #' [bayestestR::bci()]), `"SPI"` (see [bayestestR::spi()]), or #' `"SI"` (see [bayestestR::si()]). #' @param test The indices of effect existence to compute. Character (vector) or #' list with one or more of these options: `"p_direction"` (or `"pd"`), #' `"rope"`, `"p_map"`, `"equivalence_test"` (or `"equitest"`), #' `"bayesfactor"` (or `"bf"`) or `"all"` to compute all tests. #' For each "test", the corresponding \pkg{bayestestR} function is called #' (e.g. [bayestestR::rope()] or [bayestestR::p_direction()]) and its results #' included in the summary output. #' @param rope_range ROPE's lower and higher bounds. Should be a list of two #' values (e.g., `c(-0.1, 0.1)`) or `"default"`. If `"default"`, #' the bounds are set to `x +- 0.1*SD(response)`. #' @param rope_ci The Credible Interval (CI) probability, corresponding to the #' proportion of HDI, to use for the percentage in ROPE. #' @param keep_iterations If `TRUE`, will keep all iterations (draws) of #' bootstrapped or Bayesian models. They will be added as additional columns #' named `iter_1, iter_2, ...`. You can reshape them to a long format by #' running [bayestestR::reshape_iterations()]. #' @param bf_prior Distribution representing a prior for the computation of #' Bayes factors / SI. Used if the input is a posterior, otherwise (in the #' case of models) ignored. #' @param priors Add the prior used for each parameter. #' #' @inheritParams point_estimate #' @inheritParams ci #' @inheritParams si #' #' @details #' One or more components of point estimates (like posterior mean or median), #' intervals and tests can be omitted from the summary output by setting the #' related argument to `NULL`. For example, `test = NULL` and `centrality = #' NULL` would only return the HDI (or CI). #' #' @references #' - Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). #' *Indices of Effect Existence and Significance in the Bayesian Framework*. #' Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} #' - [Region of Practical Equivalence (ROPE)](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html) #' - [Bayes factors](https://easystats.github.io/bayestestR/articles/bayes_factors.html) #' #' @examples #' library(bayestestR) #' #' if (require("logspline")) { #' x <- rnorm(1000) #' describe_posterior(x, verbose = FALSE) #' describe_posterior(x, #' centrality = "all", #' dispersion = TRUE, #' test = "all", #' verbose = FALSE #' ) #' describe_posterior(x, ci = c(0.80, 0.90), verbose = FALSE) #' #' df <- data.frame(replicate(4, rnorm(100))) #' describe_posterior(df, verbose = FALSE) #' describe_posterior( #' df, #' centrality = "all", #' dispersion = TRUE, #' test = "all", #' verbose = FALSE #' ) #' describe_posterior(df, ci = c(0.80, 0.90), verbose = FALSE) #' #' df <- data.frame(replicate(4, rnorm(20))) #' head(reshape_iterations( #' describe_posterior(df, keep_iterations = TRUE, verbose = FALSE) #' )) #' } #' \dontrun{ #' # rstanarm models #' # ----------------------------------------------- #' if (require("rstanarm") && require("emmeans")) { #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' describe_posterior(model) #' describe_posterior(model, centrality = "all", dispersion = TRUE, test = "all") #' describe_posterior(model, ci = c(0.80, 0.90)) #' #' # emmeans estimates #' # ----------------------------------------------- #' describe_posterior(emtrends(model, ~1, "wt")) #' } #' #' # BayesFactor objects #' # ----------------------------------------------- #' if (require("BayesFactor")) { #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' describe_posterior(bf) #' describe_posterior(bf, centrality = "all", dispersion = TRUE, test = "all") #' describe_posterior(bf, ci = c(0.80, 0.90)) #' } #' } #' @export describe_posterior <- function(posteriors, ...) { UseMethod("describe_posterior") } #' @export describe_posterior.default <- function(posteriors, ...) { insight::format_error( paste0("`describe_posterior()` is not yet implemented for objects of class `", class(posteriors)[1], "`.") ) } #' @keywords internal .describe_posterior <- function(x, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, BF = 1, ...) { if (is.null(x)) { insight::format_warning("Could not extract posterior samples.") return(NULL) } # we need this information from the original object if (all(rope_range == "default")) { rope_range <- rope_range(x, ...) } if (!is.data.frame(x) && !is.numeric(x)) { is_stanmvreg <- inherits(x, "stanmvreg") cleaned_parameters <- insight::clean_parameters(x) # rename to use `x` in bayes factor later x_df <- insight::get_parameters(x, ...) } else { cleaned_parameters <- NULL x_df <- x } # Arguments fixes if (!is.null(centrality) && length(centrality) == 1 && (centrality == "none" || isFALSE(centrality))) { centrality <- NULL } if (!is.null(ci) && length(ci) == 1 && (is.na(ci) || isFALSE(ci))) { ci <- NULL } if (!is.null(test) && length(test) == 1 && (test == "none" || isFALSE(test))) { test <- NULL } # Point-estimates if (!is.null(centrality)) { estimates <- .prepare_output( point_estimate(x_df, centrality = centrality, dispersion = dispersion, ...), cleaned_parameters, is_stanmvreg ) if (!"Parameter" %in% names(estimates)) { estimates <- cbind( data.frame(Parameter = "Posterior", stringsAsFactors = FALSE), estimates ) } } else { estimates <- data.frame(Parameter = NA) } # Uncertainty if (!is.null(ci)) { ci_method <- match.arg(tolower(ci_method), c("hdi", "spi", "quantile", "ci", "eti", "si", "bci", "bcai")) # not sure why "si" requires the model object if (ci_method == "si") { uncertainty <- ci(x, BF = BF, method = ci_method, prior = bf_prior, ...) } else { uncertainty <- ci(x_df, ci = ci, method = ci_method, ...) } uncertainty <- .prepare_output( uncertainty, cleaned_parameters, is_stanmvreg ) if (!"Parameter" %in% names(uncertainty)) { uncertainty <- cbind( data.frame(Parameter = "Posterior", stringsAsFactors = FALSE), uncertainty ) } } else { uncertainty <- data.frame(Parameter = NA) } # Effect Existence if (!is.null(test)) { test <- .check_test_values(test) if ("all" %in% test) { test <- c("pd", "p_map", "p_rope", "p_significance", "rope", "equivalence", "bf") } ## TODO no BF for arm::sim if (inherits(x, c("sim", "sim.merMod", "mcmc", "stanfit"))) { test <- setdiff(test, "bf") } ## TODO enable once "rope()" works for multi-response models # no ROPE for multi-response models if (insight::is_multivariate(x)) { test <- setdiff(test, c("rope", "p_rope")) insight::format_warning( "Multivariate response models are not yet supported for tests `rope` and `p_rope`." ) } # MAP-based p-value if (any(c("p_map", "p_pointnull") %in% test)) { test_pmap <- .prepare_output( p_map(x_df, ...), cleaned_parameters, is_stanmvreg ) if (!is.data.frame(test_pmap)) { test_pmap <- data.frame( Parameter = "Posterior", p_map = test_pmap, stringsAsFactors = FALSE ) } } else { test_pmap <- data.frame(Parameter = NA) } # Probability of direction if (any(c("pd", "p_direction", "pdir", "mpe") %in% test)) { test_pd <- .prepare_output( p_direction(x_df, ...), cleaned_parameters, is_stanmvreg ) if (!is.data.frame(test_pd)) { test_pd <- data.frame( Parameter = "Posterior", pd = test_pd, stringsAsFactors = FALSE ) } } else { test_pd <- data.frame(Parameter = NA) } # Probability of rope if ("p_rope" %in% test) { test_prope <- .prepare_output( p_rope(x_df, range = rope_range, ...), cleaned_parameters, is_stanmvreg ) if (!"Parameter" %in% names(test_prope)) { test_prope <- cbind( data.frame(Parameter = "Posterior", stringsAsFactors = FALSE), test_prope ) } } else { test_prope <- data.frame(Parameter = NA) } # Probability of significance if (any(c("ps", "p_sig", "p_significance") %in% test)) { test_psig <- .prepare_output( p_significance(x_df, threshold = rope_range, ...), cleaned_parameters, is_stanmvreg ) if (!is.data.frame(test_psig)) { test_psig <- data.frame( Parameter = "Posterior", ps = test_psig, stringsAsFactors = FALSE ) } } else { test_psig <- data.frame(Parameter = NA) } # ROPE if ("rope" %in% test) { test_rope <- .prepare_output( rope(x_df, range = rope_range, ci = rope_ci, ...), cleaned_parameters, is_stanmvreg ) if (!"Parameter" %in% names(test_rope)) { test_rope <- cbind( data.frame(Parameter = "Posterior", stringsAsFactors = FALSE), test_rope ) } names(test_rope)[names(test_rope) == "CI"] <- "ROPE_CI" } else { test_rope <- data.frame(Parameter = NA) } # Equivalence test if (any(c("equivalence", "equivalence_test", "equitest") %in% test)) { dot_args <- list(...) dot_args$verbose <- !"rope" %in% test test_equi <- .prepare_output( equivalence_test(x_df, range = rope_range, ci = rope_ci, dot_args ), cleaned_parameters, is_stanmvreg ) test_equi$Cleaned_Parameter <- NULL if (!"Parameter" %in% names(test_equi)) { test_equi <- cbind( data.frame(Parameter = "Posterior", stringsAsFactors = FALSE), test_equi ) } names(test_equi)[names(test_equi) == "CI"] <- "ROPE_CI" test_rope <- merge(test_rope, test_equi, all = TRUE) test_rope <- test_rope[!names(test_rope) %in% c("HDI_low", "HDI_high")] } # Bayes Factors if (any(c("bf", "bayesfactor", "bayes_factor") %in% test)) { test_bf <- tryCatch( .prepare_output( bayesfactor_parameters(x, prior = bf_prior, ...), cleaned_parameters, is_stanmvreg ), error = function(e) data.frame("Parameter" = NA) ) if (!"Parameter" %in% names(test_bf)) { test_bf <- cbind( data.frame(Parameter = "Posterior", stringsAsFactors = FALSE), test_bf ) } } else { test_bf <- data.frame("Parameter" = NA) } } else { test_pd <- data.frame( "Parameter" = NA, "Effects" = NA, "Component" = NA, "Response" = NA ) test_rope <- data.frame( "Parameter" = NA, "Effects" = NA, "Component" = NA, "Response" = NA ) test_prope <- data.frame( "Parameter" = NA, "Effects" = NA, "Component" = NA, "Response" = NA ) test_psig <- data.frame( "Parameter" = NA, "Effects" = NA, "Component" = NA, "Response" = NA ) test_bf <- data.frame( "Parameter" = NA, "Effects" = NA, "Component" = NA, "Response" = NA ) test_pmap <- data.frame( "Parameter" = NA, "Effects" = NA, "Component" = NA, "Response" = NA ) } # for data frames or numeric, and even for some models, we don't # have the "Effects" or "Component" column for all data frames. # To make "merge()" work, we add those columns to all data frames, # filled with NA, and remove the columns later if necessary estimates <- .add_effects_component_column(estimates) uncertainty <- .add_effects_component_column(uncertainty) test_pmap <- .add_effects_component_column(test_pmap) test_pd <- .add_effects_component_column(test_pd) test_prope <- .add_effects_component_column(test_prope) test_psig <- .add_effects_component_column(test_psig) test_rope <- .add_effects_component_column(test_rope) test_bf <- .add_effects_component_column(test_bf) # at least one "valid" data frame needs a row id, to restore # row-order after merging if (!all(is.na(estimates$Parameter))) { estimates$.rowid <- seq_len(nrow(estimates)) } else if (!all(is.na(test_pmap$Parameter))) { test_pmap$.rowid <- seq_len(nrow(test_pmap)) } else if (!all(is.na(test_pd$Parameter))) { test_pd$.rowid <- seq_len(nrow(test_pd)) } else if (!all(is.na(test_prope$Parameter))) { test_prope$.rowid <- seq_len(nrow(test_prope)) } else if (!all(is.na(test_psig$Parameter))) { test_psig$.rowid <- seq_len(nrow(test_psig)) } else if (!all(is.na(test_rope$Parameter))) { test_rope$.rowid <- seq_len(nrow(test_rope)) } else if (!all(is.na(test_bf$Parameter))) { test_bf$.rowid <- seq_len(nrow(test_bf)) } else { estimates$.rowid <- seq_len(nrow(estimates)) } # remove duplicated columns if (all(c("rope", "p_rope") %in% test)) { test_prope$ROPE_low <- NULL test_prope$ROPE_high <- NULL } # merge all data frames merge_by <- c("Parameter", "Effects", "Component", "Response") # merge_by <- intersect(merge_by, colnames(estimates)) out <- merge(estimates, uncertainty, by = merge_by, all = TRUE) out <- merge(out, test_pmap, by = merge_by, all = TRUE) out <- merge(out, test_pd, by = merge_by, all = TRUE) out <- merge(out, test_prope, by = merge_by, all = TRUE) out <- merge(out, test_psig, by = merge_by, all = TRUE) out <- merge(out, test_rope, by = merge_by, all = TRUE) out <- merge(out, test_bf, by = merge_by, all = TRUE) out <- out[!is.na(out$Parameter), ] # check which columns can be removed at the end. In any case, we don't # need .rowid in the returned data frame, and when the Effects or Component # column consist only of missing values, we remove those columns as well remove_columns <- ".rowid" if (insight::n_unique(out$Effects, na.rm = TRUE) < 2) remove_columns <- c(remove_columns, "Effects") if (insight::n_unique(out$Component, na.rm = TRUE) < 2) remove_columns <- c(remove_columns, "Component") if (insight::n_unique(out$Response, na.rm = TRUE) < 2) remove_columns <- c(remove_columns, "Response") # Restore columns order out <- datawizard::data_remove(out[order(out$.rowid), ], remove_columns, verbose = FALSE) # Add iterations if (keep_iterations) { row_order <- out$Parameter iter <- as.data.frame(t(as.data.frame(x_df, ...))) names(iter) <- paste0("iter_", seq_len(ncol(iter))) iter$Parameter <- row.names(iter) out <- merge(out, iter, all.x = TRUE, by = "Parameter") out <- out[match(row_order, out$Parameter), ] row.names(out) <- NULL } # Prepare output attr(out, "ci_method") <- ci_method out } #' @keywords internal .add_effects_component_column <- function(x) { if (!"Effects" %in% names(x)) x <- cbind(x, data.frame("Effects" = NA)) if (!"Component" %in% names(x)) x <- cbind(x, data.frame("Component" = NA)) if (!"Response" %in% names(x)) x <- cbind(x, data.frame("Response" = NA)) x } # Models based on simple data frame of posteriors --------------------- #' @rdname describe_posterior #' @export describe_posterior.numeric <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, BF = 1, ...) { out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, ... ) class(out) <- unique(c("describe_posterior", "see_describe_posterior", class(out))) out } #' @export describe_posterior.double <- describe_posterior.numeric #' @export describe_posterior.data.frame <- describe_posterior.numeric #' @export describe_posterior.sim.merMod <- describe_posterior.numeric #' @export describe_posterior.sim <- describe_posterior.numeric #' @export describe_posterior.bayesQR <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, parameters = NULL, ...) { out <- .describe_posterior( insight::get_parameters(posteriors), centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, effects = "fixed", parameters = parameters, ... ) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } #' @export describe_posterior.blrm <- describe_posterior.bayesQR #' @export describe_posterior.mcmc <- describe_posterior.bayesQR #' @export describe_posterior.mcmc.list <- describe_posterior.bayesQR #' @export describe_posterior.BGGM <- describe_posterior.bayesQR #' @export describe_posterior.draws <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, BF = 1, ...) { out <- .describe_posterior( .posterior_draws_to_df(posteriors), centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, ... ) class(out) <- unique(c("describe_posterior", "see_describe_posterior", class(out))) out } #' @export describe_posterior.rvar <- describe_posterior.draws # easystats methods ------------------------ #' @export describe_posterior.effectsize_std_params <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, BF = 1, ...) { class(posteriors) <- "data.frame" no_unique <- vapply(posteriors, function(col) { length(unique(col)) == 1 }, FUN.VALUE = TRUE) if (any(no_unique)) { no_unique <- which(no_unique) out <- describe_posterior.data.frame( posteriors[, -no_unique], centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, ... ) out_int <- data.frame(Parameter = colnames(posteriors)[no_unique]) col_diff <- setdiff(colnames(out), colnames(out_int)) out_int[, col_diff] <- NA out <- rbind(out_int, out) out <- out[order(match(out$Parameter, colnames(posteriors))), ] return(out) } describe_posterior.data.frame( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, ... ) } #' @export describe_posterior.get_predicted <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = NULL, ...) { if ("iterations" %in% names(attributes(posteriors))) { describe_posterior( as.data.frame(t(attributes(posteriors)$iterations)), centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, ... ) } else { insight::format_error("No iterations present in the output.") } } # emmeans --------------------------- #' @export describe_posterior.emmGrid <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, BF = 1, ...) { if (any(c("all", "bf", "bayesfactor", "bayes_factor") %in% tolower(test)) || "si" %in% tolower(ci_method)) { samps <- .clean_priors_and_posteriors(posteriors, bf_prior) bf_prior <- samps$prior posteriors <- samps$posterior } else { posteriors <- insight::get_parameters(posteriors) } out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, ... ) row.names(out) <- NULL # Reset row names class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) out } #' @export describe_posterior.emm_list <- describe_posterior.emmGrid # Stan ------------------------------ #' @inheritParams insight::get_parameters #' @inheritParams diagnostic_posterior #' @rdname describe_posterior #' @export describe_posterior.stanreg <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, diagnostic = c("ESS", "Rhat"), priors = FALSE, effects = c("fixed", "random", "all"), component = c( "location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary" ), parameters = NULL, BF = 1, ...) { if ((any(c("all", "bf", "bayesfactor", "bayes_factor") %in% tolower(test)) || "si" %in% tolower(ci_method)) && is.null(bf_prior)) { bf_prior <- suppressMessages(unupdate(posteriors)) } effects <- match.arg(effects) component <- match.arg(component) out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, effects = effects, component = component, parameters = parameters, ... ) diagnostic <- diagnostic_posterior( posteriors, diagnostic, effects = effects, component = component, parameters = parameters, ... ) out <- .merge_and_sort(out, diagnostic, by = "Parameter", all = TRUE) if (isTRUE(priors)) { priors_data <- describe_prior(posteriors, parameters = out$Parameter, ...) out <- .merge_and_sort(out, priors_data, by = "Parameter", all = TRUE) } out <- .add_clean_parameters_attribute(out, posteriors) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } #' @inheritParams insight::get_parameters #' @inheritParams diagnostic_posterior #' @export describe_posterior.stanmvreg <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = "p_direction", rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, diagnostic = c("ESS", "Rhat"), priors = FALSE, effects = c("fixed", "random", "all"), component = c( "location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary" ), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, effects = effects, parameters = parameters, ... ) if (is.null(out$Response)) { out$Response <- gsub("(b\\[)*(.*)\\|(.*)", "\\2", out$Parameter) } diagnostic <- diagnostic_posterior( posteriors, diagnostic, effects = effects, parameters = parameters, ... ) out <- .merge_and_sort(out, diagnostic, by = c("Parameter", "Response"), all = TRUE) if (isTRUE(priors)) { priors_data <- describe_prior(posteriors, parameters = NULL, ...) priors_data$Parameter <- gsub("^(.*)\\|(.*)", replacement = "\\2", priors_data$Parameter) out <- .merge_and_sort(out, priors_data, by = c("Parameter", "Response"), all = TRUE) } out <- .add_clean_parameters_attribute(out, posteriors) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } #' @inheritParams insight::get_parameters #' @inheritParams diagnostic_posterior #' @export describe_posterior.stanfit <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, diagnostic = c("ESS", "Rhat"), effects = c("fixed", "random", "all"), parameters = NULL, priors = FALSE, ...) { effects <- match.arg(effects) out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, effects = effects, parameters = parameters, ... ) diagnostic <- diagnostic_posterior( posteriors, diagnostic, effects = effects, parameters = parameters, ... ) out <- .merge_and_sort(out, diagnostic, by = "Parameter", all = TRUE) if (isTRUE(priors)) { priors_data <- describe_prior(posteriors, parameters = out$Parameter, ...) out <- .merge_and_sort(out, priors_data, by = "Parameter", all = TRUE) } attr(out, "ci_method") <- ci_method class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } #' @inheritParams describe_posterior.stanreg #' @rdname describe_posterior #' @export describe_posterior.brmsfit <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, bf_prior = NULL, diagnostic = c("ESS", "Rhat"), effects = c("fixed", "random", "all"), component = c( "conditional", "zi", "zero_inflated", "all", "location", "distributional", "auxiliary" ), parameters = NULL, BF = 1, priors = FALSE, ...) { effects <- match.arg(effects) component <- match.arg(component) if ((any(c("all", "bf", "bayesfactor", "bayes_factor") %in% tolower(test)) || "si" %in% tolower(ci_method)) && is.null(bf_prior)) { bf_prior <- suppressMessages(unupdate(posteriors)) } out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, bf_prior = bf_prior, BF = BF, effects = effects, component = component, parameters = parameters, ... ) if (!is.null(diagnostic)) { diagnostic <- diagnostic_posterior( posteriors, diagnostic, effects = effects, component = component, parameters = parameters, ... ) out <- .merge_and_sort(out, diagnostic, by = "Parameter", all = TRUE) } if (isTRUE(priors)) { priors_data <- describe_prior(posteriors, parameters = out$Parameter, ...) out <- .merge_and_sort(out, priors_data, by = "Parameter", all = TRUE) } out <- .add_clean_parameters_attribute(out, posteriors) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } #' @export describe_posterior.blavaan <- describe_posterior.stanfit # other models -------------------------------- #' @inheritParams describe_posterior.stanreg #' @export describe_posterior.MCMCglmm <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, diagnostic = "ESS", parameters = NULL, ...) { out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, effects = "fixed", parameters = parameters, ... ) if (!is.null(diagnostic) && diagnostic == "ESS") { diagnostic <- effective_sample(posteriors, effects = "fixed", parameters = parameters, ...) out <- .merge_and_sort(out, diagnostic, by = "Parameter", all = TRUE) } out } #' @export describe_posterior.bcplm <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, priors = TRUE, parameters = NULL, ...) { out <- .describe_posterior( insight::get_parameters(posteriors), centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, effects = "fixed", parameters = parameters, ... ) if (isTRUE(priors)) { priors_data <- describe_prior(posteriors, parameters = out$Parameter, ...) out <- .merge_and_sort(out, priors_data, by = "Parameter", all = TRUE) } attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } #' @export describe_posterior.bamlss <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, component = c("all", "conditional", "location"), parameters = NULL, ...) { component <- match.arg(component) out <- .describe_posterior( posteriors, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, component = component, parameters = parameters, ... ) attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } # BayesFactor -------------------- #' @export describe_posterior.BFBayesFactor <- function(posteriors, centrality = "median", dispersion = FALSE, ci = 0.95, ci_method = "eti", test = c("p_direction", "rope", "bf"), rope_range = "default", rope_ci = 0.95, keep_iterations = FALSE, priors = TRUE, verbose = TRUE, ...) { # Match test args to catch BFs if (!is.null(test)) { test <- .check_test_values(test) if ("all" %in% test) { test <- c("pd", "p_map", "p_rope", "p_significance", "rope", "equivalence", "bf") } } # Remove BF from list if (any(c("bf", "bayesfactor", "bayes_factor") %in% test)) { test <- test[!test %in% c("bf", "bayesfactor", "bayes_factor")] if (length(test) == 0L) test <- NULL compute_bf <- TRUE } else { compute_bf <- FALSE } draws <- insight::get_parameters(posteriors) if (all(rope_range == "default")) { rope_range <- rope_range(posteriors, verbose = verbose) } # Describe posterior out <- .describe_posterior( draws, centrality = centrality, dispersion = dispersion, ci = ci, ci_method = ci_method, test = test, rope_range = rope_range, rope_ci = rope_ci, keep_iterations = keep_iterations, ... ) if (is.null(out)) { return(NULL) } # Compute and read BF a posteriori if (compute_bf) { tryCatch( { out$log_BF <- as.data.frame(bayesfactor_models(posteriors[1], ...))[-1, ]$log_BF out$BF <- exp(out$log_BF) }, error = function(e) { NULL } ) } # Add priors if (priors) { priors_data <- describe_prior(posteriors, ...) out <- .merge_and_sort(out, priors_data, by = intersect(names(out), names(priors_data)), all = TRUE) } attr(out, "ci_method") <- ci_method attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors)) class(out) <- c("describe_posterior", "see_describe_posterior", class(out)) out } # Helpers ----------------------------------------------------------------- #' @keywords internal .check_test_values <- function(test) { match.arg(tolower(test), c( "pd", "p_direction", "pdir", "mpe", "ps", "psig", "p_significance", "p_rope", "rope", "equivalence", "equivalence_test", "equitest", "bf", "bayesfactor", "bayes_factor", "p_map", "all" ), several.ok = TRUE) } bayestestR/R/distribution.R0000644000176200001440000001553114407021360015444 0ustar liggesusers#' Empirical Distributions #' #' Generate a sequence of n-quantiles, i.e., a sample of size `n` with a #' near-perfect distribution. #' #' @param type Can be any of the names from base R's #' [Distributions][stats::Distributions], like `"cauchy"`, `"pois"` or #' `"beta"`. #' @param random Generate near-perfect or random (simple wrappers for the base R #' `r*` functions) distributions. #' @param xi For tweedie distributions, the value of `xi` such that the variance #' is `var(Y) = phi * mu^xi`. #' @param power Alias for `xi`. #' @param ... Arguments passed to or from other methods. #' @inheritParams tweedie::rtweedie #' #' @details #' When `random = FALSE`, these function return `q*(ppoints(n), ...)`. #' #' @examples #' library(bayestestR) #' x <- distribution(n = 10) #' plot(density(x)) #' #' x <- distribution(type = "gamma", n = 100, shape = 2) #' plot(density(x)) #' @export distribution <- function(type = "normal", ...) { basr_r_distributions <- c( "beta", "binom", "binomial", "cauchy", "chisq", "chisquared", "exp", "f", "gamma", "geom", "hyper", "lnorm", "multinom", "nbinom", "normal", "gaussian", "pois", "poisson", "student", "t", "student_t", "unif", "uniform", "weibull" ) switch(match.arg(arg = type, choices = basr_r_distributions), "beta" = distribution_beta(...), "binom" = , "binomial" = distribution_binomial(...), "cauchy" = distribution_cauchy(...), "chisq" = , "chisquared" = distribution_chisquared(...), "gamma" = distribution_gamma(...), "gaussian" = , "normal" = distribution_normal(...), "nbinom" = distribution_nbinom(...), "poisson" = distribution_poisson(...), "t" = , "student" = , "student_t" = distribution_student(...), "uniform" = distribution_uniform(...), distribution_custom(type = type, ...) ) } #' @rdname distribution #' @inheritParams distribution #' @export distribution_custom <- function(n, type = "norm", ..., random = FALSE) { if (random) { f <- match.fun(paste0("r", type)) f(n, ...) } else { f <- match.fun(paste0("q", type)) f(stats::ppoints(n), ...) } } #' @rdname distribution #' @inheritParams stats::rbeta #' @export distribution_beta <- function(n, shape1, shape2, ncp = 0, random = FALSE, ...) { if (random) { stats::rbeta(n, shape1, shape2, ncp = ncp) } else { stats::qbeta(stats::ppoints(n), shape1, shape2, ncp = ncp, ...) } } #' @rdname distribution #' @inheritParams stats::rbinom #' @export distribution_binomial <- function(n, size = 1, prob = 0.5, random = FALSE, ...) { if (random) { stats::rbinom(n, size, prob) } else { stats::qbinom(stats::ppoints(n), size, prob, ...) } } #' @rdname distribution #' @export distribution_binom <- distribution_binomial #' @rdname distribution #' @inheritParams stats::rcauchy #' @export distribution_cauchy <- function(n, location = 0, scale = 1, random = FALSE, ...) { if (random) { stats::rcauchy(n, location, scale) } else { stats::qcauchy(stats::ppoints(n), location, scale, ...) } } #' @rdname distribution #' @inheritParams stats::rchisq #' @export distribution_chisquared <- function(n, df, ncp = 0, random = FALSE, ...) { if (random) { stats::rchisq(n, df, ncp) } else { stats::qchisq(stats::ppoints(n), df, ncp, ...) } } #' @rdname distribution #' @export distribution_chisq <- distribution_chisquared #' @rdname distribution #' @inheritParams stats::rgamma #' @param shape Shape parameter. #' @export distribution_gamma <- function(n, shape, scale = 1, random = FALSE, ...) { if (random) { stats::rgamma(n = n, shape = shape, scale = scale) } else { stats::qgamma(p = stats::ppoints(n), shape = shape, scale = scale) } } #' @rdname distribution #' @inheritParams stats::rnorm #' @export distribution_mixture_normal <- function(n, mean = c(-3, 3), sd = 1, random = FALSE, ...) { n <- round(n / length(mean)) sd <- sd if (length(sd) != length(mean)) { sd <- rep(sd, length.out = length(mean)) } x <- NULL for (i in seq_along(mean)) { x <- c(x, distribution_normal(n = n, mean = mean[i], sd = sd[i], random = random)) } x } #' @rdname distribution #' @inheritParams stats::rnorm #' @export distribution_normal <- function(n, mean = 0, sd = 1, random = FALSE, ...) { if (random) { stats::rnorm(n, mean, sd) } else { stats::qnorm(stats::ppoints(n), mean, sd, ...) } } #' @rdname distribution #' @export distribution_gaussian <- distribution_normal #' @rdname distribution #' @inheritParams stats::rnbinom #' @param phi Corresponding to `glmmTMB`'s implementation of nbinom #' distribution, where `size=mu/phi`. #' @export distribution_nbinom <- function(n, size, prob, mu, phi, random = FALSE, ...) { if (missing(size)) { size <- mu / phi } if (random) { stats::rnbinom(n, size, prob, mu) } else { stats::qnbinom(stats::ppoints(n), size, prob, mu, ...) } } #' @rdname distribution #' @inheritParams stats::rpois #' @export distribution_poisson <- function(n, lambda = 1, random = FALSE, ...) { if (random) { stats::rpois(n, lambda) } else { stats::qpois(stats::ppoints(n), lambda, ...) } } #' @rdname distribution #' @inheritParams stats::rt #' @export distribution_student <- function(n, df, ncp, random = FALSE, ...) { if (random) { stats::rt(n, df, ncp) } else { stats::qt(stats::ppoints(n), df, ncp, ...) } } #' @rdname distribution #' @export distribution_t <- distribution_student #' @rdname distribution #' @export distribution_student_t <- distribution_student #' @rdname distribution #' @inheritParams tweedie::rtweedie #' @export distribution_tweedie <- function(n, xi = NULL, mu, phi, power = NULL, random = FALSE, ...) { insight::check_if_installed("tweedie") if (random) { tweedie::rtweedie( n = n, xi = xi, mu = mu, phi = phi, power = power ) } else { tweedie::qtweedie( p = stats::ppoints(n), xi = xi, mu = mu, phi = phi, power = power ) } } #' @rdname distribution #' @inheritParams stats::runif #' @export distribution_uniform <- function(n, min = 0, max = 1, random = FALSE, ...) { if (random) { stats::runif(n, min, max) } else { stats::qunif(stats::ppoints(n), min, max, ...) } } #' @rdname distribution #' @inheritParams stats::rnorm #' @export rnorm_perfect <- function(n, mean = 0, sd = 1) { .Deprecated("distribution_normal") stats::qnorm(stats::ppoints(n), mean, sd) } bayestestR/R/p_rope.R0000644000176200001440000001005114357655465014230 0ustar liggesusers#' Probability of being in the ROPE #' #' Compute the proportion of the whole posterior distribution that doesn't lie within a region of practical equivalence (ROPE). It is equivalent to running `rope(..., ci = 1)`. #' #' @inheritParams rope #' #' @examples #' library(bayestestR) #' #' p_rope(x = rnorm(1000, 0, 0.01), range = c(-0.1, 0.1)) #' p_rope(x = mtcars, range = c(-0.1, 0.1)) #' @export p_rope <- function(x, ...) { UseMethod("p_rope") } #' @method as.double p_rope #' @export as.double.p_rope <- function(x, ...) { x } #' @export p_rope.default <- function(x, ...) { NULL } #' @rdname p_rope #' @export p_rope.numeric <- function(x, range = "default", ...) { out <- .p_rope(rope(x, range = range, ci = 1, ...)) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.data.frame <- p_rope.numeric #' @export p_rope.draws <- function(x, range = "default", ...) { p_rope(.posterior_draws_to_df(x), range = range, ...) } #' @export p_rope.rvar <- p_rope.draws #' @export p_rope.emmGrid <- function(x, range = "default", ...) { xdf <- insight::get_parameters(x) out <- p_rope(xdf, range = range) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.emm_list <- p_rope.emmGrid #' @export p_rope.BFBayesFactor <- p_rope.numeric #' @export p_rope.MCMCglmm <- p_rope.numeric #' @rdname p_rope #' @export p_rope.stanreg <- function(x, range = "default", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { out <- .p_rope(rope(x, range = range, ci = 1, effects = effects, component = component, parameters = parameters, ...)) out <- .add_clean_parameters_attribute(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.stanfit <- p_rope.stanreg #' @export p_rope.blavaan <- p_rope.stanreg #' @rdname p_rope #' @export p_rope.brmsfit <- function(x, range = "default", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { out <- .p_rope(rope(x, range = range, ci = 1, effects = effects, component = component, parameters = parameters, ...)) out <- .add_clean_parameters_attribute(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.sim.merMod <- p_rope.stanreg #' @export p_rope.sim <- function(x, range = "default", parameters = NULL, ...) { out <- .p_rope(rope(x, range = range, ci = 1, parameters = parameters, ...)) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.bamlss <- function(x, range = "default", component = c("all", "conditional", "location"), parameters = NULL, ...) { component <- match.arg(component) out <- .p_rope(rope(x, range = range, ci = 1, effects = "all", component = component, parameters = parameters, ...)) out <- .add_clean_parameters_attribute(out, x) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.mcmc <- function(x, range = "default", parameters = NULL, ...) { out <- .p_rope(rope(x, range = range, ci = 1, parameters = parameters, ...)) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_rope.bcplm <- p_rope.mcmc #' @export p_rope.BGGM <- p_rope.mcmc #' @export p_rope.blrm <- p_rope.mcmc #' @export p_rope.mcmc.list <- p_rope.mcmc # Internal ---------------------------------------------------------------- #' @keywords internal .p_rope <- function(rope_rez) { cols <- c("Parameter", "ROPE_low", "ROPE_high", "ROPE_Percentage", "Effects", "Component") out <- as.data.frame(rope_rez[cols[cols %in% names(rope_rez)]]) names(out)[names(out) == "ROPE_Percentage"] <- "p_ROPE" class(out) <- c("p_rope", "see_p_rope", "data.frame") out } bayestestR/R/convert_bayesian_to_frequentist.R0000644000176200001440000001174514407021360021416 0ustar liggesusers#' Convert (refit) a Bayesian model to frequentist #' #' Refit Bayesian model as frequentist. Can be useful for comparisons. #' #' @param model A Bayesian model. #' @param data Data used by the model. If `NULL`, will try to extract it #' from the model. #' @param REML For mixed effects, should models be estimated using #' restricted maximum likelihood (REML) (`TRUE`, default) or maximum #' likelihood (`FALSE`)? #' @examples #' \donttest{ #' # Rstanarm ---------------------- #' if (require("rstanarm")) { #' # Simple regressions #' model <- stan_glm(Sepal.Length ~ Species, #' data = iris, chains = 2, refresh = 0 #' ) #' bayesian_as_frequentist(model) #' } #' } #' #' \dontrun{ #' if (require("rstanarm")) { #' model <- stan_glm(vs ~ mpg, #' family = "binomial", #' data = mtcars, chains = 2, refresh = 0 #' ) #' bayesian_as_frequentist(model) #' #' # Mixed models #' model <- stan_glmer(Sepal.Length ~ Petal.Length + (1 | Species), #' data = iris, chains = 2, refresh = 0 #' ) #' bayesian_as_frequentist(model) #' #' model <- stan_glmer(vs ~ mpg + (1 | cyl), #' family = "binomial", #' data = mtcars, chains = 2, refresh = 0 #' ) #' bayesian_as_frequentist(model) #' } #' } #' #' @export convert_bayesian_as_frequentist <- function(model, data = NULL, REML = TRUE) { if (is.null(data)) { data <- insight::get_data(model) } info <- insight::model_info(model, verbose = FALSE) formula <- insight::find_formula(model) family <- insight::get_family(model) if (inherits(family, "brmsfamily")) { family <- get(family$family)(link = family$link) } freq <- tryCatch(.convert_bayesian_as_frequentist( info = info, formula = formula, data = data, family = family, REML = REML ), error = function(e) e) if (inherits(freq, "error")) { family <- get(family$family)(link = family$link) freq <- .convert_bayesian_as_frequentist( info = info, formula = formula, data = data, family = family, REML = REML ) } if (inherits(freq, "error")) { insight::format_error("Model could not be automatically converted to frequentist model.") } else { return(freq) } } # internal .convert_bayesian_as_frequentist <- function(info, formula, data, family, REML = TRUE) { # TODO: Check for # nonlinear formulas, # correlation structures, # weights, # offset, # subset, # knots, # meta-analysis if (info$is_dispersion || info$is_zero_inflated || info$is_zeroinf || info$is_hurdle) { insight::check_if_installed("glmmTMB") cond_formula <- .rebuild_cond_formula(formula) dispformula <- formula$dispersion if (is.null(dispformula)) dispformula <- formula$sigma if (is.null(dispformula)) dispformula <- ~1 ziformula <- formula$zero_inflated if (is.null(ziformula)) ziformula <- formula$zi if (is.null(ziformula)) ziformula <- ~0 freq <- tryCatch( glmmTMB::glmmTMB( formula = cond_formula, ziformula = ziformula, dispformula = dispformula, family = family, data = data, REML = REML ), error = function(e) e ) } else if (info$is_gam) { insight::check_if_installed("gamm4") freq <- tryCatch( gamm4::gamm4( formula = formula$conditional, random = formula$random, family = family, data = data ), error = function(e) e ) } else if (info$is_mixed) { insight::check_if_installed("lme4") cond_formula <- .rebuild_cond_formula(formula) if (info$is_linear) { freq <- tryCatch( lme4::lmer( formula = cond_formula, data = data ), error = function(e) e ) } else { freq <- tryCatch( lme4::glmer( formula = cond_formula, family = family, data = data ), error = function(e) e ) } } else { if (info$is_linear) { freq <- stats::lm(formula$conditional, data = data) } else { freq <- stats::glm(formula$conditional, data = data, family = family) } } return(freq) } .rebuild_cond_formula <- function(formula) { if (is.null(formula$random)) { return(formula$conditional) } else { if (is.list(formula$random)) { random_formula <- paste( lapply( formula$random, function(x) { paste0("(", as.character(x)[-1], ")") } ), collapse = " + " ) } else { random_formula <- paste0("(", as.character(formula$random)[-1], ")") } fixed_formula <- paste(as.character(formula$conditional)[c(2, 1, 3)], collapse = " ") cond_formula <- stats::as.formula(paste( fixed_formula, random_formula, sep = " + " )) return(cond_formula) } } #' @rdname convert_bayesian_as_frequentist #' @export bayesian_as_frequentist <- convert_bayesian_as_frequentist bayestestR/R/utils_clean_stan_parameters.R0000644000176200001440000000140414276606712020507 0ustar liggesusers#' @keywords internal .clean_up_tmp_stanreg <- function(tmp, group, cols, parms) { tmp$Group <- group tmp$Parameter <- rep(parms, each = nrow(tmp) / length(parms)) rownames(tmp) <- NULL tmp <- tmp[, c("Parameter", cols)] # clean random effects notation from parameters # tmp$Parameter <- gsub("b\\[(.*) (.*)\\]", "\\2", tmp$Parameter) tmp } #' @keywords internal .clean_up_tmp_brms <- function(tmp, group, component, cols, parms) { tmp$Group <- group tmp$Component <- component tmp$Parameter <- rep(parms, each = nrow(tmp) / length(parms)) rownames(tmp) <- NULL tmp <- tmp[, c("Parameter", cols)] # clean random effects notation from parameters # tmp$Parameter <- gsub("r_(.*)\\.(.*)\\.", "\\1", tmp$Parameter) tmp } bayestestR/R/print_html.R0000644000176200001440000001263214307033605015110 0ustar liggesusers# Reexports models ------------------------ #' @importFrom insight print_html #' @export insight::print_html #' @export print_html.describe_posterior <- function(x, digits = 2, caption = "Summary of Posterior Distribution", ...) { .print_html_default(x = x, digits = digits, caption = caption, ...) } #' @export print_html.point_estimate <- function(x, digits = 2, caption = "Point Estimate", ...) { .print_html_default(x = x, digits = digits, caption = caption, ...) } #' @export print_html.map_estimate <- function(x, digits = 2, caption = "MAP Estimate", ...) { .print_html_default(x = x, digits = digits, caption = caption, ...) } #' @export print_html.p_direction <- function(x, digits = 2, caption = "Probability of Direction (pd)", ...) { .print_html_default(x = x, digits = digits, caption = caption, ...) } #' @export print_html.p_map <- function(x, digits = 2, caption = "MAP-based p-value", ...) { .print_html_default(x = x, digits = digits, caption = caption, ...) } #' @export print_html.p_rope <- function(x, digits = 2, ...) { caption <- sprintf( "Proportion of samples inside the ROPE [%.*f, %.*f]", digits, x$ROPE_low[1], digits, x$ROPE_high[1] ) x$ROPE_low <- x$ROPE_high <- NULL .print_html_default(x = x, digits = digits, caption = caption, ci_string = "ROPE", ...) } #' @export print_html.p_significance <- function(x, digits = 2, ...) { caption <- sprintf( "Practical Significance (threshold: %s)", insight::format_value(attributes(x)$threshold, digits = digits) ) .print_html_default(x = x, digits = digits, caption = caption, ...) } #' @export print_html.bayestestR_hdi <- function(x, digits = 2, caption = "Highest Density Interval", ...) { .print_html_default(x = x, digits = digits, caption = caption, ci_string = "HDI", ...) } #' @export print_html.bayestestR_eti <- function(x, digits = 2, caption = "Equal-Tailed Interval", ...) { .print_html_default(x = x, digits = digits, caption = caption, ci_string = "ETI", ...) } #' @export print_html.bayestestR_si <- function(x, digits = 2, caption = "Support Interval", ...) { .print_html_default(x = x, digits = digits, caption = caption, ci_string = "SI", ...) } # special handling for bayes factors ------------------ #' @export print_html.bayesfactor_models <- function(x, digits = 3, log = FALSE, show_names = TRUE, caption = "Bayes Factors for Model Comparison", ...) { .print_bf_html_default( x = x, digits = digits, log = log, show_names = show_names, caption = caption, align = c("llr"), ... ) } #' @export print_html.bayesfactor_inclusion <- function(x, digits = 3, log = FALSE, caption = "Inclusion Bayes Factors (Model Averaged)", ...) { .print_bf_html_default( x = x, digits = digits, log = log, caption = caption, align = c("lrrr"), ... ) } #' @export print_html.bayesfactor_restricted <- function(x, digits = 3, log = FALSE, caption = "Bayes Factor (Order-Restriction)", ...) { .print_bf_html_default(x = x, digits = digits, log = log, caption = caption, ...) } #' @export print_html.bayesfactor_parameters <- function(x, digits = 3, log = FALSE, ...) { # retrieve information with cleaned parameter names cp <- attr(x, "clean_parameters") # format data frame and columns formatted_table <- format( x, cp = cp, digits = digits, log = log, format = "html", ... ) insight::export_table(formatted_table, format = "html") } # util --------------- .print_html_default <- function(x, digits = 2, caption = NULL, subtitles = NULL, ci_string = "CI", ...) { # retrieve information with cleaned parameter names cp <- attr(x, "clean_parameters") # format data frame and columns formatted_table <- format( x, cp = cp, digits = digits, format = "html", ci_string = ci_string, caption = caption, subtitles = subtitles, ... ) # print for data frame - I don't think we need a special handling for # numeric values to have a markdown-table output insight::export_table( formatted_table, caption = caption, format = "html" ) } .print_bf_html_default <- function(x, digits = 3, log = FALSE, show_names = NULL, caption = NULL, align = NULL, ...) { formatted_table <- format( x, digits = digits, log = log, show_names = show_names, caption = caption, format = "html", ... ) insight::export_table( formatted_table, align = align, caption = caption, format = "html" ) } bayestestR/R/effective_sample.R0000644000176200001440000001405514407021360016226 0ustar liggesusers#' Effective Sample Size (ESS) #' #' This function returns the effective sample size (ESS). #' #' @param model A `stanreg`, `stanfit`, `brmsfit`, `blavaan`, or `MCMCglmm` object. #' @param ... Currently not used. #' @inheritParams hdi #' #' @return A data frame with two columns: Parameter name and effective sample size (ESS). #' #' @details **Effective Sample (ESS)** should be as large as possible, altough for most applications, an effective sample size greater than 1,000 is sufficient for stable estimates (Bürkner, 2017). The ESS corresponds to the number of independent samples with the same estimation power as the N autocorrelated samples. It is is a measure of \dQuote{how much independent information there is in autocorrelated chains} (*Kruschke 2015, p182-3*). #' #' @references \itemize{ #' \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. #' \item Bürkner, P. C. (2017). brms: An R package for Bayesian multilevel models using Stan. Journal of Statistical Software, 80(1), 1-28 #' } #' #' @examples #' \dontrun{ #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' effective_sample(model) #' } #' @export effective_sample <- function(model, ...) { UseMethod("effective_sample") } #' @export effective_sample.default <- function(model, ...) { insight::format_error( paste0( "'effective_sample()' is not yet implemented for objects of class '", class(model)[1], "'." ) ) } #' @rdname effective_sample #' @export effective_sample.brmsfit <- function(model, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) pars <- insight::find_parameters( model, effects = effects, component = component, parameters = parameters, flatten = TRUE ) insight::check_if_installed("rstan") s <- rstan::summary(model$fit)$summary s <- subset(s, subset = rownames(s) %in% pars) data.frame( Parameter = rownames(s), ESS = round(s[, "n_eff"]), stringsAsFactors = FALSE, row.names = NULL ) } #' @rdname effective_sample #' @export effective_sample.stanreg <- function(model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) pars <- insight::find_parameters( model, effects = effects, component = component, parameters = parameters, flatten = TRUE ) s <- as.data.frame(summary(model)) s <- s[rownames(s) %in% pars, ] data.frame( Parameter = rownames(s), ESS = s[["n_eff"]], stringsAsFactors = FALSE, row.names = NULL ) } #' @export effective_sample.stanmvreg <- function(model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) pars <- insight::get_parameters( model, effects = effects, component = component, parameters = parameters ) s <- as.data.frame(summary(model)) s <- s[rownames(s) %in% colnames(pars), ] data.frame( Parameter = rownames(s), ESS = s[["n_eff"]], stringsAsFactors = FALSE, row.names = NULL ) } #' @export effective_sample.stanfit <- function(model, effects = c("fixed", "random", "all"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) pars <- insight::get_parameters( model, effects = effects, parameters = parameters ) insight::check_if_installed("rstan") s <- as.data.frame(rstan::summary(model)$summary) s <- s[rownames(s) %in% colnames(pars), ] data.frame( Parameter = rownames(s), ESS = s[["n_eff"]], stringsAsFactors = FALSE, row.names = NULL ) } #' @export effective_sample.blavaan <- function(model, parameters = NULL, ...) { insight::check_if_installed("blavaan") ESS <- blavaan::blavInspect(model, what = "neff") data.frame( Parameter = colnames(insight::get_parameters(model)), ESS = ESS, stringsAsFactors = FALSE, row.names = NULL ) } #' @export effective_sample.MCMCglmm <- function(model, effects = c("fixed", "random", "all"), parameters = NULL, ...) { # check arguments effects <- match.arg(effects) pars <- insight::get_parameters( model, effects = effects, parameters = parameters, summary = TRUE ) s.fixed <- as.data.frame(summary(model)$solutions) s.random <- as.data.frame(summary(model)$Gcovariances) es <- data.frame( Parameter = rownames(s.fixed), ESS = round(s.fixed[["eff.samp"]]), stringsAsFactors = FALSE, row.names = NULL ) if (nrow(s.random) > 0L) { es <- rbind(es, data.frame( Parameter = rownames(s.random), ESS = round(s.random[["eff.samp"]]), stringsAsFactors = FALSE, row.names = NULL )) } es[match(pars[[1]], es$Parameter), ] } bayestestR/R/print.bayesfactor_models.R0000644000176200001440000000213714276606712017741 0ustar liggesusers#' @export print.bayesfactor_models_matrix <- function(x, digits = 2, log = FALSE, exact = TRUE, ...) { orig_x <- x # Format values x <- unclass(x) if (!log) x <- exp(x) sgn <- sign(x) < 0 x <- insight::format_bf(abs(x), name = NULL, exact = exact, ...) diag(x) <- if (log) "0" else "1" if (any(sgn)) x[sgn] <- paste0("-", x[sgn]) df <- as.data.frame(x) # Model names models <- colnames(df) models[models == "1"] <- "(Intercept only)" models <- paste0("[", seq_along(models), "] ", models) k <- max(sapply(c(models, "Denominator"), nchar)) + 2 rownames(df) <- colnames(df) <- NULL df <- cbind(Model = models, df) colnames(df) <- c("placeholder", paste0(" [", seq_along(models), "] ")) out <- insight::export_table( df, caption = c("# Bayes Factors for Model Comparison", "blue"), subtitle = c(sprintf("\n\n%sNumerator\nDenominator", paste(rep(" ", k), collapse = "")), "cyan"), footer = if (log) c("\nBayes Factors are on the log-scale.\n", "red") ) out <- sub("placeholder", "\b\b", out) cat(out) invisible(orig_x) } bayestestR/R/sexit.R0000644000176200001440000003330214407021360014055 0ustar liggesusers#' Sequential Effect eXistence and sIgnificance Testing (SEXIT) #' #' The SEXIT is a new framework to describe Bayesian effects, guiding which #' indices to use. Accordingly, the `sexit()` function returns the minimal (and #' optimal) required information to describe models' parameters under a Bayesian #' framework. It includes the following indices: #' \itemize{ #' \item{Centrality: the median of the posterior distribution. In #' probabilistic terms, there is `50%` of probability that the effect is higher #' and lower. See [`point_estimate()`][point_estimate].} #' \item{Uncertainty: the `95%` Highest Density Interval (HDI). In #' probabilistic terms, there is `95%` of probability that the effect is #' within this confidence interval. See [`ci()`][ci].} #' \item{Existence: The probability of direction allows to quantify the #' certainty by which an effect is positive or negative. It is a critical #' index to show that an effect of some manipulation is not harmful (for #' instance in clinical studies) or to assess the direction of a link. See #' [`p_direction()`][p_direction].} #' \item{Significance: Once existence is demonstrated with high certainty, we #' can assess whether the effect is of sufficient size to be considered as #' significant (i.e., not negligible). This is a useful index to determine #' which effects are actually important and worthy of discussion in a given #' process. See [`p_significance()`][p_significance].} #' \item{Size: Finally, this index gives an idea about the strength of an #' effect. However, beware, as studies have shown that a big effect size can #' be also suggestive of low statistical power (see details section).} #' } #' #' @inheritParams p_direction #' @inheritParams hdi #' @param significant,large The threshold values to use for significant and #' large probabilities. If left to 'default', will be selected through #' [`sexit_thresholds()`][sexit_thresholds]. See the details section below. #' #' @details #' #' \subsection{Rationale}{ #' The assessment of "significance" (in its broadest meaning) is a pervasive #' issue in science, and its historical index, the p-value, has been strongly #' criticized and deemed to have played an important role in the replicability #' crisis. In reaction, more and more scientists have tuned to Bayesian methods, #' offering an alternative set of tools to answer their questions. However, the #' Bayesian framework offers a wide variety of possible indices related to #' "significance", and the debate has been raging about which index is the best, #' and which one to report. #' #' This situation can lead to the mindless reporting of all possible indices #' (with the hopes that with that the reader will be satisfied), but often #' without having the writer understanding and interpreting them. It is indeed #' complicated to juggle between many indices with complicated definitions and #' subtle differences. #' #' SEXIT aims at offering a practical framework for Bayesian effects reporting, #' in which the focus is put on intuitiveness, explicitness and usefulness of #' the indices' interpretation. To that end, we suggest a system of description #' of parameters that would be intuitive, easy to learn and apply, #' mathematically accurate and useful for taking decision. #' #' Once the thresholds for significance (i.e., the ROPE) and the one for a #' "large" effect are explicitly defined, the SEXIT framework does not make any #' interpretation, i.e., it does not label the effects, but just sequentially #' gives 3 probabilities (of direction, of significance and of being large, #' respectively) as-is on top of the characteristics of the posterior (using the #' median and HDI for centrality and uncertainty description). Thus, it provides #' a lot of information about the posterior distribution (through the mass of #' different 'sections' of the posterior) in a clear and meaningful way. #' } #' #' \subsection{Threshold selection}{ #' One of the most important thing about the SEXIT framework is that it relies #' on two "arbitrary" thresholds (i.e., that have no absolute meaning). They #' are the ones related to effect size (an inherently subjective notion), #' namely the thresholds for significant and large effects. They are set, by #' default, to `0.05` and `0.3` of the standard deviation of the outcome #' variable (tiny and large effect sizes for correlations according to Funder #' and Ozer, 2019). However, these defaults were chosen by lack of a better #' option, and might not be adapted to your case. Thus, they are to be handled #' with care, and the chosen thresholds should always be explicitly reported #' and justified. #' \itemize{ #' \item For **linear models (lm)**, this can be generalised to \ifelse{html}{\out{0.05 * SDy}}{\eqn{[0.05*SD_{y}]}} and \ifelse{html}{\out{0.3 * SDy}}{\eqn{[0.3*SD_{y}]}} for significant and large effects, respectively. #' \item For **logistic models**, the parameters expressed in log odds ratio can be converted to standardized difference through the formula \ifelse{html}{\out{π/√(3)}}{\eqn{\pi/\sqrt{3}}}, resulting a threshold of `0.09` and `0.54`. #' \item For other models with **binary outcome**, it is strongly recommended to manually specify the rope argument. Currently, the same default is applied that for logistic models. #' \item For models from **count data**, the residual variance is used. This is a rather experimental threshold and is probably often similar to `0.05` and `0.3`, but should be used with care! #' \item For **t-tests**, the standard deviation of the response is used, similarly to linear models (see above). #' \item For **correlations**,`0.05` and `0.3` are used. #' \item For all other models, `0.05` and `0.3` are used, but it is strongly advised to specify it manually. #' } #' } #' \subsection{Examples}{ #' The three values for existence, significance and size provide a useful description of the posterior distribution of the effects. Some possible scenarios include: #' \itemize{ #' \item{The probability of existence is low, but the probability of being large is high: it suggests that the posterior is very wide (covering large territories on both side of 0). The statistical power might be too low, which should warrant any confident conclusion.} #' \item{The probability of existence and significance is high, but the probability of being large is very small: it suggests that the effect is, with high confidence, not large (the posterior is mostly contained between the significance and the large thresholds).} #' \item{The 3 indices are very low: this suggests that the effect is null with high confidence (the posterior is closely centred around 0).}}} #' #' @return A dataframe and text as attribute. #' #' @references \itemize{ #' \item{Makowski, D., Ben-Shachar, M. S., & Lüdecke, D. (2019). bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework. Journal of Open Source Software, 4(40), 1541. \doi{10.21105/joss.01541}} #' \item{Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767}} #' } #' #' @examples #' \dontrun{ #' library(bayestestR) #' #' s <- sexit(rnorm(1000, -1, 1)) #' s #' print(s, summary = TRUE) #' #' s <- sexit(iris) #' s #' print(s, summary = TRUE) #' #' if (require("rstanarm")) { #' model <- rstanarm::stan_glm(mpg ~ wt * cyl, #' data = mtcars, #' iter = 400, refresh = 0 #' ) #' s <- sexit(model) #' s #' print(s, summary = TRUE) #' } #' } #' @export sexit <- function(x, significant = "default", large = "default", ci = 0.95, ...) { thresholds <- .sexit_preprocess(x, significant, large, ...) significant <- thresholds$significant large <- thresholds$large thresholds_text <- thresholds$text # Description centrality <- point_estimate(x, "median") centrality$Effects <- centrality$Component <- NULL centrality_text <- paste0("Median = ", insight::format_value(centrality$Median)) direction <- ifelse(centrality$Median < 0, "negative", "positive") uncertainty <- ci(x, ci = ci, method = "ETI", ...)[c("CI", "CI_low", "CI_high")] uncertainty_text <- insight::format_ci(uncertainty$CI_low, uncertainty$CI_high, uncertainty$CI) # Indices existence_rez <- as.numeric(p_direction(x, ...)) existence_value <- insight::format_value(existence_rez, as_percent = TRUE) existence_threshold <- ifelse(direction == "negative", "< 0", "> 0") sig_rez <- as.numeric(p_significance(x, threshold = significant, ...)) sig_value <- insight::format_value(sig_rez, as_percent = TRUE) sig_threshold <- ifelse(direction == "negative", -1 * significant, significant) sig_threshold <- paste0(ifelse(direction == "negative", "< ", "> "), insight::format_value(sig_threshold)) large_rez <- as.numeric(p_significance(x, threshold = large, ...)) large_value <- insight::format_value(large_rez, as_percent = TRUE) large_threshold <- ifelse(direction == "negative", -1 * large, large) large_threshold <- paste0(ifelse(direction == "negative", "< ", "> "), insight::format_value(large_threshold)) if ("Parameter" %in% names(centrality)) { parameters <- centrality$Parameter } else { parameters <- "The effect" } text_full <- paste0( parameters, " (", centrality_text, ", ", uncertainty_text, ") has a ", existence_value, " probability of being ", direction, " (", existence_threshold, "), ", sig_value, " of being significant (", sig_threshold, "), and ", large_value, " of being large (", large_threshold, ")" ) text_short <- paste0( parameters, " (", centrality_text, ", ", uncertainty_text, ") has ", existence_value, ", ", sig_value, " and ", large_value, " probability of being ", direction, " (", existence_threshold, "), significant (", sig_threshold, ") and large (", large_threshold, ")" ) out <- cbind( centrality, as.data.frame(uncertainty), data.frame(Direction = existence_rez), data.frame(Significance = sig_rez), data.frame(Large = large_rez) ) # Prepare output attr(out, "sexit_info") <- "Following the Sequential Effect eXistence and sIgnificance Testing (SEXIT) framework, we report the median of the posterior distribution and its 95% CI (Highest Density Interval), along the probability of direction (pd), the probability of significance and the probability of being large." attr(out, "sexit_ci_method") <- "ETI" attr(out, "sexit_significance") <- significant attr(out, "sexit_large") <- large attr(out, "sexit_textlong") <- text_full attr(out, "sexit_textshort") <- text_short attr(out, "sexit_thresholds") <- thresholds_text pretty_cols <- c( "Median", paste0(insight::format_value(ci * 100, protect_integers = TRUE), "% CI"), "Direction", paste0("Significance (> |", insight::format_value(significant), "|)"), paste0("Large (> |", insight::format_value(large), "|)") ) if ("Parameter" %in% names(out)) pretty_cols <- c("Parameter", pretty_cols) attr(out, "pretty_cols") <- pretty_cols attr(out, "data") <- x class(out) <- unique(c("sexit", "see_sexit", class(out))) out } #' @keywords internal .sexit_preprocess <- function(x, significant = "default", large = "default", ...) { thresholds <- sexit_thresholds(x) if (significant == "default") significant <- thresholds[1] if (large == "default") large <- thresholds[2] suppressWarnings(resp <- .safe(insight::get_response(x, type = "mf"))) suppressWarnings(info <- .safe(insight::model_info(x, verbose = FALSE))) if (!is.null(resp) && !is.null(info) && info$is_linear) { sd1 <- significant / stats::sd(resp, na.rm = TRUE) sd2 <- large / stats::sd(resp, na.rm = TRUE) text_sd <- paste0( " (corresponding respectively to ", insight::format_value(sd1), " and ", insight::format_value(sd2), " of the outcome's SD)" ) } else { text_sd <- "" } thresholds <- paste0( "The thresholds beyond which the effect is considered ", "as significant (i.e., non-negligible) and large are |", insight::format_value(significant), "| and |", insight::format_value(large), "|", text_sd, "." ) list(significant = significant, large = large, text = thresholds) } #' @export print.sexit <- function(x, summary = FALSE, digits = 2, ...) { orig_x <- x # Long if (isFALSE(summary)) { insight::print_color(paste0("# ", attributes(x)$sexit_info, " ", attributes(x)$sexit_thresholds, "\n\n"), "blue") text <- attributes(x)$sexit_textlong if (length(text) > 1) text <- paste0(paste0("- ", text), collapse = "\n") insight::print_color(text, "yellow") cat("\n\n") df <- data.frame(Median = x$Median, CI = insight::format_ci(x$CI_low, x$CI_high, NULL)) if ("Parameter" %in% names(x)) { df <- cbind(data.frame(Parameter = x$Parameter), df, x[c("Direction", "Significance", "Large")]) } else { df <- cbind(df, x[c("Direction", "Significance", "Large")]) } names(df) <- attributes(x)$pretty_cols .print_data_frame(df, digits = digits, ...) # Short } else { insight::print_color(paste0("# ", attributes(x)$sexit_thresholds, "\n\n"), "blue") text <- attributes(x)$sexit_textshort if (length(text) > 1) text <- paste0(paste0("- ", text), collapse = "\n") cat(text) } invisible(orig_x) } bayestestR/R/describe_prior.R0000644000176200001440000000720214307033605015720 0ustar liggesusers#' Describe Priors #' #' Returns a summary of the priors used in the model. #' #' @param model A Bayesian model. #' @param ... Currently not used. #' @inheritParams describe_posterior #' #' @examples #' \dontrun{ #' library(bayestestR) #' #' # rstanarm models #' # ----------------------------------------------- #' if (require("rstanarm")) { #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) #' describe_prior(model) #' } #' #' # brms models #' # ----------------------------------------------- #' if (require("brms")) { #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' describe_prior(model) #' } #' #' # BayesFactor objects #' # ----------------------------------------------- #' if (require("BayesFactor")) { #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' describe_prior(bf) #' } #' } #' @export describe_prior <- function(model, ...) { UseMethod("describe_prior") } #' @rdname describe_prior #' @export describe_prior.brmsfit <- function(model, effects = c("fixed", "random", "all"), component = c( "conditional", "zi", "zero_inflated", "all", "location", "distributional", "auxiliary" ), parameters = NULL, ...) { .describe_prior(model, parameters = parameters) } # Internal ---------------------------------------------------------------- #' @keywords internal .describe_prior <- function(model, parameters = NULL, ...) { priors <- insight::get_priors(model, ...) # Format names names(priors)[-1] <- paste0("Prior_", names(priors)[-1]) # If the prior scale has been adjusted, it is the actual scale that was used. if ("Prior_Adjusted_Scale" %in% names(priors)) { priors$Prior_Scale[!is.na(priors$Prior_Adjusted_Scale)] <- priors$Prior_Adjusted_Scale[!is.na(priors$Prior_Adjusted_Scale)] priors$Prior_Adjusted_Scale <- NULL } if ("Prior_Response" %in% names(priors)) { names(priors)[names(priors) == "Prior_Response"] <- "Response" } # make sure parameter names match between prior output and model cp <- insight::clean_parameters(model) ## TODO for now, only fixed effects if ("Effects" %in% names(cp)) { cp <- cp[cp$Effects == "fixed", ] } if (!is.null(parameters) && !all(priors$Parameter %in% parameters)) { cp$Cleaned_Parameter <- gsub("(.*)(\\.|\\[)\\d+(\\.|\\])", "\\1", cp$Cleaned_Parameter) cp$Cleaned_Parameter[cp$Cleaned_Parameter == "Intercept"] <- "(Intercept)" colnames(priors)[1] <- "Cleaned_Parameter" out <- merge(cp, priors, by = "Cleaned_Parameter", all = TRUE) out <- out[!duplicated(out$Parameter), ] priors <- out[intersect(colnames(out), c("Parameter", "Prior_Distribution", "Prior_df", "Prior_Location", "Prior_Scale", "Response"))] } priors } #' @export describe_prior.stanreg <- .describe_prior #' @export describe_prior.bcplm <- .describe_prior #' @export describe_prior.blavaan <- .describe_prior #' @export describe_prior.BFBayesFactor <- function(model, ...) { priors <- insight::get_priors(model) # Format names names(priors)[-1] <- paste0("Prior_", names(priors)[-1]) priors } # unsupported ---------------- #' @export describe_prior.BGGM <- function(model, ...) { NULL } #' @export describe_prior.BGGM <- describe_prior.BGGM #' @export describe_prior.bamlss <- describe_prior.BGGM #' @export describe_prior.draws <- describe_prior.BGGM #' @export describe_prior.rvar <- describe_prior.BGGM bayestestR/R/point_estimate.R0000644000176200001440000002610714357655465016001 0ustar liggesusers#' Point-estimates of posterior distributions #' #' Compute various point-estimates, such as the mean, the median or the MAP, to describe posterior distributions. #' #' @param centrality The point-estimates (centrality indices) to compute. Character (vector) or list with one or more of these options: `"median"`, `"mean"`, `"MAP"` or `"all"`. #' @param dispersion Logical, if `TRUE`, computes indices of dispersion related to the estimate(s) (`SD` and `MAD` for `mean` and `median`, respectively). #' @param threshold For `centrality = "trimmed"` (i.e. trimmed mean), indicates the fraction (0 to 0.5) of observations to be trimmed from each end of the vector before the mean is computed. #' @param ... Additional arguments to be passed to or from methods. #' @inheritParams hdi #' #' @references Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). *Indices of Effect Existence and Significance in the Bayesian Framework*. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @examples #' library(bayestestR) #' #' point_estimate(rnorm(1000)) #' point_estimate(rnorm(1000), centrality = "all", dispersion = TRUE) #' point_estimate(rnorm(1000), centrality = c("median", "MAP")) #' #' df <- data.frame(replicate(4, rnorm(100))) #' point_estimate(df, centrality = "all", dispersion = TRUE) #' point_estimate(df, centrality = c("median", "MAP")) #' \dontrun{ #' # rstanarm models #' # ----------------------------------------------- #' library(rstanarm) #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) #' point_estimate(model, centrality = "all", dispersion = TRUE) #' point_estimate(model, centrality = c("median", "MAP")) #' #' #' # emmeans estimates #' # ----------------------------------------------- #' library(emmeans) #' point_estimate(emtrends(model, ~1, "wt"), centrality = c("median", "MAP")) #' #' # brms models #' # ----------------------------------------------- #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' point_estimate(model, centrality = "all", dispersion = TRUE) #' point_estimate(model, centrality = c("median", "MAP")) #' #' # BayesFactor objects #' # ----------------------------------------------- #' library(BayesFactor) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' point_estimate(bf, centrality = "all", dispersion = TRUE) #' point_estimate(bf, centrality = c("median", "MAP")) #' } #' #' @export point_estimate <- function(x, ...) { UseMethod("point_estimate") } #' @export point_estimate.default <- function(x, ...) { stop(insight::format_message(paste0("'point_estimate()' is not yet implemented for objects of class '", class(x)[1], "'.")), call. = FALSE) } #' @rdname point_estimate #' @export point_estimate.numeric <- function(x, centrality = "all", dispersion = FALSE, threshold = .1, ...) { centrality <- match.arg(tolower(centrality), c("median", "mean", "map", "trimmed", "mode", "all"), several.ok = TRUE) if ("all" %in% centrality) { estimate_list <- c("median", "mean", "map") } else { estimate_list <- centrality } out <- data.frame(".temp" = 0) # Median if ("median" %in% estimate_list) { out$Median <- stats::median(x) if (dispersion) { out$MAD <- stats::mad(x) } } # Mean if ("mean" %in% estimate_list) { out$Mean <- mean(x) if (dispersion) { out$SD <- stats::sd(x) } } # trimmed mean if ("trimmed" %in% estimate_list) { out$Trimmed_Mean <- mean(x, trim = threshold) if (dispersion) { out$SD <- stats::sd(x) } } # MAP if ("map" %in% estimate_list) { out$MAP <- as.numeric(map_estimate(x)) } # MODE if ("mode" %in% estimate_list) { out$Mode <- .mode_estimate(x) } out <- out[names(out) != ".temp"] attr(out, "data") <- x attr(out, "centrality") <- centrality class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } .mode_estimate <- function(x) { ux <- unique(x) ux[which.max(tabulate(match(x, ux)))] } #' @export point_estimate.data.frame <- function(x, centrality = "all", dispersion = FALSE, threshold = .1, ...) { x <- .select_nums(x) if (ncol(x) == 1) { estimates <- point_estimate(x[, 1], centrality = centrality, dispersion = dispersion, threshold = threshold, ...) } else { estimates <- sapply(x, point_estimate, centrality = centrality, dispersion = dispersion, simplify = FALSE, ...) estimates <- do.call(rbind, estimates) } out <- cbind(data.frame("Parameter" = names(x), stringsAsFactors = FALSE), estimates) rownames(out) <- NULL attr(out, "data") <- x attr(out, "centrality") <- centrality class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } #' @export point_estimate.draws <- function(x, centrality = "all", dispersion = FALSE, threshold = .1, ...) { point_estimate(.posterior_draws_to_df(x), centrality = centrality, dispersion = dispersion, threshold = threshold, ...) } #' @export point_estimate.rvar <- point_estimate.draws #' @export point_estimate.mcmc <- function(x, centrality = "all", dispersion = FALSE, ...) { point_estimate(as.data.frame(x), centrality = centrality, dispersion = dispersion, ...) } #' @export point_estimate.bcplm <- function(x, centrality = "all", dispersion = FALSE, ...) { point_estimate(insight::get_parameters(x), centrality = centrality, dispersion = dispersion, ...) } #' @export point_estimate.bayesQR <- point_estimate.bcplm #' @export point_estimate.blrm <- point_estimate.bcplm #' @export point_estimate.mcmc.list <- point_estimate.bcplm #' @export point_estimate.BGGM <- point_estimate.bcplm #' @export point_estimate.bamlss <- function(x, centrality = "all", dispersion = FALSE, component = c("conditional", "location", "all"), ...) { component <- match.arg(component) out <- point_estimate(insight::get_parameters(x, component = component), centrality = centrality, dispersion = dispersion, ...) out <- .add_clean_parameters_attribute(out, x) out } #' @export point_estimate.MCMCglmm <- function(x, centrality = "all", dispersion = FALSE, ...) { nF <- x$Fixed$nfl point_estimate(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), centrality = centrality, dispersion = dispersion, ...) } #' @export point_estimate.emmGrid <- function(x, centrality = "all", dispersion = FALSE, ...) { xdf <- insight::get_parameters(x) out <- point_estimate(xdf, centrality = centrality, dispersion = dispersion, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export point_estimate.emm_list <- point_estimate.emmGrid # Helper ------------------------------------------------------------------ #' @keywords internal .point_estimate_models <- function(x, effects, component, parameters, centrality = "all", dispersion = FALSE, ...) { out <- point_estimate(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), centrality = centrality, dispersion = dispersion, ...) out } #' @rdname point_estimate #' @export point_estimate.stanreg <- function(x, centrality = "all", dispersion = FALSE, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( point_estimate(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), centrality = centrality, dispersion = dispersion, ...), cleaned_parameters, inherits(x, "stanmvreg") ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) attr(out, "centrality") <- centrality attr(out, "clean_parameters") <- cleaned_parameters class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } #' @export point_estimate.stanfit <- point_estimate.stanreg #' @export point_estimate.blavaan <- point_estimate.stanreg #' @rdname point_estimate #' @export point_estimate.brmsfit <- function(x, centrality = "all", dispersion = FALSE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( point_estimate(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), centrality = centrality, dispersion = dispersion, ...), cleaned_parameters ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) attr(out, "centrality") <- centrality attr(out, "clean_parameters") <- cleaned_parameters class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } #' @export point_estimate.sim.merMod <- function(x, centrality = "all", dispersion = FALSE, effects = c("fixed", "random", "all"), parameters = NULL, ...) { effects <- match.arg(effects) out <- .point_estimate_models( x = x, effects = effects, component = "conditional", parameters = parameters, centrality = centrality, dispersion = dispersion, ... ) attr(out, "data") <- insight::get_parameters(x, effects = effects, parameters = parameters) attr(out, "centrality") <- centrality out <- .add_clean_parameters_attribute(out, x) class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } #' @export point_estimate.sim <- function(x, centrality = "all", dispersion = FALSE, parameters = NULL, ...) { out <- .point_estimate_models( x = x, effects = "fixed", component = "conditional", parameters = parameters, centrality = centrality, dispersion = dispersion, ... ) attr(out, "data") <- insight::get_parameters(x, parameters = parameters) attr(out, "centrality") <- centrality class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } #' @rdname point_estimate #' @export point_estimate.BFBayesFactor <- function(x, centrality = "all", dispersion = FALSE, ...) { out <- point_estimate(insight::get_parameters(x), centrality = centrality, dispersion = dispersion, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) attr(out, "centrality") <- centrality class(out) <- unique(c("point_estimate", "see_point_estimate", class(out))) out } #' @export point_estimate.matrix <- function(x, ...) { point_estimate(as.data.frame(x), ...) } #' @export point_estimate.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { point_estimate(as.data.frame(t(attributes(x)$iterations)), ...) } else { as.numeric(x) } } bayestestR/R/bayesfactor_inclusion.R0000644000176200001440000001623614407021360017315 0ustar liggesusers#' Inclusion Bayes Factors for testing predictors across Bayesian models #' #' The `bf_*` function is an alias of the main function. #' \cr \cr #' For more info, see [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html). #' #' @author Mattan S. Ben-Shachar #' @param models An object of class [bayesfactor_models()] or `BFBayesFactor`. #' @param match_models See details. #' @param prior_odds Optional vector of prior odds for the models. See #' `BayesFactor::priorOdds<-`. #' @param ... Arguments passed to or from other methods. #' #' @return a data frame containing the prior and posterior probabilities, and #' log(BF) for each effect (Use `as.numeric()` to extract the non-log Bayes #' factors; see examples). #' #' @details Inclusion Bayes factors answer the question: Are the observed data #' more probable under models with a particular effect, than they are under #' models without that particular effect? In other words, on average - are #' models with effect \eqn{X} more likely to have produced the observed data #' than models without effect \eqn{X}? #' #' \subsection{Match Models}{ #' If `match_models=FALSE` (default), Inclusion BFs are computed by comparing #' all models with a term against all models without that term. If `TRUE`, #' comparison is restricted to models that (1) do not include any interactions #' with the term of interest; (2) for interaction terms, averaging is done only #' across models that containe the main effect terms from which the interaction #' term is comprised. #' } #' #' @inheritSection bayesfactor_parameters Interpreting Bayes Factors #' #' @note Random effects in the `lmer` style are converted to interaction terms: #' i.e., `(X|G)` will become the terms `1:G` and `X:G`. #' #' @seealso [weighted_posteriors()] for Bayesian parameter averaging. #' #' @examples #' library(bayestestR) #' #' # Using bayesfactor_models: #' # ------------------------------ #' mo0 <- lm(Sepal.Length ~ 1, data = iris) #' mo1 <- lm(Sepal.Length ~ Species, data = iris) #' mo2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris) #' mo3 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) #' #' BFmodels <- bayesfactor_models(mo1, mo2, mo3, denominator = mo0) #' (bf_inc <- bayesfactor_inclusion(BFmodels)) #' #' as.numeric(bf_inc) #' #' \dontrun{ #' # BayesFactor #' # ------------------------------- #' library(BayesFactor) #' #' BF <- generalTestBF(len ~ supp * dose, ToothGrowth, progress = FALSE) #' #' bayesfactor_inclusion(BF) #' #' # compare only matched models: #' bayesfactor_inclusion(BF, match_models = TRUE) #' } #' #' @references #' - Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25). #' A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64} #' #' - Clyde, M. A., Ghosh, J., & Littman, M. L. (2011). Bayesian adaptive sampling #' for variable selection and model averaging. Journal of Computational and Graphical Statistics, #' 20(1), 80-101. #' #' - Mathot, S. (2017). Bayes like a Baws: Interpreting Bayesian Repeated Measures in JASP. #' [Blog post](https://www.cogsci.nl/blog/interpreting-bayesian-repeated-measures-in-jasp). #' #' @export bayesfactor_inclusion <- function(models, match_models = FALSE, prior_odds = NULL, ...) { UseMethod("bayesfactor_inclusion") } #' @rdname bayesfactor_inclusion #' @export bf_inclusion <- bayesfactor_inclusion #' @export bayesfactor_inclusion.bayesfactor_models <- function(models, match_models = FALSE, prior_odds = NULL, ...) { if (isTRUE(attr(models, "unsupported_models"))) { insight::format_error( "Can not compute inclusion Bayes factors - passed models are not (yet) supported." ) } # Build Models Table # df.model <- .get_model_table(models, priorOdds = prior_odds) effnames <- colnames(df.model)[-(1:3)] # Build Interaction Matrix # if (isTRUE(match_models)) { effects.matrix <- as.matrix(df.model[, -(1:3)]) df.interaction <- data.frame(effnames, stringsAsFactors = FALSE) for (eff in effnames) { df.interaction[, eff] <- sapply(effnames, .includes_interaction, effnames = eff) } rownames(df.interaction) <- effnames df.interaction <- as.matrix(df.interaction[, -1]) } # Build Effect Table # df.effect <- data.frame( effnames, Pinc = rep(NA, length(effnames)), PincD = rep(NA, length(effnames)), log_BF = rep(NA, length(effnames)), stringsAsFactors = FALSE ) for (eff in effnames) { if (isTRUE(match_models)) { idx1 <- df.interaction[eff, ] idx2 <- df.interaction[, eff] has_not_high_order_interactions <- !apply(effects.matrix[, idx1, drop = FALSE], 1, any) ind_include <- has_not_high_order_interactions & effects.matrix[, eff] ind_exclude <- apply(effects.matrix[, idx2, drop = FALSE], 1, all) & has_not_high_order_interactions & !effects.matrix[, eff] df.model_temp <- df.model[ind_include | ind_exclude, , drop = FALSE] } else { df.model_temp <- df.model } # models with effect mwith <- which(df.model_temp[[eff]]) mwithprior <- sum(df.model_temp[mwith, "priorProbs"]) mwithpost <- sum(df.model_temp[mwith, "postProbs"]) # models without effect mwithoutprior <- sum(df.model_temp[-mwith, "priorProbs"]) mwithoutpost <- sum(df.model_temp[-mwith, "postProbs"]) # Save results df.effect$Pinc[effnames == eff] <- mwithprior df.effect$PincD[effnames == eff] <- mwithpost df.effect$log_BF[effnames == eff] <- (log(mwithpost) - log(mwithoutpost)) - (log(mwithprior) - log(mwithoutprior)) } df.effect <- df.effect[, -1, drop = FALSE] colnames(df.effect) <- c("p_prior", "p_posterior", "log_BF") rownames(df.effect) <- effnames class(df.effect) <- c("bayesfactor_inclusion", class(df.effect)) attr(df.effect, "matched") <- match_models attr(df.effect, "priorOdds") <- prior_odds return(df.effect) } #' @export bayesfactor_inclusion.BFBayesFactor <- function(models, match_models = FALSE, prior_odds = NULL, ...) { models <- bayesfactor_models.BFBayesFactor(models) bayesfactor_inclusion.bayesfactor_models(models, match_models = match_models, prior_odds = prior_odds ) } #' @keywords internal .includes_interaction <- function(eff, effnames) { eff_b <- strsplit(eff, ":", fixed = TRUE) effnames_b <- strsplit(effnames, ":", fixed = TRUE) is_int <- vapply(effnames_b, function(x) length(x) > 1, TRUE) temp <- logical(length(effnames)) for (rr in seq_along(effnames)) { if (is_int[rr]) { temp[rr] <- all(eff_b[[1]] %in% effnames_b[[rr]]) & !all(effnames_b[[rr]] %in% eff_b[[1]]) } } temp } bayestestR/R/p_direction.R0000644000176200001440000003707314407021360015231 0ustar liggesusers#' Probability of Direction (pd) #' #' Compute the **Probability of Direction** (***pd***, also known #' as the Maximum Probability of Effect - *MPE*). It varies between `50%` #' and `100%` (*i.e.*, `0.5` and `1`) and can be interpreted as #' the probability (expressed in percentage) that a parameter (described by its #' posterior distribution) is strictly positive or negative (whichever is the #' most probable). It is mathematically defined as the proportion of the #' posterior distribution that is of the median's sign. Although differently #' expressed, this index is fairly similar (*i.e.*, is strongly correlated) #' to the frequentist **p-value**. #' \cr\cr #' Note that in some (rare) cases, especially when used with model averaged #' posteriors (see [weighted_posteriors()] or #' `brms::posterior_average`), `pd` can be smaller than `0.5`, #' reflecting high credibility of `0`. #' #' @param x Vector representing a posterior distribution. Can also be a Bayesian model (`stanreg`, `brmsfit` or `BayesFactor`). #' @param method Can be `"direct"` or one of methods of [density estimation][estimate_density], such as `"kernel"`, `"logspline"` or `"KernSmooth"`. If `"direct"` (default), the computation is based on the raw ratio of samples superior and inferior to 0. Else, the result is based on the [Area under the Curve (AUC)][auc] of the estimated [density][estimate_density] function. #' @param null The value considered as a "null" effect. Traditionally 0, but could also be 1 in the case of ratios. #' @inheritParams hdi #' #' @details #' \subsection{What is the *pd*?}{ #' The Probability of Direction (pd) is an index of effect existence, ranging #' from `50%` to `100%`, representing the certainty with which an effect goes in #' a particular direction (*i.e.*, is positive or negative). Beyond its #' simplicity of interpretation, understanding and computation, this index also #' presents other interesting properties: #' \itemize{ #' \item It is independent from the model: It is solely based on the posterior #' distributions and does not require any additional information from the data #' or the model. #' \item It is robust to the scale of both the response variable and the predictors. #' \item It is strongly correlated with the frequentist p-value, and can thus #' be used to draw parallels and give some reference to readers non-familiar #' with Bayesian statistics. #' } #' } #' \subsection{Relationship with the p-value}{ #' In most cases, it seems that the *pd* has a direct correspondence with the frequentist one-sided *p*-value through the formula \ifelse{html}{\out{pone sided = 1 - p(d)/100}}{\eqn{p_{one sided}=1-\frac{p_{d}}{100}}} and to the two-sided p-value (the most commonly reported one) through the formula \ifelse{html}{\out{ptwo sided = 2 * (1 - p(d)/100)}}{\eqn{p_{two sided}=2*(1-\frac{p_{d}}{100})}}. Thus, a two-sided p-value of respectively `.1`, `.05`, `.01` and `.001` would correspond approximately to a *pd* of `95%`, `97.5%`, `99.5%` and `99.95%`. See also [pd_to_p()]. #' } #' \subsection{Methods of computation}{ #' The most simple and direct way to compute the *pd* is to 1) look at the #' median's sign, 2) select the portion of the posterior of the same sign and #' 3) compute the percentage that this portion represents. This "simple" method #' is the most straightforward, but its precision is directly tied to the #' number of posterior draws. The second approach relies on [density #' estimation][estimate_density]. It starts by estimating the density function #' (for which many methods are available), and then computing the [area under #' the curve][area_under_curve] (AUC) of the density curve on the other side of #' 0. #' } #' \subsection{Strengths and Limitations}{ #' **Strengths:** Straightforward computation and interpretation. Objective #' property of the posterior distribution. 1:1 correspondence with the #' frequentist p-value. #' \cr \cr #' **Limitations:** Limited information favoring the null hypothesis. #' } #' #' @return #' Values between 0.5 and 1 corresponding to the probability of direction (pd). #' \cr\cr #' Note that in some (rare) cases, especially when used with model averaged #' posteriors (see [weighted_posteriors()] or #' `brms::posterior_average`), `pd` can be smaller than `0.5`, #' reflecting high credibility of `0`. To detect such cases, the #' `method = "direct"` must be used. #' #' @seealso [pd_to_p()] to convert between Probability of Direction (pd) and p-value. #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @references #' Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect #' Existence and Significance in the Bayesian Framework. Frontiers in Psychology #' 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} #' #' @examples #' library(bayestestR) #' #' # Simulate a posterior distribution of mean 1 and SD 1 #' # ---------------------------------------------------- #' posterior <- rnorm(1000, mean = 1, sd = 1) #' p_direction(posterior) #' p_direction(posterior, method = "kernel") #' #' # Simulate a dataframe of posterior distributions #' # ----------------------------------------------- #' df <- data.frame(replicate(4, rnorm(100))) #' p_direction(df) #' p_direction(df, method = "kernel") #' \dontrun{ #' # rstanarm models #' # ----------------------------------------------- #' if (require("rstanarm")) { #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, #' data = mtcars, #' chains = 2, refresh = 0 #' ) #' p_direction(model) #' p_direction(model, method = "kernel") #' } #' #' # emmeans #' # ----------------------------------------------- #' if (require("emmeans")) { #' p_direction(emtrends(model, ~1, "wt")) #' } #' #' # brms models #' # ----------------------------------------------- #' if (require("brms")) { #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' p_direction(model) #' p_direction(model, method = "kernel") #' } #' #' # BayesFactor objects #' # ----------------------------------------------- #' if (require("BayesFactor")) { #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' p_direction(bf) #' p_direction(bf, method = "kernel") #' } #' } #' @export p_direction <- function(x, ...) { UseMethod("p_direction") } #' @rdname p_direction #' @export pd <- p_direction #' @export p_direction.default <- function(x, ...) { insight::format_error(paste0("'p_direction()' is not yet implemented for objects of class '", class(x)[1], "'.")) } #' @rdname p_direction #' @export p_direction.numeric <- function(x, method = "direct", null = 0, ...) { if (method == "direct") { pdir <- max( c( length(x[x > null]) / length(x), # pd positive length(x[x < null]) / length(x) # pd negative ) ) } else { dens <- estimate_density(x, method = method, precision = 2^10, extend = TRUE, ...) if (length(x[x > null]) > length(x[x < null])) { dens <- dens[dens$x > null, ] } else { dens <- dens[dens$x < null, ] } pdir <- area_under_curve(dens$x, dens$y, method = "spline") if (pdir >= 1) pdir <- 1 # Enforce bounds } attr(pdir, "method") <- method attr(pdir, "data") <- x class(pdir) <- unique(c("p_direction", "see_p_direction", class(pdir))) pdir } #' @export p_direction.parameters_model <- function(x, ...) { out <- data.frame( "Parameter" = x$Parameter, "pd" = p_to_pd(p = x[["p"]]), row.names = NULL, stringsAsFactors = FALSE ) if (!is.null(x$Component)) { out$Component <- x$Component } attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- unique(c("p_direction", "see_p_direction", class(out))) out } #' @rdname p_direction #' @export p_direction.data.frame <- function(x, method = "direct", null = 0, ...) { obj_name <- insight::safe_deparse_symbol(substitute(x)) x <- .select_nums(x) if (ncol(x) == 1) { pd <- p_direction(x[[1]], method = method, null = null, ...) } else { pd <- sapply(x, p_direction, method = method, null = null, simplify = TRUE, ...) } out <- data.frame( "Parameter" = names(x), "pd" = pd, row.names = NULL, stringsAsFactors = FALSE ) attr(out, "object_name") <- obj_name class(out) <- unique(c("p_direction", "see_p_direction", class(out))) out } #' @export p_direction.draws <- function(x, method = "direct", null = 0, ...) { p_direction(.posterior_draws_to_df(x), method = method, null = null, ...) } #' @export p_direction.rvar <- p_direction.draws #' @rdname p_direction #' @export p_direction.MCMCglmm <- function(x, method = "direct", null = 0, ...) { nF <- x$Fixed$nfl out <- p_direction(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), method = method, null = null, ... ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_direction.mcmc <- function(x, method = "direct", null = 0, ...) { p_direction(as.data.frame(x), method = method, null = null, ...) } #' @export p_direction.BGGM <- function(x, method = "direct", null = 0, ...) { p_direction(as.data.frame(x), method = method, null = null, ...) } #' @export p_direction.bcplm <- function(x, method = "direct", null = 0, ...) { p_direction(insight::get_parameters(x), method = method, null = null, ...) } #' @export p_direction.mcmc.list <- p_direction.bcplm #' @export p_direction.blrm <- p_direction.bcplm #' @export p_direction.bayesQR <- p_direction.bcplm #' @export p_direction.bamlss <- function(x, method = "direct", null = 0, component = c("all", "conditional", "location"), ...) { component <- match.arg(component) out <- p_direction( insight::get_parameters(x, component = component), method = method, null = null, ... ) out <- .add_clean_parameters_attribute(out, x) out } #' @rdname p_direction #' @export p_direction.emmGrid <- function(x, method = "direct", null = 0, ...) { xdf <- insight::get_parameters(x) out <- p_direction(xdf, method = method, null = null, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_direction.emm_list <- p_direction.emmGrid #' @keywords internal .p_direction_models <- function(x, effects, component, parameters, method = "direct", null = 0, ...) { p_direction( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), method = method, null = null, ... ) } #' @export p_direction.sim.merMod <- function(x, effects = c("fixed", "random", "all"), parameters = NULL, method = "direct", null = 0, ...) { effects <- match.arg(effects) out <- .p_direction_models( x = x, effects = effects, component = "conditional", parameters = parameters, method = method, null = null, ... ) attr(out, "data") <- insight::get_parameters(x, effects = effects, parameters = parameters) out } #' @export p_direction.sim <- function(x, parameters = NULL, method = "direct", null = 0, ...) { out <- .p_direction_models( x = x, effects = "fixed", component = "conditional", parameters = parameters, method = method, null = null, ... ) attr(out, "data") <- insight::get_parameters(x, parameters = parameters) out } #' @rdname p_direction #' @export p_direction.stanreg <- function(x, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, method = "direct", null = 0, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( p_direction( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), method = method, null = null, ... ), cleaned_parameters, inherits(x, "stanmvreg") ) attr(out, "clean_parameters") <- cleaned_parameters class(out) <- unique(c("p_direction", "see_p_direction", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_direction.stanfit <- p_direction.stanreg #' @export p_direction.blavaan <- p_direction.stanreg #' @rdname p_direction #' @export p_direction.brmsfit <- function(x, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, method = "direct", null = 0, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( p_direction( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), method = method, null = null, ... ), cleaned_parameters ) attr(out, "clean_parameters") <- cleaned_parameters class(out) <- unique(c("p_direction", "see_p_direction", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @rdname p_direction #' @export p_direction.BFBayesFactor <- function(x, method = "direct", null = 0, ...) { out <- p_direction(insight::get_parameters(x), method = method, null = null, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export p_direction.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { out <- p_direction(as.data.frame(t(attributes(x)$iterations)), ...) } else { stop("No iterations present in the output.", call. = FALSE) } attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } # Methods ----------------------------------------------------------------- #' Convert to Numeric #' #' @inheritParams base::as.numeric #' @method as.numeric p_direction #' @export as.numeric.p_direction <- function(x, ...) { if (inherits(x, "data.frame")) { return(as.numeric(as.vector(x$pd))) } else { return(as.vector(x)) } } #' @method as.double p_direction #' @export as.double.p_direction <- as.numeric.p_direction bayestestR/R/si.R0000644000176200001440000002322314407021360013335 0ustar liggesusers#' Compute Support Intervals #' #' A support interval contains only the values of the parameter that predict the observed data better #' than average, by some degree *k*; these are values of the parameter that are associated with an #' updating factor greater or equal than *k*. From the perspective of the Savage-Dickey Bayes factor, testing #' against a point null hypothesis for any value within the support interval will yield a Bayes factor smaller #' than *1/k*. #' \cr \cr #' \strong{For more info, in particular on specifying correct priors for factors with more than 2 levels, #' see [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html).} #' #' @param BF The amount of support required to be included in the support interval. #' @inheritParams bayesfactor_parameters #' @inheritParams hdi #' @inherit hdi seealso #' @family ci #' #' @details This method is used to compute support intervals based on prior and posterior distributions. #' For the computation of support intervals, the model priors must be proper priors (at the very least #' they should be *not flat*, and it is preferable that they be *informative* - note #' that by default, `brms::brm()` uses flat priors for fixed-effects; see example below). #' #' \subsection{Choosing a value of `BF`}{ #' The choice of `BF` (the level of support) depends on what we want our interval to represent: #' \itemize{ #' \item A `BF` = 1 contains values whose credibility is not decreased by observing the data. #' \item A `BF` > 1 contains values who received more impressive support from the data. #' \item A `BF` < 1 contains values whose credibility has *not* been impressively decreased by observing the data. #' Testing against values outside this interval will produce a Bayes factor larger than 1/`BF` in support of #' the alternative. E.g., if an SI (BF = 1/3) excludes 0, the Bayes factor against the point-null will be larger than 3. #' } #' } #' #' @inheritSection bayesfactor_parameters Setting the correct `prior` #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @return #' A data frame containing the lower and upper bounds of the SI. #' \cr #' Note that if the level of requested support is higher than observed in the data, the #' interval will be `[NA,NA]`. #' #' @examplesIf requireNamespace("logspline", quietly = TRUE) #' library(bayestestR) #' #' prior <- distribution_normal(1000, mean = 0, sd = 1) #' posterior <- distribution_normal(1000, mean = .5, sd = .3) #' #' si(posterior, prior) #' \dontrun{ #' # rstanarm models #' # --------------- #' library(rstanarm) #' contrasts(sleep$group) <- contr.equalprior_pairs # see vignette #' stan_model <- stan_lmer(extra ~ group + (1 | ID), data = sleep) #' si(stan_model) #' si(stan_model, BF = 3) #' #' # emmGrid objects #' # --------------- #' library(emmeans) #' group_diff <- pairs(emmeans(stan_model, ~group)) #' si(group_diff, prior = stan_model) #' #' # brms models #' # ----------- #' library(brms) #' contrasts(sleep$group) <- contr.equalprior_pairs # see vingette #' my_custom_priors <- #' set_prior("student_t(3, 0, 1)", class = "b") + #' set_prior("student_t(3, 0, 1)", class = "sd", group = "ID") #' #' brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID), #' data = sleep, #' prior = my_custom_priors, #' refresh = 0 #' )) #' si(brms_model) #' } #' @references #' Wagenmakers, E., Gronau, Q. F., Dablander, F., & Etz, A. (2018, November 22). The Support Interval. \doi{10.31234/osf.io/zwnxb} #' #' @export si <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) { UseMethod("si") } #' @rdname si #' @export si.numeric <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) { if (is.null(prior)) { prior <- posterior if (verbose) { insight::format_warning( "Prior not specified!", "Support intervals ('si') can only be computed for Bayesian models with proper priors.", "Please specify priors (with column order matching 'posterior')." ) } } prior <- data.frame(X = prior) posterior <- data.frame(X = posterior) # Get SIs out <- si.data.frame( posterior = posterior, prior = prior, BF = BF, verbose = verbose, ... ) out$Parameter <- NULL out } #' @rdname si #' @export si.stanreg <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, effects = c("fixed", "random", "all"), component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary", "distributional"), parameters = NULL, ...) { cleaned_parameters <- insight::clean_parameters(posterior) effects <- match.arg(effects) component <- match.arg(component) samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose, effects = effects, component = component, parameters = parameters ) # Get SIs temp <- si.data.frame( posterior = samps$posterior, prior = samps$prior, BF = BF, verbose = verbose, ... ) out <- .prepare_output(temp, cleaned_parameters, inherits(posterior, "stanmvreg")) attr(out, "ci_method") <- "SI" attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) class(out) <- class(temp) attr(out, "plot_data") <- attr(temp, "plot_data") out } #' @rdname si #' @export si.brmsfit <- si.stanreg #' @rdname si #' @export si.blavaan <- si.stanreg #' @rdname si #' @export si.emmGrid <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) { samps <- .clean_priors_and_posteriors(posterior, prior, verbose = verbose ) # Get SIs out <- si.data.frame( posterior = samps$posterior, prior = samps$prior, BF = BF, verbose = verbose, ... ) attr(out, "ci_method") <- "SI" attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) out } #' @export si.emm_list <- si.emmGrid #' @export si.stanfit <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, effects = c("fixed", "random", "all"), ...) { out <- si(insight::get_parameters(posterior, effects = effects), prior = prior, BF = BF, verbose = verbose ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) out } #' @export si.get_predicted <- function(posterior, ...) { out <- si(as.data.frame(t(posterior)), ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior)) out } #' @rdname si #' @export si.data.frame <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) { if (is.null(prior)) { prior <- posterior insight::format_warning( "Prior not specified!", "Support intervals ('si') can only be computed for Bayesian models with proper priors.", "Please specify priors (with column order matching 'posterior')." ) } if (verbose && (nrow(posterior) < 4e4 || nrow(prior) < 4e4)) { insight::format_warning( "Support intervals might not be precise.", "For precise support intervals, sampling at least 40,000 posterior samples is recommended." ) } out <- lapply(BF, function(BFi) { .si.data.frame(posterior, prior, BFi, verbose = verbose) }) out <- do.call(rbind, out) attr(out, "ci_method") <- "SI" attr(out, "ci") <- BF attr(out, "plot_data") <- .make_BF_plot_data(posterior, prior, 0, 0, ...)$plot_data class(out) <- unique(c("bayestestR_si", "see_si", "bayestestR_ci", "see_ci", class(out))) out } #' @export si.draws <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) { si(.posterior_draws_to_df(posterior), prior = prior, BF = BF, verbose = verbose, ...) } #' @export si.rvar <- si.draws # Helper ------------------------------------------------------------------ .si.data.frame <- function(posterior, prior, BF, verbose = TRUE, ...) { sis <- matrix(NA, nrow = ncol(posterior), ncol = 2) for (par in seq_along(posterior)) { sis[par, ] <- .si(posterior[[par]], prior[[par]], BF = BF, verbose = verbose, ... ) } out <- data.frame( Parameter = colnames(posterior), CI = BF, CI_low = sis[, 1], CI_high = sis[, 2], stringsAsFactors = FALSE ) } #' @keywords internal .si <- function(posterior, prior, BF = 1, extend_scale = 0.05, precision = 2^8, verbose = TRUE, ...) { insight::check_if_installed("logspline") if (isTRUE(all.equal(prior, posterior))) { return(c(NA, NA)) } x <- c(prior, posterior) x_range <- range(x) x_rangex <- stats::median(x) + 7 * stats::mad(x) * c(-1, 1) x_range <- c( max(c(x_range[1], x_rangex[1])), min(c(x_range[2], x_rangex[2])) ) extension_scale <- diff(x_range) * extend_scale x_range <- x_range + c(-1, 1) * extension_scale x_axis <- seq(x_range[1], x_range[2], length.out = precision) f_prior <- .logspline(prior, ...) f_posterior <- .logspline(posterior, ...) d_prior <- logspline::dlogspline(x_axis, f_prior) d_posterior <- logspline::dlogspline(x_axis, f_posterior) relative_d <- d_posterior / d_prior crit <- relative_d >= BF cp <- rle(stats::na.omit(crit)) if (length(cp$lengths) > 3 && verbose) { insight::format_warning("More than 1 SI detected. Plot the result to investigate.") } x_supported <- stats::na.omit(x_axis[crit]) if (length(x_supported) < 2) { return(c(NA, NA)) } else { range(x_supported) } } bayestestR/R/sexit_thresholds.R0000644000176200001440000001207614407021360016321 0ustar liggesusers#' @title Find Effect Size Thresholds #' #' @description This function attempts at automatically finding suitable default #' values for a "significant" (i.e., non-negligible) and "large" effect. This is #' to be used with care, and the chosen threshold should always be explicitly #' reported and justified. See the detail section in [`sexit()`][sexit] for more #' information. #' #' @inheritParams rope #' #' @examples #' sexit_thresholds(rnorm(1000)) #' \dontrun{ #' if (require("rstanarm")) { #' model <- stan_glm( #' mpg ~ wt + gear, #' data = mtcars, #' chains = 2, #' iter = 200, #' refresh = 0 #' ) #' sexit_thresholds(model) #' #' model <- stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0) #' sexit_thresholds(model) #' } #' #' if (require("brms")) { #' model <- brm(mpg ~ wt + cyl, data = mtcars) #' sexit_thresholds(model) #' } #' #' if (require("BayesFactor")) { #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' sexit_thresholds(bf) #' } #' } #' @references Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. #' #' @export sexit_thresholds <- function(x, ...) { UseMethod("sexit_thresholds") } #' @export sexit_thresholds.brmsfit <- function(x, verbose = TRUE, ...) { response <- insight::get_response(x, source = "mf") information <- insight::model_info(x, verbose = FALSE) if (insight::is_multivariate(x)) { mapply(function(i, j) .sexit_thresholds(i, j), x, information, response, verbose) } else { .sexit_thresholds(x, information, response, verbose) } } #' @export sexit_thresholds.stanreg <- sexit_thresholds.brmsfit #' @export sexit_thresholds.BFBayesFactor <- function(x, verbose = TRUE, ...) { fac <- 1 if (inherits(x@numerator[[1]], "BFlinearModel")) { response <- .safe(insight::get_response(x, source = "mf")) if (!is.null(response)) { fac <- stats::sd(response, na.rm = TRUE) } } fac * .sexit_thresholds(x, verbose = verbose) } #' @export sexit_thresholds.lm <- sexit_thresholds.brmsfit #' @export sexit_thresholds.glm <- sexit_thresholds.brmsfit #' @export sexit_thresholds.merMod <- sexit_thresholds.brmsfit #' @export sexit_thresholds.glmmTMB <- sexit_thresholds.brmsfit #' @export sexit_thresholds.mixed <- sexit_thresholds.brmsfit #' @export sexit_thresholds.MixMod <- sexit_thresholds.brmsfit #' @export sexit_thresholds.wbm <- sexit_thresholds.brmsfit #' @export sexit_thresholds.feis <- sexit_thresholds.brmsfit #' @export sexit_thresholds.gee <- sexit_thresholds.brmsfit #' @export sexit_thresholds.geeglm <- sexit_thresholds.brmsfit #' @export sexit_thresholds.lme <- sexit_thresholds.brmsfit #' @export sexit_thresholds.felm <- sexit_thresholds.brmsfit #' @export sexit_thresholds.fixest <- sexit_thresholds.brmsfit #' @export sexit_thresholds.gls <- sexit_thresholds.brmsfit #' @export sexit_thresholds.hurdle <- sexit_thresholds.brmsfit #' @export sexit_thresholds.zeroinfl <- sexit_thresholds.brmsfit #' @export sexit_thresholds.bayesQR <- sexit_thresholds.brmsfit #' @export sexit_thresholds.default <- function(x, verbose = TRUE, ...) { .sexit_thresholds(x, verbose = verbose) } #' @export sexit_thresholds.mlm <- function(x, verbose = TRUE, ...) { response <- insight::get_response(x, type = "mf") information <- insight::model_info(x, verbose = FALSE) lapply(response, function(i) .sexit_thresholds(x, information, i, verbose = verbose)) } # helper ------------------ .sexit_thresholds <- function(x, information = NULL, response = NULL, verbose = TRUE) { if (is.null(information) && is.null(response)) { norm <- 1 } else { norm <- tryCatch( { # Linear Models if (information$is_linear) { stats::sd(response, na.rm = TRUE) # Logistic Regression Models } else if (information$is_binomial) { pi / sqrt(3) # Count Models } else if (information$is_count) { sig <- stats::sigma(x) if (!is.null(sig) && length(sig) > 0 && !is.na(sig)) { sig } else { 1 } # T-tests } else if (information$is_ttest) { if (inherits(x, "BFBayesFactor")) { stats::sd(x@data[, 1]) } else { if (verbose) { insight::format_warning("Could not estimate good thresholds, using default values.") } 1 } # Correlations } else if (information$is_correlation) { # https://github.com/easystats/bayestestR/issues/121 1 # Default } else { 1 } }, error = function(e) { if (verbose) { insight::format_warning("Could not estimate good thresholds, using default values.") } 1 } ) } c(0.05, 0.3) * norm } bayestestR/R/bci.R0000644000176200001440000001652014407021360013461 0ustar liggesusers#' Bias Corrected and Accelerated Interval (BCa) #' #' Compute the **Bias Corrected and Accelerated Interval (BCa)** of posterior #' distributions. #' #' @inheritParams hdi #' @inherit ci return #' @inherit hdi details #' @inherit hdi seealso #' @family ci #' #' @references #' DiCiccio, T. J. and B. Efron. (1996). Bootstrap Confidence Intervals. #' Statistical Science. 11(3): 189–212. 10.1214/ss/1032280214 #' #' @examples #' posterior <- rnorm(1000) #' bci(posterior) #' bci(posterior, ci = c(0.80, 0.89, 0.95)) #' @export bci <- function(x, ...) { UseMethod("bci") } #' @rdname bci #' @export bcai <- bci #' @rdname bci #' @export bci.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- do.call(rbind, lapply(ci, function(i) { .bci(x = x, ci = i, verbose = verbose) })) class(out) <- unique(c("bayestestR_eti", "see_eti", "bayestestR_ci", "see_ci", class(out))) attr(out, "data") <- x out } #' @rdname bci #' @export bci.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "bci") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.draws <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "bci") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.rvar <- bci.draws #' @rdname bci #' @export bci.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) { nF <- x$Fixed$nfl d <- as.data.frame(x$Sol[, 1:nF, drop = FALSE]) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) { d <- as.data.frame(x) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.bamlss <- function(x, ci = 0.95, component = c("all", "conditional", "location"), verbose = TRUE, ...) { component <- match.arg(component) d <- insight::get_parameters(x, component = component) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.bcplm <- function(x, ci = 0.95, verbose = TRUE, ...) { d <- insight::get_parameters(x) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.bayesQR <- bci.bcplm #' @export bci.blrm <- bci.bcplm #' @export bci.mcmc.list <- bci.bcplm #' @export bci.BGGM <- bci.bcplm #' @rdname bci #' @export bci.sim.merMod <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) dat <- .compute_interval_simMerMod( x = x, ci = ci, effects = effects, parameters = parameters, verbose = verbose, fun = "bci" ) out <- dat$result attr(out, "data") <- dat$data out } #' @rdname bci #' @export bci.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { dat <- .compute_interval_sim( x = x, ci = ci, parameters = parameters, verbose = verbose, fun = "bci" ) out <- dat$result attr(out, "data") <- dat$data out } #' @rdname bci #' @export bci.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) dat <- bci(xdf, ci = ci, verbose = verbose, ...) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export bci.emm_list <- bci.emmGrid #' @rdname bci #' @export bci.stanreg <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .prepare_output( bci( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), ci = ci, verbose = verbose, ... ), insight::clean_parameters(x), inherits(x, "stanmvreg") ) class(out) <- unique(c("bayestestR_eti", "see_eti", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export bci.stanfit <- bci.stanreg #' @export bci.blavaan <- bci.stanreg #' @rdname bci #' @export bci.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .prepare_output( bci(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), ci = ci, verbose = verbose, ...), insight::clean_parameters(x) ) class(out) <- unique(c("bayestestR_eti", "see_eti", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @rdname bci #' @export bci.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- bci(insight::get_parameters(x), ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export bci.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { out <- bci(as.data.frame(t(attributes(x)$iterations)), ...) } else { insight::format_error("No iterations present in the output.") } attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } # Helper ------------------------------------------------------------------ .bci <- function(x, ci, verbose = TRUE) { check_ci <- .check_ci_argument(x, ci, verbose) if (!is.null(check_ci)) { return(check_ci) } low <- (1 - ci) / 2 high <- 1 - low sims <- length(x) z.inv <- length(x[x < mean(x, na.rm = TRUE)]) / sims z <- stats::qnorm(z.inv) U <- (sims - 1) * (mean(x, na.rm = TRUE) - x) top <- sum(U^3) under <- 6 * (sum(U^2))^1.5 a <- top / under lower.inv <- stats::pnorm(z + (z + stats::qnorm(low)) / (1 - a * (z + stats::qnorm(low)))) lower <- stats::quantile(x, lower.inv, names = FALSE, na.rm = TRUE) upper.inv <- stats::pnorm(z + (z + stats::qnorm(high)) / (1 - a * (z + stats::qnorm(high)))) upper <- stats::quantile(x, upper.inv, names = FALSE, na.rm = TRUE) data.frame( "CI" = ci, "CI_low" = lower, "CI_high" = upper ) } bayestestR/R/eti.R0000644000176200001440000001654514407021360013514 0ustar liggesusers#' Equal-Tailed Interval (ETI) #' #' Compute the **Equal-Tailed Interval (ETI)** of posterior distributions using #' the quantiles method. The probability of being below this interval is equal #' to the probability of being above it. The ETI can be used in the context of #' uncertainty characterisation of posterior distributions as #' **Credible Interval (CI)**. #' #' @inheritParams hdi #' @inherit ci return #' @inherit hdi details #' @inherit hdi seealso #' @family ci #' #' @examples #' library(bayestestR) #' #' posterior <- rnorm(1000) #' eti(posterior) #' eti(posterior, ci = c(0.80, 0.89, 0.95)) #' #' df <- data.frame(replicate(4, rnorm(100))) #' eti(df) #' eti(df, ci = c(0.80, 0.89, 0.95)) #' \dontrun{ #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' eti(model) #' eti(model, ci = c(0.80, 0.89, 0.95)) #' #' library(emmeans) #' eti(emtrends(model, ~1, "wt")) #' #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' eti(model) #' eti(model, ci = c(0.80, 0.89, 0.95)) #' #' library(BayesFactor) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' eti(bf) #' eti(bf, ci = c(0.80, 0.89, 0.95)) #' } #' #' @export eti <- function(x, ...) { UseMethod("eti") } #' @export eti.default <- function(x, ...) { insight::format_error(paste0("'eti()' is not yet implemented for objects of class '", class(x)[1], "'.")) } #' @rdname eti #' @export eti.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- do.call(rbind, lapply(ci, function(i) { .eti(x = x, ci = i, verbose = verbose) })) class(out) <- unique(c("bayestestR_eti", "see_eti", "bayestestR_ci", "see_ci", class(out))) attr(out, "data") <- x out } #' @export eti.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "eti") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.draws <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "eti") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.rvar <- eti.draws #' @export eti.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) { nF <- x$Fixed$nfl d <- as.data.frame(x$Sol[, 1:nF, drop = FALSE]) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) { d <- as.data.frame(x) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.bamlss <- function(x, ci = 0.95, component = c("all", "conditional", "location"), verbose = TRUE, ...) { component <- match.arg(component) d <- insight::get_parameters(x, component = component) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.bcplm <- function(x, ci = 0.95, verbose = TRUE, ...) { d <- insight::get_parameters(x) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti") attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.bayesQR <- eti.bcplm #' @export eti.blrm <- eti.bcplm #' @export eti.mcmc.list <- eti.bcplm #' @export eti.BGGM <- eti.bcplm #' @export eti.sim.merMod <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) dat <- .compute_interval_simMerMod( x = x, ci = ci, effects = effects, parameters = parameters, verbose = verbose, fun = "eti" ) out <- dat$result attr(out, "data") <- dat$data out } #' @export eti.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { dat <- .compute_interval_sim(x = x, ci = ci, parameters = parameters, verbose = verbose, fun = "eti") out <- dat$result attr(out, "data") <- dat$data out } #' @export eti.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) dat <- eti(xdf, ci = ci, verbose = verbose, ...) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export eti.emm_list <- eti.emmGrid #' @rdname eti #' @export eti.stanreg <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .prepare_output( eti( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), ci = ci, verbose = verbose, ... ), insight::clean_parameters(x), inherits(x, "stanmvreg") ) class(out) <- unique(c("bayestestR_eti", "see_eti", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export eti.stanfit <- eti.stanreg #' @export eti.blavaan <- eti.stanreg #' @rdname eti #' @export eti.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .prepare_output( eti( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), ci = ci, verbose = verbose, ... ), insight::clean_parameters(x) ) class(out) <- unique(c("bayestestR_eti", "see_eti", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export eti.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- eti(insight::get_parameters(x), ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export eti.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { out <- eti(as.data.frame(t(attributes(x)$iterations)), ...) } else { insight::format_error("No iterations present in the output.") } attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } # Helper ------------------------------------------------------------------ .eti <- function(x, ci, verbose = TRUE) { check_ci <- .check_ci_argument(x, ci, verbose) if (!is.null(check_ci)) { return(check_ci) } results <- as.vector(stats::quantile( x, probs = c((1 - ci) / 2, (1 + ci) / 2), names = FALSE, na.rm = TRUE )) data.frame( "CI" = ci, "CI_low" = results[1], "CI_high" = results[2] ) } bayestestR/R/overlap.R0000644000176200001440000000435614307033605014404 0ustar liggesusers#' Overlap Coefficient #' #' A method to calculate the overlap coefficient between two empirical distributions (that can be used as a measure of similarity between two samples). #' #' @param x Vector of x values. #' @param y Vector of x values. #' @param method_auc Area Under the Curve (AUC) estimation method. See [area_under_curve()]. #' @param method_density Density estimation method. See [estimate_density()]. #' @inheritParams estimate_density #' #' @examples #' library(bayestestR) #' #' x <- distribution_normal(1000, 2, 0.5) #' y <- distribution_normal(1000, 0, 1) #' #' overlap(x, y) #' plot(overlap(x, y)) #' @export overlap <- function(x, y, method_density = "kernel", method_auc = "trapezoid", precision = 2^10, extend = TRUE, extend_scale = 0.1, ...) { # Generate densities dx <- estimate_density(x, method = method_density, precision = precision, extend = extend, extend_scale = extend_scale, ...) dy <- estimate_density(y, method = method_density, precision = precision, extend = extend, extend_scale = extend_scale, ...) # Create density estimation functions fx <- stats::approxfun(dx$x, dx$y, method = "linear", rule = 2) fy <- stats::approxfun(dy$x, dy$y, method = "linear", rule = 2) x_axis <- seq(min(c(dx$x, dy$x)), max(c(dx$x, dy$x)), length.out = precision) data <- data.frame(x = x_axis, y1 = fx(x_axis), y2 = fy(x_axis)) # calculate intersection densities data$intersection <- pmin(data$y1, data$y2) data$exclusion <- pmax(data$y1, data$y2) # integrate areas under curves area_intersection <- area_under_curve(data$x, data$intersection, method = method_auc) # area_exclusion <- area_under_curve(data$x, data$exclusion, method = method_auc) # compute overlap coefficient overlap <- area_intersection attr(overlap, "data") <- data class(overlap) <- c("overlap", class(overlap)) overlap } #' @export print.overlap <- function(x, ...) { insight::print_color("# Overlap\n\n", "blue") cat(sprintf("%.2f", as.numeric(x))) } #' @export plot.overlap <- function(x, ...) { # Can be improved through see data <- attributes(x)$data graphics::plot(data$x, data$exclusion, type = "l") graphics::polygon(data$x, data$intersection, col = "red") } bayestestR/R/equivalence_test.R0000644000176200001440000003406314407021360016266 0ustar liggesusers#' Test for Practical Equivalence #' #' Perform a **Test for Practical Equivalence** for Bayesian and frequentist models. #' #' Documentation is accessible for: #' \itemize{ #' \item [Bayesian models](https://easystats.github.io/bayestestR/reference/equivalence_test.html) #' \item [Frequentist models](https://easystats.github.io/parameters/reference/equivalence_test.lm.html) #' } #' #' For Bayesian models, the **Test for Practical Equivalence** is based on the *"HDI+ROPE decision rule"* (\cite{Kruschke, 2014, 2018}) to check whether parameter values should be accepted or rejected against an explicitly formulated "null hypothesis" (i.e., a ROPE). In other words, it checks the percentage of the `89%` [HDI][hdi] that is the null region (the ROPE). If this percentage is sufficiently low, the null hypothesis is rejected. If this percentage is sufficiently high, the null hypothesis is accepted. #' #' #' @inheritParams rope #' #' @details Using the [ROPE][rope] and the [HDI][hdi], \cite{Kruschke (2018)} #' suggests using the percentage of the `95%` (or `89%`, considered more stable) #' HDI that falls within the ROPE as a decision rule. If the HDI #' is completely outside the ROPE, the "null hypothesis" for this parameter is #' "rejected". If the ROPE completely covers the HDI, i.e., all most credible #' values of a parameter are inside the region of practical equivalence, the #' null hypothesis is accepted. Else, it’s undecided whether to accept or #' reject the null hypothesis. If the full ROPE is used (i.e., `100%` of the #' HDI), then the null hypothesis is rejected or accepted if the percentage #' of the posterior within the ROPE is smaller than to `2.5%` or greater than #' `97.5%`. Desirable results are low proportions inside the ROPE (the closer #' to zero the better). #' \cr \cr #' Some attention is required for finding suitable values for the ROPE limits #' (argument `range`). See 'Details' in [`rope_range()`][rope_range] #' for further information. #' \cr \cr #' **Multicollinearity: Non-independent covariates** #' \cr \cr #' When parameters show strong correlations, i.e. when covariates are not #' independent, the joint parameter distributions may shift towards or #' away from the ROPE. In such cases, the test for practical equivalence may #' have inappropriate results. Collinearity invalidates ROPE and hypothesis #' testing based on univariate marginals, as the probabilities are conditional #' on independence. Most problematic are the results of the "undecided" #' parameters, which may either move further towards "rejection" or away #' from it (\cite{Kruschke 2014, 340f}). #' \cr \cr #' `equivalence_test()` performs a simple check for pairwise correlations #' between parameters, but as there can be collinearity between more than two variables, #' a first step to check the assumptions of this hypothesis testing is to look #' at different pair plots. An even more sophisticated check is the projection #' predictive variable selection (\cite{Piironen and Vehtari 2017}). #' #' #' @references #' - Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304} #' - Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press #' - Piironen, J., & Vehtari, A. (2017). Comparison of Bayesian predictive methods for model selection. Statistics and Computing, 27(3), 711–735. \doi{10.1007/s11222-016-9649-y} #' #' @return A data frame with following columns: #' \itemize{ #' \item `Parameter` The model parameter(s), if `x` is a model-object. If `x` is a vector, this column is missing. #' \item `CI` The probability of the HDI. #' \item `ROPE_low`, `ROPE_high` The limits of the ROPE. These values are identical for all parameters. #' \item `ROPE_Percentage` The proportion of the HDI that lies inside the ROPE. #' \item `ROPE_Equivalence` The "test result", as character. Either "rejected", "accepted" or "undecided". #' \item `HDI_low` , `HDI_high` The lower and upper HDI limits for the parameters. #' } #' #' @note There is a `print()`-method with a `digits`-argument to control #' the amount of digits in the output, and there is a #' [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) #' to visualize the results from the equivalence-test (for models only). #' #' @examples #' library(bayestestR) #' #' equivalence_test(x = rnorm(1000, 0, 0.01), range = c(-0.1, 0.1)) #' equivalence_test(x = rnorm(1000, 0, 1), range = c(-0.1, 0.1)) #' equivalence_test(x = rnorm(1000, 1, 0.01), range = c(-0.1, 0.1)) #' equivalence_test(x = rnorm(1000, 1, 1), ci = c(.50, .99)) #' #' # print more digits #' test <- equivalence_test(x = rnorm(1000, 1, 1), ci = c(.50, .99)) #' print(test, digits = 4) #' \dontrun{ #' library(rstanarm) #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) #' equivalence_test(model) #' #' # plot result #' test <- equivalence_test(model) #' plot(test) #' #' library(emmeans) #' equivalence_test(emtrends(model, ~1, "wt")) #' #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' equivalence_test(model) #' #' library(BayesFactor) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' # equivalence_test(bf) #' } #' @export equivalence_test <- function(x, ...) { UseMethod("equivalence_test") } #' @rdname equivalence_test #' @export equivalence_test.default <- function(x, ...) { NULL } #' @export equivalence_test.numeric <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { rope_data <- rope(x, range = range, ci = ci) out <- as.data.frame(rope_data) if (all(ci < 1)) { out$ROPE_Equivalence <- ifelse(out$ROPE_Percentage == 0, "Rejected", ifelse(out$ROPE_Percentage == 1, "Accepted", "Undecided") ) } else { # Related to guidelines for full rope (https://easystats.github.io/bayestestR/articles/4_Guidelines.html) out$ROPE_Equivalence <- ifelse(out$ROPE_Percentage < 0.025, "Rejected", ifelse(out$ROPE_Percentage > 0.975, "Accepted", "Undecided") ) } out$HDI_low <- attr(rope_data, "HDI_area", exact = TRUE)$CI_low out$HDI_high <- attr(rope_data, "HDI_area", exact = TRUE)$CI_high # remove attribute attr(out, "HDI_area") <- NULL attr(out, "data") <- x class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out))) out } #' @rdname equivalence_test #' @export equivalence_test.data.frame <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { l <- insight::compact_list(lapply( x, equivalence_test, range = range, ci = ci, verbose = verbose )) dat <- do.call(rbind, l) out <- data.frame( Parameter = rep(names(l), each = nrow(dat) / length(l)), dat, stringsAsFactors = FALSE ) row.names(out) <- NULL attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- unique(c("equivalence_test", "see_equivalence_test_df", class(out))) out } #' @export equivalence_test.draws <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { equivalence_test(.posterior_draws_to_df(x), range = range, ci = ci, verbose = verbose, ...) } #' @export equivalence_test.rvar <- equivalence_test.draws #' @export equivalence_test.emmGrid <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) out <- equivalence_test(xdf, range = range, ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export equivalence_test.emm_list <- equivalence_test.emmGrid #' @export equivalence_test.BFBayesFactor <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) { out <- equivalence_test(insight::get_parameters(x), range = range, ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @keywords internal .equivalence_test_models <- function(x, range = "default", ci = 0.95, effects = "fixed", component = "conditional", parameters = NULL, verbose = TRUE) { if (all(range == "default")) { range <- rope_range(x) } else if (!all(is.numeric(range)) || length(range) != 2L) { insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).") } if (verbose && !inherits(x, "blavaan")) .check_multicollinearity(x) params <- insight::get_parameters( x, component = component, effects = effects, parameters = parameters, verbose = verbose ) l <- sapply( params, equivalence_test, range = range, ci = ci, verbose = verbose, simplify = FALSE ) dat <- do.call(rbind, l) out <- data.frame( Parameter = rep(names(l), each = nrow(dat) / length(l)), dat, stringsAsFactors = FALSE ) class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out))) out } #' @rdname equivalence_test #' @export equivalence_test.stanreg <- function(x, range = "default", ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .equivalence_test_models(x, range, ci, effects, component, parameters, verbose) out <- .prepare_output( out, insight::clean_parameters(x), inherits(x, "stanmvreg") ) class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export equivalence_test.stanfit <- equivalence_test.stanreg #' @export equivalence_test.blavaan <- equivalence_test.stanreg #' @rdname equivalence_test #' @export equivalence_test.brmsfit <- function(x, range = "default", ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) out <- .equivalence_test_models(x, range, ci, effects, component, parameters, verbose) out <- .prepare_output( out, insight::clean_parameters(x), inherits(x, "stanmvreg") ) class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out))) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export equivalence_test.sim.merMod <- function(x, range = "default", ci = 0.95, parameters = NULL, verbose = TRUE, ...) { out <- .equivalence_test_models( x, range, ci, effects = "fixed", component = "conditional", parameters, verbose = verbose ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export equivalence_test.sim <- equivalence_test.sim.merMod #' @export equivalence_test.mcmc <- function(x, range = "default", ci = 0.95, parameters = NULL, verbose = TRUE, ...) { out <- .equivalence_test_models( as.data.frame(x), range, ci, effects = "fixed", component = "conditional", parameters, verbose = verbose ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export equivalence_test.bcplm <- function(x, range = "default", ci = 0.95, parameters = NULL, verbose = TRUE, ...) { out <- .equivalence_test_models( insight::get_parameters(x), range, ci, effects = "fixed", component = "conditional", parameters, verbose = verbose ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export equivalence_test.blrm <- equivalence_test.bcplm #' @export equivalence_test.mcmc.list <- equivalence_test.bcplm #' @export equivalence_test.bayesQR <- equivalence_test.bcplm #' @export equivalence_test.bamlss <- function(x, range = "default", ci = 0.95, component = c("all", "conditional", "location"), parameters = NULL, verbose = TRUE, ...) { component <- match.arg(component) out <- .equivalence_test_models( insight::get_parameters(x, component = component), range, ci, effects = "fixed", component = "conditional", parameters, verbose = verbose ) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } bayestestR/R/hdi.R0000644000176200001440000003450414407021360013472 0ustar liggesusers#' Highest Density Interval (HDI) #' #' Compute the **Highest Density Interval (HDI)** of posterior distributions. #' All points within this interval have a higher probability density than points #' outside the interval. The HDI can be used in the context of uncertainty #' characterisation of posterior distributions as **Credible Interval (CI)**. #' #' @param x Vector representing a posterior distribution, or a data frame of such #' vectors. Can also be a Bayesian model. **bayestestR** supports a wide range #' of models (see, for example, `methods("hdi")`) and not all of those are #' documented in the 'Usage' section, because methods for other classes mostly #' resemble the arguments of the `.numeric` or `.data.frame`methods. #' @param ci Value or vector of probability of the (credible) interval - CI #' (between 0 and 1) to be estimated. Default to `.95` (`95%`). #' @param effects Should results for fixed effects, random effects or both be #' returned? Only applies to mixed models. May be abbreviated. #' @param component Should results for all parameters, parameters for the #' conditional model or the zero-inflated part of the model be returned? May #' be abbreviated. Only applies to \pkg{brms}-models. #' @param parameters Regular expression pattern that describes the parameters #' that should be returned. Meta-parameters (like `lp__` or `prior_`) are #' filtered by default, so only parameters that typically appear in the #' `summary()` are returned. Use `parameters` to select specific parameters #' for the output. #' @param verbose Toggle off warnings. #' @param ... Currently not used. #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @details Unlike equal-tailed intervals (see `eti()`) that typically exclude `2.5%` #' from each tail of the distribution and always include the median, the HDI is #' *not* equal-tailed and therefore always includes the mode(s) of posterior #' distributions. While this can be useful to better represent the credibility #' mass of a distribution, the HDI also has some limitations. See [spi()] for #' details. #' \cr \cr #' The [`95%` or `89%` Credible Intervals (CI)](https://easystats.github.io/bayestestR/articles/credible_interval.html) #' are two reasonable ranges to characterize the uncertainty related to the estimation (see [here](https://easystats.github.io/bayestestR/articles/credible_interval.html) for a discussion about the differences between these two values). #' \cr #' The `89%` intervals (`ci = 0.89`) are deemed to be more stable than, for #' instance, `95%` intervals (\cite{Kruschke, 2014}). An effective sample size #' of at least 10.000 is recommended if one wants to estimate `95%` intervals #' with high precision (\cite{Kruschke, 2014, p. 183ff}). Unfortunately, the #' default number of posterior samples for most Bayes packages (e.g., `rstanarm` #' or `brms`) is only 4.000 (thus, you might want to increase it when fitting #' your model). Moreover, 89 indicates the arbitrariness of interval limits - #' its only remarkable property is being the highest prime number that does not #' exceed the already unstable `95%` threshold (\cite{McElreath, 2015}). #' \cr #' However, `95%` has some [advantages #' too](https://easystats.github.io/blog/posts/bayestestr_95/). For instance, it #' shares (in the case of a normal posterior distribution) an intuitive #' relationship with the standard deviation and it conveys a more accurate image #' of the (artificial) bounds of the distribution. Also, because it is wider, it #' makes analyses more conservative (i.e., the probability of covering 0 is #' larger for the `95%` CI than for lower ranges such as `89%`), which is a good #' thing in the context of the reproducibility crisis. #' \cr \cr #' A `95%` equal-tailed interval (ETI) has `2.5%` of the distribution on either #' side of its limits. It indicates the 2.5th percentile and the 97.5h #' percentile. In symmetric distributions, the two methods of computing credible #' intervals, the ETI and the [HDI][hdi], return similar results. #' \cr \cr #' This is not the case for skewed distributions. Indeed, it is possible that #' parameter values in the ETI have lower credibility (are less probable) than #' parameter values outside the ETI. This property seems undesirable as a summary #' of the credible values in a distribution. #' \cr \cr #' On the other hand, the ETI range does change when transformations are applied #' to the distribution (for instance, for a log odds scale to probabilities): #' the lower and higher bounds of the transformed distribution will correspond #' to the transformed lower and higher bounds of the original distribution. #' On the contrary, applying transformations to the distribution will change #' the resulting HDI. #' #' @inherit ci return #' #' @family ci #' @seealso Other interval functions, such as [hdi()], [eti()], [bci()], [spi()], [si()], [cwi()]. #' #' @examples #' library(bayestestR) #' #' posterior <- rnorm(1000) #' hdi(posterior, ci = 0.89) #' hdi(posterior, ci = c(.80, .90, .95)) #' #' df <- data.frame(replicate(4, rnorm(100))) #' hdi(df) #' hdi(df, ci = c(.80, .90, .95)) #' \dontrun{ #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' hdi(model) #' hdi(model, ci = c(.80, .90, .95)) #' #' library(emmeans) #' hdi(emtrends(model, ~1, "wt")) #' #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' hdi(model) #' hdi(model, ci = c(.80, .90, .95)) #' #' library(BayesFactor) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' hdi(bf) #' hdi(bf, ci = c(.80, .90, .95)) #' } #' @author Credits go to **ggdistribute** and [**HDInterval**](https://github.com/mikemeredith/HDInterval). #' #' @references \itemize{ #' \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. #' \item McElreath, R. (2015). Statistical rethinking: A Bayesian course with examples in R and Stan. Chapman and Hall/CRC. #' } #' #' @export hdi <- function(x, ...) { UseMethod("hdi") } #' @export hdi.default <- function(x, ...) { insight::format_error(paste0("'hdi()' is not yet implemented for objects of class '", class(x)[1], "'.")) } #' @rdname hdi #' @export hdi.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- do.call(rbind, lapply(ci, function(i) { .hdi(x, ci = i, verbose = verbose) })) class(out) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_ci", "see_ci", class(out))) attr(out, "data") <- x out } #' @rdname hdi #' @export hdi.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "hdi") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export hdi.draws <- function(x, ci = 0.95, verbose = TRUE, ...) { dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "hdi") attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export hdi.rvar <- hdi.draws #' @export hdi.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) { ci_fun <- .check_ci_fun(list(...)) nF <- x$Fixed$nfl d <- as.data.frame(x$Sol[, 1:nF, drop = FALSE]) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun) attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export hdi.bamlss <- function(x, ci = 0.95, component = c("all", "conditional", "location"), verbose = TRUE, ...) { ci_fun <- .check_ci_fun(list(...)) component <- match.arg(component) d <- insight::get_parameters(x, component = component) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun) dat <- .add_clean_parameters_attribute(dat, x) attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export hdi.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) { ci_fun <- .check_ci_fun(list(...)) d <- as.data.frame(x) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun) attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export hdi.bcplm <- function(x, ci = 0.95, verbose = TRUE, ...) { ci_fun <- .check_ci_fun(list(...)) d <- insight::get_parameters(x) dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun) attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export hdi.bayesQR <- hdi.bcplm #' @export hdi.blrm <- hdi.bcplm #' @export hdi.mcmc.list <- hdi.bcplm #' @export hdi.BGGM <- hdi.bcplm #' @export hdi.sim.merMod <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) { ci_fun <- .check_ci_fun(list(...)) effects <- match.arg(effects) dat <- .compute_interval_simMerMod( x = x, ci = ci, effects = effects, parameters = parameters, verbose = verbose, fun = ci_fun ) out <- dat$result attr(out, "data") <- dat$data out } #' @export hdi.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) { ci_fun <- .check_ci_fun(list(...)) dat <- .compute_interval_sim( x = x, ci = ci, parameters = parameters, verbose = verbose, fun = ci_fun ) out <- dat$result attr(out, "data") <- dat$data out } #' @export hdi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) { xdf <- insight::get_parameters(x) out <- hdi(xdf, ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export hdi.emm_list <- hdi.emmGrid #' @rdname hdi #' @export hdi.stanreg <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( hdi( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), ci = ci, verbose = verbose, ... ), cleaned_parameters, inherits(x, "stanmvreg") ) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- unique(c("bayestestR_hdi", "see_hdi", class(out))) out } #' @export hdi.stanfit <- hdi.stanreg #' @export hdi.blavaan <- hdi.stanreg #' @rdname hdi #' @export hdi.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) cleaned_parameters <- insight::clean_parameters(x) out <- .prepare_output( hdi( insight::get_parameters( x, effects = effects, component = component, parameters = parameters ), ci = ci, verbose = verbose, ... ), cleaned_parameters ) attr(out, "clean_parameters") <- cleaned_parameters attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- unique(c("bayestestR_hdi", "see_hdi", class(out))) out } #' @export hdi.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) { out <- hdi(insight::get_parameters(x), ci = ci, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export hdi.get_predicted <- function(x, ...) { if ("iterations" %in% names(attributes(x))) { out <- hdi(as.data.frame(t(attributes(x)$iterations)), ...) } else { insight::format_error("No iterations present in the output.") } attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } # Helper ------------------------------------------------------------------ #' @keywords internal .hdi <- function(x, ci = 0.95, verbose = TRUE) { check_ci <- .check_ci_argument(x, ci, verbose) if (!is.null(check_ci)) { return(check_ci) } x_sorted <- unname(sort.int(x, method = "quick")) # removes NA/NaN, but not Inf window_size <- ceiling(ci * length(x_sorted)) # See https://github.com/easystats/bayestestR/issues/39 if (window_size < 2) { if (verbose) { insight::format_warning("`ci` is too small or x does not contain enough data points, returning NAs.") } return(data.frame( "CI" = ci, "CI_low" = NA, "CI_high" = NA )) } nCIs <- length(x_sorted) - window_size if (nCIs < 1) { if (verbose) { insight::format_warning("`ci` is too large or x does not contain enough data points, returning NAs.") } return(data.frame( "CI" = ci, "CI_low" = NA, "CI_high" = NA )) } ci.width <- sapply(1:nCIs, function(.x) x_sorted[.x + window_size] - x_sorted[.x]) # find minimum of width differences, check for multiple minima min_i <- which(ci.width == min(ci.width)) n_candies <- length(min_i) if (n_candies > 1) { if (any(diff(sort(min_i)) != 1)) { if (verbose) { insight::format_warning("Identical densities found along different segments of the distribution, choosing rightmost.") } min_i <- max(min_i) } else { min_i <- floor(mean(min_i)) } } data.frame( "CI" = ci, "CI_low" = x_sorted[min_i], "CI_high" = x_sorted[min_i + window_size] ) } bayestestR/R/simulate_simpson.R0000644000176200001440000000313414307033605016320 0ustar liggesusers#' Simpson's paradox dataset simulation #' #' Simpson's paradox, or the Yule-Simpson effect, is a phenomenon in probability #' and statistics, in which a trend appears in several different groups of data #' but disappears or reverses when these groups are combined. #' #' @param n The number of observations for each group to be generated (minimum #' 4). #' @param groups Number of groups (groups can be participants, clusters, #' anything). #' @param difference Difference between groups. #' @param group_prefix The prefix of the group name (e.g., "G_1", "G_2", "G_3", ...). #' @inheritParams simulate_correlation #' #' @return A dataset. #' #' @examples #' data <- simulate_simpson(n = 10, groups = 5, r = 0.5) #' #' if (require("ggplot2")) { #' ggplot(data, aes(x = V1, y = V2)) + #' geom_point(aes(color = Group)) + #' geom_smooth(aes(color = Group), method = "lm") + #' geom_smooth(method = "lm") #' } #' @export simulate_simpson <- function(n = 100, r = 0.5, groups = 3, difference = 1, group_prefix = "G_") { if (n <= 3) { stop("The number of observation `n` should be higher than 3", call. = FALSE) } data <- data.frame() for (i in 1:groups) { dat <- simulate_correlation(n = n, r = r) dat$V1 <- dat$V1 + difference * i # (i * -sign(r)) dat$V2 <- dat$V2 + difference * (i * -sign(r)) dat$Group <- sprintf(paste0(group_prefix, "%0", nchar(trunc(abs(groups))), "d"), i) data <- rbind(data, dat) } data } bayestestR/R/plot.R0000644000176200001440000000460214276606712013716 0ustar liggesusers#' @export plot.equivalence_test <- function(x, ...) { insight::check_if_installed("see", "to plot results from equivalence-test") NextMethod() } #' @export plot.p_direction <- function(x, ...) { insight::check_if_installed("see", "to plot results from p_direction()") NextMethod() } #' @export plot.point_estimate <- function(x, ...) { insight::check_if_installed("see", "to plot point-estimates") NextMethod() } #' @export plot.map_estimate <- function(x, ...) { insight::check_if_installed("see", "to plot point-estimates") NextMethod() } #' @export plot.rope <- function(x, ...) { insight::check_if_installed("see", "to plot ROPE") NextMethod() } #' @export plot.bayestestR_hdi <- function(x, ...) { insight::check_if_installed("see", "to plot HDI") NextMethod() } #' @export plot.bayestestR_eti <- function(x, ...) { insight::check_if_installed("see", "to plot credible intervals") NextMethod() } #' @export plot.bayestestR_si <- function(x, ...) { insight::check_if_installed("see", "to plot support intervals") NextMethod() } #' @export plot.bayesfactor_parameters <- function(x, ...) { insight::check_if_installed("see", "to plot Savage-Dickey Bayes factor") NextMethod() } #' @export plot.bayesfactor_models <- function(x, ...) { insight::check_if_installed("see", "to plot models' Bayes factors") NextMethod() } #' @export plot.estimate_density <- function(x, ...) { insight::check_if_installed("see", "to plot densities") NextMethod() } #' @export plot.estimate_density_df <- function(x, ...) { insight::check_if_installed("see", "to plot models' densities") NextMethod() } #' @export plot.p_significance <- function(x, ...) { insight::check_if_installed("see", "to plot practical significance") NextMethod() } #' @export plot.describe_posterior <- function(x, stack = FALSE, ...) { insight::check_if_installed("see", "to plot posterior samples") insight::check_if_installed("ggplot2", "to plot posterior samples") model <- .retrieve_model(x) if (!is.null(model)) { graphics::plot(estimate_density(model), stack = stack, ...) + ggplot2::labs(title = "Posterior Samples", x = NULL, y = NULL) } else { warning(insight::format_message("Could not find model-object. Try ' plot(estimate_density(model))' instead."), call. = FALSE) } } bayestestR/R/bayestestR-package.R0000644000176200001440000000166214357655465016472 0ustar liggesusers#' \code{bayestestR} #' #' @title bayestestR: Describing Effects and their Uncertainty, Existence and #' Significance within the Bayesian Framework #' #' @description #' #' Existing R packages allow users to easily fit a large variety of models #' and extract and visualize the posterior draws. However, most of these #' packages only return a limited set of indices (e.g., point-estimates and #' CIs). **bayestestR** provides a comprehensive and consistent set of #' functions to analyze and describe posterior distributions generated by a #' variety of models objects, including popular modeling packages such as #' **rstanarm**, **brms** or **BayesFactor**. #' #' References: #' #' - Makowski et al. (2019) \doi{10.21105/joss.01541} #' - Makowski et al. (2019) \doi{10.3389/fpsyg.2019.02767} #' #' @docType package #' @aliases bayestestR bayestestR-package #' @name bayestestR-package #' @keywords internal "_PACKAGE" bayestestR/R/utils_print_data_frame.R0000644000176200001440000000556514407021360017452 0ustar liggesusers.print_data_frame <- function(x, digits) { out <- list(x) names(out) <- "fixed" if (all(c("Effects", "Component") %in% colnames(x))) { x$split <- sprintf("%s_%s", x$Effects, x$Component) } else if ("Effects" %in% colnames(x)) { colnames(x)[which(colnames(x) == "Effects")] <- "split" } else if ("Component" %in% colnames(x)) { colnames(x)[which(colnames(x) == "Component")] <- "split" } if ("split" %in% colnames(x)) { if (anyNA(x$split)) { x$split[is.na(x$split)] <- "{other}" } out <- lapply( split(x, f = x$split), datawizard::data_remove, select = c("split", "Component", "Effects"), verbose = FALSE ) } for (i in names(out)) { header <- switch(i, "conditional" = , "fixed_conditional" = , "fixed" = "# Fixed Effects (Conditional Model)", "fixed_sigma" = "# Sigma (fixed effects)", "sigma" = "# Sigma (fixed effects)", "zi" = , "zero_inflated" = , "fixed_zero_inflated" = , "fixed_zi" = "# Fixed Effects (Zero-Inflated Model)", "random" = , "random_conditional" = "# Random Effects (Conditional Model)", "random_zero_inflated" = , "random_zi" = "# Random Effects (Zero-Inflated Model)", "smooth_sd" = , "fixed_smooth_sd" = "# Smooth Terms", # blavaan "latent" = "# Latent Loading", "residual" = "# Residual Variance", "intercept" = "# Intercept", "regression" = "# Regression", # Default paste0("# ", i) ) if ("Parameter" %in% colnames(out[[i]])) { # clean parameters names out[[i]]$Parameter <- gsub("(b_|bs_|bsp_|bcs_)(?!zi_)(.*)", "\\2", out[[i]]$Parameter, perl = TRUE) out[[i]]$Parameter <- gsub("(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)(.*)", "\\2", out[[i]]$Parameter, perl = TRUE) # clean random effect parameters names out[[i]]$Parameter <- gsub("r_(.*)\\.(.*)\\.", "\\1", out[[i]]$Parameter) out[[i]]$Parameter <- gsub("b\\[\\(Intercept\\) (.*)\\]", "\\1", out[[i]]$Parameter) out[[i]]$Parameter <- gsub("b\\[(.*) (.*)\\]", "\\2", out[[i]]$Parameter) # clean smooth terms out[[i]]$Parameter <- gsub("^smooth_sd\\[(.*)\\]", "\\1", out[[i]]$Parameter) out[[i]]$Parameter <- gsub("^sds_", "\\1", out[[i]]$Parameter) # SD out[[i]]$Parameter <- gsub("(.*)(__Intercept|__zi_Intercept)(.*)", "\\1 (Intercept)\\3", gsub("^sd_(.*)", "SD \\1", out[[i]]$Parameter)) # remove ".1" etc. suffix out[[i]]$Parameter <- gsub("(.*)(\\.)(\\d)$", "\\1 \\3", out[[i]]$Parameter) # remove "__zi" out[[i]]$Parameter <- gsub("__zi", "", out[[i]]$Parameter, fixed = TRUE) } if (length(out) > 1) { insight::print_color(header, "blue") cat("\n\n") } cat(insight::export_table(out[[i]], digits = digits)) cat("\n") } } bayestestR/R/rope_range.R0000644000176200001440000001363414407021360015050 0ustar liggesusers#' @title Find Default Equivalence (ROPE) Region Bounds #' #' @description This function attempts at automatically finding suitable "default" #' values for the Region Of Practical Equivalence (ROPE). #' #' @details \cite{Kruschke (2018)} suggests that the region of practical #' equivalence could be set, by default, to a range from `-0.1` to #' `0.1` of a standardized parameter (negligible effect size #' according to Cohen, 1988). #' #' \itemize{ #' \item For **linear models (lm)**, this can be generalised to #' \ifelse{html}{\out{-0.1 * SDy, 0.1 * #' SDy}}{\eqn{[-0.1*SD_{y}, 0.1*SD_{y}]}}. #' #' \item For **logistic models**, the parameters expressed in log odds #' ratio can be converted to standardized difference through the formula #' \ifelse{html}{\out{π/√(3)}}{\eqn{\pi/\sqrt{3}}}, resulting in a #' range of `-0.18` to `0.18`. #' #' \item For other models with **binary outcome**, it is strongly #' recommended to manually specify the rope argument. Currently, the same #' default is applied that for logistic models. #' #' \item For models from **count data**, the residual variance is used. #' This is a rather experimental threshold and is probably often similar to #' `-0.1, 0.1`, but should be used with care! #' #' \item For **t-tests**, the standard deviation of the response is #' used, similarly to linear models (see above). #' #' \item For **correlations**, `-0.05, 0.05` is used, i.e., half #' the value of a negligible correlation as suggested by Cohen's (1988) #' rules of thumb. #' #' \item For all other models, `-0.1, 0.1` is used to determine the #' ROPE limits, but it is strongly advised to specify it manually. #' } #' #' @param x A `stanreg`, `brmsfit` or `BFBayesFactor` object. #' @param verbose Toggle warnings. #' @inheritParams rope #' #' @examples #' \dontrun{ #' if (require("rstanarm")) { #' model <- stan_glm( #' mpg ~ wt + gear, #' data = mtcars, #' chains = 2, #' iter = 200, #' refresh = 0 #' ) #' rope_range(model) #' #' model <- stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0) #' rope_range(model) #' } #' #' if (require("brms")) { #' model <- brm(mpg ~ wt + cyl, data = mtcars) #' rope_range(model) #' } #' #' if (require("BayesFactor")) { #' model <- ttestBF(mtcars[mtcars$vs == 1, "mpg"], mtcars[mtcars$vs == 0, "mpg"]) #' rope_range(model) #' #' model <- lmBF(mpg ~ vs, data = mtcars) #' rope_range(model) #' } #' } #' #' @references Kruschke, J. K. (2018). Rejecting or accepting parameter values #' in Bayesian estimation. Advances in Methods and Practices in Psychological #' Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. #' #' @export rope_range <- function(x, ...) { UseMethod("rope_range") } #' @rdname rope_range #' @export rope_range.default <- function(x, verbose = TRUE, ...) { response <- insight::get_response(x, source = "mf") response_transform <- insight::find_transformation(x) information <- insight::model_info(x, verbose = FALSE) if (insight::is_multivariate(x)) { ret <- Map( function(i, j, ...) .rope_range(x, i, j), information, response, response_transform, verbose ) return(ret) } else { .rope_range(x, information, response, response_transform, verbose) } } #' @export rope_range.data.frame <- function(x, verbose = TRUE, ...) { # to avoid errors with "get_response()" in the default method c(-0.1, 0.1) } # Exceptions -------------------------------------------------------------- #' @export rope_range.mlm <- function(x, verbose = TRUE, ...) { response <- insight::get_response(x, source = "mf") information <- insight::model_info(x, verbose = FALSE) lapply(response, function(i) .rope_range(x, information, i, response_transform = NULL, verbose)) } # helper ------------------ .rope_range <- function(x, information = NULL, response = NULL, response_transform = NULL, verbose = TRUE) { negligible_value <- tryCatch( { if (!is.null(response_transform) && grepl("log", response_transform, fixed = TRUE)) { # for log-transform, we assume that a 1% change represents the ROPE adequately # see https://github.com/easystats/bayestestR/issues/487 0.01 } else if (information$is_linear && information$link_function == "log") { # for log-transform, we assume that a 1% change represents the ROPE adequately # see https://github.com/easystats/bayestestR/issues/487 0.01 } else if (information$family == "lognormal") { # for log-transform, we assume that a 1% change represents the ROPE adequately # see https://github.com/easystats/bayestestR/issues/487 0.01 } else if (!is.null(response) && information$link_function == "identity") { # Linear Models 0.1 * stats::sd(response, na.rm = TRUE) # 0.1 * stats::sigma(x) # https://github.com/easystats/bayestestR/issues/364 } else if (information$is_logit) { # Logistic Models (any) # Sigma==pi / sqrt(3) 0.1 * pi / sqrt(3) } else if (information$is_probit) { # Probit models # Sigma==1 0.1 * 1 } else if (information$is_correlation) { # Correlations # https://github.com/easystats/bayestestR/issues/121 0.05 } else if (information$is_count) { # Not sure about this sig <- stats::sigma(x) if (is.null(sig) || length(sig) == 0 || is.na(sig)) stop() 0.1 * sig } else { # Default stop() } }, error = function(e) { if (isTRUE(verbose)) { insight::format_warning("Could not estimate a good default ROPE range. Using 'c(-0.1, 0.1)'.") } 0.1 } ) c(-1, 1) * negligible_value } bayestestR/R/utils_posterior.R0000644000176200001440000000160414407021360016167 0ustar liggesusers# helper ------------------------------ .posterior_draws_to_df <- function(x) { UseMethod(".posterior_draws_to_df") } .posterior_draws_to_df.default <- function(x) { insight::format_error(paste0("Objects of class `%s` are not yet supported.", class(x)[1])) } .posterior_draws_to_df.data.frame <- function(x) { x } .posterior_draws_to_df.draws_df <- function(x) { insight::check_if_installed("posterior") datawizard::data_remove(as.data.frame(posterior::as_draws_df(x)), c(".chain", ".iteration", ".draw")) } .posterior_draws_to_df.draws_matrix <- .posterior_draws_to_df.draws_df .posterior_draws_to_df.draws_array <- .posterior_draws_to_df.draws_df .posterior_draws_to_df.draws_list <- .posterior_draws_to_df.draws_df .posterior_draws_to_df.draws_rvars <- .posterior_draws_to_df.draws_df .posterior_draws_to_df.rvar <- .posterior_draws_to_df.draws_df bayestestR/R/bayesfactor.R0000644000176200001440000000656114407021360015232 0ustar liggesusers#' Bayes Factors (BF) #' #' This function compte the Bayes factors (BFs) that are appropriate to the #' input. For vectors or single models, it will compute [`BFs for single #' parameters()`][bayesfactor_parameters], or is `hypothesis` is specified, #' [`BFs for restricted models()`][bayesfactor_restricted]. For multiple models, #' it will return the BF corresponding to [`comparison between #' models()`][bayesfactor_models] and if a model comparison is passed, it will #' compute the [`inclusion BF()`][bayesfactor_inclusion]. #' \cr\cr #' For a complete overview of these functions, read the [Bayes factor vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html). #' #' @param ... A numeric vector, model object(s), or the output from #' `bayesfactor_models`. #' @inheritParams bayesfactor_parameters #' @inheritParams bayesfactor_restricted #' @inheritParams bayesfactor_models #' @inheritParams bayesfactor_inclusion #' #' @return Some type of Bayes factor, depending on the input. See [bayesfactor_parameters()], [bayesfactor_models()] or [bayesfactor_inclusion()] #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @examples #' library(bayestestR) #' #' if (require("logspline")) { #' prior <- distribution_normal(1000, mean = 0, sd = 1) #' posterior <- distribution_normal(1000, mean = .5, sd = .3) #' #' bayesfactor(posterior, prior = prior, verbose = FALSE) #' } #' \dontrun{ #' # rstanarm models #' # --------------- #' if (require("rstanarm")) { #' model <- stan_lmer(extra ~ group + (1 | ID), data = sleep) #' bayesfactor(model, verbose = FALSE) #' } #' } #' #' if (require("logspline")) { #' # Frequentist models #' # --------------- #' m0 <- lm(extra ~ 1, data = sleep) #' m1 <- lm(extra ~ group, data = sleep) #' m2 <- lm(extra ~ group + ID, data = sleep) #' #' comparison <- bayesfactor(m0, m1, m2) #' comparison #' #' bayesfactor(comparison) #' } #' @export bayesfactor <- function(..., prior = NULL, direction = "two-sided", null = 0, hypothesis = NULL, effects = c("fixed", "random", "all"), verbose = TRUE, denominator = 1, match_models = FALSE, prior_odds = NULL) { mods <- list(...) effects <- match.arg(effects) if (length(mods) > 1) { bayesfactor_models(..., denominator = denominator) } else if (inherits(mods[[1]], "bayesfactor_models")) { bayesfactor_inclusion(..., match_models = match_models, prior_odds = prior_odds) } else if (inherits(mods[[1]], "BFBayesFactor")) { if (inherits(mods[[1]]@numerator[[1]], "BFlinearModel")) { bayesfactor_inclusion(..., match_models = match_models, prior_odds = prior_odds) } else { bayesfactor_models(...) } } else if (!is.null(hypothesis)) { bayesfactor_restricted(..., prior = prior, verbose = verbose, effects = effects ) } else { bayesfactor_parameters( ..., prior = prior, direction = direction, null = null, effects = effects, verbose = verbose ) } } bayestestR/R/mediation.R0000644000176200001440000003254114407027127014705 0ustar liggesusers#' @title Summary of Bayesian multivariate-response mediation-models #' @name mediation #' #' @description `mediation()` is a short summary for multivariate-response #' mediation-models, i.e. this function computes average direct and average #' causal mediation effects of multivariate response models. #' #' @param model A `brmsfit` or `stanmvreg` object. #' @param treatment Character, name of the treatment variable (or direct effect) #' in a (multivariate response) mediator-model. If missing, `mediation()` #' tries to find the treatment variable automatically, however, this may fail. #' @param mediator Character, name of the mediator variable in a (multivariate #' response) mediator-model. If missing, `mediation()` tries to find the #' treatment variable automatically, however, this may fail. #' @param response A named character vector, indicating the names of the response #' variables to be used for the mediation analysis. Usually can be `NULL`, #' in which case these variables are retrieved automatically. If not `NULL`, #' names should match the names of the model formulas, #' `names(insight::find_response(model, combine = TRUE))`. This can be #' useful if, for instance, the mediator variable used as predictor has a different #' name from the mediator variable used as response. This might occur when the #' mediator is transformed in one model, but used "as is" as response variable #' in the other model. Example: The mediator `m` is used as response variable, #' but the centered version `m_center` is used as mediator variable. The #' second response variable (for the treatment model, with the mediator as #' additional predictor), `y`, is not transformed. Then we could use #' `response` like this: `mediation(model, response = c(m = "m_center", y = "y"))`. #' @param ... Not used. #' @inheritParams ci #' @inheritParams describe_posterior #' #' @return A data frame with direct, indirect, mediator and #' total effect of a multivariate-response mediation-model, as well as the #' proportion mediated. The effect sizes are median values of the posterior #' samples (use `centrality` for other centrality indices). #' #' @details `mediation()` returns a data frame with information on the #' *direct effect* (mean value of posterior samples from `treatment` #' of the outcome model), *mediator effect* (mean value of posterior #' samples from `mediator` of the outcome model), *indirect effect* #' (mean value of the multiplication of the posterior samples from #' `mediator` of the outcome model and the posterior samples from #' `treatment` of the mediation model) and the total effect (mean #' value of sums of posterior samples used for the direct and indirect #' effect). The *proportion mediated* is the indirect effect divided #' by the total effect. #' \cr \cr #' For all values, the `89%` credible intervals are calculated by default. #' Use `ci` to calculate a different interval. #' \cr \cr #' The arguments `treatment` and `mediator` do not necessarily #' need to be specified. If missing, `mediation()` tries to find the #' treatment and mediator variable automatically. If this does not work, #' specify these variables. #' \cr \cr #' The direct effect is also called *average direct effect* (ADE), #' the indirect effect is also called *average causal mediation effects* #' (ACME). See also \cite{Tingley et al. 2014} and \cite{Imai et al. 2010}. #' #' @note There is an `as.data.frame()` method that returns the posterior #' samples of the effects, which can be used for further processing in the #' different \pkg{bayestestR} package. #' #' @references #' \itemize{ #' \item Imai, K., Keele, L. and Tingley, D. (2010) A General Approach to Causal #' Mediation Analysis, Psychological Methods, Vol. 15, No. 4 (December), pp. #' 309-334. #' #' \item Tingley, D., Yamamoto, T., Hirose, K., Imai, K. and Keele, L. (2014). #' mediation: R package for Causal Mediation Analysis, Journal of Statistical #' Software, Vol. 59, No. 5, pp. 1-38. #' } #' #' @seealso The \pkg{mediation} package for a causal mediation analysis in #' the frequentist framework. #' #' @examples #' \dontrun{ #' library(mediation) #' library(brms) #' library(rstanarm) #' #' # load sample data #' data(jobs) #' set.seed(123) #' #' # linear models, for mediation analysis #' b1 <- lm(job_seek ~ treat + econ_hard + sex + age, data = jobs) #' b2 <- lm(depress2 ~ treat + job_seek + econ_hard + sex + age, data = jobs) #' # mediation analysis, for comparison with Stan models #' m1 <- mediate(b1, b2, sims = 1000, treat = "treat", mediator = "job_seek") #' #' # Fit Bayesian mediation model in brms #' f1 <- bf(job_seek ~ treat + econ_hard + sex + age) #' f2 <- bf(depress2 ~ treat + job_seek + econ_hard + sex + age) #' m2 <- brm(f1 + f2 + set_rescor(FALSE), data = jobs, cores = 4, refresh = 0) #' #' # Fit Bayesian mediation model in rstanarm #' m3 <- stan_mvmer( #' list( #' job_seek ~ treat + econ_hard + sex + age + (1 | occp), #' depress2 ~ treat + job_seek + econ_hard + sex + age + (1 | occp) #' ), #' data = jobs, #' cores = 4, #' refresh = 0 #' ) #' #' summary(m1) #' mediation(m2, centrality = "mean", ci = 0.95) #' mediation(m3, centrality = "mean", ci = 0.95) #' } #' @export mediation <- function(model, ...) { UseMethod("mediation") } #' @rdname mediation #' @export mediation.brmsfit <- function(model, treatment, mediator, response = NULL, centrality = "median", ci = 0.95, method = "ETI", ...) { .mediation( model = model, treatment = treatment, mediator = mediator, response = response, centrality = centrality, ci = ci, method = method, pattern = "b_%s_%s", ... ) } #' @rdname mediation #' @export mediation.stanmvreg <- function(model, treatment, mediator, response = NULL, centrality = "median", ci = 0.95, method = "ETI", ...) { .mediation( model = model, treatment = treatment, mediator = mediator, response = response, centrality = centrality, ci = ci, method = method, pattern = "%s|%s", ... ) } # workhorse --------------------------------- .mediation <- function(model, treatment, mediator, response = NULL, centrality = "median", ci = 0.95, method = "ETI", pattern = "b_%s_%s", ...) { # only one HDI interval if (length(ci) > 1) ci <- ci[1] # check for binary response. In this case, user should rescale variables modelinfo <- insight::model_info(model) if (any(sapply(modelinfo, function(i) i$is_binomial, simplify = TRUE))) { message("One of moderator or outcome is binary, so direct and indirect effects may be on different scales. Consider rescaling model predictors, e.g. with `effectsize::standardize()`.") } # model responses if (is.null(response)) { response <- insight::find_response(model, combine = TRUE) } fix_mediator <- FALSE # find mediator, if not specified if (missing(mediator)) { predictors <- insight::find_predictors(model, flatten = TRUE) mediator <- predictors[predictors %in% response] fix_mediator <- TRUE } # find treatment, if not specified if (missing(treatment)) { predictors <- lapply( insight::find_predictors(model), function(.f) .f$conditional ) treatment <- predictors[[1]][predictors[[1]] %in% predictors[[2]]][1] treatment <- .fix_factor_name(model, treatment) } mediator.model <- which(response == mediator) treatment.model <- which(response != mediator) if (fix_mediator) mediator <- .fix_factor_name(model, mediator) if (inherits(model, "brmsfit")) { response_name <- names(response) } else { response_name <- unname(response) } # brms removes underscores from variable names when naming estimates # so we need to fix variable names here response <- names(response) # Direct effect: coef(treatment) from model_y_treatment coef_treatment <- sprintf(pattern, response[treatment.model], treatment) effect_direct <- insight::get_parameters(model)[[coef_treatment]] # Mediator effect: coef(mediator) from model_y_treatment coef_mediator <- sprintf(pattern, response[treatment.model], mediator) effect_mediator <- insight::get_parameters(model)[[coef_mediator]] # Indirect effect: coef(treament) from model_m_mediator * coef(mediator) from model_y_treatment coef_indirect <- sprintf(pattern, response[mediator.model], treatment) tmp.indirect <- insight::get_parameters(model)[c(coef_indirect, coef_mediator)] effect_indirect <- tmp.indirect[[coef_indirect]] * tmp.indirect[[coef_mediator]] # Total effect effect_total <- effect_indirect + effect_direct # proportion mediated: indirect effect / total effect proportion_mediated <- as.numeric(point_estimate(effect_indirect, centrality = centrality)) / as.numeric(point_estimate(effect_total, centrality = centrality)) hdi_eff <- ci(effect_indirect / effect_total, ci = ci, method = method) prop_mediated_se <- (hdi_eff$CI_high - hdi_eff$CI_low) / 2 prop_mediated_ci <- proportion_mediated + c(-1, 1) * prop_mediated_se res <- cbind( data.frame( Effect = c("Direct Effect (ADE)", "Indirect Effect (ACME)", "Mediator Effect", "Total Effect", "Proportion Mediated"), Estimate = c( as.numeric(point_estimate(effect_direct, centrality = centrality)), as.numeric(point_estimate(effect_indirect, centrality = centrality)), as.numeric(point_estimate(effect_mediator, centrality = centrality)), as.numeric(point_estimate(effect_total, centrality = centrality)), proportion_mediated ), stringsAsFactors = FALSE ), as.data.frame(rbind( ci(effect_direct, ci = ci, method = method)[, -1], ci(effect_indirect, ci = ci, method = method)[, -1], ci(effect_mediator, ci = ci, method = method)[, -1], ci(effect_total, ci = ci, method = method)[, -1], prop_mediated_ci )) ) colnames(res) <- c("Effect", "Estimate", "CI_low", "CI_high") samples <- data.frame( effect_direct, effect_indirect, effect_mediator, effect_total, proportion_mediated = effect_indirect / effect_total ) attr(res, "ci") <- ci attr(res, "ci_method") <- method attr(res, "treatment") <- treatment attr(res, "mediator") <- mediator attr(res, "response") <- response_name[treatment.model] attr(res, "data") <- samples class(res) <- c("bayestestR_mediation", "see_bayestestR_mediation", class(res)) res } # methods --------------------- #' @export as.data.frame.bayestestR_mediation <- function(x, ...) { attributes(x)$data } # helper --------------------------------- .fix_factor_name <- function(model, variable) { # check for categorical. if user has not specified a treatment variable # and this variable is categorical, the posterior samples contain the # samples from each category of the treatment variable - so we need to # fix the variable name mf <- insight::get_data(model) if (variable %in% colnames(mf)) { check_fac <- mf[[variable]] if (is.factor(check_fac)) { variable <- sprintf("%s%s", variable, levels(check_fac)[nlevels(check_fac)]) } else if (is.logical(check_fac)) { variable <- sprintf("%sTRUE", variable) } } variable } # S3 --------------------------------- #' @export print.bayestestR_mediation <- function(x, digits = 3, ...) { attr(x, "data") <- NULL insight::print_color("# Causal Mediation Analysis for Stan Model\n\n", "blue") cat(sprintf( " Treatment: %s\n Mediator : %s\n Response : %s\n\n", attr(x, "treatment", exact = TRUE), attr(x, "mediator", exact = TRUE), attr(x, "response", exact = TRUE) )) prop_mediated <- prop_mediated_ori <- x[nrow(x), ] x <- x[-nrow(x), ] x$CI <- insight::format_ci(x$CI_low, x$CI_high, ci = NULL, digits = digits, width = "auto", missing = "NA") x <- datawizard::data_remove(x, c("CI_low", "CI_high"), verbose = FALSE) colnames(x)[ncol(x)] <- sprintf("%.5g%% %s", 100 * attributes(x)$ci, attributes(x)$ci_method) # remove class, to avoid conflicts with "as.data.frame.bayestestR_mediation()" class(x) <- "data.frame" cat(insight::export_table(x, digits = digits)) cat("\n") prop_mediated[] <- lapply(prop_mediated, insight::format_value, as_percent = TRUE) insight::print_color( sprintf( "Proportion mediated: %s [%s, %s]\n", prop_mediated$Estimate, prop_mediated$CI_low, prop_mediated$CI_high ), "red" ) if (any(prop_mediated_ori$Estimate < 0)) { message("\nDirect and indirect effects have opposite directions. The proportion mediated is not meaningful.") } } #' @export plot.bayestestR_mediation <- function(x, ...) { insight::check_if_installed("see", "to plot results from mediation analysis") NextMethod() } bayestestR/R/contr.equalprior.R0000644000176200001440000001620714311464510016237 0ustar liggesusers#' Contrast Matrices for Equal Marginal Priors in Bayesian Estimation #' #' Build contrasts for factors with equal marginal priors on all levels. The 3 #' functions give the same orthogonal contrasts, but are scaled differently to #' allow different prior specifications (see 'Details'). Implementation from #' Singmann & Gronau's [`bfrms`](https://github.com/bayesstuff/bfrms/), #' following the description in Rouder, Morey, Speckman, & Province (2012, p. #' 363). #' #' @inheritParams stats::contr.treatment #' #' @details #' When using [`stats::contr.treatment`], each dummy variable is the difference #' between each level and the reference level. While this is useful if setting #' different priors for each coefficient, it should not be used if one is trying #' to set a general prior for differences between means, as it (as well as #' [`stats::contr.sum`] and others) results in unequal marginal priors on the #' means the the difference between them. #' #' ``` #' library(brms) #' #' data <- data.frame( #' group = factor(rep(LETTERS[1:4], each = 3)), #' y = rnorm(12) #' ) #' #' contrasts(data$group) # R's default contr.treatment #' #> B C D #' #> A 0 0 0 #' #> B 1 0 0 #' #> C 0 1 0 #' #> D 0 0 1 #' #' model_prior <- brm( #' y ~ group, data = data, #' sample_prior = "only", #' # Set the same priors on the 3 dummy variable #' # (Using an arbitrary scale) #' prior = set_prior("normal(0, 10)", coef = c("groupB", "groupC", "groupD")) #' ) #' #' est <- emmeans::emmeans(model_prior, pairwise ~ group) #' #' point_estimate(est, centr = "mean", disp = TRUE) #' #> Point Estimate #' #> #' #> Parameter | Mean | SD #' #> ------------------------- #' #> A | -0.01 | 6.35 #' #> B | -0.10 | 9.59 #' #> C | 0.11 | 9.55 #' #> D | -0.16 | 9.52 #' #> A - B | 0.10 | 9.94 #' #> A - C | -0.12 | 9.96 #' #> A - D | 0.15 | 9.87 #' #> B - C | -0.22 | 14.38 #' #> B - D | 0.05 | 14.14 #' #> C - D | 0.27 | 14.00 #' ``` #' #' We can see that the priors for means aren't all the same (`A` having a more #' narrow prior), and likewise for the pairwise differences (priors for #' differences from `A` are more narrow). #' #' The solution is to use one of the methods provided here, which *do* result in #' marginally equal priors on means differences between them. Though this will #' obscure the interpretation of parameters, setting equal priors on means and #' differences is important for they are useful for specifying equal priors on #' all means in a factor and their differences correct estimation of Bayes #' factors for contrasts and order restrictions of multi-level factors (where #' `k>2`). See info on specifying correct priors for factors with more than 2 #' levels in [the Bayes factors vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html). #' #' ***NOTE:*** When setting priors on these dummy variables, always: #' 1. Use priors that are **centered on 0**! Other location/centered priors are meaningless! #' 2. Use **identically-scaled priors** on all the dummy variables of a single factor! #' #' `contr.equalprior` returns the original orthogonal-normal contrasts as #' described in Rouder, Morey, Speckman, & Province (2012, p. 363). Setting #' `contrasts = FALSE` returns the \eqn{I_{n} - \frac{1}{n}} matrix. #' #' ## `contr.equalprior_pairs` #' #' Useful for setting priors in terms of pairwise differences between means - #' the scales of the priors defines the prior distribution of the pair-wise #' differences between all pairwise differences (e.g., `A - B`, `B - C`, etc.). #' #' ``` #' contrasts(data$group) <- contr.equalprior_pairs #' contrasts(data$group) #' #> [,1] [,2] [,3] #' #> A 0.0000000 0.6123724 0.0000000 #' #> B -0.1893048 -0.2041241 0.5454329 #' #> C -0.3777063 -0.2041241 -0.4366592 #' #> D 0.5670111 -0.2041241 -0.1087736 #' #' model_prior <- brm( #' y ~ group, data = data, #' sample_prior = "only", #' # Set the same priors on the 3 dummy variable #' # (Using an arbitrary scale) #' prior = set_prior("normal(0, 10)", coef = c("group1", "group2", "group3")) #' ) #' #' est <- emmeans(model_prior, pairwise ~ group) #' #' point_estimate(est, centr = "mean", disp = TRUE) #' #> Point Estimate #' #> #' #> Parameter | Mean | SD #' #> ------------------------- #' #> A | -0.31 | 7.46 #' #> B | -0.24 | 7.47 #' #> C | -0.34 | 7.50 #' #> D | -0.30 | 7.25 #' #> A - B | -0.08 | 10.00 #' #> A - C | 0.03 | 10.03 #' #> A - D | -0.01 | 9.85 #' #> B - C | 0.10 | 10.28 #' #> B - D | 0.06 | 9.94 #' #> C - D | -0.04 | 10.18 #' ``` #' #' All means have the same prior distribution, and the distribution of the #' differences matches the prior we set of `"normal(0, 10)"`. Success! #' #' ## `contr.equalprior_deviations` #' #' Useful for setting priors in terms of the deviations of each mean from the #' grand mean - the scales of the priors defines the prior distribution of the #' distance (above, below) the mean of one of the levels might have from the #' overall mean. (See examples.) #' #' #' @references #' Rouder, J. N., Morey, R. D., Speckman, P. L., & Province, J. M. (2012). #' Default Bayes factors for ANOVA designs. *Journal of Mathematical #' Psychology*, 56(5), 356-374. https://doi.org/10.1016/j.jmp.2012.08.001 #' #' @return A `matrix` with n rows and k columns, with k=n-1 if contrasts is #' `TRUE` and k=n if contrasts is `FALSE`. #' #' @aliases contr.bayes contr.orthonorm #' #' @examples #' contr.equalprior(2) # Q_2 in Rouder et al. (2012, p. 363) #' #' contr.equalprior(5) # equivalent to Q_5 in Rouder et al. (2012, p. 363) #' #' ## check decomposition #' Q3 <- contr.equalprior(3) #' Q3 %*% t(Q3) ## 2/3 on diagonal and -1/3 on off-diagonal elements #' @export contr.equalprior <- function(n, contrasts = TRUE, sparse = FALSE) { contr <- stats::contr.treatment(n, contrasts = FALSE, base = 1, sparse = sparse & !contrasts ) k <- nrow(contr) contr <- contr - 1 / k if (contrasts) { contr <- eigen(contr)$vectors[, seq_len(k - 1), drop = FALSE] } contr } #' @export #' @rdname contr.equalprior contr.equalprior_pairs <- function(n, contrasts = TRUE, sparse = FALSE) { contr <- contr.equalprior(n, contrasts, sparse) / sqrt(2) } #' @export #' @rdname contr.equalprior contr.equalprior_deviations <- function(n, contrasts = TRUE, sparse = FALSE) { contr <- contr.equalprior(n, contrasts, sparse) k <- nrow(contr) r <- -1 / (k - 1) V <- 1 - 1 / k VCOV <- matrix(r * V, k, k) diag(VCOV) <- V wts <- c(1 - 1 / k, rep(-1 / k, k - 1)) scale <- as.vector(sqrt(wts %*% VCOV %*% wts)) contr / scale } # OLD ------------------------------ #' @export contr.orthonorm <- function(n, contrasts = TRUE) { .Deprecated(new = "contr.equalprior", old = "contr.orthonorm") contr.equalprior(n, contrasts = contrasts) } #' @export contr.bayes <- function(n, contrasts = TRUE) { .Deprecated(new = "contr.equalprior", old = "contr.bayes") contr.equalprior(n, contrasts = contrasts) } bayestestR/R/rope.R0000644000176200001440000004632414407021360013676 0ustar liggesusers#' Region of Practical Equivalence (ROPE) #' #' Compute the proportion of the HDI (default to the `89%` HDI) of a posterior distribution that lies within a region of practical equivalence. #' #' @param x Vector representing a posterior distribution. Can also be a `stanreg` or `brmsfit` model. #' @param range ROPE's lower and higher bounds. Should be `"default"` or #' depending on the number of outcome variables a vector or a list. In models with one response, #' `range` should be a vector of length two (e.g., `c(-0.1, 0.1)`). In #' multivariate models, `range` should be a list with a numeric vectors for #' each response variable. Vector names should correspond to the name of the response #' variables. If `"default"` and input is a vector, the range is set to `c(-0.1, #' 0.1)`. If `"default"` and input is a Bayesian model, #' [`rope_range()`][rope_range] is used. #' @param ci The Credible Interval (CI) probability, corresponding to the #' proportion of HDI, to use for the percentage in ROPE. #' @param ci_method The type of interval to use to quantify the percentage in #' ROPE. Can be 'HDI' (default) or 'ETI'. See [ci()]. #' #' @inheritParams hdi #' #' @details #' \subsection{ROPE}{ #' Statistically, the probability of a posterior distribution of being #' different from 0 does not make much sense (the probability of a single value #' null hypothesis in a continuous distribution is 0). Therefore, the idea #' underlining ROPE is to let the user define an area around the null value #' enclosing values that are *equivalent to the null* value for practical #' purposes (\cite{Kruschke 2010, 2011, 2014}). #' \cr \cr #' Kruschke (2018) suggests that such null value could be set, by default, #' to the -0.1 to 0.1 range of a standardized parameter (negligible effect #' size according to Cohen, 1988). This could be generalized: For instance, #' for linear models, the ROPE could be set as `0 +/- .1 * sd(y)`. #' This ROPE range can be automatically computed for models using the #' [rope_range] function. #' \cr \cr #' Kruschke (2010, 2011, 2014) suggests using the proportion of the `95%` #' (or `89%`, considered more stable) [HDI][hdi] that falls within the #' ROPE as an index for "null-hypothesis" testing (as understood under the #' Bayesian framework, see [`equivalence_test()`][equivalence_test]). #' } #' \subsection{Sensitivity to parameter's scale}{ #' It is important to consider the unit (i.e., the scale) of the predictors #' when using an index based on the ROPE, as the correct interpretation of the #' ROPE as representing a region of practical equivalence to zero is dependent #' on the scale of the predictors. Indeed, the percentage in ROPE depend on #' the unit of its parameter. In other words, as the ROPE represents a fixed #' portion of the response's scale, its proximity with a coefficient depends #' on the scale of the coefficient itself. #' } #' \subsection{Multicollinearity: Non-independent covariates}{ #' When parameters show strong correlations, i.e. when covariates are not #' independent, the joint parameter distributions may shift towards or #' away from the ROPE. Collinearity invalidates ROPE and hypothesis #' testing based on univariate marginals, as the probabilities are conditional #' on independence. Most problematic are parameters that only have partial #' overlap with the ROPE region. In case of collinearity, the (joint) distributions #' of these parameters may either get an increased or decreased ROPE, which #' means that inferences based on `rope()` are inappropriate #' (\cite{Kruschke 2014, 340f}). #' \cr \cr #' `rope()` performs a simple check for pairwise correlations between #' parameters, but as there can be collinearity between more than two variables, #' a first step to check the assumptions of this hypothesis testing is to look #' at different pair plots. An even more sophisticated check is the projection #' predictive variable selection (\cite{Piironen and Vehtari 2017}). #' } #' \subsection{Strengths and Limitations}{ #' **Strengths:** Provides information related to the practical relevance of the effects. #' \cr \cr #' **Limitations:** A ROPE range needs to be arbitrarily defined. Sensitive to the scale (the unit) of the predictors. Not sensitive to highly significant effects. #' } #' #' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @references \itemize{ #' \item Cohen, J. (1988). Statistical power analysis for the behavioural sciences. #' \item Kruschke, J. K. (2010). What to believe: Bayesian methods for data analysis. Trends in cognitive sciences, 14(7), 293-300. \doi{10.1016/j.tics.2010.05.001}. #' \item Kruschke, J. K. (2011). Bayesian assessment of null values via parameter estimation and model comparison. Perspectives on Psychological Science, 6(3), 299-312. \doi{10.1177/1745691611406925}. #' \item Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. \doi{10.1177/2515245918771304}. #' \item Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. #' \item Makowski D, Ben-Shachar MS, Chen SHA, Lüdecke D (2019) Indices of Effect Existence and Significance in the Bayesian Framework. Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} #' \item Piironen, J., & Vehtari, A. (2017). Comparison of Bayesian predictive methods for model selection. Statistics and Computing, 27(3), 711–735. \doi{10.1007/s11222-016-9649-y} #' } #' #' @examples #' library(bayestestR) #' #' rope(x = rnorm(1000, 0, 0.01), range = c(-0.1, 0.1)) #' rope(x = rnorm(1000, 0, 1), range = c(-0.1, 0.1)) #' rope(x = rnorm(1000, 1, 0.01), range = c(-0.1, 0.1)) #' rope(x = rnorm(1000, 1, 1), ci = c(.90, .95)) #' \dontrun{ #' library(rstanarm) #' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0) #' rope(model) #' rope(model, ci = c(.90, .95)) #' #' library(emmeans) #' rope(emtrends(model, ~1, "wt"), ci = c(.90, .95)) #' #' library(brms) #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' rope(model) #' rope(model, ci = c(.90, .95)) #' #' library(brms) #' model <- brms::brm(brms::mvbind(mpg, disp) ~ wt + cyl, data = mtcars) #' rope(model) #' rope(model, ci = c(.90, .95)) #' #' library(BayesFactor) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' rope(bf) #' rope(bf, ci = c(.90, .95)) #' } #' @export rope <- function(x, ...) { UseMethod("rope") } #' @method as.double rope #' @export as.double.rope <- function(x, ...) { x$ROPE_Percentage } #' @export rope.default <- function(x, ...) { NULL } #' @rdname rope #' @export rope.numeric <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { if (all(range == "default")) { range <- c(-0.1, 0.1) } else if (!all(is.numeric(range)) || length(range) != 2) { stop("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).", call. = FALSE) } rope_values <- lapply(ci, function(i) { .rope(x, range = range, ci = i, ci_method = ci_method, verbose = verbose) }) # "do.call(rbind)" does not bind attribute values together # so we need to capture the information about HDI separately out <- do.call(rbind, rope_values) if (nrow(out) > 1) { out$ROPE_Percentage <- as.numeric(out$ROPE_Percentage) } # Attributes hdi_area <- cbind(CI = ci, data.frame(do.call(rbind, lapply(rope_values, attr, "HDI_area")))) names(hdi_area) <- c("CI", "CI_low", "CI_high") attr(out, "HDI_area") <- hdi_area attr(out, "data") <- x class(out) <- unique(c("rope", "see_rope", class(out))) out } #' @export rope.data.frame <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { out <- .prepare_rope_df(x, range, ci, ci_method, verbose) HDI_area_attributes <- insight::compact_list(out$HDI_area) dat <- data.frame( Parameter = rep(names(HDI_area_attributes), each = length(ci)), out$tmp, stringsAsFactors = FALSE ) row.names(dat) <- NULL attr(dat, "HDI_area") <- HDI_area_attributes attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(dat) <- c("rope", "see_rope", "data.frame") dat } #' @export rope.draws <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { rope(.posterior_draws_to_df(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) } #' @export rope.rvar <- rope.draws #' @export rope.emmGrid <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { xdf <- insight::get_parameters(x) dat <- rope(xdf, range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export rope.emm_list <- rope.emmGrid #' @export rope.BFBayesFactor <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { if (all(range == "default")) { range <- rope_range(x, verbose = verbose) } out <- rope(insight::get_parameters(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export rope.bamlss <- rope.BFBayesFactor #' @export rope.MCMCglmm <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { nF <- x$Fixed$nfl out <- rope(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export rope.mcmc <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { out <- rope(as.data.frame(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) attr(out, "object_name") <- NULL attr(out, "data") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export rope.bcplm <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) { out <- rope(insight::get_parameters(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...) attr(out, "object_name") <- NULL attr(out, "data") <- insight::safe_deparse_symbol(substitute(x)) out } #' @export rope.bayesQR <- rope.bcplm #' @export rope.blrm <- rope.bcplm #' @export rope.BGGM <- rope.bcplm #' @export rope.mcmc.list <- rope.bcplm #' @keywords internal .rope <- function(x, range = c(-0.1, 0.1), ci = 0.95, ci_method = "ETI", verbose = TRUE) { ci_bounds <- ci(x, ci = ci, method = ci_method, verbose = verbose) if (anyNA(ci_bounds)) { rope_percentage <- NA } else { HDI_area <- x[x >= ci_bounds$CI_low & x <= ci_bounds$CI_high] area_within <- HDI_area[HDI_area >= min(range) & HDI_area <= max(range)] rope_percentage <- length(area_within) / length(HDI_area) } rope <- data.frame( "CI" = ci, "ROPE_low" = range[1], "ROPE_high" = range[2], "ROPE_Percentage" = rope_percentage ) attr(rope, "HDI_area") <- c(ci_bounds$CI_low, ci_bounds$CI_high) attr(rope, "CI_bounds") <- c(ci_bounds$CI_low, ci_bounds$CI_high) class(rope) <- unique(c("rope", "see_rope", class(rope))) rope } #' @rdname rope #' @export rope.stanreg <- function(x, range = "default", ci = 0.95, ci_method = "ETI", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) if (all(range == "default")) { range <- rope_range(x, verbose = verbose) } else if (!all(is.numeric(range)) || length(range) != 2) { insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).") } # check for possible collinearity that might bias ROPE if (verbose && !inherits(x, "blavaan")) .check_multicollinearity(x, "rope") rope_data <- rope( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ... ) out <- .prepare_output(rope_data, insight::clean_parameters(x), inherits(x, "stanmvreg")) attr(out, "HDI_area") <- attr(rope_data, "HDI_area") attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- class(rope_data) out } #' @export rope.stanfit <- rope.stanreg #' @export rope.blavaan <- rope.stanreg #' @rdname rope #' @export rope.brmsfit <- function(x, range = "default", ci = 0.95, ci_method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) component <- match.arg(component) # check range argument if (all(range == "default")) { range <- rope_range(x, verbose = verbose) # we expect a list with named vectors (length two) in the multivariate case. # Names state the response variable. } else if (insight::is_multivariate(x)) { if ( !is.list(range) || length(range) < length(insight::find_response(x)) || !all(names(range) %in% insight::find_response(x)) ) { stop("With a multivariate model, `range` should be 'default' or a list of named numeric vectors with length 2.", call. = FALSE) } } else if (!all(is.numeric(range)) || length(range) != 2) { stop("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).", call. = FALSE) } # check for possible collinearity that might bias ROPE and print a warning if (verbose) .check_multicollinearity(x, "rope") # calc rope if (insight::is_multivariate(x)) { dv <- insight::find_response(x) # ROPE range / width differs between response varialbe. Thus ROPE is # calculated for every variable on its own. rope_data <- lapply( dv, function(dv_item) { ret <- rope( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), range = range[[dv_item]], ci = ci, ci_method = ci_method, verbose = verbose, ... ) # It's a waste of performance to calculate ROPE for all parameters # with the ROPE width of a specific response variable and to throw # away the unwanted results. However, performance impact should not be # too high and this way it is much easier to handle the `parameters` # argument. ret[grepl(paste0("(.*)", dv_item), ret$Parameter), ] } ) rope_data <- do.call(rbind, rope_data) out <- .prepare_output(rope_data, insight::clean_parameters(x), is_brms_mv = TRUE) } else { rope_data <- rope( insight::get_parameters(x, effects = effects, component = component, parameters = parameters), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ... ) out <- .prepare_output(rope_data, insight::clean_parameters(x)) } attr(out, "HDI_area") <- attr(rope_data, "HDI_area") attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x)) class(out) <- class(rope_data) out } #' @export rope.sim.merMod <- function(x, range = "default", ci = 0.95, ci_method = "ETI", effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) { effects <- match.arg(effects) if (all(range == "default")) { range <- rope_range(x, verbose = verbose) } else if (!all(is.numeric(range)) || length(range) != 2) { stop("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).", call. = FALSE) } list <- lapply(c("fixed", "random"), function(.x) { parms <- insight::get_parameters(x, effects = .x, parameters = parameters) getropedata <- .prepare_rope_df(parms, range, ci, ci_method, verbose) tmp <- getropedata$tmp HDI_area <- getropedata$HDI_area if (!insight::is_empty_object(tmp)) { tmp <- .clean_up_tmp_stanreg( tmp, group = .x, cols = c("CI", "ROPE_low", "ROPE_high", "ROPE_Percentage", "Group"), parms = names(parms) ) if (!insight::is_empty_object(HDI_area)) { attr(tmp, "HDI_area") <- HDI_area } } else { tmp <- NULL } tmp }) dat <- do.call(rbind, args = c(insight::compact_list(list), make.row.names = FALSE)) dat <- switch(effects, fixed = .select_rows(dat, "Group", "fixed"), random = .select_rows(dat, "Group", "random"), dat ) if (all(dat$Group == dat$Group[1])) { dat <- datawizard::data_remove(dat, "Group", verbose = FALSE) } HDI_area_attributes <- lapply(insight::compact_list(list), attr, "HDI_area") if (effects != "all") { HDI_area_attributes <- HDI_area_attributes[[1]] } else { names(HDI_area_attributes) <- c("fixed", "random") } attr(dat, "HDI_area") <- HDI_area_attributes attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @export rope.sim <- function(x, range = "default", ci = 0.95, ci_method = "ETI", parameters = NULL, verbose = TRUE, ...) { if (all(range == "default")) { range <- rope_range(x, verbose = verbose) } else if (!all(is.numeric(range)) || length(range) != 2) { stop("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).", call. = FALSE) } parms <- insight::get_parameters(x, parameters = parameters) getropedata <- .prepare_rope_df(parms, range, ci, ci_method, verbose) dat <- getropedata$tmp HDI_area <- getropedata$HDI_area if (!insight::is_empty_object(dat)) { dat <- .clean_up_tmp_stanreg( dat, group = "fixed", cols = c("CI", "ROPE_low", "ROPE_high", "ROPE_Percentage"), parms = names(parms) ) if (!insight::is_empty_object(HDI_area)) { attr(dat, "HDI_area") <- HDI_area } } else { dat <- NULL } attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x)) dat } #' @keywords internal .prepare_rope_df <- function(parms, range, ci, ci_method, verbose) { tmp <- sapply( parms, rope, range = range, ci = ci, ci_method = ci_method, verbose = verbose, simplify = FALSE ) HDI_area <- lapply(tmp, attr, which = "HDI_area") # HDI_area <- lapply(HDI_area, function(.x) { # dat <- cbind(CI = ci, data.frame(do.call(rbind, .x))) # colnames(dat) <- c("CI", "HDI_low", "HDI_high") # dat # }) list( tmp = do.call(rbind, tmp), HDI_area = HDI_area ) } bayestestR/R/ci.R0000644000176200001440000002213414407021360013315 0ustar liggesusers#' Confidence/Credible/Compatibility Interval (CI) #' #' Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals #' (SI) for Bayesian and frequentist models. The Documentation is accessible #' for: #' #' \itemize{ #' \item [Bayesian models](https://easystats.github.io/bayestestR/articles/credible_interval.html) #' \item [Frequentist models](https://easystats.github.io/parameters/reference/ci.default.html) #' } #' #' @param x A `stanreg` or `brmsfit` model, or a vector representing a posterior distribution. #' @param method Can be ['ETI'][eti] (default), ['HDI'][hdi], ['BCI'][bci], ['SPI'][spi] or ['SI'][si]. #' @param ci Value or vector of probability of the CI (between 0 and 1) #' to be estimated. Default to `.95` (`95%`). #' @inheritParams hdi #' @inheritParams si #' @inherit hdi seealso #' @family ci #' #' @return A data frame with following columns: #' \itemize{ #' \item `Parameter` The model parameter(s), if `x` is a model-object. If `x` is a vector, this column is missing. #' \item `CI` The probability of the credible interval. #' \item `CI_low`, `CI_high` The lower and upper credible interval limits for the parameters. #' } #' #' @note When it comes to interpretation, we recommend thinking of the CI in terms of #' an "uncertainty" or "compatibility" interval, the latter being defined as #' \dQuote{Given any value in the interval and the background assumptions, #' the data should not seem very surprising} (\cite{Gelman & Greenland 2019}). #' \cr \cr #' There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}. #' #' @references Gelman A, Greenland S. Are confidence intervals better termed "uncertainty intervals"? BMJ 2019;l5381. 10.1136/bmj.l5381 #' #' #' @examplesIf require("rstanarm", quietly = TRUE) #' library(bayestestR) #' #' posterior <- rnorm(1000) #' ci(posterior, method = "ETI") #' ci(posterior, method = "HDI") #' #' df <- data.frame(replicate(4, rnorm(100))) #' ci(df, method = "ETI", ci = c(0.80, 0.89, 0.95)) #' ci(df, method = "HDI", ci = c(0.80, 0.89, 0.95)) #' #' model <- suppressWarnings( #' stan_glm(mpg ~ wt, data = mtcars, chains = 2, iter = 200, refresh = 0) #' ) #' ci(model, method = "ETI", ci = c(0.80, 0.89)) #' ci(model, method = "HDI", ci = c(0.80, 0.89)) #' #' @examplesIf require("BayesFactor", quietly = TRUE) #' bf <- ttestBF(x = rnorm(100, 1, 1)) #' ci(bf, method = "ETI") #' ci(bf, method = "HDI") #' #' @examplesIf require("emmeans", quietly = TRUE) && require("rstanarm", quietly = TRUE) #' model <- emtrends(model, ~1, "wt") #' ci(model, method = "ETI") #' ci(model, method = "HDI") #' @export ci <- function(x, ...) { UseMethod("ci") } #' @keywords internal .ci_bayesian <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, BF = 1, ...) { if (tolower(method) %in% c("eti", "equal", "ci", "quantile")) { return( eti( x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ... ) ) } else if (tolower(method) %in% c("bci", "bca", "bcai")) { return( bci( x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ... ) ) } else if (tolower(method) == "hdi") { return( hdi( x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ... ) ) } else if (tolower(method) == "spi") { return( spi( x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ... ) ) } else if (tolower(method) == "si") { return( si( x, BF = BF, effects = effects, component = component, parameters = parameters, verbose = verbose, ... ) ) } else { insight::format_error( "`method` should be 'ETI' (for equal-tailed interval),'HDI' (for highest density interval), 'BCI' (for bias corrected and accelerated bootstrap intervals), 'SPI' (for shortest probability interval) or 'SI' (for support interval)." ) } } #' @rdname ci #' @export ci.numeric <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...) { .ci_bayesian(x, ci = ci, method = method, verbose = verbose, BF = BF, ...) } #' @rdname ci #' @export ci.data.frame <- ci.numeric #' @export ci.draws <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...) { .ci_bayesian(.posterior_draws_to_df(x), ci = ci, method = method, verbose = verbose, BF = BF, ...) } #' @export ci.rvar <- ci.draws #' @export ci.emmGrid <- function(x, ci = NULL, ...) { if (!.is_baysian_emmeans(x)) { insight::check_if_installed("parameters") if (is.null(ci)) ci <- 0.95 return(parameters::ci(model = x, ci = ci, ...)) } if (is.null(ci)) ci <- 0.95 x <- insight::get_parameters(x) ci(x, ci = ci, ...) } #' @export ci.emm_list <- ci.emmGrid #' @rdname ci #' @export ci.sim.merMod <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) { .ci_bayesian( x, ci = ci, method = method, effects = effects, parameters = parameters, verbose = verbose, ... ) } #' @rdname ci #' @export ci.sim <- function(x, ci = 0.95, method = "ETI", parameters = NULL, verbose = TRUE, ...) { .ci_bayesian( x, ci = ci, method = method, parameters = parameters, verbose = verbose, ... ) } #' @rdname ci #' @export ci.stanreg <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c( "location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary" ), parameters = NULL, verbose = TRUE, BF = 1, ...) { .ci_bayesian( x, ci = ci, method = method, effects = effects, component = component, parameters = parameters, verbose = verbose, BF = BF, ... ) } #' @rdname ci #' @export ci.brmsfit <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, BF = 1, ...) { .ci_bayesian( x, ci = ci, method = method, effects = effects, component = component, parameters = parameters, verbose = verbose, BF = BF, ... ) } #' @export ci.stanfit <- ci.stanreg #' @export ci.blavaan <- ci.stanreg #' @rdname ci #' @export ci.BFBayesFactor <- ci.numeric #' @rdname ci #' @export ci.MCMCglmm <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, ...) { nF <- x$Fixed$nfl ci( as.data.frame(x$Sol[, 1:nF, drop = FALSE]), ci = ci, method = method, verbose = verbose, ... ) } #' @export ci.bamlss <- function(x, ci = 0.95, method = "ETI", component = c("all", "conditional", "location"), verbose = TRUE, ...) { component <- match.arg(component) ci( insight::get_parameters(x, component = component), ci = ci, method = method, verbose = verbose, ... ) } #' @export ci.bcplm <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, ...) { ci(insight::get_parameters(x), ci = ci, method = method, verbose = verbose, ...) } #' @export ci.blrm <- ci.bcplm #' @export ci.mcmc <- ci.bcplm #' @export ci.mcmc.list <- ci.bcplm #' @export ci.BGGM <- ci.bcplm #' @export ci.get_predicted <- ci.data.frame bayestestR/R/utils_hdi_ci.R0000644000176200001440000000540114307033605015363 0ustar liggesusers#' @keywords internal .check_ci_fun <- function(dots) { ci_fun <- "hdi" if (identical(dots$ci_method, "spi")) { ci_fun <- "spi" } ci_fun } #' @keywords internal .check_ci_argument <- function(x, ci, verbose = TRUE) { if (ci > 1) { if (verbose) { warning("`ci` should be less than 1, returning NAs.", call. = FALSE) } return(data.frame( "CI" = ci, "CI_low" = NA, "CI_high" = NA )) } if (ci == 1) { return(data.frame( "CI" = ci, "CI_low" = min(x, na.rm = TRUE), "CI_high" = max(x, na.rm = TRUE) )) } if (length(x) < 3) { if (verbose) { warning("The posterior is too short, returning NAs.", call. = FALSE) } return(data.frame( "CI" = ci, "CI_low" = NA, "CI_high" = NA )) } NULL } #' @keywords internal .compute_interval_dataframe <- function(x, ci, verbose, fun) { numeric_variables <- sapply(x, is.numeric, simplify = TRUE) out <- insight::compact_list(lapply( x[, numeric_variables, drop = FALSE], get(fun, asNamespace("bayestestR")), ci = ci, verbose = verbose )) dat <- data.frame( Parameter = rep(names(out), each = length(ci)), do.call(rbind, out), stringsAsFactors = FALSE, row.names = NULL ) # rename for SPI, should be HDI if (identical(fun, "spi")) { class(dat) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_spi", class(dat))) } else { class(dat) <- unique(c(paste0("bayestestR_", fun), paste0("see_", fun), class(dat))) } dat } #' @keywords internal .compute_interval_simMerMod <- function(x, ci, effects, parameters, verbose, fun) { fixed <- fixed.data <- NULL random <- random.data <- NULL if (effects %in% c("fixed", "all")) { fixed.data <- insight::get_parameters(x, effects = "fixed", parameters = parameters) fixed <- .compute_interval_dataframe(fixed.data, ci, verbose, fun) fixed$Group <- "fixed" } if (effects %in% c("random", "all")) { random.data <- insight::get_parameters(x, effects = "random", parameters = parameters) random <- .compute_interval_dataframe(random.data, ci, verbose, fun) random$Group <- "random" } d <- do.call(rbind, list(fixed, random)) if (length(unique(d$Group)) == 1) { d <- datawizard::data_remove(d, "Group", verbose = FALSE) } list(result = d, data = do.call(cbind, insight::compact_list(list(fixed.data, random.data)))) } #' @keywords internal .compute_interval_sim <- function(x, ci, parameters, verbose, fun) { fixed.data <- insight::get_parameters(x, parameters = parameters) d <- .compute_interval_dataframe(fixed.data, ci, verbose, fun) list(result = d, data = fixed.data) } bayestestR/R/reshape_iterations.R0000644000176200001440000000513514357655465016643 0ustar liggesusers#' Reshape estimations with multiple iterations (draws) to long format #' #' Reshape a wide data.frame of iterations (such as posterior draws or #' bootsrapped samples) as columns to long format. Instead of having all #' iterations as columns (e.g., `iter_1, iter_2, ...`), will return 3 columns #' with the `\*_index` (the previous index of the row), the `\*_group` (the #' iteration number) and the `\*_value` (the value of said iteration). #' #' @param x A data.frame containing posterior draws obtained from #' `estimate_response` or `estimate_link`. #' @param prefix The prefix of the draws (for instance, `"iter_"` for columns #' named as `iter_1, iter_2, iter_3`). If more than one are provided, will #' search for the first one that matches. #' @examples #' \donttest{ #' if (require("rstanarm")) { #' model <- stan_glm(mpg ~ am, data = mtcars, refresh = 0) #' draws <- insight::get_predicted(model) #' long_format <- reshape_iterations(draws) #' head(long_format) #' } #' } #' @return Data frame of reshaped draws in long format. #' @export reshape_iterations <- function(x, prefix = c("draw", "iter", "iteration", "sim")) { # Accomodate output from get_predicted if (inherits(x, "get_predicted") && "iterations" %in% names(attributes(x))) { x <- as.data.frame(x) } # Find columns' name prefix <- prefix[min(which(sapply(tolower(prefix), function(prefix) sum(grepl(prefix, tolower(names(x)), fixed = TRUE)) > 1)))] if (is.na(prefix) || is.null(prefix)) { stop(insight::format_message( "Couldn't find columns corresponding to iterations in your dataframe, please specify the correct prefix." ), call. = FALSE) } # Get column names iter_cols <- tolower(names(x))[grepl(prefix, tolower(names(x)), fixed = TRUE)] # Drop "_" if prefix ends with it newname <- ifelse(endsWith(prefix, "_"), substr(prefix, 1, nchar(prefix) - 1), prefix) # Create Index column index_col <- paste0(newname, "_index") if (index_col %in% names(x)) index_col <- paste0(".", newname, "_index") x[[index_col]] <- seq_len(nrow(x)) # Reshape long <- stats::reshape(x, varying = iter_cols, idvar = index_col, v.names = paste0(newname, "_value"), timevar = paste0(newname, "_group"), direction = "long" ) row.names(long) <- NULL class(long) <- class(long)[which(class(long) == "data.frame"):length(class(long))] long } #' @rdname reshape_iterations #' @export reshape_draws <- function(x, prefix = c("draw", "iter", "iteration", "sim")) { .Deprecated("reshape_iterations") reshape_iterations(x, prefix) } bayestestR/R/unupdate.R0000644000176200001440000000752714357655465014607 0ustar liggesusers#' Un-update Bayesian models to their prior-to-data state #' #' As posteriors are priors that have been updated after observing some data, #' the goal of this function is to un-update the posteriors to obtain models #' representing the priors. These models can then be used to examine the prior #' predictive distribution, or to compare priors with posteriors. #' \cr\cr #' This function in used internally to compute Bayes factors. #' #' @param model A fitted Bayesian model. #' @param verbose Toggle warnings. #' @param newdata List of `data.frames` to update the model with new data. Required even if the original data should be used. #' @param ... Not used #' #' @return A model un-fitted to the data, representing the prior model. #' #' @keywords internal #' @export unupdate <- function(model, verbose = TRUE, ...) { UseMethod("unupdate") } #' @export #' @rdname unupdate unupdate.stanreg <- function(model, verbose = TRUE, ...) { insight::check_if_installed("rstanarm") prior_PD <- stats::getCall(model)$prior_PD if (!is.null(prior_PD) && isTRUE(eval(parse(text = prior_PD)))) { return(model) } if (verbose) { message("Sampling priors, please wait...") } prior_dists <- sapply(rstanarm::prior_summary(model), `[[`, "dist") if (anyNA(prior_dists)) { stop( "Cannot sample from flat priors (such as when priors are ", "set to 'NULL' in a 'stanreg' model).", call. = FALSE ) } model_prior <- suppressWarnings( stats::update(model, prior_PD = TRUE, refresh = 0) ) model_prior } #' @export #' @rdname unupdate unupdate.brmsfit <- function(model, verbose = TRUE, ...) { insight::check_if_installed("brms") if (isTRUE(attr(model$prior, "sample_prior") == "only")) { return(model) } if (verbose) { message("Sampling priors, please wait...") } utils::capture.output( model_prior <- try(suppressMessages(suppressWarnings( stats::update(model, sample_prior = "only", refresh = 0) )), silent = TRUE) ) if (methods::is(model_prior, "try-error")) { if (grepl("proper priors", model_prior, fixed = TRUE)) { stop( "Cannot sample from flat priors (such as the default ", "priors for fixed-effects in a 'brmsfit' model).", call. = FALSE ) } else { stop(model_prior, call. = FALSE) } } model_prior } #' @export #' @rdname unupdate unupdate.brmsfit_multiple <- function(model, verbose = TRUE, newdata = NULL, ...) { insight::check_if_installed("brms") if (isTRUE(attr(model$prior, "sample_prior") == "only")) { return(model) } if (verbose) { message("Sampling priors, please wait...") } utils::capture.output(model_prior <- try(suppressMessages(suppressWarnings( stats::update( model, sample_prior = "only", newdata = newdata, refresh = 0 ) )), silent = TRUE)) if (methods::is(model_prior, "try-error")) { if (grepl("proper priors", model_prior, fixed = TRUE)) { insight::format_error( "Cannot sample from flat priors (such as the default ", "priors for fixed-effects in a 'brmsfit' model).", ) } else { insight::format_error(model_prior) } } model_prior } #' @export #' @rdname unupdate unupdate.blavaan <- function(model, verbose = TRUE, ...) { insight::check_if_installed("blavaan") cl <- model@call if (isTRUE(eval(cl$prisamp))) { return(model) } if (verbose) { message("Sampling priors, please wait...") } cl$prisamp <- TRUE suppressMessages(suppressWarnings( utils::capture.output(model_prior <- eval(cl)) )) model_prior } bayestestR/R/print.equivalence_test.R0000644000176200001440000001127414357655465017447 0ustar liggesusers#' @export print.equivalence_test <- function(x, digits = 2, ...) { orig_x <- x insight::print_color("# Test for Practical Equivalence\n\n", "blue") cat(sprintf(" ROPE: [%.*f %.*f]\n\n", digits, x$ROPE_low[1], digits, x$ROPE_high[1])) # fix "sd" pattern model <- .retrieve_model(x) if (!is.null(model)) { cp <- insight::clean_parameters(model) if (!is.null(cp$Group) && any(startsWith(cp$Group, "SD/Cor"))) { cp <- cp[startsWith(cp$Group, "SD/Cor"), ] matches <- match(cp$Parameter, x$Parameter) if (length(matches)) x$Parameter[matches] <- paste0("SD/Cor: ", cp$Cleaned_Parameter[stats::na.omit(match(x$Parameter, cp$Parameter))]) } } # find the longest HDI-value, so we can align the brackets in the ouput x$HDI_low <- sprintf("%.*f", digits, x$HDI_low) x$HDI_high <- sprintf("%.*f", digits, x$HDI_high) maxlen_low <- max(nchar(x$HDI_low)) maxlen_high <- max(nchar(x$HDI_high)) x$ROPE_Percentage <- sprintf("%.*f %%", digits, x$ROPE_Percentage * 100) x$HDI <- sprintf("[%*s %*s]", maxlen_low, x$HDI_low, maxlen_high, x$HDI_high) # clean parameter names # if ("Parameter" %in% colnames(x) && "Cleaned_Parameter" %in% colnames(x)) { # x$Parameter <- x$Cleaned_Parameter # } ci <- unique(x$CI) keep.columns <- c("CI", "Parameter", "ROPE_Equivalence", "ROPE_Percentage", "HDI", "Effects", "Component") x <- x[, intersect(keep.columns, colnames(x))] colnames(x)[which(colnames(x) == "ROPE_Equivalence")] <- "H0" colnames(x)[which(colnames(x) == "ROPE_Percentage")] <- "inside ROPE" .print_equivalence_component(x, ci, digits) # split_column <- "" # split_column <- c(split_column, ifelse("Component" %in% names(x) && length(unique(x$Component)) > 1, "Component", "")) # split_column <- c(split_column, ifelse("Effects" %in% names(x) && length(unique(x$Effects)) > 1, "Effects", "")) # split_column <- split_column[nchar(split_column) > 0] # # if (length(split_column)) { # # # set up split-factor # if (length(split_column) > 1) { # split_by <- lapply(split_column, function(i) x[[i]]) # } else { # split_by <- list(x[[split_column]]) # } # names(split_by) <- split_column # # # # make sure we have correct sorting here... # tables <- split(x, f = split_by) # # for (type in names(tables)) { # # # Don't print Component column # tables[[type]][["Effects"]] <- NULL # tables[[type]][["Component"]] <- NULL # # component_name <- switch( # type, # "fixed" = , # "conditional" = "Fixed Effects", # "random" = "Random Effects", # "conditional.fixed" = "Fixed Effects (Count Model)", # "conditional.random" = "Random Effects (Count Model)", # "zero_inflated" = "Zero-Inflated", # "zero_inflated.fixed" = "Fixed Effects (Zero-Inflated Model)", # "zero_inflated.random" = "Random Effects (Zero-Inflated Model)", # "smooth_sd" = "Smooth Terms (SD)", # "smooth_terms" = "Smooth Terms", # type # ) # # insight::print_color(sprintf(" %s\n\n", component_name), "red") # .print_equivalence_component(tables[[type]], ci, digits) # } # } else { # type <- paste0(unique(x$Component), ".", unique(x$Effects)) # component_name <- switch( # type, # "conditional.fixed" = "Fixed Effects", # "conditional.random" = "Random Effects", # "zero_inflated.fixed" = "Fixed Effects (Zero-Inflated Model)", # "zero_inflated.random" = "Random Effects (Zero-Inflated Model)", # type # ) # # x$Effects <- NULL # x$Component <- NULL # # insight::print_color(sprintf(" %s\n\n", component_name), "red") # .print_equivalence_component(x, ci, digits) # } invisible(orig_x) } .print_equivalence_component <- function(x, ci, digits) { for (i in ci) { xsub <- x[x$CI == i, -which(colnames(x) == "CI"), drop = FALSE] colnames(xsub)[colnames(xsub) == "HDI"] <- sprintf("%i%% HDI", 100 * i) .print_data_frame(xsub, digits = digits) cat("\n") } } .retrieve_model <- function(x) { # retrieve model obj_name <- attr(x, "object_name", exact = TRUE) model <- NULL if (!is.null(obj_name)) { # first try, parent frame model <- tryCatch( { get(obj_name, envir = parent.frame()) }, error = function(e) { NULL } ) if (is.null(model)) { # second try, global env model <- tryCatch( { get(obj_name, envir = globalenv()) }, error = function(e) { NULL } ) } } model } bayestestR/R/as.list.R0000644000176200001440000000140214357655465014321 0ustar liggesusers# as.list ----------------------------------------------------------------- #' @export as.list.bayestestR_hdi <- function(x, ...) { if (nrow(x) == 1) { out <- list(CI = x$CI, CI_low = x$CI_low, CI_high = x$CI_high) out$Parameter <- x$Parameter } else { out <- list() for (param in x$Parameter) { out[[param]] <- list() out[[param]][["CI"]] <- x[x$Parameter == param, "CI"] out[[param]][["CI_low"]] <- x[x$Parameter == param, "CI_low"] out[[param]][["CI_high"]] <- x[x$Parameter == param, "CI_high"] } } out } #' @export as.list.bayestestR_eti <- as.list.bayestestR_hdi #' @export as.list.bayestestR_si <- as.list.bayestestR_hdi #' @export as.list.bayestestR_ci <- as.list.bayestestR_hdi bayestestR/R/datasets.R0000644000176200001440000000132214357655465014555 0ustar liggesusers#' Moral Disgust Judgment #' #' A sample (simulated) dataset, used in tests and some examples. #' #' @author Richard D. Morey #' #' @docType data #' #' @name disgust #' #' @keywords data #' #' @format A data frame with 500 rows and 5 variables: #' \describe{ #' \item{score}{Score on the questionnaire, which ranges from 0 to 50 with higher scores representing harsher moral judgment} #' \item{condition}{one of three conditions, differing by the odor present in the room: a pleasant scent associated with cleanliness (lemon), a disgusting scent (sulfur), and a control condition in which no unusual odor is present} #' } #' #' ```{r} #' data("disgust") #' head(disgust, n = 5) #' ```` #' NULL bayestestR/R/format.R0000644000176200001440000002370114407021360014213 0ustar liggesusers#' @export format.describe_posterior <- function(x, cp, digits = 2, format = "text", ci_string = "CI", caption = NULL, subtitles = NULL, ...) { # reshape CI if (is.data.frame(x) && insight::n_unique(x$CI) > 1) { att <- attributes(x) x <- datawizard::reshape_ci(x) attributes(x) <- utils::modifyList(att, attributes(x)) } # format columns and values of data frame out <- insight::format_table(x, digits = digits, format = format, ...) # different CI-types as column names? if (ci_string != "CI" && any(endsWith(colnames(out), "CI"))) { colnames(out) <- gsub("(.*)CI$", paste0("\\1", ci_string), colnames(out)) } # match and split at components if (!is.null(cp) && !all(is.na(match(cp$Parameter, out$Parameter)))) { out <- insight::print_parameters( cp, out, keep_parameter_column = FALSE, remove_empty_column = TRUE, titles = caption, subtitles = subtitles, format = format ) } else { attr(out, "table_caption") <- caption attr(out, "table_subtitle") <- subtitles } out } #' @export format.point_estimate <- format.describe_posterior #' @export format.p_rope <- format.describe_posterior #' @export format.p_direction <- format.describe_posterior #' @export format.p_map <- format.describe_posterior #' @export format.map_estimate <- format.describe_posterior #' @export format.p_significance <- format.describe_posterior #' @export format.bayestestR_hdi <- format.describe_posterior #' @export format.bayestestR_eti <- format.describe_posterior #' @export format.bayestestR_si <- format.describe_posterior # special handling for bayes factors ------------------ #' @export format.bayesfactor_models <- function(x, digits = 3, log = FALSE, show_names = TRUE, format = "text", caption = NULL, exact = TRUE, ...) { BFE <- x denominator <- attr(BFE, "denominator") grid.type <- attr(BFE, "BF_method") model_names <- attr(BFE, "model_names") formula_length <- attr(BFE, "text_length") BFE <- as.data.frame(BFE) BFE$log_BF <- as.numeric(x, log = log) BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...) if (any((sgn <- sign(BFE$log_BF) < 0)[!is.na(BFE$log_BF)])) { BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } BFE$Model[BFE$Model == "1"] <- "(Intercept only)" # indicate null-model # shorten model formulas? if (!is.null(formula_length) && !is.null(BFE$Model)) { BFE$Model <- insight::format_string(BFE$Model, length = formula_length) } if (isFALSE(show_names) || is.null(model_names) || length(model_names) != nrow(BFE)) { BFE$i <- paste0("[", seq_len(nrow(BFE)), "]") } else { BFE$i <- paste0("[", model_names, "]") } # Denominator denM <- insight::trim_ws(paste0(BFE$i, " ", BFE$Model)[denominator]) BFE <- BFE[-denominator, ] BFE <- BFE[c("i", "Model", "BF")] colnames(BFE)[1] <- ifelse(identical(format, "html"), "Name", "") # footer if (is.null(format) || format == "text") { footer <- list( "\n* Against Denominator: ", c(denM, "cyan"), "\n* Bayes Factor Type: ", c(grid.type, "cyan"), if (log) c("\n\nBayes Factors are on the log-scale.", "red") ) # color formatting for caption if (!is.null(caption)) { caption <- c(caption, "blue") } } else { footer <- insight::compact_list(list( paste0("Against Denominator: ", denM), paste0("Bayes Factor Type: ", grid.type), if (log) "Bayes Factors are on the log-scale." )) } attr(BFE, "table_footer") <- footer attr(BFE, "table_caption") <- caption BFE } #' @export format.bayesfactor_inclusion <- function(x, digits = 3, log = FALSE, format = "text", caption = NULL, exact = TRUE, ...) { priorOdds <- attr(x, "priorOdds") matched <- attr(x, "matched") # format table BFE <- as.data.frame(x) BFE$log_BF <- as.numeric(x, log = log) BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...) if (any((sgn <- sign(BFE$log_BF) < 0)[!is.na(BFE$log_BF)])) { BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } BFE <- BFE[c("p_prior", "p_posterior", "BF")] BFE <- cbind(rownames(BFE), BFE) colnames(BFE) <- c("", "P(prior)", "P(posterior)", "Inclusion BF") colnames(BFE)[1] <- ifelse(identical(format, "html"), "Parameter", "") # footer if (is.null(format) || format == "text") { footer <- list( "\n* Compared among: ", c(if (matched) "matched models only" else "all models", "cyan"), "\n* Priors odds: ", c(if (!is.null(priorOdds)) "custom" else "uniform-equal", "cyan"), if (log) c("\n\nBayes Factors are on the log-scale.", "red") ) # color formatting for caption if (!is.null(caption)) { caption <- c(caption, "blue") } } else { footer <- insight::compact_list(list( paste0("Compared among: ", if (matched) "matched models only" else "all models"), paste0("Priors odds: ", if (!is.null(priorOdds)) "custom" else "uniform-equal"), if (log) "Bayes Factors are on the log-scale." )) } attr(BFE, "table_footer") <- footer attr(BFE, "table_caption") <- caption BFE } #' @export format.bayesfactor_restricted <- function(x, digits = 3, log = FALSE, format = "text", caption = NULL, exact = TRUE, ...) { BFE <- as.data.frame(x) # Format BFE$log_BF <- as.numeric(x, log = log) BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...) if (any((sgn <- sign(BFE$log_BF) < 0)[!is.na(BFE$log_BF)])) { BFE$BF[sgn] <- paste0("-", BFE$BF[sgn]) } BFE$log_BF <- NULL colnames(BFE) <- c("Hypothesis", "P(Prior)", "P(Posterior)", "BF") # footer if (is.null(format) || format == "text") { footer <- list( "\n* Bayes factors for the restricted model vs. the un-restricted model.\n", if (log) c("\nBayes Factors are on the log-scale.\n", "red") ) # color formatting for caption if (!is.null(caption)) { caption <- c(caption, "blue") } } else { footer <- insight::compact_list(list( "Bayes factors for the restricted model vs. the un-restricted model.", if (log) "Bayes Factors are on the log-scale." )) } attr(BFE, "table_footer") <- footer attr(BFE, "table_caption") <- caption BFE } #' @export format.bayesfactor_parameters <- function(x, cp = NULL, digits = 3, log = FALSE, format = "text", exact = TRUE, ...) { null <- attr(x, "hypothesis") direction <- attr(x, "direction") x$log_BF <- as.numeric(x, log = log) x$BF_override <- insight::format_bf(abs(x$log_BF), name = NULL, exact = exact, ...) if (any((sgn <- sign(x$log_BF) < 0)[!is.na(x$log_BF)])) { x$BF_override[sgn] <- paste0("-", x$BF_override[sgn]) } x$log_BF <- NULL # format columns and values of data frame out <- insight::format_table(x, digits = digits, format = format, ...) colnames(out)[colnames(out) == "BF_override"] <- "BF" # table caption caption <- sprintf( "Bayes Factor (%s)", if (length(null) == 1) "Savage-Dickey density ratio" else "Null-Interval" ) if (is.null(format) || format == "text") { caption <- c(caption, "blue") } # format null-value if (length(null) == 1) { null <- insight::format_value(null, digits = digits, protect_integers = TRUE) } else { null <- insight::format_ci(null[1], null[2], ci = NULL, digits = digits) } # footer if (is.null(format) || format == "text") { footer <- list( "\n* Evidence Against The Null: ", c(paste0(null, "\n"), "cyan"), if (direction) "* Direction: ", if (direction < 0) c("Left-Sided test", "cyan"), if (direction > 0) c("Right-Sided test", "cyan"), if (direction) "\n", if (log) c("\n\nBayes Factors are on the log-scale.\n", "red") ) } else { footer <- insight::compact_list(list( paste0("Evidence Against The Null: ", null), if (direction) "Direction: ", if (direction < 0) "Left-Sided test", if (direction > 0) "Right-Sided test", if (log) "Bayes Factors are on the log-scale." )) } # match and split at components if (!is.null(cp) && !all(is.na(match(cp$Parameter, out$Parameter)))) { out <- insight::print_parameters( cp, out, keep_parameter_column = FALSE, remove_empty_column = TRUE, format = format ) attr(out[[1]], "table_caption") <- caption attr(out[[length(out)]], "table_footer") <- footer } else { attr(out, "table_caption") <- caption attr(out, "table_footer") <- footer } out } bayestestR/R/check_prior.R0000644000176200001440000001552214407021360015215 0ustar liggesusers#' Check if Prior is Informative #' #' Performs a simple test to check whether the prior is informative to the #' posterior. This idea, and the accompanying heuristics, were discussed in #' [this blogpost](https://statmodeling.stat.columbia.edu/2019/08/10/). #' #' @param method Can be `"gelman"` or `"lakeland"`. For the #' `"gelman"` method, if the SD of the posterior is more than 0.1 times #' the SD of the prior, then the prior is considered as informative. For the #' `"lakeland"` method, the prior is considered as informative if the #' posterior falls within the `95%` HDI of the prior. #' @param simulate_priors Should prior distributions be simulated using #' [simulate_prior()] (default; faster) or sampled via #' [unupdate()] (slower, more accurate). #' @inheritParams effective_sample #' @inheritParams hdi #' #' @return A data frame with two columns: The parameter names and the quality #' of the prior (which might be `"informative"`, `"uninformative"`) #' or `"not determinable"` if the prior distribution could not be #' determined). #' #' @examples #' \dontrun{ #' library(bayestestR) #' if (require("rstanarm")) { #' model <- stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) #' check_prior(model, method = "gelman") #' check_prior(model, method = "lakeland") #' #' # An extreme example where both methods diverge: #' model <- stan_glm(mpg ~ wt, #' data = mtcars[1:3, ], #' prior = normal(-3.3, 1, FALSE), #' prior_intercept = normal(0, 1000, FALSE), #' refresh = 0 #' ) #' check_prior(model, method = "gelman") #' check_prior(model, method = "lakeland") #' # can provide visual confirmation to the Lakeland method #' plot(si(model, verbose = FALSE)) #' } #' } #' @references https://statmodeling.stat.columbia.edu/2019/08/10/ #' @export check_prior <- function(model, method = "gelman", simulate_priors = TRUE, ...) { UseMethod("check_prior") } #' @export check_prior.brmsfit <- function(model, method = "gelman", simulate_priors = TRUE, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) { # check arguments effects <- match.arg(effects) component <- match.arg(component) posteriors <- insight::get_parameters( model, effects = effects, component = component, parameters = parameters ) if (isTRUE(simulate_priors)) { priors <- simulate_prior( model, effects = effects, component = component, parameters = parameters, verbose = verbose ) } else { priors <- unupdate(model, verbose = FALSE) priors <- insight::get_parameters( priors, effects = effects, component = component, parameters = parameters ) } .check_prior(priors, posteriors, method, verbose = verbose, cleaned_parameters = insight::clean_parameters(model) ) } #' @export check_prior.stanreg <- check_prior.brmsfit #' @export check_prior.blavaan <- check_prior.brmsfit #' @keywords internal .check_prior <- function(priors, posteriors, method = "gelman", verbose = TRUE, cleaned_parameters = NULL) { # sanity check for matching parameters. Some weird priors like # rstanarm's R2 prior might cause problems if (!is.null(cleaned_parameters) && ncol(priors) != ncol(posteriors)) { ## TODO for now only fixed effects if ("Effects" %in% colnames(cleaned_parameters)) { cleaned_parameters <- cleaned_parameters[cleaned_parameters$Effects == "fixed", ] } # rename cleaned parameters, so they match name of prior parameter column cp <- cleaned_parameters$Cleaned_Parameter cp <- gsub("(.*)(\\.|\\[)\\d+(\\.|\\])", "\\1", cp) cp[cp == "Intercept"] <- "(Intercept)" cleaned_parameters$Cleaned_Parameter <- cp colnames(priors)[colnames(priors) == "Intercept"] <- "(Intercept)" # at this point, the colnames of "posteriors" should match "cp$Parameter", # while colnames of "priors" should match "cp$Cleaned_Parameter". To ensure # that ncol of priors is the same as ncol of posteriors, we now duplicate # prior columns and match them with the posteriors if (ncol(posteriors) > ncol(priors)) { matched_columns <- stats::na.omit(match(cleaned_parameters$Cleaned_Parameter, colnames(priors))) matched_column_names <- stats::na.omit(match(colnames(priors), cleaned_parameters$Cleaned_Parameter)) priors <- priors[matched_columns] } else { matched_columns <- stats::na.omit(match(colnames(priors), cleaned_parameters$Cleaned_Parameter)) matched_column_names <- stats::na.omit(match(cleaned_parameters$Cleaned_Parameter, colnames(priors))) priors <- priors[matched_columns] } colnames(priors) <- cleaned_parameters$Parameter[matched_column_names] } # still different ncols? if (ncol(priors) != ncol(posteriors)) { common_columns <- intersect(colnames(priors), colnames(posteriors)) priors <- priors[common_columns] posteriors <- posteriors[common_columns] if (verbose) { insight::format_warning("Parameters and priors could not be fully matched. Only returning results for parameters with matching priors.") } } # for priors whose distribution cannot be simulated, prior values are # all NA. Catch those, and warn user all_missing <- sapply(priors, function(i) { all(is.na(i)) }) if (any(all_missing) && verbose) { insight::format_warning("Some priors could not be simulated.") } .gelman <- function(prior, posterior) { if (all(is.na(prior))) { "not determinable" } else if (stats::sd(posterior, na.rm = TRUE) > 0.1 * stats::sd(prior, na.rm = TRUE)) { "informative" } else { "uninformative" } } .lakeland <- function(prior, posterior) { if (all(is.na(prior))) { "not determinable" } else { hdi <- hdi(prior, ci = 0.95) r <- rope(posterior, ci = 1, range = c(hdi$CI_low, hdi$CI_high)) if (as.numeric(r) > 0.99) { "informative" } else { "misinformative" } } } if (method == "gelman") { result <- mapply(.gelman, priors, posteriors) } else if (method == "lakeland") { result <- mapply(.lakeland, priors, posteriors) } else { insight::format_error("method should be 'gelman' or 'lakeland'.") } data.frame( Parameter = names(posteriors), Prior_Quality = unname(result), stringsAsFactors = FALSE ) } bayestestR/R/bic_to_bf.R0000644000176200001440000000232214276606712014643 0ustar liggesusers#' Convert BIC indices to Bayes Factors via the BIC-approximation method. #' #' The difference between two Bayesian information criterion (BIC) indices of #' two models can be used to approximate Bayes factors via: #' \cr #' \deqn{BF_{10} = e^{(BIC_0 - BIC_1)/2}}{BF10 = exp((BIC0-BIC1)/2)} #' #' @param bic A vector of BIC values. #' @param denominator The BIC value to use as a denominator (to test against). #' @param log If `TRUE`, return the `log(BF)`. #' #' @references #' Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values. Psychonomic bulletin & review, 14(5), 779-804 #' #' @examples #' bic1 <- BIC(lm(Sepal.Length ~ 1, data = iris)) #' bic2 <- BIC(lm(Sepal.Length ~ Species, data = iris)) #' bic3 <- BIC(lm(Sepal.Length ~ Species + Petal.Length, data = iris)) #' bic4 <- BIC(lm(Sepal.Length ~ Species * Petal.Length, data = iris)) #' #' bic_to_bf(c(bic1, bic2, bic3, bic4), denominator = bic1) #' @return The Bayes Factors corresponding to the BIC values against the denominator. #' #' @export bic_to_bf <- function(bic, denominator, log = FALSE) { delta <- (denominator - bic) / 2 if (log) { return(delta) } else { return(exp(delta)) } } bayestestR/R/sensitivity_to_prior.R0000644000176200001440000000717714407021360017243 0ustar liggesusers#' Sensitivity to Prior #' #' Computes the sensitivity to priors specification. This represents the #' proportion of change in some indices when the model is fitted with an #' antagonistic prior (a prior of same shape located on the opposite of the #' effect). #' #' @param model A Bayesian model (`stanreg` or `brmsfit`). #' @param index The indices from which to compute the sensitivity. Can be one or #' multiple names of the columns returned by `describe_posterior`. The case is #' important here (e.g., write 'Median' instead of 'median'). #' @param magnitude This represent the magnitude by which to shift the #' antagonistic prior (to test the sensitivity). For instance, a magnitude of #' 10 (default) means that the mode wil be updated with a prior located at 10 #' standard deviations from its original location. #' @param ... Arguments passed to or from other methods. #' #' @examples #' \dontrun{ #' library(bayestestR) #' #' # rstanarm models #' # ----------------------------------------------- #' if (require("rstanarm")) { #' model <- rstanarm::stan_glm(mpg ~ wt, data = mtcars) #' sensitivity_to_prior(model) #' #' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) #' sensitivity_to_prior(model, index = c("Median", "MAP")) #' } #' #' # brms models #' # ----------------------------------------------- #' if (require("brms")) { #' model <- brms::brm(mpg ~ wt + cyl, data = mtcars) #' # sensitivity_to_prior(model) #' } #' } #' @seealso DescTools #' @export sensitivity_to_prior <- function(model, index = "Median", magnitude = 10, ...) { UseMethod("sensitivity_to_prior") } #' @export sensitivity_to_prior.stanreg <- function(model, index = "Median", magnitude = 10, ...) { # Original params <- .extract_parameters(model, index = index, ...) # Priors priors <- .extract_priors_rstanarm(model) new_priors <- .prior_new_location(prior = priors$prior, sign = sign(params$Median), magnitude = magnitude) model_updated <- stats::update(model, data = insight::get_data(model), prior = new_priors, refresh = 0) # New model params_updated <- .extract_parameters(model_updated, index = index, ...) # Compute index sensitivity <- abs(as.matrix(params_updated[-1]) - as.matrix(params[-1])) / abs(as.matrix(params[-1])) # Clean up sensitivity <- as.data.frame(sensitivity) names(sensitivity) <- paste0("Sensitivity_", names(params_updated)[-1]) sensitivity <- cbind(params_updated[1], sensitivity) row.names(sensitivity) <- NULL sensitivity } #' @keywords internal .extract_parameters <- function(model, index = "Median", ...) { # Handle BF test <- c("pd", "rope", "p_map") if (any(c("bf", "bayesfactor", "bayes_factor") %in% index)) { test <- c(test, "bf") } params <- suppressMessages(describe_posterior( model, centrality = "all", dispersion = TRUE, test = test, ... )) params <- params[params$Parameter != "(Intercept)", ] params[unique(c("Parameter", "Median", index))] } #' Set a new location for a prior #' @keywords internal .prior_new_location <- function(prior, sign, magnitude = 10) { prior$location <- -1 * sign * magnitude * prior$scale prior } #' Extract and Returns the priors formatted for rstanarm #' @keywords internal .extract_priors_rstanarm <- function(model, ...) { priors <- rstanarm::prior_summary(model) # Deal with adjusted scale if (!is.null(priors$prior$adjusted_scale)) { priors$prior$scale <- priors$prior$adjusted_scale priors$prior$adjusted_scale <- NULL } priors$prior$autoscale <- FALSE priors } bayestestR/NEWS.md0000644000176200001440000003747714407021360013514 0ustar liggesusers# bayestestR 0.13.1 ## Changes * Improved speed performance when functions are called using `do.call()`. * Improved speed performance to `bayesfactor_models()` for `brmsfit` objects that already included a `marglik` element in the model object. ## New functionality * `as.logical()` for `bayesfactor_restricted()` results, extracts the boolean vector(s) the mark which draws are part of the order restriction. ## Bug fixes * `p_map()` gains a new `null` argument to specify any non-0 nulls. * Fixed non-working examples for `ci(method = "SI")`. * Fixed wrong calculation of rope range for model objects in `describe_posterior()`. * Some smaller bug fixes. # bayestestR 0.13.0 ## Breaking * The minimum needed R version has been bumped to `3.6`. * `contr.equalprior(contrasts = FALSE)` (previously `contr.orthonorm`) no longer returns an identity matrix, but a shifted `diag(n) - 1/n`, for consistency. ## New functionality * `p_to_bf()`, to convert p-values into Bayes factors. For more accurate approximate Bayes factors, use `bic_to_bf()`. * *bayestestR* now supports objects of class `rvar` from package *posterior*. * `contr.equalprior` (previously `contr.orthonorm`) gains two new functions: `contr.equalprior_pairs` and `contr.equalprior_deviations` to aide in setting more intuitive priors. ## Changes * has been renamed *`contr.equalprior`* to be more explicit about its function. * `p_direction()` now accepts objects of class `parameters_model()` (from `parameters::model_parameters()`), to compute probability of direction for parameters of frequentist models. # bayestestR 0.12.1 ## Breaking * `Bayesfactor_models()` for frequentist models now relies on the updated `insight::get_loglikelihood()`. This might change some results for REML based models. See documentation. * `estimate_density()` argument `group_by` is renamed `at`. * All `distribution_*(random = FALSE)` functions now rely on `ppoints()`, which will result in slightly different results, especially with small `n`s. * Uncertainty estimation now defaults to `"eti"` (formerly was `"hdi"`). ## Changes * *bayestestR* functions now support `draws` objects from package *posterior*. * `rope_range()` now handles log(normal)-families and models with log-transformed outcomes. * New function `spi()`, to compute shortest probability intervals. Furthermore, the `"spi"` option was added as new method to compute uncertainty intervals. ## Bug fixes * `bci()` for some objects incorrectly returned the equal-tailed intervals. # bayestestR 0.11.5 * Fixes failing tests in CRAN checks. # bayestestR 0.11.1 ## New functions * `describe_posterior()` gains a `plot()` method, which is a short cut for `plot(estimate_density(describe_posterior()))`. # bayestestR 0.11 ## Bug fixes * Fixed issues related to last *brms* update. * Fixed bug in `describe_posterior.BFBayesFactor()` where Bayes factors were missing from out put ( #442 ). # bayestestR 0.10.0 ## Breaking * All Bayes factors are now returned as `log(BF)` (column name `log_BF`). Printing is unaffected. To retrieve the raw BFs, you can run `exp(result$log_BF)`. ## New functions * `bci()` (and its alias `bcai()`) to compute bias-corrected and accelerated bootstrap intervals. Along with this new function, `ci()` and `describe_posterior()` gain a new `ci_method` type, `"bci"`. ## Changes * `contr.bayes` has been renamed *`contr.orthonorm`* to be more explicit about its function. # bayestestR 0.9.0 ## Breaking * The default `ci` width has been changed to 0.95 instead of 0.89 (see [here](https://github.com/easystats/bayestestR/discussions/250)). This should not come as a surprise to the long-time users of `bayestestR` as we have been warning about this impending change for a while now :) * Column names for `bayesfactor_restricted()` are now `p_prior` and `p_posterior` (was `Prior_prob` and `Posterior_prob`), to be consistent with `bayesfactor_inclusion()` output. * Removed the experimental function `mhdior`. ## General * Support for `blavaan` models. * Support for `blrm` models (*rmsb*). * Support for `BGGM` models (*BGGM*). * `check_prior()` and `describe_prior()` should now also work for more ways of prior definition in models from *rstanarm* or *brms*. ## Bug fixes * Fixed bug in `print()` method for the `mediation()` function. * Fixed remaining inconsistencies with CI values, which were not reported as fraction for `rope()`. * Fixed issues with special prior definitions in `check_prior()`, `describe_prior()` and `simulate_prior()`. # bayestestR 0.8.2 ## General * Support for `bamlss` models. * Roll-back R dependency to R >= 3.4. ## Changes to functions * All `.stanreg` methods gain a `component` argument, to also include auxiliary parameters. ## Bug fixes * `bayesfactor_parameters()` no longer errors for no reason when computing extremely un/likely direction hypotheses. * `bayesfactor_pointull()` / `bf_pointull()` are now `bayesfactor_pointnull()` / `bf_pointnull()` (can *you* spot the difference? #363 ). # bayestestR 0.8.0 ## New functions * `sexit()`, a function for sequential effect existence and significance testing (SEXIT). ## General * Added startup-message to warn users that default ci-width might change in a future update. * Added support for *mcmc.list* objects. ## Bug fixes * `unupdate()` gains a `newdata` argument to work with `brmsfit_multiple` models. * Fixed issue in Bayes factor vignette (don't evaluate code chunks if packages not available). # bayestestR 0.7.5 ## New functions * Added `as.matrix()` function for `bayesfactor_model` arrays. * `unupdate()`, a utility function to get Bayesian models un-fitted from the data, representing the priors only. ## Changes to functions * `ci()` supports `emmeans` - both Bayesian and frequentist ( #312 - cross fix with `parameters`) ## Bug fixes * Fixed issue with *default* rope range for `BayesFactor` models. * Fixed issue in collinearity-check for `rope()` for models with less than two parameters. * Fixed issue in print-method for `mediation()` with `stanmvreg`-models, which displays the wrong name for the response-value. * Fixed issue in `effective_sample()` for models with only one parameter. * `rope_range()` for `BayesFactor` models returns non-`NA` values ( #343 ) # bayestestR 0.7.2 ## New functions - `mediation()`, to compute average direct and average causal mediation effects of multivariate response models (`brmsfit`, `stanmvreg`). ## Bug fixes - `bayesfactor_parameters()` works with `R<3.6.0`. # bayestestR 0.7.0 ## General - Preliminary support for *stanfit* objects. - Added support for *bayesQR* objects. ## Changes to functions - `weighted_posteriors()` can now be used with data frames. - Revised `print()` for `describe_posterior()`. - Improved value formatting for Bayesfactor functions. ## Bug fixes - Link transformation are now taken into account for `emmeans` objets. E.g., in `describe_posterior()`. - Fix `diagnostic_posterior()` when algorithm is not "sampling". - Minor revisions to some documentations. - Fix CRAN check issues for win-old-release. # bayestestR 0.6.0 ## Changes to functions - `describe_posterior()` now also works on `effectsize::standardize_posteriors()`. - `p_significance()` now also works on `parameters::simulate_model()`. - `rope_range()` supports more (frequentis) models. ## Bug fixes - Fixed issue with `plot()` `data.frame`-methods of `p_direction()` and `equivalence_test()`. - Fix check issues for forthcoming insight-update. # bayestestR 0.5.3 ## General - Support for *bcplm* objects (package **cplm**) ## Changes to functions - `estimate_density()` now also works on grouped data frames. ## Bug fixes - Fixed bug in `weighted_posteriors()` to properly weight Intercept-only `BFBayesFactor` models. - Fixed bug in `weighted_posteriors()` when models have very low posterior probability ( #286 ). - Fixed bug in `describe_posterior()`, `rope()` and `equivalence_test()` for *brmsfit* models with monotonic effect. - Fixed issues related to latest changes in `as.data.frame.brmsfit()` from the *brms* package. # bayestestR 0.5.0 ## General - Added `p_pointnull()` as an alias to `p_MAP()`. - Added `si()` function to compute support intervals. - Added `weighted_posteriors()` for generating posterior samples averaged across models. - Added `plot()`-method for `p_significance()`. - `p_significance()` now also works for *brmsfit*-objects. - `estimate_density()` now also works for *MCMCglmm*-objects. - `equivalence_test()` gets `effects` and `component` arguments for *stanreg* and *brmsfit* models, to print specific model components. - Support for *mcmc* objects (package **coda**) - Provide more distributions via `distribution()`. - Added `distribution_tweedie()`. - Better handling of `stanmvreg` models for `describe_posterior()`, `diagnostic_posterior()` and `describe_prior()`. ## Breaking changes - `point_estimate()`: argument `centrality` default value changed from 'median' to 'all'. - `p_rope()`, previously as exploratory index, was renamed as `mhdior()` (for *Max HDI inside/outside ROPE*), as `p_rope()` will refer to `rope(..., ci = 1)` ( #258 ) ## Bug fixes - Fixed mistake in description of `p_significance()`. - Fixed error when computing BFs with `emmGrid` based on some non-linear models ( #260 ). - Fixed wrong output for percentage-values in `print.equivalence_test()`. - Fixed issue in `describe_posterior()` for `BFBayesFactor`-objects with more than one model. # bayestestR 0.4.0 ## New functions / features - `convert_bayesian_to_frequentist()` Convert (refit) Bayesian model as frequentist - `distribution_binomial()` for perfect binomial distributions - `simulate_ttest()` Simulate data with a mean difference - `simulate_correlation()` Simulate correlated datasets - `p_significance()` Compute the probability of Practical Significance (ps) - `overlap()` Compute overlap between two empirical distributions - `estimate_density()`: `method = "mixture"` argument added for mixture density estimation ## Bug fixes - Fixed bug in `simulate_prior()` for stanreg-models when `autoscale` was set to `FALSE` # bayestestR 0.3.0 ## General - revised `print()`-methods for functions like `rope()`, `p_direction()`, `describe_posterior()` etc., in particular for model objects with random effects and/or zero-inflation component ## New functions / features - `check_prior()` to check if prior is informative - `simulate_prior()` to simulate model's priors as distributions - `distribution_gamma()` to generate a (near-perfect or random) Gamma distribution - `contr.bayes` function for orthogonal factor coding (implementation from Singmann & Gronau's [`bfrms`](https://github.com/bayesstuff/bfrms/), used for proper prior estimation when factor have 3 levels or more. See Bayes factor vignette ## Changes to functions - Added support for `sim`, `sim.merMod` (from `arm::sim()`) and `MCMCglmm`-objects to many functions (like `hdi()`, `ci()`, `eti()`, `rope()`, `p_direction()`, `point_estimate()`, ...) - `describe_posterior()` gets an `effects` and `component` argument, to include the description of posterior samples from random effects and/or zero-inflation component. - More user-friendly warning for non-supported models in `bayesfactor()`-methods ## Bug fixes - Fixed bug in `bayesfactor_inclusion()` where the same interaction sometimes appeared more than once (#223) - Fixed bug in `describe_posterior()` for *stanreg* models fitted with fullrank-algorithm # bayestestR 0.2.5 ## Breaking changes - `rope_range()` for binomial model has now a different default (-.18; .18 ; instead of -.055; .055) - `rope()`: returns a proportion (between 0 and 1) instead of a value between 0 and 100 - `p_direction()`: returns a proportion (between 0.5 and 1) instead of a value between 50 and 100 ([#168](https://github.com/easystats/bayestestR/issues/168)) - `bayesfactor_savagedickey()`: `hypothesis` argument replaced by `null` as part of the new `bayesfactor_parameters()` function ## New functions / features - `density_at()`, `p_map()` and `map_estimate()`: `method` argument added - `rope()`: `ci_method` argument added - `eti()`: Computes equal-tailed intervals - `reshape_ci()`: Reshape CIs between wide/long - `bayesfactor_parameters()`: New function, replacing `bayesfactor_savagedickey()`, allows for computing Bayes factors against a *point-null* or an *interval-null* - `bayesfactor_restricted()`: Function for computing Bayes factors for order restricted models ## Minor changes ## Bug fixes - `bayesfactor_inclusion()` now works with `R < 3.6`. # bayestestR 0.2.2 ## Breaking changes - `equivalence_test()`: returns capitalized output (e.g., `Rejected` instead of `rejected`) - `describe_posterior.numeric()`: `dispersion` defaults to `FALSE` for consistency with the other methods ## New functions / features - `pd_to_p()` and `p_to_pd()`: Functions to convert between probability of direction (pd) and p-value - Support of `emmGrid` objects: `ci()`, `rope()`, `bayesfactor_savagedickey()`, `describe_posterior()`, ... ## Minor changes - Improved tutorial 2 ## Bug fixes - `describe_posterior()`: Fixed column order restoration - `bayesfactor_inclusion()`: Inclusion BFs for matched models are more inline with JASP results. # bayestestR 0.2.0 ## Breaking changes - plotting functions now require the installation of the `see` package - `estimate` argument name in `describe_posterior()` and `point_estimate()` changed to `centrality` - `hdi()`, `ci()`, `rope()` and `equivalence_test()` default `ci` to `0.89` - `rnorm_perfect()` deprecated in favour of `distribution_normal()` - `map_estimate()` now returns a single value instead of a dataframe and the `density` parameter has been removed. The MAP density value is now accessible via `attributes(map_output)$MAP_density` ## New functions / features - `describe_posterior()`, `describe_prior()`, `diagnostic_posterior()`: added wrapper function - `point_estimate()` added function to compute point estimates - `p_direction()`: new argument `method` to compute pd based on AUC - `area_under_curve()`: compute AUC - `distribution()` functions have been added - `bayesfactor_savagedickey()`, `bayesfactor_models()` and `bayesfactor_inclusion()` functions has been added - Started adding plotting methods (currently in the [`see`](https://github.com/easystats/see) package) for `p_direction()` and `hdi()` - `probability_at()` as alias for `density_at()` - `effective_sample()` to return the effective sample size of Stan-models - `mcse()` to return the Monte Carlo standard error of Stan-models ## Minor changes - Improved documentation - Improved testing - `p_direction()`: improved printing - `rope()` for model-objects now returns the HDI values for all parameters as attribute in a consistent way - Changes legend-labels in `plot.equivalence_test()` to align plots with the output of the `print()`-method (#78) ## Bug fixes - `hdi()` returned multiple class attributes (#72) - Printing results from `hdi()` failed when `ci`-argument had fractional parts for percentage values (e.g. `ci = 0.995`). - `plot.equivalence_test()` did not work properly for *brms*-models (#76). # bayestestR 0.1.0 - CRAN initial publication and [0.1.0 release](https://github.com/easystats/bayestestR/releases/tag/v0.1.0) - Added a `NEWS.md` file to track changes to the package bayestestR/MD50000644000176200001440000002367514414032242012720 0ustar liggesuserscdd2ca57df85efda104be9dd5277d572 *DESCRIPTION e75e5f6cb6630a7ca67d62d8b88b449a *NAMESPACE 39405bfb8bacea08be8037081e86a2bf *NEWS.md 74275e59c5c1c837176699338ec03bb7 *R/area_under_curve.R a990bddd4c54e18ca2bb3b5cf954cbee *R/as.list.R f429b938797329e425d9158e05d3a87f *R/bayesfactor.R e90d2a673c630e3e750d5a2483125042 *R/bayesfactor_inclusion.R 9a3c2f07c22fb94238ae825d2f868208 *R/bayesfactor_models.R c26aae94506fc2e90456e2bd610d9e4c *R/bayesfactor_parameters.R eeded42a3866ac344e2bc9eedf0f8e22 *R/bayesfactor_restricted.R 89fb8182fcba929c2bf1034641601fcc *R/bayestestR-package.R 4097b0466b23e258c3575ad34304e565 *R/bci.R e6642f324192341f4f5e92aa200feeff *R/bic_to_bf.R dd93d5c4dc8dd5c89e8f45fbcc46e534 *R/check_prior.R 43794898e3dfbea61fad3d02fee5e056 *R/ci.R 9c1764245ab6f98e939b1c57a50bb448 *R/contr.equalprior.R ab6f555ae19ed899fc2bbd531bac844e *R/convert_bayesian_to_frequentist.R 484605e2a29dd677c26b111cb17bb0a9 *R/convert_pd_to_p.R 190bd1fd94590a6066de0207c8d37908 *R/cwi.R e87daed2f8a248c6d092f14fc1b1ce6e *R/datasets.R 85d07453d8ffbc1d1106e369863166f0 *R/describe_posterior.R 78ffdf36e861169b40af538e63aca891 *R/describe_prior.R a9f1c79b25785cf642a498765c727816 *R/diagnostic_draws.R d67abcfd8153706d15a3e408143153d0 *R/diagnostic_posterior.R 2ef8f63bb10102f5e1dd466c8c89e7a3 *R/distribution.R 571f4b443b199c2ef6eda1c05a4c1ef2 *R/effective_sample.R e0d15f8ac3c54f095509ab7e499381b8 *R/equivalence_test.R 7dcf53368a60159c77ff79d0b489e3b1 *R/estimate_density.R 1d9812d85fbe9a392e793c89576e9eee *R/eti.R 664066cab5b49256b7525927c87e1d50 *R/format.R e67f627e2824ea30295dad407c1c1c6e *R/hdi.R 5d0b547938e3688e1f6f7a3e6058ea6d *R/map_estimate.R 465826ada4abdc5795c9d06d6aa37591 *R/mcse.R 880ecebac4006f1fa2f28881ec009e16 *R/mediation.R 9a86d42ec6cbdd8b9c27027ae8a28f39 *R/model_to_priors.R a251b159734a21d5edd899113a9960c3 *R/overlap.R 543d72b748fe695502d65234a8d1e074 *R/p_direction.R a8706d57a6e94323106190f3ee2a8845 *R/p_map.R 89b544f41b9ae4123c59feedd3a11ef1 *R/p_rope.R d6998111b57af29195112e2a30552643 *R/p_significance.R 4250600edafe86595e4253dcc5ce4a46 *R/p_to_bf.R b515a37ad3c623deaef79be35b798307 *R/plot.R f3c2ccb25ca711d874370d6ac65cce63 *R/point_estimate.R 6c9b98c2075fc37630eeadb8ffffa34c *R/print.R c6a9e68d8b3f9e11db67c87e99211e62 *R/print.bayesfactor_models.R 62e897a55c3acdb0a06a0fa42a687f85 *R/print.equivalence_test.R 1bcea270139b446e8e6acdf3c781c219 *R/print.rope.R 773ee78fc044e415b0d3f56db549b22e *R/print_html.R af3ddc3bc4c1fcc7d67fb1bffab708ca *R/print_md.R b8b3d0de18279d44e61852508d7422a5 *R/reshape_iterations.R 14ab03188f789964e7f186542d7bf6f1 *R/rope.R 372b2d3fdb701affe2f3bac6c200102c *R/rope_range.R 41fbb3dad470aac239d18252302fda81 *R/sensitivity_to_prior.R b20902c86297850b0426cd9b45e0d85d *R/sexit.R befcbb125cc1cedc5a82d6ecddefef29 *R/sexit_thresholds.R 71304c9c714c78efe0a41c52578230d5 *R/si.R 2532e684356d2719bfe4817fc7879de9 *R/simulate_data.R 4f10f48b426bd5febe937eeae20409df *R/simulate_priors.R 0875623348cf213c96288b0dc30f1169 *R/simulate_simpson.R dd2e13015f0f12826aef8c4e93871f77 *R/spi.R 72efe3d4fea6af74a37fd9df828d1abf *R/unupdate.R 73aadb2df73a26b40d1c47e7d580cd80 *R/utils.R 16820c7eccda75f7c402a8b0fec9e620 *R/utils_bayesfactor.R 56f499e43c31efa43f6cd64af1c9428e *R/utils_check_collinearity.R 8117073ed9981ca4f4cc32780cbeffaf *R/utils_clean_stan_parameters.R ae06d66ba5784ec2553860c6f78b23f3 *R/utils_hdi_ci.R 506839f138e42454411368529c153561 *R/utils_posterior.R 4dcb76b763881abb1d43c993fd21e853 *R/utils_print_data_frame.R 2360db4a482586982ce758ddd79350a9 *R/weighted_posteriors.R 4533f523d6cb92676f1d7912e088e29b *R/zzz.R 10d213f413399e9044449a376a85cff3 *README.md 9ecb0bdfb906213cc54af05f9a8fb645 *build/partial.rdb 3d4560ff6c352ca940a5b131221b19d5 *build/vignette.rds 0ff3ea913147c5a1b14eb94d50333b98 *data/disgust.rdata c5cfd3e44877e6f8487a7d57c28dd0e2 *inst/CITATION 4bbd263b71091999fc97ff01b90d8953 *inst/WORDLIST 7342a6d63f4cc4501afc55be1d148740 *inst/doc/overview_of_vignettes.R d3047f8dd544e4791a13e4ede781199f *inst/doc/overview_of_vignettes.Rmd 0fc7c30724becb44d7363bfce3a337ad *inst/doc/overview_of_vignettes.html 261ba655620dfbd3001fa10238ff6d0e *man/area_under_curve.Rd 6860290cbdd452ec9f23f98ddf68fb99 *man/as.data.frame.density.Rd 3d348eff3f4bc590080a8cd696304d75 *man/as.numeric.p_direction.Rd 2e24dbda10116e16afc3a1ecead0b8e2 *man/bayesfactor.Rd 2d81bdec563ff4acafb83320d6a9cb38 *man/bayesfactor_inclusion.Rd d8dbf200c78d71f5de4289f06b54c360 *man/bayesfactor_models.Rd abc9686aa1a971f24983f387fddf788f *man/bayesfactor_parameters.Rd dc90c03f81239afd7b7ffff2fae8f30e *man/bayesfactor_restricted.Rd 5999335209addda65e250db62b1c9977 *man/bayestestR-package.Rd 0eb780fa472f146ca0ca5bc9fa213083 *man/bci.Rd 4de97402297ddaeced4bfabbcf8b8bde *man/bic_to_bf.Rd bff15644ddd81feb334a57077e4cd198 *man/check_prior.Rd e4877485ea3d636dbad45b4ce8b89f6e *man/ci.Rd ade20e470426dcac15633c0337c8aea4 *man/contr.equalprior.Rd fed834ae2ef12615ebacfd5beddcf38f *man/convert_bayesian_as_frequentist.Rd a6824e6d983b84d1d9fc49e5d63313aa *man/cwi.Rd 5b355471ecc29db1dffae4d85d9ed028 *man/density_at.Rd 2d438465347f656376eaf4626f38cf2c *man/describe_posterior.Rd 018067e4f1b532b2ee2a768f86584094 *man/describe_prior.Rd a9a25f4350af2047cf57930479d893a4 *man/diagnostic_draws.Rd 885f2c862d11bd5cd1eb13d7a2fe16e2 *man/diagnostic_posterior.Rd 933a334f0afcb213569e4ad5d3446e6e *man/disgust.Rd 96a78333a48f5f062fc36ef2466fb1ad *man/distribution.Rd 0b1d93b59d19425ddb3a0d40f38210c1 *man/dot-extract_priors_rstanarm.Rd e450b5ed09ce1a54bb53cf57a436a1a5 *man/dot-prior_new_location.Rd 1991efd66189082be157e0b5d706e148 *man/dot-select_nums.Rd f020fd509e11115a6119b46fa1a20b2e *man/effective_sample.Rd 4faf6b48584e5a87d84dbfef187e1dad *man/equivalence_test.Rd 7fc47c7b4568f6197c0cc02783174fe1 *man/estimate_density.Rd 83ee2ff5b9b25790bfdf3b48e6809ef1 *man/eti.Rd 27e0ea3ff40617aff2e5f74afd47970c *man/figures/logo.png 3fb0a39e4eef303730e5b3bcdb40fb38 *man/figures/unnamed-chunk-10-1.png 46f4dafb23fab7cd9274b70c818401c4 *man/figures/unnamed-chunk-12-1.png 23ef093130b2d6f9918a4191d90a0ce5 *man/figures/unnamed-chunk-14-1.png bf3bb55ba72a848986fe903c7b637a6c *man/figures/unnamed-chunk-16-1.png 9a8d21fb1aa6841c21ae79ef83baa5ad *man/figures/unnamed-chunk-7-1.png 31b53d9f4b67e667cad8655407337d6c *man/figures/unnamed-chunk-8-1.png e25a9ed0ec13a983ff0eac78f97cd02e *man/hdi.Rd 5cd187b5b3b9877af4880a8e84594bf4 *man/map_estimate.Rd 0a0ca29c4aef471865268c4f1566272c *man/mcse.Rd 70cd79bea11c69edceb009cc03db7900 *man/mediation.Rd 79d15a5bdc95a3d9861f7d70c438ac01 *man/model_to_priors.Rd 4d4617709255a7b19da590a89c0ededc *man/overlap.Rd 033f20dbbd8adb19298afaa149dd0847 *man/p_direction.Rd 77c19e4f5e3b80bb14489e37e586b527 *man/p_map.Rd e26c22167b16a733fdf5c8faa0ffa8f1 *man/p_rope.Rd 2f08e6b152dc939400e6f1a97fe82777 *man/p_significance.Rd e49f3d556075a5d1a48911d91cd4647e *man/p_to_bf.Rd cfd901e16ebdfb40af423676f40b673f *man/pd_to_p.Rd bedb9a9cd613de1b3e9fcd9e0dd10a5c *man/point_estimate.Rd efdfd4e3b26b1ea4f4d9f4e88387de8b *man/reexports.Rd f9baf506f3a47e5e259a7417091cbce2 *man/reshape_iterations.Rd 71e876fa03ffa7c4a3d507a744f79289 *man/rope.Rd 3f7c7bfdeb2eba84be8919d65893ac59 *man/rope_range.Rd a841aa6574807cce644795652f342a8b *man/sensitivity_to_prior.Rd aed3c961fdac62a01ad6425feb17f366 *man/sexit.Rd 206d7ffb87a03099009d1f9735a6b6d7 *man/sexit_thresholds.Rd 1d3a038155665c82dc5b39968a436f42 *man/si.Rd ec179c4a0325de79faf13744d5cb3737 *man/simulate_correlation.Rd d33c6ef25efb00a4bfcadb86921db72b *man/simulate_prior.Rd 75edf873b80d3ad0c322a0b3ac1071b3 *man/simulate_simpson.Rd 38aa4810dc6ec7aafba8623ad6303174 *man/spi.Rd b9581b70c34ef137c49531d8c8ba4072 *man/unupdate.Rd e9deca84ad542a13ff75061321335b3d *man/weighted_posteriors.Rd ed019fb28c42d301a471042302b2215d *tests/testthat.R 0e84b6d82ae0c55225f7b5606bc6ab10 *tests/testthat/helper.R 8e5d275d30f7822b9b4dba93527fddf0 *tests/testthat/test-BFBayesFactor.R a9cbb2928bdc3e39c85d40383e12f538 *tests/testthat/test-as.data.frame.density.R 0ce57d0c043ff51435557123abb362bd *tests/testthat/test-bayesfactor_models.R 5ba6507c40b75ed100d97ddb538b5ab9 *tests/testthat/test-bayesfactor_parameters.R 077031f36901d45428f91e05c024e261 *tests/testthat/test-bayesfactor_restricted.R 7345d07695ed2353ac64b8efe014fbfc *tests/testthat/test-blavaan.R d124fead927d100d76f6f815e6193501 *tests/testthat/test-brms.R e99c0277fe2ca999dc4195389192dd1e *tests/testthat/test-check_prior.R 0e5731199bd70abf3959a4b5fa905c5c *tests/testthat/test-ci.R 43dfdbc876dff66ea3914899c32f73c0 *tests/testthat/test-contr.R 8cfbb3b3a84cc76ad6fac4e191b705a7 *tests/testthat/test-density_at.R e6219c5bd24b161520b4a21e2ad449db *tests/testthat/test-describe_posterior.R 19319920df0458f035e195fc9802942a *tests/testthat/test-describe_prior.R 1b93414763a19e2e4d1c07d04240c799 *tests/testthat/test-different_models.R ed8c019fa0e88ef258102036899bf543 *tests/testthat/test-distributions.R 155ca1bd378bdb782f3898979d552875 *tests/testthat/test-effective_sample.R c682caf6c03880c4d4029de189650a46 *tests/testthat/test-emmGrid.R 2eaab582f44a50403a11d11b55d10861 *tests/testthat/test-estimate_density.R f406e8002aa06d116f0bc9ea77e434cf *tests/testthat/test-hdi.R 2e79d5272e245b453e4fcebbafad7f46 *tests/testthat/test-map_estimate.R 0b7105cb674357eb204fe98458f38678 *tests/testthat/test-overlap.R 706cbaf4b28e9c3a04f08329c08a4151 *tests/testthat/test-p_direction.R 89cd288de6ecd6a2b5f51d0af27ab1bf *tests/testthat/test-p_map.R ddae26ecb8cb46091df46a92a8f74edb *tests/testthat/test-p_significance.R 339b310dff63000e06b2f5a03836fb71 *tests/testthat/test-p_to_bf.R a7f7028b1ceb5fa0047c559317f4ed1b *tests/testthat/test-point_estimate.R f121cb3927a29cf5fc358b1c3b745434 *tests/testthat/test-posterior.R 7ddd7bb4693fde2c73752021e57e0cc6 *tests/testthat/test-rope.R f794f6330023e5da7bd7a6db16388c81 *tests/testthat/test-rope_range.R 0296c69cae7ecd48df7a6962d04f758d *tests/testthat/test-rstanarm.R 12996c266989a21a0d94bd57f249cf8a *tests/testthat/test-si.R aef26eaae2ee208af837cd7840f33c60 *tests/testthat/test-simulate_data.R 755dca6c1088356016fc2907229f6410 *tests/testthat/test-spi.R a4c5ad432858a87b6c4759469cb304c4 *tests/testthat/test-weighted_posteriors.R d3047f8dd544e4791a13e4ede781199f *vignettes/overview_of_vignettes.Rmd bayestestR/inst/0000755000176200001440000000000014413525306013357 5ustar liggesusersbayestestR/inst/doc/0000755000176200001440000000000014413525306014124 5ustar liggesusersbayestestR/inst/doc/overview_of_vignettes.R0000644000176200001440000000035514413525306020674 0ustar liggesusers## ----message=FALSE, warning=FALSE, include=FALSE------------------------------ library(knitr) knitr::opts_chunk$set( echo = TRUE, collapse = TRUE, warning = FALSE, message = FALSE, comment = "#>", eval = TRUE ) bayestestR/inst/doc/overview_of_vignettes.html0000644000176200001440000001622014413525306021435 0ustar liggesusers Overview of Vignettes

Overview of Vignettes

All package vignettes are available at https://easystats.github.io/bayestestR/.

Function Overview

bayestestR/inst/doc/overview_of_vignettes.Rmd0000644000176200001440000000410014276606714021217 0ustar liggesusers--- title: "Overview of Vignettes" output: rmarkdown::html_vignette: vignette: > %\VignetteIndexEntry{Overview of Vignettes} \usepackage[utf8]{inputenc} %\VignetteEngine{knitr::rmarkdown} editor_options: chunk_output_type: console --- ```{r message=FALSE, warning=FALSE, include=FALSE} library(knitr) knitr::opts_chunk$set( echo = TRUE, collapse = TRUE, warning = FALSE, message = FALSE, comment = "#>", eval = TRUE ) ``` All package vignettes are available at [https://easystats.github.io/bayestestR/](https://easystats.github.io/bayestestR/). ## Function Overview * [Function Reference](https://easystats.github.io/bayestestR/reference/index.html) ## Get Started * [Get Started with Bayesian Analysis](https://easystats.github.io/bayestestR/articles/bayestestR.html) ## Examples 1. [Initiation to Bayesian models](https://easystats.github.io/bayestestR/articles/example1.html) 2. [Confirmation of Bayesian skills](https://easystats.github.io/bayestestR/articles/example2.html) 3. [Become a Bayesian master](https://easystats.github.io/bayestestR/articles/example3.html) ## Articles * [Credible Intervals (CI))](https://easystats.github.io/bayestestR/articles/credible_interval.html) * [Region of Practical Equivalence (ROPE)](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html) * [Probability of Direction (pd)](https://easystats.github.io/bayestestR/articles/probability_of_direction.html) * [Bayes Factors](https://easystats.github.io/bayestestR/articles/bayes_factors.html) ## In-Depths * [Comparison of Point-Estimates](https://easystats.github.io/bayestestR/articles/web_only/indicesEstimationComparison.html) * [Indices of Effect Existence and Significance in the Bayesian Framework](https://www.frontiersin.org/articles/10.3389/fpsyg.2019.02767/full) * [Mediation Analysis using Bayesian Regression Models](https://easystats.github.io/bayestestR/articles/mediation.html) ## Guidelines * [Reporting Guidelines](https://easystats.github.io/bayestestR/articles/guidelines.html) bayestestR/inst/CITATION0000644000176200001440000000142214276606712014523 0ustar liggesusersbibentry( bibtype="Article", title="bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework.", author=c(person("Dominique", "Makowski"), person("Mattan S.", "Ben-Shachar"), person("Daniel", "Lüdecke")), journal="Journal of Open Source Software", doi="10.21105/joss.01541", year="2019", number = "40", volume = "4", pages = "1541", url="https://joss.theoj.org/papers/10.21105/joss.01541", textVersion = "Makowski, D., Ben-Shachar, M., & Lüdecke, D. (2019). bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework. Journal of Open Source Software, 4(40), 1541. doi:10.21105/joss.01541", mheader = "To cite bayestestR in publications use:" ) bayestestR/inst/WORDLIST0000644000176200001440000000360714407114241014552 0ustar liggesusersADE Altough ArXiv BCI BCa BFs BGGM BICs BMA BMJ Baws BayesFactor Bayesfactor Bergh Bridgesampling CMD CRC CWI Curvewise DOI DV Dablander DescTools Desimone DiCiccio Dom Driing ESS ETI Efron Etz Fernández Funder Gelman Ghosh Grasman Gronau's HDI HDInterval Haaf Hinne Hirose Imai Iverson JASP JASP's Jeffreys Kass Keele Kruschke Kuriyal Kurz's Ley Liao Liddell Lindley Littman Liu Lodewyckx Ly Makowski MCMCglmm MCSE MPE Mathot Mattan Matzke McElreath Midya Modelling Morey Multicollinearity ORCID Ozer Parmigiani Piironen Posteriori Preprint Psychonomic ROPE's ROPEs ROPE’s Raftery Rhat Rouder SEM SEXIT SHA SPI SPIn Shachar Speckman Tada Tingley Un Vandekerckhove Vehtari Versicolor Visualise Wagenmakers Wether Wetzels Wickham Wookies Yamamoto Ying Zheng al altough analsyes arXiv autocorrelated avaible bayesQR bayesian bcplm behavioural blogpost bmj bmwiernik bootsrapped brms brmsfit centred characterisation characterises ci columbia compte containe cplm curvewise doi driiiing eXistence easystats edu effectsize egydq emmeans et favour favouring fpsyg frac frequentis frequentist's fullrank generalised ggdist ggdistribute github grano higer https infty ing interpretability interpretable io iteratively jmp joss lavaan lentiful lifecycle lm maths mattansb mcmc modelling nbinom neq notin objets operationlizing orthonormal osterior patilindrajeets pre preprint priori ps psyarxiv rOpenSci reconceptualisation replicability reproducibility richarddmorey riors rmsb rstanarm sIgnificance salis setosa setosas splinefun ss stanfit stanreg statmodeling strengejacke summarise summarised th treedepth tweedie un underbrace versicolor versicolors virginica virgnica visualisation visualise warmup wil xy