https://github.com/cran/bayestestR
Raw File
Tip revision: 601edcd8d1306ebea478657861c54fa9c69a52f3 authored by Dominique Makowski on 31 May 2021, 05:40 UTC
version 0.10.0
Tip revision: 601edcd
diagnostic_draws.R
#' Diagnostic values for each iteration
#'
#' Returns the accumulated log-posterior, the average Metropolis acceptance rate, divergent transitions, treedepth rather than terminated its evolution normally.
#' @inheritParams diagnostic_posterior
#'
#' @examples
#' \donttest{
#' set.seed(333)
#'
#' if (require("brms", quietly = TRUE)) {
#'   model <- brm(mpg ~ wt * cyl * vs, data = mtcars,
#'                iter = 100, control = list(adapt_delta = 0.80),
#'                refresh = 0)
#'   diagnostic_draws(model)
#' }
#' }
#'
#' @export
diagnostic_draws <- function(posteriors, ...) {
  UseMethod("diagnostic_draws")
}




#' @export
diagnostic_draws.brmsfit <- function(posteriors, ...) {
  if (!requireNamespace("brms", quietly = TRUE)) {
    stop("Package 'brms' required for this function to work. Please install it by running `install.packages('brms')`.")
  }

  data <- brms::nuts_params(posteriors)
  data$idvar <- paste0(data$Chain, "_", data$Iteration)
  out <- reshape(data, v.names = "Value", idvar = "idvar", timevar = "Parameter", direction = "wide")
  out$idvar <- NULL
  out <- merge(out, brms::log_posterior(posteriors), by = c("Chain", "Iteration"), sort = FALSE)

  # Rename
  names(out)[names(out) == "Value.accept_stat__"] <- "Acceptance_Rate"
  names(out)[names(out) == "Value.treedepth__"] <- "Tree_Depth"
  names(out)[names(out) == "Value.stepsize__"] <- "Step_Size"
  names(out)[names(out) == "Value.divergent__"] <- "Divergent"
  names(out)[names(out) == "Value.n_leapfrog__"] <- "n_Leapfrog"
  names(out)[names(out) == "Value.energy__"] <- "Energy"
  names(out)[names(out) == "Value"] <- "LogPosterior"

  out
}
back to top