#' @title Create BayesTools ensemble summary tables
#'
#' @description Creates estimate summaries based on posterior
#' distributions created by [mix_posteriors], inference summaries
#' based on inference created by [ensemble_inference], or ensemble
#' summary/diagnostics based on a list of [models_inference] models
#' (or [marginal_inference] in case of [marginal_estimates_table]).
#'
#' @param samples posterior samples created by [mix_posteriors]
#' @param inference model inference created by [ensemble_inference]
#' @param parameters character vector of parameters (or a
#' named list with of character vectors for summary and
#' diagnostics tables) specifying the parameters
#' (and their grouping) for the summary table
#' @param models list of [models_inference] model objects,
#' each of which containing a list of \code{priors}
#' and \code{inference} object, The \code{inference} must be a
#' named list with information about the model: model number
#' \code{m_number}, marginal likelihood \code{marglik}, prior and
#' posterior probability \code{prior_prob} and \code{post_prob},
#' inclusion Bayes factor \code{inclusion_BF}, and fit summary
#' generated by [runjags_estimates_table] for the diagnostics
#' table
#' @param probs quantiles for parameter estimates
#' @param logBF whether the Bayes factor should be on log scale
#' @param BF01 whether the Bayes factor should be inverted
#' @param short_name whether the prior distribution names should be
#' shortened. Defaults to \code{FALSE}.
#' @param remove_spike_0 whether prior distributions equal to spike
#' at 0 should be removed from the \code{prior_list}
#' @param transform_factors whether factors with orthonormal/meandif
#' prior distribution should be transformed to differences from the
#' grand mean
#' @param transform_orthonormal (to be depreciated) whether factors
#' with orthonormal prior distributions should be transformed to
#' differences from the grand mean
#' @param transform_scaled whether coefficients from standardized
#' continuous predictors should be transformed back to the original
#' scale. Defaults to \code{FALSE}.
#' @param formula_scale named list containing standardization information
#' (mean and sd) for each standardized predictor. Required when
#' \code{transform_scaled = TRUE} for ensemble/marginal tables. For
#' \code{runjags_estimates_table}, this is automatically extracted from
#' the fit object's \code{formula_scale} attribute.
#' @param title title to be added to the table
#' @param footnotes footnotes to be added to the table
#' @param warnings warnings to be added to the table
#' @param formula_prefix whether the parameter prefix from formula should
#' be printed. Defaults to \code{TRUE}.
#'
#'
#' @return \code{ensemble_estimates_table} returns a table with the
#' model-averaged estimates, \code{ensemble_inference_table} returns
#' a table with the prior and posterior probabilities and inclusion
#' Bayes factors, \code{ensemble_summary_table} returns a table with
#' overview of the models included in the ensemble, and
#' \code{ensemble_diagnostics_table} returns an overview of the MCMC
#' diagnostics for the models included in the ensemble. All of the
#' tables are objects of class 'BayesTools_table'.
#'
#' @export ensemble_estimates_table
#' @export ensemble_inference_table
#' @export ensemble_summary_table
#' @export ensemble_diagnostics_table
#' @export ensemble_estimates_empty_table
#' @export ensemble_inference_empty_table
#' @export ensemble_summary_empty_table
#' @export ensemble_diagnostics_empty_table
#' @export marginal_estimates_table
#' @name BayesTools_ensemble_tables
#'
#' @seealso [ensemble_inference] [mix_posteriors] [BayesTools_model_tables]
NULL

#' @rdname BayesTools_ensemble_tables
ensemble_estimates_table <- function(samples, parameters, probs = c(0.025, 0.975), title = NULL, footnotes = NULL, warnings = NULL, transform_factors = FALSE, transform_orthonormal = FALSE, formula_prefix = TRUE, transform_scaled = FALSE, formula_scale = NULL){

  # check input
  check_char(parameters, "parameters", check_length = 0)
  check_list(samples, "samples", check_names = parameters, all_objects = TRUE, allow_other = TRUE)
  check_real(probs, "probs", lower = 0, upper = 1, check_length = 0, allow_NULL = TRUE)
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(transform_factors, "transform_factors")
  check_bool(transform_orthonormal, "transform_orthonormal")
  check_bool(formula_prefix, "formula_prefix")
  check_bool(transform_scaled, "transform_scaled")
  check_list(formula_scale, "formula_scale", allow_NULL = TRUE)

  # depreciate
  transform_factors <- .depreciate.transform_orthonormal(transform_orthonormal, transform_factors)


  # transform scaled coefficients back to original scale
  if(transform_scaled && !is.null(formula_scale) && length(formula_scale) > 0){
    samples <- .transform_scale_samples_list(samples, formula_scale)
  }

  # transform meandif/orthonormal posterior
  if(transform_factors){
    samples <- transform_factor_samples(samples)
  }


  # extract values
  estimates_table <- NULL
  for(parameter in parameters){

    if(is.matrix(samples[[parameter]])){

      par_summary <- cbind(
        "Mean"   = apply(samples[[parameter]], 2, mean),
        "Median" = apply(samples[[parameter]], 2, stats::median)
      )
      for(i in seq_along(probs)){
        par_summary <- cbind(par_summary, apply(samples[[parameter]], 2, stats::quantile, probs = probs[i]))
        colnames(par_summary)[ncol(par_summary)] <- probs[i]
      }

      if(inherits(samples[[parameter]], "mixed_posteriors.formula")){
        parameter_name <- format_parameter_names(colnames(samples[[parameter]]), formula_parameters = attr(samples[[parameter]], "formula_parameter"), formula_prefix = formula_prefix, formula_scale = formula_scale)
      }else{
        parameter_name <- colnames(samples[[parameter]])
      }

      rownames(par_summary) <- parameter_name
      estimates_table       <- rbind(estimates_table, par_summary)

    }else if(is.numeric(samples[[parameter]])){

      par_summary <- c(
        "Mean"   = mean(samples[[parameter]]),
        "Median" = stats::median((samples[[parameter]]))
      )
      for(i in seq_along(probs)){
        par_summary <- c(par_summary, stats::quantile(samples[[parameter]], probs = probs[i]))
        names(par_summary)[length(par_summary)] <- probs[i]
      }
      estimates_table <- rbind(estimates_table, par_summary)

      if(inherits(samples[[parameter]], "mixed_posteriors.formula")){
        parameter_name <- gsub(
          paste0(attr(samples[[parameter]], "formula_parameter"), "_"),
          if(formula_prefix) paste0("(", attr(samples[[parameter]], "formula_parameter"), ") ") else "",
          parameter)
        parameter_name <- gsub("__xXx__", ":", parameter_name)
      }else{
        parameter_name <- parameter
      }

      rownames(estimates_table)[nrow(estimates_table)] <- parameter_name


    }else{
      stop("Uknown parameter type.")
    }
  }

  # prepare output
  estimates_table                    <- data.frame(estimates_table)
  colnames(estimates_table)          <- gsub("X", "", colnames(estimates_table))
  class(estimates_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(estimates_table))
  attr(estimates_table, "type")      <- rep("estimate", ncol(estimates_table))
  attr(estimates_table, "rownames")  <- TRUE
  attr(estimates_table, "title")     <- title
  attr(estimates_table, "footnotes") <- footnotes
  attr(estimates_table, "warnings")  <- warnings

  return(estimates_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_inference_table <- function(inference, parameters, logBF = FALSE, BF01 = FALSE, title = NULL, footnotes = NULL, warnings = NULL){

  # check input
  check_char(parameters, "parameters", check_length = 0)
  check_list(inference, "inference", check_names = parameters, all_objects = TRUE, allow_other = TRUE)
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  if(attr(inference,"conditional"))
    stop("The inference object cannot be 'conditional'.")

  # extract values
  inference_table <- NULL
  n_models        <- NULL
  for(parameter in parameters){
    inference_table <- rbind(inference_table, c(
      "models"       = sum(!attr(inference[[parameter]], "is_null")),
      "prior_prob"   = sum(inference[[parameter]][["prior_probs"]][!attr(inference[[parameter]], "is_null")]),
      "post_prob"    = sum(inference[[parameter]][["post_probs"]][!attr(inference[[parameter]], "is_null")] ),
      "inclusion_BF" = inference[[parameter]][["BF"]]
    ))
    rownames(inference_table)[nrow(inference_table)] <- attr(inference[[parameter]], "parameter_name")
    n_models <- c(n_models, length(attr(inference[[parameter]], "is_null")))
  }
  inference_table <- data.frame(inference_table)

  # format BF
  inference_table[,"inclusion_BF"]  <- format_BF(inference_table[,"inclusion_BF"], logBF = logBF, BF01 = BF01, inclusion = TRUE)

  # prepare output
  class(inference_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(inference_table))
  attr(inference_table, "type")      <- c("n_models", "prior_prob", "post_prob", "inclusion_BF")
  attr(inference_table, "rownames")  <- TRUE
  attr(inference_table, "n_models")  <- n_models
  attr(inference_table, "title")     <- title
  attr(inference_table, "footnotes") <- footnotes
  attr(inference_table, "warnings")  <- warnings

  return(inference_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_summary_table <- function(models, parameters, logBF = FALSE, BF01 = FALSE, title = NULL, footnotes = NULL, warnings = NULL,
                                   remove_spike_0 = TRUE, short_name = FALSE){

  # check input
  check_list(models, "models")
  for(i in seq_along(models)){
    model <- models[[i]]
    check_list(model, "model", check_names = "inference", allow_other = TRUE, all_objects = TRUE)
    prior_list <- attr(model[["fit"]], "prior_list")
    check_list(prior_list, "model:priors")
    if(!all(sapply(prior_list, is.prior)))
      stop("'model:priors' must be a list of priors.")
    model_inference <- model[["inference"]]
    check_list(model_inference, "model:inference", check_names = c("m_number", "marglik", "prior_prob", "post_prob", "inclusion_BF"), allow_other = TRUE, all_objects = TRUE)
    check_int(model_inference[["m_number"]],      "model_inference:model_number")
    check_real(model_inference[["marglik"]],      "model_inference:marglik")
    check_real(model_inference[["prior_prob"]],   "model_inference:prior_prob",   lower = 0, upper = 1)
    check_real(model_inference[["post_prob"]],    "model_inference:post_prob",   lower = 0, upper = 1)
    check_real(model_inference[["inclusion_BF"]], "model_inference:inclusion_BF", lower = 0)
  }
  if(is.list(parameters)){
    check_list(parameters, "parameters")
    check_char(names(parameters), "names(parameters)", check_length = FALSE, allow_NULL = length(parameters) == 0)
    sapply(parameters, check_char, name = "parameters", check_length = FALSE)
  }else{
    check_char(parameters, "parameters", check_length = FALSE)
    if(is.null(names(parameters))){
      names(parameters) <- parameters
    }
  }
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(short_name, "short_name")


  # create the output
  ensemble_table <- .ensemble_table_foundation(models, parameters, remove_spike_0, short_name)

  ensemble_table <- cbind(
    ensemble_table,
    "prior_prob"   = sapply(models, function(model)model[["inference"]][["prior_prob"]]),
    "marglik"      = sapply(models, function(model)model[["inference"]][["marglik"]]),
    "post_prob"    = sapply(models, function(model)model[["inference"]][["post_prob"]]),
    "inclusion_BF" = sapply(models, function(model)model[["inference"]][["inclusion_BF"]])
  )

  ensemble_table[,"inclusion_BF"]  <- format_BF(ensemble_table[,"inclusion_BF"], logBF = logBF, BF01 = BF01, inclusion = TRUE)

  # prepare output
  class(ensemble_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(ensemble_table))
  attr(ensemble_table, "type")      <- c("integer", rep("prior", length(parameters)), "prior_prob", "marglik", "post_prob", "inclusion_BF")
  attr(ensemble_table, "rownames")  <- FALSE
  attr(ensemble_table, "title")     <- title
  attr(ensemble_table, "footnotes") <- footnotes
  attr(ensemble_table, "warnings")  <- warnings

  return(ensemble_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_diagnostics_table <- function(models, parameters, title = NULL, footnotes = NULL, warnings = NULL, remove_spike_0 = TRUE, short_name = FALSE){

  # check input
  check_list(models, "models")
  for(i in seq_along(models)){
    model <- models[[i]]
    check_list(model, "model", check_names = c("fit_summary", "inference"), allow_other = TRUE, all_objects = TRUE)
    prior_list <- attr(model[["fit"]], "prior_list")
    check_list(prior_list, "model:priors")
    if(!all(sapply(prior_list, is.prior)))
      stop("'model:priors' must be a list of priors.")
    if(!is.null(model[["fit_summary"]]) && !(inherits(model[["fit_summary"]], "BayesTools_runjags_summary") || inherits(model[["fit_summary"]], "BayesTools_stan_summary")))
      stop("'fit_summary' must be a runjags or rstan summary generated by 'JAGS_estimates_table()' / 'stan_estimates_table()'.")
    model_inference <- model[["inference"]]
    check_list(model_inference, "model:inference", check_names = "m_number", allow_other = TRUE, all_objects = TRUE)
    check_int(model_inference[["m_number"]], "model_inference:model_number")
  }
  if(is.list(parameters)){
    check_list(parameters, "parameters")
    check_char(names(parameters), "names(parameters)", check_length = FALSE, allow_NULL = length(parameters) == 0)
    sapply(parameters, check_char, name = "parameters", check_length = FALSE)
  }else{
    check_char(parameters, "parameters", check_length = FALSE)
    if(is.null(names(parameters))){
      names(parameters) <- parameters
    }
  }
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(short_name, "short_name")

  # create the output
  ensemble_table <- .ensemble_table_foundation(models, parameters, remove_spike_0, short_name)

  ensemble_table <- cbind(
    ensemble_table,
    "max_MCMC_error"    = sapply(models, function(model){
      .max_or_na(.fit_summary_column(model[["fit_summary"]], "MCMC_error"))
    }),
    "max_MCMC_SD_error" = sapply(models, function(model){
      .max_or_na(.fit_summary_column(model[["fit_summary"]], "MCMC_SD_error"))
    }),
    "min_ESS"     = sapply(models, function(model){
      .min_or_na(.fit_summary_column(model[["fit_summary"]], "ESS"))
    }),
    "max_R_hat"   = sapply(models, function(model){
      .max_or_na(.fit_summary_column(model[["fit_summary"]], "R_hat"))
    })
  )

  # prepare output
  class(ensemble_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(ensemble_table))
  attr(ensemble_table, "type")      <- c("integer", rep("prior", length(parameters)), "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")
  attr(ensemble_table, "rownames")  <- FALSE
  attr(ensemble_table, "title")     <- title
  attr(ensemble_table, "footnotes") <- footnotes
  attr(ensemble_table, "warnings")  <- warnings

  return(ensemble_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_estimates_empty_table   <- function(probs = c(0.025, 0.975), title = NULL, footnotes = NULL, warnings = NULL){

  empty_table <- data.frame(matrix(nrow = 0, ncol = 2 + length(probs)))
  colnames(empty_table) <- c("Mean", "Median", probs)

  class(empty_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(empty_table))
  attr(empty_table, "type")      <- rep("estimate", ncol(empty_table))
  attr(empty_table, "rownames")  <- TRUE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_inference_empty_table   <- function(title = NULL, footnotes = NULL, warnings = NULL){

  empty_table <- data.frame(matrix(nrow = 0, ncol = 4))
  colnames(empty_table) <- c("models", "prior_prob", "post_prob", "inclusion_BF")

  class(empty_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(empty_table))
  attr(empty_table, "type")      <- c("n_models", "prior_prob", "post_prob", "inclusion_BF")
  attr(empty_table, "rownames")  <- TRUE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_summary_empty_table     <- function(title = NULL, footnotes = NULL, warnings = NULL){

  empty_table <- data.frame(matrix(nrow = 0, ncol = 5))
  colnames(empty_table) <- c("Model", "prior_prob", "marglik", "post_prob", "inclusion_BF")

  # prepare output
  class(empty_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(empty_table))
  attr(empty_table, "type")      <- c("integer", "prior_prob", "marglik", "post_prob", "inclusion_BF")
  attr(empty_table, "rownames")  <- FALSE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_ensemble_tables
ensemble_diagnostics_empty_table <- function(title = NULL, footnotes = NULL, warnings = NULL){

  empty_table <- data.frame(matrix(nrow = 0, ncol = 5))
  colnames(empty_table) <- c("Model", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")

  # prepare output
  class(empty_table)             <- c("BayesTools_table", "BayesTools_ensemble_summary", class(empty_table))
  attr(empty_table, "type")      <- c("integer", "max_MCMC_error", "max_MCMC_SD_error", "min_ESS", "max_R_hat")
  attr(empty_table, "rownames")  <- FALSE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_ensemble_tables
marginal_estimates_table <- function(samples, inference, parameters, probs = c(0.025, 0.5, 0.975), logBF = FALSE, BF01 = FALSE, title = NULL, footnotes = NULL, warnings = NULL, formula_prefix = TRUE, transform_scaled = FALSE, formula_scale = NULL){

  # check input
  check_char(parameters, "parameters", check_length = 0)
  check_list(samples, "samples", check_names = parameters, all_objects = TRUE, allow_other = TRUE)
  check_list(inference, "inference", check_names = parameters, all_objects = TRUE, allow_other = TRUE)
  check_real(probs, "probs", lower = 0, upper = 1, check_length = 0, allow_NULL = TRUE)
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(formula_prefix, "formula_prefix")
  check_bool(transform_scaled, "transform_scaled")
  check_list(formula_scale, "formula_scale", allow_NULL = TRUE)

  # transform scaled coefficients back to original scale
  if(transform_scaled && !is.null(formula_scale) && length(formula_scale) > 0){
    samples <- .transform_scale_samples_list(samples, formula_scale)
  }


  # extract values
  estimates_table <- NULL
  for(parameter in parameters){

    # extract the relevant information
    if(is.list(samples[[parameter]]) && length(samples[[parameter]]) > 1){
      temp_samples  <- .marginal_posterior_parameter_samples(samples, parameter)
      temp_BF       <- do.call(c, inference[[parameter]])
      temp_warnings <- do.call(c, lapply(names(inference[[parameter]]), function(lvl) {
        if(is.null(attr(inference[[parameter]][[lvl]], "warnings"))){
          return()
        }else{
          paste0("[", lvl, "]: ", attr(inference[[parameter]][[lvl]], "warnings"))
        }
      }))
    }else{
      temp_samples  <- .marginal_posterior_parameter_samples(samples, parameter)
      temp_BF       <- inference[[parameter]][[1]]
      if(is.null(attr(inference[[parameter]][[1]], "warnings"))){
        temp_warnings <- NULL
      }else{
        temp_warnings <- paste0(if(names(inference[[parameter]]) != "intercept") paste0("[", names(inference[[parameter]]), "]: ") else ": ", attr(inference[[parameter]][[1]], "warnings"))
      }
    }

    # add estimates
    par_summary <- cbind(
      "Mean" = vapply(temp_samples, mean, numeric(1)),
      "SD"   = vapply(temp_samples, stats::sd, numeric(1))
    )
    for(i in seq_along(probs)){
      par_summary <- cbind(par_summary, vapply(temp_samples, stats::quantile, numeric(1), probs = probs[i]))
      colnames(par_summary)[ncol(par_summary)] <- probs[i]
    }

    # add BF
    par_summary <- cbind(par_summary, "inclusion_BF" = temp_BF)


    # format parameter names
    if(inherits(samples[[parameter]], "marginal_posterior.formula")){
      if(length(names(samples[[parameter]])) == 1 && names(samples[[parameter]]) == "intercept"){
        parameter_name <- parameter
      }else{
        parameter_name <- paste0(parameter, "[", names(samples[[parameter]]), "]")
      }
      parameter_name <- format_parameter_names(parameter_name, formula_parameters = attr(samples[[parameter]], "formula_parameter"), formula_prefix = formula_prefix, formula_scale = formula_scale)
    }else{
      parameter_name <- paste0(parameter, "[", names(samples[[parameter]]), "]")
    }

    rownames(par_summary) <- parameter_name
    estimates_table       <- rbind(estimates_table, par_summary)

    # add warnings
    if(!is.null(temp_warnings)){
      warnings <- c(warnings, paste0(parameter, temp_warnings))
    }
  }

  # prepare output
  estimates_table                    <- data.frame(estimates_table)
  colnames(estimates_table)          <- gsub("X", "", colnames(estimates_table))
  estimates_table[,"inclusion_BF"]   <- format_BF(estimates_table[,"inclusion_BF"], logBF = logBF, BF01 = BF01, inclusion = TRUE)
  class(estimates_table)             <- c("BayesTools_table", "BayesTools_marginal_estimates", class(estimates_table))
  attr(estimates_table, "type")      <- c(rep("estimate", ncol(estimates_table) - 1), "inclusion_BF")
  attr(estimates_table, "rownames")  <- TRUE
  attr(estimates_table, "title")     <- title
  attr(estimates_table, "footnotes") <- footnotes
  attr(estimates_table, "warnings")  <- warnings

  return(estimates_table)
}



.ensemble_table_foundation <- function(models, parameters, remove_spike_0, short_name){

  model_rows <- list()
  for(i in seq_along(models)){

    model_row <- list()
    model_row[["Model"]] <- models[[i]][["inference"]][["m_number"]]

    temp_prior_list <- attr(models[[i]][["fit"]], "prior_list")

    for(p in seq_along(parameters)){
      if(is.list(parameters)){
        if(sum(names(temp_prior_list) %in% parameters[[p]]) == 1){
          temp_prior <- temp_prior_list[[parameters[[p]][parameters[[p]] %in% names(temp_prior_list)]]]
        }else if(sum(names(temp_prior_list) %in% parameters[[p]]) == 0){
          temp_prior <- prior_none()
        }else{
          stop("More than one prior matching the specified grouping.")
        }
      }else{
        if(any(names(temp_prior_list) == parameters[p])){
          temp_prior <- temp_prior_list[[parameters[p]]]
        }else{
          temp_prior <- prior_none()
        }
      }
      if(remove_spike_0 && is.prior.point(temp_prior) && temp_prior[["parameters"]][["location"]] == 0){
        model_row[[names(parameters)[p]]] <- ""
      }else if(is.prior.none(temp_prior)){
        model_row[[names(parameters)[p]]] <- ""
      }else{
        model_row[[names(parameters)[p]]] <- print(temp_prior, silent = TRUE, short_name = short_name)
      }
    }
    model_rows[[i]] <- model_row
  }

  summary_table <- data.frame(do.call(rbind, model_rows))
  for(i in 1:ncol(summary_table)){
    summary_table[,i] <- unlist(summary_table[,i])
  }

  colnames(summary_table) <- c("Model", names(parameters))

  parameters <- unlist(parameters) # deal with potential matching of multiple parameters withing a name
  for(p in seq_along(parameters)){

    parameter_name    <- parameters[p]
    formula_parameter <- unique(unlist(lapply(models, function(m) attr(attr(m[["fit"]], "prior_list")[[parameter_name]], "parameter"))))

    if(!is.null(unlist(formula_parameter))){
      parameter_name <- gsub(paste0(formula_parameter, "_"), paste0("(", formula_parameter, ") "), parameter_name)
      parameter_name <- gsub("__xXx__", ":", parameter_name)

      colnames(summary_table)[colnames(summary_table) == parameters[p]] <- parameter_name
    }
  }

  return(summary_table)
}
.fit_summary_column <- function(fit_summary, column){

  if(is.null(fit_summary) || !column %in% colnames(fit_summary)){
    return(NA_real_)
  }

  fit_summary[, column]
}
.max_or_na <- function(x){

  if(length(x) == 0 || all(is.na(x))){
    return(NA_real_)
  }

  max(x, na.rm = TRUE)
}
.min_or_na <- function(x){

  if(length(x) == 0 || all(is.na(x))){
    return(NA_real_)
  }

  min(x, na.rm = TRUE)
}


#' @title Create BayesTools model tables
#'
#' @description Creates model summary based on a model objects or
#' provides estimates table for a runjags fit.
#'
#' @param model model object containing a list of \code{priors}
#' and \code{inference} object, The \code{inference} must be a
#' named list with information about the model: model number
#' \code{m_number}, marginal likelihood \code{marglik}, prior and
#' posterior probability \code{prior_prob} and \code{post_prob},
#' and model inclusion Bayes factor \code{inclusion_BF}
#' @param fit runjags model fit
#' @param conditional summarizes estimates conditional on being included
#' in the model for spike and slab priors. Defaults to \code{FALSE}.
#' @param transformations named list of transformations to be applied
#' to specific parameters
#' @param model_description named list with additional description
#' to be added to the table
#' @param remove_inclusion whether estimates of the inclusion probabilities
#' should be excluded from the summary table. Defaults to \code{FALSE}.
#' @param remove_parameters parameters to be removed from the summary.
#' Can be \code{NULL} (default, no removal), a character vector of parameter
#' names to remove, or \code{TRUE} to remove all parameters that are not
#' part of any formula.
#' @param remove_formulas character vector of formula names whose parameters
#' should be removed from the summary. Defaults to \code{NULL}.
#' @param keep_parameters character vector of parameter names to keep.
#' All other parameters will be removed unless they belong to formulas
#' specified in \code{keep_formulas}. Defaults to \code{NULL}.
#' @param keep_formulas character vector of formula names whose parameters
#' should be kept. All other parameters will be removed unless they are
#' specified in \code{keep_parameters}. Defaults to \code{NULL}.
#' @param return_samples whether to return the transoformed and formated samples
#' instead of the table. Defaults to \code{FALSE}.
#' @param remove_diagnostics whether to exclude MCMC diagnostics (MCMC error,
#' ESS, R-hat) from the output table. Defaults to \code{FALSE}. Setting to
#' \code{TRUE} will exclude diagnostics columns regardless of the
#' \code{conditional} setting.
#' @param diagnostic_columns MCMC diagnostic columns to display in JAGS
#' estimates tables. Can be \code{"all"}, \code{"none"}, \code{TRUE},
#' \code{FALSE}, or a character vector containing any subset of
#' \code{"MCMC_error"}, \code{"MCMC_SD_error"}, \code{"ESS"}, and
#' \code{"R_hat"}. Defaults to the
#' \code{BayesTools.JAGS_estimates_diagnostic_columns} option, or all
#' diagnostics unless \code{remove_diagnostics = TRUE}.
#' @param BF_diagnostics whether to add MCMC diagnostics for Bayes factors
#' computed from model indicator frequencies. The Bayes factor error is
#' reported as a relative Monte Carlo standard error percentage. Defaults to
#' \code{FALSE}.
#' @param BF_diagnostic_columns MCMC diagnostic columns to display in JAGS
#' inclusion Bayes factor tables. Can be \code{"all"}, \code{"none"},
#' \code{TRUE}, \code{FALSE}, or a character vector containing any subset of
#' \code{"ESS"}, \code{"MCMC_error"}, and \code{"BF_error_percent"}.
#' Defaults to the \code{BayesTools.JAGS_BF_diagnostic_columns} option, or all
#' diagnostics when \code{BF_diagnostics = TRUE} and none otherwise.
#' @inheritParams BayesTools_ensemble_tables
#'
#'
#' @return \code{model_summary_table} returns a table with
#' overview of the fitted model, \code{runjags_estimates_table} returns
#' a table with MCMC estimates, and \code{runjags_estimates_empty_table}
#' returns an empty estimates table. All of the tables are objects of
#' class 'BayesTools_table'.
#'
#' @details For product-space JAGS inclusion Bayes factors, posterior
#' inclusion probabilities of exactly 0 or 1 cannot produce a finite
#' point estimate of the model odds ratio. In that case, inclusion BFs
#' marked with \code{"<"} or \code{">"} are finite-sample bounds: posterior
#' inclusion probabilities of 0 or 1 were replaced by \code{1/S} or
#' \code{(S - 1)/S}, where \code{S} is the number of posterior samples.
#' This is a reporting convention, not an unbiased finite Bayes-factor
#' estimate. If the prior inclusion probability is exactly 0 or 1, the
#' inclusion Bayes factor is undefined and reported as \code{NA}, because
#' the corresponding inclusion/exclusion comparison was not tested.
#'
#' @export JAGS_summary_table
#' @export JAGS_estimates_table
#' @export JAGS_inference_table
#' @export model_summary_table
#' @export runjags_estimates_table
#' @export runjags_inference_table
#' @export model_summary_empty_table
#' @export JAGS_inference_empty_table
#' @export JAGS_estimates_empty_table
#' @export runjags_estimates_empty_table
#' @export runjags_inference_empty_table
#' @export stan_estimates_table
#' @name BayesTools_model_tables
#'
#' @seealso [BayesTools_ensemble_tables]
NULL

#' @rdname BayesTools_model_tables
model_summary_table <- function(model, model_description = NULL, title = NULL, footnotes = NULL, warnings = NULL,
                                remove_spike_0 = TRUE, short_name = FALSE, formula_prefix = TRUE, remove_parameters = NULL){

  # check input
  check_list(model, "model", check_names = "inference", allow_other = TRUE, all_objects = TRUE)
  prior_list <- attr(model[["fit"]], "prior_list")
  check_list(prior_list, "model:priors")
  if(!all(sapply(prior_list, is.prior)))
    stop("'model:priors' must be a list of priors.")
  model_inference <- model[["inference"]]
  check_list(model_inference, "model:inference", check_names = c("m_number", "marglik", "prior_prob", "post_prob", "inclusion_BF"), allow_other = TRUE, all_objects = TRUE)
  check_int(model_inference[["m_number"]],      "model_inference:model_number")
  check_real(model_inference[["marglik"]],      "model_inference:marglik")
  check_real(model_inference[["prior_prob"]],   "model_inference:prior_prob",   lower = 0, upper = 1)
  check_real(model_inference[["post_prob"]],    "model_inference:post_prob",   lower = 0, upper = 1)
  check_real(model_inference[["inclusion_BF"]], "model_inference:inclusion_BF", lower = 0)
  check_list(model_description, "model_description", allow_NULL = TRUE)
  check_bool(short_name, "short_name")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(formula_prefix, "formula_prefix")
  check_char(remove_parameters, "remove_parameters", allow_NULL = TRUE, check_length = 0)

  # prepare the columns
  summary_names  <- c(
    "Model",
    if(!is.null(model_description)) names(model_description),
    "Prior prob.",
    "log(marglik)",
    "Post. prob.",
    "Inclusion BF")
  summary_values <- c(
    model_inference[["m_number"]],
    if(!is.null(model_description)) unlist(model_description),
    .format_column(model_inference[["prior_prob"]],   "probability"),
    .format_column(model_inference[["marglik"]],      "marglik"),
    .format_column(model_inference[["post_prob"]],    "probability"),
    .format_column(model_inference[["inclusion_BF"]], "BF"))

  summary_priors  <- "Parameter prior distributions"
  for(i in seq_along(prior_list)){
    # get the prior name
    if(is.prior.none(prior_list[[i]])){
      next
    }else if(remove_spike_0 && is.prior.point(prior_list[[i]]) && prior_list[[i]][["parameters"]][["location"]] == 0 || (names(prior_list)[[i]] %in% remove_parameters)){
      next
    }else if(is.prior.weightfunction(prior_list[[i]]) | is.prior.PET(prior_list[[i]]) | is.prior.PEESE(prior_list[[i]]) |
             is_prior_phacking(prior_list[[i]]) | is_prior_bias(prior_list[[i]])){
      temp_prior <- print(prior_list[[i]], silent = TRUE, short_name = short_name)
    }else if(is.prior.simple(prior_list[[i]]) | is.prior.vector(prior_list[[i]]) | is.prior.factor(prior_list[[i]]) | is.prior.spike_and_slab(prior_list[[i]]) | is.prior.mixture(prior_list[[i]])){
      temp_prior <- paste0(names(prior_list)[i], " ~ " , print(prior_list[[i]], silent = TRUE, short_name = short_name, inline = TRUE))
    }else if(is.prior.point(prior_list[[i]])){
      temp_prior <- paste0(names(prior_list)[i], " = " , print(prior_list[[i]], silent = TRUE, short_name = short_name))
    }
    # change the formula formatting
    if(!is.null(attr(prior_list[[i]], "parameter"))){
      temp_prior <- gsub(
        paste0(attr(prior_list[[i]], "parameter"), "_"),
        if(formula_prefix) paste0("(", attr(prior_list[[i]], "parameter"), ") ") else "",
        temp_prior)
      temp_prior <- gsub("__xXx__", ":", temp_prior)
    }
    summary_priors <- c(summary_priors, temp_prior)
  }

  if(length(summary_names) > length(summary_priors)){
    summary_priors <- c(summary_priors, rep("", length(summary_names) - length(summary_priors)))
  }else if(length(summary_names) < length(summary_priors)){
    summary_names  <- c(summary_names,  rep("", length(summary_priors) - length(summary_names)))
    summary_values <- c(summary_values, rep("", length(summary_priors) - length(summary_values)))
  }
  summary_names <- paste0(summary_names, "  ")

  summary_table <- data.frame(cbind(
    summary_names,
    summary_values,
    rep("           ", length(summary_names)),
    summary_priors
  ))
  names(summary_table) <- NULL

  # prepare output
  class(summary_table)             <- c("BayesTools_table", class(summary_table))
  attr(summary_table, "type")      <- c("string_left", "string", "string", "prior")
  attr(summary_table, "rownames")  <- FALSE
  attr(summary_table, "as.matrix") <- TRUE
  attr(summary_table, "title")     <- title
  attr(summary_table, "footnotes") <- footnotes
  attr(summary_table, "warnings")  <- warnings

  return(summary_table)
}

#' @rdname BayesTools_model_tables
runjags_estimates_table  <- function(fit, transformations = NULL, title = NULL, footnotes = NULL, warnings = NULL, conditional = FALSE,
                                     probs = c(0.025, 0.5, 0.975), remove_spike_0 = TRUE, transform_factors = FALSE, transform_orthonormal = FALSE,
                                     formula_prefix = TRUE, remove_inclusion = FALSE, remove_parameters = NULL, remove_formulas = NULL,
                                     keep_parameters = NULL, keep_formulas = NULL, return_samples = FALSE, transform_scaled = FALSE,
                                     remove_diagnostics = FALSE,
                                     diagnostic_columns = getOption("BayesTools.JAGS_estimates_diagnostic_columns", if(remove_diagnostics) "none" else "all")){

  .check_runjags()
  # most of the code is shared with .diagnostics_plot_data function (keep them in sync on update)

  # check fits
  if(!inherits(fit, "runjags"))
    stop("'fit' must be a runjags fit")
  if(!inherits(fit, "BayesTools_fit"))
    stop("'fit' must be a BayesTools fit")
  prior_list <- attr(fit, "prior_list")
  check_list(prior_list, "prior_list")
  if(!all(sapply(prior_list, is.prior)))
    stop("'prior_list' must be a list of priors.")
  check_list(transformations, "transformations", allow_NULL = TRUE)
  if(!is.null(transformations) && any(!sapply(transformations, function(trans)is.function(trans[["fun"]]))))
    stop("'transformations' must be list of functions in the 'fun' element.")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_real(probs, "probs", lower = 0, upper = 1, check_length = 0)
  check_bool(remove_spike_0, "remove_spike_0")
  check_bool(conditional, "conditional")
  check_bool(transform_factors, "transform_factors")
  check_bool(transform_orthonormal, "transform_orthonormal")
  check_bool(formula_prefix, "formula_prefix")
  check_bool(transform_scaled, "transform_scaled")
  check_bool(remove_diagnostics, "remove_diagnostics")
  diagnostic_columns <- .normalize_diagnostic_columns(diagnostic_columns, .JAGS_estimates_diagnostic_columns(), "diagnostic_columns")
  if(remove_diagnostics){
    diagnostic_columns <- character()
  }
  summary_diagnostic_columns <- if(conditional) character() else diagnostic_columns
  if(!is.null(remove_parameters) && !is.logical(remove_parameters))
    check_char(remove_parameters, "remove_parameters", allow_NULL = TRUE, check_length = 0)
  if(is.logical(remove_parameters))
    check_bool(remove_parameters, "remove_parameters")
  check_char(remove_formulas, "remove_formulas", allow_NULL = TRUE, check_length = 0)
  check_char(keep_parameters, "keep_parameters", allow_NULL = TRUE, check_length = 0)
  check_char(keep_formulas, "keep_formulas", allow_NULL = TRUE, check_length = 0)

  # depreciate
  transform_factors <- .depreciate.transform_orthonormal(transform_orthonormal, transform_factors)

  # get model samples
  model_samples <- .extract_posterior_samples(fit, as_list = FALSE)

  # transform scaled coefficients back to original scale before filtering. Lower
  # order coefficients can depend on higher-order interaction columns.
  formula_scale <- NULL
  if(transform_scaled){
    formula_scale <- attr(fit, "formula_scale")
    if(!is.null(formula_scale) && length(formula_scale) > 0){
      model_samples <- transform_scale_samples(model_samples, formula_scale)
    }
  }

  ### remove un-wanted estimates (or support values) - spike and slab priors already dealt with later (also remove the item from prior list)
  # compute filtered parameters using the helper function
  remove_params_vec <- .filter_parameters(
    prior_list        = prior_list,
    remove_parameters = remove_parameters,
    remove_formulas   = remove_formulas,
    keep_parameters   = keep_parameters,
    keep_formulas     = keep_formulas,
    remove_spike_0    = remove_spike_0
  )

  cleaned       <- .remove_auxiliary_parameters(model_samples, prior_list, remove_params_vec)
  model_samples <- cleaned$model_samples
  prior_list    <- cleaned$prior_list

  # simplify mixture and spike and slab priors to simple priors
  # the samples and summary can be dealt with as any other prior (i.e., transformations later)
  for(par in names(prior_list)){
    if(is.prior.spike_and_slab(prior_list[[par]])){

      # process spike and slab using helper function
      processed     <- .process_spike_and_slab(model_samples, prior_list, par, conditional, remove_inclusion, warnings)
      model_samples <- processed$model_samples
      prior_list    <- processed$prior_list
      warnings      <- processed$warnings

    }else if(is.prior.mixture(prior_list[[par]])){

      # check for publication bias component
      is_bias_mixture <- inherits(prior_list[[par]], "prior.bias_mixture")
      is_PET          <- sapply(prior_list[[par]], is.prior.PET)
      is_PEESE        <- sapply(prior_list[[par]], is.prior.PEESE)
      if(is_bias_mixture){
        branch_info   <- .selection_prior_branch_info(prior_list[[par]])
        has_selection <- vapply(branch_info, function(x) !is.null(x$selection), logical(1))
        has_phacking  <- vapply(branch_info, function(x) !is.null(x$phacking), logical(1))
      }else{
        branch_info   <- vector("list", length(prior_list[[par]]))
        has_selection <- rep(FALSE, length(prior_list[[par]]))
        has_phacking  <- rep(FALSE, length(prior_list[[par]]))
      }

      # distinguish between null/alternative and component type notations
      components <- attr(prior_list[[par]], "components")

      if(any(is_PET | is_PEESE | has_selection | has_phacking)){

        # change the samples between conditional/averaged based on the preferences
        if(conditional){

          if(any(is_PET)){
            # compute the number of conditional samples
            n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(is_PET))

            # replace null samples with NAs (important for later transformations)
            model_samples[!model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(is_PET), "PET"] <- NA

            # add warnings about conditional summary
            warnings <- c(warnings, .runjags_conditional_warning("PET", n_conditional_samples))
          }

          if(any(is_PEESE)){
            # compute the number of conditional samples
            n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(is_PEESE))

            # replace null samples with NAs (important for later transformations)
            model_samples[!model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(is_PEESE), "PEESE"] <- NA

            # add warnings about conditional summary
            warnings <- c(warnings, .runjags_conditional_warning("PEESE", n_conditional_samples))
          }

          if(any(has_selection)){
            # compute the number of conditional samples
            n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(has_selection))

            # replace null samples with NAs (important for later transformations)
            model_samples[!model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(has_selection), grepl("omega", colnames(model_samples))] <- NA

            # add warnings about conditional summary
            warnings <- c(warnings, .runjags_conditional_warning("omega", n_conditional_samples))
          }

          if(any(has_phacking)){
            # compute the number of conditional samples
            n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(has_phacking))

            # replace non-p-hacking samples with NAs
            phacking_report_columns <- .selection_phacking_report_parameters(lapply(branch_info[has_phacking], function(x) x$phacking))
            phacking_columns <- intersect(c(phacking_report_columns, "phack_kind"), colnames(model_samples))
            if(length(phacking_columns) > 0){
              model_samples[!model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(has_phacking), phacking_columns] <- NA
            }

            # add warnings about conditional summary
            warning_columns <- intersect(phacking_report_columns, phacking_columns)
            if(length(warning_columns) > 0){
              warnings <- c(warnings, .runjags_conditional_warning(warning_columns, n_conditional_samples))
            }
          }

        }

        # re-format the weightfunctions
        if(any(has_selection) || any(has_phacking)){

          # rename
          omega_cuts      <- if(any(has_selection)){
            selection_priors <- lapply(branch_info[has_selection], function(x) x$selection)
            weightfunctions_mapping(selection_priors, cuts_only = TRUE, one_sided = TRUE)
          }else{
            c(0, 1)
          }
          omega_names_old <- paste0("omega[", 1:(length(omega_cuts)-1),"]")
          omega_names     <- sapply(1:(length(omega_cuts)-1), function(i)paste0("omega[",omega_cuts[i],",",omega_cuts[i+1],"]"))
          colnames(model_samples)[which(colnames(model_samples) %in% omega_names_old)] <- omega_names

          # remove if requested
          if("omega" %in% remove_parameters){
            model_samples <- model_samples[,!colnames(model_samples) %in% omega_names,drop=FALSE]
            if(any(has_selection)){
              prior_list[[par]][has_selection] <- NULL
            }
          }
        }

        # add the simpler priors to the prior list
        if(any(is_PET)){
          prior_list[["PET"]] <- prior_list[[par]][is_PET][1]
        }
        if(any(is_PEESE)){
          prior_list[["PEESE"]] <- prior_list[[par]][is_PEESE][1]
        }
        if(any(has_selection)){
          prior_list[["omega"]] <- branch_info[has_selection][[1]]$selection
        }
        if(any(has_phacking)){
          phacking_priors <- lapply(branch_info[has_phacking], function(x) x$phacking)
          drop_phacking <- .selection_phacking_unreported_parameters(phacking_priors)
          model_samples <- model_samples[, !colnames(model_samples) %in% drop_phacking, drop = FALSE]

          phacking_report_columns <- .selection_phacking_report_parameters(phacking_priors)
          for(phacking_report_column in phacking_report_columns){
            prior_list[[phacking_report_column]] <- phacking_priors[[1]]$alpha
          }
        }

      }else{

        # prepare parameter names
        if(inherits(prior_list[[par]], "prior.factor_mixture")){
          par_names <- .JAGS_prior_factor_names(par, prior_list[[par]])
        }else{
          par_names <- par
        }

        # change the samples between conditional/averaged based on the preferences
        if(conditional){

          if(all(components %in% c("null", "alternative"))){

            # select the corresponding indicators
            this_component_indicator <- which(components == "alternative")

            # compute the number of conditional samples
            n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% this_component_indicator)

            # replace null samples with NAs (important for later transformations)
            model_samples[!model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% this_component_indicator, par_names] <- NA

            # add warnings about conditional summary
            warnings <- c(warnings, .runjags_conditional_warning(par_names, n_conditional_samples))

          }else{

            # remove the join samples and replace with individual conditional samples
            temp_position    <- min(which(colnames(model_samples) %in% par))
            temp_all_samples <- model_samples[, colnames(model_samples) %in% par,drop=FALSE]
            temp_new_samples <- list()
            model_samples    <- model_samples[,!colnames(model_samples) %in% par,drop=FALSE]

             # component-by-component replacement
            for(component in unique(components[components != "null"])){

              # create component specific samples
              temp_par_names <- paste0(par_names, "[", component, "]")
              temp_new_samples[[component]]           <- temp_all_samples
              colnames(temp_new_samples[[component]]) <- temp_par_names

              # select the corresponding indicators
              this_component_indicator <- which(components == component)

              # compute the number of conditional samples
              n_conditional_samples <- sum(model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% this_component_indicator)

              # replace null samples with NAs (important for later transformations)
              temp_new_samples[[component]][!model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% this_component_indicator,] <- NA

              # add warnings about conditional summary
              warnings <- c(warnings, .runjags_conditional_warning(temp_par_names, n_conditional_samples))

              # forward transformations to the conditional estimates
              if(!is.null(transformations[[par]])){
                transformations[[temp_par_names]] <- transformations[[par]]
                attr(prior_list[[par]][which(components == component)][1], "parameter") <- attr(prior_list[[par]], "parameter")
                prior_list[[temp_par_names]]      <- prior_list[[par]][which(components == component)][1]
              }
            }

            # place the transformed samples back
            model_samples <- cbind(
              if(temp_position > 1) model_samples[,1:(temp_position-1),drop=FALSE],
              do.call(cbind, temp_new_samples),
              if(temp_position <= ncol(model_samples)) model_samples[,temp_position:ncol(model_samples),drop=FALSE]
            )

            # remove the original parameter transformations
            if(!is.null(transformations[[par]])){
              transformations[[par]] <- NULL
              prior_list[[par]]      <- NULL
            }
          }
        }
      }

      # remove/rename the inclusions probabilities
      if(remove_inclusion){
        model_samples   <- model_samples[,colnames(model_samples) != paste0(par, "_indicator"),drop=FALSE]
      }else{
        if(all(components %in% c("null", "alternative"))){
          # replace and rename in the samples
          model_samples[,colnames(model_samples) == paste0(par, "_indicator")] <- ifelse(
            model_samples[,colnames(model_samples) == paste0(par, "_indicator")] %in% which(components == "alternative"), 1, 0)
          colnames(model_samples)[colnames(model_samples) == paste0(par, "_indicator")] <- paste0(par, " (inclusion)")
        }else{
          # extract
          temp_position <- min(which(colnames(model_samples) %in% paste0(par, "_indicator")))
          temp_samples  <- model_samples[,colnames(model_samples) == paste0(par, "_indicator")]
          model_samples <- model_samples[,colnames(model_samples) != paste0(par, "_indicator"),drop=FALSE]

          # compute component specific indicators
          temp_new_samples <- lapply(unique(components), function(component) ifelse(temp_samples %in% which(components == component), 1, 0))
          temp_new_samples <- do.call(cbind, temp_new_samples)
          colnames(temp_new_samples) <- paste0(par, " (inclusion: ", unique(components),")")

          # place the transformed samples back
          model_samples <- cbind(
            if(temp_position > 1) model_samples[,1:(temp_position-1),drop=FALSE],
            temp_new_samples,
            if(temp_position <= ncol(model_samples)) model_samples[,temp_position:ncol(model_samples),drop=FALSE]
          )
        }
      }
    }
  }

  # remove transformations for removed variables
  if(!is.null(transformations)){
    transformations <-  transformations[names(transformations) %in% names(prior_list)]
  }

  # apply transformations (not orthornormal if they are to be returned transformed to diffs)
  model_samples <- .apply_parameter_transformations(model_samples, transformations, prior_list, transform_factors)

  # transform orthonormal factors to differences from mean
  model_samples <- .transform_factor_contrasts(model_samples, prior_list, transform_factors, transformations)

  # rename factor levels
  model_samples <- .rename_factor_levels(model_samples, prior_list)

  # store parameter names before removing formula attachments
  parameter_names <- colnames(model_samples)

  # rename formula parameters
  if(any(!sapply(lapply(prior_list, attr, which = "parameter"), is.null))){
    colnames(model_samples) <- format_parameter_names(
      parameters         = colnames(model_samples),
      formula_parameters = unique(unlist(lapply(prior_list, attr, which = "parameter"))),
      formula_random     = unique(unlist(lapply(prior_list, attr, which = "random_factor"))),
      formula_prefix     = formula_prefix,
      formula_scale      = if(transform_scaled) formula_scale else NULL)
  }

  # return samples if requested
  if(return_samples){
    attr(model_samples, "prior_list") <- prior_list
    return(model_samples)
  }

  # compute the summary
  if(ncol(model_samples) == 0){
    return(runjags_estimates_empty_table(
      probs              = probs,
      title              = title,
      footnotes          = footnotes,
      warnings           = warnings,
      remove_diagnostics = remove_diagnostics,
      diagnostic_columns = summary_diagnostic_columns
    ))
  }else{
    runjags_summary <- .runjags_summary_fast(
      model_samples       = model_samples,
      n_samples           = fit$sample,
      n_chains            = length(fit$mcmc),
      conditional         = conditional,
      probs               = probs,
      remove_diagnostics  = remove_diagnostics,
      diagnostic_columns  = diagnostic_columns
    )
  }

  # prepare output
  n_estimate_cols <- 2 + length(probs)  # Mean, SD, quantiles
  class(runjags_summary)              <- c("BayesTools_table", "BayesTools_runjags_summary", class(runjags_summary))
  attr(runjags_summary, "type")       <- c(rep("estimate", n_estimate_cols), summary_diagnostic_columns)
  attr(runjags_summary, "parameters") <- parameter_names
  attr(runjags_summary, "rownames")   <- TRUE
  attr(runjags_summary, "title")      <- title
  attr(runjags_summary, "footnotes")  <- footnotes
  attr(runjags_summary, "warnings")   <- warnings

  return(runjags_summary)
}

#' @rdname BayesTools_model_tables
runjags_inference_table  <- function(fit, title = NULL, footnotes = NULL, warnings = NULL, formula_prefix = TRUE,
                                     logBF = FALSE, BF01 = FALSE, BF_diagnostics = FALSE,
                                     BF_diagnostic_columns = getOption("BayesTools.JAGS_BF_diagnostic_columns", if(BF_diagnostics) "all" else "none")){

  # check fits
  if(!inherits(fit, "runjags"))
    stop("'fit' must be a runjags fit")
  if(!inherits(fit, "BayesTools_fit"))
    stop("'fit' must be a BayesTools fit")
  prior_list <- attr(fit, "prior_list")
  check_list(prior_list, "prior_list")
  if(!all(sapply(prior_list, is.prior)))
    stop("'prior_list' must be a list of priors.")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(formula_prefix, "formula_prefix")
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")
  check_bool(BF_diagnostics, "BF_diagnostics")
  BF_diagnostic_columns <- .normalize_diagnostic_columns(BF_diagnostic_columns, .JAGS_BF_diagnostic_columns(), "BF_diagnostic_columns")
  BF_diagnostics        <- length(BF_diagnostic_columns) > 0
  BF_error_diagnostics  <- "BF_error_percent" %in% BF_diagnostic_columns

  # return empty table if none of the priors is spike and slab
  if(!any(sapply(prior_list, function(p) is.prior.spike_and_slab(p) | is.prior.mixture(p)))){
    runjags_summary <- runjags_inference_empty_table(
      title          = title,
      footnotes      = footnotes,
      warnings       = warnings,
      logBF          = logBF,
      BF01           = BF01,
      BF_diagnostics = BF_diagnostics,
      BF_diagnostic_columns = BF_diagnostic_columns
    )
    return(runjags_summary)
  }

  # extract samples
  model_samples   <- .extract_posterior_samples(fit, as_list = FALSE)
  if(BF_diagnostics){
    model_samples_list <- .extract_posterior_samples(fit, as_list = TRUE)
  }else{
    model_samples_list <- NULL
  }
  runjags_summary <- data.frame(matrix(nrow = 0, ncol = 4 + length(BF_diagnostic_columns)))
  colnames(runjags_summary) <- c("Parameter", "prior_prob", "post_prob", "inclusion_BF", BF_diagnostic_columns)
  BF_bound_operators <- character()

  for(par in names(prior_list)){
    if(is.prior.spike_and_slab(prior_list[[par]])){

      temp_prior_prob <- mean(.get_spike_and_slab_inclusion(prior_list[[par]]))
      temp_post_prob  <- mean(model_samples[,paste0(par, "_indicator")])
      temp_BF         <- inclusion_BF(
        prior_probs = c(null = 1 - temp_prior_prob, alternative = temp_prior_prob),
        post_probs  = c(null = 1 - temp_post_prob,  alternative = temp_post_prob),
        is_null     = c(TRUE, FALSE)
      )
      temp_BF_reporting <- .indicator_BF_reporting_value(temp_BF, temp_post_prob, temp_prior_prob, nrow(model_samples))
      temp_row        <- data.frame(
        Parameter    = par,
        prior_prob   = temp_prior_prob,
        post_prob    = temp_post_prob,
        inclusion_BF = temp_BF_reporting$value
      )
      if(BF_diagnostics){
        temp_indicator_list <- .runjags_indicator_list(model_samples_list, paste0(par, "_indicator"), 1)
        temp_diagnostics    <- .indicator_BF_diagnostics(temp_indicator_list, temp_prior_prob, temp_BF)
        temp_row            <- cbind(temp_row, .indicator_BF_diagnostic_row(temp_diagnostics)[, BF_diagnostic_columns, drop = FALSE])
        if(BF_error_diagnostics){
          warnings <- c(warnings, .indicator_BF_warnings(par, temp_diagnostics))
        }
      }

      runjags_summary <- rbind(runjags_summary, temp_row)
      BF_bound_operators <- c(BF_bound_operators, temp_BF_reporting$operator)
    }else if(is.prior.mixture(prior_list[[par]])){

      # extract the components and prior probabilities
      components      <- attr(prior_list[[par]], "components")
      temp_prior_prob <- attr(prior_list[[par]], "prior_weights")
      temp_prior_prob <- sapply(unique(components), function(component) sum(temp_prior_prob[which(components == component)])) / sum(temp_prior_prob)
      temp_post_prob  <- sapply(unique(components), function(component) mean(model_samples[,paste0(par, "_indicator")] %in% which(components == component)))

      # if only null and alternative are specified, removed the null component
      if(all(components %in% c("null", "alternative"))){

        if(all(components == "null")){
          temp_prior_prob <- c(temp_prior_prob, "alternative" = 0)
          temp_post_prob  <- c(temp_post_prob,  "alternative" = 0)
        }
        if(all(components == "alternative")){
          temp_prior_prob <- c("null" = 0, temp_prior_prob)
          temp_post_prob  <- c("null" = 0,  temp_post_prob)
        }

        temp_BF  <- inclusion_BF(prior_probs = temp_prior_prob, post_probs = temp_post_prob, is_null = names(temp_post_prob) != "alternative")
        temp_BF_reporting <- .indicator_BF_reporting_value(temp_BF, temp_post_prob[["alternative"]], temp_prior_prob[["alternative"]], nrow(model_samples))
        temp_row <- data.frame(
          Parameter    = par,
          prior_prob   = temp_prior_prob[["alternative"]],
          post_prob    = temp_post_prob[["alternative"]],
          inclusion_BF = temp_BF_reporting$value
        )
        if(BF_diagnostics){
          temp_indicator_list <- .runjags_indicator_list(model_samples_list, paste0(par, "_indicator"), which(components == "alternative"))
          temp_diagnostics    <- .indicator_BF_diagnostics(temp_indicator_list, temp_prior_prob[["alternative"]], temp_BF)
          temp_row            <- cbind(temp_row, .indicator_BF_diagnostic_row(temp_diagnostics)[, BF_diagnostic_columns, drop = FALSE])
          if(BF_error_diagnostics){
            warnings <- c(warnings, .indicator_BF_warnings(par, temp_diagnostics))
          }
        }

        runjags_summary <- rbind(runjags_summary, temp_row)
        BF_bound_operators <- c(BF_bound_operators, temp_BF_reporting$operator)

      }else{

        # compute summary for each component
        for(component in unique(components)){
          temp_parameter <- paste0(par, " [", component, "]")
          temp_BF        <- inclusion_BF(prior_probs = temp_prior_prob, post_probs = temp_post_prob, is_null = names(temp_post_prob) != component)
          temp_BF_reporting <- .indicator_BF_reporting_value(temp_BF, temp_post_prob[[component]], temp_prior_prob[[component]], nrow(model_samples))
          temp_row       <- data.frame(
            Parameter    = paste0(par, " [", component, "]"),
            prior_prob   = temp_prior_prob[[component]],
            post_prob    = temp_post_prob[[component]],
            inclusion_BF = temp_BF_reporting$value
          )
          if(BF_diagnostics){
            temp_indicator_list <- .runjags_indicator_list(model_samples_list, paste0(par, "_indicator"), which(components == component))
            temp_diagnostics    <- .indicator_BF_diagnostics(temp_indicator_list, temp_prior_prob[[component]], temp_BF)
            temp_row            <- cbind(temp_row, .indicator_BF_diagnostic_row(temp_diagnostics)[, BF_diagnostic_columns, drop = FALSE])
            if(BF_error_diagnostics){
              warnings <- c(warnings, .indicator_BF_warnings(temp_parameter, temp_diagnostics))
            }
          }

          runjags_summary <- rbind(runjags_summary, temp_row)
          BF_bound_operators <- c(BF_bound_operators, temp_BF_reporting$operator)
        }

      }
    }
  }

  # store parameter names before removing formula attachments
  parameter_names           <- runjags_summary$Parameter
  rownames(runjags_summary) <- parameter_names
  runjags_summary           <- runjags_summary[,-1]

  # format BF and BF MC error on the requested scale
  temp_inclusion_BF <- runjags_summary[,"inclusion_BF"]
  attr(temp_inclusion_BF, "bound_operator") <- BF_bound_operators
  runjags_summary[["inclusion_BF"]] <- format_BF(temp_inclusion_BF, logBF = logBF, BF01 = BF01, inclusion = TRUE)
  if("MCMC_error" %in% BF_diagnostic_columns){
    attr(runjags_summary[["MCMC_error"]], "name") <- "error(Post. prob.)"
  }
  if("BF_error_percent" %in% BF_diagnostic_columns){
    attr(runjags_summary[["BF_error_percent"]], "name") <- .BF_error_column_name(BF01)
  }

  # rename formula parameters
  if(any(!sapply(lapply(prior_list, attr, which = "parameter"), is.null))){
    rownames(runjags_summary) <- format_parameter_names(
      parameters         = rownames(runjags_summary),
      formula_parameters = unique(unlist(lapply(prior_list, attr, which = "parameter"))),
      formula_random     = unique(unlist(lapply(prior_list, attr, which = "random_factor"))),
      formula_prefix     = formula_prefix,
      formula_scale      = NULL)
  }

  class(runjags_summary)               <- c("BayesTools_table", "BayesTools_runjags_inference", class(runjags_summary))
  attr(runjags_summary, "type")        <- c("prior_prob", "post_prob", "inclusion_BF", .JAGS_BF_diagnostic_column_types(BF_diagnostic_columns))
  attr(runjags_summary, "parameters")  <- parameter_names
  attr(runjags_summary, "rownames")    <- TRUE
  attr(runjags_summary, "title")       <- title
  attr(runjags_summary, "footnotes")   <- footnotes
  attr(runjags_summary, "warnings")    <- warnings

  return(runjags_summary)
}

#' @rdname BayesTools_model_tables
JAGS_estimates_table <- runjags_estimates_table

#' @rdname BayesTools_model_tables
JAGS_inference_table <- runjags_inference_table

#' @rdname BayesTools_model_tables
JAGS_summary_table   <- model_summary_table

#' @rdname BayesTools_model_tables
model_summary_empty_table <- function(model_description = NULL, title = NULL, footnotes = NULL, warnings = NULL){

  check_list(model_description, "model_description", allow_NULL = TRUE)

  summary_names  <- c(
    "Model",
    if(!is.null(model_description)) names(model_description),
    "Prior prob.",
    "log(marglik)",
    "Post. prob.",
    "Inclusion BF")


  summary_names <- paste0(summary_names, "  ")

  empty_table <- data.frame(cbind(
    summary_names,
    rep("",            length(summary_names)),
    rep("           ", length(summary_names)),
    c("Parameter prior distributions", rep("", length(summary_names) - 1))
  ))
  names(empty_table) <- NULL

  # prepare output
  class(empty_table)             <- c("BayesTools_table", class(empty_table))
  attr(empty_table, "type")      <- c("string_left", "string", "string", "prior")
  attr(empty_table, "rownames")  <- FALSE
  attr(empty_table, "as.matrix") <- TRUE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_model_tables
runjags_estimates_empty_table <- function(probs = c(0.025, 0.5, 0.975), title = NULL, footnotes = NULL, warnings = NULL,
                                          remove_diagnostics = FALSE,
                                          diagnostic_columns = getOption("BayesTools.JAGS_estimates_diagnostic_columns", if(remove_diagnostics) "none" else "all")){

  check_bool(remove_diagnostics, "remove_diagnostics")
  diagnostic_columns <- .normalize_diagnostic_columns(diagnostic_columns, .JAGS_estimates_diagnostic_columns(), "diagnostic_columns")
  if(remove_diagnostics){
    diagnostic_columns <- character()
  }
  n_estimate_cols <- 2 + length(probs)  # Mean, SD, quantiles
  empty_table <- data.frame(matrix(nrow = 0, ncol = n_estimate_cols + length(diagnostic_columns)), check.names = FALSE)
  colnames(empty_table) <- c("Mean", "SD", as.character(probs), diagnostic_columns)

  class(empty_table)             <- c("BayesTools_table", "BayesTools_runjags_summary", class(empty_table))
  attr(empty_table, "type")      <- c(rep("estimate", n_estimate_cols), diagnostic_columns)
  attr(empty_table, "rownames")  <- FALSE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_model_tables
runjags_inference_empty_table <- function(title = NULL, footnotes = NULL, warnings = NULL,
                                          logBF = FALSE, BF01 = FALSE, BF_diagnostics = FALSE,
                                          BF_diagnostic_columns = getOption("BayesTools.JAGS_BF_diagnostic_columns", if(BF_diagnostics) "all" else "none")){

  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")
  check_bool(BF_diagnostics, "BF_diagnostics")
  BF_diagnostic_columns <- .normalize_diagnostic_columns(BF_diagnostic_columns, .JAGS_BF_diagnostic_columns(), "BF_diagnostic_columns")
  BF_diagnostics        <- length(BF_diagnostic_columns) > 0

  empty_table <- data.frame(matrix(nrow = 0, ncol = 3 + length(BF_diagnostic_columns)))
  colnames(empty_table) <- c("prior_prob", "post_prob", "inclusion_BF", BF_diagnostic_columns)
  attr(empty_table[["inclusion_BF"]], "name") <- .BF_column_name(logBF = logBF, BF01 = BF01, inclusion = TRUE)
  if("MCMC_error" %in% BF_diagnostic_columns){
    attr(empty_table[["MCMC_error"]], "name") <- "error(Post. prob.)"
  }
  if("BF_error_percent" %in% BF_diagnostic_columns){
    attr(empty_table[["BF_error_percent"]], "name") <- .BF_error_column_name(BF01)
  }

  class(empty_table)             <- c("BayesTools_table", "BayesTools_runjags_inference", class(empty_table))
  attr(empty_table, "type")      <- c("prior_prob", "post_prob", "inclusion_BF", .JAGS_BF_diagnostic_column_types(BF_diagnostic_columns))
  attr(empty_table, "rownames")  <- FALSE
  attr(empty_table, "title")     <- title
  attr(empty_table, "footnotes") <- footnotes
  attr(empty_table, "warnings")  <- warnings

  return(empty_table)
}

#' @rdname BayesTools_model_tables
JAGS_estimates_empty_table <- runjags_estimates_empty_table

#' @rdname BayesTools_model_tables
JAGS_inference_empty_table <- runjags_inference_empty_table

#' @rdname BayesTools_model_tables
stan_estimates_table  <- function(fit, transformations = NULL, title = NULL, footnotes = NULL, warnings = NULL){

  # this is a simplification of the runjags_estimates_table function for stan
  .check_rstan()

  # check fits
  if(!inherits(fit, "stanfit"))
    stop("'fit' must be a rstan fit")
  prior_list <- attr(fit, "prior_list")
  check_list(prior_list, "prior_list")
  if(!all(sapply(prior_list, is.prior)))
    stop("'prior_list' must be a list of priors.")
  check_list(transformations, "transformations", allow_NULL = TRUE)
  if(!is.null(transformations) && any(!sapply(transformations, function(trans)is.function(trans[["fun"]]))))
    stop("'transformations' must be list of functions in the 'fun' element.")
  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)

  # obtain model information
  stan_summary  <- data.frame(rstan::summary(fit)$summary)
  model_samples <- .extract_stan(fit, drop = FALSE)

  # remove un-wanted columns
  stan_summary <- stan_summary[,!colnames(stan_summary) %in% c("X25.", "X75."), drop = FALSE]

  # remove un-wanted rows
  stan_summary <- stan_summary[-nrow(stan_summary),, drop = FALSE]

  # rename columns to match runjags output
  colnames(stan_summary) <- c("Mean", "MCerr", "SD", "Lower95", "Median", "Upper95", "SSeff", "psrf")

  # add MC.ofSD estimates
  stan_summary[, "MC.ofSD"] <- stan_summary[, "MCerr"] / stan_summary[, "SD"]


  # apply transformations
  if(!is.null(transformations)){
    for(par in names(transformations)){
      model_samples[,par] <- do.call(transformations[[par]][["fun"]], c(list(model_samples[,par]), transformations[[par]][["arg"]]))
      transformed_summary <- .stan_transformed_summary(model_samples[,par], stan_summary[par, "SSeff"])
      stan_summary[par, names(transformed_summary)] <- transformed_summary
      stan_summary[par, "MC.ofSD"] <- stan_summary[par, "MCerr"] / stan_summary[par, "SD"]
    }
  }


  # rename the rest
  colnames(stan_summary)[colnames(stan_summary) == "Lower95"] <- "0.025"
  colnames(stan_summary)[colnames(stan_summary) == "Median"]  <- "0.5"
  colnames(stan_summary)[colnames(stan_summary) == "Upper95"] <- "0.975"
  colnames(stan_summary)[colnames(stan_summary) == "MCerr"]   <- "MCMC_error"
  colnames(stan_summary)[colnames(stan_summary) == "MC.ofSD"] <- "MCMC_SD_error"
  colnames(stan_summary)[colnames(stan_summary) == "SSeff"]   <- "ESS"
  colnames(stan_summary)[colnames(stan_summary) == "psrf"]    <- "R_hat"

  # reorder the columns
  stan_summary <- stan_summary[,c("Mean", "SD", "0.025", "0.5", "0.975", "MCMC_error", "MCMC_SD_error", "ESS", "R_hat"), drop = FALSE]

  # store parameter names
  parameter_names <- rownames(stan_summary)

  # prepare output
  class(stan_summary)              <- c("BayesTools_table", "BayesTools_stan_summary", class(stan_summary))
  attr(stan_summary, "type")       <- c(rep("estimate", 5), "MCMC_error", "MCMC_SD_error", "ESS", "R_hat")
  attr(stan_summary, "parameters") <- parameter_names
  attr(stan_summary, "rownames")   <- TRUE
  attr(stan_summary, "title")      <- title
  attr(stan_summary, "footnotes")  <- footnotes
  attr(stan_summary, "warnings")   <- warnings

  return(stan_summary)
}

.stan_transformed_summary <- function(samples, SSeff){

  samples <- as.numeric(samples)
  qs      <- stats::quantile(samples, probs = c(0.025, 0.5, 0.975), na.rm = TRUE, names = FALSE)
  sd      <- stats::sd(samples, na.rm = TRUE)
  MCerr   <- if(is.finite(SSeff) && SSeff > 0) sd / sqrt(SSeff) else NA_real_

  c(
    "Mean"    = mean(samples, na.rm = TRUE),
    "MCerr"   = MCerr,
    "SD"      = sd,
    "Lower95" = qs[1],
    "Median"  = qs[2],
    "Upper95" = qs[3]
  )
}

#' @title Print a BayesTools table
#'
#' @param x a BayesTools_values_tables
#' @param ... additional arguments.
#'
#' @return \code{print.BayesTools_table} returns \code{NULL}.
#'
#' @exportS3Method
print.BayesTools_table <- function(x, ...){

  # print formatting
  for(i in seq_along(attr(x, "type"))){
    values         <- x[[i]]
    colnames(x)[i] <- .format_column_names(colnames(x)[i], attr(x, "type")[i], values)
    x[[i]]         <- .format_column(values, attr(x, "type")[i], attr(x, "n_models")[i])
  }

  # print title
  if(!is.null(attr(x, "title"))){
    cat(paste0(attr(x, "title"), "\n"))
  }

  # print the table
  print(as.data.frame(x), quote = FALSE, right = TRUE, row.names = attr(x, "rownames"))

  # print footnotes
  for(i in seq_along(attr(x, "footnotes"))){
    cat(paste0(attr(x, "footnotes")[i], "\n"))
  }

  # print warnings in red
  for(i in seq_along(attr(x, "warnings"))){
    cat(paste0("\033[0;31m", attr(x, "warnings")[i], "\033[0m\n"))
  }

  return(invisible())
}

#' @title Format Bayes factor
#'
#' @description Formats Bayes factor
#'
#' @param BF Bayes factor(s)
#' @param logBF log(BF)
#' @param BF01 1/BF
#' @param inclusion whether the Bayes factor is an inclusion BF (for naming purposes)
#'
#' @return \code{format_BF} returns a formatted Bayes factor.
#'
#' @export
format_BF <- function(BF, logBF = FALSE, BF01 = FALSE, inclusion = FALSE){

  if(!is.numeric(BF)){
    check_real(BF, "BF", lower = 0, check_length = FALSE, allow_NA = TRUE)
  }
  BF_names <- names(BF)
  bound_operator <- .standardize_BF_bound_operator(attr(BF, "bound_operator"), length(BF))
  BF <- as.numeric(BF)
  names(BF) <- BF_names
  check_real(BF, "BF", lower = 0, check_length = FALSE, allow_NA = TRUE)
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")

  if(BF01){
    BF   <- 1/BF
    bound_operator <- .invert_BF_bound_operator(bound_operator)
    name <- ifelse(inclusion, "Exclusion BF", "1/BF")
  }else{
    name <- ifelse(inclusion, "Inclusion BF", "BF")
  }

  if(logBF){
    BF   <- log(BF)
    name <- paste0("log(", name, ")")
  }

  attr(BF, "name")  <- name
  attr(BF, "logBF") <- logBF
  attr(BF, "BF01")  <- BF01
  attr(BF, "bound_operator") <- bound_operator
  if(any(!is.na(bound_operator))){
    class(BF) <- unique(c("BayesTools_BF", class(BF)))
  }

  return(BF)
}

#' @exportS3Method
`[.BayesTools_BF` <- function(x, i, ...){

  bound_operator <- attr(x, "bound_operator")
  out <- NextMethod("[")

  attr(out, "name")  <- attr(x, "name")
  attr(out, "logBF") <- attr(x, "logBF")
  attr(out, "BF01")  <- attr(x, "BF01")
  if(!is.null(bound_operator)){
    attr(out, "bound_operator") <- if(missing(i)) bound_operator else bound_operator[i]
  }
  if(any(!is.na(attr(out, "bound_operator")))){
    class(out) <- unique(c("BayesTools_BF", class(out)))
  }

  return(out)
}

#' @exportS3Method
`[.BayesTools_table` <- function(x, i, j, ..., drop = TRUE){

  original_names <- names(x)
  original_col_attributes <- lapply(x, attributes)

  out <- NextMethod("[")
  if(!is.data.frame(out)){
    return(out)
  }

  out_names <- names(out)
  source_cols <- .match_table_columns(out_names, original_names)
  valid_cols  <- !is.na(source_cols)

  if(length(source_cols) > 0 && any(valid_cols)){
    for(k in which(valid_cols)){
      out[[k]] <- .restore_table_column_attributes(out[[k]], original_col_attributes[[source_cols[k]]])
    }
  }

  type <- attr(x, "type")
  if(length(type) == length(original_names)){
    attr(out, "type") <- type[source_cols]
  }

  n_models <- attr(x, "n_models")
  if(length(n_models) == length(original_names)){
    attr(out, "n_models") <- n_models[source_cols]
  }

  selected_parameters <- .subset_table_parameters(x, out)
  if(!is.null(selected_parameters)){
    attr(out, "parameters") <- selected_parameters
  }
  attr(out, "warnings") <- .subset_table_warnings(attr(x, "warnings"), selected_parameters, rownames(out))

  out
}

.BF_column_name <- function(logBF = FALSE, BF01 = FALSE, inclusion = FALSE){

  if(BF01){
    name <- ifelse(inclusion, "Exclusion BF", "1/BF")
  }else{
    name <- ifelse(inclusion, "Inclusion BF", "BF")
  }

  if(logBF){
    name <- paste0("log(", name, ")")
  }

  return(name)
}

.runjags_indicator_list <- function(model_samples_list, indicator_name, indicator_values){

  lapply(model_samples_list, function(samples){
    samples <- as.matrix(samples)
    if(!indicator_name %in% colnames(samples)){
      stop(paste0("The '", indicator_name, "' indicator was not found in the posterior samples."), call. = FALSE)
    }
    as.numeric(samples[, indicator_name] %in% indicator_values)
  })
}

.indicator_MCMC_summary <- function(indicator_list){

  indicator_list <- lapply(indicator_list, as.numeric)
  indicator      <- unlist(indicator_list, use.names = FALSE)

  indicator_mcmc <- coda::as.mcmc.list(lapply(indicator_list, function(x){
    coda::as.mcmc(matrix(x, ncol = 1, dimnames = list(NULL, "indicator")))
  }))

  mcmc_summary <- summary(indicator_mcmc, quantiles = NULL)$statistics
  if(is.null(dim(mcmc_summary))){
    mcmc_summary <- t(mcmc_summary)
  }

  ESS <- coda::effectiveSize(indicator_mcmc)[1]
  if(is.nan(ESS)){
    ESS <- 0
  }

  return(list(
    post_prob       = mean(indicator),
    MCMC_error      = mcmc_summary[1,"Time-series SE"],
    MCMC_SD_error   = mcmc_summary[1,"Time-series SE"] / mcmc_summary[1,"SD"],
    ESS             = ESS,
    visits          = sum(indicator),
    n_samples       = length(indicator)
  ))
}

.indicator_BF_diagnostics <- function(indicator_list, prior_prob, BF){

  diagnostics <- .indicator_MCMC_summary(indicator_list)

  if(diagnostics$post_prob <= 0 || diagnostics$post_prob >= 1 ||
     prior_prob <= 0 || prior_prob >= 1 ||
     !is.finite(BF) || !is.finite(diagnostics$MCMC_error)){
    BF_error_percent <- NA_real_
  }else{
    log_BF_error <- diagnostics$MCMC_error / (diagnostics$post_prob * (1 - diagnostics$post_prob))
    BF_error_percent <- 100 * log_BF_error
  }

  diagnostics$BF_error_percent <- BF_error_percent

  return(diagnostics)
}

.indicator_BF_diagnostic_row <- function(diagnostics){

  data.frame(
    ESS              = diagnostics$ESS,
    MCMC_error       = diagnostics$MCMC_error,
    BF_error_percent = diagnostics$BF_error_percent
  )
}

.indicator_BF_reporting_value <- function(BF, post_prob, prior_prob, n_samples){

  out <- list(value = BF, operator = NA_character_)
  if(length(post_prob) != 1L || length(prior_prob) != 1L || length(n_samples) != 1L){
    return(out)
  }
  if(!is.finite(post_prob) || !is.finite(prior_prob) || !is.finite(n_samples) ||
     prior_prob <= 0 || prior_prob >= 1 || n_samples <= 1){
    return(out)
  }

  prior_odds <- prior_prob / (1 - prior_prob)
  if(post_prob >= 1){
    out$value    <- (n_samples - 1) / prior_odds
    out$operator <- ">"
  }else if(post_prob <= 0){
    out$value    <- 1 / ((n_samples - 1) * prior_odds)
    out$operator <- "<"
  }

  return(out)
}

.indicator_BF_warnings <- function(parameter, diagnostics, severe_limit = 20, warning_limit = 100){

  minority_visits <- min(diagnostics$visits, diagnostics$n_samples - diagnostics$visits)

  if(minority_visits == 0){
    return()
  }else if(minority_visits < severe_limit){
    return(stats::setNames(
      sprintf("Bayes factor MC error for %s is based on only %i posterior samples from the less frequent model.", parameter, minority_visits),
      parameter
    ))
  }else if(minority_visits < warning_limit){
    return(stats::setNames(
      sprintf("Bayes factor MC error for %s is based on %i posterior samples from the less frequent model.", parameter, minority_visits),
      parameter
    ))
  }else{
    return()
  }
}

.BF_error_column_name <- function(BF01 = FALSE){

  "error%(Inclusion BF)"
}

.standardize_BF_bound_operator <- function(operator, n){

  if(is.null(operator)){
    return(rep(NA_character_, n))
  }
  operator <- as.character(operator)
  if(length(operator) != n){
    operator <- rep_len(operator, n)
  }
  operator[!operator %in% c("<", ">")] <- NA_character_

  return(operator)
}

.invert_BF_bound_operator <- function(operator){

  operator <- as.character(operator)
  operator[operator == "<"] <- "TEMP_GT"
  operator[operator == ">"] <- "<"
  operator[operator == "TEMP_GT"] <- ">"

  return(operator)
}

.match_table_columns <- function(output_names, input_names){

  if(length(output_names) == 0){
    return(integer())
  }

  used <- rep(FALSE, length(input_names))
  vapply(output_names, function(output_name){
    matches <- which(input_names == output_name & !used)
    if(length(matches) == 0){
      return(NA_integer_)
    }
    used[matches[1]] <<- TRUE
    matches[1]
  }, integer(1))
}

.restore_table_column_attributes <- function(column, source_attributes){

  source_attributes <- source_attributes[!names(source_attributes) %in% c("names", "dim", "dimnames")]
  for(attribute in names(source_attributes)){
    attr(column, attribute) <- source_attributes[[attribute]]
  }

  column
}

.subset_table_parameters <- function(table, output){

  parameters <- attr(table, "parameters")
  if(is.null(parameters) || length(parameters) != nrow(table)){
    return(NULL)
  }

  row_indices <- match(rownames(output), rownames(table))
  if(any(is.na(row_indices))){
    return(NULL)
  }

  parameters[row_indices]
}

.subset_table_warnings <- function(warnings, selected_parameters = NULL, selected_rows = NULL){

  if(is.null(warnings) || length(warnings) == 0){
    return(warnings)
  }

  warning_names <- names(warnings)
  if(is.null(warning_names)){
    return(warnings)
  }
  warning_names[is.na(warning_names)] <- ""
  if(!any(nzchar(warning_names))){
    return(warnings)
  }

  selected <- unique(c(selected_parameters, selected_rows))
  if(length(selected) == 0){
    return(warnings[!nzchar(warning_names)])
  }

  keep <- !nzchar(warning_names) | warning_names %in% selected
  warnings[keep]
}

.format_BF_column <- function(x){

  out <- format(round(x, digits = 3), nsmall = 3)
  bound_operator <- .standardize_BF_bound_operator(attr(x, "bound_operator"), length(x))
  has_bound <- !is.na(bound_operator) & !is.na(x)
  if(any(has_bound)){
    out[has_bound] <- paste0(bound_operator[has_bound], trimws(out[has_bound]))
  }

  return(out)
}

.copy_BayesTools_table_attributes <- function(new_table, table, type){

  class(new_table)        <- class(table)
  attr(new_table, "type") <- type

  copied_attributes <- setdiff(
    names(attributes(table)),
    c("class", "type", "names", "dim", "dimnames")
  )
  for(a in copied_attributes){
    attr(new_table, a) <- attr(table, a)
  }

  new_table
}

#' @title Adds column to BayesTools table
#'
#' @description Adds column to a BayesTools table while not
#' breaking formatting, attributes, etc...
#'
#' @param table BayesTools table
#' @param column_title title of the new column
#' @param column_values values of the new column
#' @param column_position position of the new column (defaults to \code{NULL} which
#' appends the column to the end)
#' @param column_type type of values of the new column table (important for formatting,
#' defaults to \code{NULL} = the function tries to guess numeric / character based on the
#' \code{column_values} but many more specific types are available)
#'
#' @return returns an object of 'BayesTools_table' class.
#'
#' @export
add_column <- function(table, column_title, column_values, column_position = NULL, column_type = NULL){

  if(!inherits(table, "BayesTools_table"))
    stop("The 'table' must be of class 'BayesTools_table'.")
  check_char(column_title, "column_title")
  if(!(is.vector(column_values) | is.numeric(column_values)) || length(column_values) != nrow(table))
    stop("The 'column_values' must be a vector of the same length as has the table rows.")
  check_int(column_position, "column_position", allow_NULL = TRUE, lower = 0, upper = ncol(table) + 1)
  .check_table_types(column_type, "column_type", allow_NULL = TRUE)

  # fill defaults
  if(is.null(column_position)){
    column_position <- ncol(table) + 1
  }
  if(is.null(column_type)){
    if(all(.is.wholenumber(column_values))){
      column_type <- "integer"
    }else if(is.numeric(column_values)){
      column_type <- "estimate"
    }else if(is.character(column_values)){
      column_type <- "string"
    }else{
      stop("The 'column_type' could not be guessed. Please, supply it manually.")
    }
  }

  before <- if(column_position > 1) seq_len(column_position - 1) else integer(0)
  after  <- if(column_position <= ncol(table)) seq.int(max(column_position, 1L), ncol(table)) else integer(0)

  new_table <- table
  new_table[[ncol(table) + 1L]] <- column_values
  new_table <- new_table[, c(before, ncol(table) + 1L, after), drop = FALSE]

  names(new_table) <- c(
    if(length(before) > 0) colnames(table)[before],
    column_title,
    if(length(after) > 0) colnames(table)[after]
  )

  .copy_BayesTools_table_attributes(new_table, table, c(
    if(length(before) > 0) attr(table, "type")[before],
    column_type,
    if(length(after) > 0) attr(table, "type")[after]
  ))
}

#' @title Removes column to BayesTools table
#'
#' @description Removes column to a BayesTools table while not
#' breaking formatting, attributes, etc...
#'
#' @param table BayesTools table
#' @param column_position position of the to be removed column (defaults to \code{NULL} which
#' removes the last column)
#'
#' @return returns an object of 'BayesTools_table' class.
#'
#' @export
remove_column <- function(table, column_position = NULL){

  if(!inherits(table, "BayesTools_table"))
    stop("The 'table' must be of class 'BayesTools_table'.")
  check_int(column_position, "column_position", allow_NULL = TRUE, lower = 1, upper = ncol(table))

  # fill defaults
  if(is.null(column_position)){
    column_position <- ncol(table)
  }

  keep <- setdiff(seq_len(ncol(table)), column_position)
  new_table <- table[, keep, drop = FALSE]

  # transfer column names
  colnames(new_table) <- colnames(table)[keep]

  .copy_BayesTools_table_attributes(new_table, table, attr(table, "type")[keep])
}

#' @title Updates BayesTools table
#'
#' @description Updates BayesTools table while not breaking formatting, attributes, etc...
#'
#' @param object a BayesTools table
#' @param title title of the table
#' @param footnotes add footnotes to the table
#' @param warnings add warnings of the table
#' @param remove_parameters remove parameters from the table
#' @param logBF whether to format Bayes factors as log(BF)
#' @param BF01 whether to format Bayes factors as 1/BF
#' @param ... additional arguments.
#'
#' @return returns an object of 'BayesTools_table' class.
#' @export
update.BayesTools_table <- function(object, title = NULL, footnotes = NULL, warnings = NULL, remove_parameters = NULL, logBF = FALSE, BF01 = FALSE, ...){

  check_char(title, "title", allow_NULL = TRUE)
  check_char(footnotes, "footnotes", check_length = 0, allow_NULL = TRUE)
  check_char(warnings, "warnings", check_length = 0, allow_NULL = TRUE)
  check_char(remove_parameters, "remove_parameters", check_length = 0, allow_NULL = TRUE)
  check_bool(logBF, "logBF")
  check_bool(BF01,  "BF01")

  if(!is.null(footnotes)){
    attr(object, "footnotes") <- c(attr(object, "footnotes"), footnotes)
  }

  if(!is.null(warnings)){
    attr(object, "warnings")  <- c(attr(object, "warnings"), warnings)
  }

  if(!is.null(remove_parameters)){
    object <- object[!rownames(object) %in% remove_parameters,,drop=FALSE]
  }

  if(!is.null(title)){
    attr(object, "title") <- title
  }

  if(any(attr(object, "type") == "inclusion_BF")){
    for(BF_col in which(attr(object, "type") == "inclusion_BF")){
      BF_values <- object[[BF_col]]
      raw_BF    <- as.numeric(BF_values)
      bound_operator <- .standardize_BF_bound_operator(attr(BF_values, "bound_operator"), length(BF_values))
      if(isTRUE(attr(BF_values, "logBF"))){
        raw_BF <- exp(raw_BF)
      }
      if(isTRUE(attr(BF_values, "BF01"))){
        raw_BF <- 1 / raw_BF
        bound_operator <- .invert_BF_bound_operator(bound_operator)
      }
      attr(raw_BF, "bound_operator") <- bound_operator
      object[[BF_col]] <- format_BF(raw_BF, logBF = logBF, BF01 = BF01, inclusion = TRUE)
    }
  }
  if(any(attr(object, "type") == "BF_error")){
    BF_error_cols <- which(attr(object, "type") == "BF_error")
    if(length(BF_error_cols) == 1){
      attr(object[[BF_error_cols]], "name") <- .BF_error_column_name(BF01)
    }
  }

  return(object)
}

.format_column       <- function(x, type, n_models){
  if(is.null(x) || length(x) == 0){
    return(x)
  }else{
    return(switch(
      type,
      "integer"         = round(x),
      "prior"           = .center_priors(x),
      "string_left"     = .string_left(x),
      "string"          = x,
      "estimate"        = format(round(x, digits = 3), nsmall = 3),
      "prior_prob"      = format(round(x, digits = 3), nsmall = 3),
      "post_prob"       = format(round(x, digits = 3), nsmall = 3),
      "probability"     = format(round(x, digits = 3), nsmall = 3),
      "marglik"         = format(round(x, digits = 2), nsmall = 2),
      "BF"              = .format_BF_column(x),
      "inclusion_BF"    = .format_BF_column(x),
      "BF_error"        = format(round(x, digits = 3), nsmall = 3),
      "n_models"        = paste0(round(x), "/", n_models),
      "ESS"             = round(x),
      "R_hat"           = format(round(x, digits = 3), nsmall = 3),
      "MCMC_error"      = format(round(x, digits = 5), nsmall = 5),
      "MCMC_SD_error"   = format(round(x, digits = 3), nsmall = 3),
      "min_ESS"             = round(x),
      "max_R_hat"           = format(round(x, digits = 3), nsmall = 3),
      "max_MCMC_error"      = format(round(x, digits = 5), nsmall = 5),
      "max_MCMC_SD_error"   = format(round(x, digits = 3), nsmall = 3)
    ))
  }
}
.format_column_names <- function(x, type, values){
  if(is.null(x) || length(x) == 0){
    return(x)
  }else{
    return(switch(
      type,
      "integer"         = x,
      "prior"           = .string_center(paste0("Prior ", x), values),
      "string_left"     = .string_left(x, values),
      "string"          = x,
      "estimate"        = x,
      "probability"     = x,
      "prior_prob"      = "Prior prob.",
      "post_prob"       = "Post. prob.",
      "marglik"         = "log(marglik)",
      "BF"              = if(is.null(attr(values, "name"))) "BF"           else attr(values, "name"),
      "inclusion_BF"    = if(is.null(attr(values, "name"))) "Inclusion BF" else attr(values, "name"),
      "BF_error"        = if(is.null(attr(values, "name"))) x              else attr(values, "name"),
      "n_models"        = "Models",
      "ESS"             = "ESS",
      "R_hat"           = "R-hat",
      "MCMC_error"      = if(is.null(attr(values, "name"))) "error(MCMC)" else attr(values, "name"),
      "MCMC_SD_error"   = "error(MCMC)/SD",
      "min_ESS"             = "min(ESS)",
      "max_R_hat"           = "max(R-hat)",
      "max_MCMC_error"      = "max[error(MCMC)]",
      "max_MCMC_SD_error"   = "max[error(MCMC)/SD]",
    ))
  }
}
.center_priors <- function(x){

  if(any(grepl("~", x) | grepl("=", x))){

    position_tilda  <- regexpr("~", x)
    position_equal  <- regexpr("=", x)
    from_right      <- sapply(seq_along(x), function(i){
      if(position_tilda[i] != -1){
        return(nchar(x[i]) - position_tilda[i])
      }else if(position_equal[i] != -1){
        return(nchar(x[i]) - position_equal[i])
      }else{
        return(0)
      }
    })
    add_to_right  <- ifelse(from_right == 0, 0, max(from_right) - from_right)
    x <- paste0(x, sapply(seq_along(x), function(i)paste0(rep(" ", add_to_right[i]), collapse = "")))

  }

  return(x)
}
.string_left   <- function(x, reference = x){

  if(length(x) > 0){

    add_to_right <- max(nchar(reference)) - nchar(x)
    x <- paste0(x, sapply(seq_along(x), function(i)paste0(rep(" ", add_to_right[i]), collapse = "")))

  }

  return(x)
}
.string_center <- function(x, reference = x){

  if(length(x) > 0){

    add_to_sides <- max(nchar(reference)) - nchar(x)
    add_to_sides <- ifelse(add_to_sides < 0, 0, add_to_sides)
    x <- paste0( sapply(seq_along(x), function(i)paste0(rep(" ", round(add_to_sides[i]/2)), collapse = "")), x, sapply(seq_along(x), function(i)paste0(rep(" ", round(add_to_sides[i]/2)), collapse = "")))

  }

  return(x)
}

.check_table_types      <- function(x, name, allow_NULL = FALSE){
  check_char(x, name, allow_values = c(
    "integer", "prior", "string_left", "string", "estimate",
    "probability", "prior_prob", "post_prob",
    "marglik", "BF", "inclusion_BF", "BF_error", "n_models",
    "ESS", "R_hat", "MCMC_error", "MCMC_SD_error", "min_ESS", "max_R_hat", "max_MCMC_error", "max_MCMC_SD_error"),
    allow_NULL = allow_NULL)
}
.JAGS_estimates_diagnostic_columns <- function(){
  c("MCMC_error", "MCMC_SD_error", "ESS", "R_hat")
}
.JAGS_BF_diagnostic_columns <- function(){
  c("ESS", "MCMC_error", "BF_error_percent")
}
.JAGS_BF_diagnostic_column_types <- function(columns){
  unname(c(
    ESS              = "ESS",
    MCMC_error       = "MCMC_error",
    BF_error_percent = "BF_error"
  )[columns])
}
.normalize_diagnostic_columns <- function(columns, allowed_columns, name){

  if(is.null(columns) || length(columns) == 0){
    return(character())
  }

  if(is.logical(columns)){
    check_bool(columns, name, allow_NA = FALSE)
    if(columns){
      return(allowed_columns)
    }else{
      return(character())
    }
  }

  check_char(columns, name, check_length = 0, allow_NA = FALSE)

  shortcut_columns <- c("all", "none")
  if(any(columns %in% shortcut_columns)){
    if(length(columns) > 1){
      stop(paste0("The '", name, "' argument can use 'all' or 'none' only by itself."), call. = FALSE)
    }
    if(columns == "all"){
      return(allowed_columns)
    }else{
      return(character())
    }
  }

  check_char(columns, name, check_length = 0, allow_values = allowed_columns, allow_NA = FALSE)

  return(unique(columns))
}
.runjags_summary_fast   <- function(model_samples, n_samples, n_chains, conditional, probs = c(0.025, 0.975), remove_diagnostics = FALSE,
                                    diagnostic_columns = .JAGS_estimates_diagnostic_columns()){

  diagnostic_columns <- .normalize_diagnostic_columns(diagnostic_columns, .JAGS_estimates_diagnostic_columns(), "diagnostic_columns")
  if(remove_diagnostics){
    diagnostic_columns <- character()
  }

  # compute quantiles dynamically
  quantile_cols <- lapply(probs, function(p) apply(model_samples, 2, stats::quantile, probs = p, na.rm = TRUE))
  names(quantile_cols) <- as.character(probs)

  # the chains needs to be kept merged for conditional summary (due to NAs in the chains)
  runjags_summary <- cbind.data.frame(
    "Mean"   = apply(model_samples, 2, mean,          na.rm = TRUE),
    "SD"     = apply(model_samples, 2, stats::sd,    na.rm = TRUE),
    as.data.frame(quantile_cols, check.names = FALSE)
  )

  # remove all but Mean for inclusions
  quantile_col_names <- as.character(probs)
  runjags_summary[grepl("(inclusion)", rownames(runjags_summary)), c("SD", quantile_col_names)] <- NA

  # don't produce fit diagnostics for conditional samples (different chain lengths etc...) or if remove_diagnostics is TRUE
  if(conditional || length(diagnostic_columns) == 0){
    return(runjags_summary)
  }

  # split back the chains (allows for diagnostics calculation)
  model_samples_list <- split(as.data.frame(model_samples), rep(1:n_chains, each = n_samples), drop = FALSE)
  model_samples_list <- coda::as.mcmc.list(lapply(model_samples_list, coda::as.mcmc))
  mcmc_summary       <- summary(model_samples_list, quantiles = NULL)$statistics

  # fix single parameter summaries
  if(is.null(dim(mcmc_summary))){
    mcmc_summary <- t(mcmc_summary)
  }

  # add diagnostics to non-conditional samples
  runjags_diagnostics <- cbind.data.frame(
    "MCMC_error"    = mcmc_summary[,"Time-series SE"],
    "MCMC_SD_error" = mcmc_summary[,"Time-series SE"] / mcmc_summary[,"SD"],
    "ESS"           = coda::effectiveSize(model_samples_list),
    "R_hat"         = if(n_chains > 1) coda::gelman.diag(model_samples_list, multivariate = FALSE, autoburnin = FALSE)$psrf[,1] else NA
  )

  # remove incorrect NANs and NAs from the diagnostics
  runjags_diagnostics[is.nan(runjags_diagnostics[,"MCMC_SD_error"]),"MCMC_SD_error"] <- NA
  runjags_diagnostics[runjags_diagnostics[,"ESS"] == 0, "ESS"]                       <- 0
  runjags_diagnostics[is.nan(runjags_diagnostics[,"R_hat"]),"R_hat"]                 <- NA

  # first omega parameter is always constant
  runjags_diagnostics[grepl("omega[0,", rownames(runjags_diagnostics), fixed = TRUE), ] <- NA
  runjags_summary <- cbind.data.frame(runjags_summary, runjags_diagnostics[, diagnostic_columns, drop = FALSE])

  return(runjags_summary)
}
.runjags_conditional_warning <- function(parameters, n_samples, warning_limit = 500){
  if(n_samples == 0){
    return(sprintf("Conditional summary for %1$s parameter could not be computed due to no posterior samples.", paste0(parameters, collapse = ", ")))
  }else if(n_samples <= warning_limit){
    return(sprintf("Conditional summary for %1$s is based on %2$i samples.", paste0(parameters, collapse = ", "), n_samples))
  }else{
    return()
  }
}

# Helper function to transform scaled samples in list format (for ensemble/marginal tables)
# Uses the combinatorial unscaling algorithm via the helper in JAGS-formula.R
.transform_scale_samples_list <- function(samples, formula_scale){
  
  if(is.null(formula_scale) || length(formula_scale) == 0){
    return(samples)
  }
  
  sample_names <- names(samples)
  transformable <- sapply(samples, function(x) is.numeric(x) || is.matrix(x))
  transformable_names <- sample_names[transformable]
  
  if(length(transformable_names) == 0){
    return(samples)
  }

  n_samples <- if(is.matrix(samples[[transformable_names[1]]])){
    nrow(samples[[transformable_names[1]]])
  }else{
    length(samples[[transformable_names[1]]])
  }

  sample_columns <- lapply(transformable_names, function(name){
    if(is.matrix(samples[[name]])){
      temp_samples <- samples[[name]]
      if(is.null(colnames(temp_samples))){
        colnames(temp_samples) <- if(ncol(temp_samples) == 1) name else paste0(name, "[", seq_len(ncol(temp_samples)), "]")
      }
      return(temp_samples)
    }else{
      temp_samples <- matrix(samples[[name]], ncol = 1)
      colnames(temp_samples) <- name
      return(temp_samples)
    }
  })
  names(sample_columns) <- transformable_names

  posterior_matrix <- do.call(cbind, sample_columns)
  if(nrow(posterior_matrix) != n_samples){
    stop("All posterior sample elements must contain the same number of samples.", call. = FALSE)
  }

  posterior_matrix <- .apply_unscale_transform(posterior_matrix, formula_scale)

  for(name in transformable_names){
    old_attrs <- attributes(samples[[name]])
    column_names <- colnames(sample_columns[[name]])

    if(is.matrix(samples[[name]])){
      samples[[name]][, seq_along(column_names)] <- posterior_matrix[, column_names, drop = FALSE]
    }else{
      samples[[name]] <- posterior_matrix[, column_names]
      for(attr_name in setdiff(names(old_attrs), "names")){
        attr(samples[[name]], attr_name) <- old_attrs[[attr_name]]
      }
    }
  }
  
  return(samples)
}
