Skip to content

Commit

Permalink
Rejuvenation (#625)
Browse files Browse the repository at this point in the history
* fix issues

* tests

* fix tests

* fix test

* fix test

* fix tests

* fix tests

* fix

* fix test

* fix tests

* fix test

* fix vignette

* fix issues

* lintr

* lintr

* fix test

* fix example

* separate internal from methods

* fix examples

* fix

* fix

* skip on oldrel

* fix?

* fix examples

* replace plotting code in vignette

* add p_significance.get_predicted

* update NAMESPACE

* fix tests

* lintr

* lintr

* docs

* fix examples

* styler

* fix examples

* fix issues

* lintr

* fix

* fix

* fix examples

* fix examples

* make sure we have uniform get_predicted methods

* fix test

* fixes

* suppress Warnings

* Update test-bayesfactor_parameters.R

* Update test-different_models.R

* Update test-describe_posterior.R

* fix

* fix tests

* fix

* generic only has one argument, #525

* news

* version

* #525

* correct URL for vignette images

closes #602

* lintr

---------

Co-authored-by: Dominique Makowski <[email protected]>
Co-authored-by: Indrajeet Patil <[email protected]>
  • Loading branch information
3 people authored Oct 2, 2023
1 parent 2d702b5 commit fdd2512
Show file tree
Hide file tree
Showing 71 changed files with 1,117 additions and 782 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: bayestestR
Title: Understand and Describe Bayesian Models and Posterior Distributions
Version: 0.13.1.3
Version: 0.13.1.4
Authors@R:
c(person(given = "Dominique",
family = "Makowski",
Expand Down
3 changes: 3 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -314,6 +314,7 @@ S3method(p_map,data.frame)
S3method(p_map,draws)
S3method(p_map,emmGrid)
S3method(p_map,emm_list)
S3method(p_map,get_predicted)
S3method(p_map,mcmc)
S3method(p_map,mcmc.list)
S3method(p_map,numeric)
Expand Down Expand Up @@ -357,6 +358,7 @@ S3method(p_significance,default)
S3method(p_significance,draws)
S3method(p_significance,emmGrid)
S3method(p_significance,emm_list)
S3method(p_significance,get_predicted)
S3method(p_significance,mcmc)
S3method(p_significance,mcmc.list)
S3method(p_significance,numeric)
Expand Down Expand Up @@ -469,6 +471,7 @@ S3method(rope,default)
S3method(rope,draws)
S3method(rope,emmGrid)
S3method(rope,emm_list)
S3method(rope,get_predicted)
S3method(rope,mcmc)
S3method(rope,mcmc.list)
S3method(rope,numeric)
Expand Down
8 changes: 7 additions & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,15 @@

## Breaking Changes

* `pd_to_p()` now returns 1 and a warning for pds smaller than 0.5.
* `pd_to_p()` now returns 1 and a warning for values smaller than 0.5.

* `map_estimate()`, `p_direction()`, `p_map()`, and `p_significance()` now
return a data-frame when the input is a numeric vector. (making the output
consistently a data frame for all inputs.)

* Argument `posteriors` was renamed into `posterior`. Before, there were a mix
of both spellings, now it is consistently `posterior`.

## Changes

* Retrieving models from the environment was improved.
Expand All @@ -19,6 +23,8 @@
* Fixed issue in `estimate_density()` for double vectors that also had other
class attributes.

* Fixed several minor issues and tests.

# bayestestR 0.13.1

## Changes
Expand Down
2 changes: 1 addition & 1 deletion R/area_under_curve.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@
#' @seealso DescTools
#' @export
area_under_curve <- function(x, y, method = c("trapezoid", "step", "spline"), ...) {
# Stolen from DescTools: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r
# From DescTools [GPL-3]: https://github.com/cran/DescTools/blob/master/R/StatsAndCIs.r

if (length(x) != length(y)) {
insight::format_error("Length of x must be equal to length of y.")
Expand Down
49 changes: 22 additions & 27 deletions R/bayesfactor.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,35 +21,30 @@
#'
#' @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 require("rstanarm") && require("logspline")
#' library(bayestestR)
#'
#' if (require("logspline")) {
#' prior <- distribution_normal(1000, mean = 0, sd = 1)
#' posterior <- distribution_normal(1000, mean = .5, sd = .3)
#' prior <- distribution_normal(1000, mean = 0, sd = 1)
#' posterior <- distribution_normal(1000, mean = .5, sd = .3)
#'
#' bayesfactor(posterior, prior = prior, verbose = FALSE)
#'
#' bayesfactor(posterior, prior = prior, verbose = FALSE)
#' }
#' \donttest{
#' # rstanarm models
#' # ---------------
#' if (require("rstanarm")) {
#' model <- stan_lmer(extra ~ group + (1 | ID), data = sleep)
#' bayesfactor(model, verbose = FALSE)
#' }
#' }
#' model <- suppressWarnings(rstanarm::stan_lmer(extra ~ group + (1 | ID), data = sleep))
#' bayesfactor(model, verbose = FALSE)
#'
#' if (require("logspline")) {
#' # Frequentist models
#' # ---------------
#' m0 <- lm(extra ~ 1, data = sleep)
#' m1 <- lm(extra ~ group, data = sleep)
#' m2 <- lm(extra ~ group + ID, data = sleep)
#' # Frequentist models
#' # ---------------
#' m0 <- lm(extra ~ 1, data = sleep)
#' m1 <- lm(extra ~ group, data = sleep)
#' m2 <- lm(extra ~ group + ID, data = sleep)
#'
#' comparison <- bayesfactor(m0, m1, m2)
#' comparison
#' comparison <- bayesfactor(m0, m1, m2)
#' comparison
#'
#' bayesfactor(comparison)
#' bayesfactor(comparison)
#' }
#' @export
bayesfactor <- function(...,
Expand All @@ -75,13 +70,7 @@ bayesfactor <- function(...,
} else {
bayesfactor_models(...)
}
} else if (!is.null(hypothesis)) {
bayesfactor_restricted(...,
prior = prior,
verbose = verbose,
effects = effects
)
} else {
} else if (is.null(hypothesis)) {
bayesfactor_parameters(
...,
prior = prior,
Expand All @@ -90,5 +79,11 @@ bayesfactor <- function(...,
effects = effects,
verbose = verbose
)
} else {
bayesfactor_restricted(...,
prior = prior,
verbose = verbose,
effects = effects
)
}
}
7 changes: 2 additions & 5 deletions R/bayesfactor_inclusion.R
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@
#'
#' @seealso [weighted_posteriors()] for Bayesian parameter averaging.
#'
#' @examples
#' @examplesIf require("BayesFactor")
#' library(bayestestR)
#'
#' # Using bayesfactor_models:
Expand All @@ -55,10 +55,7 @@
#' \donttest{
#' # BayesFactor
#' # -------------------------------
#' library(BayesFactor)
#'
#' BF <- generalTestBF(len ~ supp * dose, ToothGrowth, progress = FALSE)
#'
#' BF <- BayesFactor::generalTestBF(len ~ supp * dose, ToothGrowth, progress = FALSE)
#' bayesfactor_inclusion(BF)
#'
#' # compare only matched models:
Expand Down
98 changes: 47 additions & 51 deletions R/bayesfactor_models.R
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@
#' random effects) and their `log(BF)`s (Use `as.numeric()` to extract the
#' non-log Bayes factors; see examples), that prints nicely.
#'
#' @examples
#' @examplesIf require("lme4") && require("BayesFactor") && require("rstanarm") && require("brms")
#' # With lm objects:
#' # ----------------
#' lm1 <- lm(mpg ~ 1, data = mtcars)
Expand All @@ -66,81 +66,72 @@
#' # bayesfactor_models(lm2, lm3, lm4, denominator = lm1) # same result
#' # bayesfactor_models(lm1, lm2, lm3, lm4, denominator = lm1) # same result
#'
#'
#' update(BFM, reference = "bottom")
#' as.matrix(BFM)
#' as.numeric(BFM)
#'
#'
#' lm2b <- lm(sqrt(mpg) ~ hp, data = mtcars)
#' # Set check_response = TRUE for transformed responses
#' bayesfactor_models(lm2b, denominator = lm2, check_response = TRUE)
#'
#' \donttest{
#' # With lmerMod objects:
#' # ---------------------
#' if (require("lme4")) {
#' lmer1 <- lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
#' lmer2 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris)
#' lmer3 <- lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species) + (1 | Petal.Width),
#' data = iris
#' )
#' bayesfactor_models(lmer1, lmer2, lmer3,
#' denominator = 1,
#' estimator = "REML"
#' )
#' }
#' lmer1 <- lme4::lmer(Sepal.Length ~ Petal.Length + (1 | Species), data = iris)
#' lmer2 <- lme4::lmer(Sepal.Length ~ Petal.Length + (Petal.Length | Species), data = iris)
#' lmer3 <- lme4::lmer(
#' Sepal.Length ~ Petal.Length + (Petal.Length | Species) + (1 | Petal.Width),
#' data = iris
#' )
#' bayesfactor_models(lmer1, lmer2, lmer3,
#' denominator = 1,
#' estimator = "REML"
#' )
#'
#' # rstanarm models
#' # ---------------------
#' # (note that a unique diagnostic_file MUST be specified in order to work)
#' if (require("rstanarm")) {
#' stan_m0 <- stan_glm(Sepal.Length ~ 1,
#' data = iris,
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df0.csv")
#' )
#' stan_m1 <- stan_glm(Sepal.Length ~ Species,
#' data = iris,
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df1.csv")
#' )
#' stan_m2 <- stan_glm(Sepal.Length ~ Species + Petal.Length,
#' data = iris,
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df2.csv")
#' )
#' bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE)
#' }
#' stan_m0 <- suppressWarnings(rstanarm::stan_glm(Sepal.Length ~ 1,
#' data = iris,
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df0.csv")
#' ))
#' stan_m1 <- suppressWarnings(rstanarm::stan_glm(Sepal.Length ~ Species,
#' data = iris,
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df1.csv")
#' ))
#' stan_m2 <- suppressWarnings(rstanarm::stan_glm(Sepal.Length ~ Species + Petal.Length,
#' data = iris,
#' family = gaussian(),
#' diagnostic_file = file.path(tempdir(), "df2.csv")
#' ))
#' bayesfactor_models(stan_m1, stan_m2, denominator = stan_m0, verbose = FALSE)
#'
#'
#' # brms models
#' # --------------------
#' # (note the save_pars MUST be set to save_pars(all = TRUE) in order to work)
#' if (require("brms")) {
#' brm1 <- brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE))
#' brm2 <- brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE))
#' brm3 <- brm(
#' Sepal.Length ~ Species + Petal.Length,
#' data = iris,
#' save_pars = save_pars(all = TRUE)
#' )
#' brm1 <- brms::brm(Sepal.Length ~ 1, data = iris, save_pars = save_pars(all = TRUE))
#' brm2 <- brms::brm(Sepal.Length ~ Species, data = iris, save_pars = save_pars(all = TRUE))
#' brm3 <- brms::brm(
#' Sepal.Length ~ Species + Petal.Length,
#' data = iris,
#' save_pars = save_pars(all = TRUE)
#' )
#'
#' bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE)
#' }
#' bayesfactor_models(brm1, brm2, brm3, denominator = 1, verbose = FALSE)
#'
#'
#' # BayesFactor
#' # ---------------------------
#' if (require("BayesFactor")) {
#' data(puzzles)
#' BF <- anovaBF(RT ~ shape * color + ID,
#' data = puzzles,
#' whichRandom = "ID", progress = FALSE
#' )
#' BF
#' bayesfactor_models(BF) # basically the same
#' }
#' data(puzzles)
#' BF <- BayesFactor::anovaBF(RT ~ shape * color + ID,
#' data = puzzles,
#' whichRandom = "ID", progress = FALSE
#' )
#' BF
#' bayesfactor_models(BF) # basically the same
#' }
#'
#' @references
Expand Down Expand Up @@ -169,6 +160,7 @@ bayesfactor_models <- function(..., denominator = 1, verbose = TRUE) {
#' @export
bf_models <- bayesfactor_models


#' @export
#' @rdname bayesfactor_models
bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
Expand Down Expand Up @@ -289,6 +281,7 @@ bayesfactor_models.default <- function(..., denominator = 1, verbose = TRUE) {
)
}


#' @keywords internal
.bayesfactor_models_stan_REG <- function(mods, denominator, verbose = TRUE) {
insight::check_if_installed("bridgesampling")
Expand Down Expand Up @@ -356,6 +349,7 @@ bayesfactor_models.stanreg <- function(..., denominator = 1, verbose = TRUE) {
.bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose)
}


#' @export
bayesfactor_models.brmsfit <- function(..., denominator = 1, verbose = TRUE) {
insight::check_if_installed("brms")
Expand All @@ -374,6 +368,7 @@ 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")
Expand All @@ -392,6 +387,7 @@ bayesfactor_models.blavaan <- function(..., denominator = 1, verbose = TRUE) {
.bayesfactor_models_stan(mods, denominator = denominator, verbose = verbose)
}


#' @export
bayesfactor_models.BFBayesFactor <- function(..., verbose = TRUE) {
models <- c(...)
Expand Down
15 changes: 10 additions & 5 deletions R/bci.R
Original file line number Diff line number Diff line change
Expand Up @@ -257,14 +257,19 @@ bci.BFBayesFactor <- function(x, ci = 0.95, verbose = TRUE, ...) {
}


#' @rdname bci
#' @export
bci.get_predicted <- function(x, ...) {
if ("iterations" %in% names(attributes(x))) {
out <- bci(as.data.frame(t(attributes(x)$iterations)), ...)
bci.get_predicted <- function(x, ci = 0.95, use_iterations = FALSE, verbose = TRUE, ...) {
if (isTRUE(use_iterations)) {
if ("iterations" %in% names(attributes(x))) {
out <- bci(as.data.frame(t(attributes(x)$iterations)), ci = ci, verbose = verbose, ...)
} else {
insight::format_error("No iterations present in the output.")
}
attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
} else {
insight::format_error("No iterations present in the output.")
out <- bci(as.numeric(x), ci = ci, verbose = verbose, ...)
}
attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
out
}

Expand Down
Loading

0 comments on commit fdd2512

Please sign in to comment.