New Upstream Release - r-cran-bayestestr
Ready changes
Summary
Merged new upstream version: 0.13.1 (was: 0.13.0).
Diff
diff --git a/DESCRIPTION b/DESCRIPTION
index 957329c..b5ea81b 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -2,7 +2,7 @@ Type: Package
Package: bayestestR
Title: Understand and Describe Bayesian Models and Posterior
Distributions
-Version: 0.13.0
+Version: 0.13.1
Authors@R:
c(person(given = "Dominique",
family = "Makowski",
@@ -63,28 +63,30 @@ Description: Provides utilities to describe posterior
Maximum A Posteriori (MAP), measures of dispersion (Highest Density
Interval - HDI; Kruschke, 2015 <doi:10.1016/C2012-0-00477-2>) and
indices used for null-hypothesis testing (such as ROPE percentage, pd
- and Bayes factors).
+ and Bayes factors). References: Makowski et al. (2021) <doi:10.21105/joss.01541>.
Depends: R (>= 3.6)
-Imports: insight (>= 0.18.2), datawizard (>= 0.5.1), graphics, methods,
+Imports: insight (>= 0.19.1), datawizard (>= 0.7.0), graphics, methods,
stats, utils
-Suggests: BayesFactor, bayesQR, bayesplot, BH, blavaan, bridgesampling,
- brms, effectsize, emmeans, gamm4, ggdist, ggplot2, glmmTMB,
- httr, KernSmooth, knitr, lavaan, lme4, logspline, MASS, mclust,
- mediation, modelbased, parameters, patchwork, performance,
- quadprog, posterior, RcppEigen, rmarkdown, rstan, rstanarm,
- see, testthat, tweedie
+Suggests: BayesFactor (>= 0.9.12-4.4), bayesQR, bayesplot, BH, blavaan,
+ bridgesampling, brms, curl, effectsize, emmeans, gamm4, ggdist,
+ ggplot2, glmmTMB, httr, KernSmooth, knitr, lavaan, lme4,
+ logspline, MASS, mclust, mediation, modelbased, parameters,
+ patchwork, performance, quadprog, posterior, RcppEigen,
+ rmarkdown, rstan, rstanarm, see (>= 0.7.5), testthat, tweedie
License: GPL-3
URL: https://easystats.github.io/bayestestR/
BugReports: https://github.com/easystats/bayestestR/issues
VignetteBuilder: knitr
Encoding: UTF-8
Language: en-US
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3.9000
Config/testthat/edition: 3
+Config/testthat/parallel: true
+Config/rcmdcheck/ignore-inconsequential-notes: true
Config/Needs/website: rstudio/bslib, r-lib/pkgdown,
easystats/easystatstemplate
NeedsCompilation: no
-Packaged: 2022-09-18 00:42:48 UTC; domma
+Packaged: 2023-04-06 11:19:35 UTC; domma
Author: Dominique Makowski [aut, cre] (<https://orcid.org/0000-0001-5375-9967>,
@Dom_Makowski),
Daniel Lüdecke [aut] (<https://orcid.org/0000-0002-8895-3206>,
@@ -102,4 +104,4 @@ Author: Dominique Makowski [aut, cre] (<https://orcid.org/0000-0001-5375-9967>,
Quentin F. Gronau [ctb] (<https://orcid.org/0000-0001-5510-6943>),
Sam Crawley [ctb] (<https://orcid.org/0000-0002-7847-0411>)
Repository: CRAN
-Date/Publication: 2022-09-18 02:46:03 UTC
+Date/Publication: 2023-04-07 15:20:02 UTC
diff --git a/MD5 b/MD5
index 465eea4..54eb12f 100644
--- a/MD5
+++ b/MD5
@@ -1,108 +1,112 @@
-c1aa30b2ab4e70b3a28f08914d891dad *DESCRIPTION
-bdc1aec94a9b73d226d0957fc9458538 *NAMESPACE
-8f4d2672e81a1a43e80dcffb171c06f5 *NEWS.md
-827207e34ddc13f19d92a08c159985ea *R/area_under_curve.R
-a20acab068281c522e713aba13986d94 *R/as.list.R
-1165acb15211cd10d3d3d7a9f1177839 *R/bayesfactor.R
-18b1df17d7e37efcd70fd5c55a53b274 *R/bayesfactor_inclusion.R
-44adbabfbe5326ce9637ee72102b35de *R/bayesfactor_models.R
-03713ab938b5ff85942621c0a79887f5 *R/bayesfactor_parameters.R
-8421957c824379234e5912f17c516601 *R/bayesfactor_restricted.R
-9613c9887924c1f64c7ed89acc0e36f8 *R/bci.R
+cdd2ca57df85efda104be9dd5277d572 *DESCRIPTION
+e75e5f6cb6630a7ca67d62d8b88b449a *NAMESPACE
+39405bfb8bacea08be8037081e86a2bf *NEWS.md
+74275e59c5c1c837176699338ec03bb7 *R/area_under_curve.R
+a990bddd4c54e18ca2bb3b5cf954cbee *R/as.list.R
+f429b938797329e425d9158e05d3a87f *R/bayesfactor.R
+e90d2a673c630e3e750d5a2483125042 *R/bayesfactor_inclusion.R
+9a3c2f07c22fb94238ae825d2f868208 *R/bayesfactor_models.R
+c26aae94506fc2e90456e2bd610d9e4c *R/bayesfactor_parameters.R
+eeded42a3866ac344e2bc9eedf0f8e22 *R/bayesfactor_restricted.R
+89fb8182fcba929c2bf1034641601fcc *R/bayestestR-package.R
+4097b0466b23e258c3575ad34304e565 *R/bci.R
e6642f324192341f4f5e92aa200feeff *R/bic_to_bf.R
-605aa1de75e8898cd34cca668708c5a7 *R/check_prior.R
-42e493dc895d4fbf1cf7d697bd4e07a5 *R/ci.R
+dd93d5c4dc8dd5c89e8f45fbcc46e534 *R/check_prior.R
+43794898e3dfbea61fad3d02fee5e056 *R/ci.R
9c1764245ab6f98e939b1c57a50bb448 *R/contr.equalprior.R
-2924fa3c7a219328b4986f47581c92ce *R/convert_bayesian_to_frequentist.R
+ab6f555ae19ed899fc2bbd531bac844e *R/convert_bayesian_to_frequentist.R
484605e2a29dd677c26b111cb17bb0a9 *R/convert_pd_to_p.R
-8ec1c32083bc62ddfdce097d3c9e6da5 *R/cwi.R
-1b24a227163026fbefe870a73a85f76d *R/describe_posterior.R
+190bd1fd94590a6066de0207c8d37908 *R/cwi.R
+e87daed2f8a248c6d092f14fc1b1ce6e *R/datasets.R
+85d07453d8ffbc1d1106e369863166f0 *R/describe_posterior.R
78ffdf36e861169b40af538e63aca891 *R/describe_prior.R
a9f1c79b25785cf642a498765c727816 *R/diagnostic_draws.R
-c42281dcd5de856d86b552ad72164e3d *R/diagnostic_posterior.R
-a071b66cc18bbf6e80d6b6a3442f51b6 *R/distribution.R
-a94f1384381fed74e197627e69c44e1d *R/effective_sample.R
-3256e7fdd5c90872406f30156c7509e1 *R/equivalence_test.R
-ed52e48ef425b43aeca3e45893b3dd55 *R/estimate_density.R
-206118b734132c66520f1daeeacf5036 *R/eti.R
-bba0d006cba11a8f2e40991fe7f16837 *R/format.R
-94bbd96126856f376535898724008725 *R/hdi.R
-9fbead1aad27e74129bbe1b6ea08a254 *R/map_estimate.R
+d67abcfd8153706d15a3e408143153d0 *R/diagnostic_posterior.R
+2ef8f63bb10102f5e1dd466c8c89e7a3 *R/distribution.R
+571f4b443b199c2ef6eda1c05a4c1ef2 *R/effective_sample.R
+e0d15f8ac3c54f095509ab7e499381b8 *R/equivalence_test.R
+7dcf53368a60159c77ff79d0b489e3b1 *R/estimate_density.R
+1d9812d85fbe9a392e793c89576e9eee *R/eti.R
+664066cab5b49256b7525927c87e1d50 *R/format.R
+e67f627e2824ea30295dad407c1c1c6e *R/hdi.R
+5d0b547938e3688e1f6f7a3e6058ea6d *R/map_estimate.R
465826ada4abdc5795c9d06d6aa37591 *R/mcse.R
-95901b275962acc1c2ceccac4ade5af5 *R/mediation.R
+880ecebac4006f1fa2f28881ec009e16 *R/mediation.R
9a86d42ec6cbdd8b9c27027ae8a28f39 *R/model_to_priors.R
a251b159734a21d5edd899113a9960c3 *R/overlap.R
-51570ad40b302fec82e9d8b31e80100b *R/p_direction.R
-ab6b766323f5ab8a5eecbd65e1b24b73 *R/p_map.R
-3ff637818301dd25593dd5ffdc0b1a16 *R/p_rope.R
-ef99a5781aca1303080b0dd5d6d9d774 *R/p_significance.R
-3b7083a576622af0bebd073ba8e97434 *R/p_to_bf.R
+543d72b748fe695502d65234a8d1e074 *R/p_direction.R
+a8706d57a6e94323106190f3ee2a8845 *R/p_map.R
+89b544f41b9ae4123c59feedd3a11ef1 *R/p_rope.R
+d6998111b57af29195112e2a30552643 *R/p_significance.R
+4250600edafe86595e4253dcc5ce4a46 *R/p_to_bf.R
b515a37ad3c623deaef79be35b798307 *R/plot.R
-64bb25b12e14ddc3baac31f87e87de92 *R/point_estimate.R
-954fa07a3f90b158f85db9eb4d7ee989 *R/print.R
+f3c2ccb25ca711d874370d6ac65cce63 *R/point_estimate.R
+6c9b98c2075fc37630eeadb8ffffa34c *R/print.R
c6a9e68d8b3f9e11db67c87e99211e62 *R/print.bayesfactor_models.R
-017c8afd559b5f658b0cec65fad3d8c3 *R/print.equivalence_test.R
+62e897a55c3acdb0a06a0fa42a687f85 *R/print.equivalence_test.R
1bcea270139b446e8e6acdf3c781c219 *R/print.rope.R
773ee78fc044e415b0d3f56db549b22e *R/print_html.R
af3ddc3bc4c1fcc7d67fb1bffab708ca *R/print_md.R
-c3424c1dccab80a289d35bb820b3dbc0 *R/reexports.R
-a58e90879c266841cfe925e3650652ac *R/reshape_iterations.R
-80738ff7dd0717986dbd032ba4ba05d3 *R/rope.R
-cc4dd589041f0287eaf778486aab881c *R/rope_range.R
-e6393aa1c56dcfe705924454633d2b96 *R/sensitivity_to_prior.R
-960e1fb173ffa98cec09359e57054e9d *R/sexit.R
-4beb62b5c245d438fa0f30d09703599f *R/sexit_thresholds.R
-b97067702b79cbcfd5891fe7921e547b *R/si.R
-c401a802d1e73d16d0e4566a702efd86 *R/simulate_data.R
+b8b3d0de18279d44e61852508d7422a5 *R/reshape_iterations.R
+14ab03188f789964e7f186542d7bf6f1 *R/rope.R
+372b2d3fdb701affe2f3bac6c200102c *R/rope_range.R
+41fbb3dad470aac239d18252302fda81 *R/sensitivity_to_prior.R
+b20902c86297850b0426cd9b45e0d85d *R/sexit.R
+befcbb125cc1cedc5a82d6ecddefef29 *R/sexit_thresholds.R
+71304c9c714c78efe0a41c52578230d5 *R/si.R
+2532e684356d2719bfe4817fc7879de9 *R/simulate_data.R
4f10f48b426bd5febe937eeae20409df *R/simulate_priors.R
0875623348cf213c96288b0dc30f1169 *R/simulate_simpson.R
-ed9cb1f0909c9604dfd668809a74b8e9 *R/spi.R
-0297628f93a2e52dde1330571d4797ef *R/unupdate.R
-bfb658697e240cd1b1b93a67ca910e65 *R/utils.R
-f2696b6c11547533d90fb2fcdcf5356b *R/utils_bayesfactor.R
-a350deadbaacdb065ecc3529de2f3cc5 *R/utils_check_collinearity.R
+dd2e13015f0f12826aef8c4e93871f77 *R/spi.R
+72efe3d4fea6af74a37fd9df828d1abf *R/unupdate.R
+73aadb2df73a26b40d1c47e7d580cd80 *R/utils.R
+16820c7eccda75f7c402a8b0fec9e620 *R/utils_bayesfactor.R
+56f499e43c31efa43f6cd64af1c9428e *R/utils_check_collinearity.R
8117073ed9981ca4f4cc32780cbeffaf *R/utils_clean_stan_parameters.R
ae06d66ba5784ec2553860c6f78b23f3 *R/utils_hdi_ci.R
-0a5b0c6d2d9c09a637b5e18939ec492c *R/utils_posterior.R
-53df25ca89611a8c046e4e1ea3e9f563 *R/utils_print_data_frame.R
-a4784db9a2efd61c6dccbfe0834f39ff *R/weighted_posteriors.R
+506839f138e42454411368529c153561 *R/utils_posterior.R
+4dcb76b763881abb1d43c993fd21e853 *R/utils_print_data_frame.R
+2360db4a482586982ce758ddd79350a9 *R/weighted_posteriors.R
4533f523d6cb92676f1d7912e088e29b *R/zzz.R
-8f4840b8dc8590313dac389391bc9d0a *README.md
+10d213f413399e9044449a376a85cff3 *README.md
9ecb0bdfb906213cc54af05f9a8fb645 *build/partial.rdb
3d4560ff6c352ca940a5b131221b19d5 *build/vignette.rds
+0ff3ea913147c5a1b14eb94d50333b98 *data/disgust.rdata
c5cfd3e44877e6f8487a7d57c28dd0e2 *inst/CITATION
-68769b38b8e629f3dc47c7b8c019e02d *inst/WORDLIST
+4bbd263b71091999fc97ff01b90d8953 *inst/WORDLIST
7342a6d63f4cc4501afc55be1d148740 *inst/doc/overview_of_vignettes.R
d3047f8dd544e4791a13e4ede781199f *inst/doc/overview_of_vignettes.Rmd
-faa18d5b2d371b984446f149fd8a50bd *inst/doc/overview_of_vignettes.html
-a49a7cf3326d79449a1ec118d1fb9a4a *man/area_under_curve.Rd
+0fc7c30724becb44d7363bfce3a337ad *inst/doc/overview_of_vignettes.html
+261ba655620dfbd3001fa10238ff6d0e *man/area_under_curve.Rd
6860290cbdd452ec9f23f98ddf68fb99 *man/as.data.frame.density.Rd
3d348eff3f4bc590080a8cd696304d75 *man/as.numeric.p_direction.Rd
-25cc4b9c2411b102e5842c5e3761b43b *man/bayesfactor.Rd
-26e4671eec670e32553eb861908584b6 *man/bayesfactor_inclusion.Rd
-d9905cd4b60a587887c171c27c1e25f8 *man/bayesfactor_models.Rd
-65c390fe146b83aa6312ec0f24568127 *man/bayesfactor_parameters.Rd
-bd4e260dfc103c1911942243f7400b39 *man/bayesfactor_restricted.Rd
-4f53ccefcd1c44e8e66be2d306faa51c *man/bci.Rd
+2e24dbda10116e16afc3a1ecead0b8e2 *man/bayesfactor.Rd
+2d81bdec563ff4acafb83320d6a9cb38 *man/bayesfactor_inclusion.Rd
+d8dbf200c78d71f5de4289f06b54c360 *man/bayesfactor_models.Rd
+abc9686aa1a971f24983f387fddf788f *man/bayesfactor_parameters.Rd
+dc90c03f81239afd7b7ffff2fae8f30e *man/bayesfactor_restricted.Rd
+5999335209addda65e250db62b1c9977 *man/bayestestR-package.Rd
+0eb780fa472f146ca0ca5bc9fa213083 *man/bci.Rd
4de97402297ddaeced4bfabbcf8b8bde *man/bic_to_bf.Rd
-e10b03cfaa4dcd01a367f4d6fa7e5040 *man/check_prior.Rd
-dc14bd5d9c69d92e5489164878405cf7 *man/ci.Rd
+bff15644ddd81feb334a57077e4cd198 *man/check_prior.Rd
+e4877485ea3d636dbad45b4ce8b89f6e *man/ci.Rd
ade20e470426dcac15633c0337c8aea4 *man/contr.equalprior.Rd
fed834ae2ef12615ebacfd5beddcf38f *man/convert_bayesian_as_frequentist.Rd
-87b9050350afcd308f23d7b03aaaac3a *man/cwi.Rd
+a6824e6d983b84d1d9fc49e5d63313aa *man/cwi.Rd
5b355471ecc29db1dffae4d85d9ed028 *man/density_at.Rd
-200b725a3579a35aefbec3b41c76e4c5 *man/describe_posterior.Rd
+2d438465347f656376eaf4626f38cf2c *man/describe_posterior.Rd
018067e4f1b532b2ee2a768f86584094 *man/describe_prior.Rd
a9a25f4350af2047cf57930479d893a4 *man/diagnostic_draws.Rd
885f2c862d11bd5cd1eb13d7a2fe16e2 *man/diagnostic_posterior.Rd
+933a334f0afcb213569e4ad5d3446e6e *man/disgust.Rd
96a78333a48f5f062fc36ef2466fb1ad *man/distribution.Rd
0b1d93b59d19425ddb3a0d40f38210c1 *man/dot-extract_priors_rstanarm.Rd
e450b5ed09ce1a54bb53cf57a436a1a5 *man/dot-prior_new_location.Rd
1991efd66189082be157e0b5d706e148 *man/dot-select_nums.Rd
f020fd509e11115a6119b46fa1a20b2e *man/effective_sample.Rd
-57913d713c05243aebf23c9d27681ebd *man/equivalence_test.Rd
-81b87d6c99c5d8c33b2935eddb1d6bdb *man/estimate_density.Rd
-dcff31c919d883941fac3e51e46ffff3 *man/eti.Rd
+4faf6b48584e5a87d84dbfef187e1dad *man/equivalence_test.Rd
+7fc47c7b4568f6197c0cc02783174fe1 *man/estimate_density.Rd
+83ee2ff5b9b25790bfdf3b48e6809ef1 *man/eti.Rd
27e0ea3ff40617aff2e5f74afd47970c *man/figures/logo.png
3fb0a39e4eef303730e5b3bcdb40fb38 *man/figures/unnamed-chunk-10-1.png
46f4dafb23fab7cd9274b70c818401c4 *man/figures/unnamed-chunk-12-1.png
@@ -110,67 +114,67 @@ dcff31c919d883941fac3e51e46ffff3 *man/eti.Rd
bf3bb55ba72a848986fe903c7b637a6c *man/figures/unnamed-chunk-16-1.png
9a8d21fb1aa6841c21ae79ef83baa5ad *man/figures/unnamed-chunk-7-1.png
31b53d9f4b67e667cad8655407337d6c *man/figures/unnamed-chunk-8-1.png
-2818dbe270cfb3eb0ca115b3456c54d6 *man/hdi.Rd
+e25a9ed0ec13a983ff0eac78f97cd02e *man/hdi.Rd
5cd187b5b3b9877af4880a8e84594bf4 *man/map_estimate.Rd
0a0ca29c4aef471865268c4f1566272c *man/mcse.Rd
-3ac95688502d559dbc9db833628d79e9 *man/mediation.Rd
+70cd79bea11c69edceb009cc03db7900 *man/mediation.Rd
79d15a5bdc95a3d9861f7d70c438ac01 *man/model_to_priors.Rd
4d4617709255a7b19da590a89c0ededc *man/overlap.Rd
033f20dbbd8adb19298afaa149dd0847 *man/p_direction.Rd
-958b4f3b1a5afd6128525910db4566db *man/p_map.Rd
+77c19e4f5e3b80bb14489e37e586b527 *man/p_map.Rd
e26c22167b16a733fdf5c8faa0ffa8f1 *man/p_rope.Rd
2f08e6b152dc939400e6f1a97fe82777 *man/p_significance.Rd
e49f3d556075a5d1a48911d91cd4647e *man/p_to_bf.Rd
cfd901e16ebdfb40af423676f40b673f *man/pd_to_p.Rd
bedb9a9cd613de1b3e9fcd9e0dd10a5c *man/point_estimate.Rd
-c5e00860cbc69810f44890e13a46446d *man/reexports.Rd
+efdfd4e3b26b1ea4f4d9f4e88387de8b *man/reexports.Rd
f9baf506f3a47e5e259a7417091cbce2 *man/reshape_iterations.Rd
-21789efec36a923834cf3d751a5781b9 *man/rope.Rd
+71e876fa03ffa7c4a3d507a744f79289 *man/rope.Rd
3f7c7bfdeb2eba84be8919d65893ac59 *man/rope_range.Rd
-45add6308bb50726c209426cdb99fb59 *man/sensitivity_to_prior.Rd
+a841aa6574807cce644795652f342a8b *man/sensitivity_to_prior.Rd
aed3c961fdac62a01ad6425feb17f366 *man/sexit.Rd
-db38df89481f05fa59cad9277a8db2d1 *man/sexit_thresholds.Rd
-61a0611087a12a1dd9d88483b68938b8 *man/si.Rd
+206d7ffb87a03099009d1f9735a6b6d7 *man/sexit_thresholds.Rd
+1d3a038155665c82dc5b39968a436f42 *man/si.Rd
ec179c4a0325de79faf13744d5cb3737 *man/simulate_correlation.Rd
d33c6ef25efb00a4bfcadb86921db72b *man/simulate_prior.Rd
75edf873b80d3ad0c322a0b3ac1071b3 *man/simulate_simpson.Rd
-c060e74a28beff6991c9a3f580bdfa25 *man/spi.Rd
+38aa4810dc6ec7aafba8623ad6303174 *man/spi.Rd
b9581b70c34ef137c49531d8c8ba4072 *man/unupdate.Rd
-7cf302299eb784896229a7569db3f878 *man/weighted_posteriors.Rd
-163821bedd02b4663965364cae72b2a2 *tests/testthat.R
-fc5341978a702848d38b368a6dd499aa *tests/testthat/helper-requiet.R
-8b08b3d41d7664aeea39ca2d15d7ebf5 *tests/testthat/test-BFBayesFactor.R
+e9deca84ad542a13ff75061321335b3d *man/weighted_posteriors.Rd
+ed019fb28c42d301a471042302b2215d *tests/testthat.R
+0e84b6d82ae0c55225f7b5606bc6ab10 *tests/testthat/helper.R
+8e5d275d30f7822b9b4dba93527fddf0 *tests/testthat/test-BFBayesFactor.R
a9cbb2928bdc3e39c85d40383e12f538 *tests/testthat/test-as.data.frame.density.R
-4f2c6813e6771fe9cb83e76f1c831df4 *tests/testthat/test-bayesfactor_models.R
-d96cf5b6d26b9f5b2838b3c8d251ef95 *tests/testthat/test-bayesfactor_parameters.R
-c5d3b5a0a9e6bf83b8441c9e7e7f3173 *tests/testthat/test-bayesfactor_restricted.R
-bb71fc584b9a4b619e97a70a31164ad9 *tests/testthat/test-blavaan.R
-aa22eac4ef5c5d1d7503646d872fc125 *tests/testthat/test-brms.R
-c80dd7b81922607b038d03caeaaa2d3a *tests/testthat/test-check_prior.R
-b4661a39d3faab88f932abc5c8d8cbca *tests/testthat/test-ci.R
-8677708f17877479e5cdd4209b50f430 *tests/testthat/test-contr.R
+0ce57d0c043ff51435557123abb362bd *tests/testthat/test-bayesfactor_models.R
+5ba6507c40b75ed100d97ddb538b5ab9 *tests/testthat/test-bayesfactor_parameters.R
+077031f36901d45428f91e05c024e261 *tests/testthat/test-bayesfactor_restricted.R
+7345d07695ed2353ac64b8efe014fbfc *tests/testthat/test-blavaan.R
+d124fead927d100d76f6f815e6193501 *tests/testthat/test-brms.R
+e99c0277fe2ca999dc4195389192dd1e *tests/testthat/test-check_prior.R
+0e5731199bd70abf3959a4b5fa905c5c *tests/testthat/test-ci.R
+43dfdbc876dff66ea3914899c32f73c0 *tests/testthat/test-contr.R
8cfbb3b3a84cc76ad6fac4e191b705a7 *tests/testthat/test-density_at.R
-df35d921374423534efae5a9a11daec8 *tests/testthat/test-describe_posterior.R
-d8f9ff21305e68ef637842ae5d7ac283 *tests/testthat/test-describe_prior.R
-b8d8ecafceac80441d943e0976ff373a *tests/testthat/test-different_models.R
-5f5d3b1678e10a074b3a70da55d16f0f *tests/testthat/test-distributions.R
-160fad80c65211829f5a673c1927af0a *tests/testthat/test-effective_sample.R
-0ba13788632873bfbd2fdb27f118d389 *tests/testthat/test-emmGrid.R
-d486a9d7b5f5b045521e77c61cb6df81 *tests/testthat/test-estimate_density.R
-2fab490acef20295a1e50cad2a72b972 *tests/testthat/test-hdi.R
-0af85c686368e25c0ac4b9e089990d5e *tests/testthat/test-map_estimate.R
+e6219c5bd24b161520b4a21e2ad449db *tests/testthat/test-describe_posterior.R
+19319920df0458f035e195fc9802942a *tests/testthat/test-describe_prior.R
+1b93414763a19e2e4d1c07d04240c799 *tests/testthat/test-different_models.R
+ed8c019fa0e88ef258102036899bf543 *tests/testthat/test-distributions.R
+155ca1bd378bdb782f3898979d552875 *tests/testthat/test-effective_sample.R
+c682caf6c03880c4d4029de189650a46 *tests/testthat/test-emmGrid.R
+2eaab582f44a50403a11d11b55d10861 *tests/testthat/test-estimate_density.R
+f406e8002aa06d116f0bc9ea77e434cf *tests/testthat/test-hdi.R
+2e79d5272e245b453e4fcebbafad7f46 *tests/testthat/test-map_estimate.R
0b7105cb674357eb204fe98458f38678 *tests/testthat/test-overlap.R
-b41c0d97dc314878d5401f0a9cf087da *tests/testthat/test-p_direction.R
-2bc30e839a848ae34cd3b064f0946676 *tests/testthat/test-p_map.R
-6ac862072880e8ac2a73ddbf2bec1244 *tests/testthat/test-p_significance.R
-fef2584d64c480d21e757af8ff60d9d2 *tests/testthat/test-p_to_bf.R
-cf41b788edeac336d8d9aed00fea5710 *tests/testthat/test-point_estimate.R
-be62c8a66d74b06df1cb2de1fafa2d27 *tests/testthat/test-posterior.R
-758a31ddae6fefc2e323c83477eca210 *tests/testthat/test-rope.R
-8b2e174d60a1da3d6a73b3c3c4a90191 *tests/testthat/test-rope_range.R
-ec15f8ce0f1278b424e2f7c9027dd47d *tests/testthat/test-rstanarm.R
-cab1e533afe2cb5b4a6e22aa5b026df1 *tests/testthat/test-si.R
+706cbaf4b28e9c3a04f08329c08a4151 *tests/testthat/test-p_direction.R
+89cd288de6ecd6a2b5f51d0af27ab1bf *tests/testthat/test-p_map.R
+ddae26ecb8cb46091df46a92a8f74edb *tests/testthat/test-p_significance.R
+339b310dff63000e06b2f5a03836fb71 *tests/testthat/test-p_to_bf.R
+a7f7028b1ceb5fa0047c559317f4ed1b *tests/testthat/test-point_estimate.R
+f121cb3927a29cf5fc358b1c3b745434 *tests/testthat/test-posterior.R
+7ddd7bb4693fde2c73752021e57e0cc6 *tests/testthat/test-rope.R
+f794f6330023e5da7bd7a6db16388c81 *tests/testthat/test-rope_range.R
+0296c69cae7ecd48df7a6962d04f758d *tests/testthat/test-rstanarm.R
+12996c266989a21a0d94bd57f249cf8a *tests/testthat/test-si.R
aef26eaae2ee208af837cd7840f33c60 *tests/testthat/test-simulate_data.R
-edc6fdd3d2d4cfb4ae21bc88e786f334 *tests/testthat/test-spi.R
-39c28c8d7e147cf7bfbd1d1e66ab96d6 *tests/testthat/test-weighted_posteriors.R
+755dca6c1088356016fc2907229f6410 *tests/testthat/test-spi.R
+a4c5ad432858a87b6c4759469cb304c4 *tests/testthat/test-weighted_posteriors.R
d3047f8dd544e4791a13e4ede781199f *vignettes/overview_of_vignettes.Rmd
diff --git a/NAMESPACE b/NAMESPACE
index 62389ce..a864f02 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -16,6 +16,7 @@ S3method(as.list,bayestestR_ci)
S3method(as.list,bayestestR_eti)
S3method(as.list,bayestestR_hdi)
S3method(as.list,bayestestR_si)
+S3method(as.logical,bayesfactor_restricted)
S3method(as.matrix,bayesfactor_models)
S3method(as.numeric,bayesfactor_inclusion)
S3method(as.numeric,bayesfactor_models)
@@ -473,6 +474,7 @@ S3method(rope,sim)
S3method(rope,sim.merMod)
S3method(rope,stanfit)
S3method(rope,stanreg)
+S3method(rope_range,data.frame)
S3method(rope_range,default)
S3method(rope_range,mlm)
S3method(sensitivity_to_prior,stanreg)
@@ -620,7 +622,6 @@ export(pd_to_p)
export(point_estimate)
export(print_html)
export(print_md)
-export(reshape_ci)
export(reshape_draws)
export(reshape_iterations)
export(rnorm_perfect)
@@ -638,6 +639,5 @@ export(simulate_ttest)
export(spi)
export(unupdate)
export(weighted_posteriors)
-importFrom(datawizard,reshape_ci)
importFrom(insight,print_html)
importFrom(insight,print_md)
diff --git a/NEWS.md b/NEWS.md
index ceefb87..4900b43 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,28 @@
-# bayestestR 0.12.x
+# bayestestR 0.13.1
+
+## Changes
+
+* Improved speed performance when functions are called using `do.call()`.
+
+* Improved speed performance to `bayesfactor_models()` for `brmsfit` objects
+ that already included a `marglik` element in the model object.
+
+## New functionality
+
+* `as.logical()` for `bayesfactor_restricted()` results, extracts the boolean
+ vector(s) the mark which draws are part of the order restriction.
+
+## Bug fixes
+
+* `p_map()` gains a new `null` argument to specify any non-0 nulls.
+
+* Fixed non-working examples for `ci(method = "SI")`.
+
+* Fixed wrong calculation of rope range for model objects in `describe_posterior()`.
+
+* Some smaller bug fixes.
+
+# bayestestR 0.13.0
## Breaking
@@ -514,7 +538,7 @@
- `hdi()` returned multiple class attributes (#72)
- Printing results from `hdi()` failed when `ci`-argument had fractional parts
- for percentage values (e.g. `ci = .995`).
+ for percentage values (e.g. `ci = 0.995`).
- `plot.equivalence_test()` did not work properly for *brms*-models (#76).
diff --git a/R/area_under_curve.R b/R/area_under_curve.R
index cec1475..f9fd039 100644
--- a/R/area_under_curve.R
+++ b/R/area_under_curve.R
@@ -1,10 +1,18 @@
#' Area under the Curve (AUC)
#'
-#' Based on the DescTools `AUC` function. It can calculate the area under the curve with a naive algorithm or a more elaborated spline approach. The curve must be given by vectors of xy-coordinates. This function can handle unsorted x values (by sorting x) and ties for the x values (by ignoring duplicates).
+#' Based on the DescTools `AUC` function. It can calculate the area under the
+#' curve with a naive algorithm or a more elaborated spline approach. The curve
+#' must be given by vectors of xy-coordinates. This function can handle unsorted
+#' x values (by sorting x) and ties for the x values (by ignoring duplicates).
#'
#' @param x Vector of x values.
#' @param y Vector of y values.
-#' @param method Method to compute the Area Under the Curve (AUC). Can be `"trapezoid"` (default), `"step"` or `"spline"`. If "trapezoid", the curve is formed by connecting all points by a direct line (composite trapezoid rule). If "step" is chosen then a stepwise connection of two points is used. For calculating the area under a spline interpolation the splinefun function is used in combination with integrate.
+#' @param method Method to compute the Area Under the Curve (AUC). Can be
+#' `"trapezoid"` (default), `"step"` or `"spline"`. If "trapezoid", the curve
+#' is formed by connecting all points by a direct line (composite trapezoid
+#' rule). If "step" is chosen then a stepwise connection of two points is
+#' used. For calculating the area under a spline interpolation the splinefun
+#' function is used in combination with integrate.
#' @param ... Arguments passed to or from other methods.
#'
#'
@@ -26,7 +34,7 @@ area_under_curve <- function(x, y, method = c("trapezoid", "step", "spline"), ..
# Stolen from DescTools: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r
if (length(x) != length(y)) {
- stop("Length of x must be equal to length of y.", call. = FALSE)
+ insight::format_error("Length of x must be equal to length of y.")
}
idx <- order(x)
diff --git a/R/as.list.R b/R/as.list.R
index eba6765..5a15507 100644
--- a/R/as.list.R
+++ b/R/as.list.R
@@ -1,4 +1,3 @@
-
# as.list -----------------------------------------------------------------
#' @export
diff --git a/R/bayesfactor.R b/R/bayesfactor.R
index 2772342..048f265 100644
--- a/R/bayesfactor.R
+++ b/R/bayesfactor.R
@@ -28,14 +28,14 @@
#' prior <- distribution_normal(1000, mean = 0, sd = 1)
#' posterior <- distribution_normal(1000, mean = .5, sd = .3)
#'
-#' bayesfactor(posterior, prior = prior)
+#' bayesfactor(posterior, prior = prior, verbose = FALSE)
#' }
#' \dontrun{
#' # rstanarm models
#' # ---------------
#' if (require("rstanarm")) {
#' model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
-#' bayesfactor(model)
+#' bayesfactor(model, verbose = FALSE)
#' }
#' }
#'
diff --git a/R/bayesfactor_inclusion.R b/R/bayesfactor_inclusion.R
index b12a32a..363a5bd 100644
--- a/R/bayesfactor_inclusion.R
+++ b/R/bayesfactor_inclusion.R
@@ -64,13 +64,17 @@
#' # compare only matched models:
#' bayesfactor_inclusion(BF, match_models = TRUE)
#' }
+#'
#' @references
-#' \itemize{
-#' \item Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25). A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64}
-#' \item Clyde, M. A., Ghosh, J., & Littman, M. L. (2011). Bayesian adaptive sampling for variable selection and model averaging. Journal of Computational and Graphical Statistics, 20(1), 80-101.
-#' \item Mathot, S. (2017). Bayes like a Baws: Interpreting Bayesian Repeated Measures in JASP [Blog post](https://www.cogsci.nl/blog/interpreting-bayesian-repeated-measures-in-jasp).
-#' }
+#' - Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25).
+#' A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64}
+#'
+#' - Clyde, M. A., Ghosh, J., & Littman, M. L. (2011). Bayesian adaptive sampling
+#' for variable selection and model averaging. Journal of Computational and Graphical Statistics,
+#' 20(1), 80-101.
#'
+#' - Mathot, S. (2017). Bayes like a Baws: Interpreting Bayesian Repeated Measures in JASP.
+#' [Blog post](https://www.cogsci.nl/blog/interpreting-bayesian-repeated-measures-in-jasp).
#'
#' @export
bayesfactor_inclusion <- function(models,
@@ -90,7 +94,9 @@ bayesfactor_inclusion.bayesfactor_models <- function(models,
prior_odds = NULL,
...) {
if (isTRUE(attr(models, "unsupported_models"))) {
- stop("Can not compute inclusion Bayes factors - passed models are not (yet) supported.", call. = FALSE)
+ insight::format_error(
+ "Can not compute inclusion Bayes factors - passed models are not (yet) supported."
+ )
}
# Build Models Table #
@@ -99,12 +105,12 @@ bayesfactor_inclusion.bayesfactor_models <- function(models,
# Build Interaction Matrix #
if (isTRUE(match_models)) {
- effects.matrix <- as.matrix(df.model[, -c(1:3)])
+ effects.matrix <- as.matrix(df.model[, -(1:3)])
df.interaction <- data.frame(effnames, stringsAsFactors = FALSE)
for (eff in effnames) {
- df.interaction[, eff] <- sapply(effnames, function(x) .includes_interaction(x, eff))
+ df.interaction[, eff] <- sapply(effnames, .includes_interaction, effnames = eff)
}
rownames(df.interaction) <- effnames
df.interaction <- as.matrix(df.interaction[, -1])
@@ -179,10 +185,10 @@ bayesfactor_inclusion.BFBayesFactor <- function(models,
#' @keywords internal
.includes_interaction <- function(eff, effnames) {
- eff_b <- strsplit(eff, "\\:")
- effnames_b <- strsplit(effnames, "\\:")
+ eff_b <- strsplit(eff, ":", fixed = TRUE)
+ effnames_b <- strsplit(effnames, ":", fixed = TRUE)
- is_int <- sapply(effnames_b, function(x) length(x) > 1)
+ is_int <- vapply(effnames_b, function(x) length(x) > 1, TRUE)
temp <- logical(length(effnames))
diff --git a/R/bayesfactor_models.R b/R/bayesfactor_models.R
index 63db0f9..11b6ba8 100644
--- a/R/bayesfactor_models.R
+++ b/R/bayesfactor_models.R
@@ -22,7 +22,8 @@
#' model.
#' @inheritParams hdi
#'
-#' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
+#' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html)
+#' implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
#'
#' @details
#' If the passed models are supported by \pkg{insight} the DV of all models will be tested for equality
@@ -33,7 +34,9 @@
#' - `brmsfit` models must have been fitted with `save_pars = save_pars(all = TRUE)`.
#' - `stanreg` models must have been fitted with a defined `diagnostic_file`.
#' - For `BFBayesFactor`, `bayesfactor_models()` is mostly a wraparound `BayesFactor::extractBF()`.
-#' - For all other model types, Bayes factors are computed using the BIC approximation. Note that BICs are extracted from using [insight::get_loglikelihood], see documentation there for options for dealing with transformed responses and REML estimation.
+#' - For all other model types, Bayes factors are computed using the BIC approximation.
+#' Note that BICs are extracted from using [insight::get_loglikelihood], see documentation
+#' there for options for dealing with transformed responses and REML estimation.
#'
#' In order to correctly and precisely estimate Bayes factors, a rule of thumb
#' are the 4 P's: **P**roper **P**riors and **P**lentiful
@@ -107,7 +110,7 @@
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df2.csv")
#' )
-#' bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0)
+#' bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE)
#' }
#'
#'
@@ -115,15 +118,15 @@
#' # --------------------
#' # (note the save_pars MUST be set to save_pars(all = TRUE) in order to work)
#' if (require("brms")) {
-#' brm1 <- brm(Sepal.Length ~ 1, data = iris, save_all_pars = TRUE)
-#' brm2 <- brm(Sepal.Length ~ Species, data = iris, save_all_pars = TRUE)
+#' brm1 <- brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE))
+#' brm2 <- brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE))
#' brm3 <- brm(
#' Sepal.Length ~ Species + Petal.Length,
#' data = iris,
#' save_pars = save_pars(all = TRUE)
#' )
#'
-#' bayesfactor_models(brm1, brm2, brm3, denominator = 1)
+#' bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE)
#' }
#'
#'
@@ -139,14 +142,24 @@
#' bayesfactor_models(BF) # basically the same
#' }
#' }
+#'
#' @references
-#' \itemize{
-#' \item Gronau, Q. F., Singmann, H., & Wagenmakers, E. J. (2017). Bridgesampling: An R package for estimating normalizing constants. arXiv preprint arXiv:1710.08162.
-#' \item Kass, R. E., and Raftery, A. E. (1995). Bayes Factors. Journal of the American Statistical Association, 90(430), 773-795.
-#' \item Robert, C. P. (2016). The expected demise of the Bayes factor. Journal of Mathematical Psychology, 72, 33–37.
-#' \item Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values. Psychonomic bulletin & review, 14(5), 779-804.
-#' \item Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011). Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests. Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923}
-#' }
+#' - Gronau, Q. F., Singmann, H., & Wagenmakers, E. J. (2017). Bridgesampling: An R package for estimating
+#' normalizing constants. arXiv preprint arXiv:1710.08162.
+#'
+#' - Kass, R. E., and Raftery, A. E. (1995). Bayes Factors. Journal of the American Statistical Association,
+#' 90(430), 773-795.
+#'
+#' - Robert, C. P. (2016). The expected demise of the Bayes factor. Journal of Mathematical Psychology,
+#' 72, 33–37.
+#'
+#' - Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values.
+#' Psychonomic bulletin & review, 14(5), 779-804.
+#'
+#' - Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011).
+#' Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests.
+#' Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923}
+#'
#' @export
bayesfactor_models <- function(..., denominator = 1, verbose = TRUE) {
UseMethod("bayesfactor_models")
@@ -181,7 +194,7 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
# Get formula / model names
# supported models
- supported_models <- sapply(mods, insight::is_model_supported)
+ supported_models <- vapply(mods, insight::is_model_supported, TRUE)
if (all(supported_models)) {
temp_forms <- sapply(mods, .find_full_formula)
@@ -198,34 +211,25 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
were_checked <- inherits(objects, "ListModels")
# Validate response
- if (were_checked && verbose &&
- !isTRUE(attr(objects, "same_response"))) {
- warning(
- insight::format_message(
- "When comparing models, please note that probably not all models were fit from same data."
- ),
- call. = FALSE
+ if (were_checked && verbose && !isTRUE(attr(objects, "same_response"))) {
+ insight::format_warning(
+ "When comparing models, please note that probably not all models were fit from same data."
)
}
# Get BIC
if (were_checked && estimator == "REML" &&
- any(sapply(mods, insight::is_mixed_model)) &&
- !isTRUE(attr(objects, "same_fixef"))) {
- # estimator <- "ML"
- if (verbose) {
- warning(
- insight::format_message(
- "Information criteria (like BIC) based on REML fits (i.e. `estimator=\"REML\"`)",
- "are not recommended for comparison between models with different fixed effects.",
- "Concider setting `estimator=\"ML\"`."
- ),
- call. = FALSE
- )
- }
+ any(vapply(mods, insight::is_mixed_model, TRUE)) &&
+ !isTRUE(attr(objects, "same_fixef")) &&
+ verbose) {
+ insight::format_warning(
+ "Information criteria (like BIC) based on REML fits (i.e. `estimator=\"REML\"`)",
+ "are not recommended for comparison between models with different fixed effects.",
+ "Concider setting `estimator=\"ML\"`."
+ )
}
} else if (verbose) {
- message("Unable to validate that all models were fit with the same data.")
+ insight::format_alert("Unable to validate that all models were fit with the same data.")
}
mBIC <- tryCatch(sapply(mods, function(m) {
@@ -263,11 +267,10 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
if (is.null(alg$iterations)) alg$iterations <- alg$sample
(alg$iterations - alg$warmup) * alg$chains
})
- if (any(n_samps < 4e4)) {
- warning(
- "Bayes factors might not be precise.\n",
- "For precise Bayes factors, sampling at least 40,000 posterior samples is recommended.",
- call. = FALSE, immediate. = TRUE
+ if (any(n_samps < 4e4) && verbose) {
+ insight::format_warning(
+ "Bayes factors might not be precise.",
+ "For precise Bayes factors, sampling at least 40,000 posterior samples is recommended."
)
}
@@ -300,17 +303,10 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
)
if (!all(from_same_data_as_den)) {
- stop("Models were not computed from the same data.", call. = FALSE)
- }
-
- # Get BF
- if (verbose) {
- message("Computation of Bayes factors: estimating marginal likelihood, please wait...")
+ insight::format_error("Models were not computed from the same data.")
}
- mML <- lapply(mods, function(x) {
- bridgesampling::bridge_sampler(x, silent = TRUE)
- })
+ mML <- lapply(mods, .get_marglik, verbose = verbose)
mBFs <- sapply(mML, function(x) {
bf <- bridgesampling::bf(x, mML[[denominator]], log = TRUE)
@@ -329,11 +325,11 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
.bayesfactor_models_stan_SEM <- function(mods, denominator, verbose = TRUE) {
utils::capture.output(
- suppressWarnings(
+ suppressWarnings({
mBFs <- sapply(mods, function(m) {
blavaan::blavCompare(m, mods[[denominator]])[["bf"]][1]
})
- )
+ })
)
res <- data.frame(
@@ -380,7 +376,6 @@ bayesfactor_models.brmsfit <- function(..., denominator = 1, verbose = TRUE) {
.bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose)
}
-
#' @export
bayesfactor_models.blavaan <- function(..., denominator = 1, verbose = TRUE) {
insight::check_if_installed("blavaan")
@@ -408,7 +403,7 @@ bayesfactor_models.BFBayesFactor <- function(..., verbose = TRUE) {
mBFs <- c(0, BayesFactor::extractBF(models, TRUE, TRUE))
mforms <- sapply(c(models@denominator, models@numerator), function(x) x@shortName)
- if (!"BFlinearModel" %in% class(models@denominator)) {
+ if (!inherits(models@denominator, "BFlinearModel")) {
mforms <- .clean_non_linBF_mods(mforms)
} else {
mforms[mforms == "Intercept only"] <- "1"
@@ -423,7 +418,7 @@ bayesfactor_models.BFBayesFactor <- function(..., verbose = TRUE) {
.bf_models_output(res,
denominator = 1,
bf_method = "JZS (BayesFactor)",
- unsupported_models = !"BFlinearModel" %in% class(models@denominator)
+ unsupported_models = !inherits(models@denominator, "BFlinearModel")
)
}
@@ -513,7 +508,11 @@ as.matrix.bayesfactor_models <- function(x, ...) {
#' @keywords internal
-.bf_models_output <- function(res, denominator = 1, bf_method = "method", unsupported_models = FALSE, model_names = NULL) {
+.bf_models_output <- function(res,
+ denominator = 1,
+ bf_method = "method",
+ unsupported_models = FALSE,
+ model_names = NULL) {
attr(res, "denominator") <- denominator
attr(res, "BF_method") <- bf_method
attr(res, "unsupported_models") <- unsupported_models
@@ -551,12 +550,12 @@ as.matrix.bayesfactor_models <- function(x, ...) {
m_txt <- character(length = length(m_names))
## Detect types ##
- is_null <- grepl("^Null", m_names)
- is_rho <- grepl("rho", m_names)
- is_mu <- grepl("mu", m_names)
- is_d <- grepl("d", m_names)
- is_p <- grepl("p", m_names)
- is_range <- grepl("<", m_names)
+ is_null <- startsWith(m_names, "Null")
+ is_rho <- grepl("rho", m_names, fixed = TRUE)
+ is_mu <- grepl("mu", m_names, fixed = TRUE)
+ is_d <- grepl("d", m_names, fixed = TRUE)
+ is_p <- grepl("p", m_names, fixed = TRUE)
+ is_range <- grepl("<", m_names, fixed = TRUE)
## Range Alts ##
m_txt[!is_null & is_range] <-
@@ -564,35 +563,35 @@ as.matrix.bayesfactor_models <- function(x, ...) {
## Null models + Not nulls ##
if (any(is_d & is_p)) {
- is_null <- !grepl("^Non", m_names)
+ is_null <- !startsWith(m_names, "Non")
temp <- m_names[is_null][1]
mi <- gregexpr("\\(.*\\)", temp)
- aa <- unlist(regmatches(temp, m = mi))
+ aa <- unlist(regmatches(temp, m = mi), use.names = FALSE)
- m_txt[is_null] <- sub("a=", "a = ", aa)
- m_txt[!is_null & !is_range] <- sub("a=", "a != ", aa)
+ m_txt[is_null] <- sub("a=", "a = ", aa, fixed = TRUE)
+ m_txt[!is_null & !is_range] <- sub("a=", "a != ", aa, fixed = TRUE)
} else if (any(is_rho)) {
m_txt[is_null] <- "rho = 0"
m_txt[!is_null & !is_range] <- "rho != 0"
- m_txt <- sub("<rho<", " < rho < ", m_txt)
+ m_txt <- sub("<rho<", " < rho < ", m_txt, fixed = TRUE)
} else if (any(is_d | is_mu)) {
m_txt[is_null] <- "d = 0"
m_txt[!is_null & !is_range] <- "d != 0"
- m_txt <- sub("<d<", " < d < ", m_txt)
+ m_txt <- sub("<d<", " < d < ", m_txt, fixed = TRUE)
} else if (any(is_p)) {
temp <- m_names[is_null][1]
mi <- gregexpr("[0-9|\\.]+", temp)
- pp <- unlist(regmatches(temp, m = mi))
+ pp <- unlist(regmatches(temp, m = mi), use.names = FALSE)
m_txt[is_null] <- paste0("p = ", pp)
m_txt[!is_null & !is_range] <- paste0("p != ", pp)
- m_txt <- sub("<p<", " < p < ", m_txt)
+ m_txt <- sub("<p<", " < p < ", m_txt, fixed = TRUE)
} else {
stop("!", call. = FALSE)
}
## wrap with () for readability ##
- is_wrapped <- grepl("\\(", m_txt)
+ is_wrapped <- grepl("(", m_txt, fixed = TRUE)
m_txt[!is_wrapped] <- paste0("(", m_txt[!is_wrapped], ")")
return(m_txt)
@@ -602,3 +601,18 @@ as.matrix.bayesfactor_models <- function(x, ...) {
}
)
}
+
+#' @keywords internal
+.get_marglik <- function(mod, verbose, ...) {
+ # Add a check here for brmsfit object to avoid unnecessary computation of the ML
+ if (inherits(mod, "brmsfit") && "marglik" %in% names(mod$criteria)) {
+ return(stats::median(mod$criteria$marglik$logml))
+ }
+
+ # Else... Get marginal likelihood
+ if (verbose) {
+ message("Computation of Marginal Likelihood: estimating marginal likelihood, please wait...")
+ }
+ # Should probably allow additional arguments such as reps or cores to for bridge_sampler
+ bridgesampling::bridge_sampler(mod, silent = TRUE)
+}
diff --git a/R/bayesfactor_parameters.R b/R/bayesfactor_parameters.R
index dcdb967..1ecbaac 100644
--- a/R/bayesfactor_parameters.R
+++ b/R/bayesfactor_parameters.R
@@ -113,7 +113,7 @@
#' if (require("logspline")) {
#' prior <- distribution_normal(1000, mean = 0, sd = 1)
#' posterior <- distribution_normal(1000, mean = .5, sd = .3)
-#' (BF_pars <- bayesfactor_parameters(posterior, prior))
+#' (BF_pars <- bayesfactor_parameters(posterior, prior, verbose = FALSE))
#'
#' as.numeric(BF_pars)
#' }
@@ -122,18 +122,22 @@
#' # ---------------
#' if (require("rstanarm") && require("emmeans") && require("logspline")) {
#' contrasts(sleep$group) <- contr.equalprior_pairs # see vingette
-#' stan_model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
-#' bayesfactor_parameters(stan_model)
+#' stan_model <- suppressWarnings(stan_lmer(
+#' extra ~ group + (1 | ID),
+#' data = sleep,
+#' refresh = 0
+#' ))
+#' bayesfactor_parameters(stan_model, verbose = FALSE)
#' bayesfactor_parameters(stan_model, null = rope_range(stan_model))
#'
#' # emmGrid objects
#' # ---------------
#' group_diff <- pairs(emmeans(stan_model, ~group))
-#' bayesfactor_parameters(group_diff, prior = stan_model)
+#' bayesfactor_parameters(group_diff, prior = stan_model, verbose = FALSE)
#'
#' # Or
#' group_diff_prior <- pairs(emmeans(unupdate(stan_model), ~group))
-#' bayesfactor_parameters(group_diff, prior = group_diff_prior)
+#' bayesfactor_parameters(group_diff, prior = group_diff_prior, verbose = FALSE)
#' }
#'
#' # brms models
@@ -144,11 +148,12 @@
#' set_prior("student_t(3, 0, 1)", class = "b") +
#' set_prior("student_t(3, 0, 1)", class = "sd", group = "ID")
#'
-#' brms_model <- brm(extra ~ group + (1 | ID),
+#' brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID),
#' data = sleep,
-#' prior = my_custom_priors
-#' )
-#' bayesfactor_parameters(brms_model)
+#' prior = my_custom_priors,
+#' refresh = 0
+#' ))
+#' bayesfactor_parameters(brms_model, verbose = FALSE)
#' }
#' }
#' @references
@@ -193,7 +198,7 @@ bayesfactor_pointnull <- function(posterior,
null = 0,
verbose = TRUE,
...) {
- if (length(null) > 1) {
+ if (length(null) > 1 && verbose) {
message("'null' is a range - computing a ROPE based Bayes factor.")
}
@@ -215,8 +220,8 @@ bayesfactor_rope <- function(posterior,
null = rope_range(posterior),
verbose = TRUE,
...) {
- if (length(null) < 2) {
- message("'null' is a point - computing a Savage-Dickey (point null) Bayes factor.")
+ if (length(null) < 2 && verbose) {
+ insight::format_alert("'null' is a point - computing a Savage-Dickey (point null) Bayes factor.")
}
bayesfactor_parameters(
@@ -249,10 +254,8 @@ bayesfactor_parameters.numeric <- function(posterior, prior = NULL, direction =
if (is.null(prior)) {
prior <- posterior
if (verbose) {
- warning(
- "Prior not specified! ",
- "Please specify a prior (in the form 'prior = distribution_normal(1000, 0, 1)')",
- " to get meaningful results."
+ insight::format_warning(
+ "Prior not specified! Please specify a prior (in the form 'prior = distribution_normal(1000, 0, 1)') to get meaningful results."
)
}
}
@@ -386,18 +389,17 @@ bayesfactor_parameters.data.frame <- function(posterior,
if (is.null(prior)) {
prior <- posterior
- warning(
- "Prior not specified! ",
- "Please specify priors (with column order matching 'posterior')",
- " to get meaningful results."
- )
+ if (verbose) {
+ insight::format_warning(
+ "Prior not specified! Please specify priors (with column order matching 'posterior') to get meaningful results."
+ )
+ }
}
if (verbose && length(null) == 1L && (nrow(posterior) < 4e4 || nrow(prior) < 4e4)) {
- warning(
- "Bayes factors might not be precise.\n",
- "For precise Bayes factors, sampling at least 40,000 posterior samples is recommended.",
- call. = FALSE
+ insight::format_warning(
+ "Bayes factors might not be precise.",
+ "For precise Bayes factors, sampling at least 40,000 posterior samples is recommended."
)
}
@@ -484,8 +486,7 @@ bayesfactor_parameters.rvar <- bayesfactor_parameters.draws
d_samples / norm_samples
}
- return(relative_density(prior) /
- relative_density(posterior))
+ return(relative_density(prior) / relative_density(posterior))
} else if (length(null) == 2) {
null <- sort(null)
null[is.infinite(null)] <- 1.797693e+308 * sign(null[is.infinite(null)])
@@ -518,17 +519,17 @@ bayesfactor_parameters.rvar <- bayesfactor_parameters.draws
#' @export
bayesfactor_parameters.bayesfactor_models <- function(...) {
- stop(
- "Oh no, 'bayesfactor_parameters()' does not know how to deal with multiple models :(\n",
+ insight::format_error(
+ "Oh no, 'bayesfactor_parameters()' does not know how to deal with multiple models :(",
"You might want to use 'bayesfactor_inclusion()' here to test specific terms across models."
)
}
#' @export
bayesfactor_parameters.sim <- function(...) {
- stop(
- "Bayes factors are based on the shift from a prior to a posterior. ",
- "Since simulated draws are not based on any priors, computing Bayes factors does not make sense :(\n",
+ insight::format_error(
+ "Bayes factors are based on the shift from a prior to a posterior.",
+ "Since simulated draws are not based on any priors, computing Bayes factors does not make sense :(",
"You might want to try `rope`, `ci`, `pd` or `pmap` for posterior-based inference."
)
}
diff --git a/R/bayesfactor_restricted.R b/R/bayesfactor_restricted.R
index 0ca86fc..ee1e4fb 100644
--- a/R/bayesfactor_restricted.R
+++ b/R/bayesfactor_restricted.R
@@ -50,59 +50,62 @@
#' "C > A"
#' )
#'
-#' if (getRversion() > "3.5.0") {
-#' (b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior))
-#'
-#' as.numeric(b)
-#'
-#' if (require("see") && require("patchwork")) {
-#' i <- attr(b, "bool_results")[["posterior"]]
-#'
-#' see::plots(
-#' plot(estimate_density(posterior)),
-#' # distribution **conditional** on the restrictions
-#' plot(estimate_density(posterior[i[[hyps[1]]], ])) + ggplot2::ggtitle(hyps[1]),
-#' plot(estimate_density(posterior[i[[hyps[2]]], ])) + ggplot2::ggtitle(hyps[2]),
-#' plot(estimate_density(posterior[i[[hyps[3]]], ])) + ggplot2::ggtitle(hyps[3]),
-#' guides = "collect"
-#' )
-#' }
-#' }
#'
+#' (b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior))
+#'
+#' bool <- as.logical(b, which = "posterior")
+#' head(bool)
+#'
+#' @examplesIf require("see") && require("patchwork")
+#'
+#' see::plots(
+#' plot(estimate_density(posterior)),
+#' # distribution **conditional** on the restrictions
+#' plot(estimate_density(posterior[bool[, hyps[1]], ])) + ggplot2::ggtitle(hyps[1]),
+#' plot(estimate_density(posterior[bool[, hyps[2]], ])) + ggplot2::ggtitle(hyps[2]),
+#' plot(estimate_density(posterior[bool[, hyps[3]], ])) + ggplot2::ggtitle(hyps[3]),
+#' guides = "collect"
+#' )
+#'
+#' @examplesIf require("rstanarm")
#' \dontrun{
#' # rstanarm models
#' # ---------------
-#' if (require("rstanarm") && require("emmeans")) {
-#' fit_stan <- stan_glm(mpg ~ wt + cyl + am,
-#' data = mtcars, refresh = 0
-#' )
-#' hyps <- c(
-#' "am > 0 & cyl < 0",
-#' "cyl < 0",
-#' "wt - cyl > 0"
-#' )
-#' bayesfactor_restricted(fit_stan, hypothesis = hyps)
-#'
-#' # emmGrid objects
-#' # ---------------
-#' # replicating http://bayesfactor.blogspot.com/2015/01/multiple-comparisons-with-bayesfactor-2.html
-#' disgust_data <- read.table(url("http://www.learnbayes.org/disgust_example.txt"), header = TRUE)
-#'
-#' contrasts(disgust_data$condition) <- contr.equalprior_pairs # see vignette
-#' fit_model <- stan_glm(score ~ condition, data = disgust_data, family = gaussian())
-#'
-#' em_condition <- emmeans(fit_model, ~condition)
-#' hyps <- c("lemon < control & control < sulfur")
-#'
-#' bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps)
-#' # > # Bayes Factor (Order-Restriction)
-#' # >
-#' # > Hypothesis P(Prior) P(Posterior) BF
-#' # > lemon < control & control < sulfur 0.17 0.75 4.49
-#' # > ---
-#' # > Bayes factors for the restricted model vs. the un-restricted model.
+#' data("mtcars")
+#'
+#' fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am,
+#' data = mtcars, refresh = 0
+#' )
+#' hyps <- c(
+#' "am > 0 & cyl < 0",
+#' "cyl < 0",
+#' "wt - cyl > 0"
+#' )
+#'
+#' bayesfactor_restricted(fit_stan, hypothesis = hyps)
#' }
+#'
+#' @examplesIf require("rstanarm") && require("emmeans")
+#' \dontrun{
+#' # emmGrid objects
+#' # ---------------
+#' # replicating http://bayesfactor.blogspot.com/2015/01/multiple-comparisons-with-bayesfactor-2.html
+#' data("disgust")
+#' contrasts(disgust$condition) <- contr.equalprior_pairs # see vignette
+#' fit_model <- rstanarm::stan_glm(score ~ condition, data = disgust, family = gaussian())
+#'
+#' em_condition <- emmeans::emmeans(fit_model, ~condition)
+#' hyps <- c("lemon < control & control < sulfur")
+#'
+#' bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps)
+#' # > # Bayes Factor (Order-Restriction)
+#' # >
+#' # > Hypothesis P(Prior) P(Posterior) BF
+#' # > lemon < control & control < sulfur 0.17 0.75 4.49
+#' # > ---
+#' # > Bayes factors for the restricted model vs. the un-restricted model.
#' }
+#'
#' @references
#' - Morey, R. D., & Wagenmakers, E. J. (2014). Simple relation between Bayesian order-restricted and point-null hypothesis tests. Statistics & Probability Letters, 92, 121-124.
#' - Morey, R. D., & Rouder, J. N. (2011). Bayes factor approaches for testing interval null hypotheses. Psychological methods, 16(4), 406.
@@ -183,7 +186,7 @@ bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NUL
if (is.null(prior)) {
prior <- posterior
- warning(
+ insight::format_warning(
"Prior not specified! ",
"Please specify priors (with column names matching 'posterior')",
" to get meaningful results."
@@ -196,16 +199,17 @@ bayesfactor_restricted.data.frame <- function(posterior, hypothesis, prior = NUL
cnames <- colnames(data)
is_name <- make.names(cnames) == cnames
cnames[!is_name] <- paste0("`", cnames[!is_name], "`")
- cnames <- paste0(cnames, collapse = ", ")
- stop(x_logical, "Available parameters are: ", cnames, call. = FALSE)
+ insight::format_error(
+ x_logical,
+ paste("Available parameters are:", toString(cnames))
+ )
} else if (!all(is.logical(x_logical))) {
- stop("Hypotheses must be logical", call. = FALSE)
+ insight::format_error("Hypotheses must be logical.")
}
x_logical
}
-
posterior_l <- as.data.frame(lapply(p_hypothesis, .test_hypothesis, data = posterior))
prior_l <- as.data.frame(lapply(p_hypothesis, .test_hypothesis, data = prior))
colnames(posterior_l) <- colnames(prior_l) <- if (!is.null(names(hypothesis))) names(hypothesis) else hypothesis
@@ -238,3 +242,15 @@ bayesfactor_restricted.draws <- function(posterior, hypothesis, prior = NULL, ..
#' @export
bayesfactor_restricted.rvar <- bayesfactor_restricted.draws
+
+
+# Methods -----------------------------------------------------------------
+
+#' @export
+#' @rdname bayesfactor_restricted
+#' @param x An object of class `bayesfactor_restricted`
+#' @param which Should the logical matrix be of the posterior or prior distribution(s)?
+as.logical.bayesfactor_restricted <- function(x, which = c("posterior", "prior"), ...) {
+ which <- match.arg(which)
+ as.matrix(attr(x, "bool_results")[[which]])
+}
diff --git a/R/bayestestR-package.R b/R/bayestestR-package.R
new file mode 100644
index 0000000..4671227
--- /dev/null
+++ b/R/bayestestR-package.R
@@ -0,0 +1,25 @@
+#' \code{bayestestR}
+#'
+#' @title bayestestR: Describing Effects and their Uncertainty, Existence and
+#' Significance within the Bayesian Framework
+#'
+#' @description
+#'
+#' Existing R packages allow users to easily fit a large variety of models
+#' and extract and visualize the posterior draws. However, most of these
+#' packages only return a limited set of indices (e.g., point-estimates and
+#' CIs). **bayestestR** provides a comprehensive and consistent set of
+#' functions to analyze and describe posterior distributions generated by a
+#' variety of models objects, including popular modeling packages such as
+#' **rstanarm**, **brms** or **BayesFactor**.
+#'
+#' References:
+#'
+#' - Makowski et al. (2019) \doi{10.21105/joss.01541}
+#' - Makowski et al. (2019) \doi{10.3389/fpsyg.2019.02767}
+#'
+#' @docType package
+#' @aliases bayestestR bayestestR-package
+#' @name bayestestR-package
+#' @keywords internal
+"_PACKAGE"
diff --git a/R/bci.R b/R/bci.R
index 09d2f47..7b6540d 100644
--- a/R/bci.R
+++ b/R/bci.R
@@ -16,7 +16,7 @@
#' @examples
#' posterior <- rnorm(1000)
#' bci(posterior)
-#' bci(posterior, ci = c(.80, .89, .95))
+#' bci(posterior, ci = c(0.80, 0.89, 0.95))
#' @export
bci <- function(x, ...) {
UseMethod("bci")
@@ -45,7 +45,7 @@ bci.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
bci.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "bci")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -54,7 +54,7 @@ bci.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
bci.draws <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "bci")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -68,7 +68,7 @@ bci.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) {
nF <- x$Fixed$nfl
d <- as.data.frame(x$Sol[, 1:nF, drop = FALSE])
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -78,7 +78,7 @@ bci.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) {
bci.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) {
d <- as.data.frame(x)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -93,7 +93,7 @@ bci.bamlss <- function(x,
component <- match.arg(component)
d <- insight::get_parameters(x, component = component)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -103,7 +103,7 @@ bci.bamlss <- function(x,
bci.bcplm <- function(x, ci = 0.95, verbose = TRUE, ...) {
d <- insight::get_parameters(x)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "bci")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -169,7 +169,7 @@ bci.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) {
xdf <- insight::get_parameters(x)
dat <- bci(xdf, ci = ci, verbose = verbose, ...)
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -205,7 +205,7 @@ bci.stanreg <- function(x,
)
class(out) <- unique(c("bayestestR_eti", "see_eti", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -232,7 +232,7 @@ bci.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"),
)
class(out) <- unique(c("bayestestR_eti", "see_eti", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -242,7 +242,7 @@ bci.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"),
#' @export
bci.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) {
out <- bci(insight::get_parameters(x), ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -252,9 +252,9 @@ bci.get_predicted <- function(x, ...) {
if ("iterations" %in% names(attributes(x))) {
out <- bci(as.data.frame(t(attributes(x)$iterations)), ...)
} else {
- stop("No iterations present in the output.", call. = FALSE)
+ insight::format_error("No iterations present in the output.")
}
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
diff --git a/R/check_prior.R b/R/check_prior.R
index 1a3da1b..d61795a 100644
--- a/R/check_prior.R
+++ b/R/check_prior.R
@@ -37,7 +37,8 @@
#' )
#' check_prior(model, method = "gelman")
#' check_prior(model, method = "lakeland")
-#' plot(si(model)) # can provide visual confirmation to the Lakeland method
+#' # can provide visual confirmation to the Lakeland method
+#' plot(si(model, verbose = FALSE))
#' }
#' }
#' @references https://statmodeling.stat.columbia.edu/2019/08/10/
@@ -146,7 +147,7 @@ check_prior.blavaan <- check_prior.brmsfit
priors <- priors[common_columns]
posteriors <- posteriors[common_columns]
if (verbose) {
- warning("Parameters and priors could not be fully matched. Only returning results for parameters with matching priors.", call. = FALSE)
+ insight::format_warning("Parameters and priors could not be fully matched. Only returning results for parameters with matching priors.")
}
}
@@ -158,7 +159,7 @@ check_prior.blavaan <- check_prior.brmsfit
})
if (any(all_missing) && verbose) {
- warning("Some priors could not be simulated.", call. = FALSE)
+ insight::format_warning("Some priors could not be simulated.")
}
.gelman <- function(prior, posterior) {
@@ -175,7 +176,7 @@ check_prior.blavaan <- check_prior.brmsfit
if (all(is.na(prior))) {
"not determinable"
} else {
- hdi <- hdi(prior, ci = .95)
+ hdi <- hdi(prior, ci = 0.95)
r <- rope(posterior, ci = 1, range = c(hdi$CI_low, hdi$CI_high))
if (as.numeric(r) > 0.99) {
"informative"
@@ -190,7 +191,7 @@ check_prior.blavaan <- check_prior.brmsfit
} else if (method == "lakeland") {
result <- mapply(.lakeland, priors, posteriors)
} else {
- stop("method should be 'gelman' or 'lakeland'.", call. = FALSE)
+ insight::format_error("method should be 'gelman' or 'lakeland'.")
}
data.frame(
diff --git a/R/ci.R b/R/ci.R
index 875a2da..7aad54f 100644
--- a/R/ci.R
+++ b/R/ci.R
@@ -1,6 +1,8 @@
#' Confidence/Credible/Compatibility Interval (CI)
#'
-#' Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals (SI) for Bayesian and frequentist models. The Documentation is accessible for:
+#' Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals
+#' (SI) for Bayesian and frequentist models. The Documentation is accessible
+#' for:
#'
#' \itemize{
#' \item [Bayesian models](https://easystats.github.io/bayestestR/articles/credible_interval.html)
@@ -33,7 +35,7 @@
#' @references Gelman A, Greenland S. Are confidence intervals better termed "uncertainty intervals"? BMJ 2019;l5381. 10.1136/bmj.l5381
#'
#'
-#' @examples
+#' @examplesIf require("rstanarm", quietly = TRUE)
#' library(bayestestR)
#'
#' posterior <- rnorm(1000)
@@ -41,36 +43,24 @@
#' ci(posterior, method = "HDI")
#'
#' df <- data.frame(replicate(4, rnorm(100)))
-#' ci(df, method = "ETI", ci = c(.80, .89, .95))
-#' ci(df, method = "HDI", ci = c(.80, .89, .95))
-#' \dontrun{
-#' if (require("rstanarm")) {
-#' model <- stan_glm(mpg ~ wt, data = mtcars, chains = 2, iter = 200, refresh = 0)
-#' ci(model, method = "ETI", ci = c(.80, .89))
-#' ci(model, method = "HDI", ci = c(.80, .89))
-#' ci(model, method = "SI")
-#' }
+#' ci(df, method = "ETI", ci = c(0.80, 0.89, 0.95))
+#' ci(df, method = "HDI", ci = c(0.80, 0.89, 0.95))
#'
-#' if (require("brms")) {
-#' model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
-#' ci(model, method = "ETI")
-#' ci(model, method = "HDI")
-#' ci(model, method = "SI")
-#' }
+#' model <- suppressWarnings(
+#' stan_glm(mpg ~ wt, data = mtcars, chains = 2, iter = 200, refresh = 0)
+#' )
+#' ci(model, method = "ETI", ci = c(0.80, 0.89))
+#' ci(model, method = "HDI", ci = c(0.80, 0.89))
#'
-#' if (require("BayesFactor")) {
-#' bf <- ttestBF(x = rnorm(100, 1, 1))
-#' ci(bf, method = "ETI")
-#' ci(bf, method = "HDI")
-#' }
+#' @examplesIf require("BayesFactor", quietly = TRUE)
+#' bf <- ttestBF(x = rnorm(100, 1, 1))
+#' ci(bf, method = "ETI")
+#' ci(bf, method = "HDI")
#'
-#' if (require("emmeans")) {
-#' model <- emtrends(model, ~1, "wt")
-#' ci(model, method = "ETI")
-#' ci(model, method = "HDI")
-#' ci(model, method = "SI")
-#' }
-#' }
+#' @examplesIf require("emmeans", quietly = TRUE) && require("rstanarm", quietly = TRUE)
+#' model <- emtrends(model, ~1, "wt")
+#' ci(model, method = "ETI")
+#' ci(model, method = "HDI")
#' @export
ci <- function(x, ...) {
UseMethod("ci")
@@ -78,19 +68,79 @@ ci <- function(x, ...) {
#' @keywords internal
-.ci_bayesian <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, BF = 1, ...) {
+.ci_bayesian <- function(x,
+ ci = 0.95,
+ method = "ETI",
+ effects = c("fixed", "random", "all"),
+ component = c("conditional", "zi", "zero_inflated", "all"),
+ parameters = NULL,
+ verbose = TRUE,
+ BF = 1,
+ ...) {
if (tolower(method) %in% c("eti", "equal", "ci", "quantile")) {
- return(eti(x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
+ return(
+ eti(
+ x,
+ ci = ci,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
+ )
} else if (tolower(method) %in% c("bci", "bca", "bcai")) {
- return(bci(x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
- } else if (tolower(method) %in% c("hdi")) {
- return(hdi(x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
- } else if (tolower(method) %in% c("spi")) {
- return(spi(x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
- } else if (tolower(method) %in% c("si")) {
- return(si(x, BF = BF, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
+ return(
+ bci(
+ x,
+ ci = ci,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
+ )
+ } else if (tolower(method) == "hdi") {
+ return(
+ hdi(
+ x,
+ ci = ci,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
+ )
+ } else if (tolower(method) == "spi") {
+ return(
+ spi(
+ x,
+ ci = ci,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
+ )
+ } else if (tolower(method) == "si") {
+ return(
+ si(
+ x,
+ BF = BF,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
+ )
} else {
- stop(insight::format_message("`method` should be 'ETI' (for equal-tailed interval),'HDI' (for highest density interval), 'BCI' (for bias corrected and accelerated bootstrap intervals), 'SPI' (for shortest probability interval) or 'SI' (for support interval)."), call. = FALSE)
+ insight::format_error(
+ "`method` should be 'ETI' (for equal-tailed interval),'HDI' (for highest density interval), 'BCI' (for bias corrected and accelerated bootstrap intervals), 'SPI' (for shortest probability interval) or 'SI' (for support interval)."
+ )
}
}
@@ -120,10 +170,7 @@ ci.rvar <- ci.draws
#' @export
ci.emmGrid <- function(x, ci = NULL, ...) {
if (!.is_baysian_emmeans(x)) {
- if (!requireNamespace("parameters")) {
- stop("'parameters' required for this function to work.", call. = FALSE)
- }
-
+ insight::check_if_installed("parameters")
if (is.null(ci)) ci <- 0.95
return(parameters::ci(model = x, ci = ci, ...))
}
@@ -141,36 +188,101 @@ ci.emm_list <- ci.emmGrid
#' @rdname ci
#' @export
-ci.sim.merMod <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"),
- parameters = NULL, verbose = TRUE, ...) {
- .ci_bayesian(x, ci = ci, method = method, effects = effects, parameters = parameters, verbose = verbose, ...)
+ci.sim.merMod <- function(x,
+ ci = 0.95,
+ method = "ETI",
+ effects = c("fixed", "random", "all"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
+ .ci_bayesian(
+ x,
+ ci = ci,
+ method = method,
+ effects = effects,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
}
#' @rdname ci
#' @export
-ci.sim <- function(x, ci = 0.95, method = "ETI", parameters = NULL, verbose = TRUE, ...) {
- .ci_bayesian(x, ci = ci, method = method, parameters = parameters, verbose = verbose, ...)
+ci.sim <- function(x,
+ ci = 0.95,
+ method = "ETI",
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
+ .ci_bayesian(
+ x,
+ ci = ci,
+ method = method,
+ parameters = parameters,
+ verbose = verbose,
+ ...
+ )
}
#' @rdname ci
#' @export
-ci.stanreg <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"),
- component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
- parameters = NULL, verbose = TRUE, BF = 1, ...) {
- .ci_bayesian(x, ci = ci, method = method, effects = effects, component = component, parameters = parameters, verbose = verbose, BF = BF, ...)
+ci.stanreg <- function(x,
+ ci = 0.95,
+ method = "ETI",
+ effects = c("fixed", "random", "all"),
+ component = c(
+ "location",
+ "all",
+ "conditional",
+ "smooth_terms",
+ "sigma",
+ "distributional",
+ "auxiliary"
+ ),
+ parameters = NULL,
+ verbose = TRUE,
+ BF = 1,
+ ...) {
+ .ci_bayesian(
+ x,
+ ci = ci,
+ method = method,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ BF = BF,
+ ...
+ )
}
#' @rdname ci
#' @export
-ci.brmsfit <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"),
+ci.brmsfit <- function(x,
+ ci = 0.95,
+ method = "ETI",
+ effects = c("fixed", "random", "all"),
component = c("conditional", "zi", "zero_inflated", "all"),
- parameters = NULL, verbose = TRUE, BF = 1, ...) {
- .ci_bayesian(x, ci = ci, method = method, effects = effects, component = component, parameters = parameters, verbose = verbose, BF = BF, ...)
+ parameters = NULL,
+ verbose = TRUE,
+ BF = 1,
+ ...) {
+ .ci_bayesian(
+ x,
+ ci = ci,
+ method = method,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ verbose = verbose,
+ BF = BF,
+ ...
+ )
}
@@ -193,14 +305,31 @@ ci.BFBayesFactor <- ci.numeric
#' @export
ci.MCMCglmm <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, ...) {
nF <- x$Fixed$nfl
- ci(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), ci = ci, method = method, verbose = verbose, ...)
+ ci(
+ as.data.frame(x$Sol[, 1:nF, drop = FALSE]),
+ ci = ci,
+ method = method,
+ verbose = verbose,
+ ...
+ )
}
#' @export
-ci.bamlss <- function(x, ci = 0.95, method = "ETI", component = c("all", "conditional", "location"), verbose = TRUE, ...) {
+ci.bamlss <- function(x,
+ ci = 0.95,
+ method = "ETI",
+ component = c("all", "conditional", "location"),
+ verbose = TRUE,
+ ...) {
component <- match.arg(component)
- ci(insight::get_parameters(x, component = component), ci = ci, method = method, verbose = verbose, ...)
+ ci(
+ insight::get_parameters(x, component = component),
+ ci = ci,
+ method = method,
+ verbose = verbose,
+ ...
+ )
}
diff --git a/R/convert_bayesian_to_frequentist.R b/R/convert_bayesian_to_frequentist.R
index 815f8cc..58b28c6 100644
--- a/R/convert_bayesian_to_frequentist.R
+++ b/R/convert_bayesian_to_frequentist.R
@@ -48,7 +48,7 @@ convert_bayesian_as_frequentist <- function(model, data = NULL, REML = TRUE) {
data <- insight::get_data(model)
}
- info <- insight::model_info(model)
+ info <- insight::model_info(model, verbose = FALSE)
formula <- insight::find_formula(model)
family <- insight::get_family(model)
if (inherits(family, "brmsfamily")) {
@@ -67,9 +67,7 @@ convert_bayesian_as_frequentist <- function(model, data = NULL, REML = TRUE) {
}
if (inherits(freq, "error")) {
- stop(insight::format_message(
- "Model could not be automatically converted to frequentist model."
- ), call. = FALSE)
+ insight::format_error("Model could not be automatically converted to frequentist model.")
} else {
return(freq)
}
diff --git a/R/cwi.R b/R/cwi.R
index 5d32c98..42349bc 100644
--- a/R/cwi.R
+++ b/R/cwi.R
@@ -43,12 +43,12 @@
#' data[c("ETI_low", "ETI_high")] <- eti(iters, ci = 0.5)[c("CI_low", "CI_high")]
#'
#' # Compute CWI
-#' # ggdist::curve_interval(reshape_iterations(data), iter_value .width = c(.5))
+#' # ggdist::curve_interval(reshape_iterations(data), iter_value .width = 0.5)
#'
#' # Visualization =============================================
#' ggplot(data, aes(x = x, y = Median)) +
#' geom_ribbon(aes(ymin = ETI_low, ymax = ETI_high), fill = "red", alpha = 0.3) +
-#' geom_line(size = 1) +
+#' geom_line(linewidth = 1) +
#' geom_line(
#' data = reshape_iterations(data),
#' aes(y = iter_value, group = iter_group),
@@ -67,5 +67,5 @@ cwi <- function(x, ...) {
cwi.data.frame <- function(x, ci = 0.95, ...) {
insight::check_if_installed("ggdist")
- print("Comming soon!")
+ print("Comming soon!") # @DominiqueMakowski GitBlame says this was 2 years ago - when is "soon"? :-)
}
diff --git a/R/datasets.R b/R/datasets.R
new file mode 100644
index 0000000..f01affb
--- /dev/null
+++ b/R/datasets.R
@@ -0,0 +1,24 @@
+#' Moral Disgust Judgment
+#'
+#' A sample (simulated) dataset, used in tests and some examples.
+#'
+#' @author Richard D. Morey
+#'
+#' @docType data
+#'
+#' @name disgust
+#'
+#' @keywords data
+#'
+#' @format A data frame with 500 rows and 5 variables:
+#' \describe{
+#' \item{score}{Score on the questionnaire, which ranges from 0 to 50 with higher scores representing harsher moral judgment}
+#' \item{condition}{one of three conditions, differing by the odor present in the room: a pleasant scent associated with cleanliness (lemon), a disgusting scent (sulfur), and a control condition in which no unusual odor is present}
+#' }
+#'
+#' ```{r}
+#' data("disgust")
+#' head(disgust, n = 5)
+#' ````
+#'
+NULL
diff --git a/R/describe_posterior.R b/R/describe_posterior.R
index 38eb226..2ecc914 100644
--- a/R/describe_posterior.R
+++ b/R/describe_posterior.R
@@ -54,17 +54,30 @@
#'
#' if (require("logspline")) {
#' x <- rnorm(1000)
-#' describe_posterior(x)
-#' describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")
-#' describe_posterior(x, ci = c(0.80, 0.90))
+#' describe_posterior(x, verbose = FALSE)
+#' describe_posterior(x,
+#' centrality = "all",
+#' dispersion = TRUE,
+#' test = "all",
+#' verbose = FALSE
+#' )
+#' describe_posterior(x, ci = c(0.80, 0.90), verbose = FALSE)
#'
#' df <- data.frame(replicate(4, rnorm(100)))
-#' describe_posterior(df)
-#' describe_posterior(df, centrality = "all", dispersion = TRUE, test = "all")
-#' describe_posterior(df, ci = c(0.80, 0.90))
+#' describe_posterior(df, verbose = FALSE)
+#' describe_posterior(
+#' df,
+#' centrality = "all",
+#' dispersion = TRUE,
+#' test = "all",
+#' verbose = FALSE
+#' )
+#' describe_posterior(df, ci = c(0.80, 0.90), verbose = FALSE)
#'
#' df <- data.frame(replicate(4, rnorm(20)))
-#' head(reshape_iterations(describe_posterior(df, keep_iterations = TRUE)))
+#' head(reshape_iterations(
+#' describe_posterior(df, keep_iterations = TRUE, verbose = FALSE)
+#' ))
#' }
#' \dontrun{
#' # rstanarm models
@@ -80,15 +93,6 @@
#' describe_posterior(emtrends(model, ~1, "wt"))
#' }
#'
-#' # brms models
-#' # -----------------------------------------------
-#' if (require("brms")) {
-#' model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
-#' describe_posterior(model)
-#' describe_posterior(model, centrality = "all", dispersion = TRUE, test = "all")
-#' describe_posterior(model, ci = c(0.80, 0.90))
-#' }
-#'
#' # BayesFactor objects
#' # -----------------------------------------------
#' if (require("BayesFactor")) {
@@ -106,9 +110,9 @@ describe_posterior <- function(posteriors, ...) {
#' @export
describe_posterior.default <- function(posteriors, ...) {
- stop(insight::format_message(
+ insight::format_error(
paste0("`describe_posterior()` is not yet implemented for objects of class `", class(posteriors)[1], "`.")
- ), call. = FALSE)
+ )
}
@@ -126,10 +130,14 @@ describe_posterior.default <- function(posteriors, ...) {
BF = 1,
...) {
if (is.null(x)) {
- warning("Could not extract posterior samples.", call. = FALSE)
+ insight::format_warning("Could not extract posterior samples.")
return(NULL)
}
+ # we need this information from the original object
+ if (all(rope_range == "default")) {
+ rope_range <- rope_range(x, ...)
+ }
if (!is.data.frame(x) && !is.numeric(x)) {
is_stanmvreg <- inherits(x, "stanmvreg")
@@ -142,9 +150,15 @@ describe_posterior.default <- function(posteriors, ...) {
}
# Arguments fixes
- if (!is.null(centrality) && length(centrality) == 1 && (centrality == "none" || centrality == FALSE)) centrality <- NULL
- if (!is.null(ci) && length(ci) == 1 && (is.na(ci) || ci == FALSE)) ci <- NULL
- if (!is.null(test) && length(test) == 1 && (test == "none" || test == FALSE)) test <- NULL
+ if (!is.null(centrality) && length(centrality) == 1 && (centrality == "none" || isFALSE(centrality))) {
+ centrality <- NULL
+ }
+ if (!is.null(ci) && length(ci) == 1 && (is.na(ci) || isFALSE(ci))) {
+ ci <- NULL
+ }
+ if (!is.null(test) && length(test) == 1 && (test == "none" || isFALSE(test))) {
+ test <- NULL
+ }
# Point-estimates
@@ -156,10 +170,13 @@ describe_posterior.default <- function(posteriors, ...) {
is_stanmvreg
)
if (!"Parameter" %in% names(estimates)) {
- estimates <- cbind(data.frame("Parameter" = "Posterior"), estimates)
+ estimates <- cbind(
+ data.frame(Parameter = "Posterior", stringsAsFactors = FALSE),
+ estimates
+ )
}
} else {
- estimates <- data.frame("Parameter" = NA)
+ estimates <- data.frame(Parameter = NA)
}
@@ -180,10 +197,13 @@ describe_posterior.default <- function(posteriors, ...) {
)
if (!"Parameter" %in% names(uncertainty)) {
- uncertainty <- cbind(data.frame("Parameter" = "Posterior"), uncertainty)
+ uncertainty <- cbind(
+ data.frame(Parameter = "Posterior", stringsAsFactors = FALSE),
+ uncertainty
+ )
}
} else {
- uncertainty <- data.frame("Parameter" = NA)
+ uncertainty <- data.frame(Parameter = NA)
}
@@ -196,18 +216,18 @@ describe_posterior.default <- function(posteriors, ...) {
}
## TODO no BF for arm::sim
- if (inherits(x_df, c("sim", "sim.merMod", "mcmc", "stanfit"))) {
+ if (inherits(x, c("sim", "sim.merMod", "mcmc", "stanfit"))) {
test <- setdiff(test, "bf")
}
## TODO enable once "rope()" works for multi-response models
# no ROPE for multi-response models
- if (insight::is_multivariate(x_df)) {
+ if (insight::is_multivariate(x)) {
test <- setdiff(test, c("rope", "p_rope"))
- warning(insight::format_message(
+ insight::format_warning(
"Multivariate response models are not yet supported for tests `rope` and `p_rope`."
- ), call. = FALSE)
+ )
}
# MAP-based p-value
@@ -218,9 +238,15 @@ describe_posterior.default <- function(posteriors, ...) {
cleaned_parameters,
is_stanmvreg
)
- if (!is.data.frame(test_pmap)) test_pmap <- data.frame("Parameter" = "Posterior", "p_map" = test_pmap)
+ if (!is.data.frame(test_pmap)) {
+ test_pmap <- data.frame(
+ Parameter = "Posterior",
+ p_map = test_pmap,
+ stringsAsFactors = FALSE
+ )
+ }
} else {
- test_pmap <- data.frame("Parameter" = NA)
+ test_pmap <- data.frame(Parameter = NA)
}
@@ -232,24 +258,33 @@ describe_posterior.default <- function(posteriors, ...) {
cleaned_parameters,
is_stanmvreg
)
- if (!is.data.frame(test_pd)) test_pd <- data.frame("Parameter" = "Posterior", "pd" = test_pd)
+ if (!is.data.frame(test_pd)) {
+ test_pd <- data.frame(
+ Parameter = "Posterior",
+ pd = test_pd,
+ stringsAsFactors = FALSE
+ )
+ }
} else {
- test_pd <- data.frame("Parameter" = NA)
+ test_pd <- data.frame(Parameter = NA)
}
# Probability of rope
- if (any(c("p_rope") %in% test)) {
+ if ("p_rope" %in% test) {
test_prope <- .prepare_output(
p_rope(x_df, range = rope_range, ...),
cleaned_parameters,
is_stanmvreg
)
if (!"Parameter" %in% names(test_prope)) {
- test_prope <- cbind(data.frame("Parameter" = "Posterior"), test_prope)
+ test_prope <- cbind(
+ data.frame(Parameter = "Posterior", stringsAsFactors = FALSE),
+ test_prope
+ )
}
} else {
- test_prope <- data.frame("Parameter" = NA)
+ test_prope <- data.frame(Parameter = NA)
}
# Probability of significance
@@ -260,44 +295,48 @@ describe_posterior.default <- function(posteriors, ...) {
cleaned_parameters,
is_stanmvreg
)
- if (!is.data.frame(test_psig)) test_psig <- data.frame("Parameter" = "Posterior", "ps" = test_psig)
+ if (!is.data.frame(test_psig)) {
+ test_psig <- data.frame(
+ Parameter = "Posterior",
+ ps = test_psig,
+ stringsAsFactors = FALSE
+ )
+ }
} else {
- test_psig <- data.frame("Parameter" = NA)
+ test_psig <- data.frame(Parameter = NA)
}
# ROPE
- if (any(c("rope") %in% test)) {
+ if ("rope" %in% test) {
test_rope <- .prepare_output(
rope(x_df, range = rope_range, ci = rope_ci, ...),
cleaned_parameters,
is_stanmvreg
)
if (!"Parameter" %in% names(test_rope)) {
- test_rope <- cbind(data.frame("Parameter" = "Posterior"), test_rope)
+ test_rope <- cbind(
+ data.frame(Parameter = "Posterior", stringsAsFactors = FALSE),
+ test_rope
+ )
}
names(test_rope)[names(test_rope) == "CI"] <- "ROPE_CI"
} else {
- test_rope <- data.frame("Parameter" = NA)
+ test_rope <- data.frame(Parameter = NA)
}
# Equivalence test
if (any(c("equivalence", "equivalence_test", "equitest") %in% test)) {
- if (any("rope" %in% test)) {
- equi_warnings <- FALSE
- } else {
- equi_warnings <- TRUE
- }
-
+ dot_args <- list(...)
+ dot_args$verbose <- !"rope" %in% test
test_equi <- .prepare_output(
equivalence_test(x_df,
range = rope_range,
ci = rope_ci,
- verbose = equi_warnings,
- ...
+ dot_args
),
cleaned_parameters,
is_stanmvreg
@@ -305,7 +344,10 @@ describe_posterior.default <- function(posteriors, ...) {
test_equi$Cleaned_Parameter <- NULL
if (!"Parameter" %in% names(test_equi)) {
- test_equi <- cbind(data.frame("Parameter" = "Posterior"), test_equi)
+ test_equi <- cbind(
+ data.frame(Parameter = "Posterior", stringsAsFactors = FALSE),
+ test_equi
+ )
}
names(test_equi)[names(test_equi) == "CI"] <- "ROPE_CI"
@@ -326,7 +368,10 @@ describe_posterior.default <- function(posteriors, ...) {
error = function(e) data.frame("Parameter" = NA)
)
if (!"Parameter" %in% names(test_bf)) {
- test_bf <- cbind(data.frame("Parameter" = "Posterior"), test_bf)
+ test_bf <- cbind(
+ data.frame(Parameter = "Posterior", stringsAsFactors = FALSE),
+ test_bf
+ )
}
} else {
test_bf <- data.frame("Parameter" = NA)
@@ -444,7 +489,7 @@ describe_posterior.default <- function(posteriors, ...) {
out <- datawizard::data_remove(out[order(out$.rowid), ], remove_columns, verbose = FALSE)
# Add iterations
- if (keep_iterations == TRUE) {
+ if (keep_iterations) {
row_order <- out$Parameter
iter <- as.data.frame(t(as.data.frame(x_df, ...)))
names(iter) <- paste0("iter_", seq_len(ncol(iter)))
@@ -554,7 +599,7 @@ describe_posterior.bayesQR <- function(posteriors,
)
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
@@ -631,9 +676,9 @@ describe_posterior.effectsize_std_params <- function(posteriors,
...) {
class(posteriors) <- "data.frame"
- no_unique <- sapply(posteriors, function(col) {
+ no_unique <- vapply(posteriors, function(col) {
length(unique(col)) == 1
- })
+ }, FUN.VALUE = TRUE)
if (any(no_unique)) {
no_unique <- which(no_unique)
@@ -699,7 +744,7 @@ describe_posterior.get_predicted <- function(posteriors,
...
)
} else {
- stop("No iterations present in the output.", call. = FALSE)
+ insight::format_error("No iterations present in the output.")
}
}
@@ -751,7 +796,7 @@ describe_posterior.emmGrid <- function(posteriors,
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
out
}
@@ -783,7 +828,11 @@ describe_posterior.stanreg <- function(posteriors,
diagnostic = c("ESS", "Rhat"),
priors = FALSE,
effects = c("fixed", "random", "all"),
- component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ component = c(
+ "location", "all", "conditional",
+ "smooth_terms", "sigma", "distributional",
+ "auxiliary"
+ ),
parameters = NULL,
BF = 1,
...) {
@@ -830,7 +879,7 @@ describe_posterior.stanreg <- function(posteriors,
out <- .add_clean_parameters_attribute(out, posteriors)
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
@@ -852,7 +901,11 @@ describe_posterior.stanmvreg <- function(posteriors,
diagnostic = c("ESS", "Rhat"),
priors = FALSE,
effects = c("fixed", "random", "all"),
- component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ component = c(
+ "location", "all", "conditional",
+ "smooth_terms", "sigma", "distributional",
+ "auxiliary"
+ ),
parameters = NULL,
...) {
effects <- match.arg(effects)
@@ -895,7 +948,7 @@ describe_posterior.stanmvreg <- function(posteriors,
out <- .add_clean_parameters_attribute(out, posteriors)
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
@@ -969,7 +1022,11 @@ describe_posterior.brmsfit <- function(posteriors,
bf_prior = NULL,
diagnostic = c("ESS", "Rhat"),
effects = c("fixed", "random", "all"),
- component = c("conditional", "zi", "zero_inflated", "all", "location", "distributional", "auxiliary"),
+ component = c(
+ "conditional", "zi", "zero_inflated",
+ "all", "location", "distributional",
+ "auxiliary"
+ ),
parameters = NULL,
BF = 1,
priors = FALSE,
@@ -1019,7 +1076,7 @@ describe_posterior.brmsfit <- function(posteriors,
out <- .add_clean_parameters_attribute(out, posteriors)
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
@@ -1105,7 +1162,7 @@ describe_posterior.bcplm <- function(posteriors,
}
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
@@ -1141,7 +1198,7 @@ describe_posterior.bamlss <- function(posteriors,
)
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
@@ -1226,7 +1283,7 @@ describe_posterior.BFBayesFactor <- function(posteriors,
}
attr(out, "ci_method") <- ci_method
- attr(out, "object_name") <- insight::safe_deparse(substitute(posteriors))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posteriors))
class(out) <- c("describe_posterior", "see_describe_posterior", class(out))
out
}
diff --git a/R/diagnostic_posterior.R b/R/diagnostic_posterior.R
index c99b2f1..fa9d728 100644
--- a/R/diagnostic_posterior.R
+++ b/R/diagnostic_posterior.R
@@ -57,7 +57,7 @@ diagnostic_posterior <- function(posteriors, diagnostic = c("ESS", "Rhat"), ...)
#' @export
diagnostic_posterior.default <- function(posteriors, diagnostic = c("ESS", "Rhat"), ...) {
- stop("'diagnostic_posterior()' only works with rstanarm, brms or blavaan models.", call. = FALSE)
+ insight::format_error("'diagnostic_posterior()' only works with rstanarm, brms or blavaan models.")
}
#' @inheritParams insight::get_parameters.BFBayesFactor
@@ -85,7 +85,7 @@ diagnostic_posterior.stanreg <- function(posteriors, diagnostic = "all", effects
if ("all" %in% diagnostic) {
diagnostic <- c("ESS", "Rhat", "MCSE", "khat")
} else {
- diagnostic <- c(diagnostic)
+ diagnostic <- diagnostic
if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat")
}
@@ -131,8 +131,8 @@ diagnostic_posterior.stanmvreg <- function(posteriors,
params <- unlist(lapply(names(all_params), function(i) {
all_params[[i]]$sigma <- NULL
- unlist(all_params[[i]])
- }))
+ unlist(all_params[[i]], use.names = FALSE)
+ }), use.names = FALSE)
# If no diagnostic
if (is.null(diagnostic)) {
@@ -143,7 +143,7 @@ diagnostic_posterior.stanmvreg <- function(posteriors,
if ("all" %in% diagnostic) {
diagnostic <- c("ESS", "Rhat", "MCSE", "khat")
} else {
- diagnostic <- c(diagnostic)
+ diagnostic <- diagnostic
if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat")
}
@@ -299,7 +299,7 @@ diagnostic_posterior.blavaan <- function(posteriors, diagnostic = "all", ...) {
if ("all" %in% diagnostic) {
diagnostic <- c("ESS", "Rhat", "MCSE")
} else {
- diagnostic <- c(diagnostic)
+ diagnostic <- diagnostic
if ("Rhat" %in% diagnostic) diagnostic <- c(diagnostic, "khat")
}
diff --git a/R/distribution.R b/R/distribution.R
index 5a7fc06..8e2f708 100644
--- a/R/distribution.R
+++ b/R/distribution.R
@@ -146,14 +146,14 @@ distribution_gamma <- function(n, shape, scale = 1, random = FALSE, ...) {
#' @export
distribution_mixture_normal <- function(n, mean = c(-3, 3), sd = 1, random = FALSE, ...) {
n <- round(n / length(mean))
- sd <- c(sd)
+ sd <- sd
if (length(sd) != length(mean)) {
sd <- rep(sd, length.out = length(mean))
}
- x <- c()
- for (i in 1:length(mean)) {
+ x <- NULL
+ for (i in seq_along(mean)) {
x <- c(x, distribution_normal(n = n, mean = mean[i], sd = sd[i], random = random))
}
x
diff --git a/R/effective_sample.R b/R/effective_sample.R
index 02f222f..27c98cf 100644
--- a/R/effective_sample.R
+++ b/R/effective_sample.R
@@ -29,13 +29,23 @@ effective_sample <- function(model, ...) {
#' @export
effective_sample.default <- function(model, ...) {
- stop(insight::format_message(paste0("'effective_sample()' is not yet implemented for objects of class '", class(model)[1], "'.")), call. = FALSE)
+ insight::format_error(
+ paste0(
+ "'effective_sample()' is not yet implemented for objects of class '",
+ class(model)[1],
+ "'."
+ )
+ )
}
#' @rdname effective_sample
#' @export
-effective_sample.brmsfit <- function(model, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) {
+effective_sample.brmsfit <- function(model,
+ effects = c("fixed", "random", "all"),
+ component = c("conditional", "zi", "zero_inflated", "all"),
+ parameters = NULL,
+ ...) {
# check arguments
effects <- match.arg(effects)
component <- match.arg(component)
@@ -64,19 +74,22 @@ effective_sample.brmsfit <- function(model, effects = c("fixed", "random", "all"
#' @rdname effective_sample
#' @export
-effective_sample.stanreg <- function(model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) {
+effective_sample.stanreg <- function(model,
+ effects = c("fixed", "random", "all"),
+ component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ parameters = NULL,
+ ...) {
# check arguments
effects <- match.arg(effects)
component <- match.arg(component)
- pars <-
- insight::find_parameters(
- model,
- effects = effects,
- component = component,
- parameters = parameters,
- flatten = TRUE
- )
+ pars <- insight::find_parameters(
+ model,
+ effects = effects,
+ component = component,
+ parameters = parameters,
+ flatten = TRUE
+ )
s <- as.data.frame(summary(model))
s <- s[rownames(s) %in% pars, ]
@@ -91,7 +104,11 @@ effective_sample.stanreg <- function(model, effects = c("fixed", "random", "all"
#' @export
-effective_sample.stanmvreg <- function(model, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) {
+effective_sample.stanmvreg <- function(model,
+ effects = c("fixed", "random", "all"),
+ component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ parameters = NULL,
+ ...) {
# check arguments
effects <- match.arg(effects)
component <- match.arg(component)
@@ -116,7 +133,10 @@ effective_sample.stanmvreg <- function(model, effects = c("fixed", "random", "al
#' @export
-effective_sample.stanfit <- function(model, effects = c("fixed", "random", "all"), parameters = NULL, ...) {
+effective_sample.stanfit <- function(model,
+ effects = c("fixed", "random", "all"),
+ parameters = NULL,
+ ...) {
# check arguments
effects <- match.arg(effects)
@@ -157,7 +177,10 @@ effective_sample.blavaan <- function(model, parameters = NULL, ...) {
#' @export
-effective_sample.MCMCglmm <- function(model, effects = c("fixed", "random", "all"), parameters = NULL, ...) {
+effective_sample.MCMCglmm <- function(model,
+ effects = c("fixed", "random", "all"),
+ parameters = NULL,
+ ...) {
# check arguments
effects <- match.arg(effects)
@@ -179,7 +202,7 @@ effective_sample.MCMCglmm <- function(model, effects = c("fixed", "random", "all
row.names = NULL
)
- if (nrow(s.random) > 0) {
+ if (nrow(s.random) > 0L) {
es <- rbind(es, data.frame(
Parameter = rownames(s.random),
ESS = round(s.random[["eff.samp"]]),
diff --git a/R/equivalence_test.R b/R/equivalence_test.R
index 738f63a..2c19a62 100644
--- a/R/equivalence_test.R
+++ b/R/equivalence_test.R
@@ -48,11 +48,10 @@
#' predictive variable selection (\cite{Piironen and Vehtari 2017}).
#'
#'
-#' @references \itemize{
-#' \item Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}
-#' \item Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press
-#' \item Piironen, J., & Vehtari, A. (2017). Comparison of Bayesian predictive methods for model selection. Statistics and Computing, 27(3), 711–735. \doi{10.1007/s11222-016-9649-y}
-#' }
+#' @references
+#' - Kruschke, J. K. (2018). Rejecting or accepting parameter values in Bayesian estimation. Advances in Methods and Practices in Psychological Science, 1(2), 270-280. \doi{10.1177/2515245918771304}
+#' - Kruschke, J. K. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press
+#' - Piironen, J., & Vehtari, A. (2017). Comparison of Bayesian predictive methods for model selection. Statistics and Computing, 27(3), 711–735. \doi{10.1007/s11222-016-9649-y}
#'
#' @return A data frame with following columns:
#' \itemize{
@@ -84,7 +83,6 @@
#' library(rstanarm)
#' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars)
#' equivalence_test(model)
-#' equivalence_test(model, ci = c(.50, 1))
#'
#' # plot result
#' test <- equivalence_test(model)
@@ -96,12 +94,10 @@
#' library(brms)
#' model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
#' equivalence_test(model)
-#' equivalence_test(model, ci = c(.50, .99))
#'
#' library(BayesFactor)
#' bf <- ttestBF(x = rnorm(100, 1, 1))
-#' equivalence_test(bf)
-#' equivalence_test(bf, ci = c(.50, .99))
+#' # equivalence_test(bf)
#' }
#' @export
equivalence_test <- function(x, ...) {
@@ -164,7 +160,7 @@ equivalence_test.data.frame <- function(x, range = "default", ci = 0.95, verbose
)
row.names(out) <- NULL
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- unique(c("equivalence_test", "see_equivalence_test_df", class(out)))
out
@@ -185,7 +181,7 @@ equivalence_test.emmGrid <- function(x, range = "default", ci = 0.95, verbose =
xdf <- insight::get_parameters(x)
out <- equivalence_test(xdf, range = range, ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -196,7 +192,7 @@ equivalence_test.emm_list <- equivalence_test.emmGrid
#' @export
equivalence_test.BFBayesFactor <- function(x, range = "default", ci = 0.95, verbose = TRUE, ...) {
out <- equivalence_test(insight::get_parameters(x), range = range, ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -204,15 +200,27 @@ equivalence_test.BFBayesFactor <- function(x, range = "default", ci = 0.95, verb
#' @keywords internal
-.equivalence_test_models <- function(x, range = "default", ci = 0.95, effects = "fixed", component = "conditional", parameters = NULL, verbose = TRUE) {
+.equivalence_test_models <- function(x,
+ range = "default",
+ ci = 0.95,
+ effects = "fixed",
+ component = "conditional",
+ parameters = NULL,
+ verbose = TRUE) {
if (all(range == "default")) {
range <- rope_range(x)
- } else if (!all(is.numeric(range)) || length(range) != 2) {
- stop("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).", call. = FALSE)
+ } else if (!all(is.numeric(range)) || length(range) != 2L) {
+ insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).")
}
if (verbose && !inherits(x, "blavaan")) .check_multicollinearity(x)
- params <- insight::get_parameters(x, component = component, effects = effects, parameters = parameters)
+ params <- insight::get_parameters(
+ x,
+ component = component,
+ effects = effects,
+ parameters = parameters,
+ verbose = verbose
+ )
l <- sapply(
params,
@@ -237,7 +245,14 @@ equivalence_test.BFBayesFactor <- function(x, range = "default", ci = 0.95, verb
#' @rdname equivalence_test
#' @export
-equivalence_test.stanreg <- function(x, range = "default", ci = 0.95, effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) {
+equivalence_test.stanreg <- function(x,
+ range = "default",
+ ci = 0.95,
+ effects = c("fixed", "random", "all"),
+ component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
effects <- match.arg(effects)
component <- match.arg(component)
@@ -250,7 +265,7 @@ equivalence_test.stanreg <- function(x, range = "default", ci = 0.95, effects =
)
class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -264,7 +279,14 @@ equivalence_test.blavaan <- equivalence_test.stanreg
#' @rdname equivalence_test
#' @export
-equivalence_test.brmsfit <- function(x, range = "default", ci = 0.95, effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) {
+equivalence_test.brmsfit <- function(x,
+ range = "default",
+ ci = 0.95,
+ effects = c("fixed", "random", "all"),
+ component = c("conditional", "zi", "zero_inflated", "all"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
effects <- match.arg(effects)
component <- match.arg(component)
@@ -277,16 +299,30 @@ equivalence_test.brmsfit <- function(x, range = "default", ci = 0.95, effects =
)
class(out) <- unique(c("equivalence_test", "see_equivalence_test", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
#' @export
-equivalence_test.sim.merMod <- function(x, range = "default", ci = 0.95, parameters = NULL, verbose = TRUE, ...) {
- out <- .equivalence_test_models(x, range, ci, effects = "fixed", component = "conditional", parameters, verbose = FALSE)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+equivalence_test.sim.merMod <- function(x,
+ range = "default",
+ ci = 0.95,
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
+ out <- .equivalence_test_models(
+ x,
+ range,
+ ci,
+ effects = "fixed",
+ component = "conditional",
+ parameters,
+ verbose = verbose
+ )
+
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -295,17 +331,45 @@ equivalence_test.sim <- equivalence_test.sim.merMod
#' @export
-equivalence_test.mcmc <- function(x, range = "default", ci = 0.95, parameters = NULL, verbose = TRUE, ...) {
- out <- .equivalence_test_models(as.data.frame(x), range, ci, effects = "fixed", component = "conditional", parameters, verbose = FALSE)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+equivalence_test.mcmc <- function(x,
+ range = "default",
+ ci = 0.95,
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
+ out <- .equivalence_test_models(
+ as.data.frame(x),
+ range,
+ ci,
+ effects = "fixed",
+ component = "conditional",
+ parameters,
+ verbose = verbose
+ )
+
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
#' @export
-equivalence_test.bcplm <- function(x, range = "default", ci = 0.95, parameters = NULL, verbose = TRUE, ...) {
- out <- .equivalence_test_models(insight::get_parameters(x), range, ci, effects = "fixed", component = "conditional", parameters, verbose = FALSE)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+equivalence_test.bcplm <- function(x,
+ range = "default",
+ ci = 0.95,
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
+ out <- .equivalence_test_models(
+ insight::get_parameters(x),
+ range,
+ ci,
+ effects = "fixed",
+ component = "conditional",
+ parameters,
+ verbose = verbose
+ )
+
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -321,9 +385,24 @@ equivalence_test.bayesQR <- equivalence_test.bcplm
#' @export
-equivalence_test.bamlss <- function(x, range = "default", ci = 0.95, component = c("all", "conditional", "location"), parameters = NULL, verbose = TRUE, ...) {
+equivalence_test.bamlss <- function(x,
+ range = "default",
+ ci = 0.95,
+ component = c("all", "conditional", "location"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
component <- match.arg(component)
- out <- .equivalence_test_models(insight::get_parameters(x, component = component), range, ci, effects = "fixed", component = "conditional", parameters, verbose = FALSE)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ out <- .equivalence_test_models(
+ insight::get_parameters(x, component = component),
+ range,
+ ci,
+ effects = "fixed",
+ component = "conditional",
+ parameters,
+ verbose = verbose
+ )
+
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
diff --git a/R/estimate_density.R b/R/estimate_density.R
index e2137ad..6abe9da 100644
--- a/R/estimate_density.R
+++ b/R/estimate_density.R
@@ -16,7 +16,7 @@
#'
#' @note There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
#'
-#' @examples
+#' @examplesIf requireNamespace("logspline", quietly = TRUE) && requireNamespace("KernSmooth", quietly = TRUE) && requireNamespace("mclust", quietly = TRUE)
#' library(bayestestR)
#'
#' set.seed(1)
@@ -87,9 +87,9 @@ estimate_density <- function(x, ...) {
#' @export
estimate_density.default <- function(x, ...) {
- stop(insight::format_message(
+ insight::format_error(
paste0("`estimate_density()` is not yet implemented for objects of class `", class(x)[1], "`.")
- ), call. = FALSE)
+ )
}
@@ -111,7 +111,10 @@ estimate_density.default <- function(x, ...) {
x <- x[!is.na(x)]
if (length(x) < 2) {
- return(stats::setNames(data.frame(matrix(ncol = 3, nrow = 0)), c("Parameter", "x", "y")))
+ return(stats::setNames(
+ data.frame(matrix(ncol = 3, nrow = 0)),
+ c("Parameter", "x", "y")
+ ))
}
# Range
@@ -138,7 +141,7 @@ estimate_density.default <- function(x, ...) {
} else if (method %in% c("mixture", "mclust")) {
kde <- .estimate_density_mixture(x, x_range, precision, ...)
} else {
- stop("method should be one of 'kernel', 'logspline', 'KernSmooth' or 'mixture'.", call. = FALSE)
+ insight::format_error("method should be one of 'kernel', 'logspline', 'KernSmooth' or 'mixture'.")
}
kde
}
@@ -164,17 +167,17 @@ estimate_density.numeric <- function(x,
# TODO remove deprecation warning
# Sanity
if (!is.null(group_by)) {
- warning(insight::format_message(
+ insight::format_warning(
"The `group_by` argument is deprecated and might be removed in a future update. Please replace by `at`."
- ), call. = FALSE)
+ )
at <- group_by
}
if (!is.null(at)) {
if (length(at) == 1) {
- stop(insight::format_message(
+ insight::format_error(
"`at` must be either the name of a group column if a data frame is entered as input, or in this case (where a single vector was passed) a vector of same length."
- ), call. = FALSE)
+ )
}
out <- estimate_density(
data.frame(V1 = x, Group = at, stringsAsFactors = FALSE),
@@ -190,7 +193,16 @@ estimate_density.numeric <- function(x,
out$Parameter <- NULL
return(out)
}
- out <- .estimate_density(x, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, ...)
+ out <- .estimate_density(
+ x,
+ method = method,
+ precision = precision,
+ extend = extend,
+ extend_scale = extend_scale,
+ bw = bw,
+ ci = ci,
+ ...
+ )
class(out) <- .set_density_class(out)
out
}
@@ -201,16 +213,36 @@ estimate_density.numeric <- function(x,
#' @rdname estimate_density
#' @export
-estimate_density.data.frame <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", ci = NULL, select = NULL, at = NULL, group_by = NULL, ...) {
+estimate_density.data.frame <- function(x,
+ method = "kernel",
+ precision = 2^10,
+ extend = FALSE,
+ extend_scale = 0.1,
+ bw = "SJ",
+ ci = NULL,
+ select = NULL,
+ at = NULL,
+ group_by = NULL,
+ ...) {
# Sanity
if (!is.null(group_by)) {
- warning(insight::format_message("The 'group_by' argument is deprecated and might be removed in a future update. Please replace by 'at'."), call. = FALSE)
+ insight::format_warning("The 'group_by' argument is deprecated and might be removed in a future update. Please replace by 'at'.")
at <- group_by
}
if (is.null(at)) {
# No grouping -------------------
- out <- .estimate_density_df(x = x, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, select = select, ...)
+ out <- .estimate_density_df(
+ x = x,
+ method = method,
+ precision = precision,
+ extend = extend,
+ extend_scale = extend_scale,
+ bw = bw,
+ ci = ci,
+ select = select,
+ ...
+ )
} else {
# Deal with at- grouping --------
@@ -219,7 +251,17 @@ estimate_density.data.frame <- function(x, method = "kernel", precision = 2^10,
for (row in seq_len(nrow(groups))) {
subdata <- datawizard::data_match(x, groups[row, , drop = FALSE])
subdata[names(groups)] <- NULL
- subdata <- .estimate_density_df(subdata, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, select = select, ...)
+ subdata <- .estimate_density_df(
+ subdata,
+ method = method,
+ precision = precision,
+ extend = extend,
+ extend_scale = extend_scale,
+ bw = bw,
+ ci = ci,
+ select = select,
+ ...
+ )
out <- rbind(out, merge(subdata, groups[row, , drop = FALSE]))
}
}
@@ -259,7 +301,7 @@ estimate_density.rvar <- estimate_density.draws
out <- sapply(x, estimate_density, method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ci = ci, simplify = FALSE)
for (i in names(out)) {
if (nrow(out[[i]]) == 0) {
- warning(insight::format_message(paste0("'", i, "', or one of its 'at' groups, is empty and has no density information.")), call. = FALSE)
+ insight::format_warning(paste0("'", i, "', or one of its 'at' groups, is empty and has no density information."))
} else {
out[[i]]$Parameter <- i
}
@@ -311,7 +353,7 @@ estimate_density.stanreg <- function(x, method = "kernel", precision = 2^10, ext
component <- match.arg(component)
out <- estimate_density(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- .set_density_class(out)
out
@@ -331,7 +373,7 @@ estimate_density.brmsfit <- function(x, method = "kernel", precision = 2^10, ext
component <- match.arg(component)
out <- estimate_density(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- .set_density_class(out)
out
@@ -344,7 +386,7 @@ estimate_density.brmsfit <- function(x, method = "kernel", precision = 2^10, ext
estimate_density.MCMCglmm <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", parameters = NULL, ...) {
nF <- x$Fixed$nfl
out <- estimate_density(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- .set_density_class(out)
out
@@ -356,7 +398,7 @@ estimate_density.MCMCglmm <- function(x, method = "kernel", precision = 2^10, ex
#' @export
estimate_density.mcmc <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", parameters = NULL, ...) {
out <- estimate_density(insight::get_parameters(x, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- .set_density_class(out)
out
@@ -379,10 +421,26 @@ estimate_density.mcmc.list <- estimate_density.mcmc
#' @export
-estimate_density.bamlss <- function(x, method = "kernel", precision = 2^10, extend = FALSE, extend_scale = 0.1, bw = "SJ", component = c("all", "conditional", "location"), parameters = NULL, ...) {
+estimate_density.bamlss <- function(x,
+ method = "kernel",
+ precision = 2^10,
+ extend = FALSE,
+ extend_scale = 0.1,
+ bw = "SJ",
+ component = c("all", "conditional", "location"),
+ parameters = NULL,
+ ...) {
component <- match.arg(component)
- out <- estimate_density(insight::get_parameters(x, component = component, parameters = parameters), method = method, precision = precision, extend = extend, extend_scale = extend_scale, bw = bw, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ out <- estimate_density(
+ insight::get_parameters(x, component = component, parameters = parameters),
+ method = method,
+ precision = precision,
+ extend = extend,
+ extend_scale = extend_scale,
+ bw = bw,
+ ...
+ )
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- .set_density_class(out)
out
@@ -445,7 +503,7 @@ density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) {
to = x_range[2]
))
fun <- get("density", asNamespace("stats"))
- kde <- do.call("fun", args)
+ kde <- suppressWarnings(do.call("fun", args))
df <- as.data.frame(kde)
# Get CI (https://bookdown.org/egarpor/NP-UC3M/app-kde-ci.html)
@@ -491,12 +549,18 @@ density_at <- function(posterior, x, precision = 2^10, method = "kernel", ...) {
# helper ----------------------------------------------------------
.set_density_df_class <- function(out) {
- setdiff(unique(c("estimate_density_df", "see_estimate_density_df", class(out))), c("estimate_density", "see_estimate_density"))
+ setdiff(
+ unique(c("estimate_density_df", "see_estimate_density_df", class(out))),
+ c("estimate_density", "see_estimate_density")
+ )
}
.set_density_class <- function(out) {
if (is.null(out)) {
return(NULL)
}
- setdiff(unique(c("estimate_density", "see_estimate_density", class(out))), c("estimate_density_df", "see_estimate_density_df"))
+ setdiff(
+ unique(c("estimate_density", "see_estimate_density", class(out))),
+ c("estimate_density_df", "see_estimate_density_df")
+ )
}
diff --git a/R/eti.R b/R/eti.R
index 712755d..869fb04 100644
--- a/R/eti.R
+++ b/R/eti.R
@@ -1,6 +1,10 @@
#' Equal-Tailed Interval (ETI)
#'
-#' Compute the **Equal-Tailed Interval (ETI)** of posterior distributions using the quantiles method. The probability of being below this interval is equal to the probability of being above it. The ETI can be used in the context of uncertainty characterisation of posterior distributions as **Credible Interval (CI)**.
+#' Compute the **Equal-Tailed Interval (ETI)** of posterior distributions using
+#' the quantiles method. The probability of being below this interval is equal
+#' to the probability of being above it. The ETI can be used in the context of
+#' uncertainty characterisation of posterior distributions as
+#' **Credible Interval (CI)**.
#'
#' @inheritParams hdi
#' @inherit ci return
@@ -13,16 +17,16 @@
#'
#' posterior <- rnorm(1000)
#' eti(posterior)
-#' eti(posterior, ci = c(.80, .89, .95))
+#' eti(posterior, ci = c(0.80, 0.89, 0.95))
#'
#' df <- data.frame(replicate(4, rnorm(100)))
#' eti(df)
-#' eti(df, ci = c(.80, .89, .95))
+#' eti(df, ci = c(0.80, 0.89, 0.95))
#' \dontrun{
#' library(rstanarm)
#' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0)
#' eti(model)
-#' eti(model, ci = c(.80, .89, .95))
+#' eti(model, ci = c(0.80, 0.89, 0.95))
#'
#' library(emmeans)
#' eti(emtrends(model, ~1, "wt"))
@@ -30,12 +34,12 @@
#' library(brms)
#' model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
#' eti(model)
-#' eti(model, ci = c(.80, .89, .95))
+#' eti(model, ci = c(0.80, 0.89, 0.95))
#'
#' library(BayesFactor)
#' bf <- ttestBF(x = rnorm(100, 1, 1))
#' eti(bf)
-#' eti(bf, ci = c(.80, .89, .95))
+#' eti(bf, ci = c(0.80, 0.89, 0.95))
#' }
#'
#' @export
@@ -46,7 +50,7 @@ eti <- function(x, ...) {
#' @export
eti.default <- function(x, ...) {
- stop(insight::format_message(paste0("'eti()' is not yet implemented for objects of class '", class(x)[1], "'.")), call. = FALSE)
+ insight::format_error(paste0("'eti()' is not yet implemented for objects of class '", class(x)[1], "'."))
}
@@ -66,7 +70,7 @@ eti.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
eti.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "eti")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -75,7 +79,7 @@ eti.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
eti.draws <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "eti")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -89,7 +93,7 @@ eti.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) {
nF <- x$Fixed$nfl
d <- as.data.frame(x$Sol[, 1:nF, drop = FALSE])
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -99,7 +103,7 @@ eti.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) {
eti.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) {
d <- as.data.frame(x)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -110,7 +114,7 @@ eti.bamlss <- function(x, ci = 0.95, component = c("all", "conditional", "locati
component <- match.arg(component)
d <- insight::get_parameters(x, component = component)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -120,7 +124,7 @@ eti.bamlss <- function(x, ci = 0.95, component = c("all", "conditional", "locati
eti.bcplm <- function(x, ci = 0.95, verbose = TRUE, ...) {
d <- insight::get_parameters(x)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = "eti")
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -139,9 +143,21 @@ eti.BGGM <- eti.bcplm
#' @export
-eti.sim.merMod <- function(x, ci = 0.95, effects = c("fixed", "random", "all"), parameters = NULL, verbose = TRUE, ...) {
+eti.sim.merMod <- function(x,
+ ci = 0.95,
+ effects = c("fixed", "random", "all"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
effects <- match.arg(effects)
- dat <- .compute_interval_simMerMod(x = x, ci = ci, effects = effects, parameters = parameters, verbose = verbose, fun = "eti")
+ dat <- .compute_interval_simMerMod(
+ x = x,
+ ci = ci,
+ effects = effects,
+ parameters = parameters,
+ verbose = verbose,
+ fun = "eti"
+ )
out <- dat$result
attr(out, "data") <- dat$data
out
@@ -162,7 +178,7 @@ eti.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) {
xdf <- insight::get_parameters(x)
dat <- eti(xdf, ci = ci, verbose = verbose, ...)
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -179,13 +195,18 @@ eti.stanreg <- function(x, ci = 0.95, effects = c("fixed", "random", "all"),
component <- match.arg(component)
out <- .prepare_output(
- eti(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), ci = ci, verbose = verbose, ...),
+ eti(
+ insight::get_parameters(x, effects = effects, component = component, parameters = parameters),
+ ci = ci,
+ verbose = verbose,
+ ...
+ ),
insight::clean_parameters(x),
inherits(x, "stanmvreg")
)
class(out) <- unique(c("bayestestR_eti", "see_eti", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -207,12 +228,17 @@ eti.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"),
component <- match.arg(component)
out <- .prepare_output(
- eti(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), ci = ci, verbose = verbose, ...),
+ eti(
+ insight::get_parameters(x, effects = effects, component = component, parameters = parameters),
+ ci = ci,
+ verbose = verbose,
+ ...
+ ),
insight::clean_parameters(x)
)
class(out) <- unique(c("bayestestR_eti", "see_eti", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -220,7 +246,7 @@ eti.brmsfit <- function(x, ci = 0.95, effects = c("fixed", "random", "all"),
#' @export
eti.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) {
out <- eti(insight::get_parameters(x), ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -230,9 +256,9 @@ eti.get_predicted <- function(x, ...) {
if ("iterations" %in% names(attributes(x))) {
out <- eti(as.data.frame(t(attributes(x)$iterations)), ...)
} else {
- stop("No iterations present in the output.", call. = FALSE)
+ insight::format_error("No iterations present in the output.")
}
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
diff --git a/R/format.R b/R/format.R
index cb50fa7..f9bb2a3 100644
--- a/R/format.R
+++ b/R/format.R
@@ -18,7 +18,7 @@ format.describe_posterior <- function(x,
out <- insight::format_table(x, digits = digits, format = format, ...)
# different CI-types as column names?
- if (ci_string != "CI" && any(grepl("CI$", colnames(out)))) {
+ if (ci_string != "CI" && any(endsWith(colnames(out), "CI"))) {
colnames(out) <- gsub("(.*)CI$", paste0("\\1", ci_string), colnames(out))
}
@@ -172,9 +172,9 @@ format.bayesfactor_inclusion <- function(x,
# footer
if (is.null(format) || format == "text") {
footer <- list(
- c("\n* Compared among: "),
+ "\n* Compared among: ",
c(if (matched) "matched models only" else "all models", "cyan"),
- c("\n* Priors odds: "),
+ "\n* Priors odds: ",
c(if (!is.null(priorOdds)) "custom" else "uniform-equal", "cyan"),
if (log) c("\n\nBayes Factors are on the log-scale.", "red")
)
@@ -220,7 +220,7 @@ format.bayesfactor_restricted <- function(x,
# footer
if (is.null(format) || format == "text") {
footer <- list(
- c("\n* Bayes factors for the restricted model vs. the un-restricted model.\n"),
+ "\n* Bayes factors for the restricted model vs. the un-restricted model.\n",
if (log) c("\nBayes Factors are on the log-scale.\n", "red")
)
# color formatting for caption
@@ -287,17 +287,18 @@ format.bayesfactor_parameters <- function(x,
# footer
if (is.null(format) || format == "text") {
footer <- list(
- c("\n* Evidence Against The Null: "),
- c(null, "cyan"),
- if (direction) c("\n* Direction: "),
+ "\n* Evidence Against The Null: ",
+ c(paste0(null, "\n"), "cyan"),
+ if (direction) "* Direction: ",
if (direction < 0) c("Left-Sided test", "cyan"),
if (direction > 0) c("Right-Sided test", "cyan"),
+ if (direction) "\n",
if (log) c("\n\nBayes Factors are on the log-scale.\n", "red")
)
} else {
footer <- insight::compact_list(list(
paste0("Evidence Against The Null: ", null),
- if (direction) c("Direction: "),
+ if (direction) "Direction: ",
if (direction < 0) "Left-Sided test",
if (direction > 0) "Right-Sided test",
if (log) "Bayes Factors are on the log-scale."
diff --git a/R/hdi.R b/R/hdi.R
index 9e77272..5db2d46 100644
--- a/R/hdi.R
+++ b/R/hdi.R
@@ -82,7 +82,7 @@
#' library(bayestestR)
#'
#' posterior <- rnorm(1000)
-#' hdi(posterior, ci = .89)
+#' hdi(posterior, ci = 0.89)
#' hdi(posterior, ci = c(.80, .90, .95))
#'
#' df <- data.frame(replicate(4, rnorm(100)))
@@ -107,7 +107,7 @@
#' hdi(bf)
#' hdi(bf, ci = c(.80, .90, .95))
#' }
-#' @author Credits go to [ggdistribute](https://rdrr.io/cran/ggdistribute/src/R/stats.R) and [HDInterval](https://github.com/mikemeredith/HDInterval).
+#' @author Credits go to **ggdistribute** and [**HDInterval**](https://github.com/mikemeredith/HDInterval).
#'
#' @references \itemize{
#' \item Kruschke, J. (2014). Doing Bayesian data analysis: A tutorial with R, JAGS, and Stan. Academic Press.
@@ -122,7 +122,7 @@ hdi <- function(x, ...) {
#' @export
hdi.default <- function(x, ...) {
- stop(insight::format_message(paste0("'hdi()' is not yet implemented for objects of class '", class(x)[1], "'.")), call. = FALSE)
+ insight::format_error(paste0("'hdi()' is not yet implemented for objects of class '", class(x)[1], "'."))
}
@@ -142,7 +142,7 @@ hdi.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
hdi.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "hdi")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -150,7 +150,7 @@ hdi.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
hdi.draws <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = .posterior_draws_to_df(x), ci = ci, verbose = verbose, fun = "hdi")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -164,7 +164,7 @@ hdi.MCMCglmm <- function(x, ci = 0.95, verbose = TRUE, ...) {
nF <- x$Fixed$nfl
d <- as.data.frame(x$Sol[, 1:nF, drop = FALSE])
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun)
- attr(dat, "data") <- deparse(substitute(x), width.cutoff = 500)
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -180,7 +180,7 @@ hdi.bamlss <- function(x,
d <- insight::get_parameters(x, component = component)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun)
dat <- .add_clean_parameters_attribute(dat, x)
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -190,7 +190,7 @@ hdi.mcmc <- function(x, ci = 0.95, verbose = TRUE, ...) {
ci_fun <- .check_ci_fun(list(...))
d <- as.data.frame(x)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun)
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -200,7 +200,7 @@ hdi.bcplm <- function(x, ci = 0.95, verbose = TRUE, ...) {
ci_fun <- .check_ci_fun(list(...))
d <- insight::get_parameters(x)
dat <- .compute_interval_dataframe(x = d, ci = ci, verbose = verbose, fun = ci_fun)
- attr(dat, "data") <- insight::safe_deparse(substitute(x))
+ attr(dat, "data") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -260,7 +260,7 @@ hdi.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) {
hdi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) {
xdf <- insight::get_parameters(x)
out <- hdi(xdf, ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -298,7 +298,7 @@ hdi.stanreg <- function(x,
)
attr(out, "clean_parameters") <- cleaned_parameters
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- unique(c("bayestestR_hdi", "see_hdi", class(out)))
out
}
@@ -339,7 +339,7 @@ hdi.brmsfit <- function(x,
)
attr(out, "clean_parameters") <- cleaned_parameters
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- unique(c("bayestestR_hdi", "see_hdi", class(out)))
out
}
@@ -348,7 +348,7 @@ hdi.brmsfit <- function(x,
#' @export
hdi.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) {
out <- hdi(insight::get_parameters(x), ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -358,9 +358,9 @@ hdi.get_predicted <- function(x, ...) {
if ("iterations" %in% names(attributes(x))) {
out <- hdi(as.data.frame(t(attributes(x)$iterations)), ...)
} else {
- stop("No iterations present in the output.", call. = FALSE)
+ insight::format_error("No iterations present in the output.")
}
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -383,7 +383,7 @@ hdi.get_predicted <- function(x, ...) {
if (window_size < 2) {
if (verbose) {
- warning("`ci` is too small or x does not contain enough data points, returning NAs.", call. = FALSE)
+ insight::format_warning("`ci` is too small or x does not contain enough data points, returning NAs.")
}
return(data.frame(
"CI" = ci,
@@ -396,7 +396,7 @@ hdi.get_predicted <- function(x, ...) {
if (nCIs < 1) {
if (verbose) {
- warning("`ci` is too large or x does not contain enough data points, returning NAs.", call. = FALSE)
+ insight::format_warning("`ci` is too large or x does not contain enough data points, returning NAs.")
}
return(data.frame(
"CI" = ci,
@@ -414,7 +414,7 @@ hdi.get_predicted <- function(x, ...) {
if (n_candies > 1) {
if (any(diff(sort(min_i)) != 1)) {
if (verbose) {
- warning("Identical densities found along different segments of the distribution, choosing rightmost.", call. = FALSE)
+ insight::format_warning("Identical densities found along different segments of the distribution, choosing rightmost.")
}
min_i <- max(min_i)
} else {
diff --git a/R/map_estimate.R b/R/map_estimate.R
index 9261f5b..8b2bf23 100644
--- a/R/map_estimate.R
+++ b/R/map_estimate.R
@@ -96,14 +96,14 @@ map_estimate.mcmc.list <- map_estimate.bayesQR
out <- data.frame(
Parameter = colnames(x),
- MAP_Estimate = unlist(l),
+ MAP_Estimate = unlist(l, use.names = FALSE),
stringsAsFactors = FALSE,
row.names = NULL
)
out <- .add_clean_parameters_attribute(out, x)
attr(out, "MAP_density") <- sapply(l, attr, "MAP_density")
- attr(out, "object_name") <- deparse(substitute(x), width.cutoff = 500)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
attr(out, "centrality") <- "map"
class(out) <- unique(c("map_estimate", "see_point_estimate", class(out)))
out
@@ -174,7 +174,7 @@ map_estimate.get_predicted <- function(x, ...) {
if ("iterations" %in% names(attributes(x))) {
map_estimate(as.data.frame(t(attributes(x)$iterations)), ...)
} else {
- stop("No iterations present in the output.", call. = FALSE)
+ insight::format_error("No iterations present in the output.")
}
}
diff --git a/R/mediation.R b/R/mediation.R
index fa54096..04c4dbb 100644
--- a/R/mediation.R
+++ b/R/mediation.R
@@ -108,8 +108,8 @@
#' )
#'
#' summary(m1)
-#' mediation(m2, centrality = "mean", ci = .95)
-#' mediation(m3, centrality = "mean", ci = .95)
+#' mediation(m2, centrality = "mean", ci = 0.95)
+#' mediation(m3, centrality = "mean", ci = 0.95)
#' }
#' @export
mediation <- function(model, ...) {
@@ -345,7 +345,7 @@ print.bayestestR_mediation <- function(x, digits = 3, ...) {
cat(insight::export_table(x, digits = digits))
cat("\n")
- prop_mediated[] <- lapply(prop_mediated, function(i) insight::format_value(i, as_percent = TRUE))
+ prop_mediated[] <- lapply(prop_mediated, insight::format_value, as_percent = TRUE)
insight::print_color(
sprintf(
"Proportion mediated: %s [%s, %s]\n",
diff --git a/R/p_direction.R b/R/p_direction.R
index 9ec1960..99e553f 100644
--- a/R/p_direction.R
+++ b/R/p_direction.R
@@ -137,7 +137,7 @@ pd <- p_direction
#' @export
p_direction.default <- function(x, ...) {
- stop(insight::format_message(paste0("'p_direction()' is not yet implemented for objects of class '", class(x)[1], "'.")), call. = FALSE)
+ insight::format_error(paste0("'p_direction()' is not yet implemented for objects of class '", class(x)[1], "'."))
}
@@ -187,7 +187,7 @@ p_direction.parameters_model <- function(x, ...) {
out$Component <- x$Component
}
- attr(out, "object_name") <- deparse(substitute(x), width.cutoff = 500)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- unique(c("p_direction", "see_p_direction", class(out)))
out
@@ -197,7 +197,7 @@ p_direction.parameters_model <- function(x, ...) {
#' @rdname p_direction
#' @export
p_direction.data.frame <- function(x, method = "direct", null = 0, ...) {
- obj_name <- insight::safe_deparse(substitute(x))
+ obj_name <- insight::safe_deparse_symbol(substitute(x))
x <- .select_nums(x)
if (ncol(x) == 1) {
@@ -238,7 +238,7 @@ p_direction.MCMCglmm <- function(x, method = "direct", null = 0, ...) {
null = null,
...
)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -294,7 +294,7 @@ p_direction.emmGrid <- function(x, method = "direct", null = 0, ...) {
xdf <- insight::get_parameters(x)
out <- p_direction(xdf, method = method, null = null, ...)
- attr(out, "object_name") <- deparse(substitute(x), width.cutoff = 500)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -400,7 +400,7 @@ p_direction.stanreg <- function(x,
attr(out, "clean_parameters") <- cleaned_parameters
class(out) <- unique(c("p_direction", "see_p_direction", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -441,7 +441,7 @@ p_direction.brmsfit <- function(x,
attr(out, "clean_parameters") <- cleaned_parameters
class(out) <- unique(c("p_direction", "see_p_direction", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -450,7 +450,7 @@ p_direction.brmsfit <- function(x,
#' @export
p_direction.BFBayesFactor <- function(x, method = "direct", null = 0, ...) {
out <- p_direction(insight::get_parameters(x), method = method, null = null, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -461,7 +461,7 @@ p_direction.get_predicted <- function(x, ...) {
} else {
stop("No iterations present in the output.", call. = FALSE)
}
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -474,7 +474,7 @@ p_direction.get_predicted <- function(x, ...) {
#' @method as.numeric p_direction
#' @export
as.numeric.p_direction <- function(x, ...) {
- if ("data.frame" %in% class(x)) {
+ if (inherits(x, "data.frame")) {
return(as.numeric(as.vector(x$pd)))
} else {
return(as.vector(x))
diff --git a/R/p_map.R b/R/p_map.R
index 550386f..6b69b2c 100644
--- a/R/p_map.R
+++ b/R/p_map.R
@@ -1,6 +1,10 @@
#' Bayesian p-value based on the density at the Maximum A Posteriori (MAP)
#'
-#' Compute a Bayesian equivalent of the *p*-value, related to the odds that a parameter (described by its posterior distribution) has against the null hypothesis (*h0*) using Mills' (2014, 2017) *Objective Bayesian Hypothesis Testing* framework. It corresponds to the density value at 0 divided by the density at the Maximum A Posteriori (MAP).
+#' Compute a Bayesian equivalent of the *p*-value, related to the odds that a
+#' parameter (described by its posterior distribution) has against the null
+#' hypothesis (*h0*) using Mills' (2014, 2017) *Objective Bayesian Hypothesis
+#' Testing* framework. It corresponds to the density value at the null (e.g., 0)
+#' divided by the density at the Maximum A Posteriori (MAP).
#'
#' @details Note that this method is sensitive to the density estimation `method` (see the section in the examples below).
#' \subsection{Strengths and Limitations}{
@@ -11,6 +15,7 @@
#'
#' @inheritParams hdi
#' @inheritParams density_at
+#' @inheritParams pd
#'
#' @examples
#' library(bayestestR)
@@ -61,7 +66,7 @@
#' }
#'
#' @export
-p_map <- function(x, precision = 2^10, method = "kernel", ...) {
+p_map <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
UseMethod("p_map")
}
@@ -72,12 +77,12 @@ p_pointnull <- p_map
#' @export
-p_map.numeric <- function(x, precision = 2^10, method = "kernel", ...) {
+p_map.numeric <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
# Density at MAP
map <- attributes(map_estimate(x, precision = precision, method = method, ...))$MAP_density
# Density at 0
- d_0 <- density_at(x, 0, precision = precision, method = method, ...)
+ d_0 <- density_at(x, null, precision = precision, method = method, ...)
if (is.na(d_0)) d_0 <- 0
# Odds
@@ -89,13 +94,13 @@ p_map.numeric <- function(x, precision = 2^10, method = "kernel", ...) {
#' @export
-p_map.data.frame <- function(x, precision = 2^10, method = "kernel", ...) {
+p_map.data.frame <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
x <- .select_nums(x)
if (ncol(x) == 1) {
- p_MAP <- p_map(x[, 1], precision = precision, method = method, ...)
+ p_MAP <- p_map(x[, 1], null = null, precision = precision, method = method, ...)
} else {
- p_MAP <- sapply(x, p_map, precision = precision, method = method, simplify = TRUE, ...)
+ p_MAP <- sapply(x, p_map, null = null, precision = precision, method = method, simplify = TRUE, ...)
}
out <- data.frame(
@@ -111,8 +116,8 @@ p_map.data.frame <- function(x, precision = 2^10, method = "kernel", ...) {
#' @export
-p_map.draws <- function(x, precision = 2^10, method = "kernel", ...) {
- p_map(.posterior_draws_to_df(x), precision = precision, method = method, ...)
+p_map.draws <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
+ p_map(.posterior_draws_to_df(x), null = null, precision = precision, method = method, ...)
}
#' @export
@@ -121,11 +126,11 @@ p_map.rvar <- p_map.draws
#' @export
-p_map.emmGrid <- function(x, precision = 2^10, method = "kernel", ...) {
+p_map.emmGrid <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
xdf <- insight::get_parameters(x)
- out <- p_map(xdf, precision = precision, method = method, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ out <- p_map(xdf, null = null, precision = precision, method = method, ...)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -136,17 +141,29 @@ p_map.emm_list <- p_map.emmGrid
#' @keywords internal
-.p_map_models <- function(x, precision, method, effects, component, parameters, ...) {
- p_map(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), precision = precision, method = method, ...)
+.p_map_models <- function(x, null, precision, method, effects, component, parameters, ...) {
+ p_map(
+ insight::get_parameters(
+ x,
+ effects = effects,
+ component = component,
+ parameters = parameters
+ ),
+ null = null,
+ precision = precision,
+ method = method,
+ ...
+ )
}
#' @export
-p_map.mcmc <- function(x, precision = 2^10, method = "kernel", parameters = NULL, ...) {
+p_map.mcmc <- function(x, null = 0, precision = 2^10, method = "kernel", parameters = NULL, ...) {
out <- .p_map_models(
x = x,
+ null = null,
precision = precision,
method = method,
effects = "fixed",
@@ -175,10 +192,12 @@ p_map.BGGM <- p_map.mcmc
#' @export
-p_map.bamlss <- function(x, precision = 2^10, method = "kernel", component = c("all", "conditional", "location"), parameters = NULL, ...) {
+p_map.bamlss <- function(x, null = 0, precision = 2^10, method = "kernel",
+ component = c("all", "conditional", "location"), parameters = NULL, ...) {
component <- match.arg(component)
out <- .p_map_models(
x = x,
+ null = null,
precision = precision,
method = method,
effects = "all",
@@ -195,11 +214,13 @@ p_map.bamlss <- function(x, precision = 2^10, method = "kernel", component = c("
#' @export
-p_map.sim.merMod <- function(x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), parameters = NULL, ...) {
+p_map.sim.merMod <- function(x, null = 0, precision = 2^10, method = "kernel",
+ effects = c("fixed", "random", "all"), parameters = NULL, ...) {
effects <- match.arg(effects)
out <- .p_map_models(
x = x,
+ null = null,
precision = precision,
method = method,
effects = effects,
@@ -216,9 +237,11 @@ p_map.sim.merMod <- function(x, precision = 2^10, method = "kernel", effects = c
#' @export
-p_map.sim <- function(x, precision = 2^10, method = "kernel", parameters = NULL, ...) {
+p_map.sim <- function(x, null = 0, precision = 2^10, method = "kernel",
+ parameters = NULL, ...) {
out <- .p_map_models(
x = x,
+ null = null,
precision = precision,
method = method,
effects = "fixed",
@@ -236,20 +259,33 @@ p_map.sim <- function(x, precision = 2^10, method = "kernel", parameters = NULL,
#' @rdname p_map
#' @export
-p_map.stanreg <- function(x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) {
+p_map.stanreg <- function(x, null = 0, precision = 2^10, method = "kernel",
+ effects = c("fixed", "random", "all"),
+ component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ parameters = NULL, ...) {
effects <- match.arg(effects)
component <- match.arg(component)
cleaned_parameters <- insight::clean_parameters(x)
out <- .prepare_output(
- p_map(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), precision = precision, method = method),
+ p_map(
+ insight::get_parameters(
+ x,
+ effects = effects,
+ component = component,
+ parameters = parameters
+ ),
+ null = null,
+ precision = precision,
+ method = method
+ ),
cleaned_parameters,
inherits(x, "stanmvreg")
)
attr(out, "clean_parameters") <- cleaned_parameters
class(out) <- unique(c("p_map", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -264,19 +300,33 @@ p_map.blavaan <- p_map.stanreg
#' @rdname p_map
#' @export
-p_map.brmsfit <- function(x, precision = 2^10, method = "kernel", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) {
+p_map.brmsfit <- function(x, null = 0, precision = 2^10, method = "kernel",
+ effects = c("fixed", "random", "all"),
+ component = c("conditional", "zi", "zero_inflated", "all"),
+ parameters = NULL, ...) {
effects <- match.arg(effects)
component <- match.arg(component)
cleaned_parameters <- insight::clean_parameters(x)
out <- .prepare_output(
- p_map(insight::get_parameters(x, effects = effects, component = component, parameters = parameters), precision = precision, method = method, ...),
+ p_map(
+ insight::get_parameters(
+ x,
+ effects = effects,
+ component = component,
+ parameters = parameters
+ ),
+ null = null,
+ precision = precision,
+ method = method,
+ ...
+ ),
cleaned_parameters
)
attr(out, "clean_parameters") <- cleaned_parameters
class(out) <- unique(c("p_map", class(out)))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -285,28 +335,28 @@ p_map.brmsfit <- function(x, precision = 2^10, method = "kernel", effects = c("f
#' @export
-p_map.BFBayesFactor <- function(x, precision = 2^10, method = "kernel", ...) {
- out <- p_map(insight::get_parameters(x), precision = precision, method = method, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+p_map.BFBayesFactor <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
+ out <- p_map(insight::get_parameters(x), null = null, precision = precision, method = method, ...)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
#' @export
-p_map.MCMCglmm <- function(x, precision = 2^10, method = "kernel", ...) {
+p_map.MCMCglmm <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
nF <- x$Fixed$nfl
- out <- p_map(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), precision = precision, method = method, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ out <- p_map(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), null = null, precision = precision, method = method, ...)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
#' @export
-p_map.bayesQR <- function(x, precision = 2^10, method = "kernel", ...) {
- out <- p_map(insight::get_parameters(x), precision = precision, method = method, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+p_map.bayesQR <- function(x, null = 0, precision = 2^10, method = "kernel", ...) {
+ out <- p_map(insight::get_parameters(x), null = null, precision = precision, method = method, ...)
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -317,7 +367,7 @@ p_map.bayesQR <- function(x, precision = 2^10, method = "kernel", ...) {
#' @method as.numeric p_map
#' @export
as.numeric.p_map <- function(x, ...) {
- if ("data.frame" %in% class(x)) {
+ if (inherits(x, "data.frame")) {
return(as.numeric(as.vector(x$p_MAP)))
} else {
return(as.vector(x))
diff --git a/R/p_rope.R b/R/p_rope.R
index b5d0e3e..b602989 100644
--- a/R/p_rope.R
+++ b/R/p_rope.R
@@ -32,7 +32,7 @@ p_rope.default <- function(x, ...) {
#' @export
p_rope.numeric <- function(x, range = "default", ...) {
out <- .p_rope(rope(x, range = range, ci = 1, ...))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -55,7 +55,7 @@ p_rope.emmGrid <- function(x, range = "default", ...) {
xdf <- insight::get_parameters(x)
out <- p_rope(xdf, range = range)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -74,7 +74,7 @@ p_rope.MCMCglmm <- p_rope.numeric
p_rope.stanreg <- function(x, range = "default", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, ...) {
out <- .p_rope(rope(x, range = range, ci = 1, effects = effects, component = component, parameters = parameters, ...))
out <- .add_clean_parameters_attribute(out, x)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -90,7 +90,7 @@ p_rope.blavaan <- p_rope.stanreg
p_rope.brmsfit <- function(x, range = "default", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, ...) {
out <- .p_rope(rope(x, range = range, ci = 1, effects = effects, component = component, parameters = parameters, ...))
out <- .add_clean_parameters_attribute(out, x)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -102,7 +102,7 @@ p_rope.sim.merMod <- p_rope.stanreg
#' @export
p_rope.sim <- function(x, range = "default", parameters = NULL, ...) {
out <- .p_rope(rope(x, range = range, ci = 1, parameters = parameters, ...))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -111,14 +111,14 @@ p_rope.bamlss <- function(x, range = "default", component = c("all", "conditiona
component <- match.arg(component)
out <- .p_rope(rope(x, range = range, ci = 1, effects = "all", component = component, parameters = parameters, ...))
out <- .add_clean_parameters_attribute(out, x)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
#' @export
p_rope.mcmc <- function(x, range = "default", parameters = NULL, ...) {
out <- .p_rope(rope(x, range = range, ci = 1, parameters = parameters, ...))
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
diff --git a/R/p_significance.R b/R/p_significance.R
index ddb83a1..b627b43 100644
--- a/R/p_significance.R
+++ b/R/p_significance.R
@@ -50,7 +50,9 @@ p_significance <- function(x, ...) {
#' @export
p_significance.default <- function(x, ...) {
- stop(insight::format_message(paste0("'p_significance()' is not yet implemented for objects of class '", class(x)[1], "'.")), call. = FALSE)
+ insight::format_error(
+ paste0("'p_significance()' is not yet implemented for objects of class '", class(x)[1], "'.")
+ )
}
@@ -77,7 +79,7 @@ p_significance.numeric <- function(x, threshold = "default", ...) {
#' @export
p_significance.data.frame <- function(x, threshold = "default", ...) {
- obj_name <- insight::safe_deparse(substitute(x))
+ obj_name <- insight::safe_deparse_symbol(substitute(x))
threshold <- .select_threshold_ps(threshold = threshold)
x <- .select_nums(x)
@@ -116,25 +118,11 @@ p_significance.parameters_simulate_model <- function(x, threshold = "default", .
obj_name <- attr(x, "object_name")
if (!is.null(obj_name)) {
# first try, parent frame
- model <- tryCatch(
- {
- get(obj_name, envir = parent.frame())
- },
- error = function(e) {
- NULL
- }
- )
+ model <- .safe(get(obj_name, envir = parent.frame()))
if (is.null(model)) {
# second try, global env
- model <- tryCatch(
- {
- get(obj_name, envir = globalenv())
- },
- error = function(e) {
- NULL
- }
- )
+ model <- .safe(get(obj_name, envir = globalenv()))
}
}
threshold <- .select_threshold_ps(model = model, threshold = threshold)
@@ -148,7 +136,7 @@ p_significance.parameters_simulate_model <- function(x, threshold = "default", .
p_significance.MCMCglmm <- function(x, threshold = "default", ...) {
nF <- x$Fixed$nfl
out <- p_significance(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), threshold = threshold, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -156,7 +144,7 @@ p_significance.MCMCglmm <- function(x, threshold = "default", ...) {
#' @export
p_significance.BFBayesFactor <- function(x, threshold = "default", ...) {
out <- p_significance(insight::get_parameters(x), threshold = threshold, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -198,7 +186,7 @@ p_significance.emmGrid <- function(x, threshold = "default", ...) {
xdf <- insight::get_parameters(x)
out <- p_significance(xdf, threshold = threshold, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -209,10 +197,16 @@ p_significance.emm_list <- p_significance.emmGrid
#' @rdname p_significance
#' @export
-p_significance.stanreg <- function(x, threshold = "default", effects = c("fixed", "random", "all"), component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"), parameters = NULL, verbose = TRUE, ...) {
+p_significance.stanreg <- function(x,
+ threshold = "default",
+ effects = c("fixed", "random", "all"),
+ component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
effects <- match.arg(effects)
component <- match.arg(component)
- threshold <- .select_threshold_ps(model = x, threshold = threshold)
+ threshold <- .select_threshold_ps(model = x, threshold = threshold, verbose = verbose)
data <- p_significance(
insight::get_parameters(x, effects = effects, component = component, parameters = parameters),
@@ -224,7 +218,7 @@ p_significance.stanreg <- function(x, threshold = "default", effects = c("fixed"
attr(out, "clean_parameters") <- cleaned_parameters
attr(out, "threshold") <- threshold
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- class(data)
out
@@ -239,10 +233,16 @@ p_significance.blavaan <- p_significance.stanreg
#' @rdname p_significance
#' @export
-p_significance.brmsfit <- function(x, threshold = "default", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, ...) {
+p_significance.brmsfit <- function(x,
+ threshold = "default",
+ effects = c("fixed", "random", "all"),
+ component = c("conditional", "zi", "zero_inflated", "all"),
+ parameters = NULL,
+ verbose = TRUE,
+ ...) {
effects <- match.arg(effects)
component <- match.arg(component)
- threshold <- .select_threshold_ps(model = x, threshold = threshold)
+ threshold <- .select_threshold_ps(model = x, threshold = threshold, verbose = verbose)
data <- p_significance(
insight::get_parameters(x, effects = effects, component = component, parameters = parameters),
@@ -254,7 +254,7 @@ p_significance.brmsfit <- function(x, threshold = "default", effects = c("fixed"
attr(out, "clean_parameters") <- cleaned_parameters
attr(out, "threshold") <- threshold
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- class(data)
out
@@ -267,7 +267,7 @@ p_significance.brmsfit <- function(x, threshold = "default", effects = c("fixed"
#' @rdname as.numeric.p_direction
#' @export
as.numeric.p_significance <- function(x, ...) {
- if ("data.frame" %in% class(x)) {
+ if (inherits(x, "data.frame")) {
return(as.numeric(as.vector(x$ps)))
} else {
return(as.vector(x))
@@ -284,25 +284,25 @@ as.double.p_significance <- as.numeric.p_significance
# helpers --------------------------
#' @keywords internal
-.select_threshold_ps <- function(model = NULL, threshold = "default") {
+.select_threshold_ps <- function(model = NULL, threshold = "default", verbose = TRUE) {
# If a range is passed
if (length(threshold) > 1) {
if (length(unique(abs(threshold))) == 1) {
# If symmetric range
threshold <- abs(threshold[2])
} else {
- stop("`threshold` should be 'default' or a numeric value (e.g., 0.1).", call. = FALSE)
+ insight::format_error("`threshold` should be 'default' or a numeric value (e.g., 0.1).")
}
}
# If default
if (all(threshold == "default")) {
if (!is.null(model)) {
- threshold <- rope_range(model)[2]
+ threshold <- rope_range(model, verbose = verbose)[2]
} else {
threshold <- 0.1
}
} else if (!all(is.numeric(threshold))) {
- stop("`threshold` should be 'default' or a numeric value (e.g., 0.1).", call. = FALSE)
+ insight::format_error("`threshold` should be 'default' or a numeric value (e.g., 0.1).")
}
threshold
}
diff --git a/R/p_to_bf.R b/R/p_to_bf.R
index 988a008..aab96f5 100644
--- a/R/p_to_bf.R
+++ b/R/p_to_bf.R
@@ -60,11 +60,11 @@ p_to_bf.numeric <- function(x, log = FALSE, n_obs = NULL, ...) {
p <- x
# Validate n_obs
if (is.null(n_obs)) {
- stop("Argument `n_obs` must be specified.", call. = FALSE)
+ insight::format_error("Argument `n_obs` must be specified.")
} else if (length(n_obs) == 1L) {
n_obs <- rep(n_obs, times = length(p))
} else if (length(n_obs) != length(p)) {
- stop("`n_obs` must be of length 1 or same length as `p`.", call. = FALSE)
+ insight::format_error("`n_obs` must be of length 1 or same length as `p`.")
}
# Convert
@@ -112,7 +112,7 @@ p_to_bf.default <- function(x, log = FALSE, ...) {
n_obs <- list(...)$n_obs
}
} else {
- stop("Argument `x` must be a model object, or a numeric vector of p-values.", call. = FALSE)
+ insight::format_error("Argument `x` must be a model object, or a numeric vector of p-values.")
}
out <- p_to_bf(p, n_obs = n_obs, log = log)
diff --git a/R/point_estimate.R b/R/point_estimate.R
index 6766068..a9a2d1a 100644
--- a/R/point_estimate.R
+++ b/R/point_estimate.R
@@ -204,7 +204,7 @@ point_estimate.emmGrid <- function(x, centrality = "all", dispersion = FALSE, ..
xdf <- insight::get_parameters(x)
out <- point_estimate(xdf, centrality = centrality, dispersion = dispersion, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -236,7 +236,7 @@ point_estimate.stanreg <- function(x, centrality = "all", dispersion = FALSE, ef
inherits(x, "stanmvreg")
)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
attr(out, "centrality") <- centrality
attr(out, "clean_parameters") <- cleaned_parameters
class(out) <- unique(c("point_estimate", "see_point_estimate", class(out)))
@@ -263,7 +263,7 @@ point_estimate.brmsfit <- function(x, centrality = "all", dispersion = FALSE, ef
cleaned_parameters
)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
attr(out, "centrality") <- centrality
attr(out, "clean_parameters") <- cleaned_parameters
class(out) <- unique(c("point_estimate", "see_point_estimate", class(out)))
@@ -319,7 +319,7 @@ point_estimate.sim <- function(x, centrality = "all", dispersion = FALSE, parame
#' @export
point_estimate.BFBayesFactor <- function(x, centrality = "all", dispersion = FALSE, ...) {
out <- point_estimate(insight::get_parameters(x), centrality = centrality, dispersion = dispersion, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
attr(out, "centrality") <- centrality
class(out) <- unique(c("point_estimate", "see_point_estimate", class(out)))
diff --git a/R/print.R b/R/print.R
index e776359..2a323d2 100644
--- a/R/print.R
+++ b/R/print.R
@@ -171,7 +171,7 @@ print.bayesfactor_models <- function(x,
log = log,
show_names = show_names,
caption = caption,
- align = c("llr"),
+ align = "llr",
...
)
}
@@ -260,7 +260,7 @@ print.bayesfactor_parameters <- function(x, digits = 3, log = FALSE, ...) {
caption <- attr(formatted_table, "table_caption")
# if we have no useful column name and a caption, use caption
- if (!is.null(caption) && !grepl(paste0(ci_string, "$"), colnames(formatted_table))) {
+ if (!is.null(caption) && !endsWith(colnames(formatted_table), ci_string)) {
cat(paste0(caption, ": "))
} else {
cat(paste0(colnames(formatted_table), ": "))
diff --git a/R/print.equivalence_test.R b/R/print.equivalence_test.R
index cfd9cf4..75ad82d 100644
--- a/R/print.equivalence_test.R
+++ b/R/print.equivalence_test.R
@@ -8,8 +8,8 @@ print.equivalence_test <- function(x, digits = 2, ...) {
model <- .retrieve_model(x)
if (!is.null(model)) {
cp <- insight::clean_parameters(model)
- if (!is.null(cp$Group) && any(grepl("^SD/Cor", cp$Group))) {
- cp <- cp[grepl("^SD/Cor", cp$Group), ]
+ if (!is.null(cp$Group) && any(startsWith(cp$Group, "SD/Cor"))) {
+ cp <- cp[startsWith(cp$Group, "SD/Cor"), ]
matches <- match(cp$Parameter, x$Parameter)
if (length(matches)) x$Parameter[matches] <- paste0("SD/Cor: ", cp$Cleaned_Parameter[stats::na.omit(match(x$Parameter, cp$Parameter))])
}
diff --git a/R/reexports.R b/R/reexports.R
deleted file mode 100644
index 3ffe899..0000000
--- a/R/reexports.R
+++ /dev/null
@@ -1,3 +0,0 @@
-#' @export
-#' @importFrom datawizard reshape_ci
-datawizard::reshape_ci
diff --git a/R/reshape_iterations.R b/R/reshape_iterations.R
index def5568..9aa3dde 100644
--- a/R/reshape_iterations.R
+++ b/R/reshape_iterations.R
@@ -29,7 +29,7 @@ reshape_iterations <- function(x, prefix = c("draw", "iter", "iteration", "sim")
}
# Find columns' name
- prefix <- prefix[min(which(sapply(tolower(prefix), function(prefix) sum(grepl(prefix, tolower(names(x)))) > 1)))]
+ prefix <- prefix[min(which(sapply(tolower(prefix), function(prefix) sum(grepl(prefix, tolower(names(x)), fixed = TRUE)) > 1)))]
if (is.na(prefix) || is.null(prefix)) {
stop(insight::format_message(
@@ -38,7 +38,7 @@ reshape_iterations <- function(x, prefix = c("draw", "iter", "iteration", "sim")
}
# Get column names
- iter_cols <- tolower(names(x))[grepl(prefix, tolower(names(x)))]
+ iter_cols <- tolower(names(x))[grepl(prefix, tolower(names(x)), fixed = TRUE)]
# Drop "_" if prefix ends with it
newname <- ifelse(endsWith(prefix, "_"), substr(prefix, 1, nchar(prefix) - 1), prefix)
diff --git a/R/rope.R b/R/rope.R
index 2f46073..afb8e9e 100644
--- a/R/rope.R
+++ b/R/rope.R
@@ -11,8 +11,10 @@
#' variables. If `"default"` and input is a vector, the range is set to `c(-0.1,
#' 0.1)`. If `"default"` and input is a Bayesian model,
#' [`rope_range()`][rope_range] is used.
-#' @param ci The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.
-#' @param ci_method The type of interval to use to quantify the percentage in ROPE. Can be 'HDI' (default) or 'ETI'. See [ci()].
+#' @param ci The Credible Interval (CI) probability, corresponding to the
+#' proportion of HDI, to use for the percentage in ROPE.
+#' @param ci_method The type of interval to use to quantify the percentage in
+#' ROPE. Can be 'HDI' (default) or 'ETI'. See [ci()].
#'
#' @inheritParams hdi
#'
@@ -179,7 +181,7 @@ rope.data.frame <- function(x, range = "default", ci = 0.95, ci_method = "ETI",
row.names(dat) <- NULL
attr(dat, "HDI_area") <- HDI_area_attributes
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(dat) <- c("rope", "see_rope", "data.frame")
dat
@@ -202,7 +204,7 @@ rope.emmGrid <- function(x, range = "default", ci = 0.95, ci_method = "ETI", ver
xdf <- insight::get_parameters(x)
dat <- rope(xdf, range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...)
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -217,7 +219,7 @@ rope.BFBayesFactor <- function(x, range = "default", ci = 0.95, ci_method = "ETI
range <- rope_range(x, verbose = verbose)
}
out <- rope(insight::get_parameters(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -230,7 +232,7 @@ rope.bamlss <- rope.BFBayesFactor
rope.MCMCglmm <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) {
nF <- x$Fixed$nfl
out <- rope(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -239,7 +241,7 @@ rope.MCMCglmm <- function(x, range = "default", ci = 0.95, ci_method = "ETI", ve
rope.mcmc <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) {
out <- rope(as.data.frame(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...)
attr(out, "object_name") <- NULL
- attr(out, "data") <- insight::safe_deparse(substitute(x))
+ attr(out, "data") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -248,7 +250,7 @@ rope.mcmc <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbos
rope.bcplm <- function(x, range = "default", ci = 0.95, ci_method = "ETI", verbose = TRUE, ...) {
out <- rope(insight::get_parameters(x), range = range, ci = ci, ci_method = ci_method, verbose = verbose, ...)
attr(out, "object_name") <- NULL
- attr(out, "data") <- insight::safe_deparse(substitute(x))
+ attr(out, "data") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -303,7 +305,7 @@ rope.stanreg <- function(x, range = "default", ci = 0.95, ci_method = "ETI", eff
if (all(range == "default")) {
range <- rope_range(x, verbose = verbose)
} else if (!all(is.numeric(range)) || length(range) != 2) {
- stop("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).", call. = FALSE)
+ insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).")
}
# check for possible collinearity that might bias ROPE
@@ -321,7 +323,7 @@ rope.stanreg <- function(x, range = "default", ci = 0.95, ci_method = "ETI", eff
out <- .prepare_output(rope_data, insight::clean_parameters(x), inherits(x, "stanmvreg"))
attr(out, "HDI_area") <- attr(rope_data, "HDI_area")
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- class(rope_data)
out
@@ -411,7 +413,7 @@ rope.brmsfit <- function(x,
}
attr(out, "HDI_area") <- attr(rope_data, "HDI_area")
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- class(rope_data)
out
@@ -475,7 +477,7 @@ rope.sim.merMod <- function(x, range = "default", ci = 0.95, ci_method = "ETI",
}
attr(dat, "HDI_area") <- HDI_area_attributes
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -511,7 +513,7 @@ rope.sim <- function(x, range = "default", ci = 0.95, ci_method = "ETI", paramet
dat <- NULL
}
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -531,9 +533,7 @@ rope.sim <- function(x, range = "default", ci = 0.95, ci_method = "ETI", paramet
simplify = FALSE
)
- HDI_area <- lapply(tmp, function(.x) {
- attr(.x, "HDI_area")
- })
+ HDI_area <- lapply(tmp, attr, which = "HDI_area")
# HDI_area <- lapply(HDI_area, function(.x) {
# dat <- cbind(CI = ci, data.frame(do.call(rbind, .x)))
diff --git a/R/rope_range.R b/R/rope_range.R
index c980b6b..81d56c3 100644
--- a/R/rope_range.R
+++ b/R/rope_range.R
@@ -84,14 +84,13 @@ rope_range <- function(x, ...) {
#' @rdname rope_range
#' @export
rope_range.default <- function(x, verbose = TRUE, ...) {
- response <- insight::get_response(x)
+ response <- insight::get_response(x, source = "mf")
response_transform <- insight::find_transformation(x)
- information <- insight::model_info(x)
+ information <- insight::model_info(x, verbose = FALSE)
if (insight::is_multivariate(x)) {
- ret <- mapply(
- function(i, j, ...) .rope_range(x, i, j), information, response, response_transform, verbose,
- SIMPLIFY = FALSE
+ ret <- Map(
+ function(i, j, ...) .rope_range(x, i, j), information, response, response_transform, verbose
)
return(ret)
} else {
@@ -100,12 +99,19 @@ rope_range.default <- function(x, verbose = TRUE, ...) {
}
+#' @export
+rope_range.data.frame <- function(x, verbose = TRUE, ...) {
+ # to avoid errors with "get_response()" in the default method
+ c(-0.1, 0.1)
+}
+
+
# Exceptions --------------------------------------------------------------
#' @export
rope_range.mlm <- function(x, verbose = TRUE, ...) {
- response <- insight::get_response(x)
- information <- insight::model_info(x)
+ response <- insight::get_response(x, source = "mf")
+ information <- insight::model_info(x, verbose = FALSE)
lapply(response, function(i) .rope_range(x, information, i, response_transform = NULL, verbose))
}
@@ -116,11 +122,6 @@ rope_range.mlm <- function(x, verbose = TRUE, ...) {
.rope_range <- function(x, information = NULL, response = NULL, response_transform = NULL, verbose = TRUE) {
- # if(method != "legacy") {
- # message("Other ROPE range methods than 'legacy' are currently not implemented. See https://github.com/easystats/bayestestR/issues/364", call. = FALSE)
- # }
-
-
negligible_value <- tryCatch(
{
if (!is.null(response_transform) && grepl("log", response_transform, fixed = TRUE)) {
@@ -163,7 +164,7 @@ rope_range.mlm <- function(x, verbose = TRUE, ...) {
},
error = function(e) {
if (isTRUE(verbose)) {
- warning("Could not estimate a good default ROPE range. Using 'c(-0.1, 0.1)'.", call. = FALSE)
+ insight::format_warning("Could not estimate a good default ROPE range. Using 'c(-0.1, 0.1)'.")
}
0.1
}
diff --git a/R/sensitivity_to_prior.R b/R/sensitivity_to_prior.R
index 0a7d1bd..7030469 100644
--- a/R/sensitivity_to_prior.R
+++ b/R/sensitivity_to_prior.R
@@ -1,10 +1,18 @@
#' Sensitivity to Prior
#'
-#' Computes the sensitivity to priors specification. This represents the proportion of change in some indices when the model is fitted with an antagonistic prior (a prior of same shape located on the opposite of the effect).
+#' Computes the sensitivity to priors specification. This represents the
+#' proportion of change in some indices when the model is fitted with an
+#' antagonistic prior (a prior of same shape located on the opposite of the
+#' effect).
#'
#' @param model A Bayesian model (`stanreg` or `brmsfit`).
-#' @param index The indices from which to compute the sensitivity. Can be one or multiple names of the columns returned by `describe_posterior`. The case is important here (e.g., write 'Median' instead of 'median').
-#' @param magnitude This represent the magnitude by which to shift the antagonistic prior (to test the sensitivity). For instance, a magnitude of 10 (default) means that the mode wil be updated with a prior located at 10 standard deviations from its original location.
+#' @param index The indices from which to compute the sensitivity. Can be one or
+#' multiple names of the columns returned by `describe_posterior`. The case is
+#' important here (e.g., write 'Median' instead of 'median').
+#' @param magnitude This represent the magnitude by which to shift the
+#' antagonistic prior (to test the sensitivity). For instance, a magnitude of
+#' 10 (default) means that the mode wil be updated with a prior located at 10
+#' standard deviations from its original location.
#' @param ... Arguments passed to or from other methods.
#'
#' @examples
@@ -63,23 +71,21 @@ sensitivity_to_prior.stanreg <- function(model, index = "Median", magnitude = 10
-
-
-
-
-
-
-
-
-
#' @keywords internal
.extract_parameters <- function(model, index = "Median", ...) {
# Handle BF
test <- c("pd", "rope", "p_map")
- if (any(c("bf", "bayesfactor", "bayes_factor") %in% c(index))) {
+ if (any(c("bf", "bayesfactor", "bayes_factor") %in% index)) {
test <- c(test, "bf")
}
- params <- suppressMessages(describe_posterior(model, centrality = "all", dispersion = TRUE, test = test, ...))
+
+ params <- suppressMessages(describe_posterior(
+ model,
+ centrality = "all",
+ dispersion = TRUE,
+ test = test,
+ ...
+ ))
params <- params[params$Parameter != "(Intercept)", ]
params[unique(c("Parameter", "Median", index))]
diff --git a/R/sexit.R b/R/sexit.R
index 6cb1f75..bb0eeee 100644
--- a/R/sexit.R
+++ b/R/sexit.R
@@ -240,20 +240,6 @@ sexit <- function(x, significant = "default", large = "default", ci = 0.95, ...)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#' @keywords internal
.sexit_preprocess <- function(x, significant = "default", large = "default", ...) {
thresholds <- sexit_thresholds(x)
@@ -262,8 +248,8 @@ sexit <- function(x, significant = "default", large = "default", ci = 0.95, ...)
- suppressWarnings(resp <- tryCatch(insight::get_response(x), error = function(e) NULL))
- suppressWarnings(info <- tryCatch(insight::model_info(x), error = function(e) NULL))
+ suppressWarnings(resp <- .safe(insight::get_response(x, type = "mf")))
+ suppressWarnings(info <- .safe(insight::model_info(x, verbose = FALSE)))
if (!is.null(resp) && !is.null(info) && info$is_linear) {
sd1 <- significant / stats::sd(resp, na.rm = TRUE)
sd2 <- large / stats::sd(resp, na.rm = TRUE)
diff --git a/R/sexit_thresholds.R b/R/sexit_thresholds.R
index cc53b96..f042ae5 100644
--- a/R/sexit_thresholds.R
+++ b/R/sexit_thresholds.R
@@ -1,7 +1,10 @@
#' @title Find Effect Size Thresholds
#'
-#' @description This function attempts at automatically finding suitable default values for a "significant" (i.e., non-negligible) and "large" effect. This is to be used with care, and the chosen threshold should always be explicitly reported and justified. See the detail section in [`sexit()`][sexit] for more information.
-#'
+#' @description This function attempts at automatically finding suitable default
+#' values for a "significant" (i.e., non-negligible) and "large" effect. This is
+#' to be used with care, and the chosen threshold should always be explicitly
+#' reported and justified. See the detail section in [`sexit()`][sexit] for more
+#' information.
#'
#' @inheritParams rope
#'
@@ -41,14 +44,14 @@ sexit_thresholds <- function(x, ...) {
#' @export
-sexit_thresholds.brmsfit <- function(x, ...) {
- response <- insight::get_response(x)
- information <- insight::model_info(x)
+sexit_thresholds.brmsfit <- function(x, verbose = TRUE, ...) {
+ response <- insight::get_response(x, source = "mf")
+ information <- insight::model_info(x, verbose = FALSE)
if (insight::is_multivariate(x)) {
- mapply(function(i, j) .sexit_thresholds(i, j), x, information, response)
+ mapply(function(i, j) .sexit_thresholds(i, j), x, information, response, verbose)
} else {
- .sexit_thresholds(x, information, response)
+ .sexit_thresholds(x, information, response, verbose)
}
}
@@ -57,24 +60,16 @@ sexit_thresholds.brmsfit <- function(x, ...) {
sexit_thresholds.stanreg <- sexit_thresholds.brmsfit
#' @export
-sexit_thresholds.BFBayesFactor <- function(x, ...) {
+sexit_thresholds.BFBayesFactor <- function(x, verbose = TRUE, ...) {
fac <- 1
if (inherits(x@numerator[[1]], "BFlinearModel")) {
- response <- tryCatch(
- {
- insight::get_response(x)
- },
- error = function(e) {
- NULL
- }
- )
-
+ response <- .safe(insight::get_response(x, source = "mf"))
if (!is.null(response)) {
fac <- stats::sd(response, na.rm = TRUE)
}
}
- fac * .sexit_thresholds(x)
+ fac * .sexit_thresholds(x, verbose = verbose)
}
#' @export
@@ -129,16 +124,16 @@ sexit_thresholds.zeroinfl <- sexit_thresholds.brmsfit
sexit_thresholds.bayesQR <- sexit_thresholds.brmsfit
#' @export
-sexit_thresholds.default <- function(x, ...) {
- .sexit_thresholds(x)
+sexit_thresholds.default <- function(x, verbose = TRUE, ...) {
+ .sexit_thresholds(x, verbose = verbose)
}
#' @export
-sexit_thresholds.mlm <- function(x, ...) {
- response <- insight::get_response(x)
- information <- insight::model_info(x)
+sexit_thresholds.mlm <- function(x, verbose = TRUE, ...) {
+ response <- insight::get_response(x, type = "mf")
+ information <- insight::model_info(x, verbose = FALSE)
- lapply(response, function(i) .sexit_thresholds(x, information, i))
+ lapply(response, function(i) .sexit_thresholds(x, information, i, verbose = verbose))
}
@@ -147,7 +142,7 @@ sexit_thresholds.mlm <- function(x, ...) {
# helper ------------------
-.sexit_thresholds <- function(x, information = NULL, response = NULL) {
+.sexit_thresholds <- function(x, information = NULL, response = NULL, verbose = TRUE) {
if (is.null(information) && is.null(response)) {
norm <- 1
} else {
@@ -172,10 +167,12 @@ sexit_thresholds.mlm <- function(x, ...) {
# T-tests
} else if (information$is_ttest) {
- if ("BFBayesFactor" %in% class(x)) {
+ if (inherits(x, "BFBayesFactor")) {
stats::sd(x@data[, 1])
} else {
- warning("Could not estimate good thresholds, using default values.", call. = FALSE)
+ if (verbose) {
+ insight::format_warning("Could not estimate good thresholds, using default values.")
+ }
1
}
@@ -190,7 +187,9 @@ sexit_thresholds.mlm <- function(x, ...) {
}
},
error = function(e) {
- warning("Could not estimate good thresholds, using default values.", call. = FALSE)
+ if (verbose) {
+ insight::format_warning("Could not estimate good thresholds, using default values.")
+ }
1
}
)
diff --git a/R/si.R b/R/si.R
index a3a9eee..ef7bca1 100644
--- a/R/si.R
+++ b/R/si.R
@@ -41,7 +41,7 @@
#' Note that if the level of requested support is higher than observed in the data, the
#' interval will be `[NA,NA]`.
#'
-#' @examples
+#' @examplesIf requireNamespace("logspline", quietly = TRUE)
#' library(bayestestR)
#'
#' prior <- distribution_normal(1000, mean = 0, sd = 1)
@@ -52,7 +52,7 @@
#' # rstanarm models
#' # ---------------
#' library(rstanarm)
-#' contrasts(sleep$group) <- contr.equalprior_pairs # see vingette
+#' contrasts(sleep$group) <- contr.equalprior_pairs # see vignette
#' stan_model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
#' si(stan_model)
#' si(stan_model, BF = 3)
@@ -71,10 +71,11 @@
#' set_prior("student_t(3, 0, 1)", class = "b") +
#' set_prior("student_t(3, 0, 1)", class = "sd", group = "ID")
#'
-#' brms_model <- brm(extra ~ group + (1 | ID),
+#' brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID),
#' data = sleep,
-#' prior = my_custom_priors
-#' )
+#' prior = my_custom_priors,
+#' refresh = 0
+#' ))
#' si(brms_model)
#' }
#' @references
@@ -91,11 +92,11 @@ si.numeric <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) {
if (is.null(prior)) {
prior <- posterior
if (verbose) {
- warning(insight::format_message(
+ insight::format_warning(
"Prior not specified!",
"Support intervals ('si') can only be computed for Bayesian models with proper priors.",
"Please specify priors (with column order matching 'posterior')."
- ), call. = FALSE)
+ )
}
}
prior <- data.frame(X = prior)
@@ -115,7 +116,7 @@ si.numeric <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) {
si.stanreg <- function(posterior, prior = NULL,
BF = 1, verbose = TRUE,
effects = c("fixed", "random", "all"),
- component = c("conditional", "location", "zi", "zero_inflated", "all", "smooth_terms", "sigma", "distributional", "auxiliary"),
+ component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary", "distributional"),
parameters = NULL,
...) {
cleaned_parameters <- insight::clean_parameters(posterior)
@@ -137,7 +138,7 @@ si.stanreg <- function(posterior, prior = NULL,
out <- .prepare_output(temp, cleaned_parameters, inherits(posterior, "stanmvreg"))
attr(out, "ci_method") <- "SI"
- attr(out, "object_name") <- insight::safe_deparse(substitute(posterior))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior))
class(out) <- class(temp)
attr(out, "plot_data") <- attr(temp, "plot_data")
@@ -169,7 +170,7 @@ si.emmGrid <- function(posterior, prior = NULL,
)
attr(out, "ci_method") <- "SI"
- attr(out, "object_name") <- insight::safe_deparse(substitute(posterior))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior))
out
}
@@ -182,14 +183,14 @@ si.stanfit <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, effects
out <- si(insight::get_parameters(posterior, effects = effects),
prior = prior, BF = BF, verbose = verbose
)
- attr(out, "object_name") <- insight::safe_deparse(substitute(posterior))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior))
out
}
#' @export
si.get_predicted <- function(posterior, ...) {
out <- si(as.data.frame(t(posterior)), ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(posterior))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(posterior))
out
}
@@ -199,23 +200,22 @@ si.get_predicted <- function(posterior, ...) {
si.data.frame <- function(posterior, prior = NULL, BF = 1, verbose = TRUE, ...) {
if (is.null(prior)) {
prior <- posterior
- warning(insight::format_message(
+ insight::format_warning(
"Prior not specified!",
"Support intervals ('si') can only be computed for Bayesian models with proper priors.",
"Please specify priors (with column order matching 'posterior')."
- ), call. = FALSE)
+ )
}
if (verbose && (nrow(posterior) < 4e4 || nrow(prior) < 4e4)) {
- warning(
- "Support intervals might not be precise.\n",
- "For precise support intervals, sampling at least 40,000 posterior samples is recommended.",
- call. = FALSE
+ insight::format_warning(
+ "Support intervals might not be precise.",
+ "For precise support intervals, sampling at least 40,000 posterior samples is recommended."
)
}
out <- lapply(BF, function(BFi) {
- .si.data.frame(posterior, prior, BFi)
+ .si.data.frame(posterior, prior, BFi, verbose = verbose)
})
out <- do.call(rbind, out)
@@ -240,12 +240,14 @@ si.rvar <- si.draws
# Helper ------------------------------------------------------------------
-.si.data.frame <- function(posterior, prior, BF, ...) {
+.si.data.frame <- function(posterior, prior, BF, verbose = TRUE, ...) {
sis <- matrix(NA, nrow = ncol(posterior), ncol = 2)
for (par in seq_along(posterior)) {
sis[par, ] <- .si(posterior[[par]],
prior[[par]],
- BF = BF, ...
+ BF = BF,
+ verbose = verbose,
+ ...
)
}
@@ -261,7 +263,7 @@ si.rvar <- si.draws
#' @keywords internal
-.si <- function(posterior, prior, BF = 1, extend_scale = 0.05, precision = 2^8, ...) {
+.si <- function(posterior, prior, BF = 1, extend_scale = 0.05, precision = 2^8, verbose = TRUE, ...) {
insight::check_if_installed("logspline")
if (isTRUE(all.equal(prior, posterior))) {
@@ -290,9 +292,9 @@ si.rvar <- si.draws
crit <- relative_d >= BF
- cp <- rle(c(stats::na.omit(crit)))
- if (length(cp$lengths) > 3) {
- warning("More than 1 SI detected. Plot the result to investigate.", call. = FALSE)
+ cp <- rle(stats::na.omit(crit))
+ if (length(cp$lengths) > 3 && verbose) {
+ insight::format_warning("More than 1 SI detected. Plot the result to investigate.")
}
x_supported <- stats::na.omit(x_axis[crit])
diff --git a/R/simulate_data.R b/R/simulate_data.R
index 3d63ac9..0105858 100644
--- a/R/simulate_data.R
+++ b/R/simulate_data.R
@@ -75,7 +75,7 @@ simulate_correlation <- function(n = 100,
} else {
stop("'r' should be a symetric matrix (relative to the diagonal).", call. = FALSE)
}
- } else if (length(r) == 1) {
+ } else if (length(r) == 1L) {
if (abs(r) > 1) {
stop("'r' should only contain values between -1 and 1.", call. = FALSE)
} else {
diff --git a/R/spi.R b/R/spi.R
index 44353e6..429d609 100644
--- a/R/spi.R
+++ b/R/spi.R
@@ -24,16 +24,16 @@
#' @references
#' Liu, Y., Gelman, A., & Zheng, T. (2015). Simulation-efficient shortest probability intervals. Statistics and Computing, 25(4), 809–819. https://doi.org/10.1007/s11222-015-9563-8
#'
-#' @examples
+#' @examplesIf requireNamespace("quadprog", quietly = TRUE)
#' library(bayestestR)
#'
#' posterior <- rnorm(1000)
#' spi(posterior)
-#' spi(posterior, ci = c(.80, .89, .95))
+#' spi(posterior, ci = c(0.80, 0.89, 0.95))
#'
#' df <- data.frame(replicate(4, rnorm(100)))
#' spi(df)
-#' spi(df, ci = c(.80, .89, .95))
+#' spi(df, ci = c(0.80, 0.89, 0.95))
#' \dontrun{
#' library(rstanarm)
#' model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0)
@@ -67,7 +67,7 @@ spi.numeric <- function(x, ci = 0.95, verbose = TRUE, ...) {
#' @export
spi.data.frame <- function(x, ci = 0.95, verbose = TRUE, ...) {
dat <- .compute_interval_dataframe(x = x, ci = ci, verbose = verbose, fun = "spi")
- attr(dat, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(dat, "object_name") <- insight::safe_deparse_symbol(substitute(x))
dat
}
@@ -129,7 +129,7 @@ spi.sim <- function(x, ci = 0.95, parameters = NULL, verbose = TRUE, ...) {
spi.emmGrid <- function(x, ci = 0.95, verbose = TRUE, ...) {
xdf <- insight::get_parameters(x)
out <- spi(xdf, ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -167,7 +167,7 @@ spi.stanreg <- function(x,
)
attr(out, "clean_parameters") <- cleaned_parameters
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_spi", class(out)))
out
}
@@ -208,7 +208,7 @@ spi.brmsfit <- function(x,
)
attr(out, "clean_parameters") <- cleaned_parameters
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
class(out) <- unique(c("bayestestR_hdi", "see_hdi", "bayestestR_spi", class(out)))
out
}
@@ -217,7 +217,7 @@ spi.brmsfit <- function(x,
#' @export
spi.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) {
out <- spi(insight::get_parameters(x), ci = ci, verbose = verbose, ...)
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
@@ -229,7 +229,7 @@ spi.get_predicted <- function(x, ...) {
} else {
stop("No iterations present in the output.", call. = FALSE)
}
- attr(out, "object_name") <- insight::safe_deparse(substitute(x))
+ attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}
diff --git a/R/unupdate.R b/R/unupdate.R
index 54855a5..3b8e027 100644
--- a/R/unupdate.R
+++ b/R/unupdate.R
@@ -74,7 +74,7 @@ unupdate.brmsfit <- function(model, verbose = TRUE, ...) {
)
if (methods::is(model_prior, "try-error")) {
- if (grepl("proper priors", model_prior)) {
+ if (grepl("proper priors", model_prior, fixed = TRUE)) {
stop(
"Cannot sample from flat priors (such as the default ",
"priors for fixed-effects in a 'brmsfit' model).",
@@ -116,14 +116,13 @@ unupdate.brmsfit_multiple <- function(model,
)), silent = TRUE))
if (methods::is(model_prior, "try-error")) {
- if (grepl("proper priors", model_prior)) {
- stop(
+ if (grepl("proper priors", model_prior, fixed = TRUE)) {
+ insight::format_error(
"Cannot sample from flat priors (such as the default ",
"priors for fixed-effects in a 'brmsfit' model).",
- call. = FALSE
)
} else {
- stop(model_prior, call. = FALSE)
+ insight::format_error(model_prior)
}
}
diff --git a/R/utils.R b/R/utils.R
index 6430e83..3db72c7 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1,3 +1,8 @@
+# small wrapper around this commonly used try-catch
+.safe <- function(code, on_error = NULL) {
+ tryCatch(code, error = function(e) on_error)
+}
+
# select rows where values in "variable" match "value"
#' @keywords internal
.select_rows <- function(data, variable, value) {
@@ -13,7 +18,9 @@
#' @keywords internal
.get_direction <- function(direction) {
- if (length(direction) > 1) warning("Using first 'direction' value.", call. = FALSE)
+ if (length(direction) > 1) {
+ insight::format_warning("Using first 'direction' value.")
+ }
if (is.numeric(direction[1])) {
return(sign(direction[1]))
@@ -70,12 +77,12 @@
remove_cols <- c("Group", "Cleaned_Parameter", "Response", "Function", ".roworder")
}
merge_by <- intersect(merge_by, colnames(temp))
- temp$.roworder <- 1:nrow(temp)
+ temp$.roworder <- seq_len(nrow(temp))
out <- merge(x = temp, y = cleaned_parameters, by = merge_by, all.x = TRUE)
# hope this works for stanmvreg...
if ((isTRUE(is_stan_mv) || isTRUE(is_brms_mv)) && all(is.na(out$Effects)) && all(is.na(out$Component))) {
- out$Effects <- cleaned_parameters$Effects[1:nrow(out)]
- out$Component <- cleaned_parameters$Component[1:nrow(out)]
+ out$Effects <- cleaned_parameters$Effects[seq_len(nrow(out))]
+ out$Component <- cleaned_parameters$Component[seq_len(nrow(out))]
}
# this here is required for multiple response models...
if (all(is.na(out$Effects)) || all(is.na(out$Component))) {
@@ -93,7 +100,7 @@
if (is.null(ncol(y))) {
return(x)
}
- x$.rowid <- 1:nrow(x)
+ x$.rowid <- seq_len(nrow(x))
x <- merge(x, y, by = by, all = all)
datawizard::data_remove(x[order(x$.rowid), ], ".rowid", verbose = FALSE)
}
diff --git a/R/utils_bayesfactor.R b/R/utils_bayesfactor.R
index 0a531d3..1737c74 100644
--- a/R/utils_bayesfactor.R
+++ b/R/utils_bayesfactor.R
@@ -1,4 +1,3 @@
-
# clean priors and posteriors ---------------------------------------------
#' @keywords internal
@@ -19,7 +18,7 @@
prior <- try(unupdate(prior, verbose = verbose), silent = TRUE)
if (methods::is(prior, "try-error")) {
- if (grepl("flat priors", prior)) {
+ if (grepl("flat priors", prior, fixed = TRUE)) {
prior <- paste0(
prior, "Could not therefore compute Bayes factors, as these inform about ",
"the raltive likelihood of two 'hypotheses', and flat priors provide no ",
@@ -27,7 +26,7 @@
"See '?bayesfactor_parameters' for more information.\n"
)
}
- stop(prior, call. = FALSE)
+ insight::format_error(prior)
}
prior <- insight::get_parameters(prior, effects = effects, component = component, ...)
@@ -100,7 +99,7 @@
prior <- try(unupdate(prior, verbose = verbose), silent = TRUE)
if (inherits(prior, "try-error")) {
on.exit() # undo general error message
- if (grepl("flat priors", prior)) {
+ if (grepl("flat priors", prior, fixed = TRUE)) {
prior <- paste0(
prior, "Could not therefore compute Bayes factors, as these inform about ",
"the raltive likelihood of two 'hypotheses', and flat priors provide no ",
@@ -151,7 +150,7 @@
prior <- try(unupdate(prior, verbose = verbose), silent = TRUE)
if (inherits(prior, "try-error")) {
- if (grepl("flat priors", prior)) {
+ if (grepl("flat priors", prior, fixed = TRUE)) {
prior <- paste0(
prior, "Could not therefore compute Bayes factors, as these inform about ",
"the raltive likelihood of two 'hypotheses', and flat priors provide no ",
@@ -240,8 +239,8 @@
#' @keywords internal
.make_terms <- function(formula) {
sort_interactions <- function(x) {
- if (grepl("\\:", x)) {
- effs <- unlist(strsplit(x, "\\:"))
+ if (grepl(":", x, fixed = TRUE)) {
+ effs <- unlist(strsplit(x, ":", fixed = TRUE))
x <- paste0(sort(effs), collapse = ":")
}
x
@@ -250,13 +249,13 @@
all.terms <- attr(stats::terms(formula.f), "term.labels")
# Fixed
- fix_trms <- all.terms[!grepl("\\|", all.terms)] # no random
+ fix_trms <- all.terms[!grepl("|", all.terms, fixed = TRUE)] # no random
if (length(fix_trms) > 0) {
fix_trms <- sapply(fix_trms, sort_interactions)
}
# Random
- random_parts <- paste0(all.terms[grepl("\\|", all.terms)]) # only random
+ random_parts <- paste0(grep("|", all.terms, fixed = TRUE, value = TRUE)) # only random
if (length(random_parts) == 0) {
return(fix_trms)
}
@@ -272,7 +271,7 @@
tmp_trms <- attr(stats::terms.formula(tmp_random[[i]]), "term.labels")
tmp_trms <- sapply(tmp_trms, sort_interactions)
- if (!any(unlist(strsplit(as.character(tmp_random[[i]])[[2]], " \\+ ")) == "0")) {
+ if (!any(unlist(strsplit(as.character(tmp_random[[i]])[[2]], " + ", fixed = TRUE)) == "0")) {
tmp_trms <- c("1", tmp_trms)
}
@@ -295,7 +294,7 @@
insight::check_if_installed("logspline")
estimate_samples_density <- function(samples) {
- nm <- insight::safe_deparse(substitute(samples))
+ nm <- insight::safe_deparse_symbol(substitute(samples))
samples <- utils::stack(samples)
samples <- split(samples, samples$ind)
diff --git a/R/utils_check_collinearity.R b/R/utils_check_collinearity.R
index 7dcc392..2930d30 100644
--- a/R/utils_check_collinearity.R
+++ b/R/utils_check_collinearity.R
@@ -32,8 +32,8 @@
# Remove duplicates
results$where <- paste0(results$Var1, " and ", results$Var2)
results$where2 <- paste0(results$Var2, " and ", results$Var1)
- to_remove <- c()
- for (i in 1:nrow(results)) {
+ to_remove <- NULL
+ for (i in seq_len(nrow(results))) {
if (results$where2[i] %in% results$where[1:i]) {
to_remove <- c(to_remove, i)
}
@@ -41,17 +41,17 @@
results <- results[-to_remove, ]
# Filter by first threshold
- threshold <- ifelse(threshold >= .9, .9, threshold)
- results <- results[results$corr > threshold & results$corr <= .9, ]
+ threshold <- pmin(threshold, 0.9)
+ results <- results[results$corr > threshold & results$corr <= 0.9, ]
if (nrow(results) > 0) {
- where <- paste0("between ", paste0(paste0(results$where, " (r = ", round(results$corr, 2), ")"), collapse = ", "), "")
+ where <- paste0("between ", toString(paste0(results$where, " (r = ", round(results$corr, 2), ")")), "")
message("Possible multicollinearity ", where, ". This might lead to inappropriate results. See 'Details' in '?", method, "'.")
}
# Filter by second threshold
- results <- results[results$corr > .9, ]
+ results <- results[results$corr > 0.9, ]
if (nrow(results) > 0) {
- where <- paste0("between ", paste0(paste0(results$where, " (r = ", round(results$corr, 2), ")"), collapse = ", "), "")
+ where <- paste0("between ", toString(paste0(results$where, " (r = ", round(results$corr, 2), ")")), "")
warning("Probable multicollinearity ", where, ". This might lead to inappropriate results. See 'Details' in '?", method, "'.", call. = FALSE)
}
}
diff --git a/R/utils_posterior.R b/R/utils_posterior.R
index 6d14972..c12c626 100644
--- a/R/utils_posterior.R
+++ b/R/utils_posterior.R
@@ -6,7 +6,7 @@
}
.posterior_draws_to_df.default <- function(x) {
- stop(paste0("Objects of class `%s` are not yet supported.", class(x)[1]), call. = FALSE)
+ insight::format_error(paste0("Objects of class `%s` are not yet supported.", class(x)[1]))
}
.posterior_draws_to_df.data.frame <- function(x) {
diff --git a/R/utils_print_data_frame.R b/R/utils_print_data_frame.R
index 905fcf8..6020aa7 100644
--- a/R/utils_print_data_frame.R
+++ b/R/utils_print_data_frame.R
@@ -14,9 +14,12 @@
if (anyNA(x$split)) {
x$split[is.na(x$split)] <- "{other}"
}
- out <- lapply(split(x, f = x$split), function(i) {
- datawizard::data_remove(i, c("split", "Component", "Effects"), verbose = FALSE)
- })
+ out <- lapply(
+ split(x, f = x$split),
+ datawizard::data_remove,
+ select = c("split", "Component", "Effects"),
+ verbose = FALSE
+ )
}
for (i in names(out)) {
@@ -63,7 +66,7 @@
# remove ".1" etc. suffix
out[[i]]$Parameter <- gsub("(.*)(\\.)(\\d)$", "\\1 \\3", out[[i]]$Parameter)
# remove "__zi"
- out[[i]]$Parameter <- gsub("__zi", "", out[[i]]$Parameter)
+ out[[i]]$Parameter <- gsub("__zi", "", out[[i]]$Parameter, fixed = TRUE)
}
if (length(out) > 1) {
diff --git a/R/weighted_posteriors.R b/R/weighted_posteriors.R
index 762bf0b..2a747a0 100644
--- a/R/weighted_posteriors.R
+++ b/R/weighted_posteriors.R
@@ -55,7 +55,6 @@
#' diagnostic_file = file.path(tempdir(), "df1.csv")
#' )
#'
-#'
#' res <- weighted_posteriors(stan_m0, stan_m1)
#'
#' plot(eti(res))
@@ -142,10 +141,12 @@ weighted_posteriors.data.frame <- function(..., prior_odds = NULL, missing = 0,
if (!is.null(prior_odds)) {
prior_odds <- c(1, prior_odds)
} else {
- warning("'prior_odds = NULL'; Using uniform priors odds.\n",
- "For weighted data frame, 'prior_odds' should be specified as a numeric vector.",
- call. = FALSE
- )
+ if (verbose) {
+ insight::format_warning(
+ "'prior_odds = NULL'; Using uniform priors odds.\n",
+ "For weighted data frame, 'prior_odds' should be specified as a numeric vector."
+ )
+ }
prior_odds <- rep(1, length(Mods))
}
diff --git a/README.md b/README.md
index f083b9d..e165d35 100644
--- a/README.md
+++ b/README.md
@@ -2,9 +2,8 @@
# bayestestR <img src='man/figures/logo.png' align="right" height="139" />
[](https://doi.org/10.21105/joss.01541)
-[](https://cran.r-project.org/package=bayestestR)
-[](https://cranlogs.r-pkg.org/)
[](https://CRAN.R-project.org/package=bayestestR)
+[](https://lifecycle.r-lib.org/articles/stages.html)
***Become a Bayesian master you will***
@@ -58,18 +57,20 @@ Once you have downloaded the package, you can then load it using:
library("bayestestR")
```
-## Documentation
+> **Tip**
+>
+> **Instead of `library(datawizard)`, use `library(easystats)`.** **This
+> will make all features of the easystats-ecosystem available.**
+>
+> **To stay updated, use `easystats::install_latest()`.**
-[](https://easystats.github.io/bayestestR/)
-[](https://easystats.github.io/blog/posts/)
-[](https://easystats.github.io/bayestestR/reference/index.html)
+## Documentation
-Click on the buttons above to access the package
-[documentation](https://easystats.github.io/bayestestR/) and the
-[easystats blog](https://easystats.github.io/blog/posts/), and check-out
+Access the package
+[documentation](https://easystats.github.io/bayestestR/) and check-out
these vignettes:
-#### Tutorials
+### Tutorials
- [Get Started with Bayesian
Analysis](https://easystats.github.io/bayestestR/articles/bayestestR.html)
@@ -80,7 +81,7 @@ these vignettes:
- [Example 3: Become a Bayesian
master](https://easystats.github.io/bayestestR/articles/example3.html)
-#### Articles
+### Articles
- [Credible Intervals
(CI)](https://easystats.github.io/bayestestR/articles/credible_interval.html)
@@ -153,13 +154,14 @@ cited below at once.
describe_posterior(
rnorm(10000),
centrality = "median",
- test = c("p_direction", "p_significance")
+ test = c("p_direction", "p_significance"),
+ verbose = FALSE
)
## Summary of Posterior Distribution
##
-## Parameter | Median | 95% CI | pd | ps
-## ----------------------------------------------------
-## Posterior | 5.58e-03 | [-1.99, 1.94] | 50.25% | 0.46
+## Parameter | Median | 95% CI | pd | ps
+## --------------------------------------------------
+## Posterior | 0.01 | [-1.97, 1.99] | 50.58% | 0.47
```
`describe_posterior()` works for many objects, including more complex
@@ -237,7 +239,7 @@ describe_posterior(
*bayestestR* also includes [**many other
features**](https://easystats.github.io/bayestestR/reference/index.html)
-useful for your Bayesian analsyes. Here are some more examples:
+useful for your Bayesian analyses. Here are some more examples:
## Point-estimates
@@ -287,10 +289,10 @@ posterior distributions.
``` r
posterior <- distribution_chisquared(10000, 4)
-hdi(posterior, ci = .89)
+hdi(posterior, ci = 0.89)
## 89% HDI: [0.18, 7.63]
-eti(posterior, ci = .89)
+eti(posterior, ci = 0.89)
## 89% ETI: [0.75, 9.25]
```
@@ -390,7 +392,7 @@ Kuriyal, & Grasman, 2010).
prior <- distribution_normal(10000, mean = 0, sd = 1)
posterior <- distribution_normal(10000, mean = 1, sd = 0.7)
-bayesfactor_parameters(posterior, prior, direction = "two-sided", null = 0)
+bayesfactor_parameters(posterior, prior, direction = "two-sided", null = 0, verbose = FALSE)
## Bayes Factor (Savage-Dickey density ratio)
##
## BF
@@ -458,7 +460,7 @@ Compute the density of a given point of a distribution.
``` r
density_at(rnorm(1000, 1, 1), 1)
-## [1] 0.38
+## [1] 0.39
```
## Code of Conduct
@@ -477,7 +479,7 @@ line-spacing="2">
Kruschke, J. K. (2018). Rejecting or accepting parameter values in
Bayesian estimation. *Advances in Methods and Practices in Psychological
-Science*, *1*(2), 270–280. <https://doi.org/10.1177/2515245918771304>
+Science*, *1*(2), 270–280.
</div>
diff --git a/data/disgust.rdata b/data/disgust.rdata
new file mode 100644
index 0000000..e2ed64d
Binary files /dev/null and b/data/disgust.rdata differ
diff --git a/debian/changelog b/debian/changelog
index 49420a3..6e135a5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,12 @@
-r-cran-bayestestr (0.13.0-2) UNRELEASED; urgency=medium
+r-cran-bayestestr (0.13.1-1) UNRELEASED; urgency=medium
+ [ Andreas Tille ]
* Disable reprotest
- -- Andreas Tille <tille@debian.org> Tue, 01 Nov 2022 17:15:08 +0100
+ [ Debian Janitor ]
+ * New upstream release.
+
+ -- Andreas Tille <tille@debian.org> Fri, 05 May 2023 23:59:58 -0000
r-cran-bayestestr (0.13.0-1) unstable; urgency=medium
diff --git a/inst/WORDLIST b/inst/WORDLIST
index f97b884..4e896c5 100644
--- a/inst/WORDLIST
+++ b/inst/WORDLIST
@@ -1,5 +1,6 @@
ADE
Altough
+ArXiv
BCI
BCa
BFs
@@ -12,6 +13,7 @@ BayesFactor
Bayesfactor
Bergh
Bridgesampling
+CMD
CRC
CWI
Curvewise
@@ -21,8 +23,8 @@ Dablander
DescTools
Desimone
DiCiccio
+Dom
Driing
-Elsevier
ESS
ETI
Efron
@@ -56,6 +58,7 @@ Littman
Liu
Lodewyckx
Ly
+Makowski
MCMCglmm
MCSE
MPE
@@ -67,26 +70,26 @@ Midya
Modelling
Morey
Multicollinearity
-Orthonormal
+ORCID
Ozer
Parmigiani
Piironen
Posteriori
+Preprint
Psychonomic
ROPE's
ROPEs
ROPE’s
Raftery
-Retrived
Rhat
Rouder
SEM
SEXIT
SHA
-Shachar
-Speckman
SPI
SPIn
+Shachar
+Speckman
Tada
Tingley
Un
@@ -95,6 +98,7 @@ Vehtari
Versicolor
Visualise
Wagenmakers
+Wether
Wetzels
Wickham
Wookies
@@ -113,6 +117,7 @@ bcplm
behavioural
blogpost
bmj
+bmwiernik
bootsrapped
brms
brmsfit
@@ -131,6 +136,7 @@ eXistence
easystats
edu
effectsize
+egydq
emmeans
et
favour
@@ -155,11 +161,12 @@ io
iteratively
jmp
joss
-kruschke
lavaan
lentiful
+lifecycle
lm
maths
+mattansb
mcmc
modelling
nbinom
@@ -169,17 +176,19 @@ objets
operationlizing
orthonormal
osterior
+patilindrajeets
pre
preprint
priori
ps
+psyarxiv
+rOpenSci
reconceptualisation
replicability
reproducibility
richarddmorey
riors
rmsb
-rOpenSci
rstanarm
sIgnificance
salis
@@ -187,10 +196,10 @@ setosa
setosas
splinefun
ss
-stan
stanfit
stanreg
statmodeling
+strengejacke
summarise
summarised
th
diff --git a/inst/doc/overview_of_vignettes.html b/inst/doc/overview_of_vignettes.html
index 2367e66..cb7e64f 100644
--- a/inst/doc/overview_of_vignettes.html
+++ b/inst/doc/overview_of_vignettes.html
@@ -29,13 +29,13 @@ document.addEventListener('DOMContentLoaded', function(e) {
</script>
<style type="text/css">
- code{white-space: pre-wrap;}
- span.smallcaps{font-variant: small-caps;}
- span.underline{text-decoration: underline;}
- div.column{display: inline-block; vertical-align: top; width: 50%;}
- div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
- ul.task-list{list-style: none;}
- </style>
+code{white-space: pre-wrap;}
+span.smallcaps{font-variant: small-caps;}
+span.underline{text-decoration: underline;}
+div.column{display: inline-block; vertical-align: top; width: 50%;}
+div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
+ul.task-list{list-style: none;}
+</style>
diff --git a/man/area_under_curve.Rd b/man/area_under_curve.Rd
index 224a699..b06023e 100644
--- a/man/area_under_curve.Rd
+++ b/man/area_under_curve.Rd
@@ -14,12 +14,20 @@ auc(x, y, method = c("trapezoid", "step", "spline"), ...)
\item{y}{Vector of y values.}
-\item{method}{Method to compute the Area Under the Curve (AUC). Can be \code{"trapezoid"} (default), \code{"step"} or \code{"spline"}. If "trapezoid", the curve is formed by connecting all points by a direct line (composite trapezoid rule). If "step" is chosen then a stepwise connection of two points is used. For calculating the area under a spline interpolation the splinefun function is used in combination with integrate.}
+\item{method}{Method to compute the Area Under the Curve (AUC). Can be
+\code{"trapezoid"} (default), \code{"step"} or \code{"spline"}. If "trapezoid", the curve
+is formed by connecting all points by a direct line (composite trapezoid
+rule). If "step" is chosen then a stepwise connection of two points is
+used. For calculating the area under a spline interpolation the splinefun
+function is used in combination with integrate.}
\item{...}{Arguments passed to or from other methods.}
}
\description{
-Based on the DescTools \code{AUC} function. It can calculate the area under the curve with a naive algorithm or a more elaborated spline approach. The curve must be given by vectors of xy-coordinates. This function can handle unsorted x values (by sorting x) and ties for the x values (by ignoring duplicates).
+Based on the DescTools \code{AUC} function. It can calculate the area under the
+curve with a naive algorithm or a more elaborated spline approach. The curve
+must be given by vectors of xy-coordinates. This function can handle unsorted
+x values (by sorting x) and ties for the x values (by ignoring duplicates).
}
\examples{
library(bayestestR)
diff --git a/man/bayesfactor.Rd b/man/bayesfactor.Rd
index d3f8333..2455d0f 100644
--- a/man/bayesfactor.Rd
+++ b/man/bayesfactor.Rd
@@ -68,14 +68,14 @@ if (require("logspline")) {
prior <- distribution_normal(1000, mean = 0, sd = 1)
posterior <- distribution_normal(1000, mean = .5, sd = .3)
- bayesfactor(posterior, prior = prior)
+ bayesfactor(posterior, prior = prior, verbose = FALSE)
}
\dontrun{
# rstanarm models
# ---------------
if (require("rstanarm")) {
model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
- bayesfactor(model)
+ bayesfactor(model, verbose = FALSE)
}
}
diff --git a/man/bayesfactor_inclusion.Rd b/man/bayesfactor_inclusion.Rd
index e657ff9..de2112e 100644
--- a/man/bayesfactor_inclusion.Rd
+++ b/man/bayesfactor_inclusion.Rd
@@ -85,12 +85,17 @@ bayesfactor_inclusion(BF)
# compare only matched models:
bayesfactor_inclusion(BF, match_models = TRUE)
}
+
}
\references{
\itemize{
-\item Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25). A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64}
-\item Clyde, M. A., Ghosh, J., & Littman, M. L. (2011). Bayesian adaptive sampling for variable selection and model averaging. Journal of Computational and Graphical Statistics, 20(1), 80-101.
-\item Mathot, S. (2017). Bayes like a Baws: Interpreting Bayesian Repeated Measures in JASP \href{https://www.cogsci.nl/blog/interpreting-bayesian-repeated-measures-in-jasp}{Blog post}.
+\item Hinne, M., Gronau, Q. F., van den Bergh, D., and Wagenmakers, E. (2019, March 25).
+A conceptual introduction to Bayesian Model Averaging. \doi{10.31234/osf.io/wgb64}
+\item Clyde, M. A., Ghosh, J., & Littman, M. L. (2011). Bayesian adaptive sampling
+for variable selection and model averaging. Journal of Computational and Graphical Statistics,
+20(1), 80-101.
+\item Mathot, S. (2017). Bayes like a Baws: Interpreting Bayesian Repeated Measures in JASP.
+\href{https://www.cogsci.nl/blog/interpreting-bayesian-repeated-measures-in-jasp}{Blog post}.
}
}
\seealso{
diff --git a/man/bayesfactor_models.Rd b/man/bayesfactor_models.Rd
index 6278632..b786997 100644
--- a/man/bayesfactor_models.Rd
+++ b/man/bayesfactor_models.Rd
@@ -63,7 +63,9 @@ analysis with \code{bayesfactor_inclusion}).
\item \code{stanreg} models must have been fitted with a defined \code{diagnostic_file}.
}
\item For \code{BFBayesFactor}, \code{bayesfactor_models()} is mostly a wraparound \code{BayesFactor::extractBF()}.
-\item For all other model types, Bayes factors are computed using the BIC approximation. Note that BICs are extracted from using \link[insight:get_loglikelihood]{insight::get_loglikelihood}, see documentation there for options for dealing with transformed responses and REML estimation.
+\item For all other model types, Bayes factors are computed using the BIC approximation.
+Note that BICs are extracted from using \link[insight:get_loglikelihood]{insight::get_loglikelihood}, see documentation
+there for options for dealing with transformed responses and REML estimation.
}
In order to correctly and precisely estimate Bayes factors, a rule of thumb
@@ -78,7 +80,8 @@ are detected, \code{bayesfactor_models()} gives a warning.
See also \href{https://easystats.github.io/bayestestR/articles/bayes_factors.html}{the Bayes factors vignette}.
}
\note{
-There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
+There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method}
+implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
}
\section{Interpreting Bayes Factors}{
@@ -144,7 +147,7 @@ if (require("rstanarm")) {
family = gaussian(),
diagnostic_file = file.path(tempdir(), "df2.csv")
)
- bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0)
+ bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE)
}
@@ -152,15 +155,15 @@ if (require("rstanarm")) {
# --------------------
# (note the save_pars MUST be set to save_pars(all = TRUE) in order to work)
if (require("brms")) {
- brm1 <- brm(Sepal.Length ~ 1, data = iris, save_all_pars = TRUE)
- brm2 <- brm(Sepal.Length ~ Species, data = iris, save_all_pars = TRUE)
+ brm1 <- brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE))
+ brm2 <- brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE))
brm3 <- brm(
Sepal.Length ~ Species + Petal.Length,
data = iris,
save_pars = save_pars(all = TRUE)
)
- bayesfactor_models(brm1, brm2, brm3, denominator = 1)
+ bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE)
}
@@ -176,14 +179,21 @@ if (require("BayesFactor")) {
bayesfactor_models(BF) # basically the same
}
}
+
}
\references{
\itemize{
-\item Gronau, Q. F., Singmann, H., & Wagenmakers, E. J. (2017). Bridgesampling: An R package for estimating normalizing constants. arXiv preprint arXiv:1710.08162.
-\item Kass, R. E., and Raftery, A. E. (1995). Bayes Factors. Journal of the American Statistical Association, 90(430), 773-795.
-\item Robert, C. P. (2016). The expected demise of the Bayes factor. Journal of Mathematical Psychology, 72, 33–37.
-\item Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values. Psychonomic bulletin & review, 14(5), 779-804.
-\item Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011). Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests. Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923}
+\item Gronau, Q. F., Singmann, H., & Wagenmakers, E. J. (2017). Bridgesampling: An R package for estimating
+normalizing constants. arXiv preprint arXiv:1710.08162.
+\item Kass, R. E., and Raftery, A. E. (1995). Bayes Factors. Journal of the American Statistical Association,
+90(430), 773-795.
+\item Robert, C. P. (2016). The expected demise of the Bayes factor. Journal of Mathematical Psychology,
+72, 33–37.
+\item Wagenmakers, E. J. (2007). A practical solution to the pervasive problems of p values.
+Psychonomic bulletin & review, 14(5), 779-804.
+\item Wetzels, R., Matzke, D., Lee, M. D., Rouder, J. N., Iverson, G. J., and Wagenmakers, E.-J. (2011).
+Statistical Evidence in Experimental Psychology: An Empirical Comparison Using 855 t Tests.
+Perspectives on Psychological Science, 6(3), 291–298. \doi{10.1177/1745691611406923}
}
}
\author{
diff --git a/man/bayesfactor_parameters.Rd b/man/bayesfactor_parameters.Rd
index 0c22d54..1aa57fb 100644
--- a/man/bayesfactor_parameters.Rd
+++ b/man/bayesfactor_parameters.Rd
@@ -259,7 +259,7 @@ library(bayestestR)
if (require("logspline")) {
prior <- distribution_normal(1000, mean = 0, sd = 1)
posterior <- distribution_normal(1000, mean = .5, sd = .3)
- (BF_pars <- bayesfactor_parameters(posterior, prior))
+ (BF_pars <- bayesfactor_parameters(posterior, prior, verbose = FALSE))
as.numeric(BF_pars)
}
@@ -268,18 +268,22 @@ if (require("logspline")) {
# ---------------
if (require("rstanarm") && require("emmeans") && require("logspline")) {
contrasts(sleep$group) <- contr.equalprior_pairs # see vingette
- stan_model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
- bayesfactor_parameters(stan_model)
+ stan_model <- suppressWarnings(stan_lmer(
+ extra ~ group + (1 | ID),
+ data = sleep,
+ refresh = 0
+ ))
+ bayesfactor_parameters(stan_model, verbose = FALSE)
bayesfactor_parameters(stan_model, null = rope_range(stan_model))
# emmGrid objects
# ---------------
group_diff <- pairs(emmeans(stan_model, ~group))
- bayesfactor_parameters(group_diff, prior = stan_model)
+ bayesfactor_parameters(group_diff, prior = stan_model, verbose = FALSE)
# Or
group_diff_prior <- pairs(emmeans(unupdate(stan_model), ~group))
- bayesfactor_parameters(group_diff, prior = group_diff_prior)
+ bayesfactor_parameters(group_diff, prior = group_diff_prior, verbose = FALSE)
}
# brms models
@@ -290,11 +294,12 @@ if (require("brms")) {
set_prior("student_t(3, 0, 1)", class = "b") +
set_prior("student_t(3, 0, 1)", class = "sd", group = "ID")
- brms_model <- brm(extra ~ group + (1 | ID),
+ brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID),
data = sleep,
- prior = my_custom_priors
- )
- bayesfactor_parameters(brms_model)
+ prior = my_custom_priors,
+ refresh = 0
+ ))
+ bayesfactor_parameters(brms_model, verbose = FALSE)
}
}
}
diff --git a/man/bayesfactor_restricted.Rd b/man/bayesfactor_restricted.Rd
index 6a40643..1d95b6f 100644
--- a/man/bayesfactor_restricted.Rd
+++ b/man/bayesfactor_restricted.Rd
@@ -7,6 +7,7 @@
\alias{bayesfactor_restricted.brmsfit}
\alias{bayesfactor_restricted.blavaan}
\alias{bayesfactor_restricted.emmGrid}
+\alias{as.logical.bayesfactor_restricted}
\title{Bayes Factors (BF) for Order Restricted Models}
\usage{
bayesfactor_restricted(
@@ -54,6 +55,8 @@ bf_restricted(posterior, hypothesis, prior = NULL, verbose = TRUE, ...)
verbose = TRUE,
...
)
+
+\method{as.logical}{bayesfactor_restricted}(x, which = c("posterior", "prior"), ...)
}
\arguments{
\item{posterior}{A \code{stanreg} / \code{brmsfit} object, \code{emmGrid} or a data frame - representing a posterior distribution(s) from (see Details).}
@@ -72,6 +75,10 @@ returned? Only applies to mixed models. May be abbreviated.}
\item{component}{Should results for all parameters, parameters for the
conditional model or the zero-inflated part of the model be returned? May
be abbreviated. Only applies to \pkg{brms}-models.}
+
+\item{x}{An object of class \code{bayesfactor_restricted}}
+
+\item{which}{Should the logical matrix be of the posterior or prior distribution(s)?}
}
\value{
A data frame containing the (log) Bayes factor representing evidence
@@ -157,59 +164,62 @@ hyps <- c(
"C > A"
)
-if (getRversion() > "3.5.0") {
- (b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior))
- as.numeric(b)
+(b <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior))
- if (require("see") && require("patchwork")) {
- i <- attr(b, "bool_results")[["posterior"]]
+bool <- as.logical(b, which = "posterior")
+head(bool)
- see::plots(
- plot(estimate_density(posterior)),
- # distribution **conditional** on the restrictions
- plot(estimate_density(posterior[i[[hyps[1]]], ])) + ggplot2::ggtitle(hyps[1]),
- plot(estimate_density(posterior[i[[hyps[2]]], ])) + ggplot2::ggtitle(hyps[2]),
- plot(estimate_density(posterior[i[[hyps[3]]], ])) + ggplot2::ggtitle(hyps[3]),
- guides = "collect"
- )
- }
-}
+\dontshow{if (require("see") && require("patchwork")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+see::plots(
+ plot(estimate_density(posterior)),
+ # distribution **conditional** on the restrictions
+ plot(estimate_density(posterior[bool[, hyps[1]], ])) + ggplot2::ggtitle(hyps[1]),
+ plot(estimate_density(posterior[bool[, hyps[2]], ])) + ggplot2::ggtitle(hyps[2]),
+ plot(estimate_density(posterior[bool[, hyps[3]], ])) + ggplot2::ggtitle(hyps[3]),
+ guides = "collect"
+)
+\dontshow{\}) # examplesIf}
+\dontshow{if (require("rstanarm")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
\dontrun{
# rstanarm models
# ---------------
-if (require("rstanarm") && require("emmeans")) {
- fit_stan <- stan_glm(mpg ~ wt + cyl + am,
- data = mtcars, refresh = 0
- )
- hyps <- c(
- "am > 0 & cyl < 0",
- "cyl < 0",
- "wt - cyl > 0"
- )
- bayesfactor_restricted(fit_stan, hypothesis = hyps)
-
- # emmGrid objects
- # ---------------
- # replicating http://bayesfactor.blogspot.com/2015/01/multiple-comparisons-with-bayesfactor-2.html
- disgust_data <- read.table(url("http://www.learnbayes.org/disgust_example.txt"), header = TRUE)
-
- contrasts(disgust_data$condition) <- contr.equalprior_pairs # see vignette
- fit_model <- stan_glm(score ~ condition, data = disgust_data, family = gaussian())
-
- em_condition <- emmeans(fit_model, ~condition)
- hyps <- c("lemon < control & control < sulfur")
-
- bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps)
- # > # Bayes Factor (Order-Restriction)
- # >
- # > Hypothesis P(Prior) P(Posterior) BF
- # > lemon < control & control < sulfur 0.17 0.75 4.49
- # > ---
- # > Bayes factors for the restricted model vs. the un-restricted model.
-}
+data("mtcars")
+
+fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am,
+ data = mtcars, refresh = 0
+)
+hyps <- c(
+ "am > 0 & cyl < 0",
+ "cyl < 0",
+ "wt - cyl > 0"
+)
+
+bayesfactor_restricted(fit_stan, hypothesis = hyps)
}
+\dontshow{\}) # examplesIf}
+\dontshow{if (require("rstanarm") && require("emmeans")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+\dontrun{
+# emmGrid objects
+# ---------------
+# replicating http://bayesfactor.blogspot.com/2015/01/multiple-comparisons-with-bayesfactor-2.html
+data("disgust")
+contrasts(disgust$condition) <- contr.equalprior_pairs # see vignette
+fit_model <- rstanarm::stan_glm(score ~ condition, data = disgust, family = gaussian())
+
+em_condition <- emmeans::emmeans(fit_model, ~condition)
+hyps <- c("lemon < control & control < sulfur")
+
+bayesfactor_restricted(em_condition, prior = fit_model, hypothesis = hyps)
+# > # Bayes Factor (Order-Restriction)
+# >
+# > Hypothesis P(Prior) P(Posterior) BF
+# > lemon < control & control < sulfur 0.17 0.75 4.49
+# > ---
+# > Bayes factors for the restricted model vs. the un-restricted model.
+}
+\dontshow{\}) # examplesIf}
}
\references{
\itemize{
diff --git a/man/bayestestR-package.Rd b/man/bayestestR-package.Rd
new file mode 100644
index 0000000..e0e3c57
--- /dev/null
+++ b/man/bayestestR-package.Rd
@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/bayestestR-package.R
+\docType{package}
+\name{bayestestR-package}
+\alias{bayestestR-package}
+\alias{_PACKAGE}
+\alias{bayestestR}
+\title{bayestestR: Describing Effects and their Uncertainty, Existence and
+Significance within the Bayesian Framework}
+\description{
+Existing R packages allow users to easily fit a large variety of models
+and extract and visualize the posterior draws. However, most of these
+packages only return a limited set of indices (e.g., point-estimates and
+CIs). \strong{bayestestR} provides a comprehensive and consistent set of
+functions to analyze and describe posterior distributions generated by a
+variety of models objects, including popular modeling packages such as
+\strong{rstanarm}, \strong{brms} or \strong{BayesFactor}.
+
+References:
+\itemize{
+\item Makowski et al. (2019) \doi{10.21105/joss.01541}
+\item Makowski et al. (2019) \doi{10.3389/fpsyg.2019.02767}
+}
+}
+\details{
+\code{bayestestR}
+}
+\seealso{
+Useful links:
+\itemize{
+ \item \url{https://easystats.github.io/bayestestR/}
+ \item Report bugs at \url{https://github.com/easystats/bayestestR/issues}
+}
+
+}
+\author{
+\strong{Maintainer}: Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) (@Dom_Makowski)
+
+Authors:
+\itemize{
+ \item Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) (@strengejacke)
+ \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) (@mattansb)
+ \item Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) (@patilindrajeets)
+ \item Michael D. Wilson \email{michael.d.wilson@curtin.edu.au} (\href{https://orcid.org/0000-0003-4143-7308}{ORCID})
+ \item Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) (@bmwiernik)
+}
+
+Other contributors:
+\itemize{
+ \item Paul-Christian Bürkner \email{paul.buerkner@gmail.com} [reviewer]
+ \item Tristan Mahr \email{tristan.mahr@wisc.edu} (\href{https://orcid.org/0000-0002-8890-5116}{ORCID}) [reviewer]
+ \item Henrik Singmann \email{singmann@gmail.com} (\href{https://orcid.org/0000-0002-4842-3657}{ORCID}) [contributor]
+ \item Quentin F. Gronau (\href{https://orcid.org/0000-0001-5510-6943}{ORCID}) [contributor]
+ \item Sam Crawley \email{sam@crawley.nz} (\href{https://orcid.org/0000-0002-7847-0411}{ORCID}) [contributor]
+}
+
+}
+\keyword{internal}
diff --git a/man/bci.Rd b/man/bci.Rd
index 1afe0c9..739fa7c 100644
--- a/man/bci.Rd
+++ b/man/bci.Rd
@@ -148,7 +148,7 @@ the resulting HDI.
\examples{
posterior <- rnorm(1000)
bci(posterior)
-bci(posterior, ci = c(.80, .89, .95))
+bci(posterior, ci = c(0.80, 0.89, 0.95))
}
\references{
DiCiccio, T. J. and B. Efron. (1996). Bootstrap Confidence Intervals.
diff --git a/man/check_prior.Rd b/man/check_prior.Rd
index 40ab268..46c6a59 100644
--- a/man/check_prior.Rd
+++ b/man/check_prior.Rd
@@ -49,7 +49,8 @@ if (require("rstanarm")) {
)
check_prior(model, method = "gelman")
check_prior(model, method = "lakeland")
- plot(si(model)) # can provide visual confirmation to the Lakeland method
+ # can provide visual confirmation to the Lakeland method
+ plot(si(model, verbose = FALSE))
}
}
}
diff --git a/man/ci.Rd b/man/ci.Rd
index e00e079..f7bf27c 100644
--- a/man/ci.Rd
+++ b/man/ci.Rd
@@ -95,7 +95,9 @@ A data frame with following columns:
}
}
\description{
-Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals (SI) for Bayesian and frequentist models. The Documentation is accessible for:
+Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals
+(SI) for Bayesian and frequentist models. The Documentation is accessible
+for:
}
\details{
\itemize{
@@ -112,6 +114,7 @@ the data should not seem very surprising} (\cite{Gelman & Greenland 2019}).
There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
}
\examples{
+\dontshow{if (require("rstanarm", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
library(bayestestR)
posterior <- rnorm(1000)
@@ -119,36 +122,25 @@ ci(posterior, method = "ETI")
ci(posterior, method = "HDI")
df <- data.frame(replicate(4, rnorm(100)))
-ci(df, method = "ETI", ci = c(.80, .89, .95))
-ci(df, method = "HDI", ci = c(.80, .89, .95))
-\dontrun{
-if (require("rstanarm")) {
- model <- stan_glm(mpg ~ wt, data = mtcars, chains = 2, iter = 200, refresh = 0)
- ci(model, method = "ETI", ci = c(.80, .89))
- ci(model, method = "HDI", ci = c(.80, .89))
- ci(model, method = "SI")
-}
-
-if (require("brms")) {
- model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
- ci(model, method = "ETI")
- ci(model, method = "HDI")
- ci(model, method = "SI")
-}
-
-if (require("BayesFactor")) {
- bf <- ttestBF(x = rnorm(100, 1, 1))
- ci(bf, method = "ETI")
- ci(bf, method = "HDI")
-}
+ci(df, method = "ETI", ci = c(0.80, 0.89, 0.95))
+ci(df, method = "HDI", ci = c(0.80, 0.89, 0.95))
-if (require("emmeans")) {
- model <- emtrends(model, ~1, "wt")
- ci(model, method = "ETI")
- ci(model, method = "HDI")
- ci(model, method = "SI")
-}
-}
+model <- suppressWarnings(
+ stan_glm(mpg ~ wt, data = mtcars, chains = 2, iter = 200, refresh = 0)
+)
+ci(model, method = "ETI", ci = c(0.80, 0.89))
+ci(model, method = "HDI", ci = c(0.80, 0.89))
+\dontshow{\}) # examplesIf}
+\dontshow{if (require("BayesFactor", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+bf <- ttestBF(x = rnorm(100, 1, 1))
+ci(bf, method = "ETI")
+ci(bf, method = "HDI")
+\dontshow{\}) # examplesIf}
+\dontshow{if (require("emmeans", quietly = TRUE) && require("rstanarm", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+model <- emtrends(model, ~1, "wt")
+ci(model, method = "ETI")
+ci(model, method = "HDI")
+\dontshow{\}) # examplesIf}
}
\references{
Gelman A, Greenland S. Are confidence intervals better termed "uncertainty intervals"? BMJ 2019;l5381. 10.1136/bmj.l5381
diff --git a/man/cwi.Rd b/man/cwi.Rd
index fdff28b..5981018 100644
--- a/man/cwi.Rd
+++ b/man/cwi.Rd
@@ -68,12 +68,12 @@ if (require("ggplot2") && require("rstanarm") && require("ggdist")) {
data[c("ETI_low", "ETI_high")] <- eti(iters, ci = 0.5)[c("CI_low", "CI_high")]
# Compute CWI
- # ggdist::curve_interval(reshape_iterations(data), iter_value .width = c(.5))
+ # ggdist::curve_interval(reshape_iterations(data), iter_value .width = 0.5)
# Visualization =============================================
ggplot(data, aes(x = x, y = Median)) +
geom_ribbon(aes(ymin = ETI_low, ymax = ETI_high), fill = "red", alpha = 0.3) +
- geom_line(size = 1) +
+ geom_line(linewidth = 1) +
geom_line(
data = reshape_iterations(data),
aes(y = iter_value, group = iter_group),
diff --git a/man/describe_posterior.Rd b/man/describe_posterior.Rd
index 66be2c6..58ec60e 100644
--- a/man/describe_posterior.Rd
+++ b/man/describe_posterior.Rd
@@ -144,17 +144,30 @@ library(bayestestR)
if (require("logspline")) {
x <- rnorm(1000)
- describe_posterior(x)
- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")
- describe_posterior(x, ci = c(0.80, 0.90))
+ describe_posterior(x, verbose = FALSE)
+ describe_posterior(x,
+ centrality = "all",
+ dispersion = TRUE,
+ test = "all",
+ verbose = FALSE
+ )
+ describe_posterior(x, ci = c(0.80, 0.90), verbose = FALSE)
df <- data.frame(replicate(4, rnorm(100)))
- describe_posterior(df)
- describe_posterior(df, centrality = "all", dispersion = TRUE, test = "all")
- describe_posterior(df, ci = c(0.80, 0.90))
+ describe_posterior(df, verbose = FALSE)
+ describe_posterior(
+ df,
+ centrality = "all",
+ dispersion = TRUE,
+ test = "all",
+ verbose = FALSE
+ )
+ describe_posterior(df, ci = c(0.80, 0.90), verbose = FALSE)
df <- data.frame(replicate(4, rnorm(20)))
- head(reshape_iterations(describe_posterior(df, keep_iterations = TRUE)))
+ head(reshape_iterations(
+ describe_posterior(df, keep_iterations = TRUE, verbose = FALSE)
+ ))
}
\dontrun{
# rstanarm models
@@ -170,15 +183,6 @@ if (require("rstanarm") && require("emmeans")) {
describe_posterior(emtrends(model, ~1, "wt"))
}
-# brms models
-# -----------------------------------------------
-if (require("brms")) {
- model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
- describe_posterior(model)
- describe_posterior(model, centrality = "all", dispersion = TRUE, test = "all")
- describe_posterior(model, ci = c(0.80, 0.90))
-}
-
# BayesFactor objects
# -----------------------------------------------
if (require("BayesFactor")) {
diff --git a/man/disgust.Rd b/man/disgust.Rd
new file mode 100644
index 0000000..bc75b2a
--- /dev/null
+++ b/man/disgust.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/datasets.R
+\docType{data}
+\name{disgust}
+\alias{disgust}
+\title{Moral Disgust Judgment}
+\format{
+A data frame with 500 rows and 5 variables:
+\describe{
+\item{score}{Score on the questionnaire, which ranges from 0 to 50 with higher scores representing harsher moral judgment}
+\item{condition}{one of three conditions, differing by the odor present in the room: a pleasant scent associated with cleanliness (lemon), a disgusting scent (sulfur), and a control condition in which no unusual odor is present}
+}
+
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{data("disgust")
+head(disgust, n = 5)
+#> score condition
+#> 1 13 control
+#> 2 26 control
+#> 3 30 control
+#> 4 23 control
+#> 5 34 control
+}\if{html}{\out{</div>}}
+}
+\description{
+A sample (simulated) dataset, used in tests and some examples.
+}
+\author{
+Richard D. Morey
+}
+\keyword{data}
diff --git a/man/equivalence_test.Rd b/man/equivalence_test.Rd
index 87cb286..44d3b6e 100644
--- a/man/equivalence_test.Rd
+++ b/man/equivalence_test.Rd
@@ -50,7 +50,8 @@ each response variable. Vector names should correspond to the name of the respon
variables. If \code{"default"} and input is a vector, the range is set to \code{c(-0.1, 0.1)}. If \code{"default"} and input is a Bayesian model,
\code{\link[=rope_range]{rope_range()}} is used.}
-\item{ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.}
+\item{ci}{The Credible Interval (CI) probability, corresponding to the
+proportion of HDI, to use for the percentage in ROPE.}
\item{verbose}{Toggle off warnings.}
@@ -145,7 +146,6 @@ print(test, digits = 4)
library(rstanarm)
model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars)
equivalence_test(model)
-equivalence_test(model, ci = c(.50, 1))
# plot result
test <- equivalence_test(model)
@@ -157,12 +157,10 @@ equivalence_test(emtrends(model, ~1, "wt"))
library(brms)
model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
equivalence_test(model)
-equivalence_test(model, ci = c(.50, .99))
library(BayesFactor)
bf <- ttestBF(x = rnorm(100, 1, 1))
-equivalence_test(bf)
-equivalence_test(bf, ci = c(.50, .99))
+# equivalence_test(bf)
}
}
\references{
diff --git a/man/estimate_density.Rd b/man/estimate_density.Rd
index 3c066f6..ac9b750 100644
--- a/man/estimate_density.Rd
+++ b/man/estimate_density.Rd
@@ -55,6 +55,7 @@ This function is a wrapper over different methods of density estimation. By defa
There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{\code{plot()}-method} implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
}
\examples{
+\dontshow{if (requireNamespace("logspline", quietly = TRUE) && requireNamespace("KernSmooth", quietly = TRUE) && requireNamespace("mclust", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
library(bayestestR)
set.seed(1)
@@ -114,7 +115,7 @@ library(brms)
model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
estimate_density(model)
}
-
+\dontshow{\}) # examplesIf}
}
\references{
Deng, H., & Wickham, H. (2011). Density estimation in R. Electronic publication.
diff --git a/man/eti.Rd b/man/eti.Rd
index 350b38b..2769e21 100644
--- a/man/eti.Rd
+++ b/man/eti.Rd
@@ -68,7 +68,11 @@ A data frame with following columns:
}
}
\description{
-Compute the \strong{Equal-Tailed Interval (ETI)} of posterior distributions using the quantiles method. The probability of being below this interval is equal to the probability of being above it. The ETI can be used in the context of uncertainty characterisation of posterior distributions as \strong{Credible Interval (CI)}.
+Compute the \strong{Equal-Tailed Interval (ETI)} of posterior distributions using
+the quantiles method. The probability of being below this interval is equal
+to the probability of being above it. The ETI can be used in the context of
+uncertainty characterisation of posterior distributions as
+\strong{Credible Interval (CI)}.
}
\details{
Unlike equal-tailed intervals (see \code{eti()}) that typically exclude \verb{2.5\%}
@@ -121,16 +125,16 @@ library(bayestestR)
posterior <- rnorm(1000)
eti(posterior)
-eti(posterior, ci = c(.80, .89, .95))
+eti(posterior, ci = c(0.80, 0.89, 0.95))
df <- data.frame(replicate(4, rnorm(100)))
eti(df)
-eti(df, ci = c(.80, .89, .95))
+eti(df, ci = c(0.80, 0.89, 0.95))
\dontrun{
library(rstanarm)
model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0)
eti(model)
-eti(model, ci = c(.80, .89, .95))
+eti(model, ci = c(0.80, 0.89, 0.95))
library(emmeans)
eti(emtrends(model, ~1, "wt"))
@@ -138,12 +142,12 @@ eti(emtrends(model, ~1, "wt"))
library(brms)
model <- brms::brm(mpg ~ wt + cyl, data = mtcars)
eti(model)
-eti(model, ci = c(.80, .89, .95))
+eti(model, ci = c(0.80, 0.89, 0.95))
library(BayesFactor)
bf <- ttestBF(x = rnorm(100, 1, 1))
eti(bf)
-eti(bf, ci = c(.80, .89, .95))
+eti(bf, ci = c(0.80, 0.89, 0.95))
}
}
diff --git a/man/hdi.Rd b/man/hdi.Rd
index 5597e01..19b25da 100644
--- a/man/hdi.Rd
+++ b/man/hdi.Rd
@@ -129,7 +129,7 @@ There is also a \href{https://easystats.github.io/see/articles/bayestestR.html}{
library(bayestestR)
posterior <- rnorm(1000)
-hdi(posterior, ci = .89)
+hdi(posterior, ci = 0.89)
hdi(posterior, ci = c(.80, .90, .95))
df <- data.frame(replicate(4, rnorm(100)))
@@ -173,6 +173,6 @@ Other ci:
\code{\link{spi}()}
}
\author{
-Credits go to \href{https://rdrr.io/cran/ggdistribute/src/R/stats.R}{ggdistribute} and \href{https://github.com/mikemeredith/HDInterval}{HDInterval}.
+Credits go to \strong{ggdistribute} and \href{https://github.com/mikemeredith/HDInterval}{\strong{HDInterval}}.
}
\concept{ci}
diff --git a/man/mediation.Rd b/man/mediation.Rd
index 40948c0..6701945 100644
--- a/man/mediation.Rd
+++ b/man/mediation.Rd
@@ -137,8 +137,8 @@ m3 <- stan_mvmer(
)
summary(m1)
-mediation(m2, centrality = "mean", ci = .95)
-mediation(m3, centrality = "mean", ci = .95)
+mediation(m2, centrality = "mean", ci = 0.95)
+mediation(m3, centrality = "mean", ci = 0.95)
}
}
\references{
diff --git a/man/p_map.Rd b/man/p_map.Rd
index 769eb56..14e21c0 100644
--- a/man/p_map.Rd
+++ b/man/p_map.Rd
@@ -7,12 +7,13 @@
\alias{p_map.brmsfit}
\title{Bayesian p-value based on the density at the Maximum A Posteriori (MAP)}
\usage{
-p_map(x, precision = 2^10, method = "kernel", ...)
+p_map(x, null = 0, precision = 2^10, method = "kernel", ...)
-p_pointnull(x, precision = 2^10, method = "kernel", ...)
+p_pointnull(x, null = 0, precision = 2^10, method = "kernel", ...)
\method{p_map}{stanreg}(
x,
+ null = 0,
precision = 2^10,
method = "kernel",
effects = c("fixed", "random", "all"),
@@ -24,6 +25,7 @@ p_pointnull(x, precision = 2^10, method = "kernel", ...)
\method{p_map}{brmsfit}(
x,
+ null = 0,
precision = 2^10,
method = "kernel",
effects = c("fixed", "random", "all"),
@@ -39,6 +41,8 @@ of models (see, for example, \code{methods("hdi")}) and not all of those are
documented in the 'Usage' section, because methods for other classes mostly
resemble the arguments of the \code{.numeric} or \code{.data.frame}methods.}
+\item{null}{The value considered as a "null" effect. Traditionally 0, but could also be 1 in the case of ratios.}
+
\item{precision}{Number of points of density data. See the \code{n} parameter in \code{density}.}
\item{method}{Density estimation method. Can be \code{"kernel"} (default), \code{"logspline"} or \code{"KernSmooth"}.}
@@ -59,7 +63,11 @@ filtered by default, so only parameters that typically appear in the
for the output.}
}
\description{
-Compute a Bayesian equivalent of the \emph{p}-value, related to the odds that a parameter (described by its posterior distribution) has against the null hypothesis (\emph{h0}) using Mills' (2014, 2017) \emph{Objective Bayesian Hypothesis Testing} framework. It corresponds to the density value at 0 divided by the density at the Maximum A Posteriori (MAP).
+Compute a Bayesian equivalent of the \emph{p}-value, related to the odds that a
+parameter (described by its posterior distribution) has against the null
+hypothesis (\emph{h0}) using Mills' (2014, 2017) \emph{Objective Bayesian Hypothesis
+Testing} framework. It corresponds to the density value at the null (e.g., 0)
+divided by the density at the Maximum A Posteriori (MAP).
}
\details{
Note that this method is sensitive to the density estimation \code{method} (see the section in the examples below).
diff --git a/man/reexports.Rd b/man/reexports.Rd
index 5fd15a4..877deef 100644
--- a/man/reexports.Rd
+++ b/man/reexports.Rd
@@ -1,11 +1,10 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/print_html.R, R/print_md.R, R/reexports.R
+% Please edit documentation in R/print_html.R, R/print_md.R
\docType{import}
\name{reexports}
\alias{reexports}
\alias{print_html}
\alias{print_md}
-\alias{reshape_ci}
\title{Objects exported from other packages}
\keyword{internal}
\description{
@@ -13,8 +12,6 @@ These objects are imported from other packages. Follow the links
below to see their documentation.
\describe{
- \item{datawizard}{\code{\link[datawizard]{reshape_ci}}}
-
\item{insight}{\code{\link[insight:display]{print_html}}, \code{\link[insight:display]{print_md}}}
}}
diff --git a/man/rope.Rd b/man/rope.Rd
index 7a8f22b..689c7a1 100644
--- a/man/rope.Rd
+++ b/man/rope.Rd
@@ -49,9 +49,11 @@ each response variable. Vector names should correspond to the name of the respon
variables. If \code{"default"} and input is a vector, the range is set to \code{c(-0.1, 0.1)}. If \code{"default"} and input is a Bayesian model,
\code{\link[=rope_range]{rope_range()}} is used.}
-\item{ci}{The Credible Interval (CI) probability, corresponding to the proportion of HDI, to use for the percentage in ROPE.}
+\item{ci}{The Credible Interval (CI) probability, corresponding to the
+proportion of HDI, to use for the percentage in ROPE.}
-\item{ci_method}{The type of interval to use to quantify the percentage in ROPE. Can be 'HDI' (default) or 'ETI'. See \code{\link[=ci]{ci()}}.}
+\item{ci_method}{The type of interval to use to quantify the percentage in
+ROPE. Can be 'HDI' (default) or 'ETI'. See \code{\link[=ci]{ci()}}.}
\item{verbose}{Toggle off warnings.}
diff --git a/man/sensitivity_to_prior.Rd b/man/sensitivity_to_prior.Rd
index a499341..6968179 100644
--- a/man/sensitivity_to_prior.Rd
+++ b/man/sensitivity_to_prior.Rd
@@ -9,14 +9,22 @@ sensitivity_to_prior(model, index = "Median", magnitude = 10, ...)
\arguments{
\item{model}{A Bayesian model (\code{stanreg} or \code{brmsfit}).}
-\item{index}{The indices from which to compute the sensitivity. Can be one or multiple names of the columns returned by \code{describe_posterior}. The case is important here (e.g., write 'Median' instead of 'median').}
+\item{index}{The indices from which to compute the sensitivity. Can be one or
+multiple names of the columns returned by \code{describe_posterior}. The case is
+important here (e.g., write 'Median' instead of 'median').}
-\item{magnitude}{This represent the magnitude by which to shift the antagonistic prior (to test the sensitivity). For instance, a magnitude of 10 (default) means that the mode wil be updated with a prior located at 10 standard deviations from its original location.}
+\item{magnitude}{This represent the magnitude by which to shift the
+antagonistic prior (to test the sensitivity). For instance, a magnitude of
+10 (default) means that the mode wil be updated with a prior located at 10
+standard deviations from its original location.}
\item{...}{Arguments passed to or from other methods.}
}
\description{
-Computes the sensitivity to priors specification. This represents the proportion of change in some indices when the model is fitted with an antagonistic prior (a prior of same shape located on the opposite of the effect).
+Computes the sensitivity to priors specification. This represents the
+proportion of change in some indices when the model is fitted with an
+antagonistic prior (a prior of same shape located on the opposite of the
+effect).
}
\examples{
\dontrun{
diff --git a/man/sexit_thresholds.Rd b/man/sexit_thresholds.Rd
index 55e34ab..d4fa774 100644
--- a/man/sexit_thresholds.Rd
+++ b/man/sexit_thresholds.Rd
@@ -12,7 +12,11 @@ sexit_thresholds(x, ...)
\item{...}{Currently not used.}
}
\description{
-This function attempts at automatically finding suitable default values for a "significant" (i.e., non-negligible) and "large" effect. This is to be used with care, and the chosen threshold should always be explicitly reported and justified. See the detail section in \code{\link[=sexit]{sexit()}} for more information.
+This function attempts at automatically finding suitable default
+values for a "significant" (i.e., non-negligible) and "large" effect. This is
+to be used with care, and the chosen threshold should always be explicitly
+reported and justified. See the detail section in \code{\link[=sexit]{sexit()}} for more
+information.
}
\examples{
sexit_thresholds(rnorm(1000))
diff --git a/man/si.Rd b/man/si.Rd
index 8e0e30c..d98cc70 100644
--- a/man/si.Rd
+++ b/man/si.Rd
@@ -20,8 +20,8 @@ si(posterior, prior = NULL, BF = 1, verbose = TRUE, ...)
BF = 1,
verbose = TRUE,
effects = c("fixed", "random", "all"),
- component = c("conditional", "location", "zi", "zero_inflated", "all", "smooth_terms",
- "sigma", "distributional", "auxiliary"),
+ component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary",
+ "distributional"),
parameters = NULL,
...
)
@@ -32,8 +32,8 @@ si(posterior, prior = NULL, BF = 1, verbose = TRUE, ...)
BF = 1,
verbose = TRUE,
effects = c("fixed", "random", "all"),
- component = c("conditional", "location", "zi", "zero_inflated", "all", "smooth_terms",
- "sigma", "distributional", "auxiliary"),
+ component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary",
+ "distributional"),
parameters = NULL,
...
)
@@ -44,8 +44,8 @@ si(posterior, prior = NULL, BF = 1, verbose = TRUE, ...)
BF = 1,
verbose = TRUE,
effects = c("fixed", "random", "all"),
- component = c("conditional", "location", "zi", "zero_inflated", "all", "smooth_terms",
- "sigma", "distributional", "auxiliary"),
+ component = c("location", "conditional", "all", "smooth_terms", "sigma", "auxiliary",
+ "distributional"),
parameters = NULL,
...
)
@@ -149,6 +149,7 @@ It is important to provide the correct \code{prior} for meaningful results.
}
\examples{
+\dontshow{if (requireNamespace("logspline", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
library(bayestestR)
prior <- distribution_normal(1000, mean = 0, sd = 1)
@@ -159,7 +160,7 @@ si(posterior, prior)
# rstanarm models
# ---------------
library(rstanarm)
-contrasts(sleep$group) <- contr.equalprior_pairs # see vingette
+contrasts(sleep$group) <- contr.equalprior_pairs # see vignette
stan_model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
si(stan_model)
si(stan_model, BF = 3)
@@ -178,12 +179,14 @@ my_custom_priors <-
set_prior("student_t(3, 0, 1)", class = "b") +
set_prior("student_t(3, 0, 1)", class = "sd", group = "ID")
-brms_model <- brm(extra ~ group + (1 | ID),
+brms_model <- suppressWarnings(brm(extra ~ group + (1 | ID),
data = sleep,
- prior = my_custom_priors
-)
+ prior = my_custom_priors,
+ refresh = 0
+))
si(brms_model)
}
+\dontshow{\}) # examplesIf}
}
\references{
Wagenmakers, E., Gronau, Q. F., Dablander, F., & Etz, A. (2018, November 22). The Support Interval. \doi{10.31234/osf.io/zwnxb}
diff --git a/man/spi.Rd b/man/spi.Rd
index d97da5e..102dbfd 100644
--- a/man/spi.Rd
+++ b/man/spi.Rd
@@ -87,21 +87,22 @@ and slightly modified to be more robust for Stan models. Thus, credits go
to Ying Liu for the original SPI algorithm and R implementation.
}
\examples{
+\dontshow{if (requireNamespace("quadprog", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
library(bayestestR)
posterior <- rnorm(1000)
spi(posterior)
-spi(posterior, ci = c(.80, .89, .95))
+spi(posterior, ci = c(0.80, 0.89, 0.95))
df <- data.frame(replicate(4, rnorm(100)))
spi(df)
-spi(df, ci = c(.80, .89, .95))
+spi(df, ci = c(0.80, 0.89, 0.95))
\dontrun{
library(rstanarm)
model <- stan_glm(mpg ~ wt + gear, data = mtcars, chains = 2, iter = 200, refresh = 0)
spi(model)
}
-
+\dontshow{\}) # examplesIf}
}
\references{
Liu, Y., Gelman, A., & Zheng, T. (2015). Simulation-efficient shortest probability intervals. Statistics and Computing, 25(4), 809–819. https://doi.org/10.1007/s11222-015-9563-8
diff --git a/man/weighted_posteriors.Rd b/man/weighted_posteriors.Rd
index ea58571..18530c4 100644
--- a/man/weighted_posteriors.Rd
+++ b/man/weighted_posteriors.Rd
@@ -124,7 +124,6 @@ if (require("rstanarm") && require("see")) {
diagnostic_file = file.path(tempdir(), "df1.csv")
)
-
res <- weighted_posteriors(stan_m0, stan_m1)
plot(eti(res))
diff --git a/tests/testthat.R b/tests/testthat.R
index 514207d..eea030a 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,10 +1,4 @@
library(testthat)
library(bayestestR)
-if (length(strsplit(packageDescription("bayestestR")$Version, "\\.")[[1]]) > 3) {
- Sys.setenv("RunAllbayestestRTests" = "yes")
-} else {
- Sys.setenv("RunAllbayestestRTests" = "no")
-}
-
test_check("bayestestR")
diff --git a/tests/testthat/helper-requiet.R b/tests/testthat/helper-requiet.R
deleted file mode 100644
index 35affba..0000000
--- a/tests/testthat/helper-requiet.R
+++ /dev/null
@@ -1,6 +0,0 @@
-requiet <- function(package) {
- testthat::skip_if_not_installed(package)
- suppressPackageStartupMessages(
- require(package, warn.conflicts = FALSE, character.only = TRUE)
- )
-}
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
new file mode 100644
index 0000000..240d8ed
--- /dev/null
+++ b/tests/testthat/helper.R
@@ -0,0 +1,6 @@
+skip_if_not_or_load_if_installed <- function(package, minimum_version = NULL) {
+ testthat::skip_if_not_installed(package, minimum_version = minimum_version)
+ suppressMessages(suppressWarnings(suppressPackageStartupMessages(
+ require(package, warn.conflicts = FALSE, character.only = TRUE, quietly = TRUE)
+ )))
+}
diff --git a/tests/testthat/test-BFBayesFactor.R b/tests/testthat/test-BFBayesFactor.R
index e13d0cd..dc3fc75 100644
--- a/tests/testthat/test-BFBayesFactor.R
+++ b/tests/testthat/test-BFBayesFactor.R
@@ -1,86 +1,85 @@
-if (requiet("testthat") && requiet("BayesFactor") && requiet("bayestestR")) {
+test_that("p_direction", {
+ skip_if_not_or_load_if_installed("BayesFactor")
set.seed(333)
- x <- BayesFactor::correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
- test_that("p_direction", {
- expect_equal(as.numeric(p_direction(x)), 0.9225, tolerance = 1)
- })
+ x <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
+ expect_equal(as.numeric(p_direction(x)), 0.9225, tolerance = 1)
+})
-
- # BF t.test one sample ---------------------------
+test_that("p_direction: BF t.test one sample", {
+ skip_if_not_or_load_if_installed("BayesFactor")
data(sleep)
diffScores <- sleep$extra[1:10] - sleep$extra[11:20]
- x <- BayesFactor::ttestBF(x = diffScores)
- test_that("p_direction", {
- expect_equal(as.numeric(p_direction(x)), 0.99675, tolerance = 1)
- })
+ x <- ttestBF(x = diffScores)
+ expect_equal(as.numeric(p_direction(x)), 0.99675, tolerance = 1)
+})
- # BF t.test two samples ---------------------------
+test_that("p_direction: BF t.test two samples", {
+ skip_if_not_or_load_if_installed("BayesFactor")
data(chickwts)
chickwts <- chickwts[chickwts$feed %in% c("horsebean", "linseed"), ]
chickwts$feed <- factor(chickwts$feed)
- x <- BayesFactor::ttestBF(formula = weight ~ feed, data = chickwts)
- test_that("p_direction", {
- expect_equal(as.numeric(p_direction(x)), 1, tolerance = 1)
- })
+ x <- ttestBF(formula = weight ~ feed, data = chickwts)
+ expect_equal(as.numeric(p_direction(x)), 1, tolerance = 1)
+})
- # BF t.test meta-analytic ---------------------------
+test_that("p_direction: BF t.test meta-analytic", {
+ skip_if_not_or_load_if_installed("BayesFactor")
t <- c(-.15, 2.39, 2.42, 2.43)
N <- c(100, 150, 97, 99)
- x <- BayesFactor::meta.ttestBF(t = t, n1 = N, rscale = 1)
- test_that("p_direction", {
- expect_equal(as.numeric(p_direction(x)), 0.99975, tolerance = 1)
- })
+ x <- meta.ttestBF(t = t, n1 = N, rscale = 1)
+ expect_equal(as.numeric(p_direction(x)), 0.99975, tolerance = 1)
+})
- # # ---------------------------
- # # "BF ANOVA"
- # data(ToothGrowth)
- # ToothGrowth$dose <- factor(ToothGrowth$dose)
- # levels(ToothGrowth$dose) <- c("Low", "Medium", "High")
- # x <- BayesFactor::anovaBF(len ~ supp*dose, data=ToothGrowth)
- # test_that("p_direction", {
- # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
- # })
- #
- # # ---------------------------
- # # "BF ANOVA Random"
- # data(puzzles)
- # x <- BayesFactor::anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID")
- # test_that("p_direction", {
- # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
- # })
- #
- #
- # # ---------------------------
- # # "BF lm"
- # x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth)
- # test_that("p_direction", {
- # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
- # })
- #
- #
- # x2 <- BayesFactor::lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth)
- # x <- x / x2
- # test_that("p_direction", {
- # expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
- # })
+# # ---------------------------
+# # "BF ANOVA"
+# data(ToothGrowth)
+# ToothGrowth$dose <- factor(ToothGrowth$dose)
+# levels(ToothGrowth$dose) <- c("Low", "Medium", "High")
+# x <- BayesFactor::anovaBF(len ~ supp*dose, data=ToothGrowth)
+# test_that("p_direction", {
+# expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
+# })
+#
+# # ---------------------------
+# # "BF ANOVA Random"
+# data(puzzles)
+# x <- BayesFactor::anovaBF(RT ~ shape*color + ID, data = puzzles, whichRandom="ID")
+# test_that("p_direction", {
+# expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
+# })
+#
+#
+# # ---------------------------
+# # "BF lm"
+# x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth)
+# test_that("p_direction", {
+# expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
+# })
+#
+#
+# x2 <- BayesFactor::lmBF(len ~ supp + dose + supp:dose, data = ToothGrowth)
+# x <- x / x2
+# test_that("p_direction", {
+# expect_equal(as.numeric(p_direction(x)), 91.9, tol=0.1)
+# })
- test_that("rope_range", {
- x <- BayesFactor::lmBF(len ~ supp + dose, data = ToothGrowth)
- expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
+test_that("rope_range", {
+ skip_if_not_or_load_if_installed("BayesFactor")
+ x <- lmBF(len ~ supp + dose, data = ToothGrowth)
+ expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
- x <- BayesFactor::ttestBF(
- ToothGrowth$len[ToothGrowth$supp == "OJ"],
- ToothGrowth$len[ToothGrowth$supp == "VC"]
- )
- expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
+ x <- ttestBF(
+ ToothGrowth$len[ToothGrowth$supp == "OJ"],
+ ToothGrowth$len[ToothGrowth$supp == "VC"]
+ )
+ expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
- x <- BayesFactor::ttestBF(formula = len ~ supp, data = ToothGrowth)
- expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
+ x <- ttestBF(formula = len ~ supp, data = ToothGrowth)
+ expect_equal(rope_range(x)[2], sd(ToothGrowth$len) / 10)
- # else
- x <- BayesFactor::correlationBF(ToothGrowth$len, ToothGrowth$dose)
- expect_equal(rope_range(x, verbose = FALSE), c(-0.05, 0.05))
- })
-}
+ # else
+ x <- correlationBF(ToothGrowth$len, ToothGrowth$dose)
+ expect_equal(rope_range(x, verbose = FALSE), c(-0.05, 0.05))
+})
diff --git a/tests/testthat/test-bayesfactor_models.R b/tests/testthat/test-bayesfactor_models.R
index 1fa89df..43353e4 100644
--- a/tests/testthat/test-bayesfactor_models.R
+++ b/tests/testthat/test-bayesfactor_models.R
@@ -1,134 +1,205 @@
-if (requiet("bayestestR") && requiet("testthat") && requiet("lme4")) {
- # bayesfactor_models BIC --------------------------------------------------
- test_that("bayesfactor_models BIC", {
- set.seed(444)
- void <- suppressMessages(capture.output({
- mo1 <- lme4::lmer(Sepal.Length ~ (1 | Species), data = iris)
- mo2 <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
- mo3 <- lme4::lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris)
- mo4 <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + (Petal.Length | Species), data = iris)
- mo5 <- lme4::lmer(Sepal.Length ~ Petal.Length * Petal.Width + (Petal.Length | Species), data = iris)
- mo4_e <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + (Petal.Length | Species), data = iris[-1, ])
- }))
-
- # both uses of denominator
- BFM1 <<- bayesfactor_models(mo2, mo3, mo4, mo1, denominator = 4)
- BFM2 <- bayesfactor_models(mo2, mo3, mo4, denominator = mo1)
- BFM3 <- bayesfactor_models(mo2, mo3, mo4, mo1, denominator = mo1)
- BFM4 <<- bayesfactor_models(mo2, mo3, mo4, mo5, mo1, denominator = mo1)
-
- expect_equal(BFM1, BFM2)
- expect_equal(BFM1, BFM3)
- expect_equal(BFM1, bayesfactor_models(list(mo2 = mo2, mo3 = mo3, mo4 = mo4, mo1 = mo1), denominator = 4))
-
- # only on same data!
- expect_warning(bayesfactor_models(mo1, mo2, mo4_e))
-
- # update models
- expect_equal(update(BFM2, subset = c(1, 2))$log_BF, c(1, 57.3, 54.52), tolerance = 0.1)
-
- # update reference
- expect_equal(update(BFM2, reference = 1)$log_BF,
- c(0, -2.8, -6.2, -57.4),
- tolerance = 0.1
- )
- })
-
-
- test_that("bayesfactor_models BIC, transformed responses", {
- m1 <- lm(mpg ~ 1, mtcars)
- m2 <- lm(sqrt(mpg) ~ 1, mtcars)
-
- BF1 <- bayesfactor_models(m1, m2, check_response = TRUE)
- expect_equal(BF1$log_BF[2], 2.4404 / 2, tolerance = 0.01)
-
- BF2 <- bayesfactor_models(m1, m2, check_response = FALSE)
- expect_false(isTRUE(all.equal(BF1, BF2)))
- })
-
- test_that("bayesfactor_models BIC (unsupported / diff nobs)", {
- skip_on_cran()
- set.seed(444)
-
- fit1 <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, iris)
- fit2a <- lm(Sepal.Length ~ Sepal.Width, iris[-1, ]) # different number of objects
- fit2b <- lm(Sepal.Length ~ Sepal.Width, iris) # not supported
- class(fit2b) <- "NOTLM"
- logLik.NOTLM <<- function(...) {
- stats:::logLik.lm(...)
- }
-
- # Should warm
- expect_warning(bayesfactor_models(fit1, fit2a))
-
- # Should fail
- suppressWarnings(expect_message(bayesfactor_models(fit1, fit2b), "Unable"))
- })
-
-
- # bayesfactor_models STAN ---------------------------------------------
- if (requiet("rstanarm") && requiet("bridgesampling")) {
- test_that("bayesfactor_models STAN", {
- skip_on_cran()
- set.seed(333)
- stan_bf_0 <- rstanarm::stan_glm(
- Sepal.Length ~ 1,
- data = iris,
- refresh = 0,
- iter = 500,
- diagnostic_file = file.path(tempdir(), "df0.csv")
- )
- stan_bf_1 <- suppressWarnings(rstanarm::stan_glm(
- Sepal.Length ~ Species,
- data = iris,
- refresh = 0,
- iter = 500,
- diagnostic_file = file.path(tempdir(), "df1.csv")
- ))
-
-
- set.seed(333) # compare against bridgesampling
- bridge_BF <- bridgesampling::bayes_factor(
- bridgesampling::bridge_sampler(stan_bf_1),
- bridgesampling::bridge_sampler(stan_bf_0)
- )
-
- set.seed(333)
- expect_warning(stan_models <- bayesfactor_models(stan_bf_0, stan_bf_1))
- expect_s3_class(stan_models, "bayesfactor_models")
- expect_equal(length(stan_models$log_BF), 2)
- expect_equal(stan_models$log_BF[2], log(bridge_BF$bf), tolerance = 0.1)
- })
- }
-
-
- # bayesfactor_inclusion ---------------------------------------------------
- if (requiet("BayesFactor")) {
- test_that("bayesfactor_inclusion | BayesFactor", {
- set.seed(444)
- # BayesFactor
- ToothGrowth$dose <- as.factor(ToothGrowth$dose)
- BF_ToothGrowth <- BayesFactor::anovaBF(len ~ dose * supp, ToothGrowth)
- expect_equal(
- bayesfactor_inclusion(BF_ToothGrowth),
- bayesfactor_inclusion(bayesfactor_models(BF_ToothGrowth))
- )
- })
+# bayesfactor_models BIC --------------------------------------------------
+test_that("bayesfactor_models BIC", {
+ skip_if_not_or_load_if_installed("lme4")
+ set.seed(444)
+ void <- suppressMessages(capture.output({
+ mo1 <- lme4::lmer(Sepal.Length ~ (1 | Species), data = iris)
+ mo2 <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
+ mo3 <- lme4::lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris)
+ mo4 <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + (Petal.Length | Species), data = iris)
+ mo5 <- lme4::lmer(Sepal.Length ~ Petal.Length * Petal.Width + (Petal.Length | Species), data = iris)
+ mo4_e <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + (Petal.Length | Species), data = iris[-1, ])
+ }))
+
+ # both uses of denominator
+ BFM1 <<- bayesfactor_models(mo2, mo3, mo4, mo1, denominator = 4)
+ BFM2 <- bayesfactor_models(mo2, mo3, mo4, denominator = mo1)
+ BFM3 <- bayesfactor_models(mo2, mo3, mo4, mo1, denominator = mo1)
+ BFM4 <<- bayesfactor_models(mo2, mo3, mo4, mo5, mo1, denominator = mo1)
+
+ expect_equal(BFM1, BFM2)
+ expect_equal(BFM1, BFM3)
+ expect_equal(BFM1, bayesfactor_models(list(mo2 = mo2, mo3 = mo3, mo4 = mo4, mo1 = mo1), denominator = 4))
+
+ # only on same data!
+ expect_warning(bayesfactor_models(mo1, mo2, mo4_e))
+
+ # update models
+ expect_equal(update(BFM2, subset = c(1, 2))$log_BF, c(1, 57.3, 54.52), tolerance = 0.1)
+
+ # update reference
+ expect_equal(update(BFM2, reference = 1)$log_BF,
+ c(0, -2.8, -6.2, -57.4),
+ tolerance = 0.1
+ )
+})
+
+
+test_that("bayesfactor_models BIC, transformed responses", {
+ skip_if_not_or_load_if_installed("lme4")
+
+ m1 <- lm(mpg ~ 1, mtcars)
+ m2 <- lm(sqrt(mpg) ~ 1, mtcars)
+
+ BF1 <- bayesfactor_models(m1, m2, check_response = TRUE)
+ expect_equal(BF1$log_BF[2], 2.4404 / 2, tolerance = 0.01)
+
+ BF2 <- bayesfactor_models(m1, m2, check_response = FALSE)
+ expect_false(isTRUE(all.equal(BF1, BF2)))
+})
+
+test_that("bayesfactor_models BIC (unsupported / diff nobs)", {
+ skip_if_not_or_load_if_installed("lme4")
+
+ skip_on_cran()
+ set.seed(444)
+
+ fit1 <- lm(Sepal.Length ~ Sepal.Width + Petal.Length, iris)
+ fit2a <- lm(Sepal.Length ~ Sepal.Width, iris[-1, ]) # different number of objects
+ fit2b <- lm(Sepal.Length ~ Sepal.Width, iris) # not supported
+ class(fit2b) <- "NOTLM"
+ logLik.NOTLM <<- function(...) {
+ stats:::logLik.lm(...)
}
- test_that("bayesfactor_inclusion | LMM", {
- # with random effects in all models:
- expect_true(is.nan(bayesfactor_inclusion(BFM1)["1:Species", "log_BF"]))
-
- bfinc_all <- bayesfactor_inclusion(BFM4, match_models = FALSE)
- expect_equal(bfinc_all$p_prior, c(1, 0.8, 0.6, 0.4, 0.2), tolerance = 0.1)
- expect_equal(bfinc_all$p_posterior, c(1, 1, 0.12, 0.01, 0), tolerance = 0.1)
- expect_equal(bfinc_all$log_BF, c(NaN, 57.651, -2.352, -4.064, -4.788), tolerance = 0.1)
-
- # + match_models
- bfinc_matched <- bayesfactor_inclusion(BFM4, match_models = TRUE)
- expect_equal(bfinc_matched$p_prior, c(1, 0.2, 0.6, 0.2, 0.2), tolerance = 0.1)
- expect_equal(bfinc_matched$p_posterior, c(1, 0.875, 0.125, 0.009, 0.002), tolerance = 0.1)
- expect_equal(bfinc_matched$log_BF, c(NaN, 58.904, -3.045, -3.573, -1.493), tolerance = 0.1)
+ # Should warm
+ expect_warning(bayesfactor_models(fit1, fit2a))
+
+ # Should fail
+ suppressWarnings(expect_message(bayesfactor_models(fit1, fit2b), "Unable"))
+})
+
+
+# bayesfactor_models STAN ---------------------------------------------
+
+test_that("bayesfactor_models STAN", {
+ skip_if_not_or_load_if_installed("lme4")
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("bridgesampling")
+ skip_if_not_or_load_if_installed("brms")
+
+ skip_on_cran()
+ set.seed(333)
+ stan_bf_0 <- rstanarm::stan_glm(
+ Sepal.Length ~ 1,
+ data = iris,
+ refresh = 0,
+ iter = 500,
+ diagnostic_file = file.path(tempdir(), "df0.csv")
+ )
+ stan_bf_1 <- suppressWarnings(rstanarm::stan_glm(
+ Sepal.Length ~ Species,
+ data = iris,
+ refresh = 0,
+ iter = 500,
+ diagnostic_file = file.path(tempdir(), "df1.csv")
+ ))
+
+
+ set.seed(333) # compare against bridgesampling
+ bridge_BF <- bridgesampling::bayes_factor(
+ bridgesampling::bridge_sampler(stan_bf_1, silent = TRUE),
+ bridgesampling::bridge_sampler(stan_bf_0, silent = TRUE)
+ )
+
+ set.seed(333)
+ suppressMessages({
+ expect_warning(
+ stan_models <- bayesfactor_models(stan_bf_0, stan_bf_1)
+ )
})
-}
+ expect_s3_class(stan_models, "bayesfactor_models")
+ expect_equal(length(stan_models$log_BF), 2)
+ expect_equal(stan_models$log_BF[2], log(bridge_BF$bf), tolerance = 0.1)
+})
+
+test_that("bayesfactor_models BRMS", {
+ # Checks for brms models
+ skip_on_cran()
+ skip_on_ci()
+
+ skip_if_not_or_load_if_installed("lme4")
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("bridgesampling")
+ skip_if_not_or_load_if_installed("brms")
+
+ set.seed(333)
+ stan_brms_model_0 <- suppressWarnings(brms::brm(
+ Sepal.Length ~ 1,
+ data = iris,
+ iter = 500,
+ refresh = 0,
+ save_pars = brms::save_pars(all = TRUE),
+ silent = 2
+ ))
+
+ stan_brms_model_1 <- suppressWarnings(brms::brm(
+ Sepal.Length ~ Petal.Length,
+ data = iris,
+ iter = 500,
+ refresh = 0,
+ save_pars = brms::save_pars(all = TRUE),
+ silent = 2
+ ))
+
+ set.seed(444)
+ suppressMessages(
+ expect_message(
+ bfm <- bayesfactor_models(stan_brms_model_0, stan_brms_model_1),
+ regexp = "marginal"
+ )
+ )
+
+ set.seed(444)
+ stan_brms_model_0wc <- brms::add_criterion(
+ stan_brms_model_0,
+ criterion = "marglik",
+ repetitions = 5,
+ silent = 2
+ )
+
+ stan_brms_model_1wc <- brms::add_criterion(
+ stan_brms_model_1,
+ criterion = "marglik",
+ repetitions = 5,
+ silent = 2
+ )
+
+ expect_message(bfmwc <- bayesfactor_models(stan_brms_model_0wc, stan_brms_model_1wc), regexp = NA)
+ expect_equal(bfmwc$log_BF, bfm$log_BF, tolerance = 0.01)
+})
+
+
+# bayesfactor_inclusion ---------------------------------------------------
+test_that("bayesfactor_inclusion | BayesFactor", {
+ skip_if_not_or_load_if_installed("lme4")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(444)
+ # BayesFactor
+ ToothGrowth$dose <- as.factor(ToothGrowth$dose)
+ BF_ToothGrowth <- BayesFactor::anovaBF(len ~ dose * supp, ToothGrowth)
+ expect_equal(
+ bayesfactor_inclusion(BF_ToothGrowth),
+ bayesfactor_inclusion(bayesfactor_models(BF_ToothGrowth))
+ )
+})
+
+test_that("bayesfactor_inclusion | LMM", {
+ skip_if_not_or_load_if_installed("lme4")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ # with random effects in all models:
+ expect_true(is.nan(bayesfactor_inclusion(BFM1)["1:Species", "log_BF"]))
+
+ bfinc_all <- bayesfactor_inclusion(BFM4, match_models = FALSE)
+ expect_equal(bfinc_all$p_prior, c(1, 0.8, 0.6, 0.4, 0.2), tolerance = 0.1)
+ expect_equal(bfinc_all$p_posterior, c(1, 1, 0.12, 0.01, 0), tolerance = 0.1)
+ expect_equal(bfinc_all$log_BF, c(NaN, 57.651, -2.352, -4.064, -4.788), tolerance = 0.1)
+
+ # + match_models
+ bfinc_matched <- bayesfactor_inclusion(BFM4, match_models = TRUE)
+ expect_equal(bfinc_matched$p_prior, c(1, 0.2, 0.6, 0.2, 0.2), tolerance = 0.1)
+ expect_equal(bfinc_matched$p_posterior, c(1, 0.875, 0.125, 0.009, 0.002), tolerance = 0.1)
+ expect_equal(bfinc_matched$log_BF, c(NaN, 58.904, -3.045, -3.573, -1.493), tolerance = 0.1)
+})
diff --git a/tests/testthat/test-bayesfactor_parameters.R b/tests/testthat/test-bayesfactor_parameters.R
index 2456497..ff43f3c 100644
--- a/tests/testthat/test-bayesfactor_parameters.R
+++ b/tests/testthat/test-bayesfactor_parameters.R
@@ -1,108 +1,116 @@
-if (requiet("rstanarm") &&
- requiet("BayesFactor") &&
- requiet("testthat") &&
- requiet("insight") &&
- requiet("httr") &&
- requiet("brms")) {
- # bayesfactor_parameters data frame ---------------------------------------
-
- test_that("bayesfactor_parameters data frame", {
- Xprior <- data.frame(
- x = distribution_normal(1e4),
- y = distribution_normal(1e4)
- )
- Xposterior <- data.frame(
- x = distribution_normal(1e4, mean = 0.5),
- y = distribution_normal(1e4, mean = -0.5)
- )
-
- # point
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = 0, verbose = FALSE)
- expect_equal(bfsd$log_BF, c(0.12, 0.12), tolerance = 0.1)
-
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = 1, verbose = FALSE)
- expect_equal(bfsd$log_BF, c(0.44, -0.35), tolerance = 0.1)
-
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = -1, verbose = FALSE)
- expect_equal(bfsd$log_BF, c(-0.35, 0.44), tolerance = 0.1)
-
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0.5, direction = 0, verbose = FALSE)
- expect_equal(bfsd$log_BF, c(-0.12, 0.37), tolerance = 0.1)
-
- expect_warning(bayestestR::bayesfactor_parameters(Xposterior, Xprior))
-
- w <- capture_warnings(bfsd <- bayestestR::bayesfactor_parameters(Xposterior))
- expect_match(w, "Prior", all = FALSE)
- expect_match(w, "40", all = FALSE)
- expect_equal(bfsd$log_BF, c(0, 0), tolerance = 0.1)
-
- # interval
- expect_warning(
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = 0),
- regexp = NA
- )
- expect_equal(bfsd$log_BF, c(0.13, 0.13), tolerance = 0.1)
-
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = 1)
- expect_equal(bfsd$log_BF, c(0.47, -0.39), tolerance = 0.1)
-
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = -1)
- expect_equal(bfsd$log_BF, c(-0.39, 0.47), tolerance = 0.1)
-
- # interval with inf
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, Inf))
- expect_equal(bfsd$log_BF, c(-0.81, 0.80), tolerance = 0.1)
-
- bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-Inf, .1))
- expect_equal(bfsd$log_BF, c(0.80, -0.81), tolerance = 0.1)
- })
-
-
- # bayesfactor_parameters RSTANARM -----------------------------------------
-
- test_that("bayesfactor_parameters RSTANARM", {
- skip_on_cran()
-
- fit <- stan_glm(mpg ~ ., data = mtcars, refresh = 0)
-
- set.seed(333)
- fit_p <- unupdate(fit)
- expect_warning(BF2 <- bayesfactor_parameters(fit, fit_p))
-
- set.seed(333)
- BF1 <- bayesfactor_parameters(fit, verbose = FALSE)
-
- expect_equal(BF1, BF2)
-
- model_flat <- stan_glm(extra ~ group, data = sleep, prior = NULL, refresh = 0)
+test_that("bayesfactor_parameters data frame", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BayesFactor")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("brms")
+
+ Xprior <- data.frame(
+ x = distribution_normal(1e4),
+ y = distribution_normal(1e4)
+ )
+ Xposterior <- data.frame(
+ x = distribution_normal(1e4, mean = 0.5),
+ y = distribution_normal(1e4, mean = -0.5)
+ )
+
+ # point
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = 0, verbose = FALSE)
+ expect_equal(bfsd$log_BF, c(0.12, 0.12), tolerance = 0.1)
+
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = 1, verbose = FALSE)
+ expect_equal(bfsd$log_BF, c(0.44, -0.35), tolerance = 0.1)
+
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0, direction = -1, verbose = FALSE)
+ expect_equal(bfsd$log_BF, c(-0.35, 0.44), tolerance = 0.1)
+
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = 0.5, direction = 0, verbose = FALSE)
+ expect_equal(bfsd$log_BF, c(-0.12, 0.37), tolerance = 0.1)
+
+ expect_warning(bayesfactor_parameters(Xposterior, Xprior))
+
+ w <- capture_warnings(bfsd <- bayesfactor_parameters(Xposterior))
+ expect_match(w, "Prior", all = FALSE)
+ expect_match(w, "40", all = FALSE)
+ expect_equal(bfsd$log_BF, c(0, 0), tolerance = 0.1)
+
+ # interval
+ expect_warning(
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = 0),
+ regexp = NA
+ )
+ expect_equal(bfsd$log_BF, c(0.13, 0.13), tolerance = 0.1)
+
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = 1)
+ expect_equal(bfsd$log_BF, c(0.47, -0.39), tolerance = 0.1)
+
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, .1), direction = -1)
+ expect_equal(bfsd$log_BF, c(-0.39, 0.47), tolerance = 0.1)
+
+ # interval with inf
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-.1, Inf))
+ expect_equal(bfsd$log_BF, c(-0.81, 0.80), tolerance = 0.1)
+
+ bfsd <- bayesfactor_parameters(Xposterior, prior = Xprior, null = c(-Inf, .1))
+ expect_equal(bfsd$log_BF, c(0.80, -0.81), tolerance = 0.1)
+})
+
+
+test_that("bayesfactor_parameters RSTANARM", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BayesFactor")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("brms")
+
+ fit <- suppressMessages(stan_glm(mpg ~ ., data = mtcars, refresh = 0))
+
+ set.seed(333)
+ fit_p <- unupdate(fit, verbose = FALSE)
+ expect_warning(BF2 <- bayesfactor_parameters(fit, fit_p))
+
+ set.seed(333)
+ BF1 <- bayesfactor_parameters(fit, verbose = FALSE)
+
+ expect_equal(BF1, BF2)
+
+ model_flat <- suppressMessages(
+ stan_glm(extra ~ group, data = sleep, prior = NULL, refresh = 0)
+ )
+ suppressMessages(
expect_error(bayesfactor_parameters(model_flat))
+ )
- skip_on_ci()
- fit10 <- update(fit, chains = 10, iter = 5100, warmup = 100)
+ skip_on_ci()
+ fit10 <- update(fit, chains = 10, iter = 5100, warmup = 100)
+ suppressMessages(
expect_warning(bayesfactor_parameters(fit10), regexp = NA)
- })
-
-
- # bayesfactor_parameters BRMS ---------------------------------------------
- # .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- # if (.runThisTest) {
- # test_that("bayesfactor_parameters BRMS", {
- # skip_on_cran()
- #
- # brms_mixed_6 <- insight::download_model("brms_mixed_6")
- #
- # set.seed(222)
- # brms_mixed_6_p <- unupdate(brms_mixed_6)
- # bfsd1 <- bayesfactor_parameters(brms_mixed_6, brms_mixed_6_p, effects = "fixed")
- #
- # set.seed(222)
- # bfsd2 <- bayesfactor_parameters(brms_mixed_6, effects = "fixed")
- #
- # expect_equal(log(bfsd1$BF), log(bfsd2$BF), tolerance = .11)
- #
- #
- # brms_mixed_1 <- insight::download_model("brms_mixed_1")
- # expect_error(bayesfactor_parameters(brms_mixed_1))
- # })
- # }
-}
+ )
+})
+
+
+# bayesfactor_parameters BRMS ---------------------------------------------
+#
+# test_that("bayesfactor_parameters BRMS", {
+# skip_if_offline()
+# skip_if_not_or_load_if_installed("rstanarm")
+# skip_if_not_or_load_if_installed("BayesFactor")
+# skip_if_not_or_load_if_installed("httr")
+# skip_if_not_or_load_if_installed("brms")
+#
+# brms_mixed_6 <- insight::download_model("brms_mixed_6")
+#
+# set.seed(222)
+# brms_mixed_6_p <- unupdate(brms_mixed_6)
+# bfsd1 <- bayesfactor_parameters(brms_mixed_6, brms_mixed_6_p, effects = "fixed")
+#
+# set.seed(222)
+# bfsd2 <- bayesfactor_parameters(brms_mixed_6, effects = "fixed")
+#
+# expect_equal(log(bfsd1$BF), log(bfsd2$BF), tolerance = .11)
+#
+#
+# brms_mixed_1 <- insight::download_model("brms_mixed_1")
+# expect_error(bayesfactor_parameters(brms_mixed_1))
+# })
diff --git a/tests/testthat/test-bayesfactor_restricted.R b/tests/testthat/test-bayesfactor_restricted.R
index aedb815..77f97dc 100644
--- a/tests/testthat/test-bayesfactor_restricted.R
+++ b/tests/testthat/test-bayesfactor_restricted.R
@@ -1,58 +1,56 @@
-if (require("testthat")) {
- # bayesfactor_restricted data.frame ---------------------------------------
+# bayesfactor_restricted data.frame ---------------------------------------
- test_that("bayesfactor_restricted df", {
- prior <- data.frame(
- X = distribution_normal(100),
- X1 = c(distribution_normal(50), distribution_normal(50)),
- X3 = c(distribution_normal(80), distribution_normal(20))
- )
+test_that("bayesfactor_restricted df", {
+ prior <- data.frame(
+ X = distribution_normal(100),
+ X1 = c(distribution_normal(50), distribution_normal(50)),
+ X3 = c(distribution_normal(80), distribution_normal(20))
+ )
- posterior <- data.frame(
- X = distribution_normal(100, .4, .2),
- X1 = distribution_normal(100, -.2, .2),
- X3 = distribution_normal(100, .2)
- )
+ posterior <- data.frame(
+ X = distribution_normal(100, .4, .2),
+ X1 = distribution_normal(100, -.2, .2),
+ X3 = distribution_normal(100, .2)
+ )
- hyps <- c(
- "X > X1 & X1 > X3",
- "X > X1"
- )
+ hyps <- c(
+ "X > X1 & X1 > X3",
+ "X > X1"
+ )
- bfr <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior)
+ bfr <- bayesfactor_restricted(posterior, hypothesis = hyps, prior = prior)
- expect_equal(bfr$p_prior, c(0.2, 0.5), tolerance = 0.1)
- expect_equal(bfr$p_posterior, c(0.31, 1), tolerance = 0.1)
- expect_equal(bfr$log_BF, c(0.43, 0.69), tolerance = 0.1)
- expect_equal(exp(bfr$log_BF), bfr$p_posterior / bfr$p_prior, tolerance = 0.1)
+ expect_equal(bfr$p_prior, c(0.2, 0.5), tolerance = 0.1)
+ expect_equal(bfr$p_posterior, c(0.31, 1), tolerance = 0.1)
+ expect_equal(bfr$log_BF, c(0.43, 0.69), tolerance = 0.1)
+ expect_equal(exp(bfr$log_BF), bfr$p_posterior / bfr$p_prior, tolerance = 0.1)
- expect_error(bayesfactor_restricted(posterior, prior, hypothesis = "Y < 0"))
- })
+ expect_error(bayesfactor_restricted(posterior, prior, hypothesis = "Y < 0"))
+})
- # bayesfactor_restricted RSTANARM -----------------------------------------
+# bayesfactor_restricted RSTANARM -----------------------------------------
- test_that("bayesfactor_restricted RSTANARM", {
- skip_on_cran()
- skip_if_not_installed("rstanarm")
- suppressWarnings(
- fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am, data = mtcars, refresh = 0, iter = 200)
- )
+test_that("bayesfactor_restricted RSTANARM", {
+ skip_on_cran()
+ skip_if_not_installed("rstanarm")
+ suppressWarnings(
+ fit_stan <- rstanarm::stan_glm(mpg ~ wt + cyl + am, data = mtcars, refresh = 0, iter = 200)
+ )
- hyps <- c(
- "am > 0 & cyl < 0",
- "cyl < 0",
- "wt - cyl > 0"
- )
+ hyps <- c(
+ "am > 0 & cyl < 0",
+ "cyl < 0",
+ "wt - cyl > 0"
+ )
- set.seed(444)
- fit_p <- suppressMessages(unupdate(fit_stan))
- bfr1 <- bayesfactor_restricted(fit_stan, prior = fit_p, hypothesis = hyps)
+ set.seed(444)
+ fit_p <- suppressMessages(unupdate(fit_stan))
+ bfr1 <- bayesfactor_restricted(fit_stan, prior = fit_p, hypothesis = hyps)
- set.seed(444)
- bfr2 <- bayesfactor_restricted(fit_stan, hypothesis = hyps)
+ set.seed(444)
+ bfr2 <- bayesfactor_restricted(fit_stan, hypothesis = hyps)
- expect_equal(bfr1, bfr2)
- })
-}
+ expect_equal(bfr1, bfr2)
+})
diff --git a/tests/testthat/test-blavaan.R b/tests/testthat/test-blavaan.R
index 8e3c1dc..46863f0 100644
--- a/tests/testthat/test-blavaan.R
+++ b/tests/testthat/test-blavaan.R
@@ -1,9 +1,13 @@
-if (requiet("bayestestR") && requiet("testthat") && requiet("blavaan") && requiet("lavaan") && requiet("cmdstanr")) {
- test_that("blavaan, all", {
- skip_on_cran()
- data("PoliticalDemocracy", package = "lavaan")
+test_that("blavaan, all", {
+ skip_on_cran()
+ skip_if_not_or_load_if_installed("blavaan")
+ skip_if_not_or_load_if_installed("lavaan")
+ skip_if_not_or_load_if_installed("cmdstanr")
+ skip_if_not_or_load_if_installed("rstan")
- model <- "
+ data("PoliticalDemocracy", package = "lavaan")
+
+ model <- "
# latent variable definitions
dem60 =~ y1 + a*y2
dem65 =~ y5 + a*y6
@@ -15,7 +19,7 @@ if (requiet("bayestestR") && requiet("testthat") && requiet("blavaan") && requie
y1 ~~ y5
"
- model2 <- "
+ model2 <- "
# latent variable definitions
dem60 =~ y1 + a*y2
dem65 =~ y5 + a*y6
@@ -26,84 +30,83 @@ if (requiet("bayestestR") && requiet("testthat") && requiet("blavaan") && requie
# residual correlations
y1 ~~ 0*y5
"
- suppressWarnings(capture.output({
- bfit <- blavaan::bsem(model,
- data = PoliticalDemocracy,
- n.chains = 1, burnin = 50, sample = 100
- )
- bfit2 <- blavaan::bsem(model2,
- data = PoliticalDemocracy,
- n.chains = 1, burnin = 50, sample = 100
- )
- }))
-
- x <- point_estimate(bfit, centrality = "all", dispersion = TRUE)
- expect_true(all(c("Median", "MAD", "Mean", "SD", "MAP", "Component") %in% colnames(x)))
- expect_equal(nrow(x), 14)
-
- x <- eti(bfit)
- expect_equal(nrow(x), 14)
-
- x <- hdi(bfit)
- expect_equal(nrow(x), 14)
-
- x <- p_direction(bfit)
- expect_equal(nrow(x), 14)
-
- x <- rope(bfit, range = c(-.1, .1))
- expect_equal(nrow(x), 14)
-
- x <- p_rope(bfit, range = c(-.1, .1))
- expect_equal(nrow(x), 14)
-
- x <- p_map(bfit)
- expect_equal(nrow(x), 14)
-
- x <- p_significance(bfit, threshold = c(-.1, .1))
- expect_equal(nrow(x), 14)
-
- x <- equivalence_test(bfit, range = c(-.1, .1))
- expect_equal(nrow(x), 14)
-
- x <- estimate_density(bfit)
- expect_equal(length(unique(x$Parameter)), 14)
-
-
- ## Bayes factors ----
- expect_warning(bayesfactor_models(bfit, bfit2))
- x <- suppressWarnings(bayesfactor_models(bfit, bfit2))
- expect_true(x$log_BF[2] < 0)
-
- expect_warning(weighted_posteriors(bfit, bfit2))
- x <- suppressWarnings(weighted_posteriors(bfit, bfit2))
- expect_equal(ncol(x), 14)
-
- # bfit_prior <- unupdate(bfit)
- # capture.output(x <- expect_warning(bayesfactor_parameters(bfit, prior = bfit_prior)))
- # expect_equal(nrow(x), 14)
- #
- # x <- expect_warning(si(bfit, prior = bfit_prior))
- # expect_equal(nrow(x), 14)
- #
- # ## Prior/posterior checks ----
- # suppressWarnings(x <- check_prior(bfit))
- # expect_equal(nrow(x), 13)
- #
- # x <- check_prior(bfit, simulate_priors = FALSE)
- # expect_equal(nrow(x), 14)
-
- x <- diagnostic_posterior(bfit)
- expect_equal(nrow(x), 14)
-
- x <- simulate_prior(bfit)
- expect_equal(ncol(x), 13)
- # YES this is 13! We have two parameters with the same prior.
-
- x <- describe_prior(bfit)
- expect_equal(nrow(x), 13)
- # YES this is 13! We have two parameters with the same prior.
-
- # x <- describe_posterior(bfit, test = "all", rope_range = c(-.1, .1))
- # expect_equal(nrow(x), 14)
- })
-}
+ suppressWarnings(capture.output({
+ bfit <- blavaan::bsem(model,
+ data = PoliticalDemocracy,
+ n.chains = 1, burnin = 50, sample = 100
+ )
+ bfit2 <- blavaan::bsem(model2,
+ data = PoliticalDemocracy,
+ n.chains = 1, burnin = 50, sample = 100
+ )
+ }))
+
+ x <- point_estimate(bfit, centrality = "all", dispersion = TRUE)
+ expect_true(all(c("Median", "MAD", "Mean", "SD", "MAP", "Component") %in% colnames(x)))
+ expect_equal(nrow(x), 14)
+
+ x <- eti(bfit)
+ expect_equal(nrow(x), 14)
+
+ x <- hdi(bfit)
+ expect_equal(nrow(x), 14)
+
+ x <- p_direction(bfit)
+ expect_equal(nrow(x), 14)
+
+ x <- rope(bfit, range = c(-.1, .1))
+ expect_equal(nrow(x), 14)
+
+ x <- p_rope(bfit, range = c(-.1, .1))
+ expect_equal(nrow(x), 14)
+
+ x <- p_map(bfit)
+ expect_equal(nrow(x), 14)
+
+ x <- p_significance(bfit, threshold = c(-.1, .1))
+ expect_equal(nrow(x), 14)
+
+ x <- equivalence_test(bfit, range = c(-.1, .1))
+ expect_equal(nrow(x), 14)
+
+ x <- estimate_density(bfit)
+ expect_equal(length(unique(x$Parameter)), 14)
+
+
+ ## Bayes factors ----
+ expect_warning(bayesfactor_models(bfit, bfit2))
+ x <- suppressWarnings(bayesfactor_models(bfit, bfit2))
+ expect_true(x$log_BF[2] < 0)
+
+ expect_warning(weighted_posteriors(bfit, bfit2))
+ x <- suppressWarnings(weighted_posteriors(bfit, bfit2))
+ expect_equal(ncol(x), 14)
+
+ # bfit_prior <- unupdate(bfit)
+ # capture.output(x <- expect_warning(bayesfactor_parameters(bfit, prior = bfit_prior)))
+ # expect_equal(nrow(x), 14)
+ #
+ # x <- expect_warning(si(bfit, prior = bfit_prior))
+ # expect_equal(nrow(x), 14)
+ #
+ # ## Prior/posterior checks ----
+ # suppressWarnings(x <- check_prior(bfit))
+ # expect_equal(nrow(x), 13)
+ #
+ # x <- check_prior(bfit, simulate_priors = FALSE)
+ # expect_equal(nrow(x), 14)
+
+ x <- diagnostic_posterior(bfit)
+ expect_equal(nrow(x), 14)
+
+ x <- simulate_prior(bfit)
+ expect_equal(ncol(x), 13)
+ # YES this is 13! We have two parameters with the same prior.
+
+ x <- describe_prior(bfit)
+ expect_equal(nrow(x), 13)
+ # YES this is 13! We have two parameters with the same prior.
+
+ # x <- describe_posterior(bfit, test = "all", rope_range = c(-.1, .1))
+ # expect_equal(nrow(x), 14)
+})
diff --git a/tests/testthat/test-brms.R b/tests/testthat/test-brms.R
index 083880c..4f6d616 100644
--- a/tests/testthat/test-brms.R
+++ b/tests/testthat/test-brms.R
@@ -1,87 +1,93 @@
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
+test_that("brms", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
-if (.runThisTest && requiet("brms") && requiet("testthat") && requiet("insight") && requiet("httr")) {
- test_that("brms", {
- skip_on_cran()
+ set.seed(333)
+ model <- insight::download_model("brms_mixed_1")
- set.seed(333)
- model <- insight::download_model("brms_mixed_1")
+ expect_s3_class(hdi(model), "data.frame")
+ expect_s3_class(ci(model), "data.frame")
+ expect_s3_class(rope(model, verbose = FALSE), "data.frame")
+ # expect_true("equivalence_test" %in% class(equivalence_test(model)))
+ expect_s3_class(map_estimate(model), "data.frame")
+ expect_s3_class(p_map(model), "data.frame")
+ expect_s3_class(p_direction(model), "data.frame")
- expect_s3_class(hdi(model), "data.frame")
- expect_s3_class(ci(model), "data.frame")
- expect_s3_class(rope(model, verbose = FALSE), "data.frame")
- # expect_true("equivalence_test" %in% class(equivalence_test(model)))
- expect_s3_class(map_estimate(model), "data.frame")
- expect_s3_class(p_map(model), "data.frame")
- expect_s3_class(p_direction(model), "data.frame")
+ expect_identical(colnames(hdi(model)), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component"))
+ expect_identical(colnames(hdi(model, effects = "all")), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component"))
+ # expect_equal(nrow(equivalence_test(model)), 2)
- expect_equal(colnames(hdi(model)), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component"))
- expect_equal(colnames(hdi(model, effects = "all")), c("Parameter", "CI", "CI_low", "CI_high", "Effects", "Component"))
- # expect_equal(nrow(equivalence_test(model)), 2)
-
- out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
- suppressWarnings(
- s <- summary(model)
- )
- expect_identical(colnames(out), c(
- "Parameter", "Effects", "Component", "Mean", "CI", "CI_low", "CI_high",
- "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
- "Rhat", "ESS"
- ))
- expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean[1:2], tolerance = 1e-3)
- expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat[1:2], tolerance = 1e-1)
- expect_equal(as.vector(s$random$cyl[, 1, drop = TRUE]), out$Mean[12], tolerance = 1e-3)
- expect_equal(as.vector(s$random$gear[, 1, drop = TRUE]), out$Mean[13:15], tolerance = 1e-3)
+ out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
+ suppressWarnings({
+ s <- summary(model)
})
+ expect_identical(colnames(out), c(
+ "Parameter", "Effects", "Component", "Mean", "CI", "CI_low", "CI_high",
+ "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
+ "Rhat", "ESS"
+ ))
+ expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean[1:2], tolerance = 1e-3)
+ expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat[1:2], tolerance = 1e-1)
+ expect_equal(as.vector(s$random$cyl[, 1, drop = TRUE]), out$Mean[12], tolerance = 1e-3)
+ expect_equal(as.vector(s$random$gear[, 1, drop = TRUE]), out$Mean[13:15], tolerance = 1e-3)
+})
- test_that("brms", {
- # skip_on_travis()
- skip_on_cran()
+test_that("brms", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
- set.seed(333)
- model <- insight::download_model("brms_1")
+ set.seed(333)
+ model <- insight::download_model("brms_1")
- out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
- s <- summary(model)
- expect_identical(colnames(out), c(
- "Parameter", "Component", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS"
- ))
- expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean[1:3], tolerance = 1e-3)
- expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat[1:3], tolerance = 1e-1)
- })
+ out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
+ s <- summary(model)
+ expect_identical(colnames(out), c(
+ "Parameter", "Component", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS"
+ ))
+ expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean[1:3], tolerance = 1e-3)
+ expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat[1:3], tolerance = 1e-1)
+})
- test_that("brms", {
- # skip_on_travis()
- skip_on_cran()
+test_that("brms", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
- set.seed(333)
- model <- insight::download_model("brms_mv_2")
+ set.seed(333)
+ model <- insight::download_model("brms_mv_2")
- out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean", test = NULL)
- s <- suppressWarnings(summary(model))
- expect_identical(colnames(out), c(
- "Parameter", "Effects", "Component", "Mean", "CI", "CI_low", "CI_high",
- "Rhat", "ESS"
- ))
+ out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean", test = NULL)
+ s <- suppressWarnings(summary(model))
+ expect_identical(colnames(out), c(
+ "Parameter", "Effects", "Component", "Mean", "CI", "CI_low", "CI_high",
+ "Rhat", "ESS"
+ ))
- known <- s$fixed
- unknown <- out[out$Effects == "fixed" & out$Component == "conditional", ]
- idx <- match(row.names(known), gsub("b_", "", unknown$Parameter))
- unknown <- unknown[idx, ]
- expect_equal(unknown$Mean, known$Estimate)
- expect_equal(unknown$Rhat, known$Rhat, tolerance = 1e-2)
- })
+ known <- s$fixed
+ unknown <- out[out$Effects == "fixed" & out$Component == "conditional", ]
+ idx <- match(row.names(known), gsub("b_", "", unknown$Parameter, fixed = TRUE))
+ unknown <- unknown[idx, ]
+ expect_equal(unknown$Mean, known$Estimate, ignore_attr = TRUE)
+ expect_equal(unknown$Rhat, known$Rhat, tolerance = 1e-2, ignore_attr = TRUE)
+})
- test_that("brms", {
- skip_on_cran()
+test_that("brms", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
- set.seed(333)
- model <- insight::download_model("brms_2")
+ set.seed(333)
+ model <- insight::download_model("brms_2")
- out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean", test = NULL)
- s <- summary(model)
- expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
- expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat, tolerance = 1e-1)
- })
-}
+ out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean", test = NULL)
+ s <- summary(model)
+ expect_equal(as.vector(s$fixed[, 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
+ expect_equal(as.vector(s$fixed[, 5, drop = TRUE]), out$Rhat, tolerance = 1e-1)
+})
diff --git a/tests/testthat/test-check_prior.R b/tests/testthat/test-check_prior.R
index fcb8882..c3892b9 100644
--- a/tests/testthat/test-check_prior.R
+++ b/tests/testthat/test-check_prior.R
@@ -1,16 +1,11 @@
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
-
-if (.runThisTest &&
- requiet("rstanarm") &&
- requiet("testthat") &&
- requiet("bayestestR") &&
- requiet("BH") &&
- requiet("RcppEigen") &&
- requiet("brms")) {
+test_that("check_prior - stanreg", {
skip_on_cran()
skip_on_os(os = "windows")
-
- # stanreg --------------------------
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BH")
+ skip_if_not_or_load_if_installed("RcppEigen")
+ skip_if_not_or_load_if_installed("brms")
set.seed(333)
model1 <- insight::download_model("stanreg_lm_1")
@@ -24,8 +19,55 @@ if (.runThisTest &&
check_prior(model1, method = "lakeland")$Prior_Quality,
c("informative", "informative")
)
+})
+
+test_that("check_prior - brms (linux)", {
+ skip("TODO: check hard-coded values")
- # brms -----------------------------
+ skip_on_cran()
+ skip_on_os(os = c("windows", "mac", "solaris"))
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BH")
+ skip_if_not_or_load_if_installed("RcppEigen")
+ skip_if_not_or_load_if_installed("brms")
+
+ # all `brms` examples in circus have uniform prior distribution, so
+ # need to use a custom example here
+ set.seed(333)
+ suppressMessages({
+ model2 <- brm(rating ~ period + carry + cs(treat),
+ data = inhaler, family = sratio("logit"),
+ prior = set_prior("normal(0,5)"),
+ chains = 2, silent = TRUE, refresh = 0
+ )
+ })
+
+ expect_warning(expect_equal(
+ check_prior(model2)$Prior_Quality,
+ c(
+ "uninformative", "informative", "informative", "uninformative",
+ "uninformative", "not determinable", "not determinable", "not determinable"
+ )
+ ))
+
+ expect_warning(expect_equal(
+ check_prior(model2, method = "lakeland")$Prior_Quality,
+ c(
+ "informative", "informative", "informative", "informative",
+ "informative", "not determinable", "not determinable", "not determinable"
+ )
+ ))
+})
+
+test_that("check_prior - brms (linux)", {
+ skip_on_cran()
+ skip_on_os(os = c("windows", "mac", "solaris"))
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BH")
+ skip_if_not_or_load_if_installed("RcppEigen")
+ skip_if_not_or_load_if_installed("brms")
# all `brms` examples in circus have uniform prior distribution, so
# need to use a custom example here
@@ -36,49 +78,58 @@ if (.runThisTest &&
chains = 2, silent = TRUE, refresh = 0
)
- linux <- tryCatch({
- si <- Sys.info()
- if (!is.null(si["sysname"])) {
- si["sysname"] == "Linux" || grepl("^linux", R.version$os)
- } else {
- FALSE
- }
+ # TODO: check hard-coded values")
+ # expect_warning(expect_equal(
+ # check_prior(model2)$Prior_Quality,
+ # c(
+ # "uninformative", "informative", "informative", "uninformative",
+ # "uninformative", "not determinable", "not determinable", "not determinable"
+ # )
+ # ))
+
+
+ expect_warning(expect_equal(
+ check_prior(model2, method = "lakeland")$Prior_Quality,
+ c(
+ "informative", "informative", "informative", "informative",
+ "informative", "not determinable", "not determinable", "not determinable"
+ )
+ ))
+})
+
+test_that("check_prior - brms (not linux or windows)", {
+ skip_on_cran()
+ skip_on_os(os = c("linux", "windows"))
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BH")
+ skip_if_not_or_load_if_installed("RcppEigen")
+ skip_if_not_or_load_if_installed("brms")
+
+ # all `brms` examples in circus have uniform prior distribution, so
+ # need to use a custom example here
+ set.seed(333)
+ suppressMessages({
+ model2 <- brm(rating ~ period + carry + cs(treat),
+ data = inhaler, family = sratio("logit"),
+ prior = set_prior("normal(0,5)"),
+ chains = 2, silent = TRUE, refresh = 0
+ )
})
- if (isTRUE(linux)) {
- test_that("check prior", {
- skip("TODO: check hard-coded values")
- expect_warning(expect_equal(
- check_prior(model2)$Prior_Quality,
- c(
- "uninformative", "informative", "informative", "uninformative",
- "uninformative", "not determinable", "not determinable", "not determinable"
- )
- ))
- })
-
- expect_warning(expect_equal(
- check_prior(model2, method = "lakeland")$Prior_Quality,
- c(
- "informative", "informative", "informative", "informative",
- "informative", "not determinable", "not determinable", "not determinable"
- )
- ))
- } else {
- expect_warning(expect_equal(
- check_prior(model2)$Prior_Quality,
- c(
- "uninformative", "uninformative", "informative", "uninformative",
- "uninformative", "not determinable", "not determinable", "not determinable"
- )
- ))
-
- expect_warning(expect_equal(
- check_prior(model2, method = "lakeland")$Prior_Quality,
- c(
- "informative", "informative", "informative", "informative",
- "informative", "not determinable", "not determinable", "not determinable"
- )
- ))
- }
-}
+ expect_warning(expect_equal(
+ check_prior(model2)$Prior_Quality,
+ c(
+ "uninformative", "uninformative", "informative", "uninformative",
+ "uninformative", "not determinable", "not determinable", "not determinable"
+ )
+ ))
+
+ expect_warning(expect_equal(
+ check_prior(model2, method = "lakeland")$Prior_Quality,
+ c(
+ "informative", "informative", "informative", "informative",
+ "informative", "not determinable", "not determinable", "not determinable"
+ )
+ ))
+})
diff --git a/tests/testthat/test-ci.R b/tests/testthat/test-ci.R
index 59a0f42..0f5f9c9 100644
--- a/tests/testthat/test-ci.R
+++ b/tests/testthat/test-ci.R
@@ -1,46 +1,57 @@
-if (requiet("rstanarm") && requiet("httr") && requiet("brms") && requiet("insight") && requiet("testthat")) {
- test_that("ci", {
- expect_equal(ci(distribution_normal(1000), ci = .90)$CI_low[1], -1.6361, tolerance = 0.02)
- expect_equal(nrow(ci(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01)
- expect_equal(ci(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
- # expect_equal(length(capture.output(print(ci(distribution_normal(1000))))))
- # expect_equal(length(capture.output(print(ci(distribution_normal(1000), ci = c(.80, .90))))))
-
- expect_equal(ci(c(2, 3, NA))$CI_low, 2.02, tolerance = 1e-2)
- expect_warning(ci(c(2, 3)))
- expect_warning(ci(distribution_normal(1000), ci = 950))
-
- x <- data.frame(replicate(4, rnorm(100)))
- x <- ci(x, ci = c(0.68, 0.89, 0.95))
- a <- datawizard::reshape_ci(x)
- expect_equal(c(nrow(x), ncol(x)), c(12, 4))
- expect_true(all(datawizard::reshape_ci(a) == x))
- })
-
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("ci", {
- expect_equal(
- ci(m, ci = c(.5, .8), effects = "all")$CI_low,
- ci(p, ci = c(.5, .8))$CI_low,
- tolerance = 1e-3
- )
- })
-
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("rope", {
- expect_equal(
- ci(m, ci = c(.5, .8), effects = "all", component = "all")$CI_low,
- ci(p, ci = c(.5, .8))$CI_low,
- tolerance = 1e-3
- )
- })
- }
-}
+test_that("ci", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("brms")
+
+ expect_equal(ci(distribution_normal(1000), ci = .90)$CI_low[1], -1.6361, tolerance = 0.02)
+ expect_equal(nrow(ci(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01)
+ expect_equal(ci(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
+ # expect_equal(length(capture.output(print(ci(distribution_normal(1000))))))
+ # expect_equal(length(capture.output(print(ci(distribution_normal(1000), ci = c(.80, .90))))))
+
+ expect_equal(ci(c(2, 3, NA))$CI_low, 2.02, tolerance = 1e-2)
+ expect_warning(ci(c(2, 3)))
+ expect_warning(ci(distribution_normal(1000), ci = 950))
+
+ x <- data.frame(replicate(4, rnorm(100)))
+ x <- ci(x, ci = c(0.68, 0.89, 0.95))
+ a <- datawizard::reshape_ci(x)
+ expect_equal(c(nrow(x), ncol(x)), c(12, 4))
+ expect_true(all(datawizard::reshape_ci(a) == x))
+})
+
+
+
+test_that("ci", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("brms")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+
+ expect_equal(
+ ci(m, ci = c(0.5, 0.8), effects = "all")$CI_low,
+ ci(p, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 1e-3
+ )
+})
+
+
+test_that("rope", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("brms")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+
+ expect_equal(
+ ci(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low,
+ ci(p, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 1e-3
+ )
+})
diff --git a/tests/testthat/test-contr.R b/tests/testthat/test-contr.R
index 16da759..954f1d0 100644
--- a/tests/testthat/test-contr.R
+++ b/tests/testthat/test-contr.R
@@ -1,4 +1,3 @@
-
test_that("contr.equalprior | gen", {
skip_on_cran()
set.seed(1234)
diff --git a/tests/testthat/test-describe_posterior.R b/tests/testthat/test-describe_posterior.R
index ae82add..30bc5bb 100644
--- a/tests/testthat/test-describe_posterior.R
+++ b/tests/testthat/test-describe_posterior.R
@@ -1,579 +1,639 @@
-if (requiet("testthat") &&
- requiet("bayestestR") &&
- requiet("rstanarm") &&
- requiet("brms") &&
- requiet("httr") &&
- requiet("insight") &&
- requiet("BayesFactor")) {
- test_that("describe_posterior", {
- set.seed(333)
-
- # numeric -------------------------------------------------
-
- x <- distribution_normal(40000)
-
- expect_warning(describe_posterior(
+test_that("describe_posterior", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(333)
+
+ # numeric -------------------------------------------------
+
+ x <- distribution_normal(4000)
+
+ describe_posterior(
+ x,
+ centrality = "all",
+ dispersion = TRUE,
+ test = "all",
+ ci = 0.89,
+ verbose = FALSE
+ )
+
+ rez <- as.data.frame(suppressWarnings(describe_posterior(
+ x,
+ centrality = "all",
+ dispersion = TRUE,
+ test = "all",
+ ci = 0.89
+ )))
+
+ expect_equal(dim(rez), c(1, 19))
+ expect_identical(colnames(rez), c(
+ "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
+ "CI_high", "p_map", "pd", "p_ROPE", "ps", "ROPE_CI", "ROPE_low",
+ "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "log_BF"
+ ))
+
+ expect_warning(expect_warning(describe_posterior(
+ x,
+ centrality = "all",
+ dispersion = TRUE,
+ test = "all",
+ ci = c(0.8, 0.9)
+ )))
+ # rez <- suppressWarnings(describe_posterior(
+ # x,
+ # centrality = "all",
+ # dispersion = TRUE,
+ # test = "all",
+ # ci = c(0.8, 0.9)
+ # ))
+ # expect_equal(dim(rez), c(2, 19))
+
+ rez <- describe_posterior(
+ x,
+ centrality = NULL,
+ dispersion = TRUE,
+ test = NULL,
+ ci_method = "quantile",
+ verbose = FALSE
+ )
+ expect_equal(dim(rez), c(1, 4))
+
+ # dataframes -------------------------------------------------
+
+ x <- data.frame(replicate(4, rnorm(100)))
+ expect_warning(expect_warning(
+ describe_posterior(
x,
centrality = "all",
dispersion = TRUE,
- test = "all",
- ci = 0.89
- ))
-
- rez <- as.data.frame(suppressWarnings(describe_posterior(
- x,
- centrality = "all",
- dispersion = TRUE,
- test = "all",
- ci = 0.89
- )))
-
- expect_equal(dim(rez), c(1, 19))
- expect_equal(colnames(rez), c(
- "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
- "CI_high", "p_map", "pd", "p_ROPE", "ps", "ROPE_CI", "ROPE_low",
- "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "log_BF"
- ))
-
- expect_warning(describe_posterior(
+ test = "all"
+ )
+ ))
+ # rez <- suppressWarnings(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all"))
+ # expect_equal(dim(rez), c(4, 19))
+ expect_warning(expect_warning(
+ describe_posterior(
x,
centrality = "all",
dispersion = TRUE,
test = "all",
ci = c(0.8, 0.9)
- ))
- # rez <- suppressWarnings(describe_posterior(
- # x,
- # centrality = "all",
- # dispersion = TRUE,
- # test = "all",
- # ci = c(0.8, 0.9)
- # ))
- # expect_equal(dim(rez), c(2, 19))
-
- rez <- describe_posterior(
- x,
- centrality = NULL,
- dispersion = TRUE,
- test = NULL,
- ci_method = "quantile"
)
- expect_equal(dim(rez), c(1, 4))
-
- # dataframes -------------------------------------------------
-
- x <- data.frame(replicate(4, rnorm(100)))
- expect_warning(expect_warning(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")))
- # rez <- suppressWarnings(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all"))
- # expect_equal(dim(rez), c(4, 19))
- expect_warning(expect_warning(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9))))
- # rez <- suppressWarnings(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9)))
- # expect_equal(dim(rez), c(8, 19))
- rez <- describe_posterior(x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method = "quantile")
- expect_equal(dim(rez), c(4, 4))
- })
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest && Sys.info()["sysname"] != "Darwin") {
- test_that("describe_posterior", {
- set.seed(333)
- # Rstanarm
- x <- rstanarm::stan_glm(mpg ~ wt, data = mtcars, refresh = 0, iter = 500)
- expect_warning(rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all"))
- expect_equal(dim(rez), c(2, 21))
- expect_equal(colnames(rez), c(
- "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
- "CI_high", "p_MAP", "pd", "p_ROPE", "ps", "ROPE_CI", "ROPE_low",
- "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "log_BF", "Rhat",
- "ESS"
- ))
- expect_warning(rez <- describe_posterior(
- x,
- centrality = "all",
- dispersion = TRUE,
- test = "all",
- ci = c(0.8, 0.9)
- ))
- expect_equal(dim(rez), c(4, 21))
-
- rez <- describe_posterior(
- x,
- centrality = NULL,
- dispersion = TRUE,
- test = NULL,
- ci_method = "quantile",
- diagnostic = NULL,
- priors = FALSE
- )
- expect_equal(dim(rez), c(2, 4))
-
- # brms -------------------------------------------------
-
- # x <- brms::brm(mpg ~ wt + (1 | cyl) + (1 + wt | gear), data = mtcars, refresh = 0)
- # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, ci = c(0.8, 0.9))
- #
- # expect_equal(dim(rez), c(4, 16))
- # expect_equal(colnames(rez), c(
- # "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
- # "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
- # "Rhat", "ESS"
- # ))
- #
- # rez <- describe_posterior(
- # x,
- # centrality = NULL,
- # dispersion = TRUE,
- # test = NULL,
- # ci_method = "quantile",
- # diagnostic = NULL
- # )
- #
- # expect_equal(dim(rez), c(2, 4))
- #
- # model <- brms::brm(
- # mpg ~ drat,
- # data = mtcars,
- # chains = 2,
- # algorithm = "meanfield",
- # refresh = 0
- # )
- #
- # expect_equal(nrow(describe_posterior(model)), 2)
-
- # rstanarm -------------------------------------------------
-
- model <- rstanarm::stan_glm(mpg ~ drat,
- data = mtcars,
- algorithm = "meanfield",
- refresh = 0
- )
-
- expect_equal(nrow(describe_posterior(model)), 2)
-
- model <- suppressWarnings(rstanarm::stan_glm(mpg ~ drat,
- data = mtcars,
- algorithm = "optimizing",
- refresh = 0
- ))
-
- expect_equal(nrow(describe_posterior(model)), 2)
-
- model <- rstanarm::stan_glm(mpg ~ drat,
- data = mtcars,
- algorithm = "fullrank",
- refresh = 0
- )
-
- expect_equal(nrow(describe_posterior(model)), 2)
- # model <- brms::brm(mpg ~ drat, data = mtcars, chains=2, algorithm="fullrank", refresh=0)
- # expect_equal(nrow(describe_posterior(model)), 2)
-
- # BayesFactor
- # library(BayesFactor)
- # x <- BayesFactor::ttestBF(x = rnorm(100, 1, 1))
- # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")
- # expect_equal(dim(rez), c(4, 16))
- # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9))
- # expect_equal(dim(rez), c(8, 16))
- # rez <- describe_posterior(x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method="quantile")
- # expect_equal(dim(rez), c(4, 4))
- })
-
- if (requiet("insight")) {
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("describe_posterior", {
- expect_equal(
- describe_posterior(m, effects = "all")$Median,
- describe_posterior(p)$Median,
- tolerance = 1e-3
+ ))
+ # rez <- suppressWarnings(describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9)))
+ # expect_equal(dim(rez), c(8, 19))
+ rez <- describe_posterior(
+ x,
+ centrality = NULL,
+ dispersion = TRUE,
+ test = NULL,
+ ci_method = "quantile"
+ )
+ expect_equal(dim(rez), c(4, 4))
+})
+
+
+
+test_that("describe_posterior", {
+ skip_if(Sys.info()["sysname"] == "Darwin", "Don't run on Darwin")
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(333)
+ # Rstanarm
+ x <- rstanarm::stan_glm(mpg ~ wt, data = mtcars, refresh = 0, iter = 500)
+ expect_warning(rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all"))
+ expect_equal(dim(rez), c(2, 21))
+ expect_equal(colnames(rez), c(
+ "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
+ "CI_high", "p_MAP", "pd", "p_ROPE", "ps", "ROPE_CI", "ROPE_low",
+ "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "log_BF", "Rhat",
+ "ESS"
+ ))
+ expect_warning(rez <- describe_posterior(
+ x,
+ centrality = "all",
+ dispersion = TRUE,
+ test = "all",
+ ci = c(0.8, 0.9)
+ ))
+ expect_equal(dim(rez), c(4, 21))
+
+ rez <- describe_posterior(
+ x,
+ centrality = NULL,
+ dispersion = TRUE,
+ test = NULL,
+ ci_method = "quantile",
+ diagnostic = NULL,
+ priors = FALSE
+ )
+ expect_equal(dim(rez), c(2, 4))
+
+ # brms -------------------------------------------------
+
+ # x <- brms::brm(mpg ~ wt + (1 | cyl) + (1 + wt | gear), data = mtcars, refresh = 0)
+ # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, ci = c(0.8, 0.9))
+ #
+ # expect_equal(dim(rez), c(4, 16))
+ # expect_equal(colnames(rez), c(
+ # "Parameter", "Median", "MAD", "Mean", "SD", "MAP", "CI", "CI_low",
+ # "CI_high", "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
+ # "Rhat", "ESS"
+ # ))
+ #
+ # rez <- describe_posterior(
+ # x,
+ # centrality = NULL,
+ # dispersion = TRUE,
+ # test = NULL,
+ # ci_method = "quantile",
+ # diagnostic = NULL
+ # )
+ #
+ # expect_equal(dim(rez), c(2, 4))
+ #
+ # model <- brms::brm(
+ # mpg ~ drat,
+ # data = mtcars,
+ # chains = 2,
+ # algorithm = "meanfield",
+ # refresh = 0
+ # )
+ #
+ # expect_equal(nrow(describe_posterior(model)), 2)
+
+ # rstanarm -------------------------------------------------
+
+ model <- rstanarm::stan_glm(mpg ~ drat,
+ data = mtcars,
+ algorithm = "meanfield",
+ refresh = 0
+ )
+
+ expect_equal(nrow(describe_posterior(model)), 2)
+
+ model <- suppressWarnings(rstanarm::stan_glm(mpg ~ drat,
+ data = mtcars,
+ algorithm = "optimizing",
+ refresh = 0
+ ))
+
+ expect_equal(nrow(describe_posterior(model)), 2)
+
+ model <- rstanarm::stan_glm(mpg ~ drat,
+ data = mtcars,
+ algorithm = "fullrank",
+ refresh = 0
+ )
+
+ expect_equal(nrow(describe_posterior(model)), 2)
+ # model <- brms::brm(mpg ~ drat, data = mtcars, chains=2, algorithm="fullrank", refresh=0)
+ # expect_equal(nrow(describe_posterior(model)), 2)
+
+ # BayesFactor
+ # library(BayesFactor)
+ # x <- BayesFactor::ttestBF(x = rnorm(100, 1, 1))
+ # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all")
+ # expect_equal(dim(rez), c(4, 16))
+ # rez <- describe_posterior(x, centrality = "all", dispersion = TRUE, test = "all", ci = c(0.8, 0.9))
+ # expect_equal(dim(rez), c(8, 16))
+ # rez <- describe_posterior(x, centrality = NULL, dispersion = TRUE, test = NULL, ci_method="quantile")
+ # expect_equal(dim(rez), c(4, 4))
+})
+
+
+test_that("describe_posterior", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+
+ expect_equal(
+ describe_posterior(m, effects = "all", verbose = FALSE)$Median,
+ describe_posterior(p, verbose = FALSE)$Median,
+ tolerance = 1e-3
+ )
+})
+
+test_that("describe_posterior", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+
+ expect_equal(
+ suppressWarnings(describe_posterior(m, effects = "all", component = "all", verbose = FALSE)$Median),
+ suppressWarnings(describe_posterior(p, verbose = FALSE)$Median),
+ tolerance = 1e-3
+ )
+})
+
+
+test_that("describe_posterior w/ BF+SI", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ x <- insight::download_model("stanreg_lm_1")
+ set.seed(555)
+ expect_warning(expect_warning(rez <- describe_posterior(x, ci_method = "SI", test = "bf")))
+
+
+ # test si
+ set.seed(555)
+ suppressMessages(
+ expect_warning(rez_si <- si(x))
+ )
+ expect_equal(rez$CI_low, rez_si$CI_low, tolerance = 0.1)
+ expect_equal(rez$CI_high, rez_si$CI_high, tolerance = 0.1)
+
+ # test BF
+ set.seed(555)
+ rez_bf <- suppressWarnings(bayesfactor_parameters(x, verbose = FALSE))
+ expect_equal(rez$log_BF, log(as.numeric(rez_bf)), tolerance = 0.1)
+})
+
+# BayesFactor -------------------------------------------------
+
+test_that("describe_posterior: BayesFactor", {
+ skip_if_not(getRversion() >= "4.0", "Don't run with R < 4.0")
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(123)
+ expect_equal(
+ as.data.frame(describe_posterior(correlationBF(
+ mtcars$wt,
+ mtcars$mpg,
+ rscale = 0.5
+ ))),
+ structure(
+ list(
+ Parameter = "rho",
+ Median = -0.833281858269296,
+ CI = 0.95,
+ CI_low = -0.919418102114416,
+ CI_high = -0.715602277241063,
+ pd = 1,
+ ROPE_CI = 0.95,
+ ROPE_low = -0.05,
+ ROPE_high = 0.05,
+ ROPE_Percentage = 0,
+ log_BF = 17.328704623688,
+ BF = 33555274.5519413,
+ Prior_Distribution = "beta",
+ Prior_Location = 2,
+ Prior_Scale = 2
+ ),
+ row.names = 1L,
+ class = "data.frame",
+ ci_method = "hdi"
+ ),
+ tolerance = 0.1,
+ ignore_attr = TRUE
+ )
+
+ set.seed(123)
+ expect_equal(
+ describe_posterior(ttestBF(mtcars$wt, mu = 3), ci = 0.95, ci_method = "hdi"),
+ structure(
+ list(
+ Parameter = "Difference",
+ Median = 0.192275922178887,
+ CI = 0.95,
+ CI_low = -0.172955539648102,
+ CI_high = 0.526426796879103,
+ pd = 0.85875,
+ ROPE_CI = 0.95,
+ ROPE_low = -0.0978457442989697,
+ ROPE_high = 0.0978457442989697,
+ ROPE_Percentage = 0.257300710339384,
+ log_BF = -0.94971351422473,
+ BF = 0.386851835128661,
+ Prior_Distribution = "cauchy",
+ Prior_Location = 0,
+ Prior_Scale = 0.707106781186548
+ ),
+ row.names = 1L, class = c("describe_posterior", "see_describe_posterior", "data.frame"),
+ ci_method = "hdi", object_name = "ttestBF(mtcars$wt, mu = 3)"
+ ),
+ tolerance = 0.1,
+ ignore_attr = TRUE
+ )
+
+ set.seed(123)
+ expect_warning(expect_equal(
+ describe_posterior(
+ contingencyTableBF(
+ x = table(mtcars$am, mtcars$cyl),
+ sampleType = "poisson"
+ ),
+ ci = 0.95,
+ ci_method = "hdi"
+ ),
+ structure(
+ list(
+ Parameter = c(
+ "cell[1,1]",
+ "cell[2,1]",
+ "cell[1,2]",
+ "cell[2,2]",
+ "cell[1,3]",
+ "cell[2,3]",
+ "Ratio"
+ ),
+ Median = c(
+ 3.04620767622137,
+ 7.33170140780154,
+ 3.96252503900368,
+ 3.06206636495483,
+ 10.7088156207511,
+ 2.26008072419983,
+ NA
+ ),
+ CI = c(
+ 0.95, 0.95, 0.95, 0.95, 0.95, 0.95,
+ NA
+ ),
+ CI_low = c(
+ 0.537476720942068,
+ 3.33553818106395,
+ 1.05013765177975,
+ 0.746538992318074,
+ 5.49894434136364,
+ 0.275642629940081,
+ NA
+ ),
+ CI_high = c(
+ 6.62852027141624,
+ 12.6753970192515,
+ 7.74693313388489,
+ 6.87239730676778,
+ 16.9198964674968,
+ 5.4533083861175,
+ NA
+ ),
+ pd = c(1, 1, 1, 1, 1, 1, NA),
+ ROPE_CI = c(
+ 0.95, 0.95, 0.95,
+ 0.95, 0.95, 0.95, NA
+ ),
+ ROPE_low = c(
+ -0.1, -0.1, -0.1, -0.1,
+ -0.1, -0.1, NA
+ ),
+ ROPE_high = c(
+ 0.1, 0.1, 0.1, 0.1, 0.1, 0.1,
+ NA
+ ),
+ ROPE_Percentage = c(0, 0, 0, 0, 0, 0, NA),
+ log_BF = c(
+ 3.84187678153378,
+ 3.84187678153378,
+ 3.84187678153378,
+ 3.84187678153378,
+ 3.84187678153378,
+ 3.84187678153378,
+ NA
+ ),
+ BF = c(
+ 46.6128745808996,
+ 46.6128745808996,
+ 46.6128745808996,
+ 46.6128745808996,
+ 46.6128745808996,
+ 46.6128745808996,
+ NA
+ ),
+ Prior_Distribution = c(NA, NA, NA, NA, NA, NA, "poisson"),
+ Prior_Location = c(NA, NA, NA, NA, NA, NA, 0),
+ Prior_Scale = c(
+ NA,
+ NA, NA, NA, NA, NA, 1
)
- })
-
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("describe_posterior", {
- expect_equal(
- describe_posterior(m, effects = "all", component = "all")$Median,
- describe_posterior(p)$Median,
- tolerance = 1e-3
+ ),
+ row.names = c(
+ 1L, 4L, 2L, 5L, 3L,
+ 6L, 7L
+ ),
+ class = c("describe_posterior", "see_describe_posterior")
+ ),
+ tolerance = 0.1,
+ ignore_attr = TRUE
+ ))
+
+ set.seed(123)
+ expect_warning(expect_equal(
+ describe_posterior(contingencyTableBF(
+ x = table(mtcars$am, mtcars$cyl),
+ sampleType = "indepMulti",
+ fixedMargin = "cols",
+ priorConcentration = 1.6
+ ), ci = 0.95),
+ structure(
+ list(
+ Parameter = c(
+ "cell[1,1]",
+ "cell[2,1]",
+ "cell[1,2]",
+ "cell[2,2]",
+ "cell[1,3]",
+ "cell[2,3]",
+ "Ratio"
+ ),
+ Median = c(
+ 3.33359102240953,
+ 7.27094924961528,
+ 4.13335763121549,
+ 3.36172537199681,
+ 10.3872621523407,
+ 2.56061336771352,
+ NA
+ ),
+ CI = c(
+ 0.95, 0.95, 0.95, 0.95, 0.95, 0.95,
+ NA
+ ),
+ CI_low = c(
+ 0.912122089726423,
+ 3.51744611674693,
+ 1.39218072401004,
+ 0.923175932880601,
+ 6.18021898129278,
+ 0.465587711080369,
+ NA
+ ),
+ CI_high = c(
+ 6.61128887457661,
+ 11.4058892728414,
+ 7.61378018576518,
+ 6.65522159416386,
+ 15.1209075845299,
+ 5.35853420162441,
+ NA
+ ),
+ pd = c(1, 1, 1, 1, 1, 1, NA),
+ ROPE_CI = c(
+ 0.95, 0.95, 0.95,
+ 0.95, 0.95, 0.95, NA
+ ),
+ ROPE_low = c(
+ -0.1, -0.1, -0.1, -0.1,
+ -0.1, -0.1, NA
+ ),
+ ROPE_high = c(
+ 0.1, 0.1, 0.1, 0.1, 0.1, 0.1,
+ NA
+ ),
+ ROPE_Percentage = c(0, 0, 0, 0, 0, 0, NA),
+ log_BF = c(
+ 2.49338780738881,
+ 2.49338780738881,
+ 2.49338780738881,
+ 2.49338780738881,
+ 2.49338780738881,
+ 2.49338780738881,
+ NA
+ ),
+ BF = c(
+ 12.1022066941064,
+ 12.1022066941064,
+ 12.1022066941064,
+ 12.1022066941064,
+ 12.1022066941064,
+ 12.1022066941064,
+ NA
+ ),
+ Prior_Distribution = c(NA, NA, NA, NA, NA, NA, "independent multinomial"),
+ Prior_Location = c(NA, NA, NA, NA, NA, NA, 0),
+ Prior_Scale = c(
+ NA,
+ NA, NA, NA, NA, NA, 1.6
)
- })
- }
-
-
- test_that("describe_posterior w/ BF+SI", {
- skip_on_cran()
-
- x <- insight::download_model("stanreg_lm_1")
- set.seed(555)
- expect_warning(expect_warning(rez <- describe_posterior(x, ci_method = "SI", test = "bf")))
-
-
- # test si
- set.seed(555)
- expect_warning(rez_si <- si(x))
- expect_equal(rez$CI_low, rez_si$CI_low, tolerance = 0.1)
- expect_equal(rez$CI_high, rez_si$CI_high, tolerance = 0.1)
-
- # test BF
- set.seed(555)
- rez_bf <- suppressWarnings(bayesfactor_parameters(x))
- expect_equal(rez$log_BF, log(as.numeric(rez_bf)), tolerance = 0.1)
- })
-
- # BayesFactor -------------------------------------------------
-
- if (getRversion() >= "4.0") {
- set.seed(123)
- expect_equal(
- as.data.frame(describe_posterior(correlationBF(
- mtcars$wt,
- mtcars$mpg,
- rscale = 0.5
- ))),
- structure(
- list(
- Parameter = "rho",
- Median = -0.833281858269296,
- CI = 0.95,
- CI_low = -0.919418102114416,
- CI_high = -0.715602277241063,
- pd = 1,
- ROPE_CI = 0.95,
- ROPE_low = -0.05,
- ROPE_high = 0.05,
- ROPE_Percentage = 0,
- log_BF = 17.328704623688,
- BF = 33555274.5519413,
- Prior_Distribution = "beta",
- Prior_Location = 2,
- Prior_Scale = 2
- ),
- row.names = 1L,
- class = "data.frame",
- ci_method = "hdi"
+ ),
+ row.names = c(
+ 1L, 4L, 2L, 5L,
+ 3L, 6L, 7L
+ ),
+ class = c(
+ "describe_posterior", "see_describe_posterior",
+ "data.frame"
+ ),
+ ci_method = "hdi",
+ object_name = "contingencyTableBF(x = table(mtcars$am, mtcars$cyl), sampleType = \"indepMulti\", fixedMargin = \"cols\", priorConcentration = 1.6)"
+ ),
+ tolerance = 0.1,
+ ignore_attr = TRUE
+ ))
+
+ set.seed(123)
+ expect_equal(
+ describe_posterior(anovaBF(extra ~ group, data = sleep, progress = FALSE), ci_method = "hdi", ci = 0.95),
+ structure(
+ list(
+ Parameter = c(
+ "mu", "group-1", "group-2", "sig2",
+ "g_group"
+ ),
+ Median = c(
+ 1.53667371296145,
+ -0.571674439385088,
+ 0.571674439385088,
+ 3.69268743002151,
+ 0.349038661644431
),
- tolerance = 0.1,
- ignore_attr = TRUE
- )
-
- set.seed(123)
- expect_equal(
- describe_posterior(ttestBF(mtcars$wt, mu = 3), ci = 0.95, ci_method = "hdi"),
- structure(
- list(
- Parameter = "Difference", Median = 0.192275922178887, CI = 0.95,
- CI_low = -0.172955539648102, CI_high = 0.526426796879103, pd = 0.85875,
- ROPE_CI = 0.95, ROPE_low = -0.0978457442989697, ROPE_high = 0.0978457442989697,
- ROPE_Percentage = 0.257300710339384, log_BF = -0.94971351422473,
- BF = 0.386851835128661, Prior_Distribution = "cauchy",
- Prior_Location = 0, Prior_Scale = 0.707106781186548
- ),
- row.names = 1L, class = c("describe_posterior", "see_describe_posterior", "data.frame"),
- ci_method = "hdi", object_name = "ttestBF(mtcars$wt, mu = 3)"
+ CI = c(
+ 0.95,
+ 0.95, 0.95, 0.95, 0.95
),
- tolerance = 0.1,
- ignore_attr = TRUE
- )
-
- set.seed(123)
- expect_warning(expect_equal(
- describe_posterior(
- contingencyTableBF(
- x = table(mtcars$am, mtcars$cyl),
- sampleType = "poisson"
- ),
- ci = 0.95,
- ci_method = "hdi"
+ CI_low = c(
+ 0.691696017646264,
+ -1.31604531656452,
+ -0.229408603643392,
+ 1.75779899540302,
+ 0.0192738130412634
),
- structure(
- list(
- Parameter = c(
- "cell[1,1]",
- "cell[2,1]",
- "cell[1,2]",
- "cell[2,2]",
- "cell[1,3]",
- "cell[2,3]",
- "Ratio"
- ),
- Median = c(
- 3.04620767622137,
- 7.33170140780154,
- 3.96252503900368,
- 3.06206636495483,
- 10.7088156207511,
- 2.26008072419983,
- NA
- ),
- CI = c(
- 0.95, 0.95, 0.95, 0.95, 0.95, 0.95,
- NA
- ),
- CI_low = c(
- 0.537476720942068,
- 3.33553818106395,
- 1.05013765177975,
- 0.746538992318074,
- 5.49894434136364,
- 0.275642629940081,
- NA
- ),
- CI_high = c(
- 6.62852027141624,
- 12.6753970192515,
- 7.74693313388489,
- 6.87239730676778,
- 16.9198964674968,
- 5.4533083861175,
- NA
- ),
- pd = c(1, 1, 1, 1, 1, 1, NA),
- ROPE_CI = c(
- 0.95, 0.95, 0.95,
- 0.95, 0.95, 0.95, NA
- ),
- ROPE_low = c(
- -0.1, -0.1, -0.1, -0.1,
- -0.1, -0.1, NA
- ),
- ROPE_high = c(
- 0.1, 0.1, 0.1, 0.1, 0.1, 0.1,
- NA
- ),
- ROPE_Percentage = c(0, 0, 0, 0, 0, 0, NA),
- log_BF = c(
- 3.84187678153378,
- 3.84187678153378,
- 3.84187678153378,
- 3.84187678153378,
- 3.84187678153378,
- 3.84187678153378,
- NA
- ),
- BF = c(
- 46.6128745808996,
- 46.6128745808996,
- 46.6128745808996,
- 46.6128745808996,
- 46.6128745808996,
- 46.6128745808996,
- NA
- ),
- Prior_Distribution = c(NA, NA, NA, NA, NA, NA, "poisson"),
- Prior_Location = c(NA, NA, NA, NA, NA, NA, 0),
- Prior_Scale = c(
- NA,
- NA, NA, NA, NA, NA, 1
- )
- ),
- row.names = c(
- 1L, 4L, 2L, 5L, 3L,
- 6L, 7L
- ),
- class = c("describe_posterior", "see_describe_posterior")
+ CI_high = c(
+ 2.43317955922589,
+ 0.229408603643392,
+ 1.31604531656452,
+ 6.88471056133351,
+ 5.30402785651874
),
- tolerance = 0.1,
- ignore_attr = TRUE
- ))
-
- set.seed(123)
- expect_warning(expect_equal(
- describe_posterior(contingencyTableBF(
- x = table(mtcars$am, mtcars$cyl),
- sampleType = "indepMulti",
- fixedMargin = "cols",
- priorConcentration = 1.6
- ), ci = 0.95),
- structure(
- list(
- Parameter = c(
- "cell[1,1]",
- "cell[2,1]",
- "cell[1,2]",
- "cell[2,2]",
- "cell[1,3]",
- "cell[2,3]",
- "Ratio"
- ),
- Median = c(
- 3.33359102240953,
- 7.27094924961528,
- 4.13335763121549,
- 3.36172537199681,
- 10.3872621523407,
- 2.56061336771352,
- NA
- ),
- CI = c(
- 0.95, 0.95, 0.95, 0.95, 0.95, 0.95,
- NA
- ),
- CI_low = c(
- 0.912122089726423,
- 3.51744611674693,
- 1.39218072401004,
- 0.923175932880601,
- 6.18021898129278,
- 0.465587711080369,
- NA
- ),
- CI_high = c(
- 6.61128887457661,
- 11.4058892728414,
- 7.61378018576518,
- 6.65522159416386,
- 15.1209075845299,
- 5.35853420162441,
- NA
- ),
- pd = c(1, 1, 1, 1, 1, 1, NA),
- ROPE_CI = c(
- 0.95, 0.95, 0.95,
- 0.95, 0.95, 0.95, NA
- ),
- ROPE_low = c(
- -0.1, -0.1, -0.1, -0.1,
- -0.1, -0.1, NA
- ),
- ROPE_high = c(
- 0.1, 0.1, 0.1, 0.1, 0.1, 0.1,
- NA
- ),
- ROPE_Percentage = c(0, 0, 0, 0, 0, 0, NA),
- log_BF = c(
- 2.49338780738881,
- 2.49338780738881,
- 2.49338780738881,
- 2.49338780738881,
- 2.49338780738881,
- 2.49338780738881,
- NA
- ),
- BF = c(
- 12.1022066941064,
- 12.1022066941064,
- 12.1022066941064,
- 12.1022066941064,
- 12.1022066941064,
- 12.1022066941064,
- NA
- ),
- Prior_Distribution = c(NA, NA, NA, NA, NA, NA, "independent multinomial"),
- Prior_Location = c(NA, NA, NA, NA, NA, NA, 0),
- Prior_Scale = c(
- NA,
- NA, NA, NA, NA, NA, 1.6
- )
- ),
- row.names = c(
- 1L, 4L, 2L, 5L,
- 3L, 6L, 7L
- ),
- class = c(
- "describe_posterior", "see_describe_posterior",
- "data.frame"
- ),
- ci_method = "hdi",
- object_name = "contingencyTableBF(x = table(mtcars$am, mtcars$cyl), sampleType = \"indepMulti\", fixedMargin = \"cols\", priorConcentration = 1.6)"
+ pd = c(0.99975, 0.927, 0.927, 1, 1),
+ ROPE_CI = c(
+ 0.95, 0.95,
+ 0.95, 0.95, 0.95
),
- tolerance = 0.1,
- ignore_attr = TRUE
- ))
-
- set.seed(123)
- expect_equal(
- describe_posterior(anovaBF(extra ~ group, data = sleep, progress = FALSE), ci_method = "hdi", ci = 0.95),
- structure(
- list(
- Parameter = c(
- "mu", "group-1", "group-2", "sig2",
- "g_group"
- ),
- Median = c(
- 1.53667371296145,
- -0.571674439385088,
- 0.571674439385088,
- 3.69268743002151,
- 0.349038661644431
- ),
- CI = c(
- 0.95,
- 0.95, 0.95, 0.95, 0.95
- ),
- CI_low = c(
- 0.691696017646264,
- -1.31604531656452,
- -0.229408603643392,
- 1.75779899540302,
- 0.0192738130412634
- ),
- CI_high = c(
- 2.43317955922589,
- 0.229408603643392,
- 1.31604531656452,
- 6.88471056133351,
- 5.30402785651874
- ),
- pd = c(0.99975, 0.927, 0.927, 1, 1),
- ROPE_CI = c(
- 0.95, 0.95,
- 0.95, 0.95, 0.95
- ),
- ROPE_low = c(
- -0.201791972090071,
- -0.201791972090071,
- -0.201791972090071,
- -0.201791972090071,
- -0.201791972090071
- ),
- ROPE_high = c(
- 0.201791972090071,
- 0.201791972090071,
- 0.201791972090071,
- 0.201791972090071,
- 0.201791972090071
- ),
- ROPE_Percentage = c(
- 0,
- 0.162325703762168, 0.162325703762168, 0, 0.346487766377269
- ),
- log_BF = c(
- 0.235803198474248,
- 0.235803198474248,
- 0.235803198474248,
- 0.235803198474248,
- 0.235803198474248
- ),
- BF = c(
- 1.26592514964916,
- 1.26592514964916,
- 1.26592514964916,
- 1.26592514964916,
- 1.26592514964916
- ),
- Prior_Distribution = c(NA, "cauchy", "cauchy", NA, NA),
- Prior_Location = c(NA, 0, 0, NA, NA),
- Prior_Scale = c(
- NA,
- 0.5, 0.5, NA, NA
- )
- ),
- row.names = c(4L, 2L, 3L, 5L, 1L),
- class = c(
- "describe_posterior",
- "see_describe_posterior", "data.frame"
- ),
- ci_method = "hdi",
- object_name = "anovaBF(extra ~ group, data = sleep, progress = FALSE)"
+ ROPE_low = c(
+ -0.201791972090071,
+ -0.201791972090071,
+ -0.201791972090071,
+ -0.201791972090071,
+ -0.201791972090071
),
- tolerance = 0.1,
- ignore_attr = TRUE
- )
- }
- }
-}
+ ROPE_high = c(
+ 0.201791972090071,
+ 0.201791972090071,
+ 0.201791972090071,
+ 0.201791972090071,
+ 0.201791972090071
+ ),
+ ROPE_Percentage = c(
+ 0,
+ 0.162325703762168, 0.162325703762168, 0, 0.346487766377269
+ ),
+ log_BF = c(
+ 0.235803198474248,
+ 0.235803198474248,
+ 0.235803198474248,
+ 0.235803198474248,
+ 0.235803198474248
+ ),
+ BF = c(
+ 1.26592514964916,
+ 1.26592514964916,
+ 1.26592514964916,
+ 1.26592514964916,
+ 1.26592514964916
+ ),
+ Prior_Distribution = c(NA, "cauchy", "cauchy", NA, NA),
+ Prior_Location = c(NA, 0, 0, NA, NA),
+ Prior_Scale = c(
+ NA,
+ 0.5, 0.5, NA, NA
+ )
+ ),
+ row.names = c(4L, 2L, 3L, 5L, 1L),
+ class = c(
+ "describe_posterior",
+ "see_describe_posterior", "data.frame"
+ ),
+ ci_method = "hdi",
+ object_name = "anovaBF(extra ~ group, data = sleep, progress = FALSE)"
+ ),
+ tolerance = 0.1,
+ ignore_attr = TRUE
+ )
+})
diff --git a/tests/testthat/test-describe_prior.R b/tests/testthat/test-describe_prior.R
index e98d446..8d47597 100644
--- a/tests/testthat/test-describe_prior.R
+++ b/tests/testthat/test-describe_prior.R
@@ -1,157 +1,151 @@
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
+test_that("describe_prior", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
-if (.runThisTest &&
- requiet("testthat") &&
- requiet("bayestestR") &&
- requiet("rstanarm") &&
- requiet("brms") &&
- requiet("httr") &&
- requiet("insight") &&
- requiet("BayesFactor") &&
- packageVersion("insight") > "0.13.2") {
- test_that("describe_prior", {
- # Bayes Factor ----------------------------------------
+ # Bayes Factor ----------------------------------------
- expect_equal(
- describe_prior(correlationBF(mtcars$wt, mtcars$mpg, rscale = 0.5)),
- structure(list(
- Parameter = "rho", Prior_Distribution = "beta",
- Prior_Location = 2, Prior_Scale = 2
- ), class = "data.frame", row.names = c(
- NA,
- -1L
- ))
- )
+ expect_equal(
+ describe_prior(correlationBF(mtcars$wt, mtcars$mpg, rscale = 0.5)),
+ structure(list(
+ Parameter = "rho", Prior_Distribution = "beta",
+ Prior_Location = 2, Prior_Scale = 2
+ ), class = "data.frame", row.names = c(
+ NA,
+ -1L
+ ))
+ )
- expect_equal(
- describe_prior(ttestBF(mtcars$wt, mu = 3)),
- structure(list(
- Parameter = "Difference", Prior_Distribution = "cauchy",
- Prior_Location = 0, Prior_Scale = 0.707106781186548
- ), class = "data.frame", row.names = c(
- NA,
- -1L
- ))
- )
+ expect_equal(
+ describe_prior(ttestBF(mtcars$wt, mu = 3)),
+ structure(list(
+ Parameter = "Difference", Prior_Distribution = "cauchy",
+ Prior_Location = 0, Prior_Scale = 0.707106781186548
+ ), class = "data.frame", row.names = c(
+ NA,
+ -1L
+ ))
+ )
- expect_equal(
- describe_prior(contingencyTableBF(
- x = table(mtcars$am, mtcars$cyl),
- sampleType = "poisson"
- )),
- structure(list(
- Parameter = "Ratio", Prior_Distribution = "poisson",
- Prior_Location = 0, Prior_Scale = 1
- ), class = "data.frame", row.names = c(
- NA,
- -1L
- ))
- )
+ expect_equal(
+ describe_prior(contingencyTableBF(
+ x = table(mtcars$am, mtcars$cyl),
+ sampleType = "poisson"
+ )),
+ structure(list(
+ Parameter = "Ratio", Prior_Distribution = "poisson",
+ Prior_Location = 0, Prior_Scale = 1
+ ), class = "data.frame", row.names = c(
+ NA,
+ -1L
+ ))
+ )
- expect_equal(
- describe_prior(contingencyTableBF(
- x = table(mtcars$am, mtcars$cyl),
- sampleType = "indepMulti",
- fixedMargin = "cols",
- priorConcentration = 1.6
- )),
- structure(list(
- Parameter = "Ratio", Prior_Distribution = "independent multinomial",
- Prior_Location = 0, Prior_Scale = 1.6
- ), class = "data.frame", row.names = c(
- NA,
- -1L
- ))
- )
+ expect_equal(
+ describe_prior(contingencyTableBF(
+ x = table(mtcars$am, mtcars$cyl),
+ sampleType = "indepMulti",
+ fixedMargin = "cols",
+ priorConcentration = 1.6
+ )),
+ structure(list(
+ Parameter = "Ratio", Prior_Distribution = "independent multinomial",
+ Prior_Location = 0, Prior_Scale = 1.6
+ ), class = "data.frame", row.names = c(
+ NA,
+ -1L
+ ))
+ )
- expect_equal(
- describe_prior(anovaBF(extra ~ group, data = sleep, progress = FALSE)),
- structure(list(Parameter = c(
- "group-1", "group-2", "mu", "sig2",
- "g_group"
- ), Prior_Distribution = c(
- "cauchy", "cauchy", NA, NA,
- NA
- ), Prior_Location = c(0, 0, NA, NA, NA), Prior_Scale = c(
- 0.5,
- 0.5, NA, NA, NA
- )), row.names = c(NA, -5L), class = "data.frame")
- )
+ expect_equal(
+ describe_prior(anovaBF(extra ~ group, data = sleep, progress = FALSE)),
+ structure(list(Parameter = c(
+ "group-1", "group-2", "mu", "sig2",
+ "g_group"
+ ), Prior_Distribution = c(
+ "cauchy", "cauchy", NA, NA,
+ NA
+ ), Prior_Location = c(0, 0, NA, NA, NA), Prior_Scale = c(
+ 0.5,
+ 0.5, NA, NA, NA
+ )), row.names = c(NA, -5L), class = "data.frame")
+ )
- # brms ----------------------------------------
+ # brms ----------------------------------------
- mod_brms <- insight::download_model("brms_1")
+ mod_brms <- insight::download_model("brms_1")
- expect_equal(
- describe_prior(mod_brms),
- structure(
+ expect_equal(
+ describe_prior(mod_brms),
+ structure(
+ list(
+ Parameter = c("b_Intercept", "b_wt", "b_cyl", "sigma"),
+ Prior_Distribution = c("student_t", "uniform", "uniform", "student_t"),
+ Prior_Location = c(19.2, NA, NA, 0),
+ Prior_Scale = c(5.4, NA, NA, 5.4),
+ Prior_df = c(3, NA, NA, 3)
+ ),
+ row.names = c(NA, -4L),
+ class = "data.frame",
+ priors = structure(
list(
- Parameter = c("b_Intercept", "b_wt", "b_cyl", "sigma"),
- Prior_Distribution = c("student_t", "uniform", "uniform", "student_t"),
- Prior_Location = c(19.2, NA, NA, 0),
- Prior_Scale = c(5.4, NA, NA, 5.4),
- Prior_df = c(3, NA, NA, 3)
- ),
- row.names = c(NA, -4L),
- class = "data.frame",
- priors = structure(
- list(
- prior = c(
- "(flat)", "(flat)", "(flat)", "student_t(3, 19.2, 5.4)",
- "student_t(3, 0, 5.4)"
- ),
- class = c("b", "b", "b", "Intercept", "sigma"),
- coef = c("", "cyl", "wt", "", ""),
- group = c("", "", "", "", ""),
- resp = c("", "", "", "", ""),
- dpar = c("", "", "", "", ""),
- nlpar = c("", "", "", "", ""),
- bound = c("", "", "", "", ""),
- source = c(
- "(unknown)", "(vectorized)", "(vectorized)", "(unknown)",
- "(unknown)"
- ),
- Parameter = c("b_", "b_cyl", "b_wt", "b_Intercept", "sigma")
+ prior = c(
+ "(flat)", "(flat)", "(flat)", "student_t(3, 19.2, 5.4)",
+ "student_t(3, 0, 5.4)"
),
- special = list(mu = list()),
- row.names = c(NA, -5L),
- sample_prior = "no",
- class = "data.frame"
- )
- ),
- ignore_attr = TRUE,
- tolerance = 1e-2
- )
+ class = c("b", "b", "b", "Intercept", "sigma"),
+ coef = c("", "cyl", "wt", "", ""),
+ group = c("", "", "", "", ""),
+ resp = c("", "", "", "", ""),
+ dpar = c("", "", "", "", ""),
+ nlpar = c("", "", "", "", ""),
+ bound = c("", "", "", "", ""),
+ source = c(
+ "(unknown)", "(vectorized)", "(vectorized)", "(unknown)",
+ "(unknown)"
+ ),
+ Parameter = c("b_", "b_cyl", "b_wt", "b_Intercept", "sigma")
+ ),
+ special = list(mu = list()),
+ row.names = c(NA, -5L),
+ sample_prior = "no",
+ class = "data.frame"
+ )
+ ),
+ ignore_attr = TRUE,
+ tolerance = 1e-2
+ )
- # stanreg ----------------------------------------
+ # stanreg ----------------------------------------
- mod_stanreg1 <- insight::download_model("stanreg_gamm4_1")
- mod_stanreg2 <- insight::download_model("stanreg_merMod_1")
+ mod_stanreg1 <- insight::download_model("stanreg_gamm4_1")
+ mod_stanreg2 <- insight::download_model("stanreg_merMod_1")
- expect_equal(
- describe_prior(mod_stanreg1),
- structure(list(
- Parameter = "(Intercept)", Prior_Distribution = "normal",
- Prior_Location = 3.05733333333333, Prior_Scale = 1.08966571234175
- ), row.names = c(
- NA,
- -1L
- ), class = "data.frame")
- )
+ expect_equal(
+ describe_prior(mod_stanreg1),
+ structure(list(
+ Parameter = "(Intercept)", Prior_Distribution = "normal",
+ Prior_Location = 3.05733333333333, Prior_Scale = 1.08966571234175
+ ), row.names = c(
+ NA,
+ -1L
+ ), class = "data.frame")
+ )
- expect_equal(
- describe_prior(mod_stanreg2),
- structure(
- list(
- Parameter = c("(Intercept)", "cyl"),
- Prior_Distribution = c(
- "normal",
- "normal"
- ), Prior_Location = c(0, 0),
- Prior_Scale = c(2.5, 1.39983744766986)
- ),
- row.names = c(NA, -2L), class = "data.frame"
- )
+ expect_equal(
+ describe_prior(mod_stanreg2),
+ structure(
+ list(
+ Parameter = c("(Intercept)", "cyl"),
+ Prior_Distribution = c(
+ "normal",
+ "normal"
+ ), Prior_Location = c(0, 0),
+ Prior_Scale = c(2.5, 1.39983744766986)
+ ),
+ row.names = c(NA, -2L), class = "data.frame"
)
- })
-}
+ )
+})
diff --git a/tests/testthat/test-different_models.R b/tests/testthat/test-different_models.R
index a98ac71..3d99a5c 100644
--- a/tests/testthat/test-different_models.R
+++ b/tests/testthat/test-different_models.R
@@ -1,93 +1,85 @@
-osx <- tryCatch(
- {
- si <- Sys.info()
- if (!is.null(si["sysname"])) {
- si["sysname"] == "Darwin" || grepl("^darwin", R.version$os)
- } else {
- FALSE
- }
- },
- error = function(e) {
- FALSE
- }
-)
-
-
-if (!osx && requiet("rstanarm")) {
- test_that("insight::get_predicted", {
- x <- suppressWarnings(
- insight::get_predicted(
- rstanarm::stan_glm(hp ~ mpg, data = mtcars, iter = 500, refresh = 0)
- )
+test_that("insight::get_predicted", {
+ skip_on_os("mac")
+ skip_if_not_or_load_if_installed("rstanarm")
+
+ x <- suppressWarnings(
+ insight::get_predicted(
+ stan_glm(hp ~ mpg, data = mtcars, iter = 500, refresh = 0)
)
+ )
+
+ rez <- point_estimate(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
- rez <- point_estimate(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
+ rez <- hdi(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
- rez <- hdi(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
+ rez <- eti(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
- rez <- eti(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
+ rez <- ci(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
- rez <- ci(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 4))
+ rez <- map_estimate(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 2))
- rez <- map_estimate(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 2))
+ rez <- p_direction(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 2))
- rez <- p_direction(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 2))
+ # rez <- p_map(x)
+ # expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
+ #
+ # rez <- p_significance(x)
+ # expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
+ #
+ # rez <- rope(x)
+ # expect_equal(c(nrow(rez), ncol(rez)), c(2, 5))
- # rez <- p_map(x)
- # expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
- #
- # rez <- p_significance(x)
- # expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
- #
- # rez <- rope(x)
- # expect_equal(c(nrow(rez), ncol(rez)), c(2, 5))
+ rez <- describe_posterior(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(32, 5))
- rez <- describe_posterior(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(32, 5))
+ # rez <- estimate_density(x)
+ # expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3))
+})
- # rez <- estimate_density(x)
- # expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3))
- })
-}
+test_that("bayesQR", {
+ skip_on_os("mac")
+ skip_if_not_or_load_if_installed("bayesQR")
-if (!osx && requiet("bayesQR")) {
- test_that("bayesQR", {
- x <- bayesQR::bayesQR(Sepal.Length ~ Petal.Width, data = iris, quantile = 0.1, alasso = TRUE, ndraw = 500)
+ invisible(capture.output(
+ x <- bayesQR(Sepal.Length ~ Petal.Width,
+ data = iris, quantile = 0.1,
+ alasso = TRUE, ndraw = 500
+ )
+ ))
- rez <- p_direction(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
+ rez <- p_direction(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
- rez <- p_map(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
+ rez <- p_map(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
- rez <- p_significance(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
+ rez <- p_significance(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
- rez <- rope(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 5))
+ rez <- rope(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 5))
- rez <- hdi(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 4))
+ rez <- hdi(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 4))
- rez <- eti(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 4))
+ rez <- eti(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 4))
- rez <- map_estimate(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
+ rez <- map_estimate(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 2))
- rez <- point_estimate(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 4))
+ rez <- point_estimate(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 4))
- rez <- describe_posterior(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2, 10))
+ rez <- describe_posterior(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2, 10))
- rez <- estimate_density(x)
- expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3))
- })
-}
+ rez <- estimate_density(x)
+ expect_equal(c(nrow(rez), ncol(rez)), c(2048, 3))
+})
diff --git a/tests/testthat/test-distributions.R b/tests/testthat/test-distributions.R
index c9e1b11..5bb0829 100644
--- a/tests/testthat/test-distributions.R
+++ b/tests/testthat/test-distributions.R
@@ -1,28 +1,30 @@
test_that("distributions", {
- expect_equal(mean(distribution_normal(10)), 0, tolerance = 0.01)
- expect_equal(length(distribution_normal(10, random = TRUE)), 10, tolerance = 0.01)
+ tolerance <- 0.01
- expect_equal(mean(distribution_beta(10, 1, 1)), 0.5, tolerance = 0.01)
- expect_equal(length(distribution_normal(10, 1, 1, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_normal(10)), 0, tolerance = tolerance)
+ expect_equal(length(distribution_normal(10, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_binomial(10, 0, 0.5)), 0, tolerance = 0.01)
- expect_equal(length(distribution_binomial(10, 0, 0.5, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_beta(10, 1, 1)), 0.5, tolerance = tolerance)
+ expect_equal(length(distribution_normal(10, 1, 1, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_cauchy(10)), 0, tolerance = 0.01)
- expect_equal(length(distribution_cauchy(10, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_binomial(10, 0, 0.5)), 0, tolerance = tolerance)
+ expect_equal(length(distribution_binomial(10, 0, 0.5, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_chisquared(10, 1)), 0.893, tolerance = 0.01)
- expect_equal(length(distribution_chisquared(10, 1, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_cauchy(10)), 0, tolerance = tolerance)
+ expect_equal(length(distribution_cauchy(10, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_gamma(10, 1)), 0.9404, tolerance = 0.01)
- expect_equal(length(distribution_gamma(10, 1, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_chisquared(10, 1)), 0.893, tolerance = tolerance)
+ expect_equal(length(distribution_chisquared(10, 1, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_poisson(10)), 1, tolerance = 0.01)
- expect_equal(length(distribution_poisson(10, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_gamma(10, 1)), 0.9404, tolerance = tolerance)
+ expect_equal(length(distribution_gamma(10, 1, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_student(10, 1)), 0, tolerance = 0.01)
- expect_equal(length(distribution_student(10, 1, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_poisson(10)), 1, tolerance = tolerance)
+ expect_equal(length(distribution_poisson(10, random = TRUE)), 10, tolerance = tolerance)
- expect_equal(mean(distribution_uniform(10)), 0.5, tolerance = 0.01)
- expect_equal(length(distribution_uniform(10, random = TRUE)), 10, tolerance = 0.01)
+ expect_equal(mean(distribution_student(10, 1)), 0, tolerance = tolerance)
+ expect_equal(length(distribution_student(10, 1, random = TRUE)), 10, tolerance = tolerance)
+
+ expect_equal(mean(distribution_uniform(10)), 0.5, tolerance = tolerance)
+ expect_equal(length(distribution_uniform(10, random = TRUE)), 10, tolerance = tolerance)
})
diff --git a/tests/testthat/test-effective_sample.R b/tests/testthat/test-effective_sample.R
index f22183e..79562df 100644
--- a/tests/testthat/test-effective_sample.R
+++ b/tests/testthat/test-effective_sample.R
@@ -1,36 +1,39 @@
-if (requiet("rstanarm") && requiet("brms") && requiet("insight")) {
- test_that("effective_sample", {
- brms_1 <- insight::download_model("brms_1")
- res <- effective_sample(brms_1)
- expect_equal(
- res,
- data.frame(
- Parameter = c("b_Intercept", "b_wt", "b_cyl"),
- ESS = c(5242, 2071, 1951),
- stringsAsFactors = F
- )
+test_that("effective_sample", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("rstan")
+
+ brms_1 <- insight::download_model("brms_1")
+ res <- effective_sample(brms_1)
+ expect_equal(
+ res,
+ data.frame(
+ Parameter = c("b_Intercept", "b_wt", "b_cyl"),
+ ESS = c(5242, 2071, 1951),
+ stringsAsFactors = F
)
+ )
- brms_null_1 <- insight::download_model("brms_null_1")
- res <- effective_sample(brms_null_1)
- expect_equal(
- res,
- data.frame(
- Parameter = c("b_Intercept"),
- ESS = c(2888),
- stringsAsFactors = F
- )
+ brms_null_1 <- insight::download_model("brms_null_1")
+ res <- effective_sample(brms_null_1)
+ expect_equal(
+ res,
+ data.frame(
+ Parameter = c("b_Intercept"),
+ ESS = c(2888),
+ stringsAsFactors = F
)
+ )
- brms_null_2 <- insight::download_model("brms_null_2")
- res <- effective_sample(brms_null_2)
- expect_equal(
- res,
- data.frame(
- Parameter = c("b_Intercept"),
- ESS = c(1059),
- stringsAsFactors = F
- )
+ brms_null_2 <- insight::download_model("brms_null_2")
+ res <- effective_sample(brms_null_2)
+ expect_equal(
+ res,
+ data.frame(
+ Parameter = c("b_Intercept"),
+ ESS = c(1059),
+ stringsAsFactors = F
)
- })
-}
+ )
+})
diff --git a/tests/testthat/test-emmGrid.R b/tests/testthat/test-emmGrid.R
index 3469944..eb15242 100644
--- a/tests/testthat/test-emmGrid.R
+++ b/tests/testthat/test-emmGrid.R
@@ -1,237 +1,236 @@
-if (require("rstanarm") && require("testthat") && require("bayestestR") && require("emmeans")) {
- set.seed(300)
- model <- stan_glm(extra ~ group,
- data = sleep,
- refresh = 0,
- chains = 6, iter = 7000, warmup = 200
- )
+# TODO: decide how to rearrange the tests
- em_ <- emmeans(model, ~group)
- c_ <- pairs(em_)
- emc_ <- emmeans(model, pairwise ~ group)
- all_ <- rbind(em_, c_)
- all_summ <- summary(all_)
+skip_on_ci()
+skip_if_not_or_load_if_installed("rstanarm")
+skip_if_not_or_load_if_installed("emmeans")
- set.seed(4)
- model_p <- unupdate(model, verbose = FALSE)
- set.seed(300)
+set.seed(300)
+model <- stan_glm(extra ~ group,
+ data = sleep,
+ refresh = 0,
+ chains = 6, iter = 7000, warmup = 200
+)
- # estimate + hdi ----------------------------------------------------------
-
- test_that("emmGrid hdi", {
- xhdi <- hdi(all_, ci = 0.95)
- expect_equal(xhdi$CI_low, all_summ$lower.HPD, tolerance = 0.1)
- expect_equal(xhdi$CI_high, all_summ$upper.HPD, tolerance = 0.1)
-
- xhdi2 <- hdi(emc_, ci = 0.95)
- expect_equal(xhdi$CI_low, xhdi2$CI_low)
- })
-
- test_that("emmGrid point_estimate", {
- xpest <- point_estimate(all_, centrality = "all", dispersion = TRUE)
- expect_equal(xpest$Median, all_summ$emmean, tolerance = 0.1)
-
- xpest2 <- point_estimate(emc_, centrality = "all", dispersion = TRUE)
- expect_equal(xpest$Median, xpest2$Median)
- })
-
-
-
- # Basics ------------------------------------------------------------------
-
- test_that("emmGrid ci", {
- xci <- ci(all_, ci = 0.9)
- expect_equal(length(xci$CI_low), 3)
- expect_equal(length(xci$CI_high), 3)
- })
-
- # test_that("emmGrid eti", {
- # xeti <- eti(all_, ci = 0.9)
- # expect_equal(length(xeti$CI_low), 3)
- # expect_equal(length(xeti$CI_high), 3)
- # })
-
- test_that("emmGrid equivalence_test", {
- xeqtest <- equivalence_test(all_, ci = 0.9, range = c(-0.1, 0.1))
- expect_equal(length(xeqtest$ROPE_Percentage), 3)
- expect_equal(length(xeqtest$ROPE_Equivalence), 3)
- })
-
- test_that("emmGrid estimate_density", {
- xestden <- estimate_density(c_, method = "logspline", precision = 5)
- expect_equal(length(xestden$x), 5)
- })
-
- test_that("emmGrid map_estimate", {
- xmapest <- map_estimate(all_, method = "kernel")
- expect_equal(length(xmapest$MAP_Estimate), 3)
- })
-
-
- test_that("emmGrid p_direction", {
- xpd <- p_direction(all_, method = "direct")
- expect_equal(length(xpd$pd), 3)
- })
-
- test_that("emmGrid p_map", {
- xpmap <- p_map(all_, precision = 2^9)
- expect_equal(length(xpmap$p_MAP), 3)
- })
-
- test_that("emmGrid p_rope", {
- xprope <- p_rope(all_, range = c(-0.1, 0.1))
- expect_equal(length(xprope$p_ROPE), 3)
- })
-
- test_that("emmGrid p_significance", {
- xsig <- p_significance(all_, threshold = c(-0.1, 0.1))
- expect_equal(length(xsig$ps), 3)
- })
-
- test_that("emmGrid rope", {
- xrope <- rope(all_, range = "default", ci = .9)
- expect_equal(length(xrope$ROPE_Percentage), 3)
- })
-
-
- # describe_posterior ------------------------------------------------------
-
- test_that("emmGrid describe_posterior", {
- expect_equal(
- describe_posterior(all_)$median,
- describe_posterior(emc_)$median
- )
-
- skip_on_cran()
- expect_equal(
- describe_posterior(all_, bf_prior = model_p, test = "bf")$log_BF,
- describe_posterior(emc_, bf_prior = model_p, test = "bf")$log_BF
- )
- })
-
- # BFs ---------------------------------------------------------------------
-
- test_that("emmGrid bayesfactor_parameters", {
- skip_on_cran()
- set.seed(4)
- expect_equal(
- bayesfactor_parameters(all_, prior = model, verbose = FALSE),
- bayesfactor_parameters(all_, prior = model_p, verbose = FALSE),
- tolerance = 0.001
- )
-
- emc_p <- emmeans(model_p, pairwise ~ group)
- xbfp <- bayesfactor_parameters(all_, prior = model_p, verbose = FALSE)
- xbfp2 <- bayesfactor_parameters(emc_, prior = model_p, verbose = FALSE)
- xbfp3 <- bayesfactor_parameters(emc_, prior = emc_p, verbose = FALSE)
- expect_equal(xbfp$log_BF, xbfp2$log_BF)
- expect_equal(xbfp$log_BF, xbfp3$log_BF)
-
- w <- capture_warnings(bayesfactor_parameters(all_))
- expect_match(w, "Prior")
-
- # error - cannot deal with regrid / transform
- e <- capture_error(bayesfactor_parameters(regrid(all_), prior = model))
- expect_match(as.character(e), "Unable to reconstruct prior estimates")
- })
-
- test_that("emmGrid bayesfactor_restricted", {
- skip_on_cran()
- skip_on_ci()
- set.seed(4)
- hyps <- c("`1` < `2`", "`1` < 0")
- xrbf <- bayesfactor_restricted(em_, prior = model_p, hypothesis = hyps)
- expect_equal(length(xrbf$log_BF), 2)
- expect_equal(length(xrbf$p_prior), 2)
- expect_equal(length(xrbf$p_posterior), 2)
- expect_warning(bayesfactor_restricted(em_, hypothesis = hyps))
-
- xrbf2 <- bayesfactor_restricted(emc_, prior = model_p, hypothesis = hyps)
- expect_equal(xrbf, xrbf2)
- })
-
- test_that("emmGrid si", {
- skip_on_cran()
- set.seed(4)
-
- xrsi <- si(all_, prior = model_p, verbose = FALSE)
- expect_equal(length(xrsi$CI_low), 3)
- expect_equal(length(xrsi$CI_high), 3)
-
- xrsi2 <- si(emc_, prior = model_p, verbose = FALSE)
- expect_equal(xrsi$CI_low, xrsi2$CI_low)
- expect_equal(xrsi$CI_high, xrsi2$CI_high)
- })
-
-
- # For non linear models ---------------------------------------------------
+em_ <- emmeans(model, ~group)
+c_ <- pairs(em_)
+emc_ <- emmeans(model, pairwise ~ group)
+all_ <- rbind(em_, c_)
+all_summ <- summary(all_)
+set.seed(4)
+model_p <- unupdate(model, verbose = FALSE)
+set.seed(300)
- set.seed(333)
- df <- data.frame(
- G = rep(letters[1:3], each = 2),
- Y = rexp(6)
+# estimate + hdi ----------------------------------------------------------
+
+test_that("emmGrid hdi", {
+ xhdi <- hdi(all_, ci = 0.95)
+ expect_equal(xhdi$CI_low, all_summ$lower.HPD, tolerance = 0.1)
+ expect_equal(xhdi$CI_high, all_summ$upper.HPD, tolerance = 0.1)
+
+ xhdi2 <- hdi(emc_, ci = 0.95)
+ expect_equal(xhdi$CI_low, xhdi2$CI_low)
+})
+
+test_that("emmGrid point_estimate", {
+ xpest <- point_estimate(all_, centrality = "all", dispersion = TRUE)
+ expect_equal(xpest$Median, all_summ$emmean, tolerance = 0.1)
+
+ xpest2 <- point_estimate(emc_, centrality = "all", dispersion = TRUE)
+ expect_equal(xpest$Median, xpest2$Median)
+})
+
+
+
+# Basics ------------------------------------------------------------------
+
+test_that("emmGrid ci", {
+ xci <- ci(all_, ci = 0.9)
+ expect_equal(length(xci$CI_low), 3)
+ expect_equal(length(xci$CI_high), 3)
+})
+
+test_that("emmGrid eti", {
+ xeti <- eti(all_, ci = 0.9)
+ expect_equal(length(xeti$CI_low), 3)
+ expect_equal(length(xeti$CI_high), 3)
+})
+
+test_that("emmGrid equivalence_test", {
+ xeqtest <- equivalence_test(all_, ci = 0.9, range = c(-0.1, 0.1))
+ expect_equal(length(xeqtest$ROPE_Percentage), 3)
+ expect_equal(length(xeqtest$ROPE_Equivalence), 3)
+})
+
+test_that("emmGrid estimate_density", {
+ xestden <- estimate_density(c_, method = "logspline", precision = 5)
+ expect_equal(length(xestden$x), 5)
+})
+
+test_that("emmGrid map_estimate", {
+ xmapest <- map_estimate(all_, method = "kernel")
+ expect_equal(length(xmapest$MAP_Estimate), 3)
+})
+
+
+test_that("emmGrid p_direction", {
+ xpd <- p_direction(all_, method = "direct")
+ expect_equal(length(xpd$pd), 3)
+})
+
+test_that("emmGrid p_map", {
+ xpmap <- p_map(all_, precision = 2^9)
+ expect_equal(length(xpmap$p_MAP), 3)
+})
+
+test_that("emmGrid p_rope", {
+ xprope <- p_rope(all_, range = c(-0.1, 0.1))
+ expect_equal(length(xprope$p_ROPE), 3)
+})
+
+test_that("emmGrid p_significance", {
+ xsig <- p_significance(all_, threshold = c(-0.1, 0.1))
+ expect_equal(length(xsig$ps), 3)
+})
+
+test_that("emmGrid rope", {
+ xrope <- rope(all_, range = "default", ci = .9)
+ expect_equal(length(xrope$ROPE_Percentage), 3)
+})
+
+
+# describe_posterior ------------------------------------------------------
+
+test_that("emmGrid describe_posterior", {
+ expect_equal(
+ describe_posterior(all_)$median,
+ describe_posterior(emc_)$median
)
- fit_bayes <- stan_glm(Y ~ G,
- data = df,
- family = Gamma(link = "identity"),
- refresh = 0
+ skip_on_cran()
+ expect_equal(
+ describe_posterior(all_, bf_prior = model_p, test = "bf")$log_BF,
+ describe_posterior(emc_, bf_prior = model_p, test = "bf")$log_BF
)
+})
- fit_bayes_prior <- unupdate(fit_bayes, verbose = FALSE)
+# BFs ---------------------------------------------------------------------
- bayes_sum <- emmeans(fit_bayes, ~G)
- bayes_sum_prior <- emmeans(fit_bayes_prior, ~G)
+test_that("emmGrid bayesfactor_parameters", {
+ skip_on_cran()
+ set.seed(4)
+ expect_equal(
+ bayesfactor_parameters(all_, prior = model, verbose = FALSE),
+ bayesfactor_parameters(all_, prior = model_p, verbose = FALSE),
+ tolerance = 0.001
+ )
+
+ emc_p <- emmeans(model_p, pairwise ~ group)
+ xbfp <- bayesfactor_parameters(all_, prior = model_p, verbose = FALSE)
+ xbfp2 <- bayesfactor_parameters(emc_, prior = model_p, verbose = FALSE)
+ xbfp3 <- bayesfactor_parameters(emc_, prior = emc_p, verbose = FALSE)
+ expect_equal(xbfp$log_BF, xbfp2$log_BF, tolerance = 0.1)
+ expect_equal(xbfp$log_BF, xbfp3$log_BF, tolerance = 0.1)
+
+ expect_warning(
+ suppressMessages(
+ bayesfactor_parameters(all_)
+ ),
+ regexp = "Prior not specified"
+ )
+
+ # error - cannot deal with regrid / transform
+
+ e <- capture_error(suppressMessages(bayesfactor_parameters(regrid(all_), prior = model)))
+ expect_match(as.character(e), "Unable to reconstruct prior estimates")
+})
- # test_that("emmGrid bayesfactor_restricted2", {
- # skip_on_cran()
- # skip_on_ci()
- #
- # hyps <- c("a < b", "b < c")
- # xrbf1 <- bayesfactor_restricted(bayes_sum, fit_bayes, hypothesis = hyps, verbose = FALSE)
- # xrbf2 <- bayesfactor_restricted(bayes_sum, bayes_sum_prior, hypothesis = hyps, verbose = FALSE)
- #
- # expect_equal(xrbf1, xrbf2, tolerance = 0.1)
- # })
+test_that("emmGrid bayesfactor_restricted", {
+ skip_on_cran()
+
+ set.seed(4)
+ hyps <- c("`1` < `2`", "`1` < 0")
+
+ xrbf <- bayesfactor_restricted(em_, prior = model_p, hypothesis = hyps)
+ expect_equal(length(xrbf$log_BF), 2)
+ expect_equal(length(xrbf$p_prior), 2)
+ expect_equal(length(xrbf$p_posterior), 2)
+ expect_warning(bayesfactor_restricted(em_, hypothesis = hyps))
+
+ xrbf2 <- bayesfactor_restricted(emc_, prior = model_p, hypothesis = hyps)
+ expect_equal(xrbf, xrbf2, tolerance = 0.1)
+})
+
+test_that("emmGrid si", {
+ skip_on_cran()
+ set.seed(4)
+ xrsi <- si(all_, prior = model_p, verbose = FALSE)
+ expect_equal(length(xrsi$CI_low), 3)
+ expect_equal(length(xrsi$CI_high), 3)
- test_that("emmGrid bayesfactor_parameters", {
- set.seed(333)
+ xrsi2 <- si(emc_, prior = model_p, verbose = FALSE)
+ expect_equal(xrsi$CI_low, xrsi2$CI_low)
+ expect_equal(xrsi$CI_high, xrsi2$CI_high)
+})
- xsdbf1 <- bayesfactor_parameters(bayes_sum, prior = fit_bayes, verbose = FALSE)
- xsdbf2 <- bayesfactor_parameters(bayes_sum, prior = bayes_sum_prior, verbose = FALSE)
- expect_equal(xsdbf1$log_BF, xsdbf2$log_BF, tolerance = 0.01)
- })
+# For non linear models ---------------------------------------------------
- # link vs response
- test_that("emmGrid bayesfactor_parameters / describe w/ nonlinear models", {
- skip_on_cran()
- model <- stan_glm(vs ~ mpg,
- data = mtcars,
- family = "binomial",
- refresh = 0
- )
+set.seed(333)
+df <- data.frame(
+ G = rep(letters[1:3], each = 2),
+ Y = rexp(6)
+)
+
+fit_bayes <- stan_glm(Y ~ G,
+ data = df,
+ family = Gamma(link = "identity"),
+ refresh = 0
+)
+
+fit_bayes_prior <- unupdate(fit_bayes, verbose = FALSE)
+
+bayes_sum <- emmeans(fit_bayes, ~G)
+bayes_sum_prior <- emmeans(fit_bayes_prior, ~G)
+
+test_that("emmGrid bayesfactor_parameters", {
+ set.seed(333)
+ skip_on_cran()
+
+ xsdbf1 <- bayesfactor_parameters(bayes_sum, prior = fit_bayes, verbose = FALSE)
+ xsdbf2 <- bayesfactor_parameters(bayes_sum, prior = bayes_sum_prior, verbose = FALSE)
+
+ expect_equal(xsdbf1$log_BF, xsdbf2$log_BF, tolerance = 0.1)
+})
+
+# link vs response
+test_that("emmGrid bayesfactor_parameters / describe w/ nonlinear models", {
+ skip_on_cran()
+
+ model <- stan_glm(vs ~ mpg,
+ data = mtcars,
+ family = "binomial",
+ refresh = 0
+ )
- probs <- emmeans(model, "mpg", type = "resp")
- link <- emmeans(model, "mpg")
+ probs <- emmeans(model, "mpg", type = "resp")
+ link <- emmeans(model, "mpg")
- probs_summ <- summary(probs)
- link_summ <- summary(link)
+ probs_summ <- summary(probs)
+ link_summ <- summary(link)
- xhdi <- hdi(probs, ci = 0.95)
- xpest <- point_estimate(probs, centrality = "median", dispersion = TRUE)
- expect_equal(xhdi$CI_low, probs_summ$lower.HPD, tolerance = 0.1)
- expect_equal(xhdi$CI_high, probs_summ$upper.HPD, tolerance = 0.1)
- expect_equal(xpest$Median, probs_summ$prob, tolerance = 0.1)
+ xhdi <- hdi(probs, ci = 0.95)
+ xpest <- point_estimate(probs, centrality = "median", dispersion = TRUE)
+ expect_equal(xhdi$CI_low, probs_summ$lower.HPD, tolerance = 0.1)
+ expect_equal(xhdi$CI_high, probs_summ$upper.HPD, tolerance = 0.1)
+ expect_equal(xpest$Median, probs_summ$prob, tolerance = 0.1)
- xhdi <- hdi(link, ci = 0.95)
- xpest <- point_estimate(link, centrality = "median", dispersion = TRUE)
- expect_equal(xhdi$CI_low, link_summ$lower.HPD, tolerance = 0.1)
- expect_equal(xhdi$CI_high, link_summ$upper.HPD, tolerance = 0.1)
- expect_equal(xpest$Median, link_summ$emmean, tolerance = 0.1)
- })
-}
+ xhdi <- hdi(link, ci = 0.95)
+ xpest <- point_estimate(link, centrality = "median", dispersion = TRUE)
+ expect_equal(xhdi$CI_low, link_summ$lower.HPD, tolerance = 0.1)
+ expect_equal(xhdi$CI_high, link_summ$upper.HPD, tolerance = 0.1)
+ expect_equal(xpest$Median, link_summ$emmean, tolerance = 0.1)
+})
diff --git a/tests/testthat/test-estimate_density.R b/tests/testthat/test-estimate_density.R
index aae3f6d..a134f96 100644
--- a/tests/testthat/test-estimate_density.R
+++ b/tests/testthat/test-estimate_density.R
@@ -1,34 +1,36 @@
-if (require("logspline") && require("KernSmooth") && require("mclust")) {
- test_that("estimate_density", {
- set.seed(333)
- x <- distribution_normal(500, 1)
+test_that("estimate_density", {
+ skip_if_not_or_load_if_installed("logspline")
+ skip_if_not_or_load_if_installed("KernSmooth")
+ skip_if_not_or_load_if_installed("mclust")
- # Methods
- density_kernel <- estimate_density(x, method = "kernel")
- density_logspline <- estimate_density(x, method = "logspline")
- density_KernSmooth <- estimate_density(x, method = "KernSmooth")
- density_mixture <- estimate_density(x, method = "mixture")
+ set.seed(333)
+ x <- distribution_normal(500, 1)
- expect_equal(mean(density_kernel$y - density_logspline$y), 0, tolerance = 0.1)
- expect_equal(mean(density_kernel$y - density_KernSmooth$y), 0, tolerance = 0.1)
- expect_equal(mean(density_kernel$y - density_mixture$y), 0, tolerance = 0.1)
+ # Methods
+ density_kernel <- estimate_density(x, method = "kernel")
+ density_logspline <- estimate_density(x, method = "logspline")
+ density_KernSmooth <- estimate_density(x, method = "KernSmooth")
+ density_mixture <- estimate_density(x, method = "mixture")
- x <- iris
- x$Fac <- rep(c("A", "B"), length.out = 150)
+ expect_equal(mean(density_kernel$y - density_logspline$y), 0, tolerance = 0.1)
+ expect_equal(mean(density_kernel$y - density_KernSmooth$y), 0, tolerance = 0.1)
+ expect_equal(mean(density_kernel$y - density_mixture$y), 0, tolerance = 0.1)
- rez <- estimate_density(x, select = "Sepal.Length")
- expect_equal(dim(rez), c(1024, 3))
+ x <- iris
+ x$Fac <- rep(c("A", "B"), length.out = 150)
- rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length"))
- expect_equal(dim(rez), c(2048, 3))
+ rez <- estimate_density(x, select = "Sepal.Length")
+ expect_equal(dim(rez), c(1024, 3))
- rez <- estimate_density(x, select = "Sepal.Length", at = "Species")
- expect_equal(dim(rez), c(1024 * 3, 4))
+ rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length"))
+ expect_equal(dim(rez), c(2048, 3))
- rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length"), at = "Species")
- expect_equal(dim(rez), c(2048 * 3, 4))
+ rez <- estimate_density(x, select = "Sepal.Length", at = "Species")
+ expect_equal(dim(rez), c(1024 * 3, 4))
- rez <- estimate_density(x, select = "Sepal.Length", at = c("Species", "Fac"), method = "KernSmooth")
- expect_equal(dim(rez), c(1024 * 3 * 2, 5))
- })
-}
+ rez <- estimate_density(x, select = c("Sepal.Length", "Petal.Length"), at = "Species")
+ expect_equal(dim(rez), c(2048 * 3, 4))
+
+ rez <- estimate_density(x, select = "Sepal.Length", at = c("Species", "Fac"), method = "KernSmooth")
+ expect_equal(dim(rez), c(1024 * 3 * 2, 5))
+})
diff --git a/tests/testthat/test-hdi.R b/tests/testthat/test-hdi.R
index 9de51d6..0a0740a 100644
--- a/tests/testthat/test-hdi.R
+++ b/tests/testthat/test-hdi.R
@@ -1,60 +1,76 @@
-if (requiet("rstanarm") && requiet("brms") && requiet("httr") && requiet("testthat") && requiet("BayesFactor")) {
- # numeric -------------------------------
- test_that("hdi", {
- expect_equal(hdi(distribution_normal(1000), ci = .90)$CI_low[1], -1.64, tolerance = 0.02)
- expect_equal(nrow(hdi(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01)
- expect_equal(hdi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
- expect_equal(nchar(capture.output(print(hdi(distribution_normal(1000))))), 22)
- expect_equal(length(capture.output(print(hdi(distribution_normal(1000), ci = c(.80, .90))))), 5)
-
-
- expect_warning(hdi(c(2, 3, NA)))
- expect_warning(hdi(c(2, 3)))
- expect_warning(hdi(distribution_normal(1000), ci = 0.0000001))
- expect_warning(hdi(distribution_normal(1000), ci = 950))
- expect_warning(hdi(c(0, 0, 0)))
- })
-
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- if (requiet("insight")) {
- # stanreg ---------------------------
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("ci", {
- expect_equal(
- hdi(m, ci = c(.5, .8), effects = "all")$CI_low,
- hdi(p, ci = c(.5, .8))$CI_low,
- tolerance = 1e-3
- )
- })
-
- # brms ---------------------------
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("rope", {
- expect_equal(
- hdi(m, ci = c(.5, .8), effects = "all", component = "all")$CI_low,
- hdi(p, ci = c(.5, .8))$CI_low,
- tolerance = 1e-3
- )
- })
-
- # BayesFactor ---------------------------
- mod_bf <- proportionBF(y = 15, N = 25, p = .5)
- p_bf <- insight::get_parameters(mod_bf)
-
- test_that("ci - BayesFactor", {
- expect_equal(
- hdi(mod_bf, ci = c(.5, .8), effects = "all", component = "all")$CI_low,
- hdi(p_bf, ci = c(.5, .8))$CI_low,
- tolerance = 0.1
- )
- })
- }
- }
-}
+# numeric -------------------------------
+test_that("hdi", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ expect_equal(hdi(distribution_normal(1000), ci = .90)$CI_low[1], -1.64, tolerance = 0.02)
+ expect_equal(nrow(hdi(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01)
+ expect_equal(hdi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
+ expect_equal(nchar(capture.output(print(hdi(distribution_normal(1000))))), 22)
+ expect_equal(length(capture.output(print(hdi(distribution_normal(1000), ci = c(.80, .90))))), 5)
+
+
+ expect_warning(hdi(c(2, 3, NA)))
+ expect_warning(hdi(c(2, 3)))
+ expect_warning(hdi(distribution_normal(1000), ci = 0.0000001))
+ expect_warning(hdi(distribution_normal(1000), ci = 950))
+ expect_warning(hdi(c(0, 0, 0)))
+})
+
+
+# stanreg ---------------------------
+test_that("ci", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+
+ expect_equal(
+ hdi(m, ci = c(0.5, 0.8), effects = "all")$CI_low,
+ hdi(p, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 1e-3
+ )
+})
+
+# brms ---------------------------
+test_that("rope", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+
+ expect_equal(
+ hdi(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low,
+ hdi(p, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 1e-3
+ )
+})
+
+# BayesFactor ---------------------------
+test_that("ci - BayesFactor", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ mod_bf <- proportionBF(y = 15, N = 25, p = .5)
+ p_bf <- insight::get_parameters(mod_bf)
+
+ expect_equal(
+ hdi(mod_bf, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low,
+ hdi(p_bf, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 0.1
+ )
+})
diff --git a/tests/testthat/test-map_estimate.R b/tests/testthat/test-map_estimate.R
index 89d0b3c..fe43ff5 100644
--- a/tests/testthat/test-map_estimate.R
+++ b/tests/testthat/test-map_estimate.R
@@ -1,45 +1,45 @@
-if (require("testthat") && requireNamespace("rstanarm", quietly = TRUE)) {
- # numeric ----------------------
- test_that("map_estimate", {
- expect_equal(
- as.numeric(map_estimate(distribution_normal(1000))),
- 0,
- tolerance = 0.01
+# numeric ----------------------
+test_that("map_estimate", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+
+ expect_equal(
+ as.numeric(map_estimate(distribution_normal(1000))),
+ 0,
+ tolerance = 0.01
+ )
+})
+
+# stanreg ----------------------
+test_that("map_estimate", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ expect_equal(
+ map_estimate(m, effects = "all")$Parameter,
+ colnames(as.data.frame(m))[1:21]
+ )
+})
+
+# brms ----------------------
+test_that("map_estimate", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("brms_zi_3")
+ expect_equal(
+ map_estimate(m, effects = "all", component = "all")$Parameter,
+ c(
+ "b_Intercept", "b_child", "b_camper", "r_persons[1,Intercept]",
+ "r_persons[2,Intercept]", "r_persons[3,Intercept]", "r_persons[4,Intercept]",
+ "sd_persons__Intercept", "b_zi_Intercept", "b_zi_child", "b_zi_camper",
+ "r_persons__zi[1,Intercept]", "r_persons__zi[2,Intercept]", "r_persons__zi[3,Intercept]",
+ "r_persons__zi[4,Intercept]", "sd_persons__zi_Intercept"
)
- })
-
-
-
-
- if (require("insight") && require("BayesFactor")) {
- # stanreg ----------------------
- m <- insight::download_model("stanreg_merMod_5")
-
- test_that("map_estimate", {
- expect_equal(
- map_estimate(m, effects = "all")$Parameter,
- colnames(as.data.frame(m))[1:21]
- )
- })
-
- # brms ----------------------
- m <- insight::download_model("brms_zi_3")
-
- test_that("map_estimate", {
- expect_equal(
- map_estimate(m, effects = "all", component = "all")$Parameter,
- c(
- "b_Intercept", "b_child", "b_camper", "r_persons[1,Intercept]",
- "r_persons[2,Intercept]", "r_persons[3,Intercept]", "r_persons[4,Intercept]",
- "sd_persons__Intercept", "b_zi_Intercept", "b_zi_child", "b_zi_camper",
- "r_persons__zi[1,Intercept]", "r_persons__zi[2,Intercept]", "r_persons__zi[3,Intercept]",
- "r_persons__zi[4,Intercept]", "sd_persons__zi_Intercept"
- )
- )
- })
-
- # BayesFactor -------------
- m <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
- expect_error(map_estimate(m))
- }
-}
+ )
+ m <- correlationBF(y = iris$Sepal.Length, x = iris$Sepal.Width)
+ expect_error(map_estimate(m))
+})
diff --git a/tests/testthat/test-p_direction.R b/tests/testthat/test-p_direction.R
index efd2682..c504019 100644
--- a/tests/testthat/test-p_direction.R
+++ b/tests/testthat/test-p_direction.R
@@ -1,40 +1,44 @@
-if (requiet("testthat") && requiet("bayestestR") && requiet("rstanarm") && requiet("brms")) {
- test_that("p_direction", {
- set.seed(333)
- x <- bayestestR::distribution_normal(10000, 1, 1)
- pd <- bayestestR::p_direction(x)
- expect_equal(as.numeric(pd), 0.842, tolerance = 0.1)
- expect_equal(as.numeric(p_direction(x, method = "kernel")), 0.842, tolerance = 0.1)
- expect_equal(nrow(p_direction(data.frame(replicate(4, rnorm(100))))), 4)
- expect_s3_class(pd, "p_direction")
- expect_equal(tail(capture.output(print(pd)), 1), "Probability of Direction: 0.84")
- })
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- if (require("insight")) {
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("p_direction", {
- expect_equal(
- p_direction(m, effects = "all")$pd,
- p_direction(p)$pd,
- tolerance = 1e-3
- )
- })
-
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("p_direction", {
- expect_equal(
- p_direction(m, effects = "all", component = "all")$pd,
- p_direction(p)$pd,
- tolerance = 1e-3
- )
- })
- }
- }
-}
+test_that("p_direction", {
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+
+ set.seed(333)
+ x <- distribution_normal(10000, 1, 1)
+ pd <- p_direction(x)
+ expect_equal(as.numeric(pd), 0.842, tolerance = 0.1)
+ expect_equal(as.numeric(p_direction(x, method = "kernel")), 0.842, tolerance = 0.1)
+ expect_equal(nrow(p_direction(data.frame(replicate(4, rnorm(100))))), 4)
+ expect_s3_class(pd, "p_direction")
+ expect_equal(tail(capture.output(print(pd)), 1), "Probability of Direction: 0.84")
+})
+
+
+test_that("p_direction", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+
+ expect_equal(
+ p_direction(m, effects = "all")$pd,
+ p_direction(p)$pd,
+ tolerance = 1e-3
+ )
+})
+
+test_that("p_direction", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+
+ expect_equal(
+ p_direction(m, effects = "all", component = "all")$pd,
+ p_direction(p)$pd,
+ tolerance = 1e-3
+ )
+})
diff --git a/tests/testthat/test-p_map.R b/tests/testthat/test-p_map.R
index 6374085..e559ceb 100644
--- a/tests/testthat/test-p_map.R
+++ b/tests/testthat/test-p_map.R
@@ -1,36 +1,47 @@
-if (requireNamespace("rstanarm", quietly = TRUE)) {
- test_that("p_map", {
- expect_equal(as.numeric(p_map(distribution_normal(1000))), 1, tolerance = 0.1)
- expect_equal(as.numeric(p_map(distribution_normal(1000, 1, 1))), 0.62, tolerance = 0.1)
- expect_equal(as.numeric(p_map(distribution_normal(1000, 2, 1))), 0.15, tolerance = 0.1)
- expect_equal(as.numeric(p_map(distribution_normal(1000, 3, 0.01))), 0, tolerance = 0.1)
- })
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- if (require("insight")) {
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("p_map", {
- expect_equal(
- p_map(m, effects = "all")$p_MAP,
- p_map(p)$p_MAP,
- tolerance = 0.1
- )
- })
-
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("p_map", {
- expect_equal(
- p_map(m, effects = "all", component = "all")$p_MAP,
- p_map(p)$p_MAP,
- tolerance = 0.1
- )
- })
- }
- }
-}
+test_that("p_map", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+
+ expect_equal(as.numeric(p_map(distribution_normal(1000))), 1, tolerance = 0.1)
+ expect_equal(as.numeric(p_map(distribution_normal(1000, 1, 1))), 0.62, tolerance = 0.1)
+ expect_equal(as.numeric(p_map(distribution_normal(1000, 2, 1))), 0.15, tolerance = 0.1)
+ expect_equal(as.numeric(p_map(distribution_normal(1000, 3, 0.01))), 0, tolerance = 0.1)
+})
+
+
+test_that("p_map", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+
+ expect_equal(
+ p_map(m, effects = "all")$p_MAP,
+ p_map(p)$p_MAP,
+ tolerance = 0.1
+ )
+})
+
+
+test_that("p_map", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+
+ expect_equal(
+ p_map(m, effects = "all", component = "all")$p_MAP,
+ p_map(p)$p_MAP,
+ tolerance = 0.1
+ )
+})
+
+
+
+test_that("p_map | null", {
+ x <- distribution_normal(4000, mean = 1)
+ expect_equal(p_map(x), 0.6194317, ignore_attr = TRUE, tolerance = 0.01)
+ expect_equal(p_map(x, null = 1), 1, ignore_attr = TRUE, tolerance = 0.01)
+})
diff --git a/tests/testthat/test-p_significance.R b/tests/testthat/test-p_significance.R
index bcce523..38e1a39 100644
--- a/tests/testthat/test-p_significance.R
+++ b/tests/testthat/test-p_significance.R
@@ -1,36 +1,39 @@
-if (suppressPackageStartupMessages(require("bayestestR", quietly = TRUE)) && require("rstanarm", quietly = TRUE) && require("testthat", quietly = TRUE)) {
- test_that("p_significance", {
- # numeric
- set.seed(333)
- x <- bayestestR::distribution_normal(10000, 1, 1)
- ps <- bayestestR::p_significance(x)
- expect_equal(as.numeric(ps), 0.816, tolerance = 0.1)
- expect_equal(nrow(p_significance(data.frame(replicate(4, rnorm(100))))), 4)
- expect_s3_class(ps, "p_significance")
- expect_equal(tail(capture.output(print(ps)), 1), "Practical Significance (threshold: 0.10): 0.82")
- })
+test_that("p_significance", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ # numeric
+ set.seed(333)
+ x <- distribution_normal(10000, 1, 1)
+ ps <- p_significance(x)
+ expect_equal(as.numeric(ps), 0.816, tolerance = 0.1)
+ expect_equal(nrow(p_significance(data.frame(replicate(4, rnorm(100))))), 4)
+ expect_s3_class(ps, "p_significance")
+ expect_equal(tail(capture.output(print(ps)), 1), "Practical Significance (threshold: 0.10): 0.82")
+})
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- if (require("insight")) {
- # stanreg
- m <- insight::download_model("stanreg_merMod_5")
+test_that("stanreg", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
- expect_equal(
- p_significance(m, effects = "all")$ps[1],
- 0.99,
- tolerance = 1e-2
- )
+ m <- insight::download_model("stanreg_merMod_5")
- # brms
- m2 <- insight::download_model("brms_1")
+ expect_equal(
+ p_significance(m, effects = "all")$ps[1],
+ 0.99,
+ tolerance = 1e-2
+ )
+})
- expect_equal(
- p_significance(m2, effects = "all")$ps,
- c(1.0000, 0.9985, 0.9785),
- tolerance = 0.01
- )
- }
- }
-}
+test_that("brms", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+
+ m2 <- insight::download_model("brms_1")
+
+ expect_equal(
+ p_significance(m2, effects = "all")$ps,
+ c(1.0000, 0.9985, 0.9785),
+ tolerance = 0.01
+ )
+})
diff --git a/tests/testthat/test-p_to_bf.R b/tests/testthat/test-p_to_bf.R
index d0b8d67..b73c88e 100644
--- a/tests/testthat/test-p_to_bf.R
+++ b/tests/testthat/test-p_to_bf.R
@@ -1,12 +1,12 @@
-if (requiet("testthat") && requiet("parameters") && requiet("bayestestR")) {
+test_that("p_to_bf works", {
+ skip_if_not_or_load_if_installed("parameters")
+
m <- lm(mpg ~ hp + cyl + am, data = mtcars)
p <- coef(summary(m))[-1, 4]
# BF by hand
bfs <- 3 * p * sqrt(insight::n_obs(m))
- test_that("p_to_bf works", {
- expect_equal(p_to_bf(m, log = FALSE)[-1, ]$BF, exp(-log(bfs)), tolerance = 1e-4, ignore_attr = TRUE)
- expect_equal(p_to_bf(m, log = TRUE)[-1, ]$log_BF, -log(bfs), tolerance = 1e-4, ignore_attr = TRUE)
- })
-}
+ expect_equal(p_to_bf(m, log = FALSE)[-1, ]$BF, exp(-log(bfs)), tolerance = 1e-4, ignore_attr = TRUE)
+ expect_equal(p_to_bf(m, log = TRUE)[-1, ]$log_BF, -log(bfs), tolerance = 1e-4, ignore_attr = TRUE)
+})
diff --git a/tests/testthat/test-point_estimate.R b/tests/testthat/test-point_estimate.R
index fe42666..d89b475 100644
--- a/tests/testthat/test-point_estimate.R
+++ b/tests/testthat/test-point_estimate.R
@@ -1,23 +1,31 @@
-if (requiet("rstanarm") && requiet("brms") && requiet("insight") && requiet("httr")) {
+test_that("point_estimate: stanreg", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+
m <- insight::download_model("stanreg_merMod_5")
p <- insight::get_parameters(m, effects = "all")
- test_that("point_estimate", {
- expect_equal(
- point_estimate(m, effects = "all")$Median,
- point_estimate(p)$Median,
- tolerance = 1e-3
- )
- })
+ expect_equal(
+ point_estimate(m, effects = "all")$Median,
+ point_estimate(p)$Median,
+ tolerance = 1e-3
+ )
+})
+
+test_that("point_estimate: brms", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
m <- insight::download_model("brms_zi_3")
p <- insight::get_parameters(m, effects = "all", component = "all")
- test_that("point_estimate", {
- expect_equal(
- point_estimate(m, effects = "all", component = "all")$Median,
- point_estimate(p)$Median,
- tolerance = 1e-3
- )
- })
-}
+ expect_equal(
+ point_estimate(m, effects = "all", component = "all")$Median,
+ point_estimate(p)$Median,
+ tolerance = 1e-3
+ )
+})
diff --git a/tests/testthat/test-posterior.R b/tests/testthat/test-posterior.R
index 975bfaf..5c0d683 100644
--- a/tests/testthat/test-posterior.R
+++ b/tests/testthat/test-posterior.R
@@ -1,98 +1,122 @@
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
+test_that("mp-posterior-draws", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("posterior")
+ skip_if_not_or_load_if_installed("brms")
-if (.runThisTest && require("posterior") && require("brms")) {
model <- insight::download_model("brms_1")
-
- test_that("mp-posterior-draws", {
- x <- posterior::as_draws(model)
- mp <- describe_posterior(x)
- expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
- expect_equal(
- colnames(mp),
- c(
- "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage"
- )
+ x <- posterior::as_draws(model)
+ mp <- describe_posterior(x)
+ expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
+ expect_identical(
+ colnames(mp),
+ c(
+ "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage"
)
- })
+ )
+})
+
+test_that("mp-posterior-draws_list", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("posterior")
+ skip_if_not_or_load_if_installed("brms")
- test_that("mp-posterior-draws_list", {
- x <- posterior::as_draws_list(model)
- mp <- describe_posterior(x)
- expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
- expect_equal(
- colnames(mp),
- c(
- "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage"
- )
+ model <- insight::download_model("brms_1")
+ x <- posterior::as_draws_list(model)
+ mp <- describe_posterior(x)
+ expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
+ expect_identical(
+ colnames(mp),
+ c(
+ "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage"
)
- })
+ )
+})
- test_that("mp-posterior-draws_df", {
- x <- posterior::as_draws_df(model)
- mp <- describe_posterior(x)
- expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
- expect_equal(
- colnames(mp),
- c(
- "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage"
- )
+test_that("mp-posterior-draws_df", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("posterior")
+ skip_if_not_or_load_if_installed("brms")
+
+ model <- insight::download_model("brms_1")
+ x <- posterior::as_draws_df(model)
+ mp <- describe_posterior(x)
+ expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
+ expect_identical(
+ colnames(mp),
+ c(
+ "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage"
)
- })
+ )
+})
+
+test_that("mp-posterior-draws_matrix", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("posterior")
+ skip_if_not_or_load_if_installed("brms")
- test_that("mp-posterior-draws_matrix", {
- x <- posterior::as_draws_matrix(model)
- mp <- describe_posterior(x)
- expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
- expect_equal(
- colnames(mp),
- c(
- "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage"
- )
+ model <- insight::download_model("brms_1")
+ x <- posterior::as_draws_matrix(model)
+ mp <- describe_posterior(x)
+ expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
+ expect_identical(
+ colnames(mp),
+ c(
+ "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage"
)
- })
+ )
+})
+
+test_that("mp-posterior-draws_array", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("posterior")
+ skip_if_not_or_load_if_installed("brms")
- test_that("mp-posterior-draws_array", {
- x <- posterior::as_draws_array(model)
- mp <- describe_posterior(x)
- expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
- expect_equal(
- colnames(mp),
- c(
- "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage"
- )
+ model <- insight::download_model("brms_1")
+ x <- posterior::as_draws_array(model)
+ mp <- describe_posterior(x)
+ expect_equal(mp$Median, c(39.68234, -3.19505, -1.4936, 2.62881, -79.73344), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_equal(mp$pd, c(1, 0.9995, 0.9995, 1, 1), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_identical(mp$Parameter, c("b_Intercept", "b_wt", "b_cyl", "sigma", "lp__"))
+ expect_identical(
+ colnames(mp),
+ c(
+ "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage"
)
- })
+ )
+})
- test_that("mp-posterior-draws_rvar", {
- # Create random vectors by adding an additional dimension:
- n <- 4 # length of output vector
- set.seed(123)
- x <- rvar(array(rnorm(4000 * n, mean = rep(1:n, each = 4000), sd = 1), dim = c(4000, n)))
- mp <- describe_posterior(x)
- expect_equal(mp$Median, c(0.99503, 1.99242, 2.9899, 3.99362), tolerance = 1e-2, ignore_attr = TRUE)
- expect_equal(mp$Parameter, c("x[1]", "x[2]", "x[3]", "x[4]"))
- expect_equal(
- colnames(mp),
- c(
- "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage"
- )
+test_that("mp-posterior-draws_rvar", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("posterior")
+ skip_if_not_or_load_if_installed("brms")
+
+ model <- insight::download_model("brms_1")
+ # Create random vectors by adding an additional dimension:
+ n <- 4 # length of output vector
+ set.seed(123)
+ x <- rvar(array(rnorm(4000 * n, mean = rep(1:n, each = 4000), sd = 1), dim = c(4000, n)))
+ mp <- describe_posterior(x)
+ expect_equal(mp$Median, c(0.99503, 1.99242, 2.9899, 3.99362), tolerance = 1e-2, ignore_attr = TRUE)
+ expect_identical(mp$Parameter, c("x[1]", "x[2]", "x[3]", "x[4]"))
+ expect_identical(
+ colnames(mp),
+ c(
+ "Parameter", "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage"
)
- })
-}
+ )
+})
diff --git a/tests/testthat/test-rope.R b/tests/testthat/test-rope.R
index 0b13b73..42d8d4c 100644
--- a/tests/testthat/test-rope.R
+++ b/tests/testthat/test-rope.R
@@ -1,72 +1,77 @@
-if (requiet("bayestestR") && requiet("testthat") && requiet("rstanarm") && requiet("brms")) {
- test_that("rope", {
- expect_equal(as.numeric(rope(distribution_normal(1000, 0, 1), verbose = FALSE)), 0.084, tolerance = 0.01)
- expect_equal(equivalence_test(distribution_normal(1000, 0, 1))$ROPE_Equivalence, "Undecided")
- expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000))))), 9)
- expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000),
- ci = c(0.8, 0.9)
- )))), 14)
-
- expect_equal(as.numeric(rope(distribution_normal(1000, 2, 0.01), verbose = FALSE)), 0, tolerance = 0.01)
- expect_equal(equivalence_test(distribution_normal(1000, 2, 0.01))$ROPE_Equivalence, "Rejected")
-
- expect_equal(as.numeric(rope(distribution_normal(1000, 0, 0.001), verbose = FALSE)), 1, tolerance = 0.01)
- expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001))$ROPE_Equivalence, "Accepted")
-
- expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001), ci = 1)$ROPE_Equivalence, "Accepted")
-
- # print(rope(rnorm(1000, mean = 0, sd = 3), ci = .5))
- expect_equal(rope(rnorm(1000, mean = 0, sd = 3), ci = c(.1, .5, .9), verbose = FALSE)$CI, c(.1, .5, .9))
-
- x <- equivalence_test(distribution_normal(1000, 1, 1), ci = c(.50, .99))
- expect_equal(x$ROPE_Percentage[2], 0.0484, tolerance = 0.01)
- expect_equal(x$ROPE_Equivalence[2], "Undecided")
-
- expect_error(rope(distribution_normal(1000, 0, 1), range = c(0.0, 0.1, 0.2)))
-
- set.seed(333)
- expect_s3_class(rope(distribution_normal(1000, 0, 1), verbose = FALSE), "rope")
- expect_error(rope(distribution_normal(1000, 0, 1), range = c("A", 0.1)))
- expect_equal(
- as.numeric(rope(distribution_normal(1000, 0, 1),
- range = c(-0.1, 0.1)
- )), 0.084,
- tolerance = 0.01
- )
- })
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- if (requiet("insight")) {
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("rope", {
- expect_equal(
- # fix range to -.1/.1, to compare to data frame method
- rope(m, range = c(-.1, .1), effects = "all", verbose = FALSE)$ROPE_Percentage,
- rope(p, verbose = FALSE)$ROPE_Percentage,
- tolerance = 1e-3
- )
- })
-
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("rope", {
- expect_equal(
- rope(m, effects = "all", component = "all", verbose = FALSE)$ROPE_Percentage,
- rope(p, verbose = FALSE)$ROPE_Percentage,
- tolerance = 1e-3
- )
- })
- }
- }
-}
-
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
-# if (.runThisTest && require("brms", quietly = TRUE)) {
+test_that("rope", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+
+ expect_equal(as.numeric(rope(distribution_normal(1000, 0, 1), verbose = FALSE)), 0.084, tolerance = 0.01)
+ expect_equal(equivalence_test(distribution_normal(1000, 0, 1))$ROPE_Equivalence, "Undecided")
+ expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000))))), 9)
+ expect_equal(length(capture.output(print(equivalence_test(distribution_normal(1000),
+ ci = c(0.8, 0.9)
+ )))), 14)
+
+ expect_equal(as.numeric(rope(distribution_normal(1000, 2, 0.01), verbose = FALSE)), 0, tolerance = 0.01)
+ expect_equal(equivalence_test(distribution_normal(1000, 2, 0.01))$ROPE_Equivalence, "Rejected")
+
+ expect_equal(as.numeric(rope(distribution_normal(1000, 0, 0.001), verbose = FALSE)), 1, tolerance = 0.01)
+ expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001))$ROPE_Equivalence, "Accepted")
+
+ expect_equal(equivalence_test(distribution_normal(1000, 0, 0.001), ci = 1)$ROPE_Equivalence, "Accepted")
+
+ # print(rope(rnorm(1000, mean = 0, sd = 3), ci = .5))
+ expect_equal(rope(rnorm(1000, mean = 0, sd = 3), ci = c(.1, .5, .9), verbose = FALSE)$CI, c(.1, .5, .9))
+
+ x <- equivalence_test(distribution_normal(1000, 1, 1), ci = c(.50, .99))
+ expect_equal(x$ROPE_Percentage[2], 0.0484, tolerance = 0.01)
+ expect_equal(x$ROPE_Equivalence[2], "Undecided")
+
+ expect_error(rope(distribution_normal(1000, 0, 1), range = c(0.0, 0.1, 0.2)))
+
+ set.seed(333)
+ expect_s3_class(rope(distribution_normal(1000, 0, 1), verbose = FALSE), "rope")
+ expect_error(rope(distribution_normal(1000, 0, 1), range = c("A", 0.1)))
+ expect_equal(
+ as.numeric(rope(distribution_normal(1000, 0, 1),
+ range = c(-0.1, 0.1)
+ )), 0.084,
+ tolerance = 0.01
+ )
+})
+
+
+test_that("rope", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+ expect_equal(
+ # fix range to -.1/.1, to compare to data frame method
+ rope(m, range = c(-.1, .1), effects = "all", verbose = FALSE)$ROPE_Percentage,
+ rope(p, verbose = FALSE)$ROPE_Percentage,
+ tolerance = 1e-3
+ )
+})
+
+
+
+test_that("rope", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+ expect_equal(
+ rope(m, effects = "all", component = "all", verbose = FALSE)$ROPE_Percentage,
+ rope(p, verbose = FALSE)$ROPE_Percentage,
+ tolerance = 1e-3
+ )
+})
+
+
+# if ( skip_if_not_or_load_if_installed("brms")) {
# set.seed(123)
# model <- brm(mpg ~ wt + gear, data = mtcars, iter = 500)
# rope <- rope(model, verbose = FALSE)
@@ -92,9 +97,11 @@ if (requiet("bayestestR") && requiet("testthat") && requiet("rstanarm") && requi
# })
# }
-if (require("BayesFactor", quietly = TRUE)) {
+test_that("BayesFactor", {
+ skip_if_not_or_load_if_installed("BayesFactor")
+
mods <- regressionBF(mpg ~ am + cyl, mtcars, progress = FALSE)
rx <- suppressMessages(rope(mods, verbose = FALSE))
expect_equal(rx$ROPE_high, -rx$ROPE_low, tolerance = 0.01)
expect_equal(rx$ROPE_high[1], 0.6026948, tolerance = 0.01)
-}
+})
diff --git a/tests/testthat/test-rope_range.R b/tests/testthat/test-rope_range.R
index 625e974..91bfd0f 100644
--- a/tests/testthat/test-rope_range.R
+++ b/tests/testthat/test-rope_range.R
@@ -6,12 +6,12 @@ test_that("rope_range cor", {
test_that("rope_range gaussian", {
data(mtcars)
mod <- lm(mpg ~ gear + hp, data = mtcars)
- expect_equal(rope_range(mod), c(-.1 * sd(mtcars$mpg), .1 * sd(mtcars$mpg)), tolerance = 1e-3)
+ expect_equal(rope_range(mod), c(-0.1 * sd(mtcars$mpg), 0.1 * sd(mtcars$mpg)), tolerance = 1e-3)
})
test_that("rope_range log gaussian", {
- data(mtcars)
- mod <- lm(log(mpg) ~ gear + hp, data = mtcars)
+ data(iris)
+ mod <- lm(log(Sepal.Length) ~ Species, data = iris)
expect_equal(rope_range(mod), c(-0.01, 0.01), tolerance = 1e-3)
})
@@ -27,9 +27,9 @@ test_that("rope_range logistic", {
expect_equal(rope_range(mod), c(-1 * 0.1 * pi / sqrt(3), 0.1 * pi / sqrt(3)), tolerance = 1e-3)
})
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
-# if (.runThisTest && require("brms", quietly = TRUE)) {
+
+# if ( skip_if_not_or_load_if_installed("brms")) {
# test_that("rope_range", {
# model <- brm(mpg ~ wt + gear, data = mtcars, iter = 300)
#
diff --git a/tests/testthat/test-rstanarm.R b/tests/testthat/test-rstanarm.R
index ea5adfc..ae2cc63 100644
--- a/tests/testthat/test-rstanarm.R
+++ b/tests/testthat/test-rstanarm.R
@@ -1,110 +1,132 @@
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
-if (.runThisTest) {
- if (requiet("rstanarm") && requiet("bayestestR") && requiet("httr") && requiet("insight")) {
- test_that("rstanarm", {
- skip_on_cran()
-
- set.seed(333)
- model <- insight::download_model("stanreg_lm_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_meanfield_lm_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_fullrank_lm_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_lmerMod_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.097, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_glm_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.18, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_merMod_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.18, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_gamm4_1")
- expect_equal(rope_range(model, verbose = FALSE)[1], -0.043, tolerance = 0.1)
-
- model <- insight::download_model("stanreg_gam_1")
- expect_warning(params <- describe_posterior(model, centrality = "all", test = "all", dispersion = TRUE))
- expect_equal(c(nrow(params), ncol(params)), c(4, 22))
-
- expect_s3_class(hdi(model), "data.frame")
- expect_s3_class(ci(model), "data.frame")
- expect_s3_class(rope(model, verbose = FALSE), "data.frame")
- # expect_true("equivalence_test" %in% class(equivalence_test(model)))
- expect_s3_class(map_estimate(model), "data.frame")
- expect_s3_class(p_map(model), "data.frame")
- expect_s3_class(p_direction(model), "data.frame")
-
- # expect_error(equivalence_test(model, range = c(.1, .3, .5)))
- # print(equivalence_test(model, ci = c(.1, .3, .5)))
- })
-
- test_that("rstanarm", {
- skip_on_cran()
-
- set.seed(333)
- model <- insight::download_model("stanreg_glm_3")
-
- out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
- s <- summary(model)
- expect_identical(colnames(out), c(
- "Parameter", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
- "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS"
- ))
- expect_equal(as.vector(s[1:4, 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
- expect_equal(as.vector(s[1:4, 8, drop = TRUE]), out$Rhat, tolerance = 1e-1)
- })
-
- test_that("rstanarm", {
- skip_on_cran()
-
- set.seed(333)
- model <- insight::download_model("stanreg_merMod_3")
-
- out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
- s <- summary(model)
- expect_identical(colnames(out), c(
- "Parameter", "Effects", "Mean", "CI", "CI_low", "CI_high",
- "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
- "Rhat", "ESS"
- ))
- expect_equal(as.vector(s[1:8, 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
- expect_equal(as.vector(s[1:8, 8, drop = TRUE]), out$Rhat, tolerance = 1e-1)
- })
-
- test_that("rstanarm", {
- skip_on_cran()
-
- set.seed(333)
- model <- insight::download_model("stanmvreg_1")
-
- out <- describe_posterior(model, effects = "fixed", component = "all", centrality = "mean", test = NULL)
- s <- summary(model)
- expect_identical(colnames(out), c(
- "Parameter", "Response", "Mean", "CI", "CI_low", "CI_high",
- "Rhat", "ESS"
- ))
- expect_equal(as.vector(s[c(1:2, 5:7), 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
- expect_equal(as.vector(s[c(1:2, 5:7), 10, drop = TRUE]), out$Rhat, tolerance = 1e-1)
- })
-
-
- test_that("rstanarm", {
- skip_on_cran()
-
- set.seed(333)
- model <- insight::download_model("stanmvreg_1")
-
- out <- describe_posterior(model, effects = "fixed", component = "all", centrality = "mean", test = NULL, priors = TRUE)
- expect_identical(colnames(out), c(
- "Parameter", "Response", "Mean", "CI", "CI_low", "CI_high",
- "Rhat", "ESS", "Prior_Distribution", "Prior_Location",
- "Prior_Scale"
- ))
- expect_equal(nrow(out), 5)
- })
- }
-}
+test_that("rstanarm", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+
+ set.seed(333)
+ model <- insight::download_model("stanreg_lm_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_meanfield_lm_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_fullrank_lm_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.602, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_lmerMod_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.097, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_glm_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.18, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_merMod_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.18, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_gamm4_1")
+ expect_equal(rope_range(model, verbose = FALSE)[1], -0.043, tolerance = 0.1)
+
+ model <- insight::download_model("stanreg_gam_1")
+ invisible(capture.output(
+ expect_warning(params <- describe_posterior(model,
+ centrality = "all",
+ test = "all", dispersion = TRUE
+ ))
+ ))
+ expect_equal(c(nrow(params), ncol(params)), c(4, 22))
+
+ expect_s3_class(hdi(model), "data.frame")
+ expect_s3_class(ci(model), "data.frame")
+ expect_s3_class(rope(model, verbose = FALSE), "data.frame")
+ # expect_true("equivalence_test" %in% class(equivalence_test(model)))
+ expect_s3_class(map_estimate(model), "data.frame")
+ expect_s3_class(p_map(model), "data.frame")
+ expect_s3_class(p_direction(model), "data.frame")
+
+ # expect_error(equivalence_test(model, range = c(.1, .3, .5)))
+ # print(equivalence_test(model, ci = c(.1, .3, .5)))
+})
+
+test_that("rstanarm", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+
+ set.seed(333)
+ model <- insight::download_model("stanreg_glm_3")
+
+ out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
+ s <- summary(model)
+ expect_identical(colnames(out), c(
+ "Parameter", "Mean", "CI", "CI_low", "CI_high", "pd", "ROPE_CI",
+ "ROPE_low", "ROPE_high", "ROPE_Percentage", "Rhat", "ESS"
+ ))
+ expect_equal(as.vector(s[1:4, 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
+ expect_equal(as.vector(s[1:4, 8, drop = TRUE]), out$Rhat, tolerance = 1e-1)
+})
+
+test_that("rstanarm", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+
+ set.seed(333)
+ model <- insight::download_model("stanreg_merMod_3")
+
+ out <- describe_posterior(model, effects = "all", component = "all", centrality = "mean")
+ s <- summary(model)
+ expect_identical(colnames(out), c(
+ "Parameter", "Effects", "Mean", "CI", "CI_low", "CI_high",
+ "pd", "ROPE_CI", "ROPE_low", "ROPE_high", "ROPE_Percentage",
+ "Rhat", "ESS"
+ ))
+ expect_equal(as.vector(s[1:8, 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
+ expect_equal(as.vector(s[1:8, 8, drop = TRUE]), out$Rhat, tolerance = 1e-1)
+})
+
+test_that("rstanarm", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+
+ set.seed(333)
+ model <- insight::download_model("stanmvreg_1")
+
+ out <- describe_posterior(model, effects = "fixed", component = "all", centrality = "mean", test = NULL)
+ s <- summary(model)
+ expect_identical(colnames(out), c(
+ "Parameter", "Response", "Mean", "CI", "CI_low", "CI_high",
+ "Rhat", "ESS"
+ ))
+ expect_equal(as.vector(s[c(1:2, 5:7), 1, drop = TRUE]), out$Mean, tolerance = 1e-3)
+ expect_equal(as.vector(s[c(1:2, 5:7), 10, drop = TRUE]), out$Rhat, tolerance = 1e-1)
+})
+
+
+test_that("rstanarm", {
+ skip_on_cran()
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("httr")
+
+ set.seed(333)
+ model <- insight::download_model("stanmvreg_1")
+
+ out <- describe_posterior(
+ model,
+ effects = "fixed",
+ component = "all",
+ centrality = "mean",
+ test = NULL,
+ priors = TRUE
+ )
+ expect_identical(colnames(out), c(
+ "Parameter", "Response", "Mean", "CI", "CI_low", "CI_high",
+ "Rhat", "ESS", "Prior_Distribution", "Prior_Location",
+ "Prior_Scale"
+ ))
+ expect_equal(nrow(out), 5)
+})
diff --git a/tests/testthat/test-si.R b/tests/testthat/test-si.R
index c658d88..f81130e 100644
--- a/tests/testthat/test-si.R
+++ b/tests/testthat/test-si.R
@@ -1,52 +1,52 @@
-if (suppressPackageStartupMessages(require("bayestestR", quietly = TRUE)) && require("testthat")) {
- test_that("si.numeric", {
- set.seed(333)
- prior <- distribution_normal(1000, mean = 0, sd = 1)
- posterior <- distribution_normal(1000, mean = .5, sd = .3)
-
- expect_warning(res <- si(posterior, prior), regexp = "40")
- expect_equal(res$CI_low, 0.043, tolerance = 0.02)
- expect_equal(res$CI_high, 1.053103, tolerance = 0.02)
- expect_s3_class(res, c("bayestestR_si"))
-
- res <- si(posterior, prior, BF = 3, verbose = FALSE)
- expect_equal(res$CI_low, 0.35, tolerance = 0.02)
- expect_equal(res$CI_high, 0.759, tolerance = 0.02)
-
- res <- si(posterior, prior, BF = 100, verbose = FALSE)
- expect_true(all(is.na(res$CI_low)))
- expect_true(all(is.na(res$CI_high)))
-
- res <- si(posterior, prior, BF = c(1 / 3, 1, 3), verbose = FALSE)
- expect_equal(res$CI, c(1 / 3, 1, 3), tolerance = 0.02)
- expect_equal(res$CI_low, c(-0.1277, 0.0426, 0.3549), tolerance = 0.02)
- expect_equal(res$CI_high, c(1.213, 1.053, 0.759), tolerance = 0.02)
- })
-
- test_that("si.rstanarm", {
- skip_on_cran()
- skip_if_not_installed("rstanarm")
-
- data(sleep)
- contrasts(sleep$group) <- contr.equalprior_pairs # See vignette
- stan_model <- rstanarm::stan_glmer(extra ~ group + (1 | ID), data = sleep, refresh = 0)
-
- set.seed(333)
- stan_model_p <- update(stan_model, prior_PD = TRUE)
- res1 <- si(stan_model, stan_model_p, verbose = FALSE)
-
- set.seed(333)
- res2 <- si(stan_model, verbose = FALSE)
-
- expect_s3_class(res1, c("bayestestR_si"))
- expect_equal(res1, res2)
-
- skip_if_not_installed("emmeans")
- set.seed(123)
- group_diff <- pairs(emmeans::emmeans(stan_model, ~group))
- res3 <- si(group_diff, prior = stan_model, verbose = FALSE)
-
- expect_equal(res3$CI_low, -2.746, tolerance = 0.3)
- expect_equal(res3$CI_high, -0.4, tolerance = 0.3)
- })
-}
+test_that("si.numeric", {
+ skip_if_not_installed("logspline")
+
+ set.seed(333)
+ prior <- distribution_normal(1000, mean = 0, sd = 1)
+ posterior <- distribution_normal(1000, mean = .5, sd = .3)
+
+ expect_warning(res <- si(posterior, prior), regexp = "40")
+ expect_equal(res$CI_low, 0.043, tolerance = 0.02)
+ expect_equal(res$CI_high, 1.053103, tolerance = 0.02)
+ expect_s3_class(res, c("bayestestR_si"))
+
+ res <- si(posterior, prior, BF = 3, verbose = FALSE)
+ expect_equal(res$CI_low, 0.35, tolerance = 0.02)
+ expect_equal(res$CI_high, 0.759, tolerance = 0.02)
+
+ res <- si(posterior, prior, BF = 100, verbose = FALSE)
+ expect_true(all(is.na(res$CI_low)))
+ expect_true(all(is.na(res$CI_high)))
+
+ res <- si(posterior, prior, BF = c(1 / 3, 1, 3), verbose = FALSE)
+ expect_equal(res$CI, c(1 / 3, 1, 3), tolerance = 0.02)
+ expect_equal(res$CI_low, c(-0.1277, 0.0426, 0.3549), tolerance = 0.02)
+ expect_equal(res$CI_high, c(1.213, 1.053, 0.759), tolerance = 0.02)
+})
+
+test_that("si.rstanarm", {
+ skip_on_cran()
+ skip_if_not_installed("rstanarm")
+
+ data(sleep)
+ contrasts(sleep$group) <- contr.equalprior_pairs # See vignette
+ stan_model <- rstanarm::stan_glmer(extra ~ group + (1 | ID), data = sleep, refresh = 0)
+
+ set.seed(333)
+ stan_model_p <- update(stan_model, prior_PD = TRUE)
+ res1 <- si(stan_model, stan_model_p, verbose = FALSE)
+
+ set.seed(333)
+ res2 <- si(stan_model, verbose = FALSE)
+
+ expect_s3_class(res1, c("bayestestR_si"))
+ expect_equal(res1, res2)
+
+ skip_if_not_installed("emmeans")
+ set.seed(123)
+ group_diff <- pairs(emmeans::emmeans(stan_model, ~group))
+ res3 <- si(group_diff, prior = stan_model, verbose = FALSE)
+
+ expect_equal(res3$CI_low, -2.746, tolerance = 0.3)
+ expect_equal(res3$CI_high, -0.4, tolerance = 0.3)
+})
diff --git a/tests/testthat/test-spi.R b/tests/testthat/test-spi.R
index 07e15aa..f733b76 100644
--- a/tests/testthat/test-spi.R
+++ b/tests/testthat/test-spi.R
@@ -1,60 +1,74 @@
-if (require("rstanarm") && require("brms") && require("httr") && require("testthat") && require("BayesFactor")) {
- # numeric -------------------------------
- test_that("spi", {
- expect_equal(spi(distribution_normal(1000), ci = .90)$CI_low[1], -1.65, tolerance = 0.02)
- expect_equal(nrow(spi(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01)
- expect_equal(spi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
- expect_equal(nchar(capture.output(print(spi(distribution_normal(1000))))), 22)
- expect_equal(length(capture.output(print(spi(distribution_normal(1000), ci = c(.80, .90))))), 5)
-
-
- expect_error(spi(c(2, 3, NA)))
- expect_warning(spi(c(2, 3)))
- expect_message(spi(distribution_normal(1000), ci = 0.0000001))
- expect_warning(spi(distribution_normal(1000), ci = 950))
- expect_message(spi(c(0, 0, 0)))
- })
-
-
-
- .runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
- if (.runThisTest) {
- if (require("insight")) {
- # stanreg ---------------------------
- m <- insight::download_model("stanreg_merMod_5")
- p <- insight::get_parameters(m, effects = "all")
-
- test_that("ci", {
- expect_equal(
- spi(m, ci = c(.5, .8), effects = "all")$CI_low,
- spi(p, ci = c(.5, .8))$CI_low,
- tolerance = 1e-3
- )
- })
-
- # brms ---------------------------
- m <- insight::download_model("brms_zi_3")
- p <- insight::get_parameters(m, effects = "all", component = "all")
-
- test_that("spi brms", {
- expect_equal(
- spi(m, ci = c(.5, .8), effects = "all", component = "all")$CI_low,
- spi(p, ci = c(.5, .8))$CI_low,
- tolerance = 1e-3
- )
- })
-
- # BayesFactor ---------------------------
- mod_bf <- proportionBF(y = 15, N = 25, p = .5)
- p_bf <- insight::get_parameters(mod_bf)
-
- test_that("ci - BayesFactor", {
- expect_equal(
- spi(mod_bf, ci = c(.5, .8), effects = "all", component = "all")$CI_low,
- spi(p_bf, ci = c(.5, .8))$CI_low,
- tolerance = 0.1
- )
- })
- }
- }
-}
+# numeric -------------------------------
+test_that("spi", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ expect_equal(spi(distribution_normal(1000), ci = .90)$CI_low[1], -1.65, tolerance = 0.02)
+ expect_equal(nrow(spi(distribution_normal(1000), ci = c(.80, .90, .95))), 3, tolerance = 0.01)
+ expect_equal(spi(distribution_normal(1000), ci = 1)$CI_low[1], -3.29, tolerance = 0.02)
+ expect_equal(nchar(capture.output(print(spi(distribution_normal(1000))))), 22)
+ expect_equal(length(capture.output(print(spi(distribution_normal(1000), ci = c(.80, .90))))), 5)
+
+
+ expect_error(spi(c(2, 3, NA)))
+ expect_warning(spi(c(2, 3)))
+ expect_message(spi(distribution_normal(1000), ci = 0.0000001))
+ expect_warning(spi(distribution_normal(1000), ci = 950))
+ expect_message(spi(c(0, 0, 0)))
+})
+
+
+test_that("ci", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("stanreg_merMod_5")
+ p <- insight::get_parameters(m, effects = "all")
+
+ expect_equal(
+ spi(m, ci = c(0.5, 0.8), effects = "all")$CI_low,
+ spi(p, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 1e-3
+ )
+})
+
+test_that("spi brms", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ m <- insight::download_model("brms_zi_3")
+ p <- insight::get_parameters(m, effects = "all", component = "all")
+
+ expect_equal(
+ spi(m, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low,
+ spi(p, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 1e-3
+ )
+})
+
+
+test_that("ci - BayesFactor", {
+ skip_if_offline()
+ skip_if_not_or_load_if_installed("rstanarm")
+ skip_if_not_or_load_if_installed("brms")
+ skip_if_not_or_load_if_installed("httr")
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ mod_bf <- proportionBF(y = 15, N = 25, p = .5)
+ p_bf <- insight::get_parameters(mod_bf)
+
+ expect_equal(
+ spi(mod_bf, ci = c(0.5, 0.8), effects = "all", component = "all")$CI_low,
+ spi(p_bf, ci = c(0.5, 0.8))$CI_low,
+ tolerance = 0.1
+ )
+})
diff --git a/tests/testthat/test-weighted_posteriors.R b/tests/testthat/test-weighted_posteriors.R
index 704a464..f8f28c3 100644
--- a/tests/testthat/test-weighted_posteriors.R
+++ b/tests/testthat/test-weighted_posteriors.R
@@ -1,98 +1,100 @@
-if (require("BayesFactor", quietly = TRUE)) {
- test_that("weighted_posteriors for BayesFactor", {
- skip_on_cran()
- set.seed(123)
- # compute Bayes Factor for 31 different regression models
- null_den <- regressionBF(mpg ~ cyl + disp + hp + drat + wt,
- data = mtcars, progress = FALSE
+test_that("weighted_posteriors for BayesFactor", {
+ skip_on_cran()
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(123)
+
+ # compute Bayes Factor for 31 different regression models
+ null_den <- regressionBF(
+ mpg ~ cyl + disp + hp + drat + wt,
+ data = mtcars,
+ progress = FALSE
+ )
+ wBF <- weighted_posteriors(null_den)
+
+ expect_s3_class(wBF, "data.frame")
+ expect_equal(
+ attr(wBF, "weights")$weights,
+ c(
+ 0, 13, 9, 0, 0, 55, 11, 4, 4, 1246, 6, 2, 38, 4, 946, 12, 3,
+ 3, 209, 3, 491, 174, 4, 134, 7, 293, 1, 123, 35, 92, 51, 27
)
- wBF <- weighted_posteriors(null_den)
-
- expect_s3_class(wBF, "data.frame")
- expect_equal(
- attr(wBF, "weights")$weights,
- c(
- 0, 13, 9, 0, 0, 55, 11, 4, 4, 1246, 6, 2, 38, 4, 946, 12, 3,
- 3, 209, 3, 491, 174, 4, 134, 7, 293, 1, 123, 35, 92, 51, 27
- )
- )
- })
-
- test_that("weighted_posteriors for BayesFactor (intercept)", {
- set.seed(123)
- # fails for win old-release
- skip_on_cran()
- skip_on_ci()
-
- dat <- data.frame(
- x1 = rnorm(10),
- x2 = rnorm(10),
- y = rnorm(10)
- )
- BFmods <- regressionBF(y ~ x1 + x2, data = dat, progress = FALSE)
-
- res <- weighted_posteriors(BFmods)
- expect_equal(attr(res, "weights")$weights, c(1032, 805, 1388, 775))
-
- wHDI <- hdi(res[c("x1", "x2")], ci = 0.9)
- expect_equal(wHDI$CI_low, c(-0.519, -0.640), tolerance = 0.01)
- expect_equal(wHDI$CI_high, c(0.150, 0.059), tolerance = 0.01)
- })
-
- test_that("weighted_posteriors for nonlinear BayesFactor", {
- set.seed(123)
- data(sleep)
-
- BFS <- ttestBF(
- x = sleep$extra[sleep$group == 1],
- y = sleep$extra[sleep$group == 2],
- nullInterval = c(-Inf, 0),
- paired = TRUE
- )
-
- res <- weighted_posteriors(BFS)
-
- expect_equal(attributes(res)$weights$weights, c(113, 3876, 11))
- })
-}
-
-.runThisTest <- Sys.getenv("RunAllbayestestRTests") == "yes"
-if (.runThisTest) {
- if (require("brms", quietly = TRUE)) {
- test_that("weighted_posteriors vs posterior_average", {
- skip_on_cran()
-
- fit1 <- brm(rating ~ treat + period + carry,
- data = inhaler,
- refresh = 0,
- silent = TRUE,
- save_pars = save_pars(all = TRUE)
- )
- fit2 <- brm(rating ~ period + carry,
- data = inhaler,
- refresh = 0,
- silent = TRUE,
- save_pars = save_pars(all = TRUE)
- )
-
-
- set.seed(444)
- expect_warning(res_BT <- weighted_posteriors(fit1, fit2))
-
- set.seed(444)
- res_brms <- brms::posterior_average(fit1, fit2, weights = "bma", missing = 0)
- res_brms <- res_brms[, 1:4]
-
- res_BT1 <- eti(res_BT)
- res_brms1 <- eti(res_brms)
-
- expect_equal(res_BT1$Parameter, res_brms1$Parameter)
- expect_equal(res_BT1$CI, res_brms1$CI)
- expect_equal(res_BT1$CI_low, res_brms1$CI_low)
- expect_equal(res_BT1$CI_high, res_brms1$CI_high)
-
- # plot(res_brms1)
- # plot(res_BT1)
- })
- }
-}
+ )
+})
+
+test_that("weighted_posteriors for BayesFactor (intercept)", {
+ # fails for win old-release
+ skip_on_ci()
+ skip_on_cran()
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(123)
+
+ dat <- data.frame(
+ x1 = rnorm(10),
+ x2 = rnorm(10),
+ y = rnorm(10)
+ )
+ BFmods <- regressionBF(y ~ x1 + x2, data = dat, progress = FALSE)
+
+ res <- weighted_posteriors(BFmods)
+ expect_equal(attr(res, "weights")$weights, c(1032, 805, 1388, 775))
+
+ wHDI <- hdi(res[c("x1", "x2")], ci = 0.9)
+ expect_equal(wHDI$CI_low, c(-0.519, -0.640), tolerance = 0.01)
+ expect_equal(wHDI$CI_high, c(0.150, 0.059), tolerance = 0.01)
+})
+
+test_that("weighted_posteriors for nonlinear BayesFactor", {
+ skip_on_cran()
+ skip_if_not_or_load_if_installed("BayesFactor")
+
+ set.seed(123)
+ data(sleep)
+
+ BFS <- ttestBF(
+ x = sleep$extra[sleep$group == 1],
+ y = sleep$extra[sleep$group == 2],
+ nullInterval = c(-Inf, 0),
+ paired = TRUE
+ )
+
+ res <- weighted_posteriors(BFS)
+
+ expect_equal(attributes(res)$weights$weights, c(113, 3876, 11))
+})
+
+test_that("weighted_posteriors vs posterior_average", {
+ skip("Test creates error, must check why...")
+ skip_on_cran()
+ skip_if_not_or_load_if_installed("BayesFactor")
+ skip_if_not_or_load_if_installed("brms")
+
+ fit1 <- brm(rating ~ treat + period + carry,
+ data = inhaler,
+ refresh = 0,
+ silent = TRUE,
+ save_pars = save_pars(all = TRUE)
+ )
+ fit2 <- brm(rating ~ period + carry,
+ data = inhaler,
+ refresh = 0,
+ silent = TRUE,
+ save_pars = save_pars(all = TRUE)
+ )
+
+ set.seed(444)
+ expect_warning(res_BT <- weighted_posteriors(fit1, fit2))
+
+ set.seed(444)
+ res_brms <- brms::posterior_average(fit1, fit2, weights = "bma", missing = 0)
+ res_brms <- res_brms[, 1:4]
+
+ res_BT1 <- eti(res_BT)
+ res_brms1 <- eti(res_brms)
+
+ expect_equal(res_BT1$Parameter, res_brms1$Parameter)
+ expect_equal(res_BT1$CI, res_brms1$CI)
+ expect_equal(res_BT1$CI_low, res_brms1$CI_low)
+ expect_equal(res_BT1$CI_high, res_brms1$CI_high)
+})