#' @title Print model parameters
#' @name print.parameters_model
#'
#' @description A `print()`-method for objects from [`model_parameters()`][model_parameters].
#'
#' @param x,object An object returned by [`model_parameters()`][model_parameters].
#' @param split_components Logical, if `TRUE` (default), For models with
#' multiple components (zero-inflation, smooth terms, ...), each component is
#' printed in a separate table. If `FALSE`, model parameters are printed
#' in a single table and a `Component` column is added to the output.
#' @param select Determines which columns and and which layout columns are
#' printed. There are three options for this argument:
#'
#' 1. Selecting columns by name or index
#' \cr
#' `select` can be a character vector (or numeric index) of column names that
#' should be printed. There are two pre-defined options for selecting columns:
#' `select = "minimal"` prints coefficients, confidence intervals and p-values,
#' while `select = "short"` prints coefficients, standard errors and p-values.
#'
#' 2. A string expression with layout pattern
#' \cr
#' `select` is a string with "tokens" enclosed in braces. These tokens will
#' be replaced by their associated columns, where the selected columns will
#' be collapsed into one column. However, it is possible to create multiple
#' columns as well. Following tokens are replaced by the related coefficients
#' or statistics: `{estimate}`, `{se}`, `{ci}` (or `{ci_low}` and `{ci_high}`),
#' `{p}` and `{stars}`. The token `{ci}` will be replaced by `{ci_low}, {ci_high}`.
#' Furthermore, a `|` separates values into new cells/columns. If
#' `format = "html"`, a `<br>` inserts a line break inside a cell. See
#' 'Examples'.
#'
#' 3. A string indicating a pre-defined layout
#' \cr
#' `select` can be one of the following string values, to create one of the
#' following pre-defined column layouts:
#'
#' - `"ci"`: Estimates and confidence intervals, no asterisks for p-values.
#' This is equivalent to `select = "{estimate} ({ci})"`.
#' - `"se"`: Estimates and standard errors, no asterisks for p-values. This is
#' equivalent to `select = "{estimate} ({se})"`.
#' - `"ci_p"`: Estimates, confidence intervals and asterisks for p-values. This
#' is equivalent to `select = "{estimate}{stars} ({ci})"`.
#' - `"se_p"`: Estimates, standard errors and asterisks for p-values. This is
#' equivalent to `select = "{estimate}{stars} ({se})"`..
#' - `"ci_p2"`: Estimates, confidence intervals and numeric p-values, in two
#' columns. This is equivalent to `select = "{estimate} ({ci})|{p}"`.
#' - `"se_p2"`: Estimate, standard errors and numeric p-values, in two columns.
#' This is equivalent to `select = "{estimate} ({se})|{p}"`.
#'
#' For `model_parameters()`, glue-like syntax is still experimental in the
#' case of more complex models (like mixed models) and may not return expected
#' results.
#' @param show_sigma Logical, if `TRUE`, adds information about the residual
#' standard deviation.
#' @param show_formula Logical, if `TRUE`, adds the model formula to the output.
#' @param caption Table caption as string. If `NULL`, depending on the model,
#' either a default caption or no table caption is printed. Use `caption = ""`
#' to suppress the table caption.
#' @param footer Can either be `FALSE` or an empty string (i.e. `""`) to
#' suppress the footer, `NULL` to print the default footer, or a string. The
#' latter will combine the string value with the default footer.
#' @param footer_digits Number of decimal places for values in the footer summary.
#' @param groups Named list, can be used to group parameters in the printed output.
#' List elements may either be character vectors that match the name of those
#' parameters that belong to one group, or list elements can be row numbers
#' of those parameter rows that should belong to one group. The names of the
#' list elements will be used as group names, which will be inserted as "header
#' row". A possible use case might be to emphasize focal predictors and control
#' variables, see 'Examples'. Parameters will be re-ordered according to the
#' order used in `groups`, while all non-matching parameters will be added
#' to the end.
#' @param column_width Width of table columns. Can be either `NULL`, a named
#' numeric vector, or `"fixed"`. If `NULL`, the width for each table column is
#' adjusted to the minimum required width. If a named numeric vector, value
#' names are matched against column names, and for each match, the specified
#' width is used. If `"fixed"`, and table is split into multiple components,
#' columns across all table components are adjusted to have the same width.
#' @param digits,ci_digits,p_digits Number of digits for rounding or
#' significant figures. May also be `"signif"` to return significant
#' figures or `"scientific"` to return scientific notation. Control the
#' number of digits by adding the value as suffix, e.g. `digits = "scientific4"`
#' to have scientific notation with 4 decimal places, or `digits = "signif5"`
#' for 5 significant figures (see also [signif()]).
#' @param pretty_names Can be `TRUE`, which will return "pretty" (i.e. more human
#' readable) parameter names. Or `"labels"`, in which case value and variable
#' labels will be used as parameters names. The latter only works for "labelled"
#' data, i.e. if the data used to fit the model had `"label"` and `"labels"`
#' attributes. See also section _Global Options to Customize Messages when Printing_.
#' @param include_reference Logical, if `TRUE`, the reference level of factors will
#' be added to the parameters table. This is only relevant for models with
#' categorical predictors. The coefficient for the reference level is always
#' `0` (except when `exponentiate = TRUE`, then the coefficient will be `1`),
#' so this is just for completeness.
#' @param ... Arguments passed down to [`format.parameters_model()`],
#' [`insight::format_table()`] and [`insight::export_table()`]
#' @inheritParams insight::format_table
#' @inheritParams compare_parameters
#' @inheritParams display.parameters_model
#'
#' @inheritSection format_parameters Interpretation of Interaction Terms
#' @inheritSection model_parameters Labeling the Degrees of Freedom
#'
#' @section Global Options to Customize Messages and Tables when Printing:
#' The `verbose` argument can be used to display or silence messages and
#' warnings for the different functions in the **parameters** package. However,
#' some messages providing additional information can be displayed or suppressed
#' using `options()`:
#'
#' - `parameters_summary`: `options(parameters_summary = TRUE)` will override the
#' `summary` argument in `model_parameters()` and always show the model summary
#' for non-mixed models.
#'
#' - `parameters_mixed_summary`: `options(parameters_mixed_summary = TRUE)` will
#' override the `summary` argument in `model_parameters()` for mixed models, and
#' will then always show the model summary.
#'
#' - `parameters_cimethod`: `options(parameters_cimethod = TRUE)` will show the
#' additional information about the approximation method used to calculate
#' confidence intervals and p-values. Set to `FALSE` to hide this message when
#' printing `model_parameters()` objects.
#'
#' - `parameters_exponentiate`: `options(parameters_exponentiate = TRUE)` will
#' show the additional information on how to interpret coefficients of models
#' with log-transformed response variables or with log-/logit-links when the
#' `exponentiate` argument in `model_parameters()` is not `TRUE`. Set this option
#' to `FALSE` to hide this message when printing `model_parameters()` objects.
#'
#' There are further options that can be used to modify the default behaviour
#' for printed outputs:
#'
#' - `parameters_labels`: `options(parameters_labels = TRUE)` will use variable
#' and value labels for pretty names, if data is labelled. If no labels
#' available, default pretty names are used.
#'
#' - `parameters_interaction`: `options(parameters_interaction = <character>)`
#' will replace the interaction mark (by default, `*`) with the related character.
#'
#' - `parameters_select`: `options(parameters_select = <value>)` will set the
#' default for the `select` argument. See argument's documentation for available
#' options.
#'
#' - `easystats_html_engine`: `options(easystats_html_engine = "gt")` will set
#' the default HTML engine for tables to `gt`, i.e. the _gt_ package is used to
#' create HTML tables. If set to `tt`, the _tinytable_ package is used.
#'
#' - `insight_use_symbols`: `options(insight_use_symbols = TRUE)` will try to
#' print unicode-chars for symbols as column names, wherever possible (e.g.,
#' \ifelse{html}{\out{ω}}{\eqn{\omega}} instead of `Omega`).
#'
#' @details `summary()` is a convenient shortcut for
#' `print(object, select = "minimal", show_sigma = TRUE, show_formula = TRUE)`.
#'
#' @return Invisibly returns the original input object.
#'
#' @seealso See also [`display()`][display.parameters_model].
#'
#' @examplesIf require("gt", quietly = TRUE) && require("glmmTMB", quietly = TRUE)
#' \donttest{
#' library(parameters)
#' model <- glmmTMB::glmmTMB(
#' count ~ spp + mined + (1 | site),
#' ziformula = ~mined,
#' family = poisson(),
#' data = Salamanders
#' )
#' mp <- model_parameters(model)
#'
#' print(mp, pretty_names = FALSE)
#'
#' print(mp, split_components = FALSE)
#'
#' print(mp, select = c("Parameter", "Coefficient", "SE"))
#'
#' print(mp, select = "minimal")
#'
#'
#' # group parameters ------
#'
#' data(iris)
#' model <- lm(
#' Sepal.Width ~ Sepal.Length + Species + Petal.Length,
#' data = iris
#' )
#' # don't select "Intercept" parameter
#' mp <- model_parameters(model, parameters = "^(?!\\(Intercept)")
#' groups <- list(
#' "Focal Predictors" = c("Speciesversicolor", "Speciesvirginica"),
#' "Controls" = c("Sepal.Length", "Petal.Length")
#' )
#' print(mp, groups = groups)
#'
#' # or use row indices
#' print(mp, groups = list(
#' "Focal Predictors" = c(1, 4),
#' "Controls" = c(2, 3)
#' ))
#'
#' # only show coefficients, CI and p,
#' # put non-matched parameters to the end
#'
#' data(mtcars)
#' mtcars$cyl <- as.factor(mtcars$cyl)
#' mtcars$gear <- as.factor(mtcars$gear)
#' model <- lm(mpg ~ hp + gear * vs + cyl + drat, data = mtcars)
#'
#' # don't select "Intercept" parameter
#' mp <- model_parameters(model, parameters = "^(?!\\(Intercept)")
#' print(mp, groups = list(
#' "Engine" = c("cyl6", "cyl8", "vs", "hp"),
#' "Interactions" = c("gear4:vs", "gear5:vs")
#' ))
#' }
#'
#'
#' # custom column layouts ------
#'
#' data(iris)
#' lm1 <- lm(Sepal.Length ~ Species, data = iris)
#' lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris)
#'
#' # custom style
#' result <- compare_parameters(lm1, lm2, select = "{estimate}{stars} ({se})")
#' print(result)
#'
#' \donttest{
#' # custom style, in HTML
#' result <- compare_parameters(lm1, lm2, select = "{estimate}<br>({se})|{p}")
#' print_html(result)
#' }
#' @export
print.parameters_model <- function(x,
pretty_names = TRUE,
split_components = TRUE,
select = NULL,
caption = NULL,
footer = NULL,
digits = 2,
ci_digits = digits,
p_digits = 3,
footer_digits = 3,
show_sigma = FALSE,
show_formula = FALSE,
zap_small = FALSE,
groups = NULL,
column_width = NULL,
ci_brackets = c("[", "]"),
include_reference = FALSE,
...) {
# save original input
orig_x <- x
# check options ---------------
# check if pretty names should be replaced by value labels
# (if we have labelled data)
if (isTRUE(getOption("parameters_labels", FALSE)) || identical(pretty_names, "labels")) {
attr(x, "pretty_names") <- attr(x, "pretty_labels", exact = TRUE)
pretty_names <- TRUE
}
# select which columns to print
if (is.null(select)) {
select <- getOption("parameters_select")
}
# check if user supplied digits attributes
if (missing(digits)) {
digits <- .additional_arguments(x, "digits", digits)
}
if (missing(ci_digits)) {
ci_digits <- .additional_arguments(x, "ci_digits", digits)
}
if (missing(p_digits)) {
p_digits <- .additional_arguments(x, "p_digits", p_digits)
}
if (missing(footer_digits)) {
footer_digits <- .additional_arguments(x, "footer_digits", footer_digits)
}
# table caption
table_caption <- .print_caption(x, caption, format = "text")
# main table
formatted_table <- .print_core(
x = x,
pretty_names = pretty_names,
split_components = split_components,
select = select,
digits = digits,
ci_digits = ci_digits,
p_digits = p_digits,
zap_small = zap_small,
ci_width = "auto",
ci_brackets = ci_brackets,
format = "text",
groups = groups,
include_reference = include_reference,
...
)
# if we have multiple components, we can align colum width across components here
if (!is.null(column_width) && all(column_width == "fixed") && is.list(formatted_table)) {
column_width <- .find_min_colwidth(formatted_table)
}
# footer
footer_stats <- .print_footer(
x,
digits = footer_digits,
show_sigma = show_sigma,
show_formula = show_formula
)
# check if footer should be printed at all. can be FALSE, or "" to suppress footer
if (isFALSE(footer)) {
footer <- ""
}
if (!identical(footer, "")) {
if (is.null(footer)) {
footer <- footer_stats
} else {
footer <- paste0("\n", footer, "\n", footer_stats)
}
}
# get attributes
verbose <- .additional_arguments(x, "verbose", TRUE)
# print main table
cat(insight::export_table(
formatted_table,
format = "text",
caption = table_caption,
footer = footer,
width = column_width,
...
))
# inform about CI and df approx.
if (isTRUE(verbose)) {
.print_footer_cimethod(x)
.print_footer_exp(x)
}
invisible(orig_x)
}
#' @rdname print.parameters_model
#' @export
summary.parameters_model <- function(object, ...) {
print(
x = object,
select = "minimal",
show_sigma = TRUE,
show_formula = TRUE,
...
)
}
#' @export
print.parameters_simulate <- print.parameters_model
#' @export
print.parameters_brms_meta <- print.parameters_model
# Random effects ------------------
#' @export
print.parameters_random <- function(x, digits = 2, ...) {
.print_random_parameters(x, digits = digits)
invisible(x)
}
# helper --------------------
.print_core <- function(x,
pretty_names = TRUE,
split_components = TRUE,
select = NULL,
digits = 2,
ci_digits = digits,
p_digits = 3,
zap_small = FALSE,
ci_width = "auto",
ci_brackets = TRUE,
format = "text",
groups = NULL,
include_reference = FALSE,
...) {
format(
x,
pretty_names = pretty_names,
split_components = split_components,
select = select,
digits = digits,
ci_digits = ci_digits,
p_digits = p_digits,
ci_width = ci_width,
ci_brackets = ci_brackets,
zap_small = zap_small,
format = format,
groups = groups,
include_reference = include_reference,
...
)
}
.print_footer <- function(x,
digits = 3,
show_sigma = FALSE,
show_formula = FALSE,
format = "text") {
# get attributes
model_sigma <- attributes(x)$sigma
show_summary <- isTRUE(attributes(x)$show_summary)
verbose <- .additional_arguments(x, "verbose", TRUE)
# override defaults. if argument "summary" is called in "model_parameters()",
# this overrides the defaults...
show_sigma <- ifelse(show_summary, TRUE, show_sigma)
show_formula <- ifelse(show_summary, TRUE, show_formula)
show_r2 <- .additional_arguments(x, "show_summary", FALSE)
# set defaults, if necessary
if (is.null(model_sigma)) {
show_sigma <- FALSE
}
.format_footer(
x,
digits = digits,
verbose = verbose,
show_sigma = show_sigma,
show_formula = show_formula,
show_r2 = show_r2,
format = format
)
}
.print_caption <- function(x, caption = NULL, format = "text") {
no_caption <- attributes(x)$no_caption
# no table-title for certain model tables, indicated by the no_caption attribute
if (isTRUE(no_caption)) {
return(NULL)
}
title_attribute <- attributes(x)$title[1]
# check effects and component parts
if (!is.null(x$Effects) && all(x$Effects == "random")) {
eff_name <- "Random"
} else {
eff_name <- "Fixed"
}
if (!is.null(x$Component) && all(x$Component == "zero_inflated")) {
zero_inflated <- " (Zero-Inflation Component)"
} else {
zero_inflated <- ""
}
# caption = NULL, set default for HTML tables
if (identical(format, "html") && is.null(caption)) {
if (isTRUE(attributes(x)$is_ggeffects)) {
table_caption <- title_attribute
} else {
table_caption <- "Model Summary"
}
} else if (isTRUE(attributes(x)$ordinal_model)) {
table_caption <- ""
# caption is NULL, set default title, using title-attribute
} else if (!is.null(title_attribute) && is.null(caption)) {
if (length(title_attribute) == 1 && title_attribute == "") {
table_caption <- NULL
} else {
table_caption <- title_attribute
}
# if caption is not empty, use it as title
} else if (!is.null(caption) && caption != "") {
table_caption <- caption
# no table-title if caption is empty string
} else if (!is.null(caption) && caption == "") {
table_caption <- NULL
# default title for sub-components of models
} else if (identical(format, "text")) {
table_caption <- c(paste0("# ", eff_name, " Effects", zero_inflated), "blue")
} else {
table_caption <- paste0(eff_name, " Effects", zero_inflated)
}
table_caption
}
#' @keywords internal
.print_random_parameters <- function(random_params, digits = 2) {
insight::print_color("# Random Effects\n\n", "blue")
# create SD
random_params$SD <- NA
var_components <- random_params$Description %in% c("Within-Group Variance", "Between-Group Variance")
random_params$SD[var_components] <- sqrt(random_params$Value[var_components])
# format values
random_params$Value <- format(sprintf("%g", round(random_params$Value, digits = digits)), justify = "right")
random_params$SD[var_components] <- format(
sprintf("(%g)", round(random_params$SD[var_components], digits = digits)),
justify = "right"
)
# create summary-information for each component
random_params$Line <- ""
random_params$Term[is.na(random_params$Term)] <- ""
random_params$SD[is.na(random_params$SD)] <- ""
non_empty <- random_params$Term != "" & random_params$Type != "" # nolint
random_params$Line[non_empty] <- sprintf("%s (%s)", random_params$Type[non_empty], random_params$Term[non_empty])
non_empty <- random_params$Term != "" & random_params$Type == "" # nolint
random_params$Line[non_empty] <- sprintf("%s", random_params$Term[non_empty])
# final fix, indentions
random_params$Line <- sprintf(" %s", format(random_params$Line))
max_len <- max(nchar(random_params$Line)) + 2
out <- split(random_params, factor(random_params$Description, levels = unique(random_params$Description)))
for (i in out) {
if ("Within-Group Variance" %in% i$Description) {
insight::print_color(format("Within-Group Variance", width = max_len), color = "blue")
cat(sprintf("%s %s\n", i$Value, i$SD))
} else if ("Between-Group Variance" %in% i$Description) {
insight::print_color("Between-Group Variance\n", "blue")
for (j in seq_len(nrow(i))) {
cat(sprintf("%s %s %s\n", i$Line[j], i$Value[j], i$SD[j]))
}
} else if ("Correlations" %in% i$Description) {
insight::print_color("Correlations\n", "blue")
for (j in seq_len(nrow(i))) {
cat(sprintf("%s %s\n", i$Line[j], i$Value[j]))
}
} else if ("N" %in% i$Description) {
insight::print_color("N (groups per factor)\n", "blue")
for (j in seq_len(nrow(i))) {
cat(sprintf(" %s%s\n", format(i$Term[j], width = max_len - 2), i$Value[j]))
}
} else if ("Observations" %in% i$Description) {
insight::print_color(format("Observations", width = max_len), color = "blue")
cat(sprintf("%s\n", i$Value))
}
}
}
.find_min_colwidth <- function(formatted_table) {
shared_cols <- unique(unlist(lapply(formatted_table, colnames)))
col_width <- rep(NA, length(shared_cols))
for (i in seq_along(shared_cols)) {
col_width[i] <- max(unlist(lapply(formatted_table, function(j) {
column <- j[[shared_cols[i]]]
if (is.null(column)) {
NA
} else {
max(nchar(column))
}
})))
}
stats::na.omit(stats::setNames(col_width, shared_cols))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.