├── vignettes ├── .gitignore ├── example3.Rmd ├── indicesExistenceComparison.Rmd └── overview_of_vignettes.Rmd ├── revdep ├── problems.md ├── data.sqlite ├── cran.md ├── README.md └── failures.md ├── .gitattributes ├── data └── disgust.rdata ├── .github ├── FUNDING.yml ├── ISSUE_TEMPLATE │ ├── question.md │ ├── feature-idea.md │ └── bug_report.md ├── PULL_REQUEST_TEMPLATE.md ├── dependabot.yaml ├── workflows │ ├── revdepcheck.yaml │ ├── check-styling.yaml │ ├── check-link-rot.yaml │ ├── check-spelling.yaml │ ├── pkgdown-no-suggests.yaml │ ├── check-random-test-order.yaml │ ├── check-test-warnings.yaml │ ├── update-to-latest-easystats.yaml │ ├── check-vignette-warnings.yaml │ ├── R-CMD-check-weekly.yaml │ ├── lint.yaml │ ├── html-5-check.yaml │ ├── test-coverage.yaml │ ├── lint-changed-files.yaml │ ├── test-coverage-examples.yaml │ ├── check-readme.yaml │ ├── pkgdown.yaml │ ├── R-CMD-check-main.yaml │ ├── R-CMD-check.yaml │ ├── check-all-examples.yaml │ ├── R-CMD-check-hard.yaml │ └── format-suggest.yaml ├── SUPPORT.md └── CONTRIBUTING.md ├── man ├── figures │ ├── JASP1.jpg │ ├── JASP2.jpg │ ├── JASP3.jpg │ ├── logo.png │ ├── watto.jpg │ ├── banner.png │ ├── YodaBayes.jpg │ ├── deathsticks.jpg │ ├── profsanders.jpg │ ├── LetsPokeAPizza.jpg │ ├── bayesianMaster.jpg │ ├── unnamed-chunk-7-1.png │ ├── unnamed-chunk-8-1.png │ ├── unnamed-chunk-10-1.png │ ├── unnamed-chunk-12-1.png │ ├── unnamed-chunk-14-1.png │ └── unnamed-chunk-16-1.png ├── dot-select_nums.Rd ├── dot-prior_new_location.Rd ├── dot-extract_priors_rstanarm.Rd ├── as.data.frame.density.Rd ├── reexports.Rd ├── as.numeric.p_direction.Rd ├── density_at.Rd ├── disgust.Rd ├── diagnostic_draws.Rd ├── model_to_priors.Rd ├── unupdate.Rd ├── bic_to_bf.Rd ├── overlap.Rd ├── describe_prior.Rd ├── reshape_iterations.Rd ├── simulate_simpson.Rd ├── sexit_thresholds.Rd ├── area_under_curve.Rd ├── convert_bayesian_as_frequentist.Rd ├── sensitivity_to_prior.Rd ├── pd_to_p.Rd ├── bayestestR-package.Rd ├── p_to_bf.Rd ├── simulate_correlation.Rd ├── display.describe_posterior.Rd ├── rope_range.Rd └── simulate_prior.Rd ├── tests ├── testthat.R └── testthat │ ├── test-as.data.frame.density.R │ ├── test-density_at.R │ ├── test-pd_to_p.R │ ├── _snaps │ ├── rope.md │ ├── equivalence_test.md │ └── windows │ │ └── print.md │ ├── helper.R │ ├── test-overlap.R │ ├── test-p_to_bf.R │ ├── test-print.R │ ├── test-p_rope.R │ ├── test-simulate_data.R │ ├── test-effective_sample.R │ ├── test-estimate_density.R │ ├── test-distributions.R │ ├── test-point_estimate.R │ ├── test-rope_range.R │ ├── test-equivalence_test.R │ ├── test-format.R │ ├── test-p_map.R │ ├── test-si.R │ ├── test-contr.R │ ├── test-ci.R │ ├── test-bayesfactor_restricted.R │ ├── test-spi.R │ ├── test-hdi.R │ ├── test-p_direction.R │ ├── test-bayesian_as_frequentist.R │ ├── test-map_estimate.R │ ├── test-weighted_posteriors.R │ ├── test-p_significance.R │ └── test-BFBayesFactor.R ├── paper ├── JOSS paper files │ ├── Figure1.png │ ├── Figure2.png │ ├── Figure3.png │ ├── Figure4.png │ ├── 10.21105.joss.01541.pdf │ ├── Figure4.R │ ├── Figure1.R │ └── Figure2.R └── paper_files │ └── figure-latex │ ├── unnamed-chunk-10-1.pdf │ ├── unnamed-chunk-14-1.pdf │ ├── unnamed-chunk-20-1.pdf │ ├── unnamed-chunk-35-1.pdf │ ├── unnamed-chunk-36-1.pdf │ ├── unnamed-chunk-39-1.pdf │ ├── unnamed-chunk-42-1.pdf │ └── unnamed-chunk-5-1.pdf ├── R ├── zzz.R ├── reexports.R ├── datasets.R ├── as.list.R ├── is_baysian_grid.R ├── utils_posterior.R ├── bayestestR-package.R ├── utils_clean_stan_parameters.R ├── bic_to_bf.R ├── print.bayesfactor_models.R ├── simulate_simpson.R ├── model_to_priors.R ├── diagnostic_draws.R ├── area_under_curve.R ├── print.equivalence_test.R ├── reshape_iterations.R ├── plot.R ├── overlap.R ├── utils_check_collinearity.R ├── utils_print_data_frame.R ├── mcse.R ├── utils_hdi_ci.R ├── print.rope.R ├── bayesfactor.R └── convert_pd_to_p.R ├── air.toml ├── cran-comments.md ├── bayestestR.code-workspace ├── bayestestR.Rproj ├── .lintr ├── inst ├── CITATION └── WORDLIST ├── .Rbuildignore ├── .gitignore ├── WIP └── cwi.R ├── _pkgdown.yml └── data-raw └── disgust.R /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | /.quarto/ 2 | -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /data/disgust.rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/data/disgust.rdata -------------------------------------------------------------------------------- /revdep/data.sqlite: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/revdep/data.sqlite -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: easystats 4 | -------------------------------------------------------------------------------- /man/figures/JASP1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/JASP1.jpg -------------------------------------------------------------------------------- /man/figures/JASP2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/JASP2.jpg -------------------------------------------------------------------------------- /man/figures/JASP3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/JASP3.jpg -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/watto.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/watto.jpg -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(bayestestR) 3 | 4 | test_check("bayestestR") 5 | -------------------------------------------------------------------------------- /man/figures/banner.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/banner.png -------------------------------------------------------------------------------- /man/figures/YodaBayes.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/YodaBayes.jpg -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | Maintainance release. Also required for the upcoming release of the 'parameters' package. 2 | -------------------------------------------------------------------------------- /man/figures/deathsticks.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/deathsticks.jpg -------------------------------------------------------------------------------- /man/figures/profsanders.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/profsanders.jpg -------------------------------------------------------------------------------- /man/figures/LetsPokeAPizza.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/LetsPokeAPizza.jpg -------------------------------------------------------------------------------- /man/figures/bayesianMaster.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/bayesianMaster.jpg -------------------------------------------------------------------------------- /man/figures/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /man/figures/unnamed-chunk-8-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/unnamed-chunk-8-1.png -------------------------------------------------------------------------------- /man/figures/unnamed-chunk-10-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/unnamed-chunk-10-1.png -------------------------------------------------------------------------------- /man/figures/unnamed-chunk-12-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/unnamed-chunk-12-1.png -------------------------------------------------------------------------------- /man/figures/unnamed-chunk-14-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/unnamed-chunk-14-1.png -------------------------------------------------------------------------------- /man/figures/unnamed-chunk-16-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/man/figures/unnamed-chunk-16-1.png -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/JOSS paper files/Figure1.png -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/JOSS paper files/Figure2.png -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/JOSS paper files/Figure3.png -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/JOSS paper files/Figure4.png -------------------------------------------------------------------------------- /paper/JOSS paper files/10.21105.joss.01541.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/JOSS paper files/10.21105.joss.01541.pdf -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/question.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Question 3 | about: You didn't understand something? 4 | 5 | --- 6 | 7 | **Question and context** 8 | -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-10-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-10-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-14-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-14-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-20-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-20-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-35-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-35-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-36-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-36-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-39-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-39-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-42-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-42-1.pdf -------------------------------------------------------------------------------- /paper/paper_files/figure-latex/unnamed-chunk-5-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/bayestestR/HEAD/paper/paper_files/figure-latex/unnamed-chunk-5-1.pdf -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | # Description 2 | 3 | This PR aims at adding this feature... 4 | 5 | # Proposed Changes 6 | 7 | I changed the `foo` function so that ... 8 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname) { 2 | if (format(Sys.time(), "%m%d") == "0504") { 3 | packageStartupMessage("May the fourth be with you!") 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /tests/testthat/test-as.data.frame.density.R: -------------------------------------------------------------------------------- 1 | test_that("as.data.frame.density", { 2 | expect_s3_class(as.data.frame(density(distribution_normal(1000))), "data.frame") 3 | }) 4 | -------------------------------------------------------------------------------- /air.toml: -------------------------------------------------------------------------------- 1 | [format] 2 | line-width = 90 3 | indent-width = 2 4 | indent-style = "space" 5 | line-ending = "auto" 6 | persistent-line-breaks = true 7 | exclude = [] 8 | default-exclude = true 9 | -------------------------------------------------------------------------------- /.github/dependabot.yaml: -------------------------------------------------------------------------------- 1 | version: 2 2 | 3 | updates: 4 | # Keep dependencies for GitHub Actions up-to-date 5 | - package-ecosystem: "github-actions" 6 | directory: "/" 7 | schedule: 8 | interval: "weekly" 9 | -------------------------------------------------------------------------------- /.github/workflows/revdepcheck.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [main, master] 4 | 5 | name: revdepcheck 6 | 7 | jobs: 8 | revdepcheck: 9 | uses: easystats/workflows/.github/workflows/revdepcheck.yaml@main 10 | -------------------------------------------------------------------------------- /.github/workflows/check-styling.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [main, master] 4 | 5 | name: check-styling 6 | 7 | jobs: 8 | check-styling: 9 | uses: easystats/workflows/.github/workflows/check-styling.yaml@main 10 | -------------------------------------------------------------------------------- /tests/testthat/test-density_at.R: -------------------------------------------------------------------------------- 1 | test_that("density_at", { 2 | expect_equal(density_at(distribution_normal(1000), 0), 0.389, tolerance = 0.1) 3 | expect_equal(density_at(distribution_normal(1000), c(0, 1))[1], 0.389, tolerance = 0.1) 4 | }) 5 | -------------------------------------------------------------------------------- /.github/workflows/check-link-rot.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [main, master] 4 | 5 | name: check-link-rot 6 | 7 | jobs: 8 | check-link-rot: 9 | uses: easystats/workflows/.github/workflows/check-link-rot.yaml@main 10 | -------------------------------------------------------------------------------- /.github/workflows/check-spelling.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [main, master] 4 | 5 | name: check-spelling 6 | 7 | jobs: 8 | check-spelling: 9 | uses: easystats/workflows/.github/workflows/check-spelling.yaml@main 10 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown-no-suggests.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [main, master] 4 | 5 | name: pkgdown-no-suggests 6 | 7 | jobs: 8 | pkgdown-no-suggests: 9 | uses: easystats/workflows/.github/workflows/pkgdown-no-suggests.yaml@main 10 | -------------------------------------------------------------------------------- /tests/testthat/test-pd_to_p.R: -------------------------------------------------------------------------------- 1 | test_that("pd_to_p", { 2 | pds <- c(0.7, 0.95, 0.99, 0.5) 3 | expect_equal(pd_to_p(pds), c(0.6, 0.1, 0.02, 1)) 4 | expect_equal(pd_to_p(pds, direction = 1), c(0.3, 0.05, 0.01, 0.5)) 5 | 6 | expect_warning(p <- pd_to_p(0.3), "0.5") 7 | expect_equal(p, 1) 8 | }) 9 | -------------------------------------------------------------------------------- /.github/workflows/check-random-test-order.yaml: -------------------------------------------------------------------------------- 1 | # Run tests in random order 2 | on: 3 | pull_request: 4 | branches: [main, master] 5 | 6 | name: check-random-test-order 7 | 8 | jobs: 9 | check-random-test-order: 10 | uses: easystats/workflows/.github/workflows/check-random-test-order.yaml@main 11 | -------------------------------------------------------------------------------- /man/dot-select_nums.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{.select_nums} 4 | \alias{.select_nums} 5 | \title{select numerics columns} 6 | \usage{ 7 | .select_nums(x) 8 | } 9 | \description{ 10 | select numerics columns 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature-idea.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature idea 3 | about: Suggest an idea for this project 4 | 5 | --- 6 | 7 | **Describe the solution you'd like** 8 | A clear and concise description of what you want to happen. 9 | 10 | **How could we do it?** 11 | A description of actual ways of implementing a feature. 12 | -------------------------------------------------------------------------------- /.github/workflows/check-test-warnings.yaml: -------------------------------------------------------------------------------- 1 | # Running tests with options(warn = 2) to fail on test warnings 2 | on: 3 | pull_request: 4 | branches: [main, master] 5 | 6 | name: check-test-warnings 7 | 8 | jobs: 9 | check-test-warnings: 10 | uses: easystats/workflows/.github/workflows/check-test-warnings.yaml@main 11 | -------------------------------------------------------------------------------- /.github/workflows/update-to-latest-easystats.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | schedule: 3 | # Check for dependency updates once a month 4 | - cron: "0 0 1 * *" 5 | 6 | name: update-to-latest-easystats 7 | 8 | jobs: 9 | update-to-latest-easystats: 10 | uses: easystats/workflows/.github/workflows/update-to-latest-easystats.yaml@main 11 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/rope.md: -------------------------------------------------------------------------------- 1 | # rope, vector 2 | 3 | Code 4 | print(out) 5 | Output 6 | # Proportion of samples inside the ROPE [-0.10, 0.10]: 7 | 8 | Inside ROPE | Above ROPE | Below ROPE 9 | ------------------------------------- 10 | 1.53 % | 49.68 % | 48.79 % 11 | 12 | 13 | -------------------------------------------------------------------------------- /.github/workflows/check-vignette-warnings.yaml: -------------------------------------------------------------------------------- 1 | # Running tests with options(warn = 2) to fail on test warnings 2 | on: 3 | pull_request: 4 | branches: [main, master] 5 | 6 | name: check-vignette-warnings 7 | 8 | jobs: 9 | check-vignette-warnings: 10 | uses: easystats/workflows/.github/workflows/check-vignette-warnings.yaml@main 11 | -------------------------------------------------------------------------------- /R/reexports.R: -------------------------------------------------------------------------------- 1 | # DO NOT REMOVE 2 | # Re-exported generics for which the current package defines S3 methods 3 | 4 | #' @importFrom insight print_html 5 | #' @export 6 | insight::print_html 7 | 8 | #' @importFrom insight print_md 9 | #' @export 10 | insight::print_md 11 | 12 | #' @importFrom insight display 13 | #' @export 14 | insight::display 15 | -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | skip_if_not_or_load_if_installed <- function(package, minimum_version = NULL) { 2 | testthat::skip_if_not_installed(package, minimum_version = minimum_version) 3 | suppressMessages(suppressWarnings(suppressPackageStartupMessages( 4 | require(package, warn.conflicts = FALSE, character.only = TRUE, quietly = TRUE) 5 | ))) 6 | } 7 | -------------------------------------------------------------------------------- /tests/testthat/test-overlap.R: -------------------------------------------------------------------------------- 1 | test_that("overlap", { 2 | set.seed(333) 3 | x <- distribution_normal(1000, 2, 0.5) 4 | y <- distribution_normal(1000, 0, 1) 5 | 6 | expect_equal(as.numeric(overlap(x, y)), 0.185, tolerance = 0.01) 7 | out <- capture.output(print(overlap(x, y))) 8 | expect_identical(out, c("# Overlap", "", "18.6%")) 9 | }) 10 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check-weekly.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | schedule: 3 | # * is a special character in YAML so you have to quote this string 4 | # Trigger once a week at 00:00 on Sunday 5 | - cron: "0 0 * * SUN" 6 | 7 | name: R-CMD-check-weekly 8 | 9 | jobs: 10 | R-CMD-check: 11 | uses: easystats/workflows/.github/workflows/R-CMD-check-main.yaml@main 12 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 22 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 1 packages 7 | 8 | Issues with CRAN packages are summarised below. 9 | 10 | ### Failed to check 11 | 12 | * snSMART (NA) 13 | Reason: JAGS was not installed. -------------------------------------------------------------------------------- /.github/workflows/lint.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: lint 8 | 9 | jobs: 10 | lint: 11 | uses: easystats/workflows/.github/workflows/lint.yaml@main 12 | -------------------------------------------------------------------------------- /bayestestR.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | } 6 | ], 7 | "launch": { 8 | "version": "0.2.0", 9 | "configurations": [ 10 | { 11 | "type": "R-Debugger", 12 | "name": "Launch R-Workspace", 13 | "request": "launch", 14 | "debugMode": "workspace", 15 | "workingDirectory": "" 16 | } 17 | ] 18 | } 19 | } -------------------------------------------------------------------------------- /man/dot-prior_new_location.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sensitivity_to_prior.R 3 | \name{.prior_new_location} 4 | \alias{.prior_new_location} 5 | \title{Set a new location for a prior} 6 | \usage{ 7 | .prior_new_location(prior, sign, magnitude = 10) 8 | } 9 | \description{ 10 | Set a new location for a prior 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /.github/workflows/html-5-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: html-5-check 8 | 9 | jobs: 10 | html-5-check: 11 | uses: easystats/workflows/.github/workflows/html-5-check.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: test-coverage 8 | 9 | jobs: 10 | test-coverage: 11 | uses: easystats/workflows/.github/workflows/test-coverage.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/lint-changed-files.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: lint-changed-files 8 | 9 | jobs: 10 | lint-changed-files: 11 | uses: easystats/workflows/.github/workflows/lint-changed-files.yaml@main 12 | -------------------------------------------------------------------------------- /man/dot-extract_priors_rstanarm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sensitivity_to_prior.R 3 | \name{.extract_priors_rstanarm} 4 | \alias{.extract_priors_rstanarm} 5 | \title{Extract and Returns the priors formatted for rstanarm} 6 | \usage{ 7 | .extract_priors_rstanarm(model, ...) 8 | } 9 | \description{ 10 | Extract and Returns the priors formatted for rstanarm 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage-examples.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: test-coverage-examples 8 | 9 | jobs: 10 | test-coverage-examples: 11 | uses: easystats/workflows/.github/workflows/test-coverage-examples.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/check-readme.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | 4 | on: 5 | push: 6 | branches: [main, master] 7 | pull_request: 8 | branches: [main, master] 9 | 10 | name: check-readme 11 | 12 | jobs: 13 | check-readme: 14 | uses: easystats/workflows/.github/workflows/check-readme.yaml@main 15 | -------------------------------------------------------------------------------- /man/as.data.frame.density.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/estimate_density.R 3 | \name{as.data.frame.density} 4 | \alias{as.data.frame.density} 5 | \title{Coerce to a Data Frame} 6 | \usage{ 7 | \method{as.data.frame}{density}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{any \R object.} 11 | 12 | \item{...}{additional arguments to be passed to or from methods.} 13 | } 14 | \description{ 15 | Coerce to a Data Frame 16 | } 17 | -------------------------------------------------------------------------------- /tests/testthat/test-p_to_bf.R: -------------------------------------------------------------------------------- 1 | test_that("p_to_bf works", { 2 | skip_if_not_or_load_if_installed("parameters") 3 | 4 | m <- lm(mpg ~ hp + cyl + am, data = mtcars) 5 | p <- coef(summary(m))[-1, 4] 6 | 7 | # BF by hand 8 | bfs <- 3 * p * sqrt(insight::n_obs(m)) 9 | 10 | expect_equal(p_to_bf(m, log = FALSE)[-1, ]$BF, exp(-log(bfs)), tolerance = 1e-4, ignore_attr = TRUE) 11 | expect_equal(p_to_bf(m, log = TRUE)[-1, ]$log_BF, -log(bfs), tolerance = 1e-4, ignore_attr = TRUE) 12 | }) 13 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | uses: easystats/workflows/.github/workflows/pkgdown.yaml@main 17 | -------------------------------------------------------------------------------- /tests/testthat/test-print.R: -------------------------------------------------------------------------------- 1 | test_that("print.describe_posterior", { 2 | skip_on_cran() 3 | skip_if_not_installed("curl") 4 | skip_if_offline() 5 | skip_if_not_installed("httr2") 6 | skip_if_not_or_load_if_installed("brms") 7 | 8 | m <- insight::download_model("brms_zi_3") 9 | skip_if(is.null(m)) 10 | expect_snapshot(describe_posterior(m, verbose = FALSE), variant = "windows") 11 | expect_snapshot(describe_posterior(m, effects = "all", component = "all", verbose = FALSE), variant = "windows") 12 | }) 13 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check-main.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | 11 | name: R-CMD-check 12 | 13 | jobs: 14 | R-CMD-check: 15 | uses: easystats/workflows/.github/workflows/R-CMD-check-main.yaml@main 16 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | pull_request: 9 | branches: [main, master] 10 | 11 | name: R-CMD-check 12 | 13 | jobs: 14 | R-CMD-check: 15 | uses: easystats/workflows/.github/workflows/R-CMD-check.yaml@main 16 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reexports.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{print_html} 7 | \alias{print_md} 8 | \alias{display} 9 | \title{Objects exported from other packages} 10 | \keyword{internal} 11 | \description{ 12 | These objects are imported from other packages. Follow the links 13 | below to see their documentation. 14 | 15 | \describe{ 16 | \item{insight}{\code{\link[insight]{display}}, \code{\link[insight:display]{print_html}}, \code{\link[insight:display]{print_md}}} 17 | }} 18 | 19 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | 5 | --- 6 | 7 | **Describe the bug** 8 | A description of what the bug is. 9 | 10 | **To Reproduce** 11 | Steps to reproduce the behaviour: 12 | 1. Go to '...' 13 | 2. Click on '....' 14 | 3. Scroll down to '....' 15 | 4. See error 16 | 17 | **Expected behaviour** 18 | A clear and concise description of what you expected to happen. 19 | 20 | **Screenshots** 21 | If applicable, add screenshots to help explain your problem. 22 | 23 | **Specifiations (please complete the following information):** 24 | - Package Version [e.g. 0.2.1] 25 | -------------------------------------------------------------------------------- /bayestestR.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: e3e3f8bd-9307-422e-94ac-03ac7fc7ad5c 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: No 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --with-keep.source 21 | PackageBuildArgs: --compact-vignettes=both 22 | PackageCheckArgs: --as-cran --run-donttest 23 | PackageRoxygenize: rd,collate,namespace 24 | 25 | QuitChildProcessesOnExit: Yes 26 | DisableExecuteRprofile: Yes 27 | -------------------------------------------------------------------------------- /.github/workflows/check-all-examples.yaml: -------------------------------------------------------------------------------- 1 | # Make sure all examples run successfully, even the ones that are not supposed 2 | # to be run or tested on CRAN machines by default. 3 | # 4 | # The examples that fail should use 5 | # - `if (FALSE) { ... }` (if example is included only for illustrative purposes) 6 | # - `try({ ... })` (if the intent is to show the error) 7 | # 8 | # This workflow helps find such failing examples that need to be modified. 9 | on: 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: check-all-examples 14 | 15 | jobs: 16 | check-all-examples: 17 | uses: easystats/workflows/.github/workflows/check-all-examples.yaml@main 18 | -------------------------------------------------------------------------------- /tests/testthat/test-p_rope.R: -------------------------------------------------------------------------------- 1 | test_that("p_rope", { 2 | skip_if_not_installed("curl") 3 | skip_if_offline() 4 | skip_if_not_installed("httr2") 5 | skip_if_not_or_load_if_installed("rstanarm") 6 | m <- insight::download_model("stanreg_merMod_5") 7 | expect_equal( 8 | p_rope(as.data.frame(m)[2:4], range = list(c(0, 40), "default", c(-1, 0.8)))$p_ROPE, 9 | c(0.598, 0.002, 0.396), 10 | tolerance = 1e-3 11 | ) 12 | 13 | expect_error( 14 | p_rope(as.data.frame(m)[2:4], range = list(c(0, 40), c(-1, 0.8))), 15 | regex = "Length of" 16 | ) 17 | expect_error( 18 | p_rope(as.data.frame(m)[2:4], range = list(c(0, 40), "a", c(-1, 0.8))), 19 | regex = "should be 'default'" 20 | ) 21 | }) 22 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: linters_with_defaults( 2 | absolute_path_linter = NULL, 3 | commented_code_linter = NULL, 4 | cyclocomp_linter = cyclocomp_linter(25), 5 | extraction_operator_linter = NULL, 6 | implicit_integer_linter = NULL, 7 | line_length_linter(120), 8 | namespace_linter = NULL, 9 | nonportable_path_linter = NULL, 10 | object_name_linter = NULL, 11 | object_length_linter(50), 12 | object_usage_linter = NULL, 13 | todo_comment_linter = NULL, 14 | undesirable_function_linter(c("mapply" = NA, "sapply" = NA, "setwd" = NA)), 15 | unnecessary_concatenation_linter(allow_single_expression = FALSE), 16 | undesirable_operator_linter = NULL, 17 | defaults = linters_with_tags(tags = NULL) 18 | ) 19 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check-hard.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow only directly installs "hard" dependencies, i.e. Depends, 5 | # Imports, and LinkingTo dependencies. Notably, Suggests dependencies are never 6 | # installed, with the exception of testthat, knitr, and rmarkdown. The cache is 7 | # never used to avoid accidentally restoring a cache containing a suggested 8 | # dependency. 9 | on: 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check-hard 14 | 15 | jobs: 16 | R-CMD-check-hard: 17 | uses: easystats/workflows/.github/workflows/R-CMD-check-hard.yaml@main 18 | -------------------------------------------------------------------------------- /man/as.numeric.p_direction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/map_estimate.R, R/p_direction.R, R/p_map.R, 3 | % R/p_significance.R 4 | \name{as.numeric.map_estimate} 5 | \alias{as.numeric.map_estimate} 6 | \alias{as.numeric.p_direction} 7 | \alias{as.numeric.p_map} 8 | \alias{as.numeric.p_significance} 9 | \title{Convert to Numeric} 10 | \usage{ 11 | \method{as.numeric}{map_estimate}(x, ...) 12 | 13 | \method{as.numeric}{p_direction}(x, ...) 14 | 15 | \method{as.numeric}{p_map}(x, ...) 16 | 17 | \method{as.numeric}{p_significance}(x, ...) 18 | } 19 | \arguments{ 20 | \item{x}{object to be coerced or tested.} 21 | 22 | \item{...}{further arguments passed to or from other methods.} 23 | } 24 | \description{ 25 | Convert to Numeric 26 | } 27 | -------------------------------------------------------------------------------- /R/datasets.R: -------------------------------------------------------------------------------- 1 | #' Moral Disgust Judgment 2 | #' 3 | #' A sample (simulated) dataset, used in tests and some examples. 4 | #' 5 | #' @author Richard D. Morey 6 | #' 7 | #' @docType data 8 | #' 9 | #' @name disgust 10 | #' 11 | #' @keywords data 12 | #' 13 | #' @format A data frame with 500 rows and 5 variables: 14 | #' \describe{ 15 | #' \item{score}{Score on the questionnaire, which ranges from 0 to 50 with higher scores representing harsher moral judgment} 16 | #' \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} 17 | #' } 18 | #' 19 | #' ```{r} 20 | #' data("disgust") 21 | #' head(disgust, n = 5) 22 | #' ```` 23 | #' 24 | NULL 25 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry( 2 | bibtype="Article", 3 | title="bayestestR: Describing Effects and their Uncertainty, Existence and Significance within the Bayesian Framework.", 4 | author=c(person("Dominique", "Makowski"), person("Mattan S.", "Ben-Shachar"), person("Daniel", "Lüdecke")), 5 | journal="Journal of Open Source Software", 6 | doi="10.21105/joss.01541", 7 | year="2019", 8 | number = "40", 9 | volume = "4", 10 | pages = "1541", 11 | url="https://joss.theoj.org/papers/10.21105/joss.01541", 12 | 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", 13 | mheader = "To cite bayestestR in publications use:" 14 | ) 15 | -------------------------------------------------------------------------------- /R/as.list.R: -------------------------------------------------------------------------------- 1 | # as.list ----------------------------------------------------------------- 2 | 3 | #' @export 4 | as.list.bayestestR_hdi <- function(x, ...) { 5 | if (nrow(x) == 1) { 6 | out <- list(CI = x$CI, CI_low = x$CI_low, CI_high = x$CI_high) 7 | out$Parameter <- x$Parameter 8 | } else { 9 | out <- list() 10 | for (param in x$Parameter) { 11 | out[[param]] <- list() 12 | out[[param]][["CI"]] <- x[x$Parameter == param, "CI"] 13 | out[[param]][["CI_low"]] <- x[x$Parameter == param, "CI_low"] 14 | out[[param]][["CI_high"]] <- x[x$Parameter == param, "CI_high"] 15 | } 16 | } 17 | out 18 | } 19 | 20 | #' @export 21 | as.list.bayestestR_eti <- as.list.bayestestR_hdi 22 | 23 | #' @export 24 | as.list.bayestestR_si <- as.list.bayestestR_hdi 25 | 26 | #' @export 27 | as.list.bayestestR_ci <- as.list.bayestestR_hdi 28 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\.Rprofile$ 2 | ^\.github 3 | ^\.github$ 4 | ^.*\.Rproj$ 5 | ^\.Rproj\.user$ 6 | ^\_pkgdown.yml 7 | 8 | ^LICENSE 9 | ^README.Rmd 10 | ^paper.*$ 11 | ^WIP$ 12 | ^.*\.tex$ 13 | ^cran-comments\.md$ 14 | ^\cache$ 15 | ^doc$ 16 | ^revdep$ 17 | publication/* 18 | ^_pkgdown\.yml$ 19 | ^_pkgdown\.yaml$ 20 | ^CRAN-RELEASE$ 21 | tests\^spelling 22 | ^LICENSE\.md$ 23 | \.code-workspace$ 24 | \.lintr$ 25 | ^CRAN-SUBMISSION$ 26 | ^data-raw$ 27 | ^tests/testthat/_snaps/. 28 | 29 | ^man/figures/JASP. 30 | ^man/figures/b. 31 | ^man/figures/d. 32 | ^man/figures/p. 33 | ^man/figures/Lets. 34 | ^man/figures/watto. 35 | ^man/figures/Yoda. 36 | 37 | ^vignettes/2019_frontiers/. 38 | ^vignettes/a. 39 | ^vignettes/b. 40 | ^vignettes/c. 41 | ^vignettes/d. 42 | ^vignettes/e. 43 | ^vignettes/g. 44 | ^vignettes/i. 45 | ^vignettes/m. 46 | ^vignettes/p. 47 | ^vignettes/r. 48 | ^vignettes/web_only 49 | -------------------------------------------------------------------------------- /R/is_baysian_grid.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .is_baysian_grid <- function(x) { 3 | UseMethod(".is_baysian_grid") 4 | } 5 | 6 | 7 | #' @keywords internal 8 | .is_baysian_grid.emmGrid <- function(x) { 9 | if (inherits(x, "emm_list")) { 10 | x <- x[[1]] 11 | } 12 | post.beta <- methods::slot(x, "post.beta") 13 | !(all(dim(post.beta) == 1) && is.na(post.beta)) 14 | } 15 | 16 | 17 | #' @keywords internal 18 | .is_baysian_grid.emm_list <- .is_baysian_grid.emmGrid 19 | 20 | 21 | #' @keywords internal 22 | .is_baysian_grid.slopes <- function(x) { 23 | insight::check_if_installed("marginaleffects", minimum_version = "0.29.0") 24 | !is.null(suppressWarnings(marginaleffects::get_draws(x, "PxD"))) 25 | } 26 | 27 | 28 | #' @keywords internal 29 | .is_baysian_grid.predictions <- .is_baysian_grid.slopes 30 | 31 | 32 | #' @keywords internal 33 | .is_baysian_grid.comparisons <- .is_baysian_grid.slopes 34 | -------------------------------------------------------------------------------- /tests/testthat/test-simulate_data.R: -------------------------------------------------------------------------------- 1 | skip_if_not_installed("MASS") 2 | 3 | test_that("simulate_correlation", { 4 | set.seed(333) 5 | data <- simulate_correlation(r = 0.5, n = 50) 6 | expect_equal(as.numeric(cor.test(data$V1, data$V2)$estimate), 0.5, tolerance = 0.001) 7 | 8 | data <- simulate_correlation(r = 0.5, n = 50, mean = c(0, 1), sd = c(0.7, 1.7)) 9 | expect_equal(as.numeric(cor.test(data$V1, data$V2)$estimate), 0.5, tolerance = 0.001) 10 | expect_equal(c(mean(data$V1), sd(data$V1)), c(0, 0.7), tolerance = 0.001) 11 | expect_equal(c(mean(data$V2), sd(data$V2)), c(1, 1.7), tolerance = 0.001) 12 | 13 | cor_matrix <- matrix( 14 | c( 15 | 1.0, 0.2, 0.4, 16 | 0.2, 1.0, 0.3, 17 | 0.4, 0.3, 1.0 18 | ), 19 | nrow = 3 20 | ) 21 | 22 | data <- simulate_correlation(r = cor_matrix) 23 | 24 | expect_equal(matrix(cor(data), nrow = 3), cor_matrix, tolerance = 0.001) 25 | }) 26 | -------------------------------------------------------------------------------- /R/utils_posterior.R: -------------------------------------------------------------------------------- 1 | # helper ------------------------------ 2 | 3 | 4 | .posterior_draws_to_df <- function(x) { 5 | UseMethod(".posterior_draws_to_df") 6 | } 7 | 8 | .posterior_draws_to_df.default <- function(x) { 9 | insight::format_error(paste0("Objects of class `%s` are not yet supported.", class(x)[1])) 10 | } 11 | 12 | .posterior_draws_to_df.data.frame <- function(x) { 13 | x 14 | } 15 | 16 | .posterior_draws_to_df.draws_df <- function(x) { 17 | insight::check_if_installed("posterior") 18 | datawizard::data_remove(as.data.frame(posterior::as_draws_df(x)), c(".chain", ".iteration", ".draw")) 19 | } 20 | 21 | .posterior_draws_to_df.draws_matrix <- .posterior_draws_to_df.draws_df 22 | 23 | .posterior_draws_to_df.draws_array <- .posterior_draws_to_df.draws_df 24 | 25 | .posterior_draws_to_df.draws_list <- .posterior_draws_to_df.draws_df 26 | 27 | .posterior_draws_to_df.draws_rvars <- .posterior_draws_to_df.draws_df 28 | 29 | .posterior_draws_to_df.rvar <- .posterior_draws_to_df.draws_df 30 | -------------------------------------------------------------------------------- /R/bayestestR-package.R: -------------------------------------------------------------------------------- 1 | #' \code{bayestestR} 2 | #' 3 | #' @title bayestestR: Describing Effects and their Uncertainty, Existence and 4 | #' Significance within the Bayesian Framework 5 | #' 6 | #' @description 7 | #' 8 | #' Existing R packages allow users to easily fit a large variety of models 9 | #' and extract and visualize the posterior draws. However, most of these 10 | #' packages only return a limited set of indices (e.g., point-estimates and 11 | #' CIs). **bayestestR** provides a comprehensive and consistent set of 12 | #' functions to analyze and describe posterior distributions generated by a 13 | #' variety of models objects, including popular modeling packages such as 14 | #' **rstanarm**, **brms** or **BayesFactor**. 15 | #' 16 | #' References: 17 | #' 18 | #' - Makowski et al. (2019) \doi{10.21105/joss.01541} 19 | #' - Makowski et al. (2019) \doi{10.3389/fpsyg.2019.02767} 20 | #' 21 | #' @docType package 22 | #' @aliases bayestestR bayestestR-package 23 | #' @name bayestestR-package 24 | #' @keywords internal 25 | "_PACKAGE" 26 | -------------------------------------------------------------------------------- /man/density_at.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/estimate_density.R 3 | \name{density_at} 4 | \alias{density_at} 5 | \title{Density Probability at a Given Value} 6 | \usage{ 7 | density_at(posterior, x, precision = 2^10, method = "kernel", ...) 8 | } 9 | \arguments{ 10 | \item{posterior}{Vector representing a posterior distribution.} 11 | 12 | \item{x}{The value of which to get the approximate probability.} 13 | 14 | \item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.} 15 | 16 | \item{method}{Density estimation method. Can be \code{"kernel"} (default), \code{"logspline"} 17 | or \code{"KernSmooth"}.} 18 | 19 | \item{...}{Currently not used.} 20 | } 21 | \description{ 22 | Compute the density value at a given point of a distribution (i.e., 23 | the value of the \code{y} axis of a value \code{x} of a distribution). 24 | } 25 | \examples{ 26 | library(bayestestR) 27 | posterior <- distribution_normal(n = 10) 28 | density_at(posterior, 0) 29 | density_at(posterior, c(0, 1)) 30 | } 31 | -------------------------------------------------------------------------------- /man/disgust.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/datasets.R 3 | \docType{data} 4 | \name{disgust} 5 | \alias{disgust} 6 | \title{Moral Disgust Judgment} 7 | \format{ 8 | A data frame with 500 rows and 5 variables: 9 | \describe{ 10 | \item{score}{Score on the questionnaire, which ranges from 0 to 50 with higher scores representing harsher moral judgment} 11 | \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} 12 | } 13 | 14 | \if{html}{\out{
}}\preformatted{data("disgust") 15 | head(disgust, n = 5) 16 | #> score condition 17 | #> 1 13 control 18 | #> 2 26 control 19 | #> 3 30 control 20 | #> 4 23 control 21 | #> 5 34 control 22 | }\if{html}{\out{
}} 23 | } 24 | \description{ 25 | A sample (simulated) dataset, used in tests and some examples. 26 | } 27 | \author{ 28 | Richard D. Morey 29 | } 30 | \keyword{data} 31 | -------------------------------------------------------------------------------- /R/utils_clean_stan_parameters.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .clean_up_tmp_stanreg <- function(tmp, group, cols, parms) { 3 | tmp$Group <- group 4 | tmp$Parameter <- rep(parms, each = nrow(tmp) / length(parms)) 5 | rownames(tmp) <- NULL 6 | tmp <- tmp[, c("Parameter", cols)] 7 | # clean random effects notation from parameters 8 | # tmp$Parameter <- gsub("b\\[(.*) (.*)\\]", "\\2", tmp$Parameter) 9 | tmp 10 | } 11 | 12 | 13 | #' @keywords internal 14 | .clean_up_tmp_brms <- function(tmp, group, component, cols, parms) { 15 | tmp$Group <- group 16 | tmp$Component <- component 17 | tmp$Parameter <- rep(parms, each = nrow(tmp) / length(parms)) 18 | rownames(tmp) <- NULL 19 | tmp <- tmp[, c("Parameter", cols)] 20 | # clean random effects notation from parameters 21 | # tmp$Parameter <- gsub("r_(.*)\\.(.*)\\.", "\\1", tmp$Parameter) 22 | tmp 23 | } 24 | 25 | 26 | #' @keywords internal 27 | .get_cleaned_parameters <- function(x, ...) { 28 | dots <- list(...) 29 | if ("cleaned_parameters" %in% names(dots)) { 30 | return(dots$cleaned_parameters) 31 | } 32 | insight::clean_parameters(x) 33 | } 34 | -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure4.R: -------------------------------------------------------------------------------- 1 | library(bayestestR) 2 | library(tidyverse) 3 | 4 | 5 | # Load the rstanarm and the see package 6 | library(rstanarm) 7 | library(see) 8 | 9 | # Fit a Bayesian linear regression 10 | model <- stan_glm(Petal.Width ~ Petal.Length * Sepal.Width, data = iris) 11 | 12 | # Store results 13 | result_pd <- p_direction(model) 14 | 15 | # Print and plot results 16 | print(result_pd) 17 | plot(result_pd) 18 | 19 | # Save -------------------------------------------------------------------- 20 | 21 | x <- data_plot(pd(model)) 22 | 23 | p <- x %>% 24 | filter(y != "(Intercept)") %>% 25 | as.data.frame() %>% 26 | ggplot(aes(x = x, y = y, height = height, group = y, fill = fill)) + 27 | ggridges::geom_ridgeline_gradient(color = "white") + 28 | add_plot_attributes(x) + 29 | geom_vline(aes(xintercept = 0), linetype = "dotted") + 30 | theme_modern() + 31 | scale_fill_manual(values = c("Negative" = "#E91E63", "Positive" = "#4CAF50")) + 32 | theme(plot.title = element_text(hjust = 0.5)) 33 | p 34 | ggsave("Figure4.png", plot = p, width = 13 * 0.7, height = 8 * 0.7, units = "in", dpi = 450) 35 | -------------------------------------------------------------------------------- /man/diagnostic_draws.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/diagnostic_draws.R 3 | \name{diagnostic_draws} 4 | \alias{diagnostic_draws} 5 | \title{Diagnostic values for each iteration} 6 | \usage{ 7 | diagnostic_draws(posterior, ...) 8 | } 9 | \arguments{ 10 | \item{posterior}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, or \code{blavaan} object.} 11 | 12 | \item{...}{Currently only used for models of class \code{brmsfit}, where a \code{variable} 13 | argument can be used, which is directly passed to the \code{as.data.frame()} 14 | method (i.e., \code{as.data.frame(x, variable = variable)}).} 15 | } 16 | \description{ 17 | Returns the accumulated log-posterior, the average Metropolis acceptance rate, divergent transitions, treedepth rather than terminated its evolution normally. 18 | } 19 | \examples{ 20 | \donttest{ 21 | set.seed(333) 22 | 23 | if (require("brms", quietly = TRUE)) { 24 | model <- suppressWarnings(brm(mpg ~ wt * cyl * vs, 25 | data = mtcars, 26 | iter = 100, control = list(adapt_delta = 0.80), 27 | refresh = 0 28 | )) 29 | diagnostic_draws(model) 30 | } 31 | } 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/model_to_priors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model_to_priors.R 3 | \name{model_to_priors} 4 | \alias{model_to_priors} 5 | \title{Convert model's posteriors to priors (EXPERIMENTAL)} 6 | \usage{ 7 | model_to_priors(model, scale_multiply = 3, ...) 8 | } 9 | \arguments{ 10 | \item{model}{A Bayesian model.} 11 | 12 | \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.} 13 | 14 | \item{...}{Other arguments for \code{insight::get_prior()} or \code{\link{describe_posterior}}.} 15 | } 16 | \description{ 17 | Convert model's posteriors to (normal) priors. 18 | } 19 | \examples{ 20 | \donttest{ 21 | # brms models 22 | # ----------------------------------------------- 23 | if (require("brms")) { 24 | formula <- brms::brmsformula(mpg ~ wt + cyl, center = FALSE) 25 | 26 | model <- brms::brm(formula, data = mtcars, refresh = 0) 27 | priors <- model_to_priors(model) 28 | priors <- brms::validate_prior(priors, formula, data = mtcars) 29 | priors 30 | 31 | model2 <- brms::brm(formula, data = mtcars, prior = priors, refresh = 0) 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:----------------------------------------| 5 | |version |R version 4.2.3 (2023-03-15 ucrt) | 6 | |os |Windows 10 x64 (build 19045) | 7 | |system |x86_64, mingw32 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |German_Germany.utf8 | 11 | |ctype |German_Germany.utf8 | 12 | |tz |Europe/Berlin | 13 | |date |2023-03-21 | 14 | |rstudio |2022.12.0+353 Elsbeth Geranium (desktop) | 15 | |pandoc |NA | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:----------|:------|:------|:--| 21 | |bayestestR |0.13.0 |0.13.1 |* | 22 | |datawizard |0.6.5 |0.6.5 | | 23 | |insight |0.19.1 |0.19.1 | | 24 | 25 | # Revdeps 26 | 27 | ## Failed to check (1) 28 | 29 | |package |version |error |warning |note | 30 | |:-------|:-------|:-----|:-------|:----| 31 | |snSMART |0.2.2 |1 | | | 32 | 33 | -------------------------------------------------------------------------------- /man/unupdate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unupdate.R 3 | \name{unupdate} 4 | \alias{unupdate} 5 | \alias{unupdate.brmsfit} 6 | \alias{unupdate.brmsfit_multiple} 7 | \title{Un-update Bayesian models to their prior-to-data state} 8 | \usage{ 9 | unupdate(model, verbose = TRUE, ...) 10 | 11 | \method{unupdate}{brmsfit}(model, verbose = TRUE, ...) 12 | 13 | \method{unupdate}{brmsfit_multiple}(model, verbose = TRUE, newdata = NULL, ...) 14 | } 15 | \arguments{ 16 | \item{model}{A fitted Bayesian model.} 17 | 18 | \item{verbose}{Toggle warnings.} 19 | 20 | \item{...}{Not used} 21 | 22 | \item{newdata}{List of \code{data.frames} to update the model with new data. 23 | Required even if the original data should be used.} 24 | } 25 | \value{ 26 | A model un-fitted to the data, representing the prior model. 27 | } 28 | \description{ 29 | As posteriors are priors that have been updated after observing some data, 30 | the goal of this function is to un-update the posteriors to obtain models 31 | representing the priors. These models can then be used to examine the prior 32 | predictive distribution, or to compare priors with posteriors. 33 | } 34 | \details{ 35 | This function in used internally to compute Bayes factors. 36 | } 37 | \keyword{internal} 38 | -------------------------------------------------------------------------------- /R/bic_to_bf.R: -------------------------------------------------------------------------------- 1 | #' Convert BIC indices to Bayes Factors via the BIC-approximation method. 2 | #' 3 | #' The difference between two Bayesian information criterion (BIC) indices of 4 | #' two models can be used to approximate Bayes factors via: 5 | #' \cr 6 | #' \deqn{BF_{10} = e^{(BIC_0 - BIC_1)/2}}{BF10 = exp((BIC0-BIC1)/2)} 7 | #' 8 | #' @param bic A vector of BIC values. 9 | #' @param denominator The BIC value to use as a denominator (to test against). 10 | #' @param log If `TRUE`, return the `log(BF)`. 11 | #' 12 | #' @references 13 | #' Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of 14 | #' p values. Psychonomic bulletin & review, 14(5), 779-804 15 | #' 16 | #' @examples 17 | #' bic1 <- BIC(lm(Sepal.Length ~ 1, data = iris)) 18 | #' bic2 <- BIC(lm(Sepal.Length ~ Species, data = iris)) 19 | #' bic3 <- BIC(lm(Sepal.Length ~ Species + Petal.Length, data = iris)) 20 | #' bic4 <- BIC(lm(Sepal.Length ~ Species * Petal.Length, data = iris)) 21 | #' 22 | #' bic_to_bf(c(bic1, bic2, bic3, bic4), denominator = bic1) 23 | #' @return The Bayes Factors corresponding to the BIC values against the denominator. 24 | #' 25 | #' @export 26 | bic_to_bf <- function(bic, denominator, log = FALSE) { 27 | delta <- (denominator - bic) / 2 28 | 29 | if (log) { 30 | delta 31 | } else { 32 | exp(delta) 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /man/bic_to_bf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bic_to_bf.R 3 | \name{bic_to_bf} 4 | \alias{bic_to_bf} 5 | \title{Convert BIC indices to Bayes Factors via the BIC-approximation method.} 6 | \usage{ 7 | bic_to_bf(bic, denominator, log = FALSE) 8 | } 9 | \arguments{ 10 | \item{bic}{A vector of BIC values.} 11 | 12 | \item{denominator}{The BIC value to use as a denominator (to test against).} 13 | 14 | \item{log}{If \code{TRUE}, return the \code{log(BF)}.} 15 | } 16 | \value{ 17 | The Bayes Factors corresponding to the BIC values against the denominator. 18 | } 19 | \description{ 20 | The difference between two Bayesian information criterion (BIC) indices of 21 | two models can be used to approximate Bayes factors via: 22 | \cr 23 | \deqn{BF_{10} = e^{(BIC_0 - BIC_1)/2}}{BF10 = exp((BIC0-BIC1)/2)} 24 | } 25 | \examples{ 26 | bic1 <- BIC(lm(Sepal.Length ~ 1, data = iris)) 27 | bic2 <- BIC(lm(Sepal.Length ~ Species, data = iris)) 28 | bic3 <- BIC(lm(Sepal.Length ~ Species + Petal.Length, data = iris)) 29 | bic4 <- BIC(lm(Sepal.Length ~ Species * Petal.Length, data = iris)) 30 | 31 | bic_to_bf(c(bic1, bic2, bic3, bic4), denominator = bic1) 32 | } 33 | \references{ 34 | Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of 35 | p values. Psychonomic bulletin & review, 14(5), 779-804 36 | } 37 | -------------------------------------------------------------------------------- /R/print.bayesfactor_models.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | print.bayesfactor_matrix <- function(x, log = FALSE, exact = TRUE, ...) { 3 | orig_x <- x 4 | 5 | # Format values 6 | x <- unclass(x) 7 | if (log) { 8 | sgn <- sign(x) < 0 9 | x <- insight::format_value(abs(x), digits = 2, ...) 10 | 11 | if (any(sgn)) { 12 | x[sgn] <- paste0("-", x[sgn]) 13 | } 14 | 15 | diag(x) <- "0" 16 | } else { 17 | x <- exp(x) 18 | x <- insight::format_bf(x, name = NULL, exact = exact, ...) 19 | 20 | diag(x) <- "1" 21 | } 22 | 23 | df <- as.data.frame(x) 24 | 25 | # Model names 26 | models <- colnames(df) 27 | models[models == "1"] <- "(Intercept only)" 28 | models <- paste0("[", seq_along(models), "] ", models) 29 | 30 | rownames(df) <- colnames(df) <- NULL 31 | df <- cbind(modl = models, df) 32 | colnames(df) <- c( 33 | "Denominator\\Numerator", 34 | paste0(" [", seq_along(models), "] ") 35 | ) 36 | 37 | # caption and footer 38 | caption <- switch( 39 | attr(orig_x, "bf_fun"), 40 | "bayesfactor_restricted()" = "# Bayes Factors for Restricted Models", 41 | "# Bayes Factors for Model Comparison" 42 | ) 43 | footer <- if (log) c("\nBayes Factors are on the log-scale.\n", "red") 44 | 45 | out <- insight::export_table( 46 | df, 47 | caption = c(caption, "blue"), 48 | footer = footer 49 | ) 50 | # Fix spacing 51 | out <- sub("Denominator", " Denominator", out, fixed = TRUE) 52 | 53 | cat(out) 54 | 55 | invisible(orig_x) 56 | } 57 | -------------------------------------------------------------------------------- /man/overlap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlap.R 3 | \name{overlap} 4 | \alias{overlap} 5 | \title{Overlap Coefficient} 6 | \usage{ 7 | overlap( 8 | x, 9 | y, 10 | method_density = "kernel", 11 | method_auc = "trapezoid", 12 | precision = 2^10, 13 | extend = TRUE, 14 | extend_scale = 0.1, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{x}{Vector of x values.} 20 | 21 | \item{y}{Vector of x values.} 22 | 23 | \item{method_density}{Density estimation method. See \code{\link[=estimate_density]{estimate_density()}}.} 24 | 25 | \item{method_auc}{Area Under the Curve (AUC) estimation method. See \code{\link[=area_under_curve]{area_under_curve()}}.} 26 | 27 | \item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.} 28 | 29 | \item{extend}{Extend the range of the x axis by a factor of \code{extend_scale}.} 30 | 31 | \item{extend_scale}{Ratio of range by which to extend the x axis. A value of \code{0.1} 32 | means that the x axis will be extended by \code{1/10} of the range of the data.} 33 | 34 | \item{...}{Currently not used.} 35 | } 36 | \description{ 37 | A method to calculate the overlap coefficient between two empirical 38 | distributions (that can be used as a measure of similarity between two 39 | samples). 40 | } 41 | \examples{ 42 | library(bayestestR) 43 | 44 | x <- distribution_normal(1000, 2, 0.5) 45 | y <- distribution_normal(1000, 0, 1) 46 | 47 | overlap(x, y) 48 | plot(overlap(x, y)) 49 | } 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | 35 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 36 | rsconnect/ 37 | 38 | # Windows image file caches 39 | Thumbs.db 40 | ehthumbs.db 41 | 42 | # Folder config file 43 | Desktop.ini 44 | 45 | # Recycle Bin used on file shares 46 | $RECYCLE.BIN/ 47 | 48 | # Windows Installer files 49 | *.cab 50 | *.msi 51 | *.msm 52 | *.msp 53 | 54 | # Windows shortcuts 55 | *.lnk 56 | 57 | # ========================= 58 | # Operating System Files 59 | # OSX 60 | .DS_Store 61 | .AppleDouble 62 | .LSOverride 63 | 64 | # Thumbnails 65 | ._* 66 | 67 | # Files that might appear in the root of a volume 68 | .DocumentRevisions-V100 69 | .fseventsd 70 | .Spotlight-V100 71 | .TemporaryItems 72 | .Trashes 73 | .VolumeIcon.icns 74 | 75 | # Directories potentially created on remote AFP share 76 | .AppleDB 77 | .AppleDesktop 78 | Network Trash Folder 79 | Temporary Items 80 | .apdisk -------------------------------------------------------------------------------- /tests/testthat/test-effective_sample.R: -------------------------------------------------------------------------------- 1 | test_that("effective_sample", { 2 | skip_if_not_installed("curl") 3 | skip_if_offline() 4 | skip_if_not_installed("httr2") 5 | skip_if_not_or_load_if_installed("rstanarm") 6 | skip_if_not_or_load_if_installed("brms") 7 | skip_if_not_or_load_if_installed("rstan") 8 | 9 | brms_1 <- insight::download_model("brms_1") 10 | skip_if(is.null(brms_1)) 11 | 12 | res <- effective_sample(brms_1) 13 | expect_equal( 14 | res, 15 | data.frame( 16 | Parameter = c("b_Intercept", "b_wt", "b_cyl"), 17 | ESS = c(5283, 2120, 2001), 18 | ESS_tail = c(3255, 2003, 2227), 19 | stringsAsFactors = FALSE 20 | ), 21 | ignore_attr = TRUE, 22 | tolerance = 1e-1 23 | ) 24 | 25 | brms_null_1 <- insight::download_model("brms_null_1") 26 | skip_if(is.null(brms_null_1)) 27 | 28 | res <- effective_sample(brms_null_1) 29 | expect_equal( 30 | res, 31 | data.frame( 32 | Parameter = "b_Intercept", 33 | ESS = 2912, 34 | ESS_tail = 2388, 35 | stringsAsFactors = FALSE 36 | ), 37 | ignore_attr = TRUE, 38 | tolerance = 1e-1 39 | ) 40 | 41 | brms_null_2 <- insight::download_model("brms_null_2") 42 | skip_if(is.null(brms_null_2)) 43 | 44 | res <- effective_sample(brms_null_2) 45 | expect_equal( 46 | res, 47 | data.frame( 48 | Parameter = "b_Intercept", 49 | ESS = 1098, 50 | ESS_tail = 954, 51 | stringsAsFactors = FALSE 52 | ), 53 | ignore_attr = TRUE, 54 | tolerance = 1e-1 55 | ) 56 | }) 57 | -------------------------------------------------------------------------------- /man/describe_prior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/describe_prior.R 3 | \name{describe_prior} 4 | \alias{describe_prior} 5 | \alias{describe_prior.brmsfit} 6 | \title{Describe Priors} 7 | \usage{ 8 | describe_prior(model, ...) 9 | 10 | \method{describe_prior}{brmsfit}(model, parameters = NULL, ...) 11 | } 12 | \arguments{ 13 | \item{model}{A Bayesian model.} 14 | 15 | \item{...}{Currently not used.} 16 | 17 | \item{parameters}{Regular expression pattern that describes the parameters 18 | that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are 19 | filtered by default, so only parameters that typically appear in the 20 | \code{summary()} are returned. Use \code{parameters} to select specific parameters 21 | for the output.} 22 | } 23 | \description{ 24 | Returns a summary of the priors used in the model. 25 | } 26 | \examples{ 27 | \donttest{ 28 | library(bayestestR) 29 | 30 | # rstanarm models 31 | # ----------------------------------------------- 32 | if (require("rstanarm")) { 33 | model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) 34 | describe_prior(model) 35 | } 36 | 37 | # brms models 38 | # ----------------------------------------------- 39 | if (require("brms")) { 40 | model <- brms::brm(mpg ~ wt + cyl, data = mtcars) 41 | describe_prior(model) 42 | } 43 | 44 | # BayesFactor objects 45 | # ----------------------------------------------- 46 | if (require("BayesFactor")) { 47 | bf <- ttestBF(x = rnorm(100, 1, 1)) 48 | describe_prior(bf) 49 | } 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /man/reshape_iterations.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reshape_iterations.R 3 | \name{reshape_iterations} 4 | \alias{reshape_iterations} 5 | \alias{reshape_draws} 6 | \title{Reshape estimations with multiple iterations (draws) to long format} 7 | \usage{ 8 | reshape_iterations(x, prefix = c("draw", "iter", "iteration", "sim")) 9 | 10 | reshape_draws(x, prefix = c("draw", "iter", "iteration", "sim")) 11 | } 12 | \arguments{ 13 | \item{x}{A data.frame containing posterior draws obtained from 14 | \code{estimate_response} or \code{estimate_link}.} 15 | 16 | \item{prefix}{The prefix of the draws (for instance, \code{"iter_"} for columns 17 | named as \verb{iter_1, iter_2, iter_3}). If more than one are provided, will 18 | search for the first one that matches.} 19 | } 20 | \value{ 21 | Data frame of reshaped draws in long format. 22 | } 23 | \description{ 24 | Reshape a wide data.frame of iterations (such as posterior draws or 25 | bootsrapped samples) as columns to long format. Instead of having all 26 | iterations as columns (e.g., \verb{iter_1, iter_2, ...}), will return 3 columns 27 | with the \verb{\\*_index} (the previous index of the row), the \verb{\\*_group} (the 28 | iteration number) and the \verb{\\*_value} (the value of said iteration). 29 | } 30 | \examples{ 31 | \donttest{ 32 | if (require("rstanarm")) { 33 | model <- stan_glm(mpg ~ am, data = mtcars, refresh = 0) 34 | draws <- insight::get_predicted(model) 35 | long_format <- reshape_iterations(draws) 36 | head(long_format) 37 | } 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /man/simulate_simpson.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_simpson.R 3 | \name{simulate_simpson} 4 | \alias{simulate_simpson} 5 | \title{Simpson's paradox dataset simulation} 6 | \usage{ 7 | simulate_simpson( 8 | n = 100, 9 | r = 0.5, 10 | groups = 3, 11 | difference = 1, 12 | group_prefix = "G_" 13 | ) 14 | } 15 | \arguments{ 16 | \item{n}{The number of observations for each group to be generated (minimum 4).} 17 | 18 | \item{r}{A value or vector corresponding to the desired correlation 19 | coefficients.} 20 | 21 | \item{groups}{Number of groups (groups can be participants, clusters, anything).} 22 | 23 | \item{difference}{Difference between groups.} 24 | 25 | \item{group_prefix}{The prefix of the group name (e.g., "G_1", "G_2", "G_3", ...).} 26 | } 27 | \value{ 28 | A dataset. 29 | } 30 | \description{ 31 | Simpson's paradox, or the Yule-Simpson effect, is a phenomenon in probability 32 | and statistics, in which a trend appears in several different groups of data 33 | but disappears or reverses when these groups are combined. 34 | } 35 | \examples{ 36 | \dontshow{if (requireNamespace("MASS", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 37 | data <- simulate_simpson(n = 10, groups = 5, r = 0.5) 38 | 39 | if (require("ggplot2")) { 40 | ggplot(data, aes(x = V1, y = V2)) + 41 | geom_point(aes(color = Group)) + 42 | geom_smooth(aes(color = Group), method = "lm") + 43 | geom_smooth(method = "lm") 44 | } 45 | \dontshow{\}) # examplesIf} 46 | } 47 | -------------------------------------------------------------------------------- /tests/testthat/test-estimate_density.R: -------------------------------------------------------------------------------- 1 | test_that("estimate_density", { 2 | skip_if_not_or_load_if_installed("logspline") 3 | skip_if_not_or_load_if_installed("KernSmooth") 4 | skip_if_not_or_load_if_installed("mclust") 5 | 6 | set.seed(333) 7 | x <- distribution_normal(500, 1) 8 | 9 | # Methods 10 | density_kernel <- estimate_density(x, method = "kernel") 11 | density_logspline <- estimate_density(x, method = "logspline") 12 | density_KernSmooth <- estimate_density(x, method = "KernSmooth") 13 | density_mixture <- estimate_density(x, method = "mixture") 14 | 15 | expect_equal(mean(density_kernel$y - density_logspline$y), 0, tolerance = 0.1) 16 | expect_equal(mean(density_kernel$y - density_KernSmooth$y), 0, tolerance = 0.1) 17 | expect_equal(mean(density_kernel$y - density_mixture$y), 0, tolerance = 0.1) 18 | 19 | x <- iris 20 | x$Fac <- rep_len(c("A", "B"), 150) 21 | 22 | rez <- estimate_density(x, select = "Sepal.Length") 23 | expect_identical(dim(rez), c(1024L, 3L)) 24 | 25 | rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length")) 26 | expect_identical(dim(rez), c(2048L, 3L)) 27 | 28 | rez <- estimate_density(x, select = "Sepal.Length", by = "Species") 29 | expect_identical(dim(rez), as.integer(c(1024 * 3, 4))) 30 | 31 | rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length"), by = "Species") 32 | expect_identical(dim(rez), as.integer(c(2048 * 3, 4))) 33 | 34 | rez <- estimate_density(x, select = "Sepal.Length", by = c("Species", "Fac"), method = "KernSmooth") 35 | expect_identical(dim(rez), as.integer(c(1024 * 3 * 2, 5))) 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-distributions.R: -------------------------------------------------------------------------------- 1 | test_that("distributions", { 2 | tolerance <- 0.01 3 | 4 | expect_equal(mean(distribution_normal(10)), 0, tolerance = tolerance) 5 | expect_equal(length(distribution_normal(10, random = TRUE)), 10, tolerance = tolerance) 6 | 7 | expect_equal(mean(distribution_beta(10, 1, 1)), 0.5, tolerance = tolerance) 8 | expect_equal(length(distribution_normal(10, 1, 1, random = TRUE)), 10, tolerance = tolerance) 9 | 10 | expect_equal(mean(distribution_binomial(10, 0, 0.5)), 0, tolerance = tolerance) 11 | expect_equal(length(distribution_binomial(10, 0, 0.5, random = TRUE)), 10, tolerance = tolerance) 12 | 13 | expect_equal(mean(distribution_cauchy(10)), 0, tolerance = tolerance) 14 | expect_equal(length(distribution_cauchy(10, random = TRUE)), 10, tolerance = tolerance) 15 | 16 | expect_equal(mean(distribution_chisquared(10, 1)), 0.893, tolerance = tolerance) 17 | expect_equal(length(distribution_chisquared(10, 1, random = TRUE)), 10, tolerance = tolerance) 18 | 19 | expect_equal(mean(distribution_gamma(10, 1)), 0.9404, tolerance = tolerance) 20 | expect_equal(length(distribution_gamma(10, 1, random = TRUE)), 10, tolerance = tolerance) 21 | 22 | expect_equal(mean(distribution_poisson(10)), 1, tolerance = tolerance) 23 | expect_equal(length(distribution_poisson(10, random = TRUE)), 10, tolerance = tolerance) 24 | 25 | expect_equal(mean(distribution_student(10, 1)), 0, tolerance = tolerance) 26 | expect_equal(length(distribution_student(10, 1, random = TRUE)), 10, tolerance = tolerance) 27 | 28 | expect_equal(mean(distribution_uniform(10)), 0.5, tolerance = tolerance) 29 | expect_equal(length(distribution_uniform(10, random = TRUE)), 10, tolerance = tolerance) 30 | }) 31 | -------------------------------------------------------------------------------- /man/sexit_thresholds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sexit_thresholds.R 3 | \name{sexit_thresholds} 4 | \alias{sexit_thresholds} 5 | \title{Find Effect Size Thresholds} 6 | \usage{ 7 | sexit_thresholds(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Vector representing a posterior distribution. Can also be a 11 | \code{stanreg} or \code{brmsfit} model.} 12 | 13 | \item{...}{Currently not used.} 14 | } 15 | \description{ 16 | This function attempts at automatically finding suitable default 17 | values for a "significant" (i.e., non-negligible) and "large" effect. This is 18 | to be used with care, and the chosen threshold should always be explicitly 19 | reported and justified. See the detail section in \code{\link[=sexit]{sexit()}} for more 20 | information. 21 | } 22 | \examples{ 23 | sexit_thresholds(rnorm(1000)) 24 | \donttest{ 25 | if (require("rstanarm")) { 26 | model <- suppressWarnings(stan_glm( 27 | mpg ~ wt + gear, 28 | data = mtcars, 29 | chains = 2, 30 | iter = 200, 31 | refresh = 0 32 | )) 33 | sexit_thresholds(model) 34 | 35 | model <- suppressWarnings( 36 | stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0) 37 | ) 38 | sexit_thresholds(model) 39 | } 40 | 41 | if (require("brms")) { 42 | model <- brm(mpg ~ wt + cyl, data = mtcars) 43 | sexit_thresholds(model) 44 | } 45 | 46 | if (require("BayesFactor")) { 47 | bf <- ttestBF(x = rnorm(100, 1, 1)) 48 | sexit_thresholds(bf) 49 | } 50 | } 51 | } 52 | \references{ 53 | 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}. 54 | } 55 | -------------------------------------------------------------------------------- /man/area_under_curve.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/area_under_curve.R 3 | \name{area_under_curve} 4 | \alias{area_under_curve} 5 | \alias{auc} 6 | \title{Area under the Curve (AUC)} 7 | \usage{ 8 | area_under_curve(x, y, method = c("trapezoid", "step", "spline"), ...) 9 | 10 | auc(x, y, method = c("trapezoid", "step", "spline"), ...) 11 | } 12 | \arguments{ 13 | \item{x}{Vector of x values.} 14 | 15 | \item{y}{Vector of y values.} 16 | 17 | \item{method}{Method to compute the Area Under the Curve (AUC). Can be 18 | \code{"trapezoid"} (default), \code{"step"} or \code{"spline"}. If "trapezoid", the curve 19 | is formed by connecting all points by a direct line (composite trapezoid 20 | rule). If "step" is chosen then a stepwise connection of two points is 21 | used. For calculating the area under a spline interpolation the splinefun 22 | function is used in combination with integrate.} 23 | 24 | \item{...}{Arguments passed to or from other methods.} 25 | } 26 | \description{ 27 | Based on the DescTools \code{AUC} function. It can calculate the area under the 28 | curve with a naive algorithm or a more elaborated spline approach. The curve 29 | must be given by vectors of xy-coordinates. This function can handle unsorted 30 | x values (by sorting x) and ties for the x values (by ignoring duplicates). 31 | } 32 | \examples{ 33 | library(bayestestR) 34 | posterior <- distribution_normal(1000) 35 | 36 | dens <- estimate_density(posterior) 37 | dens <- dens[dens$x > 0, ] 38 | x <- dens$x 39 | y <- dens$y 40 | 41 | area_under_curve(x, y, method = "trapezoid") 42 | area_under_curve(x, y, method = "step") 43 | area_under_curve(x, y, method = "spline") 44 | } 45 | \seealso{ 46 | DescTools 47 | } 48 | -------------------------------------------------------------------------------- /tests/testthat/test-point_estimate.R: -------------------------------------------------------------------------------- 1 | test_that("point_estimate: stanreg", { 2 | skip_if_not_installed("curl") 3 | skip_if_offline() 4 | skip_if_not_installed("httr2") 5 | skip_if_not_or_load_if_installed("rstanarm") 6 | skip_if_not_or_load_if_installed("brms") 7 | 8 | m <- insight::download_model("stanreg_merMod_5") 9 | p <- insight::get_parameters(m, effects = "all") 10 | 11 | expect_equal( 12 | point_estimate(m, effects = "all")$Median, 13 | point_estimate(p)$Median, 14 | tolerance = 1e-3 15 | ) 16 | }) 17 | 18 | test_that("point_estimate: brms", { 19 | skip_if_not_installed("curl") 20 | skip_if_offline() 21 | skip_if_not_installed("httr2") 22 | skip_if_not_or_load_if_installed("rstanarm") 23 | skip_if_not_or_load_if_installed("brms") 24 | 25 | m <- insight::download_model("brms_zi_3") 26 | p <- insight::get_parameters(m, effects = "all", component = "all") 27 | 28 | expect_equal( 29 | point_estimate(m, effects = "all", component = "all")$Median, 30 | point_estimate(p)$Median, 31 | tolerance = 1e-3 32 | ) 33 | }) 34 | 35 | # edge cases 36 | test_that("point_estimate, constant vectors or sparse samples", { 37 | x <- c(2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.2, 2.2, 2.2, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5) 38 | out <- point_estimate(x, centrality = "MAP", verbose = FALSE) 39 | expect_true(is.na(out$MAP)) 40 | out <- point_estimate(c(3, 3, 3), centrality = "MAP", verbose = FALSE) 41 | expect_identical(out$MAP, 3) 42 | expect_message( 43 | point_estimate(x, centrality = "MAP", verbose = TRUE), 44 | regex = "Could not calculate MAP estimate" 45 | ) 46 | expect_message( 47 | point_estimate(c(3, 3, 3), centrality = "MAP", verbose = TRUE), 48 | regex = "Data is singular" 49 | ) 50 | }) 51 | -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure1.R: -------------------------------------------------------------------------------- 1 | library(bayestestR) 2 | library(ggplot2) 3 | # library(strengejacke) 4 | 5 | set.seed(123) 6 | posterior <- distribution_chisquared(100, 3) 7 | dat <- as.data.frame(density(posterior)) 8 | 9 | m <- median(posterior) 10 | ypos <- density_at(posterior, x = m) 11 | 12 | m2 <- map_estimate(posterior) 13 | ypos2 <- dat$y[which.min(abs(dat$x - m2))] 14 | 15 | m3 <- mean(posterior) 16 | ypos3 <- dat$y[which.min(abs(dat$x - m3))] 17 | 18 | label_x <- m + .8 19 | label_y <- ypos + .01 20 | 21 | label_x2 <- m2 - 0.5 22 | label_y2 <- ypos2 + .01 23 | 24 | label_x3 <- m3 + .8 25 | label_y3 <- ypos3 + .01 26 | 27 | ggplot(dat, aes(x = x, y = y)) + 28 | geom_ribbon(aes(ymin = 0, ymax = y), fill = "#FFC107") + 29 | geom_vline(xintercept = 0, linetype = "dotted") + 30 | geom_segment(x = m2, xend = m2, y = 0, yend = ypos2, color = "#E91E63", size = 1) + 31 | geom_point(x = m2, y = ypos2, color = "#E91E63", size = 5) + 32 | geom_label(x = label_x2, y = label_y2, label = "MAP", color = "#E91E63", size = 7) + 33 | geom_segment(x = m, xend = m, y = 0, yend = ypos, color = "#2196F3", size = 1) + 34 | geom_point(x = m, y = ypos, color = "#2196F3", size = 5) + 35 | geom_label(x = label_x, y = label_y, label = "Median", color = "#2196F3", size = 7) + 36 | geom_segment(x = m3, xend = m3, y = 0, yend = ypos3, color = "#4CAF50", size = 1) + 37 | geom_point(x = m3, y = ypos3, color = "#4CAF50", size = 5) + 38 | geom_label(x = label_x3, y = label_y3, label = "Mean", color = "#4CAF50", size = 7) + 39 | theme_classic(base_size = 20) + 40 | scale_y_continuous(expand = c(0, 0), limits = c(0, .25)) + 41 | xlab("\nParameter Value") + 42 | ylab("Probability Density\n") 43 | 44 | ggsave("Figure1b.png", width = 13, height = 8, units = "in", dpi = 450) 45 | -------------------------------------------------------------------------------- /.github/SUPPORT.md: -------------------------------------------------------------------------------- 1 | # Getting help with `{bayestestR}` 2 | 3 | Thanks for using `{bayestestR}`. Before filing an issue, there are a few places 4 | to explore and pieces to put together to make the process as smooth as possible. 5 | 6 | Start by making a minimal **repr**oducible **ex**ample using the 7 | [reprex](http://reprex.tidyverse.org/) package. If you haven't heard of or used 8 | reprex before, you're in for a treat! Seriously, reprex will make all of your 9 | R-question-asking endeavors easier (which is a pretty insane ROI for the five to 10 | ten minutes it'll take you to learn what it's all about). For additional reprex 11 | pointers, check out the [Get help!](https://www.tidyverse.org/help/) resource 12 | used by the tidyverse team. 13 | 14 | Armed with your reprex, the next step is to figure out where to ask: 15 | 16 | * If it's a question: start with StackOverflow. There are more people there to answer questions. 17 | * If it's a bug: you're in the right place, file an issue. 18 | * If you're not sure: let's [discuss](https://github.com/easystats/bayestestR/discussions) it and try to figure it out! If your 19 | problem _is_ a bug or a feature request, you can easily return here and 20 | report it. 21 | 22 | Before opening a new issue, be sure to [search issues and pull requests](https://github.com/easystats/bayestestR/issues) to make sure the 23 | bug hasn't been reported and/or already fixed in the development version. By 24 | default, the search will be pre-populated with `is:issue is:open`. You can 25 | [edit the qualifiers](https://help.github.com/articles/searching-issues-and-pull-requests/) 26 | (e.g. `is:pr`, `is:closed`) as needed. For example, you'd simply 27 | remove `is:open` to search _all_ issues in the repo, open or closed. 28 | 29 | Thanks for your help! -------------------------------------------------------------------------------- /R/simulate_simpson.R: -------------------------------------------------------------------------------- 1 | #' Simpson's paradox dataset simulation 2 | #' 3 | #' Simpson's paradox, or the Yule-Simpson effect, is a phenomenon in probability 4 | #' and statistics, in which a trend appears in several different groups of data 5 | #' but disappears or reverses when these groups are combined. 6 | #' 7 | #' @param n The number of observations for each group to be generated (minimum 4). 8 | #' @param groups Number of groups (groups can be participants, clusters, anything). 9 | #' @param difference Difference between groups. 10 | #' @param group_prefix The prefix of the group name (e.g., "G_1", "G_2", "G_3", ...). 11 | #' @inheritParams simulate_correlation 12 | #' 13 | #' @return A dataset. 14 | #' 15 | #' @examplesIf requireNamespace("MASS", quietly = TRUE) 16 | #' data <- simulate_simpson(n = 10, groups = 5, r = 0.5) 17 | #' 18 | #' if (require("ggplot2")) { 19 | #' ggplot(data, aes(x = V1, y = V2)) + 20 | #' geom_point(aes(color = Group)) + 21 | #' geom_smooth(aes(color = Group), method = "lm") + 22 | #' geom_smooth(method = "lm") 23 | #' } 24 | #' @export 25 | simulate_simpson <- function(n = 100, 26 | r = 0.5, 27 | groups = 3, 28 | difference = 1, 29 | group_prefix = "G_") { 30 | if (n <= 3) { 31 | insight::format_error("The number of observations `n` should be larger than 3.") 32 | } 33 | 34 | out <- data.frame() 35 | for (i in 1:groups) { 36 | dat <- simulate_correlation(n = n, r = r) 37 | dat$V1 <- dat$V1 + difference * i # (i * -sign(r)) 38 | dat$V2 <- dat$V2 + difference * (i * -sign(r)) 39 | dat$Group <- sprintf(paste0(group_prefix, "%0", nchar(trunc(abs(groups))), "d"), i) 40 | out <- rbind(out, dat) 41 | } 42 | 43 | out 44 | } 45 | -------------------------------------------------------------------------------- /tests/testthat/test-rope_range.R: -------------------------------------------------------------------------------- 1 | test_that("rope_range cor", { 2 | x <- cor.test(ToothGrowth$len, ToothGrowth$dose) 3 | expect_equal(rope_range(x), c(-0.05, 0.05), tolerance = 1e-3) 4 | }) 5 | 6 | test_that("rope_range gaussian", { 7 | data(mtcars) 8 | mod <- lm(mpg ~ gear + hp, data = mtcars) 9 | expect_equal(rope_range(mod), c(-0.1 * sd(mtcars$mpg), 0.1 * sd(mtcars$mpg)), tolerance = 1e-3) 10 | }) 11 | 12 | test_that("rope_range log gaussian", { 13 | data(iris) 14 | mod <- lm(log(Sepal.Length) ~ Species, data = iris) 15 | expect_equal(rope_range(mod), c(-0.01, 0.01), tolerance = 1e-3) 16 | }) 17 | 18 | test_that("rope_range log gaussian 2", { 19 | data(mtcars) 20 | mod <- glm(mpg ~ gear + hp, data = mtcars, family = gaussian("log")) 21 | expect_equal(rope_range(mod), c(-0.01, 0.01), tolerance = 1e-3) 22 | }) 23 | 24 | test_that("rope_range logistic", { 25 | data(mtcars) 26 | mod <- glm(am ~ gear + hp, data = mtcars, family = binomial()) 27 | expect_equal(rope_range(mod), c(-1 * 0.1 * pi / sqrt(3), 0.1 * pi / sqrt(3)), tolerance = 1e-3) 28 | }) 29 | 30 | 31 | test_that("rope_range", { 32 | skip_if_not_or_load_if_installed("brms") 33 | model <- suppressWarnings(brms::brm(mpg ~ wt + gear, data = mtcars, iter = 300)) 34 | 35 | expect_equal( 36 | rope_range(model), 37 | c(-0.6026948, 0.6026948), 38 | tolerance = 0.01 39 | ) 40 | }) 41 | 42 | test_that("rope_range (multivariate)", { 43 | skip_if_not_or_load_if_installed("brms") 44 | model <- suppressWarnings( 45 | brms::brm(brms::bf(mvbind(mpg, disp) ~ wt + gear) + brms::set_rescor(TRUE), data = mtcars, iter = 300) 46 | ) 47 | 48 | expect_equal( 49 | rope_range(model), 50 | list( 51 | mpg = c(-0.602694, 0.602694), 52 | disp = c(-12.393869, 12.393869) 53 | ), 54 | tolerance = 0.01 55 | ) 56 | }) 57 | -------------------------------------------------------------------------------- /R/model_to_priors.R: -------------------------------------------------------------------------------- 1 | #' Convert model's posteriors to priors (EXPERIMENTAL) 2 | #' 3 | #' Convert model's posteriors to (normal) priors. 4 | #' 5 | #' @param model A Bayesian model. 6 | #' @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. 7 | #' @param ... Other arguments for \code{insight::get_prior()} or \code{\link{describe_posterior}}. 8 | #' 9 | #' @examples 10 | #' \donttest{ 11 | #' # brms models 12 | #' # ----------------------------------------------- 13 | #' if (require("brms")) { 14 | #' formula <- brms::brmsformula(mpg ~ wt + cyl, center = FALSE) 15 | #' 16 | #' model <- brms::brm(formula, data = mtcars, refresh = 0) 17 | #' priors <- model_to_priors(model) 18 | #' priors <- brms::validate_prior(priors, formula, data = mtcars) 19 | #' priors 20 | #' 21 | #' model2 <- brms::brm(formula, data = mtcars, prior = priors, refresh = 0) 22 | #' } 23 | #' } 24 | #' @export 25 | model_to_priors <- function(model, scale_multiply = 3, ...) { 26 | UseMethod("model_to_priors") 27 | } 28 | 29 | 30 | #' @export 31 | model_to_priors.brmsfit <- function(model, scale_multiply = 3, ...) { 32 | params <- describe_posterior(model, centrality = "mean", dispersion = TRUE, ci = NULL, test = NULL, ...) 33 | priors_params <- attributes(insight::get_priors(model, ...))$priors 34 | priors <- brms::prior_summary(model) 35 | 36 | for (p in priors_params$Parameter) { 37 | if (p %in% params$Parameter) { 38 | param_subset <- params[params$Parameter == p, ] 39 | priors$prior[priors_params$Parameter == p] <- paste0( 40 | "normal(", 41 | insight::format_value(param_subset$Mean), 42 | ", ", 43 | insight::format_value(param_subset$SD * scale_multiply), 44 | ")" 45 | ) 46 | } 47 | } 48 | priors 49 | } 50 | -------------------------------------------------------------------------------- /paper/JOSS paper files/Figure2.R: -------------------------------------------------------------------------------- 1 | library(bayestestR) 2 | library(tidyverse) 3 | library(strengejacke) # What the hell is that ^^ 4 | library(ggplot2) 5 | 6 | set.seed(123) 7 | posterior <- distribution_chisquared(100, 3) 8 | dat <- as.data.frame(density(posterior)) 9 | 10 | p1 <- dat %>% 11 | mutate(fill = ifelse(x < hdi(posterior)$CI_low, "low", 12 | ifelse(x > hdi(posterior)$CI_high, "high", "middle") 13 | )) %>% 14 | ggplot(aes(x = x, y = y, fill = fill)) + 15 | geom_ribbon(aes(ymin = 0, ymax = y)) + 16 | geom_vline(xintercept = 0, linetype = "dotted") + 17 | theme_classic(base_size = 20) + 18 | scale_y_continuous(expand = c(0, 0), limits = c(0, .25)) + 19 | scale_fill_manual(values = c("high" = "#FFC107", "low" = "#FFC107", "middle" = "#E91E63"), guide = FALSE) + 20 | annotate("text", x = 2.5, y = .05, label = "The 89% HDI", color = "white", size = 10) + 21 | xlab(NULL) + 22 | ylab("Probability Density\n") 23 | 24 | # ggsave("paper/Figure2.png", width = 13, height = 8, units = "in", dpi = 300) 25 | 26 | 27 | p2 <- dat %>% 28 | mutate(fill = ifelse(x < ci(posterior)$CI_low, "low", 29 | ifelse(x > ci(posterior)$CI_high, "high", "middle") 30 | )) %>% 31 | ggplot(aes(x = x, y = y, fill = fill)) + 32 | geom_ribbon(aes(ymin = 0, ymax = y)) + 33 | geom_vline(xintercept = 0, linetype = "dotted") + 34 | theme_classic(base_size = 20) + 35 | scale_y_continuous(expand = c(0, 0), limits = c(0, .25)) + 36 | scale_fill_manual(values = c("high" = "#FFC107", "low" = "#FFC107", "middle" = "#2196F3"), guide = FALSE) + 37 | annotate("text", x = 2.9, y = .05, label = "The 89% ETI", color = "white", size = 10) + 38 | xlab("\nParameter Value") + 39 | ylab("Probability Density\n") 40 | 41 | p <- see::plots(p1, p2, tags = TRUE) 42 | 43 | ggsave("Figure2.png", plot = p, width = 13, height = 8, units = "in", dpi = 450) 44 | -------------------------------------------------------------------------------- /man/convert_bayesian_as_frequentist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert_bayesian_to_frequentist.R 3 | \name{convert_bayesian_as_frequentist} 4 | \alias{convert_bayesian_as_frequentist} 5 | \alias{bayesian_as_frequentist} 6 | \title{Convert (refit) a Bayesian model to frequentist} 7 | \usage{ 8 | convert_bayesian_as_frequentist(model, data = NULL, REML = TRUE) 9 | 10 | bayesian_as_frequentist(model, data = NULL, REML = TRUE) 11 | } 12 | \arguments{ 13 | \item{model}{A Bayesian model.} 14 | 15 | \item{data}{Data used by the model. If \code{NULL}, will try to extract it 16 | from the model.} 17 | 18 | \item{REML}{For mixed effects, should models be estimated using 19 | restricted maximum likelihood (REML) (\code{TRUE}, default) or maximum 20 | likelihood (\code{FALSE})?} 21 | } 22 | \description{ 23 | Refit Bayesian model as frequentist. Can be useful for comparisons. 24 | } 25 | \examples{ 26 | \dontshow{if (require("rstanarm")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 27 | \donttest{ 28 | # Rstanarm ---------------------- 29 | # Simple regressions 30 | model <- rstanarm::stan_glm(Sepal.Length ~ Species, 31 | data = iris, chains = 2, refresh = 0 32 | ) 33 | bayesian_as_frequentist(model) 34 | 35 | model <- rstanarm::stan_glm(vs ~ mpg, 36 | family = "binomial", 37 | data = mtcars, chains = 2, refresh = 0 38 | ) 39 | bayesian_as_frequentist(model) 40 | 41 | # Mixed models 42 | model <- rstanarm::stan_glmer( 43 | Sepal.Length ~ Petal.Length + (1 | Species), 44 | data = iris, chains = 2, refresh = 0 45 | ) 46 | bayesian_as_frequentist(model) 47 | 48 | model <- rstanarm::stan_glmer(vs ~ mpg + (1 | cyl), 49 | family = "binomial", 50 | data = mtcars, chains = 2, refresh = 0 51 | ) 52 | bayesian_as_frequentist(model) 53 | } 54 | \dontshow{\}) # examplesIf} 55 | } 56 | -------------------------------------------------------------------------------- /.github/workflows/format-suggest.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/posit-dev/setup-air/tree/main/examples 2 | 3 | on: 4 | # Using `pull_request_target` over `pull_request` for elevated `GITHUB_TOKEN` 5 | # privileges, otherwise we can't set `pull-requests: write` when the pull 6 | # request comes from a fork, which is our main use case (external contributors). 7 | # 8 | # `pull_request_target` runs in the context of the target branch (`main`, usually), 9 | # rather than in the context of the pull request like `pull_request` does. Due 10 | # to this, we must explicitly checkout `ref: ${{ github.event.pull_request.head.sha }}`. 11 | # This is typically frowned upon by GitHub, as it exposes you to potentially running 12 | # untrusted code in a context where you have elevated privileges, but they explicitly 13 | # call out the use case of reformatting and committing back / commenting on the PR 14 | # as a situation that should be safe (because we aren't actually running the untrusted 15 | # code, we are just treating it as passive data). 16 | # https://securitylab.github.com/resources/github-actions-preventing-pwn-requests/ 17 | pull_request_target: 18 | 19 | name: format-suggest.yaml 20 | 21 | jobs: 22 | format-suggest: 23 | name: format-suggest 24 | runs-on: ubuntu-latest 25 | 26 | permissions: 27 | # Required to push suggestion comments to the PR 28 | pull-requests: write 29 | 30 | steps: 31 | - uses: actions/checkout@v6 32 | with: 33 | ref: ${{ github.event.pull_request.head.sha }} 34 | 35 | - name: Install 36 | uses: posit-dev/setup-air@v1 37 | 38 | - name: Format 39 | run: air format . 40 | 41 | - name: Suggest 42 | uses: reviewdog/action-suggester@v1 43 | with: 44 | level: error 45 | fail_level: error 46 | tool_name: air 47 | -------------------------------------------------------------------------------- /R/diagnostic_draws.R: -------------------------------------------------------------------------------- 1 | #' Diagnostic values for each iteration 2 | #' 3 | #' Returns the accumulated log-posterior, the average Metropolis acceptance rate, divergent transitions, treedepth rather than terminated its evolution normally. 4 | #' @inheritParams diagnostic_posterior 5 | #' 6 | #' @examples 7 | #' \donttest{ 8 | #' set.seed(333) 9 | #' 10 | #' if (require("brms", quietly = TRUE)) { 11 | #' model <- suppressWarnings(brm(mpg ~ wt * cyl * vs, 12 | #' data = mtcars, 13 | #' iter = 100, control = list(adapt_delta = 0.80), 14 | #' refresh = 0 15 | #' )) 16 | #' diagnostic_draws(model) 17 | #' } 18 | #' } 19 | #' 20 | #' @export 21 | diagnostic_draws <- function(posterior, ...) { 22 | UseMethod("diagnostic_draws") 23 | } 24 | 25 | 26 | #' @export 27 | diagnostic_draws.brmsfit <- function(posterior, ...) { 28 | insight::check_if_installed("brms") 29 | 30 | nuts_parameters <- brms::nuts_params(posterior) 31 | nuts_parameters$idvar <- paste0( 32 | nuts_parameters$Chain, 33 | "_", 34 | nuts_parameters$Iteration 35 | ) 36 | out <- stats::reshape( 37 | nuts_parameters, 38 | v.names = "Value", 39 | idvar = "idvar", 40 | timevar = "Parameter", 41 | direction = "wide" 42 | ) 43 | out$idvar <- NULL 44 | out <- merge( 45 | out, 46 | brms::log_posterior(posterior), 47 | by = c("Chain", "Iteration"), 48 | sort = FALSE 49 | ) 50 | 51 | # Rename 52 | names(out)[names(out) == "Value.accept_stat__"] <- "Acceptance_Rate" 53 | names(out)[names(out) == "Value.treedepth__"] <- "Tree_Depth" 54 | names(out)[names(out) == "Value.stepsize__"] <- "Step_Size" 55 | names(out)[names(out) == "Value.divergent__"] <- "Divergent" 56 | names(out)[names(out) == "Value.n_leapfrog__"] <- "n_Leapfrog" 57 | names(out)[names(out) == "Value.energy__"] <- "Energy" 58 | names(out)[names(out) == "Value"] <- "LogPosterior" 59 | 60 | out 61 | } 62 | -------------------------------------------------------------------------------- /man/sensitivity_to_prior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sensitivity_to_prior.R 3 | \name{sensitivity_to_prior} 4 | \alias{sensitivity_to_prior} 5 | \alias{sensitivity_to_prior.stanreg} 6 | \title{Sensitivity to Prior} 7 | \usage{ 8 | sensitivity_to_prior(model, ...) 9 | 10 | \method{sensitivity_to_prior}{stanreg}(model, index = "Median", magnitude = 10, ...) 11 | } 12 | \arguments{ 13 | \item{model}{A Bayesian model (\code{stanreg} or \code{brmsfit}).} 14 | 15 | \item{...}{Arguments passed to or from other methods.} 16 | 17 | \item{index}{The indices from which to compute the sensitivity. Can be one or 18 | multiple names of the columns returned by \code{describe_posterior}. The case is 19 | important here (e.g., write 'Median' instead of 'median').} 20 | 21 | \item{magnitude}{This represent the magnitude by which to shift the 22 | antagonistic prior (to test the sensitivity). For instance, a magnitude of 23 | 10 (default) means that the mode will be updated with a prior located at 10 24 | standard deviations from its original location.} 25 | } 26 | \description{ 27 | Computes the sensitivity to priors specification. This represents the 28 | proportion of change in some indices when the model is fitted with an 29 | antagonistic prior (a prior of same shape located on the opposite of the 30 | effect). 31 | } 32 | \examples{ 33 | \dontshow{if (require("rstanarm")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 34 | \donttest{ 35 | library(bayestestR) 36 | 37 | # rstanarm models 38 | # ----------------------------------------------- 39 | model <- rstanarm::stan_glm(mpg ~ wt, data = mtcars) 40 | sensitivity_to_prior(model) 41 | 42 | model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars) 43 | sensitivity_to_prior(model, index = c("Median", "MAP")) 44 | } 45 | \dontshow{\}) # examplesIf} 46 | } 47 | \seealso{ 48 | DescTools 49 | } 50 | -------------------------------------------------------------------------------- /vignettes/example3.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "3. Become a Bayesian master" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: true 6 | fig_width: 10.08 7 | fig_height: 6 8 | tags: [r, bayesian, posterior, test] 9 | vignette: > 10 | \usepackage[utf8]{inputenc} 11 | %\VignetteIndexEntry{3. Become a Bayesian master} 12 | %\VignetteEngine{knitr::rmarkdown} 13 | editor_options: 14 | chunk_output_type: console 15 | bibliography: bibliography.bib 16 | csl: apa.csl 17 | --- 18 | 19 | This vignette can be referred to by citing the package: 20 | 21 | - 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. https://doi.org/10.21105/joss.01541 22 | 23 | --- 24 | 25 | ```{r message=FALSE, warning=FALSE, include=FALSE} 26 | library(knitr) 27 | options(knitr.kable.NA = "") 28 | knitr::opts_chunk$set( 29 | comment = ">", 30 | message = FALSE, 31 | warning = FALSE, 32 | out.width = "100%" 33 | ) 34 | 35 | options(digits = 2) 36 | 37 | set.seed(333) 38 | ``` 39 | 40 | ```{r echo=FALSE, fig.cap="Yoda Bayes (896 BBY - 4 ABY).", fig.align='center', out.width="80%"} 41 | knitr::include_graphics("../man/figures/YodaBayes.jpg") 42 | ``` 43 | 44 | ## Mixed Models 45 | 46 | TO BE CONTINUED. 47 | 48 | ### Priors 49 | 50 | TO BE CONTINUED. 51 | 52 | 53 | ## What's next? 54 | 55 | The journey to become a true Bayesian master is not yet over. It is merely the 56 | beginning. It is now time to leave the `bayestestR` universe and apply the 57 | Bayesian framework in a variety of other statistical contexts: 58 | 59 | - [**Marginal means**](https://easystats.github.io/modelbased/articles/estimate_means.html) 60 | - [**Contrast analysis**](https://easystats.github.io/modelbased/articles/estimate_contrasts.html) 61 | - [**Testing Contrasts from Bayesian Models with 'emmeans' and 'bayestestR'**](https://easystats.github.io/blog/posts/bayestestr_emmeans/) 62 | -------------------------------------------------------------------------------- /tests/testthat/test-equivalence_test.R: -------------------------------------------------------------------------------- 1 | skip_on_cran() 2 | 3 | test_that("equivalence test, rstanarm", { 4 | skip_if_not_installed("curl") 5 | skip_if_offline() 6 | skip_if_not_installed("httr2") 7 | skip_if_not_or_load_if_installed("rstanarm") 8 | m <- insight::download_model("stanreg_merMod_5") 9 | 10 | out <- equivalence_test(m, verbose = FALSE) 11 | expect_snapshot(print(out)) 12 | 13 | out <- equivalence_test( 14 | m, 15 | range = list(c(-1, 1), "default", c(0, 2), c(-2, 0), "default"), 16 | verbose = FALSE 17 | ) 18 | expect_snapshot(print(out)) 19 | 20 | expect_error( 21 | equivalence_test( 22 | m, 23 | range = list(c(-1, 1), "default", c(0, 2), c(-2, 0)), 24 | verbose = FALSE 25 | ), 26 | regex = "Length of" 27 | ) 28 | expect_error( 29 | equivalence_test( 30 | m, 31 | range = list(c(-1, 1), "default", c(0, 2), c(-2, 0), "a"), 32 | verbose = FALSE 33 | ), 34 | regex = "should be 'default'" 35 | ) 36 | }) 37 | 38 | 39 | test_that("equivalence test, df", { 40 | skip_if_not_installed("curl") 41 | skip_if_offline() 42 | skip_if_not_installed("httr2") 43 | skip_if_not_or_load_if_installed("rstanarm") 44 | m <- insight::download_model("stanreg_merMod_5") 45 | params <- as.data.frame(m)[1:5] 46 | 47 | out <- equivalence_test(params, verbose = FALSE) 48 | expect_snapshot(print(out)) 49 | 50 | out <- equivalence_test( 51 | params, 52 | range = list(c(-1, 1), "default", c(0, 2), c(-2, 0), "default"), 53 | verbose = FALSE 54 | ) 55 | expect_snapshot(print(out)) 56 | 57 | expect_error( 58 | equivalence_test( 59 | params, 60 | range = list(c(-1, 1), "default", c(0, 2), c(-2, 0)), 61 | verbose = FALSE 62 | ), 63 | regex = "Length of" 64 | ) 65 | expect_error( 66 | equivalence_test( 67 | params, 68 | range = list(c(-1, 1), "default", c(0, 2), c(-2, 0), "a"), 69 | verbose = FALSE 70 | ), 71 | regex = "should be 'default'" 72 | ) 73 | }) 74 | -------------------------------------------------------------------------------- /tests/testthat/test-format.R: -------------------------------------------------------------------------------- 1 | test_that("p_significance", { 2 | set.seed(333) 3 | x <- rnorm(100) 4 | expect_equal( 5 | format(point_estimate(x)), 6 | data.frame(Median = "0.05", Mean = "-0.02", MAP = "0.13", stringsAsFactors = FALSE), 7 | ignore_attr = TRUE 8 | ) 9 | expect_equal( 10 | format(ci(x)), 11 | data.frame(`95% CI` = "[-1.93, 1.77]", stringsAsFactors = FALSE), 12 | ignore_attr = TRUE 13 | ) 14 | expect_equal( 15 | format(p_rope(x)), 16 | data.frame(ROPE = "[-0.10, 0.10]", `p (ROPE)` = "0.100", stringsAsFactors = FALSE), 17 | ignore_attr = TRUE 18 | ) 19 | expect_equal( 20 | format(map_estimate(x)), 21 | data.frame(Parameter = "x", MAP_Estimate = "0.13", stringsAsFactors = FALSE), 22 | ignore_attr = TRUE 23 | ) 24 | expect_equal( 25 | format(p_direction(x)), 26 | data.frame(Parameter = "Posterior", pd = "51.00%", stringsAsFactors = FALSE), 27 | ignore_attr = TRUE 28 | ) 29 | expect_equal( 30 | format(p_map(x)), 31 | data.frame(Parameter = "Posterior", p_MAP = "0.973", stringsAsFactors = FALSE), 32 | ignore_attr = TRUE 33 | ) 34 | expect_equal( 35 | format(p_significance(x)), 36 | data.frame(Parameter = "Posterior", ps = "0.46", stringsAsFactors = FALSE), 37 | ignore_attr = TRUE 38 | ) 39 | expect_equal( 40 | format(rope(x)), 41 | data.frame(CI = "0.95", ROPE = "[-0.10, 0.10]", `% in ROPE` = "10.64%", stringsAsFactors = FALSE), 42 | ignore_attr = TRUE 43 | ) 44 | expect_equal( 45 | format(equivalence_test(x)), 46 | data.frame( 47 | CI = "0.95", ROPE = "[-0.10, 0.10]", `% in ROPE` = "10.64%", 48 | `Equivalence (ROPE)` = "Undecided", HDI_low = "-1.93", HDI_high = "1.77", 49 | stringsAsFactors = FALSE 50 | ), 51 | ignore_attr = TRUE 52 | ) 53 | skip_if_not_installed("logspline") 54 | expect_equal( 55 | format(bayesfactor_parameters(x, verbose = FALSE)), 56 | data.frame(BF = "1.00", stringsAsFactors = FALSE), 57 | ignore_attr = TRUE 58 | ) 59 | }) 60 | -------------------------------------------------------------------------------- /tests/testthat/test-p_map.R: -------------------------------------------------------------------------------- 1 | test_that("p_map", { 2 | x <- distribution_normal(1000, 0.4) 3 | pmap <- p_map(x) 4 | expect_equal(as.numeric(pmap), 0.9285376, tolerance = 0.001) 5 | expect_s3_class(pmap, "p_map") 6 | expect_s3_class(pmap, "data.frame") 7 | expect_identical(dim(pmap), c(1L, 2L)) 8 | expect_identical( 9 | capture.output(print(pmap)), 10 | c( 11 | "MAP-based p-value", "", "Parameter | p (MAP)", 12 | "-------------------", "Posterior | 0.929" 13 | ) 14 | ) 15 | 16 | expect_equal(as.numeric(p_map(distribution_normal(1000))), 1, tolerance = 0.1) 17 | expect_equal(as.numeric(p_map(distribution_normal(1000, 1, 1))), 0.62, tolerance = 0.1) 18 | expect_equal(as.numeric(p_map(distribution_normal(1000, 2, 1))), 0.15, tolerance = 0.1) 19 | expect_equal(as.numeric(p_map(distribution_normal(1000, 3, 0.01))), 0, tolerance = 0.1) 20 | }) 21 | 22 | 23 | test_that("p_map", { 24 | skip_if_not_installed("curl") 25 | skip_if_offline() 26 | skip_if_not_installed("httr2") 27 | skip_if_not_or_load_if_installed("rstanarm") 28 | 29 | m <- insight::download_model("stanreg_merMod_5") 30 | p <- insight::get_parameters(m, effects = "all") 31 | 32 | expect_equal( 33 | p_map(m, effects = "all")$p_MAP, 34 | p_map(p)$p_MAP, 35 | tolerance = 0.1 36 | ) 37 | }) 38 | 39 | 40 | test_that("p_map", { 41 | skip_if_not_installed("curl") 42 | skip_if_offline() 43 | skip_if_not_installed("httr2") 44 | skip_if_not_or_load_if_installed("brms") 45 | 46 | m <- insight::download_model("brms_zi_3") 47 | p <- insight::get_parameters(m, effects = "all", component = "all") 48 | 49 | expect_equal( 50 | p_map(m, effects = "all", component = "all")$p_MAP, 51 | p_map(p)$p_MAP, 52 | tolerance = 0.1 53 | ) 54 | }) 55 | 56 | 57 | test_that("p_map | null", { 58 | x <- distribution_normal(4000, mean = 1) 59 | expect_equal(as.numeric(p_map(x)), 0.6194317, ignore_attr = TRUE, tolerance = 0.01) 60 | expect_equal(as.numeric(p_map(x, null = 1)), 1, ignore_attr = TRUE, tolerance = 0.01) 61 | }) 62 | -------------------------------------------------------------------------------- /tests/testthat/test-si.R: -------------------------------------------------------------------------------- 1 | test_that("si.numeric", { 2 | skip_if_not_installed("logspline") 3 | 4 | set.seed(333) 5 | prior <- distribution_normal(1000, mean = 0, sd = 1) 6 | posterior <- distribution_normal(1000, mean = 0.5, sd = 0.3) 7 | 8 | expect_warning( 9 | { 10 | res <- si(posterior, prior) 11 | }, 12 | regexp = "40" 13 | ) 14 | expect_equal(res$CI_low, 0.043, tolerance = 0.02) 15 | expect_equal(res$CI_high, 1.053103, tolerance = 0.02) 16 | expect_s3_class(res, "bayestestR_si") 17 | 18 | res <- si(posterior, prior, BF = 3, verbose = FALSE) 19 | expect_equal(res$CI_low, 0.35, tolerance = 0.02) 20 | expect_equal(res$CI_high, 0.759, tolerance = 0.02) 21 | 22 | res <- si(posterior, prior, BF = 100, verbose = FALSE) 23 | expect_true(all(is.na(res$CI_low))) 24 | expect_true(all(is.na(res$CI_high))) 25 | 26 | res <- si(posterior, prior, BF = c(1 / 3, 1, 3), verbose = FALSE) 27 | expect_equal(res$CI, c(1 / 3, 1, 3), tolerance = 0.02) 28 | expect_equal(res$CI_low, c(-0.1277, 0.0426, 0.3549), tolerance = 0.02) 29 | expect_equal(res$CI_high, c(1.213, 1.053, 0.759), tolerance = 0.02) 30 | }) 31 | 32 | test_that("si.rstanarm", { 33 | skip_on_cran() 34 | skip_if_not_installed("rstanarm") 35 | 36 | data(sleep) 37 | contrasts(sleep$group) <- contr.equalprior_pairs # See vignette 38 | stan_model <- suppressWarnings(rstanarm::stan_glmer(extra ~ group + (1 | ID), data = sleep, refresh = 0)) 39 | 40 | set.seed(333) 41 | stan_model_p <- update(stan_model, prior_PD = TRUE) 42 | res1 <- si(stan_model, stan_model_p, verbose = FALSE) 43 | 44 | set.seed(333) 45 | res2 <- si(stan_model, verbose = FALSE) 46 | 47 | expect_s3_class(res1, "bayestestR_si") 48 | expect_equal(res1, res2, ignore_attr = TRUE) 49 | 50 | skip_if_not_installed("emmeans") 51 | set.seed(123) 52 | group_diff <- suppressWarnings(pairs(emmeans::emmeans(stan_model, ~group))) 53 | res3 <- si(group_diff, prior = stan_model, verbose = FALSE) 54 | 55 | expect_equal(res3$CI_low, -2.746, tolerance = 0.3) 56 | expect_equal(res3$CI_high, -0.4, tolerance = 0.3) 57 | }) 58 | -------------------------------------------------------------------------------- /tests/testthat/test-contr.R: -------------------------------------------------------------------------------- 1 | test_that("contr.equalprior | gen", { 2 | skip_on_cran() 3 | set.seed(1234) 4 | 5 | k <- 3 6 | g <- 4.1 7 | 8 | contr1 <- contr.equalprior(k, contrasts = TRUE) 9 | contr2 <- contr.equalprior(k, contrasts = FALSE) 10 | 11 | samps1 <- replicate(ncol(contr1), { 12 | rnorm(4e3, 0, g) 13 | }) 14 | samps2 <- replicate(ncol(contr2), { 15 | rnorm(4e3, 0, g) 16 | }) 17 | 18 | means1 <- t(contr1 %*% t(samps1)) 19 | means2 <- t(contr2 %*% t(samps2)) 20 | 21 | expect_equal(mean(apply(means1, 2, sd)), mean(apply(means2, 2, sd)), tolerance = 0.1) 22 | }) 23 | 24 | test_that("contr.equalprior | pairs", { 25 | skip_on_cran() 26 | set.seed(1234) 27 | 28 | k <- 3 29 | g <- 4.1 30 | 31 | contr1 <- contr.equalprior_pairs(k, contrasts = TRUE) 32 | contr2 <- contr.equalprior_pairs(k, contrasts = FALSE) 33 | 34 | samps1 <- replicate(ncol(contr1), { 35 | rnorm(4e3, 0, g) 36 | }) 37 | samps2 <- replicate(ncol(contr2), { 38 | rnorm(4e3, 0, g) 39 | }) 40 | 41 | means1 <- t(contr1 %*% t(samps1)) 42 | means2 <- t(contr2 %*% t(samps2)) 43 | 44 | w <- matrix(c( 45 | -1, 1, 0, 46 | 1, 0, -1, 47 | 0, -1, 1 48 | ), 3, 3) 49 | 50 | pairs1 <- t(w %*% t(means1)) 51 | pairs2 <- t(w %*% t(means2)) 52 | 53 | expect_equal(mean(apply(pairs1, 2, sd)), g, tolerance = 0.1) 54 | expect_equal(mean(apply(pairs1, 2, sd)), mean(apply(pairs2, 2, sd)), tolerance = 0.1) 55 | }) 56 | 57 | 58 | test_that("contr.equalprior | dev", { 59 | skip_on_cran() 60 | set.seed(1234) 61 | 62 | k <- 3 63 | g <- 4.1 64 | 65 | contr1 <- contr.equalprior_deviations(k, contrasts = TRUE) 66 | contr2 <- contr.equalprior_deviations(k, contrasts = FALSE) 67 | 68 | samps1 <- replicate(ncol(contr1), { 69 | rnorm(4e3, 0, g) 70 | }) 71 | samps2 <- replicate(ncol(contr2), { 72 | rnorm(4e3, 0, g) 73 | }) 74 | 75 | means1 <- t(contr1 %*% t(samps1)) 76 | means2 <- t(contr2 %*% t(samps2)) 77 | 78 | expect_equal(mean(apply(means1, 2, sd)), g, tolerance = 0.1) 79 | expect_equal(mean(apply(means1, 2, sd)), mean(apply(means2, 2, sd)), tolerance = 0.1) 80 | }) 81 | -------------------------------------------------------------------------------- /vignettes/indicesExistenceComparison.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "In-Depth 2: Comparison of Indices of Effect Existence and Significance" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: false 6 | toc_depth: 3 7 | fig_width: 10.08 8 | fig_height: 6 9 | tags: [r, bayesian, posterior, test] 10 | vignette: > 11 | \usepackage[utf8]{inputenc} 12 | %\VignetteIndexEntry{In-Depth 2: Comparison of Indices of Effect Existence and Significance} 13 | %\VignetteEngine{knitr::rmarkdown} 14 | editor_options: 15 | chunk_output_type: console 16 | bibliography: bibliography.bib 17 | csl: apa.csl 18 | --- 19 | 20 | ```{r message=FALSE, warning=FALSE, include=FALSE} 21 | library(knitr) 22 | options(knitr.kable.NA = "") 23 | knitr::opts_chunk$set(comment = ">", dpi = 75, out.width = "100%") 24 | options(digits = 2) 25 | ``` 26 | 27 | 28 | This vignette can be referred to by citing the following: 29 | 30 | - 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. https://doi.org/10.21105/joss.01541 31 | - 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) 32 | 33 | --- 34 | 35 | # Indices of Effect *Existence* and *Significance* in the Bayesian Framework 36 | 37 | A comparison of different Bayesian indices (*pd*, *BFs*, ROPE etc.) is accessible [**here**](https://doi.org/10.3389/fpsyg.2019.02767). 38 | 39 | But, in case you don't wish to read the full article, the following table 40 | summarizes the key takeaways! 41 | 42 | ```{r, echo=FALSE} 43 | knitr::include_graphics("https://www.frontiersin.org/files/Articles/498833/fpsyg-10-02767-HTML/image_m/fpsyg-10-02767-t003.jpg") 44 | ``` 45 | 46 | # Suggestions 47 | 48 | If you have any advice, opinion or such, we encourage you to let us know by 49 | opening an [discussion thread](https://github.com/easystats/bayestestR/issues) 50 | or making a pull request. 51 | -------------------------------------------------------------------------------- /R/area_under_curve.R: -------------------------------------------------------------------------------- 1 | #' Area under the Curve (AUC) 2 | #' 3 | #' Based on the DescTools `AUC` function. It can calculate the area under the 4 | #' curve with a naive algorithm or a more elaborated spline approach. The curve 5 | #' must be given by vectors of xy-coordinates. This function can handle unsorted 6 | #' x values (by sorting x) and ties for the x values (by ignoring duplicates). 7 | #' 8 | #' @param x Vector of x values. 9 | #' @param y Vector of y values. 10 | #' @param method Method to compute the Area Under the Curve (AUC). Can be 11 | #' `"trapezoid"` (default), `"step"` or `"spline"`. If "trapezoid", the curve 12 | #' is formed by connecting all points by a direct line (composite trapezoid 13 | #' rule). If "step" is chosen then a stepwise connection of two points is 14 | #' used. For calculating the area under a spline interpolation the splinefun 15 | #' function is used in combination with integrate. 16 | #' @param ... Arguments passed to or from other methods. 17 | #' 18 | #' 19 | #' @examples 20 | #' library(bayestestR) 21 | #' posterior <- distribution_normal(1000) 22 | #' 23 | #' dens <- estimate_density(posterior) 24 | #' dens <- dens[dens$x > 0, ] 25 | #' x <- dens$x 26 | #' y <- dens$y 27 | #' 28 | #' area_under_curve(x, y, method = "trapezoid") 29 | #' area_under_curve(x, y, method = "step") 30 | #' area_under_curve(x, y, method = "spline") 31 | #' @seealso DescTools 32 | #' @export 33 | area_under_curve <- function(x, y, method = c("trapezoid", "step", "spline"), ...) { 34 | # From DescTools [GPL-3]: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r 35 | 36 | if (length(x) != length(y)) { 37 | insight::format_error("Length of x must be equal to length of y.") 38 | } 39 | 40 | idx <- order(x) 41 | x <- x[idx] 42 | y <- y[idx] 43 | 44 | switch(match.arg(arg = method, choices = c("trapezoid", "step", "spline")), 45 | trapezoid = sum((rowMeans(cbind(y[-length(y)], y[-1]))) * (x[-1] - x[-length(x)])), 46 | step = sum(y[-length(y)] * (x[-1] - x[-length(x)])), 47 | spline = stats::integrate(stats::splinefun(x, y, method = "natural"), lower = min(x), upper = max(x))$value 48 | ) 49 | } 50 | 51 | #' @rdname area_under_curve 52 | #' @export 53 | auc <- area_under_curve 54 | -------------------------------------------------------------------------------- /vignettes/overview_of_vignettes.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Overview of Vignettes" 3 | output: 4 | rmarkdown::html_vignette: 5 | vignette: > 6 | %\VignetteIndexEntry{Overview of Vignettes} 7 | \usepackage[utf8]{inputenc} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | editor_options: 10 | chunk_output_type: console 11 | --- 12 | 13 | ```{r message=FALSE, warning=FALSE, include=FALSE} 14 | library(knitr) 15 | knitr::opts_chunk$set( 16 | echo = TRUE, 17 | collapse = TRUE, 18 | warning = FALSE, 19 | message = FALSE, 20 | comment = "#>", 21 | eval = TRUE 22 | ) 23 | ``` 24 | 25 | All package vignettes are available at [https://easystats.github.io/bayestestR/](https://easystats.github.io/bayestestR/). 26 | 27 | ## Function Overview 28 | 29 | * [Function Reference](https://easystats.github.io/bayestestR/reference/index.html) 30 | 31 | ## Get Started 32 | 33 | * [Get Started with Bayesian Analysis](https://easystats.github.io/bayestestR/articles/bayestestR.html) 34 | 35 | ## Examples 36 | 37 | 1. [Initiation to Bayesian models](https://easystats.github.io/bayestestR/articles/example1.html) 38 | 2. [Confirmation of Bayesian skills](https://easystats.github.io/bayestestR/articles/example2.html) 39 | 3. [Become a Bayesian master](https://easystats.github.io/bayestestR/articles/example3.html) 40 | 41 | ## Articles 42 | 43 | * [Credible Intervals (CI))](https://easystats.github.io/bayestestR/articles/credible_interval.html) 44 | * [Region of Practical Equivalence (ROPE)](https://easystats.github.io/bayestestR/articles/region_of_practical_equivalence.html) 45 | * [Probability of Direction (pd)](https://easystats.github.io/bayestestR/articles/probability_of_direction.html) 46 | * [Bayes Factors](https://easystats.github.io/bayestestR/articles/bayes_factors.html) 47 | 48 | ## In-Depths 49 | 50 | * [Comparison of Point-Estimates](https://easystats.github.io/bayestestR/articles/web_only/indicesEstimationComparison.html) 51 | * [Indices of Effect Existence and Significance in the Bayesian Framework](https://www.frontiersin.org/articles/10.3389/fpsyg.2019.02767/full) 52 | * [Mediation Analysis using Bayesian Regression Models](https://easystats.github.io/bayestestR/articles/mediation.html) 53 | 54 | ## Guidelines 55 | 56 | * [Reporting Guidelines](https://easystats.github.io/bayestestR/articles/guidelines.html) 57 | -------------------------------------------------------------------------------- /R/print.equivalence_test.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | print.equivalence_test <- function(x, digits = 2, ...) { 3 | orig_x <- x 4 | insight::print_color("# Test for Practical Equivalence\n\n", "blue") 5 | # print ROPE limits, if we just have one set of ROPE values 6 | if (insight::has_single_value(x$ROPE_low, remove_na = TRUE)) { 7 | cat(sprintf(" ROPE: [%.*f %.*f]\n\n", digits, x$ROPE_low[1], digits, x$ROPE_high[1])) 8 | } 9 | 10 | # fix "sd" pattern 11 | model <- .retrieve_model(x) 12 | if (!is.null(model) && !is.data.frame(model)) { 13 | cp <- insight::clean_parameters(model) 14 | if (!is.null(cp$Group) && any(startsWith(cp$Group, "SD/Cor"))) { 15 | cp <- cp[startsWith(cp$Group, "SD/Cor"), ] 16 | matches <- match(cp$Parameter, x$Parameter) 17 | if (length(matches)) { 18 | new_pattern <- paste0( 19 | "SD/Cor: ", 20 | cp$Cleaned_Parameter[unique(stats::na.omit(match(x$Parameter, cp$Parameter)))] 21 | ) 22 | if (length(new_pattern) == length(matches)) { 23 | x$Parameter[matches] <- new_pattern 24 | } 25 | } 26 | } 27 | } 28 | 29 | x$ROPE_Percentage <- sprintf("%.*f %%", digits, x$ROPE_Percentage * 100) 30 | x$HDI <- insight::format_ci(x$HDI_low, x$HDI_high, ci = NULL, digits = digits) 31 | 32 | ci <- unique(x$CI) 33 | keep.columns <- c( 34 | attr(x, "idvars"), "Parameter", "Effects", "Component", 35 | "ROPE_Equivalence", "ROPE_Percentage", "CI", "HDI" 36 | ) 37 | 38 | # keep ROPE columns for multiple ROPE values 39 | if (insight::n_unique(x$ROPE_low) > 1) { 40 | keep.columns <- c(keep.columns, "ROPE") 41 | x$ROPE <- insight::format_ci(x$ROPE_low, x$ROPE_high, ci = NULL, digits = digits) 42 | } 43 | 44 | x <- x[, intersect(keep.columns, colnames(x))] 45 | 46 | colnames(x)[which(colnames(x) == "ROPE_Equivalence")] <- "H0" 47 | colnames(x)[which(colnames(x) == "ROPE_Percentage")] <- "inside ROPE" 48 | 49 | .print_equivalence_component(x, ci, digits) 50 | 51 | invisible(orig_x) 52 | } 53 | 54 | 55 | .print_equivalence_component <- function(x, ci, digits) { 56 | for (i in ci) { 57 | xsub <- x[x$CI == i, -which(colnames(x) == "CI"), drop = FALSE] 58 | colnames(xsub)[colnames(xsub) == "HDI"] <- sprintf("%i%% HDI", 100 * i) 59 | .print_data_frame(xsub, digits = digits) 60 | cat("\n") 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | # snSMART 2 | 3 |
4 | 5 | * Version: 0.2.2 6 | * GitHub: https://github.com/sidiwang/snSMART 7 | * Source code: https://github.com/cran/snSMART 8 | * Date/Publication: 2022-11-16 15:00:11 UTC 9 | * Number of recursive dependencies: 55 10 | 11 | Run `revdep_details(, "snSMART")` for more info 12 | 13 |
14 | 15 | ## In both 16 | 17 | * checking whether package 'snSMART' can be installed ... ERROR 18 | ``` 19 | Installation failed. 20 | See 'D:/mail/Documents/Coding/R/easystats/bayestestR/revdep/checks/snSMART/new/snSMART.Rcheck/00install.out' for details. 21 | ``` 22 | 23 | ## Installation 24 | 25 | ### Devel 26 | 27 | ``` 28 | * installing *source* package 'snSMART' ... 29 | ** package 'snSMART' successfully unpacked and MD5 sums checked 30 | ** using staged installation 31 | ** R 32 | ** data 33 | *** moving datasets to lazyload DB 34 | ** byte-compile and prepare package for lazy loading 35 | Error: .onLoad failed in loadNamespace() for 'rjags', details: 36 | call: fun(libname, pkgname) 37 | error: Failed to locate any version of JAGS version 4 38 | 39 | The rjags package is just an interface to the JAGS library 40 | Make sure you have installed JAGS-4.x.y.exe (for any x >=0, y>=0) from 41 | http://www.sourceforge.net/projects/mcmc-jags/files 42 | Execution halted 43 | ERROR: lazy loading failed for package 'snSMART' 44 | * removing 'D:/mail/Documents/Coding/R/easystats/bayestestR/revdep/checks/snSMART/new/snSMART.Rcheck/snSMART' 45 | 46 | 47 | ``` 48 | ### CRAN 49 | 50 | ``` 51 | * installing *source* package 'snSMART' ... 52 | ** package 'snSMART' successfully unpacked and MD5 sums checked 53 | ** using staged installation 54 | ** R 55 | ** data 56 | *** moving datasets to lazyload DB 57 | ** byte-compile and prepare package for lazy loading 58 | Error: .onLoad failed in loadNamespace() for 'rjags', details: 59 | call: fun(libname, pkgname) 60 | error: Failed to locate any version of JAGS version 4 61 | 62 | The rjags package is just an interface to the JAGS library 63 | Make sure you have installed JAGS-4.x.y.exe (for any x >=0, y>=0) from 64 | http://www.sourceforge.net/projects/mcmc-jags/files 65 | Execution halted 66 | ERROR: lazy loading failed for package 'snSMART' 67 | * removing 'D:/mail/Documents/Coding/R/easystats/bayestestR/revdep/checks/snSMART/old/snSMART.Rcheck/snSMART' 68 | 69 | 70 | ``` 71 | -------------------------------------------------------------------------------- /tests/testthat/test-ci.R: -------------------------------------------------------------------------------- 1 | test_that("ci", { 2 | skip_on_os(c("mac", "linux")) 3 | skip_if_not_or_load_if_installed("quadprog") 4 | set.seed(123) 5 | x <- rnorm(1000, 3, 2) 6 | expect_error(ci(x, method = "FDI"), regex = "`method` should be 'ETI'") 7 | out <- capture.output(print(ci(x, method = "SPI"))) 8 | expect_identical(out, "95% SPI: [-1.16, 6.76]") 9 | out <- capture.output(print(ci(x, method = "BCI"))) 10 | expect_identical(out, "95% ETI: [-0.88, 7.08]") 11 | }) 12 | 13 | 14 | test_that("ci", { 15 | expect_equal(ci(distribution_normal(1000), ci = 0.90)$CI_low[1], -1.6361, tolerance = 0.02) 16 | expect_equal(nrow(ci(distribution_normal(1000), ci = c(0.80, 0.90, 0.95))), 3, tolerance = 0.01) 17 | expect_equal(ci(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02) 18 | expect_length(capture.output(print(ci(distribution_normal(1000), ci = c(0.80, 0.90)))), 5) 19 | 20 | expect_equal(ci(c(2, 3, NA))$CI_low, 2.02, tolerance = 1e-2) 21 | expect_warning(ci(c(2, 3))) 22 | expect_warning(ci(distribution_normal(1000), ci = 950)) 23 | 24 | x <- data.frame(replicate(4, rnorm(100))) 25 | x <- ci(x, ci = c(0.68, 0.89, 0.95)) 26 | a <- datawizard::reshape_ci(x) 27 | expect_identical(c(nrow(x), ncol(x)), c(12L, 4L)) 28 | expect_true(all(datawizard::reshape_ci(a) == x)) 29 | }) 30 | 31 | 32 | test_that("ci", { 33 | skip_if_not_installed("curl") 34 | skip_if_offline() 35 | skip_if_not_installed("httr2") 36 | skip_if_not_or_load_if_installed("rstanarm") 37 | skip_if_not_or_load_if_installed("brms") 38 | 39 | m <- insight::download_model("stanreg_merMod_5") 40 | p <- insight::get_parameters(m, effects = "all") 41 | 42 | expect_equal( 43 | ci(m, ci = c(0.5, 0.8), effects = "all")$CI_low, 44 | ci(p, ci = c(0.5, 0.8))$CI_low, 45 | tolerance = 1e-3 46 | ) 47 | }) 48 | 49 | 50 | test_that("rope", { 51 | skip_if_not_installed("curl") 52 | skip_if_offline() 53 | skip_if_not_installed("httr2") 54 | skip_if_not_or_load_if_installed("rstanarm") 55 | skip_if_not_or_load_if_installed("brms") 56 | 57 | m <- insight::download_model("brms_zi_3") 58 | p <- insight::get_parameters(m, effects = "all", component = "all") 59 | 60 | expect_equal( 61 | ci(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, 62 | ci(p, ci = c(0.5, 0.8))$CI_low, 63 | tolerance = 1e-3 64 | ) 65 | }) 66 | -------------------------------------------------------------------------------- /man/pd_to_p.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/convert_pd_to_p.R 3 | \name{pd_to_p} 4 | \alias{pd_to_p} 5 | \alias{pd_to_p.numeric} 6 | \alias{p_to_pd} 7 | \alias{convert_p_to_pd} 8 | \alias{convert_pd_to_p} 9 | \title{Convert between Probability of Direction (pd) and p-value.} 10 | \usage{ 11 | pd_to_p(pd, ...) 12 | 13 | \method{pd_to_p}{numeric}(pd, direction = "two-sided", verbose = TRUE, ...) 14 | 15 | p_to_pd(p, direction = "two-sided", ...) 16 | 17 | convert_p_to_pd(p, direction = "two-sided", ...) 18 | 19 | convert_pd_to_p(pd, ...) 20 | } 21 | \arguments{ 22 | \item{pd}{A Probability of Direction (pd) value (between 0 and 1). Can also 23 | be a data frame with a column named \code{pd}, \code{p_direction}, or \code{PD}, as returned 24 | by \code{\link[=p_direction]{p_direction()}}. In this case, the column is converted to p-values and 25 | the new data frame is returned.} 26 | 27 | \item{...}{Arguments passed to or from other methods.} 28 | 29 | \item{direction}{What type of p-value is requested or provided. Can be 30 | \code{"two-sided"} (default, two tailed) or \code{"one-sided"} (one tailed).} 31 | 32 | \item{verbose}{Toggle off warnings.} 33 | 34 | \item{p}{A p-value.} 35 | } 36 | \value{ 37 | A p-value or a data frame with a p-value column. 38 | } 39 | \description{ 40 | Enables a conversion between Probability of Direction (pd) and p-value. 41 | } 42 | \details{ 43 | Conversion is done using the following equation (see \emph{Makowski et al., 2019}): 44 | 45 | When \code{direction = "two-sided"} 46 | 47 | \ifelse{html}{\out{p = 2 * (1 - pd)}}{\eqn{p = 2 \times (1 - p_d)}} 48 | 49 | When \code{direction = "one-sided"} 50 | 51 | \ifelse{html}{\out{p = 1 - pd}}{\eqn{p = 1 - p_d}} 52 | 53 | Note that this conversion is only valid when the lowest possible values of pd 54 | is 0.5 - i.e., when the posterior represents continuous parameter space (see 55 | \code{\link[=p_direction]{p_direction()}}). If any pd < 0.5 are detected, they are converted to a p 56 | of 1, and a warning is given. 57 | } 58 | \examples{ 59 | pd_to_p(pd = 0.95) 60 | pd_to_p(pd = 0.95, direction = "one-sided") 61 | 62 | } 63 | \references{ 64 | Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). 65 | \emph{Indices of Effect Existence and Significance in the Bayesian Framework}. 66 | Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} 67 | } 68 | -------------------------------------------------------------------------------- /man/bayestestR-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bayestestR-package.R 3 | \docType{package} 4 | \name{bayestestR-package} 5 | \alias{bayestestR-package} 6 | \alias{bayestestR} 7 | \title{bayestestR: Describing Effects and their Uncertainty, Existence and 8 | Significance within the Bayesian Framework} 9 | \description{ 10 | Existing R packages allow users to easily fit a large variety of models 11 | and extract and visualize the posterior draws. However, most of these 12 | packages only return a limited set of indices (e.g., point-estimates and 13 | CIs). \strong{bayestestR} provides a comprehensive and consistent set of 14 | functions to analyze and describe posterior distributions generated by a 15 | variety of models objects, including popular modeling packages such as 16 | \strong{rstanarm}, \strong{brms} or \strong{BayesFactor}. 17 | 18 | References: 19 | \itemize{ 20 | \item Makowski et al. (2019) \doi{10.21105/joss.01541} 21 | \item Makowski et al. (2019) \doi{10.3389/fpsyg.2019.02767} 22 | } 23 | } 24 | \details{ 25 | \code{bayestestR} 26 | } 27 | \seealso{ 28 | Useful links: 29 | \itemize{ 30 | \item \url{https://easystats.github.io/bayestestR/} 31 | \item Report bugs at \url{https://github.com/easystats/bayestestR/issues} 32 | } 33 | 34 | } 35 | \author{ 36 | \strong{Maintainer}: Dominique Makowski \email{officialeasystats@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) 37 | 38 | Authors: 39 | \itemize{ 40 | \item Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) 41 | \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) 42 | \item Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) 43 | \item Micah K. Wilson \email{micah.k.wilson@curtin.edu.au} (\href{https://orcid.org/0000-0003-4143-7308}{ORCID}) 44 | \item Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) 45 | } 46 | 47 | Other contributors: 48 | \itemize{ 49 | \item Paul-Christian Bürkner \email{paul.buerkner@gmail.com} [reviewer] 50 | \item Tristan Mahr \email{tristan.mahr@wisc.edu} (\href{https://orcid.org/0000-0002-8890-5116}{ORCID}) [reviewer] 51 | \item Henrik Singmann \email{singmann@gmail.com} (\href{https://orcid.org/0000-0002-4842-3657}{ORCID}) [contributor] 52 | \item Quentin F. Gronau (\href{https://orcid.org/0000-0001-5510-6943}{ORCID}) [contributor] 53 | \item Sam Crawley \email{sam@crawley.nz} (\href{https://orcid.org/0000-0002-7847-0411}{ORCID}) [contributor] 54 | } 55 | 56 | } 57 | \keyword{internal} 58 | -------------------------------------------------------------------------------- /man/p_to_bf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/p_to_bf.R 3 | \name{p_to_bf} 4 | \alias{p_to_bf} 5 | \alias{p_to_bf.numeric} 6 | \alias{p_to_bf.default} 7 | \title{Convert p-values to (pseudo) Bayes Factors} 8 | \usage{ 9 | p_to_bf(x, ...) 10 | 11 | \method{p_to_bf}{numeric}(x, log = FALSE, n_obs = NULL, ...) 12 | 13 | \method{p_to_bf}{default}(x, log = FALSE, ...) 14 | } 15 | \arguments{ 16 | \item{x}{A (frequentist) model object, or a (numeric) vector of p-values.} 17 | 18 | \item{...}{Other arguments to be passed (not used for now).} 19 | 20 | \item{log}{Wether to return log Bayes Factors. \strong{Note:} The \code{print()} method 21 | always shows \code{BF} - the \code{"log_BF"} column is only accessible from the returned 22 | data frame.} 23 | 24 | \item{n_obs}{Number of observations. Either length 1, or same length as \code{p}.} 25 | } 26 | \value{ 27 | A data frame with the p-values and pseudo-Bayes factors (against the null). 28 | } 29 | \description{ 30 | Convert p-values to (pseudo) Bayes Factors. This transformation has been 31 | suggested by Wagenmakers (2022), but is based on a vast amount of assumptions. 32 | It might therefore be not reliable. Use at your own risks. For more accurate 33 | approximate Bayes factors, use \code{\link[=bic_to_bf]{bic_to_bf()}} instead. 34 | } 35 | \examples{ 36 | \dontshow{if (require("parameters")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 37 | data(iris) 38 | model <- lm(Petal.Length ~ Sepal.Length + Species, data = iris) 39 | p_to_bf(model) 40 | 41 | # Examples that demonstrate comparison between 42 | # BIC-approximated and pseudo BF 43 | # -------------------------------------------- 44 | m0 <- lm(mpg ~ 1, mtcars) 45 | m1 <- lm(mpg ~ am, mtcars) 46 | m2 <- lm(mpg ~ factor(cyl), mtcars) 47 | 48 | # In this first example, BIC-approximated BF and 49 | # pseudo-BF based on p-values are close... 50 | 51 | # BIC-approximated BF, m1 against null model 52 | bic_to_bf(BIC(m1), denominator = BIC(m0)) 53 | 54 | # pseudo-BF based on p-values - dropping intercept 55 | p_to_bf(m1)[-1, ] 56 | 57 | # The second example shows that results from pseudo-BF are less accurate 58 | # and should be handled wit caution! 59 | bic_to_bf(BIC(m2), denominator = BIC(m0)) 60 | p_to_bf(anova(m2), n_obs = nrow(mtcars)) 61 | \dontshow{\}) # examplesIf} 62 | } 63 | \references{ 64 | \itemize{ 65 | \item Wagenmakers, E.J. (2022). Approximate objective Bayes factors from p-values 66 | and sample size: The 3p(sqrt(n)) rule. Preprint available on ArXiv: 67 | https://psyarxiv.com/egydq 68 | } 69 | } 70 | \seealso{ 71 | \code{\link[=bic_to_bf]{bic_to_bf()}} for more accurate approximate Bayes factors. 72 | } 73 | -------------------------------------------------------------------------------- /tests/testthat/test-bayesfactor_restricted.R: -------------------------------------------------------------------------------- 1 | # bayesfactor_restricted data.frame --------------------------------------- 2 | 3 | test_that("bayesfactor_restricted df", { 4 | prior <- data.frame( 5 | X = distribution_normal(100), 6 | X1 = c(distribution_normal(50), distribution_normal(50)), 7 | X3 = c(distribution_normal(80), distribution_normal(20)) 8 | ) 9 | 10 | posterior <- data.frame( 11 | X = distribution_normal(100, 0.4, 0.2), 12 | X1 = distribution_normal(100, -0.2, 0.2), 13 | X3 = distribution_normal(100, 0.2) 14 | ) 15 | 16 | hyps <- c( 17 | "X > X1 & X1 > X3", 18 | "X > X1" 19 | ) 20 | 21 | bfr <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior) 22 | 23 | expect_equal(bfr$p_prior, c(0.2, 0.5), tolerance = 0.1) 24 | expect_equal(bfr$p_posterior, c(0.31, 1), tolerance = 0.1) 25 | expect_equal(bfr$log_BF, c(0.43, 0.69), tolerance = 0.1) 26 | expect_equal(exp(bfr$log_BF), bfr$p_posterior / bfr$p_prior, tolerance = 0.1) 27 | 28 | expect_error(bayesfactor_restricted(posterior, prior, hypothesis = "Y < 0")) 29 | }) 30 | 31 | test_that("bayesfactor_restricted | bayesfactor_matrix", { 32 | set.seed(444) 33 | prior <- data.frame( 34 | A = rnorm(500), 35 | B = rnorm(500), 36 | C = rnorm(500) 37 | ) 38 | 39 | posterior <- data.frame( 40 | A = rnorm(500, .4, 0.7), 41 | B = rnorm(500, -.2, 0.4), 42 | C = rnorm(500, 0, 0.5) 43 | ) 44 | 45 | hyps <- c( 46 | "A > B & B > C", 47 | "A > B & A > C", 48 | "C > A" 49 | ) 50 | 51 | 52 | b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior) 53 | bfmat <- as.matrix(b) 54 | 55 | expect_identical(unname(bfmat[1, -1]), b$log_BF) 56 | 57 | expect_identical(unname(diag(bfmat)), rep(0, 4)) 58 | expect_identical(-t(bfmat)[upper.tri(bfmat)], bfmat[upper.tri(bfmat)]) 59 | 60 | expect_output(print(bfmat), regexp = "Denominator\\\\Numerator") 61 | expect_output(print(bfmat), regexp = "Restricted") 62 | }) 63 | 64 | # bayesfactor_restricted RSTANARM ----------------------------------------- 65 | 66 | 67 | test_that("bayesfactor_restricted RSTANARM", { 68 | skip_on_cran() 69 | skip_if_not_installed("rstanarm") 70 | suppressWarnings( 71 | fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am, data = mtcars, refresh = 0, iter = 200) 72 | ) 73 | 74 | hyps <- c( 75 | "am > 0 & cyl < 0", 76 | "cyl < 0", 77 | "wt - cyl > 0" 78 | ) 79 | 80 | set.seed(444) 81 | fit_p <- suppressMessages(unupdate(fit_stan)) 82 | bfr1 <- bayesfactor_restricted(fit_stan, prior = fit_p, hypothesis = hyps) 83 | 84 | set.seed(444) 85 | bfr2 <- bayesfactor_restricted(fit_stan, hypothesis = hyps) 86 | 87 | expect_equal(bfr1, bfr2) 88 | }) 89 | -------------------------------------------------------------------------------- /man/simulate_correlation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_data.R 3 | \name{simulate_correlation} 4 | \alias{simulate_correlation} 5 | \alias{simulate_ttest} 6 | \alias{simulate_difference} 7 | \title{Data Simulation} 8 | \usage{ 9 | simulate_correlation(n = 100, r = 0.5, mean = 0, sd = 1, names = NULL, ...) 10 | 11 | simulate_ttest(n = 100, d = 0.5, names = NULL, ...) 12 | 13 | simulate_difference(n = 100, d = 0.5, names = NULL, ...) 14 | } 15 | \arguments{ 16 | \item{n}{The number of observations to be generated.} 17 | 18 | \item{r}{A value or vector corresponding to the desired correlation 19 | coefficients.} 20 | 21 | \item{mean}{A value or vector corresponding to the mean of the variables.} 22 | 23 | \item{sd}{A value or vector corresponding to the SD of the variables.} 24 | 25 | \item{names}{A character vector of desired variable names.} 26 | 27 | \item{...}{Arguments passed to or from other methods.} 28 | 29 | \item{d}{A value or vector corresponding to the desired difference between 30 | the groups.} 31 | } 32 | \description{ 33 | Simulate data with specific characteristics. 34 | } 35 | \examples{ 36 | \dontshow{if (requireNamespace("MASS", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 37 | 38 | # Correlation -------------------------------- 39 | data <- simulate_correlation(r = 0.5) 40 | plot(data$V1, data$V2) 41 | cor.test(data$V1, data$V2) 42 | summary(lm(V2 ~ V1, data = data)) 43 | 44 | # Specify mean and SD 45 | data <- simulate_correlation(r = 0.5, n = 50, mean = c(0, 1), sd = c(0.7, 1.7)) 46 | cor.test(data$V1, data$V2) 47 | round(c(mean(data$V1), sd(data$V1)), 1) 48 | round(c(mean(data$V2), sd(data$V2)), 1) 49 | summary(lm(V2 ~ V1, data = data)) 50 | 51 | # Generate multiple variables 52 | cor_matrix <- matrix( 53 | c( 54 | 1.0, 0.2, 0.4, 55 | 0.2, 1.0, 0.3, 56 | 0.4, 0.3, 1.0 57 | ), 58 | nrow = 3 59 | ) 60 | 61 | data <- simulate_correlation(r = cor_matrix, names = c("y", "x1", "x2")) 62 | cor(data) 63 | summary(lm(y ~ x1, data = data)) 64 | 65 | # t-test -------------------------------- 66 | data <- simulate_ttest(n = 30, d = 0.3) 67 | plot(data$V1, data$V0) 68 | round(c(mean(data$V1), sd(data$V1)), 1) 69 | diff(t.test(data$V1 ~ data$V0)$estimate) 70 | summary(lm(V1 ~ V0, data = data)) 71 | summary(glm(V0 ~ V1, data = data, family = "binomial")) 72 | 73 | # Difference -------------------------------- 74 | data <- simulate_difference(n = 30, d = 0.3) 75 | plot(data$V1, data$V0) 76 | round(c(mean(data$V1), sd(data$V1)), 1) 77 | diff(t.test(data$V1 ~ data$V0)$estimate) 78 | summary(lm(V1 ~ V0, data = data)) 79 | summary(glm(V0 ~ V1, data = data, family = "binomial")) 80 | \dontshow{\}) # examplesIf} 81 | } 82 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/equivalence_test.md: -------------------------------------------------------------------------------- 1 | # equivalence test, rstanarm 2 | 3 | Code 4 | print(out) 5 | Output 6 | # Test for Practical Equivalence 7 | 8 | ROPE: [-0.18 0.18] 9 | 10 | Parameter | H0 | inside ROPE | 95% HDI 11 | ----------------------------------------------------- 12 | (Intercept) | Rejected | 0.00 % | [-2.68, -0.50] 13 | size | Accepted | 100.00 % | [-0.04, 0.07] 14 | period2 | Rejected | 0.00 % | [-1.61, -0.36] 15 | period3 | Rejected | 0.00 % | [-1.77, -0.40] 16 | period4 | Rejected | 0.00 % | [-2.52, -0.76] 17 | 18 | 19 | 20 | --- 21 | 22 | Code 23 | print(out) 24 | Output 25 | # Test for Practical Equivalence 26 | 27 | Parameter | H0 | inside ROPE | 95% HDI | ROPE 28 | ---------------------------------------------------------------------- 29 | (Intercept) | Undecided | 15.82 % | [-2.68, -0.50] | [-1.00, 1.00] 30 | size | Accepted | 100.00 % | [-0.04, 0.07] | [-0.10, 0.10] 31 | period2 | Rejected | 0.00 % | [-1.61, -0.36] | [0.00, 2.00] 32 | period3 | Accepted | 100.00 % | [-1.77, -0.40] | [-2.00, 0.00] 33 | period4 | Rejected | 0.00 % | [-2.52, -0.76] | [-0.10, 0.10] 34 | 35 | 36 | 37 | # equivalence test, df 38 | 39 | Code 40 | print(out) 41 | Output 42 | # Test for Practical Equivalence 43 | 44 | ROPE: [-0.10 0.10] 45 | 46 | Parameter | H0 | inside ROPE | 95% HDI 47 | ----------------------------------------------------- 48 | (Intercept) | Rejected | 0.00 % | [-2.68, -0.50] 49 | size | Accepted | 100.00 % | [-0.04, 0.07] 50 | period2 | Rejected | 0.00 % | [-1.61, -0.36] 51 | period3 | Rejected | 0.00 % | [-1.77, -0.40] 52 | period4 | Rejected | 0.00 % | [-2.52, -0.76] 53 | 54 | 55 | 56 | --- 57 | 58 | Code 59 | print(out) 60 | Output 61 | # Test for Practical Equivalence 62 | 63 | Parameter | H0 | inside ROPE | 95% HDI | ROPE 64 | ---------------------------------------------------------------------- 65 | (Intercept) | Undecided | 15.82 % | [-2.68, -0.50] | [-1.00, 1.00] 66 | size | Accepted | 100.00 % | [-0.04, 0.07] | [-0.10, 0.10] 67 | period2 | Rejected | 0.00 % | [-1.61, -0.36] | [0.00, 2.00] 68 | period3 | Accepted | 100.00 % | [-1.77, -0.40] | [-2.00, 0.00] 69 | period4 | Rejected | 0.00 % | [-2.52, -0.76] | [-0.10, 0.10] 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /tests/testthat/test-spi.R: -------------------------------------------------------------------------------- 1 | # numeric ------------------------------- 2 | test_that("spi", { 3 | skip_if_not_installed("curl") 4 | skip_if_offline() 5 | skip_if_not_installed("httr2") 6 | skip_if_not_or_load_if_installed("rstanarm") 7 | skip_if_not_or_load_if_installed("brms") 8 | skip_if_not_or_load_if_installed("BayesFactor") 9 | 10 | expect_equal(spi(distribution_normal(1000), ci = 0.90)$CI_low[1], -1.65, tolerance = 0.02) 11 | expect_equal(nrow(spi(distribution_normal(1000), ci = c(0.80, 0.90, 0.95))), 3, tolerance = 0.01) 12 | expect_equal(spi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02) 13 | expect_equal(nchar(capture.output(print(spi(distribution_normal(1000))))), 22) 14 | expect_equal(length(capture.output(print(spi(distribution_normal(1000), ci = c(0.80, 0.90))))), 5) 15 | 16 | 17 | expect_error(spi(c(2, 3, NA))) 18 | expect_warning(spi(c(2, 3))) 19 | expect_message(spi(distribution_normal(1000), ci = 0.0000001)) 20 | expect_warning(spi(distribution_normal(1000), ci = 950)) 21 | expect_message(spi(c(0, 0, 0))) 22 | }) 23 | 24 | 25 | test_that("ci", { 26 | skip_if_not_installed("curl") 27 | skip_if_offline() 28 | skip_if_not_installed("httr2") 29 | skip_if_not_or_load_if_installed("rstanarm") 30 | skip_if_not_or_load_if_installed("brms") 31 | skip_if_not_or_load_if_installed("BayesFactor") 32 | 33 | m <- insight::download_model("stanreg_merMod_5") 34 | p <- insight::get_parameters(m, effects = "all") 35 | 36 | expect_equal( 37 | spi(m, ci = c(0.5, 0.8), effects = "all")$CI_low, 38 | spi(p, ci = c(0.5, 0.8))$CI_low, 39 | tolerance = 1e-3 40 | ) 41 | }) 42 | 43 | test_that("spi brms", { 44 | skip_if_not_installed("curl") 45 | skip_if_offline() 46 | skip_if_not_installed("httr2") 47 | skip_if_not_or_load_if_installed("rstanarm") 48 | skip_if_not_or_load_if_installed("brms") 49 | skip_if_not_or_load_if_installed("BayesFactor") 50 | 51 | m <- insight::download_model("brms_zi_3") 52 | p <- insight::get_parameters(m, effects = "all", component = "all") 53 | 54 | expect_equal( 55 | spi(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, 56 | spi(p, ci = c(0.5, 0.8))$CI_low, 57 | tolerance = 1e-3 58 | ) 59 | }) 60 | 61 | 62 | test_that("ci - BayesFactor", { 63 | skip_if_not_installed("curl") 64 | skip_if_offline() 65 | skip_if_not_installed("httr2") 66 | skip_if_not_or_load_if_installed("rstanarm") 67 | skip_if_not_or_load_if_installed("brms") 68 | skip_if_not_or_load_if_installed("BayesFactor") 69 | 70 | mod_bf <- proportionBF(y = 15, N = 25, p = 0.5) 71 | p_bf <- insight::get_parameters(mod_bf) 72 | 73 | expect_equal( 74 | spi(mod_bf, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, 75 | spi(p_bf, ci = c(0.5, 0.8))$CI_low, 76 | tolerance = 0.1 77 | ) 78 | }) 79 | -------------------------------------------------------------------------------- /R/reshape_iterations.R: -------------------------------------------------------------------------------- 1 | #' Reshape estimations with multiple iterations (draws) to long format 2 | #' 3 | #' Reshape a wide data.frame of iterations (such as posterior draws or 4 | #' bootsrapped samples) as columns to long format. Instead of having all 5 | #' iterations as columns (e.g., `iter_1, iter_2, ...`), will return 3 columns 6 | #' with the `\*_index` (the previous index of the row), the `\*_group` (the 7 | #' iteration number) and the `\*_value` (the value of said iteration). 8 | #' 9 | #' @param x A data.frame containing posterior draws obtained from 10 | #' `estimate_response` or `estimate_link`. 11 | #' @param prefix The prefix of the draws (for instance, `"iter_"` for columns 12 | #' named as `iter_1, iter_2, iter_3`). If more than one are provided, will 13 | #' search for the first one that matches. 14 | #' @examples 15 | #' \donttest{ 16 | #' if (require("rstanarm")) { 17 | #' model <- stan_glm(mpg ~ am, data = mtcars, refresh = 0) 18 | #' draws <- insight::get_predicted(model) 19 | #' long_format <- reshape_iterations(draws) 20 | #' head(long_format) 21 | #' } 22 | #' } 23 | #' @return Data frame of reshaped draws in long format. 24 | #' @export 25 | reshape_iterations <- function(x, prefix = c("draw", "iter", "iteration", "sim")) { 26 | # Accomodate output from get_predicted 27 | if (inherits(x, "get_predicted") && "iterations" %in% names(attributes(x))) { 28 | x <- as.data.frame(x) 29 | } 30 | 31 | # Find columns' name 32 | prefix <- prefix[min(which(sapply(tolower(prefix), function(prefix) sum(grepl(prefix, tolower(names(x)), fixed = TRUE)) > 1)))] 33 | 34 | if (is.na(prefix) || is.null(prefix)) { 35 | insight::format_error( 36 | "Couldn't find columns corresponding to iterations in your dataframe, please specify the correct prefix." 37 | ) 38 | } 39 | 40 | # Get column names 41 | iter_cols <- tolower(names(x))[grepl(prefix, tolower(names(x)), fixed = TRUE)] 42 | 43 | # Drop "_" if prefix ends with it 44 | newname <- ifelse(endsWith(prefix, "_"), substr(prefix, 1, nchar(prefix) - 1), prefix) 45 | 46 | # Create Index column 47 | index_col <- paste0(newname, "_index") 48 | if (index_col %in% names(x)) index_col <- paste0(".", newname, "_index") 49 | x[[index_col]] <- seq_len(nrow(x)) 50 | 51 | # Reshape 52 | long <- stats::reshape(x, 53 | varying = iter_cols, 54 | idvar = index_col, 55 | v.names = paste0(newname, "_value"), 56 | timevar = paste0(newname, "_group"), 57 | direction = "long" 58 | ) 59 | row.names(long) <- NULL 60 | 61 | class(long) <- class(long)[which(inherits(long, "data.frame")):length(class(long))] 62 | long 63 | } 64 | 65 | #' @rdname reshape_iterations 66 | #' @export 67 | reshape_draws <- function(x, prefix = c("draw", "iter", "iteration", "sim")) { 68 | .Deprecated("reshape_iterations") 69 | reshape_iterations(x, prefix) 70 | } 71 | -------------------------------------------------------------------------------- /R/plot.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | plot.equivalence_test <- function(x, ...) { 3 | insight::check_if_installed("see", "to plot results from equivalence-test") 4 | NextMethod() 5 | } 6 | 7 | 8 | #' @export 9 | plot.p_direction <- function(x, ...) { 10 | insight::check_if_installed("see", "to plot results from p_direction()") 11 | NextMethod() 12 | } 13 | 14 | 15 | #' @export 16 | plot.point_estimate <- function(x, ...) { 17 | insight::check_if_installed("see", "to plot point-estimates") 18 | NextMethod() 19 | } 20 | 21 | 22 | #' @export 23 | plot.map_estimate <- function(x, ...) { 24 | insight::check_if_installed("see", "to plot point-estimates") 25 | NextMethod() 26 | } 27 | 28 | 29 | #' @export 30 | plot.rope <- function(x, ...) { 31 | insight::check_if_installed("see", "to plot ROPE") 32 | NextMethod() 33 | } 34 | 35 | 36 | #' @export 37 | plot.bayestestR_hdi <- function(x, ...) { 38 | insight::check_if_installed("see", "to plot HDI") 39 | NextMethod() 40 | } 41 | 42 | 43 | #' @export 44 | plot.bayestestR_eti <- function(x, ...) { 45 | insight::check_if_installed("see", "to plot credible intervals") 46 | NextMethod() 47 | } 48 | 49 | 50 | #' @export 51 | plot.bayestestR_si <- function(x, ...) { 52 | insight::check_if_installed("see", "to plot support intervals") 53 | NextMethod() 54 | } 55 | 56 | 57 | #' @export 58 | plot.bayesfactor_parameters <- function(x, ...) { 59 | insight::check_if_installed("see", "to plot Savage-Dickey Bayes factor") 60 | NextMethod() 61 | } 62 | 63 | 64 | #' @export 65 | plot.bayesfactor_models <- function(x, ...) { 66 | insight::check_if_installed("see", "to plot models' Bayes factors") 67 | NextMethod() 68 | } 69 | 70 | 71 | #' @export 72 | plot.estimate_density <- function(x, ...) { 73 | insight::check_if_installed("see", "to plot densities") 74 | NextMethod() 75 | } 76 | 77 | 78 | #' @export 79 | plot.estimate_density_df <- function(x, ...) { 80 | insight::check_if_installed("see", "to plot models' densities") 81 | NextMethod() 82 | } 83 | 84 | 85 | #' @export 86 | plot.p_significance <- function(x, ...) { 87 | insight::check_if_installed("see", "to plot practical significance") 88 | NextMethod() 89 | } 90 | 91 | 92 | #' @export 93 | plot.describe_posterior <- function(x, stack = FALSE, ...) { 94 | insight::check_if_installed("see", "to plot posterior samples") 95 | insight::check_if_installed("ggplot2", "to plot posterior samples") 96 | model <- .retrieve_model(x) 97 | if (!is.null(model)) { 98 | graphics::plot(estimate_density(model), stack = stack, ...) + 99 | ggplot2::labs(title = "Posterior Samples", x = NULL, y = NULL) 100 | } else { 101 | insight::format_alert("Could not find model-object. Try `plot(estimate_density(model))` instead.") 102 | } 103 | } 104 | -------------------------------------------------------------------------------- /R/overlap.R: -------------------------------------------------------------------------------- 1 | #' Overlap Coefficient 2 | #' 3 | #' A method to calculate the overlap coefficient between two empirical 4 | #' distributions (that can be used as a measure of similarity between two 5 | #' samples). 6 | #' 7 | #' @param x Vector of x values. 8 | #' @param y Vector of x values. 9 | #' @param method_auc Area Under the Curve (AUC) estimation method. See [area_under_curve()]. 10 | #' @param method_density Density estimation method. See [estimate_density()]. 11 | #' @inheritParams estimate_density 12 | #' 13 | #' @examples 14 | #' library(bayestestR) 15 | #' 16 | #' x <- distribution_normal(1000, 2, 0.5) 17 | #' y <- distribution_normal(1000, 0, 1) 18 | #' 19 | #' overlap(x, y) 20 | #' plot(overlap(x, y)) 21 | #' @export 22 | overlap <- function(x, 23 | y, 24 | method_density = "kernel", 25 | method_auc = "trapezoid", 26 | precision = 2^10, 27 | extend = TRUE, 28 | extend_scale = 0.1, 29 | ...) { 30 | # Generate densities 31 | dx <- estimate_density( 32 | x, 33 | method = method_density, 34 | precision = precision, 35 | extend = extend, 36 | extend_scale = extend_scale, 37 | ... 38 | ) 39 | dy <- estimate_density( 40 | y, 41 | method = method_density, 42 | precision = precision, 43 | extend = extend, 44 | extend_scale = extend_scale, 45 | ... 46 | ) 47 | 48 | # Create density estimation functions 49 | fx <- stats::approxfun(dx$x, dx$y, method = "linear", rule = 2) 50 | fy <- stats::approxfun(dy$x, dy$y, method = "linear", rule = 2) 51 | 52 | x_axis <- seq(min(c(dx$x, dy$x)), max(c(dx$x, dy$x)), length.out = precision) 53 | approx_data <- data.frame(x = x_axis, y1 = fx(x_axis), y2 = fy(x_axis)) 54 | 55 | 56 | # calculate intersection densities 57 | approx_data$intersection <- pmin(approx_data$y1, approx_data$y2) 58 | approx_data$exclusion <- pmax(approx_data$y1, approx_data$y2) 59 | 60 | # integrate areas under curves 61 | area_intersection <- area_under_curve( 62 | approx_data$x, 63 | approx_data$intersection, 64 | method = method_auc 65 | ) 66 | # area_exclusion <- area_under_curve(data$x, data$exclusion, method = method_auc) 67 | 68 | 69 | # compute overlap coefficient 70 | overlap <- area_intersection 71 | attr(overlap, "data") <- approx_data 72 | 73 | class(overlap) <- c("overlap", class(overlap)) 74 | overlap 75 | } 76 | 77 | 78 | #' @export 79 | print.overlap <- function(x, ...) { 80 | insight::print_color("# Overlap\n\n", "blue") 81 | cat(sprintf("%.1f%%\n", 100 * as.numeric(x))) 82 | } 83 | 84 | 85 | #' @export 86 | plot.overlap <- function(x, ...) { 87 | # Can be improved through see 88 | plot_data <- attributes(x)$data 89 | graphics::plot(plot_data$x, plot_data$exclusion, type = "l") 90 | graphics::polygon(plot_data$x, plot_data$intersection, col = "red") 91 | } 92 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | ADE 2 | Altough 3 | ArXiv 4 | BCa 5 | BFs 6 | BGGM 7 | BICs 8 | BMA 9 | BMJ 10 | Baws 11 | BayesFactor 12 | Bayesfactor 13 | Bergh 14 | Betancourt 15 | Bridgesampling 16 | CMD 17 | CRC 18 | CWI 19 | Curvewise 20 | DOI 21 | DV 22 | Dablander 23 | DescTools 24 | Desimone 25 | DiCiccio 26 | Dom 27 | Driing 28 | ESS 29 | ETI 30 | Efron 31 | Etz 32 | Fernández 33 | Funder 34 | Gelman 35 | Ghosh 36 | Grasman 37 | Gronau's 38 | HDI 39 | HDInterval 40 | Haaf 41 | Hinne 42 | Hirose 43 | IRR 44 | Imai 45 | Iverson 46 | JASP 47 | JASP's 48 | Jeffreys 49 | Kass 50 | Keele 51 | Kruschke 52 | Kuriyal 53 | Kurz's 54 | Ley 55 | Liao 56 | Liddell 57 | Lindley 58 | Littman 59 | Liu 60 | Lodewyckx 61 | Ly 62 | MCMCglmm 63 | MCSE 64 | MPE 65 | Mathot 66 | Mattan 67 | Matzke 68 | McElreath 69 | Midya 70 | Modelling 71 | Morey 72 | Multicollinearity 73 | ORCID 74 | Ozer 75 | Parmigiani 76 | Piironen 77 | Posteriori 78 | Preprint 79 | Psychonomic 80 | ROPE's 81 | ROPEs 82 | ROPE’s 83 | Raftery 84 | Rhat 85 | Rouder 86 | SEM 87 | SEXIT 88 | SHA 89 | SPI 90 | SPIn 91 | Shachar 92 | Speckman 93 | Tada 94 | Tingley 95 | Un 96 | Vandekerckhove 97 | Vehtari 98 | Versicolor 99 | Visualise 100 | Wagenmakers 101 | Wether 102 | Wetzels 103 | Wickham 104 | Wookies 105 | Yamamoto 106 | Ying 107 | Zheng 108 | al 109 | altough 110 | arXiv 111 | autocorrelated 112 | avaible 113 | bayesQR 114 | bayesian 115 | bcplm 116 | behavioural 117 | bmj 118 | bmwiernik 119 | bootsrapped 120 | brms 121 | brmsfit 122 | centred 123 | characterisation 124 | characterises 125 | ci 126 | codecov 127 | compte 128 | containe 129 | cplm 130 | curvewise 131 | doi 132 | driiiing 133 | eXistence 134 | easystats 135 | effectsize 136 | egydq 137 | emmeans 138 | et 139 | favour 140 | favouring 141 | fpsyg 142 | frac 143 | frequentis 144 | frequentist's 145 | fullrank 146 | generalised 147 | ggdist 148 | ggdistribute 149 | grano 150 | higer 151 | https 152 | infty 153 | ing 154 | interpretability 155 | interpretable 156 | iteratively 157 | jmp 158 | joss 159 | lavaan 160 | lentiful 161 | lifecycle 162 | lm 163 | marginaleffects 164 | maths 165 | mattansb 166 | mcmc 167 | mfx 168 | modelling 169 | nbinom 170 | neq 171 | notin 172 | objets 173 | operationalizing 174 | orthonormal 175 | osterior 176 | patilindrajeets 177 | pre 178 | preprint 179 | priori 180 | ps 181 | psyarxiv 182 | rOpenSci 183 | reconceptualisation 184 | replicability 185 | reproducibility 186 | richarddmorey 187 | riors 188 | rmsb 189 | rmarkdown 190 | rstanarm 191 | sIgnificance 192 | salis 193 | setosa 194 | setosas 195 | splinefun 196 | ss 197 | stanfit 198 | stanreg 199 | strengejacke 200 | summarise 201 | summarised 202 | th 203 | treedepth 204 | tweedie 205 | un 206 | underbrace 207 | unupdate 208 | versicolor 209 | versicolors 210 | virginica 211 | virgnica 212 | visualisation 213 | visualise 214 | warmup 215 | wil 216 | xy 217 | -------------------------------------------------------------------------------- /R/utils_check_collinearity.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .check_multicollinearity <- function(model, 3 | method = "equivalence_test", 4 | threshold = 0.7, ...) { 5 | valid_parameters <- insight::find_parameters( 6 | model, 7 | parameters = "^(?!(r_|sd_|prior_|cor_|lp__|b\\[))", 8 | flatten = TRUE 9 | ) 10 | 11 | if (inherits(model, "stanfit")) { 12 | dat <- insight::get_parameters(model)[, valid_parameters, drop = FALSE] 13 | } else { 14 | dat <- as.data.frame(model, optional = FALSE)[, valid_parameters, drop = FALSE] 15 | } 16 | 17 | # need at least three columns, one is removed anyway... 18 | 19 | if (ncol(dat) > 2) { 20 | dat <- dat[, -1, drop = FALSE] 21 | 22 | if (ncol(dat) > 1) { 23 | parameter_correlation <- stats::cor(dat) 24 | parameter <- expand.grid(colnames(dat), colnames(dat), stringsAsFactors = FALSE) 25 | 26 | results <- cbind( 27 | parameter, 28 | corr = abs(as.vector(expand.grid(parameter_correlation)[[1]])), 29 | pvalue = apply(parameter, 1, function(r) stats::cor.test(dat[[r[1]]], dat[[r[2]]])$p.value) 30 | ) 31 | 32 | # Filter 33 | results <- results[results$pvalue < 0.05 & results$Var1 != results$Var2, ] 34 | 35 | if (nrow(results) > 0) { 36 | # Remove duplicates 37 | results$where <- paste0(results$Var1, " and ", results$Var2) 38 | results$where2 <- paste0(results$Var2, " and ", results$Var1) 39 | to_remove <- NULL 40 | for (i in seq_len(nrow(results))) { 41 | if (results$where2[i] %in% results$where[1:i]) { 42 | to_remove <- c(to_remove, i) 43 | } 44 | } 45 | results <- results[-to_remove, ] 46 | 47 | # Filter by first threshold 48 | threshold <- pmin(threshold, 0.9) 49 | results <- results[results$corr > threshold & results$corr <= 0.9, ] 50 | if (nrow(results) > 0) { 51 | where <- paste0("between ", toString(paste0(results$where, " (r = ", round(results$corr, 2), ")")), "") 52 | insight::format_alert(paste0( 53 | "Possible multicollinearity ", 54 | where, 55 | ". This might lead to inappropriate results. See 'Details' in '?", 56 | method, 57 | "'." 58 | )) 59 | } 60 | 61 | # Filter by second threshold 62 | results <- results[results$corr > 0.9, ] 63 | if (nrow(results) > 0) { 64 | where <- paste0("between ", toString(paste0(results$where, " (r = ", round(results$corr, 2), ")")), "") 65 | insight::format_alert(paste0( 66 | "Probable multicollinearity ", 67 | where, 68 | ". This might lead to inappropriate results. See 'Details' in '?", 69 | method, 70 | "'." 71 | )) 72 | } 73 | } 74 | } 75 | } 76 | } 77 | -------------------------------------------------------------------------------- /tests/testthat/test-hdi.R: -------------------------------------------------------------------------------- 1 | # numeric ------------------------------- 2 | test_that("hdi", { 3 | skip_if_not_installed("curl") 4 | skip_if_offline() 5 | skip_if_not_installed("httr2") 6 | skip_if_not_or_load_if_installed("rstanarm") 7 | skip_if_not_or_load_if_installed("brms") 8 | skip_if_not_or_load_if_installed("BayesFactor") 9 | 10 | expect_equal(hdi(distribution_normal(1000), ci = 0.90)$CI_low[1], -1.64, tolerance = 0.02) 11 | expect_equal(nrow(hdi(distribution_normal(1000), ci = c(0.80, 0.90, 0.95))), 3, tolerance = 0.01) 12 | expect_equal(hdi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02) 13 | expect_identical(nchar(capture.output(print(hdi(distribution_normal(1000))))), 22L) 14 | expect_length(capture.output(print(hdi(distribution_normal(1000), ci = c(0.80, 0.90)))), 5) 15 | 16 | expect_message(hdi(c(2, 3, NA))) 17 | expect_warning(hdi(c(2, 3))) 18 | expect_message(hdi(distribution_normal(1000), ci = 0.0000001)) 19 | expect_warning(hdi(distribution_normal(1000), ci = 950)) 20 | expect_message(hdi(c(0, 0, 0))) 21 | }) 22 | 23 | 24 | # stanreg --------------------------- 25 | test_that("ci", { 26 | skip_if_not_installed("curl") 27 | skip_if_offline() 28 | skip_if_not_installed("httr2") 29 | skip_if_not_or_load_if_installed("rstanarm") 30 | skip_if_not_or_load_if_installed("brms") 31 | skip_if_not_or_load_if_installed("BayesFactor") 32 | 33 | m <- insight::download_model("stanreg_merMod_5") 34 | p <- insight::get_parameters(m, effects = "all") 35 | 36 | expect_equal( 37 | hdi(m, ci = c(0.5, 0.8), effects = "all")$CI_low, 38 | hdi(p, ci = c(0.5, 0.8))$CI_low, 39 | tolerance = 1e-3 40 | ) 41 | }) 42 | 43 | # brms --------------------------- 44 | test_that("rope", { 45 | skip_if_not_installed("curl") 46 | skip_if_offline() 47 | skip_if_not_installed("httr2") 48 | skip_if_not_or_load_if_installed("rstanarm") 49 | skip_if_not_or_load_if_installed("brms") 50 | skip_if_not_or_load_if_installed("BayesFactor") 51 | 52 | m <- insight::download_model("brms_zi_3") 53 | p <- insight::get_parameters(m, effects = "all", component = "all") 54 | 55 | expect_equal( 56 | hdi(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, 57 | hdi(p, ci = c(0.5, 0.8))$CI_low, 58 | tolerance = 1e-3 59 | ) 60 | }) 61 | 62 | # BayesFactor --------------------------- 63 | test_that("ci - BayesFactor", { 64 | skip_if_not_installed("curl") 65 | skip_if_offline() 66 | skip_if_not_installed("httr2") 67 | skip_if_not_or_load_if_installed("rstanarm") 68 | skip_if_not_or_load_if_installed("brms") 69 | skip_if_not_or_load_if_installed("BayesFactor") 70 | 71 | mod_bf <- proportionBF(y = 15, N = 25, p = 0.5) 72 | p_bf <- insight::get_parameters(mod_bf) 73 | 74 | expect_equal( 75 | hdi(mod_bf, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low, 76 | hdi(p_bf, ci = c(0.5, 0.8))$CI_low, 77 | tolerance = 0.1 78 | ) 79 | }) 80 | -------------------------------------------------------------------------------- /tests/testthat/test-p_direction.R: -------------------------------------------------------------------------------- 1 | test_that("p_direction", { 2 | set.seed(333) 3 | x <- distribution_normal(10000, 1, 1) 4 | pd <- p_direction(x) 5 | expect_equal(as.numeric(pd), 0.842, tolerance = 0.1) 6 | # converstion into frequentist p-value works 7 | p <- p_direction(x, as_p = TRUE) 8 | expect_equal(as.numeric(p), pd_to_p(pd$pd), tolerance = 0.1) 9 | expect_equal(as.vector(p), pd_to_p(pd$pd), tolerance = 0.1) 10 | # return NA 11 | expect_true(is.na(as.numeric(p_direction(c(x, NA), remove_na = FALSE)))) 12 | # works 13 | expect_equal(as.numeric(p_direction(c(x, NA))), 0.8413, tolerance = 0.1) 14 | expect_equal(as.vector(p_direction(c(x, NA))), 0.8413, tolerance = 0.1) 15 | # error if only NA 16 | expect_error(p_direction(c(NA_real_, NA_real_)), regex = "No valid values found") 17 | expect_equal(as.numeric(p_direction(x, method = "kernel")), 0.842, tolerance = 0.1) 18 | expect_s3_class(pd, "p_direction") 19 | expect_s3_class(pd, "data.frame") 20 | expect_identical(dim(pd), c(1L, 2L)) 21 | expect_identical( 22 | capture.output(print(pd)), 23 | c( 24 | "Probability of Direction", "", "Parameter | pd", "------------------", 25 | "Posterior | 84.13%" 26 | ) 27 | ) 28 | 29 | df <- data.frame(replicate(4, rnorm(100))) 30 | pd <- p_direction(df) 31 | expect_s3_class(pd, "p_direction") 32 | expect_s3_class(pd, "data.frame") 33 | expect_identical(dim(pd), c(4L, 2L)) 34 | }) 35 | 36 | 37 | test_that("p_direction", { 38 | skip_if_not_installed("curl") 39 | skip_if_offline() 40 | skip_if_not_installed("httr2") 41 | skip_if_not_or_load_if_installed("rstanarm") 42 | skip_if_not_or_load_if_installed("brms") 43 | 44 | m <- insight::download_model("stanreg_merMod_5") 45 | p <- insight::get_parameters(m, effects = "all") 46 | 47 | expect_equal( 48 | p_direction(m, effects = "all")$pd, 49 | p_direction(p)$pd, 50 | tolerance = 1e-3 51 | ) 52 | # converstion into frequentist p-value works 53 | expect_equal( 54 | p_direction(m, effects = "all", as_p = TRUE)$p, 55 | pd_to_p(p_direction(m, effects = "all")$pd), 56 | tolerance = 1e-3 57 | ) 58 | expect_equal( 59 | p_direction(m, effects = "all", as_p = TRUE)$p, 60 | as.numeric(p_direction(m, effects = "all", as_p = TRUE)), 61 | tolerance = 1e-3 62 | ) 63 | expect_equal( 64 | p_direction(m, effects = "all", as_p = TRUE)$p, 65 | as.vector(p_direction(m, effects = "all", as_p = TRUE)), 66 | tolerance = 1e-3 67 | ) 68 | }) 69 | 70 | 71 | test_that("p_direction", { 72 | skip_if_not_installed("curl") 73 | skip_if_offline() 74 | skip_if_not_installed("httr2") 75 | skip_if_not_or_load_if_installed("rstanarm") 76 | skip_if_not_or_load_if_installed("brms") 77 | 78 | m <- insight::download_model("brms_zi_3") 79 | p <- insight::get_parameters(m, effects = "all", component = "all") 80 | 81 | expect_equal( 82 | p_direction(m, effects = "all", component = "all")$pd, 83 | p_direction(p)$pd, 84 | tolerance = 1e-3 85 | ) 86 | }) 87 | -------------------------------------------------------------------------------- /WIP/cwi.R: -------------------------------------------------------------------------------- 1 | #' Curvewise Intervals (CWI) 2 | #' 3 | #' Compute the **Curvewise interval (CWI)** (also called the "simultaneous interval" or "joint interval") of posterior distributions using \code{ggdist::curve_interval()}. 4 | #' Whereas the more typical "pointwise intervals" contain xx% of the posterior for a single parameter, 5 | #' joint/curvewise intervals contain xx% of the posterior distribution for **all** parameters. 6 | #' 7 | #' Applied model predictions, pointwise intervals contain xx% of the predicted response values **conditional** on specific predictor values. 8 | #' In contrast, curvewise intervals contain xx% of the predicted response values across all predictor values. 9 | #' Put another way, curvewise intervals contain xx% of the full **prediction lines** from the model. 10 | #' 11 | #' 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-). 12 | #' 13 | #' @inheritParams hdi 14 | #' @inherit ci return 15 | #' @inherit hdi details 16 | #' @inherit hdi seealso 17 | #' @family ci 18 | #' 19 | #' @examples 20 | #' \donttest{ 21 | #' library(bayestestR) 22 | #' 23 | #' if (require("ggplot2") && require("rstanarm") && require("ggdist")) { 24 | #' # Generate data ============================================= 25 | #' k <- 11 # number of curves (iterations) 26 | #' n <- 201 # number of rows 27 | #' data <- data.frame(x = seq(-15, 15, length.out = n)) 28 | #' 29 | #' # Simulate iterations as new columns 30 | #' for (i in 1:k) { 31 | #' data[paste0("iter_", i)] <- dnorm(data$x, seq(-5, 5, length.out = k)[i], 3) 32 | #' } 33 | #' 34 | #' # Note: first, we need to transpose the data to have iters as rows 35 | #' iters <- datawizard::data_transpose(data[paste0("iter_", 1:k)]) 36 | #' 37 | #' # Compute Median 38 | #' data$Median <- point_estimate(iters)[["Median"]] 39 | #' 40 | #' # Compute Credible Intervals ================================ 41 | #' 42 | #' # Compute ETI (default type of CI) 43 | #' data[c("ETI_low", "ETI_high")] <- eti(iters, ci = 0.5)[c("CI_low", "CI_high")] 44 | #' 45 | #' # Compute CWI 46 | #' # ggdist::curve_interval(reshape_iterations(data), iter_value .width = 0.5) 47 | #' 48 | #' # Visualization ============================================= 49 | #' ggplot(data, aes(x = x, y = Median)) + 50 | #' geom_ribbon(aes(ymin = ETI_low, ymax = ETI_high), fill = "red", alpha = 0.3) + 51 | #' geom_line(linewidth = 1) + 52 | #' geom_line( 53 | #' data = reshape_iterations(data), 54 | #' aes(y = iter_value, group = iter_group), 55 | #' alpha = 0.3 56 | #' ) 57 | #' } 58 | #' } 59 | #' @export 60 | cwi <- function(x, ...) { 61 | UseMethod("cwi") 62 | } 63 | 64 | 65 | #' @rdname cwi 66 | #' @export 67 | cwi.data.frame <- function(x, ci = 0.95, ...) { 68 | insight::check_if_installed("ggdist") 69 | 70 | print("Comming soon!") # @DominiqueMakowski GitBlame says this was 2 years ago - when is "soon"? :-) 71 | } 72 | -------------------------------------------------------------------------------- /man/display.describe_posterior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/display.R, R/print.R, R/print_html.R, 3 | % R/print_md.R 4 | \name{display.describe_posterior} 5 | \alias{display.describe_posterior} 6 | \alias{print.describe_posterior} 7 | \alias{print_html.describe_posterior} 8 | \alias{print_md.describe_posterior} 9 | \title{Print tables in different output formats} 10 | \usage{ 11 | \method{display}{describe_posterior}(object, format = "markdown", ...) 12 | 13 | \method{print}{describe_posterior}(x, digits = 2, caption = "Summary of Posterior Distribution", ...) 14 | 15 | \method{print_html}{describe_posterior}(x, digits = 2, caption = "Summary of Posterior Distribution", ...) 16 | 17 | \method{print_md}{describe_posterior}(x, digits = 2, caption = "Summary of Posterior Distribution", ...) 18 | } 19 | \arguments{ 20 | \item{object, x}{An object returned by one of the package's function, for 21 | example \code{\link[=describe_posterior]{describe_posterior()}}, \code{\link[=point_estimate]{point_estimate()}}, or \code{\link[=eti]{eti()}}.} 22 | 23 | \item{format}{String, indicating the output format. Can be \code{"markdown"} 24 | \code{"html"}, or \code{"tt"}. \code{format = "tt"} creates a \code{tinytable} object, which is 25 | either printed as markdown or HTML table, depending on the environment. See 26 | \code{\link[insight:export_table]{insight::export_table()}} for details.} 27 | 28 | \item{...}{Arguments passed down to \code{print_html()} or \code{print_md()} (e.g., 29 | \code{digits}), or to \code{insight::export_table()}.} 30 | 31 | \item{digits}{Integer, number of digits to round the table output. Defaults 32 | to 2.} 33 | 34 | \item{caption}{Character, caption for the table. If \code{NULL}, no caption is 35 | added. By default, a caption is created based on the object type.} 36 | } 37 | \value{ 38 | If \code{format = "markdown"}, the return value will be a character 39 | vector in markdown-table format. If \code{format = "html"}, an object of 40 | class \code{gt_tbl}. If \code{format = "tt"}, an object of class \code{tinytable}. 41 | } 42 | \description{ 43 | Prints tables (i.e. data frame) in different output formats. 44 | } 45 | \details{ 46 | \code{display()} is useful when the table-output from functions, which is 47 | usually printed as formatted text-table to console, should be formatted for 48 | pretty table-rendering in markdown documents, or if knitted from rmarkdown 49 | to PDF or Word files. See 50 | \href{https://easystats.github.io/parameters/articles/model_parameters_formatting.html}{vignette} 51 | for examples. 52 | } 53 | \examples{ 54 | \dontshow{if (all(insight::check_if_installed(c("tinytable", "gt"), quietly = TRUE))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 55 | \donttest{ 56 | d <- data.frame(replicate(4, rnorm(20))) 57 | result <- describe_posterior(d) 58 | 59 | # markdown format 60 | display(result) 61 | 62 | # gt HTML 63 | display(result, format = "html") 64 | 65 | # tinytable 66 | display(result, format = "tt") 67 | } 68 | \dontshow{\}) # examplesIf} 69 | } 70 | -------------------------------------------------------------------------------- /tests/testthat/test-bayesian_as_frequentist.R: -------------------------------------------------------------------------------- 1 | skip_on_cran() 2 | skip_if_not_installed("curl") 3 | skip_if_offline() 4 | skip_if_not_installed("httr2") 5 | 6 | test_that("rstanarm to freq", { 7 | skip_if_not_or_load_if_installed("rstanarm") 8 | 9 | set.seed(333) 10 | m <- insight::download_model("stanreg_glm_1") 11 | m1 <- glm(vs ~ wt, data = mtcars, family = "binomial") 12 | m2 <- convert_bayesian_as_frequentist(m) 13 | 14 | expect_equal(coef(m1), coef(m2), tolerance = 1e-3) 15 | }) 16 | 17 | 18 | test_that("rstanarm to freq", { 19 | skip_if_not_or_load_if_installed("rstanarm") 20 | skip_if_not_or_load_if_installed("lme4") 21 | 22 | set.seed(333) 23 | m <- insight::download_model("stanreg_lmerMod_1") 24 | m1 <- lme4::lmer(wt ~ cyl + (1 | gear), data = mtcars) 25 | m2 <- convert_bayesian_as_frequentist(m) 26 | 27 | expect_equal(lme4::fixef(m1), lme4::fixef(m2), tolerance = 1e-3) 28 | }) 29 | 30 | 31 | test_that("brms beta to freq", { 32 | skip_if_not_or_load_if_installed("brms") 33 | skip_if_not_or_load_if_installed("glmmTMB") 34 | skip_if_not_or_load_if_installed("lme4") 35 | skip_if_not_or_load_if_installed("betareg") 36 | 37 | set.seed(333) 38 | m <- suppressWarnings(insight::download_model("brms_beta_1")) 39 | data(FoodExpenditure, package = "betareg") 40 | m1 <- glmmTMB::glmmTMB( 41 | I(food / income) ~ income + (1 | persons), 42 | data = FoodExpenditure, 43 | family = glmmTMB::beta_family() 44 | ) 45 | m2 <- convert_bayesian_as_frequentist(m) 46 | 47 | expect_equal(lme4::fixef(m1)$cond[2], lme4::fixef(m2)$cond[2], tolerance = 1e-2) 48 | }) 49 | 50 | 51 | test_that("ordbetareg to freq", { 52 | skip_if_not_or_load_if_installed("brms") 53 | skip_if_not_or_load_if_installed("ordbetareg") 54 | skip_if_not_or_load_if_installed("glmmTMB") 55 | skip_if_not_or_load_if_installed("lme4") 56 | skip_if_not_or_load_if_installed("datawizard") 57 | 58 | set.seed(333) 59 | data(sleepstudy, package = "lme4") 60 | m <- suppressWarnings(insight::download_model("ordbetareg_1")) 61 | sleepstudy$y <- datawizard::normalize(sleepstudy$Reaction) 62 | m1 <- glmmTMB::glmmTMB( 63 | y ~ Days + (Days | Subject), 64 | data = sleepstudy, 65 | family = glmmTMB::ordbeta() 66 | ) 67 | m2 <- convert_bayesian_as_frequentist(m) 68 | 69 | expect_equal(lme4::fixef(m1), lme4::fixef(m2), tolerance = 1e-1) 70 | }) 71 | 72 | 73 | test_that("brms 0 + Intercept to freq", { 74 | skip_if_not_or_load_if_installed("brms") 75 | 76 | set.seed(333) 77 | data(mtcars) 78 | m <- brms::brm(qsec ~ 0 + Intercept + mpg, data = mtcars, refresh = 0) 79 | m1 <- lm(qsec ~ mpg, data = mtcars) 80 | m2 <- convert_bayesian_as_frequentist(m) 81 | 82 | expect_equal(coef(m1), coef(m2), tolerance = 1e-2) 83 | }) 84 | 85 | 86 | test_that("brms Interaction terms to freq", { 87 | skip_if_not_or_load_if_installed("brms") 88 | 89 | set.seed(333) 90 | m <- brms::brm(qsec ~ mpg * as.factor(am), data = mtcars, refresh = 0) 91 | m1 <- lm(qsec ~ mpg * as.factor(am), data = mtcars) 92 | m2 <- convert_bayesian_as_frequentist(m) 93 | 94 | expect_equal(coef(m1), coef(m2), tolerance = 1e-2) 95 | }) 96 | -------------------------------------------------------------------------------- /tests/testthat/test-map_estimate.R: -------------------------------------------------------------------------------- 1 | # numeric ---------------------- 2 | test_that("map_estimate", { 3 | x <- distribution_normal(1000, 1) 4 | MAP <- map_estimate(x) 5 | expect_equal(as.numeric(MAP), 0.997, tolerance = 0.001, ignore_attr = TRUE) 6 | expect_s3_class(MAP, "map_estimate") 7 | expect_s3_class(MAP, "data.frame") 8 | expect_identical(dim(MAP), c(1L, 2L)) 9 | expect_identical( 10 | capture.output(print(MAP)), 11 | c( 12 | "MAP Estimate", 13 | "", 14 | "Parameter | MAP_Estimate", 15 | "------------------------", 16 | "x | 1.00" 17 | ) 18 | ) 19 | }) 20 | 21 | # stanreg ---------------------- 22 | test_that("map_estimate", { 23 | skip_if_not_installed("curl") 24 | skip_if_offline() 25 | skip_if_not_installed("httr2") 26 | skip_if_not_or_load_if_installed("rstanarm") 27 | skip_if_not_or_load_if_installed("BayesFactor") 28 | 29 | m <- insight::download_model("stanreg_merMod_5") 30 | skip_if(is.null(m)) 31 | expect_identical( 32 | map_estimate(m, effects = "all")$Parameter, 33 | colnames(as.data.frame(m))[c(1:5, 21)] 34 | ) 35 | expect_identical( 36 | map_estimate(m, effects = "full")$Parameter, 37 | colnames(as.data.frame(m))[1:21] 38 | ) 39 | }) 40 | 41 | # brms ---------------------- 42 | test_that("map_estimate", { 43 | skip_if_not_installed("curl") 44 | skip_if_offline() 45 | skip_if_not_installed("httr2") 46 | skip_if_not_or_load_if_installed("rstanarm") 47 | skip_if_not_or_load_if_installed("BayesFactor") 48 | 49 | m <- insight::download_model("brms_zi_3") 50 | skip_if(is.null(m)) 51 | expect_identical( 52 | map_estimate(m, effects = "all", component = "all")$Parameter, 53 | c( 54 | "b_Intercept", "b_child", "b_camper", "sd_persons__Intercept", 55 | "b_zi_Intercept", "b_zi_child", "b_zi_camper", "sd_persons__zi_Intercept" 56 | ) 57 | ) 58 | expect_identical( 59 | map_estimate(m, effects = "full", component = "all")$Parameter, 60 | c( 61 | "b_Intercept", "b_child", "b_camper", "r_persons[1,Intercept]", 62 | "r_persons[2,Intercept]", "r_persons[3,Intercept]", "r_persons[4,Intercept]", 63 | "sd_persons__Intercept", "b_zi_Intercept", "b_zi_child", "b_zi_camper", 64 | "r_persons__zi[1,Intercept]", "r_persons__zi[2,Intercept]", "r_persons__zi[3,Intercept]", 65 | "r_persons__zi[4,Intercept]", "sd_persons__zi_Intercept" 66 | ) 67 | ) 68 | m <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) 69 | expect_error(map_estimate(m)) 70 | }) 71 | 72 | # edge cases 73 | test_that("map_estimate, constant vectors or sparse samples", { 74 | x <- c(2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.2, 2.2, 2.2, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5) 75 | out <- map_estimate(x, verbose = FALSE) 76 | expect_true(is.na(out$MAP_Estimate)) 77 | out <- map_estimate(c(3, 3, 3), verbose = FALSE) 78 | expect_identical(out$MAP_Estimate, 3) 79 | expect_message( 80 | map_estimate(x, verbose = TRUE), 81 | regex = "Could not calculate MAP estimate" 82 | ) 83 | expect_message( 84 | map_estimate(c(3, 3, 3), verbose = TRUE), 85 | regex = "Data is singular" 86 | ) 87 | }) 88 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/windows/print.md: -------------------------------------------------------------------------------- 1 | # print.describe_posterior 2 | 3 | Code 4 | describe_posterior(m, verbose = FALSE) 5 | Output 6 | Summary of Posterior Distribution 7 | 8 | Parameter | Median | 95% CI | pd | ROPE | % in ROPE 9 | -------------------------------------------------------------------------- 10 | (Intercept) | 0.96 | [-0.81, 2.51] | 90.00% | [-0.10, 0.10] | 2.54% 11 | child | -1.16 | [-1.36, -0.94] | 100% | [-0.10, 0.10] | 0% 12 | camper | 0.73 | [ 0.54, 0.91] | 100% | [-0.10, 0.10] | 0% 13 | 14 | Parameter | Rhat | ESS 15 | ------------------------- 16 | (Intercept) | 1.011 | 110 17 | child | 0.996 | 278 18 | camper | 0.996 | 271 19 | 20 | --- 21 | 22 | Code 23 | describe_posterior(m, effects = "all", component = "all", verbose = FALSE) 24 | Output 25 | Summary of Posterior Distribution 26 | 27 | Parameter | Median | 95% CI | pd | ROPE | % in ROPE 28 | -------------------------------------------------------------------------- 29 | (Intercept) | 0.96 | [-0.81, 2.51] | 90.00% | [-0.10, 0.10] | 2.54% 30 | child | -1.16 | [-1.36, -0.94] | 100% | [-0.10, 0.10] | 0% 31 | camper | 0.73 | [ 0.54, 0.91] | 100% | [-0.10, 0.10] | 0% 32 | 33 | Parameter | Rhat | ESS 34 | ------------------------- 35 | (Intercept) | 1.011 | 110 36 | child | 0.996 | 278 37 | camper | 0.996 | 271 38 | 39 | # Fixed effects (zero-inflated) 40 | 41 | Parameter | Median | 95% CI | pd | ROPE | % in ROPE 42 | -------------------------------------------------------------------------- 43 | (Intercept) | -0.48 | [-2.03, 0.89] | 78.00% | [-0.10, 0.10] | 10.59% 44 | child | 1.85 | [ 1.19, 2.54] | 100% | [-0.10, 0.10] | 0% 45 | camper | -0.88 | [-1.61, -0.07] | 98.40% | [-0.10, 0.10] | 0.85% 46 | 47 | Parameter | Rhat | ESS 48 | ------------------------- 49 | (Intercept) | 0.997 | 138 50 | child | 0.996 | 303 51 | camper | 0.996 | 292 52 | 53 | # Random effects (conditional) (SD/Cor: persons) 54 | 55 | Parameter | Median | 95% CI | pd | ROPE | % in ROPE 56 | ------------------------------------------------------------------------ 57 | (Intercept) | 1.42 | [ 0.71, 3.58] | 100% | [-0.10, 0.10] | 0% 58 | 59 | Parameter | Rhat | ESS 60 | ------------------------- 61 | (Intercept) | 1.010 | 126 62 | 63 | # Random effects (zero-inflated) (SD/Cor: persons) 64 | 65 | Parameter | Median | 95% CI | pd | ROPE | % in ROPE 66 | ------------------------------------------------------------------------ 67 | (Intercept) | 1.30 | [ 0.63, 3.41] | 100% | [-0.10, 0.10] | 0% 68 | 69 | Parameter | Rhat | ESS 70 | ------------------------- 71 | (Intercept) | 0.996 | 129 72 | 73 | -------------------------------------------------------------------------------- /R/utils_print_data_frame.R: -------------------------------------------------------------------------------- 1 | .print_data_frame <- function(x, digits) { 2 | out <- list(x) 3 | names(out) <- "fixed" 4 | 5 | if (all(c("Effects", "Component") %in% colnames(x))) { 6 | x$split <- sprintf("%s_%s", x$Effects, x$Component) 7 | } else if ("Effects" %in% colnames(x)) { 8 | colnames(x)[which(colnames(x) == "Effects")] <- "split" 9 | } else if ("Component" %in% colnames(x)) { 10 | colnames(x)[which(colnames(x) == "Component")] <- "split" 11 | } 12 | 13 | if ("split" %in% colnames(x)) { 14 | if (anyNA(x$split)) { 15 | x$split[is.na(x$split)] <- "{other}" 16 | } 17 | out <- lapply( 18 | split(x, f = x$split), 19 | datawizard::data_remove, 20 | select = c("split", "Component", "Effects"), 21 | verbose = FALSE 22 | ) 23 | } 24 | 25 | for (i in names(out)) { 26 | header <- switch(i, 27 | conditional = , 28 | fixed_conditional = , 29 | fixed = "# Fixed Effects (Conditional Model)", 30 | fixed_sigma = "# Sigma (fixed effects)", 31 | sigma = "# Sigma (fixed effects)", 32 | zi = , 33 | zero_inflated = , 34 | fixed_zero_inflated = , 35 | fixed_zi = "# Fixed Effects (Zero-Inflated Model)", 36 | random = , 37 | random_conditional = "# Random Effects (Conditional Model)", 38 | random_zero_inflated = , 39 | random_zi = "# Random Effects (Zero-Inflated Model)", 40 | smooth_sd = , 41 | fixed_smooth_sd = "# Smooth Terms", 42 | 43 | # blavaan 44 | latent = "# Latent Loading", 45 | residual = "# Residual Variance", 46 | intercept = "# Intercept", 47 | regression = "# Regression", 48 | 49 | # Default 50 | paste0("# ", i) 51 | ) 52 | 53 | if ("Parameter" %in% colnames(out[[i]])) { 54 | # clean parameters names 55 | out[[i]]$Parameter <- gsub("(b_|bs_|bsp_|bcs_)(?!zi_)(.*)", "\\2", out[[i]]$Parameter, perl = TRUE) 56 | out[[i]]$Parameter <- gsub("(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)(.*)", "\\2", out[[i]]$Parameter, perl = TRUE) 57 | # clean random effect parameters names 58 | out[[i]]$Parameter <- gsub("r_(.*)\\.(.*)\\.", "\\1", out[[i]]$Parameter) 59 | out[[i]]$Parameter <- gsub("b\\[\\(Intercept\\) (.*)\\]", "\\1", out[[i]]$Parameter) 60 | out[[i]]$Parameter <- gsub("b\\[(.*) (.*)\\]", "\\2", out[[i]]$Parameter) 61 | # clean smooth terms 62 | out[[i]]$Parameter <- gsub("^smooth_sd\\[(.*)\\]", "\\1", out[[i]]$Parameter) 63 | out[[i]]$Parameter <- gsub("^sds_", "\\1", out[[i]]$Parameter) 64 | # SD 65 | out[[i]]$Parameter <- gsub( 66 | "(.*)(__Intercept|__zi_Intercept)(.*)", 67 | "\\1 (Intercept)\\3", 68 | gsub("^sd_(.*)", "SD \\1", out[[i]]$Parameter) 69 | ) 70 | # remove ".1" etc. suffix 71 | out[[i]]$Parameter <- gsub("(.*)(\\.)(\\d)$", "\\1 \\3", out[[i]]$Parameter) 72 | # remove "__zi" 73 | out[[i]]$Parameter <- gsub("__zi", "", out[[i]]$Parameter, fixed = TRUE) 74 | } 75 | 76 | if (length(out) > 1) { 77 | insight::print_color(header, "blue") 78 | cat("\n\n") 79 | } 80 | 81 | cat(insight::export_table(out[[i]], digits = digits)) 82 | cat("\n") 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /R/mcse.R: -------------------------------------------------------------------------------- 1 | #' Monte-Carlo Standard Error (MCSE) 2 | #' 3 | #' This function returns the Monte Carlo Standard Error (MCSE). 4 | #' 5 | #' @inheritParams effective_sample 6 | #' 7 | #' @inheritSection hdi Model components 8 | #' 9 | #' @details **Monte Carlo Standard Error (MCSE)** is another measure of 10 | #' accuracy of the chains. It is defined as standard deviation of the chains 11 | #' divided by their effective sample size (the formula for `mcse()` is 12 | #' from Kruschke 2015, p. 187). The MCSE \dQuote{provides a quantitative 13 | #' suggestion of how big the estimation noise is}. 14 | #' 15 | #' @references Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press. 16 | #' 17 | #' @examplesIf require("rstanarm") 18 | #' \donttest{ 19 | #' library(bayestestR) 20 | #' 21 | #' model <- suppressWarnings( 22 | #' rstanarm::stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) 23 | #' ) 24 | #' mcse(model) 25 | #' } 26 | #' @export 27 | mcse <- function(model, ...) { 28 | UseMethod("mcse") 29 | } 30 | 31 | 32 | #' @export 33 | mcse.brmsfit <- function(model, 34 | effects = "fixed", 35 | component = "conditional", 36 | parameters = NULL, 37 | ...) { 38 | # check arguments 39 | params <- insight::get_parameters( 40 | model, 41 | effects = effects, 42 | component = component, 43 | parameters = parameters 44 | ) 45 | 46 | ess <- effective_sample( 47 | model, 48 | effects = effects, 49 | component = component, 50 | parameters = parameters 51 | ) 52 | 53 | .mcse(params, stats::setNames(ess$ESS, ess$Parameter)) 54 | } 55 | 56 | 57 | #' @rdname mcse 58 | #' @export 59 | mcse.stanreg <- function(model, 60 | effects = "fixed", 61 | component = "location", 62 | parameters = NULL, 63 | ...) { 64 | params <- insight::get_parameters( 65 | model, 66 | effects = effects, 67 | component = component, 68 | parameters = parameters 69 | ) 70 | 71 | ess <- effective_sample( 72 | model, 73 | effects = effects, 74 | component = component, 75 | parameters = parameters 76 | ) 77 | 78 | .mcse(params, stats::setNames(ess$ESS, ess$Parameter)) 79 | } 80 | 81 | 82 | #' @export 83 | mcse.stanfit <- mcse.stanreg 84 | 85 | 86 | #' @export 87 | mcse.blavaan <- mcse.stanreg 88 | 89 | 90 | #' @keywords internal 91 | .mcse <- function(params, ess) { 92 | # get standard deviations from posterior samples 93 | stddev <- sapply(params, stats::sd) 94 | 95 | # check proper length, and for unequal length, shorten all 96 | # objects to common parameters 97 | if (length(stddev) != length(ess)) { 98 | common <- stats::na.omit(match(names(stddev), names(ess))) 99 | stddev <- stddev[common] 100 | ess <- ess[common] 101 | params <- params[common] 102 | } 103 | 104 | # compute mcse 105 | data.frame( 106 | Parameter = colnames(params), 107 | MCSE = stddev / sqrt(ess), 108 | stringsAsFactors = FALSE, 109 | row.names = NULL 110 | ) 111 | } 112 | -------------------------------------------------------------------------------- /R/utils_hdi_ci.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .check_ci_fun <- function(dots) { 3 | ci_fun <- "hdi" 4 | if (identical(dots$ci_method, "spi")) { 5 | ci_fun <- "spi" 6 | } 7 | ci_fun 8 | } 9 | 10 | 11 | #' @keywords internal 12 | .check_ci_argument <- function(x, ci, verbose = TRUE) { 13 | if (ci > 1) { 14 | if (verbose) { 15 | insight::format_warning("`ci` should be less than 1, returning NAs.") 16 | } 17 | return(data.frame( 18 | "CI" = ci, 19 | "CI_low" = NA, 20 | "CI_high" = NA 21 | )) 22 | } 23 | 24 | if (ci == 1) { 25 | return(data.frame( 26 | "CI" = ci, 27 | "CI_low" = min(x, na.rm = TRUE), 28 | "CI_high" = max(x, na.rm = TRUE) 29 | )) 30 | } 31 | 32 | 33 | if (length(x) < 3) { 34 | if (verbose) { 35 | insight::format_warning("The posterior is too short, returning NAs.") 36 | } 37 | return(data.frame( 38 | "CI" = ci, 39 | "CI_low" = NA, 40 | "CI_high" = NA 41 | )) 42 | } 43 | 44 | NULL 45 | } 46 | 47 | 48 | #' @keywords internal 49 | .compute_interval_dataframe <- function(x, ci, verbose, fun) { 50 | numeric_variables <- vapply(x, is.numeric, TRUE) 51 | 52 | out <- insight::compact_list(lapply( 53 | x[, numeric_variables, drop = FALSE], 54 | get(fun, asNamespace("bayestestR")), 55 | ci = ci, 56 | verbose = verbose 57 | )) 58 | 59 | dat <- data.frame( 60 | Parameter = rep(names(out), each = length(ci)), 61 | do.call(rbind, out), 62 | stringsAsFactors = FALSE, 63 | row.names = NULL 64 | ) 65 | 66 | # rename for SPI, should be HDI 67 | if (identical(fun, "spi")) { 68 | class(dat) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_spi", class(dat))) 69 | } else { 70 | class(dat) <- unique(c(paste0("bayestestR_", fun), paste0("see_", fun), class(dat))) 71 | } 72 | 73 | dat 74 | } 75 | 76 | 77 | #' @keywords internal 78 | .compute_interval_simMerMod <- function(x, ci, effects, parameters, verbose, fun) { 79 | fixed <- fixed.data <- NULL 80 | random <- random.data <- NULL 81 | 82 | if (effects %in% c("fixed", "all")) { 83 | fixed.data <- insight::get_parameters(x, effects = "fixed", parameters = parameters, verbose = verbose) 84 | fixed <- .compute_interval_dataframe(fixed.data, ci, verbose, fun) 85 | fixed$Group <- "fixed" 86 | } 87 | 88 | if (effects %in% c("random", "all")) { 89 | random.data <- insight::get_parameters(x, effects = "random", parameters = parameters, verbose = verbose) 90 | random <- .compute_interval_dataframe(random.data, ci, verbose, fun) 91 | random$Group <- "random" 92 | } 93 | 94 | d <- do.call(rbind, list(fixed, random)) 95 | 96 | if (length(unique(d$Group)) == 1) { 97 | d <- datawizard::data_remove(d, "Group", verbose = FALSE) 98 | } 99 | 100 | list(result = d, data = do.call(cbind, insight::compact_list(list(fixed.data, random.data)))) 101 | } 102 | 103 | 104 | #' @keywords internal 105 | .compute_interval_sim <- function(x, ci, parameters, verbose, fun) { 106 | fixed.data <- insight::get_parameters(x, parameters = parameters, verbose = verbose) 107 | d <- .compute_interval_dataframe(fixed.data, ci, verbose, fun) 108 | list(result = d, data = fixed.data) 109 | } 110 | -------------------------------------------------------------------------------- /man/rope_range.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rope_range.R 3 | \name{rope_range} 4 | \alias{rope_range} 5 | \alias{rope_range.default} 6 | \title{Find Default Equivalence (ROPE) Region Bounds} 7 | \usage{ 8 | rope_range(x, ...) 9 | 10 | \method{rope_range}{default}(x, verbose = TRUE, ...) 11 | } 12 | \arguments{ 13 | \item{x}{A \code{stanreg}, \code{brmsfit} or \code{BFBayesFactor} object, or a frequentist 14 | regression model.} 15 | 16 | \item{...}{Currently not used.} 17 | 18 | \item{verbose}{Toggle warnings.} 19 | } 20 | \description{ 21 | This function attempts at automatically finding suitable "default" 22 | values for the Region Of Practical Equivalence (ROPE). 23 | } 24 | \details{ 25 | \emph{Kruschke (2018)} suggests that the region of practical equivalence 26 | could be set, by default, to a range from \code{-0.1} to \code{0.1} of a standardized 27 | parameter (negligible effect size according to \emph{Cohen, 1988}). 28 | \itemize{ 29 | \item For \strong{linear models (lm)}, this can be generalised to 30 | \ifelse{html}{\out{-0.1 * SDy, 0.1 * SDy}}{\eqn{[-0.1*SD_{y}, 0.1*SD_{y}]}}. 31 | \item For \strong{logistic models}, the parameters expressed in log odds ratio can be 32 | converted to standardized difference through the formula 33 | \ifelse{html}{\out{π/√(3)}}{\eqn{\pi/\sqrt{3}}}, resulting in a 34 | range of \code{-0.18} to \code{0.18}. 35 | \item For other models with \strong{binary outcome}, it is strongly recommended to 36 | manually specify the rope argument. Currently, the same default is applied 37 | that for logistic models. 38 | \item For models from \strong{count data}, the residual variance is used. This is a 39 | rather experimental threshold and is probably often similar to \verb{-0.1, 0.1}, 40 | but should be used with care! 41 | \item For \strong{t-tests}, the standard deviation of the response is used, similarly 42 | to linear models (see above). 43 | \item For \strong{correlations}, \verb{-0.05, 0.05} is used, i.e., half the value of a 44 | negligible correlation as suggested by Cohen's (1988) rules of thumb. 45 | \item For all other models, \verb{-0.1, 0.1} is used to determine the ROPE limits, 46 | but it is strongly advised to specify it manually. 47 | } 48 | } 49 | \examples{ 50 | \dontshow{if (require("rstanarm") && require("brms") && require("BayesFactor")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 51 | \donttest{ 52 | model <- suppressWarnings(rstanarm::stan_glm( 53 | mpg ~ wt + gear, 54 | data = mtcars, 55 | chains = 2, 56 | iter = 200, 57 | refresh = 0 58 | )) 59 | rope_range(model) 60 | 61 | model <- suppressWarnings( 62 | rstanarm::stan_glm(vs ~ mpg, data = mtcars, family = "binomial", refresh = 0) 63 | ) 64 | rope_range(model) 65 | 66 | model <- brms::brm(mpg ~ wt + cyl, data = mtcars) 67 | rope_range(model) 68 | 69 | model <- BayesFactor::ttestBF(mtcars[mtcars$vs == 1, "mpg"], mtcars[mtcars$vs == 0, "mpg"]) 70 | rope_range(model) 71 | 72 | model <- lmBF(mpg ~ vs, data = mtcars) 73 | rope_range(model) 74 | } 75 | \dontshow{\}) # examplesIf} 76 | } 77 | \references{ 78 | Kruschke, J. K. (2018). Rejecting or accepting parameter values 79 | in Bayesian estimation. Advances in Methods and Practices in Psychological 80 | Science, 1(2), 270-280. \doi{10.1177/2515245918771304}. 81 | } 82 | -------------------------------------------------------------------------------- /tests/testthat/test-weighted_posteriors.R: -------------------------------------------------------------------------------- 1 | skip_on_os("linux") 2 | 3 | test_that("weighted_posteriors for BayesFactor", { 4 | skip_on_cran() 5 | skip_if_not_or_load_if_installed("BayesFactor") 6 | 7 | set.seed(123) 8 | 9 | # compute Bayes Factor for 31 different regression models 10 | null_den <- regressionBF( 11 | mpg ~ cyl + disp + hp + drat + wt, 12 | data = mtcars, 13 | progress = FALSE 14 | ) 15 | wBF <- weighted_posteriors(null_den) 16 | 17 | expect_s3_class(wBF, "data.frame") 18 | expect_equal( 19 | attr(wBF, "weights")$weights, 20 | c( 21 | 0, 13, 9, 0, 0, 55, 11, 4, 4, 1246, 6, 2, 38, 4, 946, 12, 3, 22 | 3, 209, 3, 491, 174, 4, 134, 7, 293, 1, 123, 35, 92, 51, 27 23 | ), 24 | ignore_attr = TRUE 25 | ) 26 | }) 27 | 28 | test_that("weighted_posteriors for BayesFactor (intercept)", { 29 | # fails for win old-release 30 | # skip_on_ci() 31 | skip_on_cran() 32 | skip_if_not_or_load_if_installed("BayesFactor") 33 | 34 | set.seed(123) 35 | 36 | dat <- data.frame( 37 | x1 = rnorm(10), 38 | x2 = rnorm(10), 39 | y = rnorm(10) 40 | ) 41 | BFmods <- regressionBF(y ~ x1 + x2, data = dat, progress = FALSE) 42 | 43 | res <- weighted_posteriors(BFmods) 44 | expect_equal(attr(res, "weights")$weights, c(1032, 805, 1388, 775), ignore_attr = TRUE) 45 | 46 | wHDI <- hdi(res[c("x1", "x2")], ci = 0.9) 47 | expect_equal(wHDI$CI_low, c(-0.519, -0.640), tolerance = 0.01) 48 | expect_equal(wHDI$CI_high, c(0.150, 0.059), tolerance = 0.01) 49 | }) 50 | 51 | test_that("weighted_posteriors for nonlinear BayesFactor", { 52 | skip_on_cran() 53 | skip_if_not_or_load_if_installed("BayesFactor") 54 | 55 | set.seed(123) 56 | data(sleep) 57 | 58 | BFS <- ttestBF( 59 | x = sleep$extra[sleep$group == 1], 60 | y = sleep$extra[sleep$group == 2], 61 | nullInterval = c(-Inf, 0), 62 | paired = TRUE 63 | ) 64 | 65 | res <- weighted_posteriors(BFS) 66 | 67 | expect_equal(attributes(res)$weights$weights, c(113, 3876, 11), ignore_attr = TRUE) 68 | }) 69 | 70 | test_that("weighted_posteriors vs posterior_average", { 71 | skip("Test creates error, must check why...") 72 | skip_on_cran() 73 | skip_if_not_or_load_if_installed("BayesFactor") 74 | skip_if_not_or_load_if_installed("brms") 75 | 76 | fit1 <- brm(rating ~ treat + period + carry, 77 | data = inhaler, 78 | refresh = 0, 79 | silent = TRUE, 80 | save_pars = save_pars(all = TRUE) 81 | ) 82 | fit2 <- brm(rating ~ period + carry, 83 | data = inhaler, 84 | refresh = 0, 85 | silent = TRUE, 86 | save_pars = save_pars(all = TRUE) 87 | ) 88 | 89 | set.seed(444) 90 | expect_warning({ 91 | res_BT <- weighted_posteriors(fit1, fit2) 92 | }) 93 | 94 | set.seed(444) 95 | res_brms <- brms::posterior_average(fit1, fit2, weights = "bma", missing = 0) 96 | res_brms <- res_brms[, 1:4] 97 | 98 | res_BT1 <- eti(res_BT) 99 | res_brms1 <- eti(res_brms) 100 | 101 | expect_equal(res_BT1$Parameter, res_brms1$Parameter, tolerance = 1e-4) 102 | expect_equal(res_BT1$CI, res_brms1$CI, tolerance = 1e-4) 103 | expect_equal(res_BT1$CI_low, res_brms1$CI_low, tolerance = 1e-4) 104 | expect_equal(res_BT1$CI_high, res_brms1$CI_high, tolerance = 1e-4) 105 | }) 106 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contribution Guidelines 2 | 3 | easystats guidelines 0.1.0 4 | 5 | **All people are very much welcome to contribute to code, documentation, testing and suggestions.** 6 | 7 | This package aims at being beginner-friendly. Even if you're new to this open-source way of life, new to coding and github stuff, we encourage you to try submitting pull requests (PRs). 8 | 9 | - **"I'd like to help, but I'm not good enough with programming yet"** 10 | 11 | It's alright, don't worry! You can always dig in the code, in the documentation or tests. There are always some typos to fix, some docs to improve, some details to add, some code lines to document, some tests to add... **Even the smaller PRs are appreciated**. 12 | 13 | - **"I'd like to help, but I don't know where to start"** 14 | 15 | You can look around the **issue section** to find some features / ideas / bugs to start working on. You can also open a new issue **just to say that you're there, interested in helping out**. We might have some ideas adapted to your skills. 16 | 17 | - **"I'm not sure if my suggestion or idea is worthwile"** 18 | 19 | Enough with the impostor syndrom! All suggestions and opinions are good, and even if it's just a thought or so, it's always good to receive feedback. 20 | 21 | - **"Why should I waste my time with this? Do I get any credit?"** 22 | 23 | Software contributions are getting more and more valued in the academic world, so it is a good time to collaborate with us! Authors of substantial contributions will be added within the **authors** list. We're also very keen on including them to eventual academic publications. 24 | 25 | 26 | **Anyway, starting is the most important! You will then enter a *whole new world, a new fantastic point of view*... So fork this repo, do some changes and submit them. We will then work together to make the best out of it :)** 27 | 28 | 29 | ## Code 30 | 31 | - Please document and comment your code, so that the purpose of each step (or code line) is stated in a clear and understandable way. 32 | - Before submitting a change, please read the [**R style guide**](https://style.tidyverse.org/) and in particular our [**easystats convention of code-style**](https://github.com/easystats/easystats#convention-of-code-style) to keep some consistency in code formatting. 33 | - Regarding the style guide, note this exception: we put readability and clarity before everything. Thus, we like underscores and full names (prefer `model_performance` over `modelperf` and `interpret_odds_logistic` over `intoddslog`). 34 | - Before you start to code, make sure you're on the `dev` branch (the most "advanced"). Then, you can create a new branch named by your feature (e.g., `feature_lightsaber`) and do your changes. Finally, submit your branch to be merged into the `dev` branch. Then, every now and then, the dev branch will merge into `master`, as a new package version. 35 | 36 | ## Checks to do before submission 37 | 38 | - Make sure **documentation** (roxygen) is good 39 | - Make sure to add **tests** for the new functions 40 | - Run: 41 | 42 | - `styler::style_pkg()`: Automatic style formatting 43 | - `lintr::lint_package()`: Style checks 44 | - `devtools::check()`: General checks 45 | 46 | 47 | 48 | ## Useful Materials 49 | 50 | - [Understanding the GitHub flow](https://guides.github.com/introduction/flow/) 51 | 52 | 53 | -------------------------------------------------------------------------------- /R/print.rope.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | print.rope <- function(x, digits = 2, ...) { 3 | orig_x <- x 4 | 5 | # If the model is multivariate, we have have different ROPES depending on 6 | # the outcome variable. 7 | is_multivariate <- length(unique(x$Response)) > 1 8 | 9 | if (isTRUE(is_multivariate)) { 10 | insight::print_color(sprintf( 11 | "# Proportion%s of samples inside the ROPE.\nROPE with depends on outcome variable.\n\n", 12 | ifelse(all(x$CI[1] == x$CI), "", "s") 13 | ), "blue") 14 | } else { 15 | insight::print_color(sprintf( 16 | "# Proportion%s of samples inside the ROPE [%.*f, %.*f]:\n\n", 17 | ifelse(all(x$CI[1] == x$CI), "", "s"), 18 | digits, 19 | x$ROPE_low[1], 20 | digits, 21 | x$ROPE_high[1] 22 | ), "blue") 23 | } 24 | 25 | 26 | # I think this is something nobody will understand and we'll probably forget 27 | # why we did this, so I'll comment a bit... 28 | 29 | # These are the base columns we want to print 30 | cols <- c( 31 | attr(x, "idvars"), "Parameter", 32 | "ROPE_Percentage", "Superiority_Percentage", "Inferiority_Percentage", 33 | "Effects", "Component", 34 | if (is_multivariate) c("ROPE_low", "ROPE_high") 35 | ) 36 | 37 | # In case we have ropes for different CIs, we also want this information 38 | # So we first check if values in the CI column differ, and if so, we also 39 | # keep this column for printing 40 | if (!all(x$CI[1] == x$CI)) { 41 | cols <- c("CI", cols) 42 | } 43 | 44 | # Either way, we need to know the different CI-values, so we can 45 | # split the data frame for printing later... 46 | ci <- unique(x$CI) 47 | 48 | # now we check which of the requested columns are actually in our data frame "x" 49 | # "x" may differ, depending on if "rope()" was called with a model-object, 50 | # or with a simple vector. So we can't hard-code this 51 | x <- subset(x, select = intersect(cols, colnames(x))) 52 | 53 | # This is just cosmetics, to have nicer column names and values 54 | iv <- intersect(colnames(x), c("ROPE_Percentage", "Superiority_Percentage", "Inferiority_Percentage")) 55 | x[iv] <- lapply(x[iv], function(v) sprintf("%.*f %%", digits, v * 100)) 56 | colnames(x)[colnames(x) == "ROPE_Percentage"] <- "Inside ROPE" 57 | colnames(x)[colnames(x) == "Superiority_Percentage"] <- "Above ROPE" 58 | colnames(x)[colnames(x) == "Inferiority_Percentage"] <- "Below ROPE" 59 | 60 | # Add ROPE width for multivariate models 61 | if (isTRUE(is_multivariate)) { 62 | # This is just cosmetics, to have nicer column names and values 63 | x$ROPE_low <- sprintf("[%.*f, %.*f]", digits, x$ROPE_low, digits, x$ROPE_high) 64 | colnames(x)[which(colnames(x) == "ROPE_low")] <- "ROPE width" 65 | x$ROPE_high <- NULL 66 | } 67 | 68 | # In case we have multiple CI values, we create a subset for each CI value. 69 | # Else, parameter-rows would be mixed up with both CIs, which is a bit 70 | # more difficult to read... 71 | if (length(ci) == 1) { 72 | # print complete data frame, because we have no different CI values here 73 | .print_data_frame(x, digits = digits) 74 | } else { 75 | for (i in ci) { 76 | xsub <- x[x$CI == i, -which(colnames(x) == "CI"), drop = FALSE] 77 | insight::print_color(sprintf("ROPE for the %s%% HDI:\n\n", 100 * i), "cyan") 78 | .print_data_frame(xsub, digits = digits) 79 | cat("\n") 80 | } 81 | } 82 | invisible(orig_x) 83 | } 84 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://easystats.github.io/bayestestR/ 2 | 3 | template: 4 | bootstrap: 5 5 | package: easystatstemplate 6 | 7 | reference: 8 | - title: "Posterior Description" 9 | contents: 10 | - starts_with("describe_") 11 | - sexit 12 | 13 | - title: "Centrality and Uncertainty" 14 | contents: 15 | - ends_with("_estimate") 16 | - bci 17 | - eti 18 | - hdi 19 | - spi 20 | - ci 21 | 22 | - title: "Effect Existence and Significance" 23 | desc: "Functions for Bayesian Inference" 24 | - subtitle: "Posterior Based Methods" 25 | contents: 26 | - starts_with("p_") 27 | - contains("rope") 28 | - equivalence_test 29 | - convert_pd_to_p 30 | 31 | - subtitle: "Bayes factors" 32 | contents: 33 | - contains("bayesfactor") 34 | - si 35 | - weighted_posteriors 36 | - bic_to_bf 37 | - p_to_bf 38 | 39 | - title: "Model Diagnostics" 40 | contents: 41 | - diagnostic_posterior 42 | - sensitivity_to_prior 43 | - check_prior 44 | - starts_with("simulate_") 45 | - unupdate 46 | - effective_sample 47 | - mcse 48 | 49 | - title: "Density Estimation" 50 | contents: 51 | - estimate_density 52 | - density_at 53 | - area_under_curve 54 | - overlap 55 | 56 | - title: "Distributions" 57 | contents: 58 | - distribution 59 | 60 | - title: "Utilities" 61 | contents: 62 | - display.describe_posterior 63 | - mediation 64 | - convert_bayesian_as_frequentist 65 | - contr.equalprior_pairs 66 | - as.numeric.p_direction 67 | - as.data.frame.density 68 | - sexit_thresholds 69 | - reshape_iterations 70 | - diagnostic_draws 71 | - model_to_priors 72 | - disgust 73 | 74 | # Keep articles organized 75 | navbar: 76 | left: 77 | - icon: fa fa-file-code 78 | text: Reference 79 | href: reference/index.html 80 | - text: Get started 81 | href: articles/bayestestR.html 82 | - text: Examples 83 | menu: 84 | - text: "1. Initiation to Bayesian models" 85 | href: articles/example1.html 86 | - text: "2. Confirmation of Bayesian skills" 87 | href: articles/example2.html 88 | - text: "3. Become a Bayesian master" 89 | href: articles/example3.html 90 | - text: Articles 91 | menu: 92 | - text: "Credible Intervals (CI)" 93 | href: articles/credible_interval.html 94 | - text: "Region of Practical Equivalence (ROPE)" 95 | href: articles/region_of_practical_equivalence.html 96 | - text: "Probability of Direction (pd)" 97 | href: articles/probability_of_direction.html 98 | - text: "Bayes Factors (BF)" 99 | href: articles/bayes_factors.html 100 | - text: "Comparison of Point-Estimates" 101 | href: articles/web_only/indicesEstimationComparison.html 102 | - text: "Comparison of Indices of Effect Existence" 103 | href: https://www.frontiersin.org/articles/10.3389/fpsyg.2019.02767/full 104 | - text: "Mediation Analysis: Direct and Indirect Effects" 105 | href: articles/mediation.html 106 | - text: Guidelines 107 | href: articles/guidelines.html 108 | - icon: fa fa-newspaper 109 | text: News 110 | href: news/index.html 111 | -------------------------------------------------------------------------------- /tests/testthat/test-p_significance.R: -------------------------------------------------------------------------------- 1 | test_that("p_significance", { 2 | # numeric 3 | set.seed(333) 4 | x <- distribution_normal(10000, 1, 1) 5 | ps <- p_significance(x) 6 | expect_equal(as.numeric(ps), 0.816, tolerance = 0.1) 7 | expect_s3_class(ps, "p_significance") 8 | expect_s3_class(ps, "data.frame") 9 | expect_identical(dim(ps), c(1L, 2L)) 10 | expect_identical( 11 | capture.output(print(ps)), 12 | c( 13 | "Practical Significance (threshold: 0.10)", 14 | "", 15 | "Parameter | ps", 16 | "----------------", 17 | "Posterior | 0.82" 18 | ) 19 | ) 20 | 21 | # non-symmetric intervals 22 | ps <- p_significance(x, threshold = c(0.05, 0.2)) 23 | expect_equal(as.numeric(ps), 0.7881, tolerance = 0.1) 24 | # should be identical, both ranges have same distance to the mean 1 25 | ps <- p_significance(x, threshold = c(1.8, 1.95)) 26 | expect_equal(as.numeric(ps), 0.7881, tolerance = 0.1) 27 | 28 | set.seed(333) 29 | x <- data.frame(replicate(4, rnorm(100))) 30 | pd <- p_significance(x) 31 | expect_identical(dim(pd), c(4L, 2L)) 32 | 33 | # error: 34 | expect_error(p_significance(x, threshold = 1:3)) 35 | }) 36 | 37 | test_that("stanreg", { 38 | skip_if_not_installed("curl") 39 | skip_if_offline() 40 | skip_if_not_installed("httr2") 41 | skip_if_not_or_load_if_installed("rstanarm") 42 | m <- insight::download_model("stanreg_merMod_5") 43 | 44 | expect_equal( 45 | p_significance(m, effects = "all")$ps[1], 46 | 0.99, 47 | tolerance = 1e-2 48 | ) 49 | }) 50 | 51 | test_that("brms", { 52 | skip_if_not_installed("curl") 53 | skip_if_offline() 54 | skip_if_not_installed("httr2") 55 | skip_if_not_or_load_if_installed("brms") 56 | 57 | m2 <- insight::download_model("brms_1") 58 | 59 | expect_equal( 60 | p_significance(m2, effects = "all")$ps, 61 | c(1.0000, 0.9985, 0.9785), 62 | tolerance = 0.01 63 | ) 64 | 65 | out <- p_significance(m2, threshold = list(1, "default", 2), effects = "all") 66 | expect_equal( 67 | out$ps, 68 | c(1.00000, 0.99850, 0.12275), 69 | tolerance = 0.01 70 | ) 71 | expect_equal( 72 | attributes(out)$threshold, 73 | list(c(-1, 1), c(-0.60269480520891, 0.60269480520891), c(-2, 2)), 74 | tolerance = 1e-4 75 | ) 76 | 77 | expect_error( 78 | p_significance(m2, threshold = list(1, "a", 2), effects = "all"), 79 | regex = "should be one of" 80 | ) 81 | expect_error( 82 | p_significance(m2, threshold = list(1, 2, 3, 4), effects = "all"), 83 | regex = "Length of" 84 | ) 85 | }) 86 | 87 | test_that("stan", { 88 | skip_if_not_installed("curl") 89 | skip_if_offline() 90 | skip_if_not_installed("httr2") 91 | skip_if_not_or_load_if_installed("rstanarm") 92 | m <- insight::download_model("stanreg_merMod_5") 93 | 94 | expect_equal( 95 | p_significance(m, threshold = list("(Intercept)" = 1, period4 = 1.5, period3 = 0.5))$ps, 96 | p_significance(m, threshold = list(1, "default", "default", 0.5, 1.5))$ps, 97 | tolerance = 1e-4 98 | ) 99 | 100 | expect_error( 101 | p_significance(m, threshold = list("(Intercept)" = 1, point = 1.5, period3 = 0.5)), 102 | regex = "Not all elements" 103 | ) 104 | expect_error( 105 | p_significance(m, threshold = list(1, "a", 2), effects = "all"), 106 | regex = "should be one of" 107 | ) 108 | expect_error( 109 | p_significance(m, threshold = list(1, 2, 3, 4), effects = "all"), 110 | regex = "Length of" 111 | ) 112 | }) 113 | -------------------------------------------------------------------------------- /tests/testthat/test-BFBayesFactor.R: -------------------------------------------------------------------------------- 1 | skip_on_os("linux") 2 | 3 | test_that("p_direction", { 4 | skip_if_not_or_load_if_installed("BayesFactor") 5 | set.seed(333) 6 | x <- BayesFactor::correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width) 7 | expect_equal(as.numeric(p_direction(x)), 0.9225, tolerance = 1) 8 | }) 9 | 10 | test_that("p_direction: BF t.test one sample", { 11 | skip_if_not_or_load_if_installed("BayesFactor") 12 | data(sleep) 13 | diffScores <- sleep$extra[1:10] - sleep$extra[11:20] 14 | x <- BayesFactor::ttestBF(x = diffScores) 15 | expect_equal(as.numeric(p_direction(x)), 0.99675, tolerance = 1) 16 | }) 17 | 18 | 19 | test_that("p_direction: BF t.test two samples", { 20 | skip_if_not_or_load_if_installed("BayesFactor") 21 | data(chickwts) 22 | chickwts <- chickwts[chickwts$feed %in% c("horsebean", "linseed"), ] 23 | chickwts$feed <- factor(chickwts$feed) 24 | x <- BayesFactor::ttestBF(formula = weight ~ feed, data = chickwts) 25 | expect_equal(as.numeric(p_direction(x)), 1, tolerance = 1) 26 | }) 27 | 28 | test_that("p_direction: BF t.test meta-analytic", { 29 | skip_if_not_or_load_if_installed("BayesFactor") 30 | t <- c(-0.15, 2.39, 2.42, 2.43) 31 | N <- c(100, 150, 97, 99) 32 | x <- BayesFactor::meta.ttestBF(t = t, n1 = N, rscale = 1) 33 | expect_equal(as.numeric(p_direction(x)), 0.99975, tolerance = 1) 34 | }) 35 | 36 | skip_if_not_or_load_if_installed("BayesFactor") 37 | 38 | # --------------------------- 39 | # "BF ANOVA" 40 | data(ToothGrowth) 41 | ToothGrowth$dose <- factor(ToothGrowth$dose) 42 | levels(ToothGrowth$dose) <- c("Low", "Medium", "High") 43 | x <- BayesFactor::anovaBF(len ~ supp * dose, data = ToothGrowth) 44 | test_that("p_direction", { 45 | expect_equal(as.numeric(p_direction(x)), c(1, 0.95675, 0.95675, 1, 1), tolerance = 0.1) 46 | }) 47 | 48 | # BF ANOVA Random --------------------------- 49 | 50 | data(puzzles) 51 | x <- BayesFactor::anovaBF(RT ~ shape * color + ID, data = puzzles, whichRandom = "ID") 52 | test_that("p_direction", { 53 | expect_equal(as.numeric(p_direction(x)), c( 54 | 1, 0.98125, 0.98125, 0.995, 0.67725, 0.8285, 0.68425, 0.99975, 55 | 0.6725, 0.9995, 0.60275, 0.99525, 0.7615, 0.763, 1, 1, 1, 1 56 | ), tolerance = 0.1) 57 | }) 58 | 59 | 60 | # --------------------------- 61 | # "BF lm" 62 | x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth) 63 | test_that("p_direction", { 64 | expect_equal(as.numeric(p_direction(x)), c(1, 0.9995, 0.9995, 1, 0.903, 1, 1, 1, 1), tolerance = 0.1) 65 | }) 66 | 67 | 68 | x2 <- BayesFactor::lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth) 69 | x <- x / x2 70 | test_that("p_direction", { 71 | expect_equal(as.numeric(p_direction(x)), c(1, 0.99925, 0.99925, 1, 0.89975, 1, 1, 1, 1), tolerance = 0.1) 72 | }) 73 | 74 | 75 | test_that("rope_range", { 76 | skip_if_not_or_load_if_installed("BayesFactor") 77 | x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth) 78 | expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10, tolerance = 1e-4) 79 | 80 | x <- BayesFactor::ttestBF( 81 | ToothGrowth$len[ToothGrowth$supp == "OJ"], 82 | ToothGrowth$len[ToothGrowth$supp == "VC"] 83 | ) 84 | expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10, tolerance = 1e-4) 85 | 86 | x <- BayesFactor::ttestBF(formula = len ~ supp, data = ToothGrowth) 87 | expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10, tolerance = 1e-4) 88 | 89 | # else 90 | x <- BayesFactor::correlationBF(ToothGrowth$len, as.numeric(ToothGrowth$dose)) 91 | expect_equal(rope_range(x, verbose = FALSE), c(-0.05, 0.05), tolerance = 1e-4) 92 | }) 93 | -------------------------------------------------------------------------------- /data-raw/disgust.R: -------------------------------------------------------------------------------- 1 | disgust <- tibble::tribble( 2 | ~score, ~condition, 3 | 13L, "control", 4 | 26L, "control", 5 | 30L, "control", 6 | 23L, "control", 7 | 34L, "control", 8 | 37L, "control", 9 | 33L, "control", 10 | 34L, "control", 11 | 35L, "control", 12 | 33L, "control", 13 | 24L, "control", 14 | 43L, "control", 15 | 23L, "control", 16 | 34L, "control", 17 | 17L, "control", 18 | 38L, "control", 19 | 38L, "control", 20 | 46L, "control", 21 | 28L, "control", 22 | 30L, "control", 23 | 25L, "control", 24 | 28L, "control", 25 | 19L, "control", 26 | 32L, "control", 27 | 29L, "control", 28 | 38L, "control", 29 | 29L, "control", 30 | 28L, "control", 31 | 28L, "control", 32 | 34L, "control", 33 | 28L, "control", 34 | 38L, "control", 35 | 26L, "control", 36 | 43L, "control", 37 | 25L, "control", 38 | 24L, "control", 39 | 21L, "control", 40 | 34L, "control", 41 | 31L, "control", 42 | 21L, "control", 43 | 23L, "control", 44 | 23L, "control", 45 | 38L, "control", 46 | 16L, "control", 47 | 29L, "control", 48 | 39L, "control", 49 | 25L, "control", 50 | 31L, "control", 51 | 33L, "control", 52 | 43L, "control", 53 | 25L, "lemon", 54 | 23L, "lemon", 55 | 35L, "lemon", 56 | 14L, "lemon", 57 | 31L, "lemon", 58 | 41L, "lemon", 59 | 21L, "lemon", 60 | 22L, "lemon", 61 | 35L, "lemon", 62 | 30L, "lemon", 63 | 45L, "lemon", 64 | 30L, "lemon", 65 | 28L, "lemon", 66 | 23L, "lemon", 67 | 40L, "lemon", 68 | 27L, "lemon", 69 | 37L, "lemon", 70 | 26L, "lemon", 71 | 25L, "lemon", 72 | 30L, "lemon", 73 | 33L, "lemon", 74 | 18L, "lemon", 75 | 26L, "lemon", 76 | 26L, "lemon", 77 | 34L, "lemon", 78 | 19L, "lemon", 79 | 22L, "lemon", 80 | 22L, "lemon", 81 | 26L, "lemon", 82 | 27L, "lemon", 83 | 27L, "lemon", 84 | 38L, "lemon", 85 | 33L, "lemon", 86 | 31L, "lemon", 87 | 31L, "lemon", 88 | 23L, "lemon", 89 | 27L, "lemon", 90 | 33L, "lemon", 91 | 30L, "lemon", 92 | 30L, "lemon", 93 | 36L, "lemon", 94 | 43L, "lemon", 95 | 26L, "lemon", 96 | 32L, "lemon", 97 | 26L, "lemon", 98 | 26L, "lemon", 99 | 22L, "lemon", 100 | 24L, "lemon", 101 | 28L, "lemon", 102 | 29L, "lemon", 103 | 35L, "sulfur", 104 | 24L, "sulfur", 105 | 39L, "sulfur", 106 | 34L, "sulfur", 107 | 35L, "sulfur", 108 | 44L, "sulfur", 109 | 23L, "sulfur", 110 | 36L, "sulfur", 111 | 28L, "sulfur", 112 | 23L, "sulfur", 113 | 30L, "sulfur", 114 | 36L, "sulfur", 115 | 40L, "sulfur", 116 | 30L, "sulfur", 117 | 34L, "sulfur", 118 | 34L, "sulfur", 119 | 32L, "sulfur", 120 | 45L, "sulfur", 121 | 40L, "sulfur", 122 | 28L, "sulfur", 123 | 33L, "sulfur", 124 | 42L, "sulfur", 125 | 30L, "sulfur", 126 | 32L, "sulfur", 127 | 26L, "sulfur", 128 | 29L, "sulfur", 129 | 31L, "sulfur", 130 | 35L, "sulfur", 131 | 24L, "sulfur", 132 | 32L, "sulfur", 133 | 31L, "sulfur", 134 | 28L, "sulfur", 135 | 32L, "sulfur", 136 | 39L, "sulfur", 137 | 20L, "sulfur", 138 | 33L, "sulfur", 139 | 30L, "sulfur", 140 | 37L, "sulfur", 141 | 35L, "sulfur", 142 | 32L, "sulfur", 143 | 27L, "sulfur", 144 | 38L, "sulfur", 145 | 21L, "sulfur", 146 | 41L, "sulfur", 147 | 27L, "sulfur", 148 | 27L, "sulfur", 149 | 43L, "sulfur", 150 | 25L, "sulfur", 151 | 24L, "sulfur", 152 | 23L, "sulfur" 153 | ) 154 | 155 | disgust$condition <- factor(disgust$condition) 156 | disgust <- as.data.frame(disgust) 157 | 158 | save(disgust, file = "data/disgust.rdata") 159 | -------------------------------------------------------------------------------- /R/bayesfactor.R: -------------------------------------------------------------------------------- 1 | #' Bayes Factors (BF) 2 | #' 3 | #' This function compte the Bayes factors (BFs) that are appropriate to the 4 | #' input. For vectors or single models, it will compute [`BFs for single 5 | #' parameters`][bayesfactor_parameters], or is `hypothesis` is specified, 6 | #' [`BFs for restricted models`][bayesfactor_restricted]. For multiple models, 7 | #' it will return the BF corresponding to [`comparison between 8 | #' models`][bayesfactor_models] and if a model comparison is passed, it will 9 | #' compute the [`inclusion BF`][bayesfactor_inclusion]. 10 | #' \cr\cr 11 | #' For a complete overview of these functions, read the [Bayes factor vignette](https://easystats.github.io/bayestestR/articles/bayes_factors.html). 12 | #' 13 | #' @param ... A numeric vector, model object(s), or the output from 14 | #' `bayesfactor_models`. 15 | #' @inheritParams bayesfactor_parameters 16 | #' @inheritParams bayesfactor_restricted 17 | #' @inheritParams bayesfactor_models 18 | #' @inheritParams bayesfactor_inclusion 19 | #' 20 | #' @return Some type of Bayes factor, depending on the input. See 21 | #' [`bayesfactor_parameters()`], [`bayesfactor_models()`] or [`bayesfactor_inclusion()`]. 22 | #' 23 | #' @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}. 24 | #' 25 | #' @examplesIf require("rstanarm") && require("logspline") 26 | #' \dontrun{ 27 | #' library(bayestestR) 28 | #' 29 | #' prior <- distribution_normal(1000, mean = 0, sd = 1) 30 | #' posterior <- distribution_normal(1000, mean = 0.5, sd = 0.3) 31 | #' 32 | #' bayesfactor(posterior, prior = prior, verbose = FALSE) 33 | #' 34 | #' # rstanarm models 35 | #' # --------------- 36 | #' model <- suppressWarnings(rstanarm::stan_lmer(extra ~ group + (1 | ID), data = sleep)) 37 | #' bayesfactor(model, verbose = FALSE) 38 | #' 39 | #' # Frequentist models 40 | #' # --------------- 41 | #' m0 <- lm(extra ~ 1, data = sleep) 42 | #' m1 <- lm(extra ~ group, data = sleep) 43 | #' m2 <- lm(extra ~ group + ID, data = sleep) 44 | #' 45 | #' comparison <- bayesfactor(m0, m1, m2) 46 | #' comparison 47 | #' 48 | #' bayesfactor(comparison) 49 | #' } 50 | #' @export 51 | bayesfactor <- function(..., 52 | prior = NULL, 53 | direction = "two-sided", 54 | null = 0, 55 | hypothesis = NULL, 56 | effects = "fixed", 57 | verbose = TRUE, 58 | denominator = 1, 59 | match_models = FALSE, 60 | prior_odds = NULL) { 61 | mods <- list(...) 62 | 63 | if (length(mods) > 1) { 64 | bayesfactor_models(..., denominator = denominator) 65 | } else if (inherits(mods[[1]], "bayesfactor_models")) { 66 | bayesfactor_inclusion(..., match_models = match_models, prior_odds = prior_odds) 67 | } else if (inherits(mods[[1]], "BFBayesFactor")) { 68 | if (inherits(mods[[1]]@numerator[[1]], "BFlinearModel")) { 69 | bayesfactor_inclusion(..., match_models = match_models, prior_odds = prior_odds) 70 | } else { 71 | bayesfactor_models(...) 72 | } 73 | } else if (is.null(hypothesis)) { 74 | bayesfactor_parameters( 75 | ..., 76 | prior = prior, 77 | direction = direction, 78 | null = null, 79 | effects = effects, 80 | verbose = verbose 81 | ) 82 | } else { 83 | bayesfactor_restricted(..., 84 | prior = prior, 85 | verbose = verbose, 86 | effects = effects 87 | ) 88 | } 89 | } 90 | -------------------------------------------------------------------------------- /man/simulate_prior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_priors.R 3 | \name{simulate_prior} 4 | \alias{simulate_prior} 5 | \alias{simulate_prior.brmsfit} 6 | \title{Returns Priors of a Model as Empirical Distributions} 7 | \usage{ 8 | simulate_prior(model, n = 1000, ...) 9 | 10 | \method{simulate_prior}{brmsfit}( 11 | model, 12 | n = 1000, 13 | effects = "fixed", 14 | component = "conditional", 15 | parameters = NULL, 16 | verbose = TRUE, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{model}{A \code{stanreg}, \code{stanfit}, \code{brmsfit}, \code{blavaan}, or \code{MCMCglmm} object.} 22 | 23 | \item{n}{Size of the simulated prior distributions.} 24 | 25 | \item{...}{Currently not used.} 26 | 27 | \item{effects}{Should variables for fixed effects (\code{"fixed"}), random effects 28 | (\code{"random"}) or both (\code{"all"}) be returned? Only applies to mixed models. May 29 | be abbreviated. 30 | 31 | For models of from packages \strong{brms} or \strong{rstanarm} there are additional 32 | options: 33 | \itemize{ 34 | \item \code{"fixed"} returns fixed effects. 35 | \item \code{"random_variance"} return random effects parameters (variance and 36 | correlation components, e.g. those parameters that start with \code{sd_} or 37 | \code{cor_}). 38 | \item \code{"grouplevel"} returns random effects group level estimates, i.e. those 39 | parameters that start with \code{r_}. 40 | \item \code{"random"} returns both \code{"random_variance"} and \code{"grouplevel"}. 41 | \item \code{"all"} returns fixed effects and random effects variances. 42 | \item \code{"full"} returns all parameters. 43 | }} 44 | 45 | \item{component}{Which type of parameters to return, such as parameters for 46 | the conditional model, the zero-inflated part of the model, the dispersion 47 | term, etc. See details in section \emph{Model Components}. May be abbreviated. 48 | Note that the \emph{conditional} component also refers to the \emph{count} or \emph{mean} 49 | component - names may differ, depending on the modeling package. There are 50 | three convenient shortcuts (not applicable to \emph{all} model classes): 51 | \itemize{ 52 | \item \code{component = "all"} returns all possible parameters. 53 | \item If \code{component = "location"}, location parameters such as \code{conditional}, 54 | \code{zero_inflated}, \code{smooth_terms}, or \code{instruments} are returned (everything 55 | that are fixed or random effects - depending on the \code{effects} argument - 56 | but no auxiliary parameters). 57 | \item For \code{component = "distributional"} (or \code{"auxiliary"}), components like 58 | \code{sigma}, \code{dispersion}, \code{beta} or \code{precision} (and other auxiliary 59 | parameters) are returned. 60 | }} 61 | 62 | \item{parameters}{Regular expression pattern that describes the parameters 63 | that should be returned. Meta-parameters (like \code{lp__} or \code{prior_}) are 64 | filtered by default, so only parameters that typically appear in the 65 | \code{summary()} are returned. Use \code{parameters} to select specific parameters 66 | for the output.} 67 | 68 | \item{verbose}{Toggle off warnings.} 69 | } 70 | \description{ 71 | Transforms priors information to actual distributions. 72 | } 73 | \examples{ 74 | \donttest{ 75 | library(bayestestR) 76 | if (require("rstanarm")) { 77 | model <- suppressWarnings( 78 | stan_glm(mpg ~ wt + am, data = mtcars, chains = 1, refresh = 0) 79 | ) 80 | simulate_prior(model) 81 | } 82 | } 83 | } 84 | \seealso{ 85 | \code{\link[=unupdate]{unupdate()}} for directly sampling from the prior 86 | distribution (useful for complex priors and designs). 87 | } 88 | -------------------------------------------------------------------------------- /R/convert_pd_to_p.R: -------------------------------------------------------------------------------- 1 | #' Convert between Probability of Direction (pd) and p-value. 2 | #' 3 | #' Enables a conversion between Probability of Direction (pd) and p-value. 4 | #' 5 | #' @param pd A Probability of Direction (pd) value (between 0 and 1). Can also 6 | #' be a data frame with a column named `pd`, `p_direction`, or `PD`, as returned 7 | #' by [`p_direction()`]. In this case, the column is converted to p-values and 8 | #' the new data frame is returned. 9 | #' @param p A p-value. 10 | #' @param direction What type of p-value is requested or provided. Can be 11 | #' `"two-sided"` (default, two tailed) or `"one-sided"` (one tailed). 12 | #' @param verbose Toggle off warnings. 13 | #' @param ... Arguments passed to or from other methods. 14 | #' 15 | #' @return A p-value or a data frame with a p-value column. 16 | #' 17 | #' @details 18 | #' Conversion is done using the following equation (see _Makowski et al., 2019_): 19 | #' 20 | #' When `direction = "two-sided"` 21 | #' 22 | #' \ifelse{html}{\out{p = 2 * (1 - pd)}}{\eqn{p = 2 \times (1 - p_d)}} 23 | #' 24 | #' When `direction = "one-sided"` 25 | #' 26 | #' \ifelse{html}{\out{p = 1 - pd}}{\eqn{p = 1 - p_d}} 27 | #' 28 | #' Note that this conversion is only valid when the lowest possible values of pd 29 | #' is 0.5 - i.e., when the posterior represents continuous parameter space (see 30 | #' [`p_direction()`]). If any pd < 0.5 are detected, they are converted to a p 31 | #' of 1, and a warning is given. 32 | #' 33 | #' @references 34 | #' Makowski, D., Ben-Shachar, M. S., Chen, S. H. A., and Lüdecke, D. (2019). 35 | #' *Indices of Effect Existence and Significance in the Bayesian Framework*. 36 | #' Frontiers in Psychology 2019;10:2767. \doi{10.3389/fpsyg.2019.02767} 37 | #' 38 | #' @examples 39 | #' pd_to_p(pd = 0.95) 40 | #' pd_to_p(pd = 0.95, direction = "one-sided") 41 | #' 42 | #' @export 43 | pd_to_p <- function(pd, ...) { 44 | UseMethod("pd_to_p") 45 | } 46 | 47 | 48 | #' @export 49 | #' @rdname pd_to_p 50 | pd_to_p.numeric <- function(pd, direction = "two-sided", verbose = TRUE, ...) { 51 | p <- 1 - pd 52 | if (.get_direction(direction) == 0) { 53 | p <- 2 * p 54 | } 55 | 56 | less_than_0.5 <- pd < 0.5 57 | if (any(less_than_0.5)) { 58 | if (verbose) { 59 | insight::format_warning(paste( 60 | "pd-values smaller than 0.5 detected, indicating inconsistent direction of the probability mass.", 61 | "This usually happens when the parameters space is not continuous. Affected values are set to 1.", 62 | "See help('p_direction') for more info." 63 | )) 64 | } 65 | p[less_than_0.5] <- 1 66 | } 67 | 68 | p 69 | } 70 | 71 | 72 | #' @export 73 | pd_to_p.data.frame <- function(pd, direction = "two-sided", verbose = TRUE, ...) { 74 | # check if data frame has an appropriate column 75 | pd_column <- intersect(c("pd", "p_direction", "PD"), colnames(pd))[1] 76 | if (is.na(pd_column) || length(pd_column) == 0) { 77 | insight::format_error("No column named `pd`, `p_direction`, or `PD` found.") 78 | } 79 | 80 | # add p-value column 81 | pd$p <- pd_to_p(as.numeric(pd[[pd_column]])) 82 | # remove pd-column 83 | pd[[pd_column]] <- NULL 84 | pd 85 | } 86 | 87 | 88 | #' @rdname pd_to_p 89 | #' @export 90 | p_to_pd <- function(p, direction = "two-sided", ...) { 91 | if (.get_direction(direction) == 0) { 92 | p <- p / 2 93 | } 94 | (1 - p) 95 | } 96 | 97 | 98 | #' @rdname pd_to_p 99 | #' @export 100 | convert_p_to_pd <- p_to_pd 101 | 102 | #' @rdname pd_to_p 103 | #' @export 104 | convert_pd_to_p <- pd_to_p 105 | --------------------------------------------------------------------------------