https://github.com/cran/bayestestR
Raw File
Tip revision: 68a979e69aa2a1e57017730e1397470d5614d216 authored by Dominique Makowski on 02 September 2021, 23:10 UTC
version 0.11.0
Tip revision: 68a979e
ci.R
#' Confidence/Credible/Compatibility Interval (CI)
#'
#' Compute Confidence/Credible/Compatibility Intervals (CI) or Support Intervals (SI) for Bayesian and frequentist models. The Documentation is accessible for:
#'
#' \itemize{
#'  \item [Bayesian models](https://easystats.github.io/bayestestR/articles/credible_interval.html)
#'  \item [Frequentist models](https://easystats.github.io/parameters/reference/ci.merMod.html)
#' }
#'
#' @param x A `stanreg` or `brmsfit` model, or a vector representing a posterior distribution.
#' @param method Can be ['ETI'][eti] (default), ['HDI'][hdi], ['BCI'][bci] or ['SI'][si].
#' @param ci Value or vector of probability of the CI (between 0 and 1)
#'   to be estimated. Default to `.95` (`95%`).
#' @inheritParams hdi
#' @inheritParams si
#' @inherit hdi seealso
#' @family ci
#'
#' @return A data frame with following columns:
#'   \itemize{
#'     \item `Parameter` The model parameter(s), if `x` is a model-object. If `x` is a vector, this column is missing.
#'     \item `CI` The probability of the credible interval.
#'     \item `CI_low`, `CI_high` The lower and upper credible interval limits for the parameters.
#'   }
#'
#' @note When it comes to interpretation, we recommend thinking of the CI in terms of
#'   an "uncertainty" or "compatibility" interval, the latter being defined as
#'   \dQuote{Given any value in the interval and the background assumptions,
#'   the data should not seem very surprising} (\cite{Gelman & Greenland 2019}).
#'   \cr \cr
#'   There is also a [`plot()`-method](https://easystats.github.io/see/articles/bayestestR.html) implemented in the \href{https://easystats.github.io/see/}{\pkg{see}-package}.
#'
#' @references Gelman A, Greenland S. Are confidence intervals better termed "uncertainty intervals"? BMJ 2019;l5381. \doi{10.1136/bmj.l5381}
#'
#'
#' @examples
#' library(bayestestR)
#'
#' posterior <- rnorm(1000)
#' ci(posterior, method = "ETI")
#' ci(posterior, method = "HDI")
#'
#' df <- data.frame(replicate(4, rnorm(100)))
#' ci(df, method = "ETI", ci = c(.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")
#' }
#'
#' if (require("emmeans")) {
#'   model <- emtrends(model, ~1, "wt")
#'   ci(model, method = "ETI")
#'   ci(model, method = "HDI")
#'   ci(model, method = "SI")
#' }
#' }
#' @export
ci <- function(x, ...) {
  UseMethod("ci")
}


#' @keywords internal
.ci_bayesian <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"), component = c("conditional", "zi", "zero_inflated", "all"), parameters = NULL, verbose = TRUE, BF = 1, ...) {
  if (tolower(method) %in% c("eti", "equal", "ci", "quantile")) {
    return(eti(x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
  } else if (tolower(method) %in% c("bci", "bca", "bcai")) {
    return(bci(x, ci = ci, effects = effects, component = component, parameters = parameters, verbose = verbose, ...))
  } else if (tolower(method) %in% c("hdi")) {
    return(hdi(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, ...))
  } else {
    stop("`method` should be 'ETI' (for equal-tailed interval),'HDI' (for highest density interval), `BCI` (for bias corrected and accelerated bootstrap intervals) or 'SI' (for support interval).")
  }
}


#' @rdname ci
#' @export
ci.numeric <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, BF = 1, ...) {
  .ci_bayesian(x, ci = ci, method = method, verbose = verbose, BF = BF, ...)
}


#' @rdname ci
#' @export
ci.data.frame <- ci.numeric



#' @export
ci.emmGrid <- function(x, ci = NULL, ...) {
  if (!.is_baysian_emmeans(x)) {
    if (!requireNamespace("parameters")) {
      stop("'parameters' required for this function to work.")
    }

    if (is.null(ci)) ci <- 0.95
    return(parameters::ci_wald(model = x, ci = ci, dof = parameters::degrees_of_freedom(x), ...))
  }

  if (is.null(ci)) ci <- 0.95
  x <- insight::get_parameters(x)
  ci(x, ci = ci, ...)
}


#' @export
ci.emm_list <- ci.emmGrid



#' @rdname ci
#' @export
ci.sim.merMod <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"),
                          parameters = NULL, verbose = TRUE, ...) {
  .ci_bayesian(x, ci = ci, method = method, effects = effects, parameters = parameters, verbose = verbose, ...)
}



#' @rdname ci
#' @export
ci.sim <- function(x, ci = 0.95, method = "ETI", parameters = NULL, verbose = TRUE, ...) {
  .ci_bayesian(x, ci = ci, method = method, parameters = parameters, verbose = verbose, ...)
}



#' @rdname ci
#' @export
ci.stanreg <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"),
                       component = c("location", "all", "conditional", "smooth_terms", "sigma", "distributional", "auxiliary"),
                       parameters = NULL, verbose = TRUE, BF = 1, ...) {
  .ci_bayesian(x, ci = ci, method = method, effects = effects, component = component, parameters = parameters, verbose = verbose, BF = BF, ...)
}


#' @rdname ci
#' @export
ci.brmsfit <- function(x, ci = 0.95, method = "ETI", effects = c("fixed", "random", "all"),
                       component = c("conditional", "zi", "zero_inflated", "all"),
                       parameters = NULL, verbose = TRUE, BF = 1, ...) {
  .ci_bayesian(x, ci = ci, method = method, effects = effects, component = component, parameters = parameters, verbose = verbose, BF = BF, ...)
}


#' @export
ci.stanfit <- ci.stanreg


#' @export
ci.blavaan <- ci.stanreg


#' @rdname ci
#' @export
ci.BFBayesFactor <- ci.numeric




#' @rdname ci
#' @export
ci.MCMCglmm <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, ...) {
  nF <- x$Fixed$nfl
  ci(as.data.frame(x$Sol[, 1:nF, drop = FALSE]), ci = ci, method = method, verbose = verbose, ...)
}


#' @export
ci.bamlss <- function(x, ci = 0.95, method = "ETI", component = c("all", "conditional", "location"), verbose = TRUE, ...) {
  component <- match.arg(component)
  ci(insight::get_parameters(x, component = component), ci = ci, method = method, verbose = verbose, ...)
}


#' @export
ci.bcplm <- function(x, ci = 0.95, method = "ETI", verbose = TRUE, ...) {
  ci(insight::get_parameters(x), ci = ci, method = method, verbose = verbose, ...)
}


#' @export
ci.blrm <- ci.bcplm


#' @export
ci.mcmc <- ci.bcplm


#' @export
ci.mcmc.list <- ci.bcplm


#' @export
ci.BGGM <- ci.bcplm


#' @export
ci.get_predicted <- ci.data.frame
back to top