swh:1:snp:cf20732a2a91717cec7759cd75c5d1a72600b018
Tip revision: 601edcd8d1306ebea478657861c54fa9c69a52f3 authored by Dominique Makowski on 31 May 2021, 05:40:09 UTC
version 0.10.0
version 0.10.0
Tip revision: 601edcd
format.R
#' @importFrom insight format_table print_parameters format_value format_bf format_ci
#' @importFrom utils modifyList
#' @export
format.describe_posterior <- function(x,
cp,
digits = 2,
format = "text",
ci_string = "CI",
caption = NULL,
subtitles = NULL,
...) {
# reshape CI
if (is.data.frame(x) && .n_unique(x$CI) > 1) {
att <- attributes(x)
x <- reshape_ci(x)
attributes(x) <- utils::modifyList(att, attributes(x))
}
# format columns and values of data frame
out <- insight::format_table(x, digits = digits, format = format, ...)
# different CI-types as column names?
if (ci_string != "CI" && any(grepl("CI$", colnames(out)))) {
colnames(out) <- gsub("(.*)CI$", paste0("\\1", ci_string), colnames(out))
}
# match and split at components
if (!is.null(cp) && !all(is.na(match(cp$Parameter, out$Parameter)))) {
out <- insight::print_parameters(
cp,
out,
keep_parameter_column = FALSE,
remove_empty_column = TRUE,
titles = caption,
subtitles = subtitles,
format = format
)
} else {
attr(out, "table_caption") <- caption
attr(out, "table_subtitle") <- subtitles
}
out
}
#' @export
format.point_estimate <- format.describe_posterior
#' @export
format.p_rope <- format.describe_posterior
#' @export
format.p_direction <- format.describe_posterior
#' @export
format.p_map <- format.describe_posterior
#' @export
format.map_estimate <- format.describe_posterior
#' @export
format.p_significance <- format.describe_posterior
#' @export
format.bayestestR_hdi <- format.describe_posterior
#' @export
format.bayestestR_eti <- format.describe_posterior
#' @export
format.bayestestR_si <- format.describe_posterior
# special handling for bayes factors ------------------
#' @export
format.bayesfactor_models <- function(x,
digits = 3,
log = FALSE,
show_names = TRUE,
format = "text",
caption = NULL,
exact = TRUE,
...) {
BFE <- x
denominator <- attr(BFE, "denominator")
grid.type <- attr(BFE, "BF_method")
model_names <- attr(BFE, "model_names")
formula_length <- attr(BFE, "text_length")
BFE <- as.data.frame(BFE)
if (!log) {
BFE$log_BF <- exp(BFE$log_BF)
}
BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...)
if (any((sgn <- sign(BFE$log_BF)<0)[!is.na(BFE$log_BF)])) {
BFE$BF[sgn] <- paste0("-", BFE$BF[sgn])
}
BFE$Model[BFE$Model == "1"] <- "(Intercept only)" # indicate null-model
# shorten model formulas?
if (!is.null(formula_length) && !is.null(BFE$Model)) {
BFE$Model <- insight::format_string(BFE$Model, length = formula_length)
}
if (isFALSE(show_names) || is.null(model_names) || length(model_names) != nrow(BFE)) {
BFE$i <- paste0("[", seq_len(nrow(BFE)), "]")
} else {
BFE$i <- paste0("[", model_names, "]")
}
# Denominator
denM <- .trim(paste0(BFE$i, " ", BFE$Model)[denominator])
BFE <- BFE[-denominator, ]
BFE <- BFE[c("i", "Model", "BF")]
colnames(BFE)[1] <- ifelse(identical(format, "html"), "Name", "")
# footer
if (is.null(format) || format == "text") {
footer <- list(
"\n* Against Denominator: ",
c(denM, "cyan"),
"\n* Bayes Factor Type: ",
c(grid.type, "cyan"),
if (log) c("\n\nBayes Factors are on the log-scale.", "red")
)
# color formatting for caption
if (!is.null(caption)) {
caption <- c(caption, "blue")
}
} else {
footer <- .compact_list(list(
paste0("Against Denominator: ", denM),
paste0("Bayes Factor Type: ", grid.type),
if (log) "Bayes Factors are on the log-scale."
))
}
attr(BFE, "table_footer") <- footer
attr(BFE, "table_caption") <- caption
BFE
}
#' @export
format.bayesfactor_inclusion <- function(x,
digits = 3,
log = FALSE,
format = "text",
caption = NULL,
exact = TRUE,
...) {
priorOdds <- attr(x, "priorOdds")
matched <- attr(x, "matched")
# format table
BFE <- as.data.frame(x)
if (!log) {
BFE$log_BF <- exp(BFE$log_BF)
}
BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...)
if (any((sgn <- sign(BFE$log_BF)<0)[!is.na(BFE$log_BF)])) {
BFE$BF[sgn] <- paste0("-", BFE$BF[sgn])
}
BFE <- BFE[c("p_prior", "p_posterior", "BF")]
BFE <- cbind(rownames(BFE), BFE)
colnames(BFE) <- c("", "P(prior)", "P(posterior)", "Inclusion BF")
colnames(BFE)[1] <- ifelse(identical(format, "html"), "Parameter", "")
# footer
if (is.null(format) || format == "text") {
footer <- list(
c("\n* Compared among: "),
c(if (matched) "matched models only" else "all models", "cyan"),
c("\n* Priors odds: "),
c(if (!is.null(priorOdds)) "custom" else "uniform-equal", "cyan"),
if (log) c("\n\nBayes Factors are on the log-scale.", "red")
)
# color formatting for caption
if (!is.null(caption)) {
caption <- c(caption, "blue")
}
} else {
footer <- .compact_list(list(
paste0("Compared among: ",if (matched) "matched models only" else "all models"),
paste0("Priors odds: ", if (!is.null(priorOdds)) "custom" else "uniform-equal"),
if (log) "Bayes Factors are on the log-scale."
))
}
attr(BFE, "table_footer") <- footer
attr(BFE, "table_caption") <- caption
BFE
}
#' @export
format.bayesfactor_restricted <- function(x,
digits = 3,
log = FALSE,
format = "text",
caption = NULL,
exact = TRUE,
...) {
BFE <- as.data.frame(x)
# Format
if (!log) {
BFE$log_BF <- exp(BFE$log_BF)
}
BFE$BF <- insight::format_bf(abs(BFE$log_BF), name = NULL, exact = exact, ...)
if (any((sgn <- sign(BFE$log_BF)<0)[!is.na(BFE$log_BF)])) {
BFE$BF[sgn] <- paste0("-", BFE$BF[sgn])
}
BFE$log_BF <- NULL
colnames(BFE) <- c("Hypothesis", "P(Prior)", "P(Posterior)", "BF")
# footer
if (is.null(format) || format == "text") {
footer <- list(
c("\n* Bayes factors for the restricted model vs. the un-restricted model.\n"),
if (log) c("\nBayes Factors are on the log-scale.\n", "red")
)
# color formatting for caption
if (!is.null(caption)) {
caption <- c(caption, "blue")
}
} else {
footer <- .compact_list(list(
"Bayes factors for the restricted model vs. the un-restricted model.",
if (log) "Bayes Factors are on the log-scale."
))
}
attr(BFE, "table_footer") <- footer
attr(BFE, "table_caption") <- caption
BFE
}
#' @export
format.bayesfactor_parameters <- function(x,
cp = NULL,
digits = 3,
log = FALSE,
format = "text",
exact = TRUE,
...) {
null <- attr(x, "hypothesis")
direction <- attr(x, "direction")
if (!log) {
x$log_BF <- exp(x$log_BF)
}
x$BF_override <- insight::format_bf(abs(x$log_BF), name = NULL, exact = exact, ...)
if (any((sgn <- sign(x$log_BF)<0)[!is.na(x$log_BF)])) {
x$BF_override[sgn] <- paste0("-", x$BF_override[sgn])
}
x$log_BF <- NULL
# format columns and values of data frame
out <- insight::format_table(x, digits = digits, format = format, ...)
colnames(out)[colnames(out)=="BF_override"] <- "BF"
# table caption
caption <- sprintf(
"Bayes Factor (%s)",
if (length(null) == 1) "Savage-Dickey density ratio" else "Null-Interval"
)
if (is.null(format) || format == "text") {
caption <- c(caption, "blue")
}
# format null-value
if (length(null) == 1) {
null <- insight::format_value(null, digits = digits, protect_integers = TRUE)
} else {
null <- insight::format_ci(null[1], null[2], ci = NULL, digits = digits)
}
# footer
if (is.null(format) || format == "text") {
footer <- list(
c("\n* Evidence Against The Null: "),
c(null, "cyan"),
if (direction) c("\n* Direction: "),
if (direction < 0) c("Left-Sided test", "cyan"),
if (direction > 0) c("Right-Sided test", "cyan"),
if (log) c("\n\nBayes Factors are on the log-scale.\n", "red")
)
} else {
footer <- .compact_list(list(
paste0("Evidence Against The Null: ", null),
if (direction) c("Direction: "),
if (direction < 0) "Left-Sided test",
if (direction > 0) "Right-Sided test",
if (log) "Bayes Factors are on the log-scale."
))
}
# match and split at components
if (!is.null(cp) && !all(is.na(match(cp$Parameter, out$Parameter)))) {
out <- insight::print_parameters(
cp,
out,
keep_parameter_column = FALSE,
remove_empty_column = TRUE,
format = format
)
attr(out[[1]], "table_caption") <- caption
attr(out[[length(out)]], "table_footer") <- footer
} else {
attr(out, "table_caption") <- caption
attr(out, "table_footer") <- footer
}
out
}