From 09fa455a8f09c97577742ef58828174aabbfe0e5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 18 Jul 2025 14:51:09 +0200 Subject: [PATCH 01/33] Implement improved tinytable support --- R/display.R | 7 +++++-- R/print.compare_parameters.R | 7 ------- R/print.parameters_model.R | 7 +++++++ R/print_html.R | 27 +++++++++++++++++++-------- man/display.parameters_model.Rd | 9 +++++++++ man/print.parameters_model.Rd | 9 +++++++++ 6 files changed, 49 insertions(+), 17 deletions(-) diff --git a/R/display.R b/R/display.R index ef2cae5f85..6fe7316e69 100644 --- a/R/display.R +++ b/R/display.R @@ -103,6 +103,7 @@ display.parameters_model <- function(object, line_padding = 4, column_labels = NULL, include_reference = FALSE, + engine = "gt", verbose = TRUE, ...) { format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) @@ -113,7 +114,7 @@ display.parameters_model <- function(object, footer = footer, ci_digits = ci_digits, p_digits = p_digits, footer_digits = footer_digits, ci_brackets = ci_brackets, show_sigma = show_sigma, show_formula = show_formula, zap_small = zap_small, - include_reference = include_reference, verbose = verbose + include_reference = include_reference, engine = format, verbose = verbose ) if (format %in% c("html", "tt")) { @@ -154,6 +155,7 @@ display.compare_parameters <- function(object, font_size = "100%", line_padding = 4, zap_small = FALSE, + engine = "gt", ...) { format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) @@ -164,7 +166,8 @@ display.compare_parameters <- function(object, p_digits = p_digits, ci_brackets = ci_brackets, select = select, - zap_small = zap_small + zap_small = zap_small, + engine = format ) if (format %in% c("html", "tt")) { diff --git a/R/print.compare_parameters.R b/R/print.compare_parameters.R index 94aace9bd0..5ec18f5170 100644 --- a/R/print.compare_parameters.R +++ b/R/print.compare_parameters.R @@ -4,13 +4,6 @@ #' @description A `print()`-method for objects from [`compare_parameters()`]. #' #' @param x An object returned by [`compare_parameters()`]. -#' @param engine Character string, naming the package or engine to be used for -#' printing into HTML or markdown format. Currently supported `"gt"` (or -#' `"default"`) to use the *gt* package to print to HTML and the default easystats -#' engine to create markdown tables. If `engine = "tt"`, the *tinytable* package -#' is used for printing to HTML or markdown. Not all `print()` methods support -#' the `"tt"` engine yet. If a specific `print()` method has no `engine` argument, -#' `insight::export_table()` is used, which uses *gt* for HTML printing. #' @inheritParams print.parameters_model #' @inheritSection print.parameters_model Global Options to Customize Messages and Tables when Printing #' diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index 124ebbd67f..4b1fb4edb2 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -99,6 +99,13 @@ #' 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 engine Character string, naming the package or engine to be used for +#' printing into HTML or markdown format. Currently supported `"gt"` (or +#' `"default"`) to use the *gt* package to print to HTML and the default easystats +#' engine to create markdown tables. If `engine = "tt"`, the *tinytable* package +#' is used for printing to HTML or markdown. Not all `print()` methods support +#' the `"tt"` engine yet. If a specific `print()` method has no `engine` argument, +#' `insight::export_table()` is used, which uses *gt* for HTML printing. #' @param ... Arguments passed down to [`format.parameters_model()`], #' [`insight::format_table()`] and [`insight::export_table()`] #' @inheritParams insight::format_table diff --git a/R/print_html.R b/R/print_html.R index 0062018f13..6e10375fb8 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -23,6 +23,7 @@ print_html.parameters_model <- function(x, line_padding = 4, column_labels = NULL, include_reference = FALSE, + engine = "gt", verbose = TRUE, ...) { # check if user supplied digits attributes @@ -55,6 +56,12 @@ print_html.parameters_model <- function(x, select <- .convert_to_glue_syntax(style = select, "
") } + # markdown engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) + # check options --------------- # check if pretty names should be replaced by value labels @@ -112,7 +119,7 @@ print_html.parameters_model <- function(x, out <- insight::export_table( formatted_table, - format = "html", + format = ifelse(identical(engine, "tt"), "tt", "html"), caption = table_caption, subtitle = subtitle, footer = footer, @@ -120,13 +127,17 @@ print_html.parameters_model <- function(x, ... ) - .add_gt_options( - out, - style = select, - font_size = font_size, - line_padding = line_padding, - user_labels = column_labels - ) + if (identical(engine, "tt")) { + out + } else { + .add_gt_options( + out, + style = select, + font_size = font_size, + line_padding = line_padding, + user_labels = column_labels + ) + } } #' @export diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index d2a4aa40a5..9ff986a2a1 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -31,6 +31,7 @@ line_padding = 4, column_labels = NULL, include_reference = FALSE, + engine = "gt", verbose = TRUE, ... ) @@ -180,6 +181,14 @@ categorical predictors. The coefficient for the reference level is always \code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}), so this is just for completeness.} +\item{engine}{Character string, naming the package or engine to be used for +printing into HTML or markdown format. Currently supported \code{"gt"} (or +\code{"default"}) to use the \emph{gt} package to print to HTML and the default easystats +engine to create markdown tables. If \code{engine = "tt"}, the \emph{tinytable} package +is used for printing to HTML or markdown. Not all \code{print()} methods support +the \code{"tt"} engine yet. If a specific \code{print()} method has no \code{engine} argument, +\code{insight::export_table()} is used, which uses \emph{gt} for HTML printing.} + \item{verbose}{Toggle messages and warnings.} \item{...}{Arguments passed down to \code{\link[=format.parameters_model]{format.parameters_model()}}, diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index 394d32352f..8fa8b04f7a 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -71,6 +71,7 @@ line_padding = 4, column_labels = NULL, include_reference = FALSE, + engine = "gt", verbose = TRUE, ... ) @@ -241,6 +242,14 @@ data frames, \code{caption} may be a list of table captions, one for each table. \item{column_labels}{Labels of columns for HTML tables. If \code{NULL}, automatic column names are generated. See 'Examples'.} +\item{engine}{Character string, naming the package or engine to be used for +printing into HTML or markdown format. Currently supported \code{"gt"} (or +\code{"default"}) to use the \emph{gt} package to print to HTML and the default easystats +engine to create markdown tables. If \code{engine = "tt"}, the \emph{tinytable} package +is used for printing to HTML or markdown. Not all \code{print()} methods support +the \code{"tt"} engine yet. If a specific \code{print()} method has no \code{engine} argument, +\code{insight::export_table()} is used, which uses \emph{gt} for HTML printing.} + \item{verbose}{Toggle messages and warnings.} } \value{ From 47ec0b7ea92396d6e9fa6d8da828ca60ecd081a2 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 18 Jul 2025 14:58:50 +0200 Subject: [PATCH 02/33] ... --- R/display.R | 13 ++++----- R/print_html.R | 51 ++++++++++++--------------------- man/display.parameters_model.Rd | 9 ------ 3 files changed, 25 insertions(+), 48 deletions(-) diff --git a/R/display.R b/R/display.R index 6fe7316e69..7b0db81d49 100644 --- a/R/display.R +++ b/R/display.R @@ -103,7 +103,6 @@ display.parameters_model <- function(object, line_padding = 4, column_labels = NULL, include_reference = FALSE, - engine = "gt", verbose = TRUE, ...) { format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) @@ -114,7 +113,7 @@ display.parameters_model <- function(object, footer = footer, ci_digits = ci_digits, p_digits = p_digits, footer_digits = footer_digits, ci_brackets = ci_brackets, show_sigma = show_sigma, show_formula = show_formula, zap_small = zap_small, - include_reference = include_reference, engine = format, verbose = verbose + include_reference = include_reference, verbose = verbose ) if (format %in% c("html", "tt")) { @@ -124,7 +123,8 @@ display.parameters_model <- function(object, column_labels = column_labels, align = align, font_size = font_size, - line_padding = line_padding + line_padding = line_padding, + engine = ifelse(format == "tt", "tt", "gt") ) ) do.call(print_html, c(fun_args, list(...))) @@ -155,7 +155,6 @@ display.compare_parameters <- function(object, font_size = "100%", line_padding = 4, zap_small = FALSE, - engine = "gt", ...) { format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) @@ -166,8 +165,7 @@ display.compare_parameters <- function(object, p_digits = p_digits, ci_brackets = ci_brackets, select = select, - zap_small = zap_small, - engine = format + zap_small = zap_small ) if (format %in% c("html", "tt")) { @@ -176,7 +174,8 @@ display.compare_parameters <- function(object, list( column_labels = column_labels, font_size = font_size, - line_padding = line_padding + line_padding = line_padding, + engine = ifelse(format == "tt", "tt", "gt") ) ) do.call(print_html, c(fun_args, list(...))) diff --git a/R/print_html.R b/R/print_html.R index 6e10375fb8..3435d5396f 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -187,27 +187,10 @@ print_html.compare_parameters <- function(x, } # markdown engine? - engine <- match.arg(getOption("easystats_html_engine", engine), c("gt", "default", "tt")) - - # for tiny table, we can just call print_md() - if (engine == "tt") { - return(print_md( - x, - digits = digits, - ci_digits = ci_digits, - p_digits = p_digits, - caption = caption, - subtitle = subtitle, - footer = footer, - select = select, - split_components = TRUE, - ci_brackets = ci_brackets, - zap_small = zap_small, - groups = groups, - engine = "tt", - outformat = "html" - )) - } + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) # we need glue-like syntax right now... select <- .convert_to_glue_syntax(style = select, "
") @@ -234,23 +217,27 @@ print_html.compare_parameters <- function(x, out <- insight::export_table( formatted_table, - format = "html", + format = ifelse(identical(engine, "tt"), "tt", "html"), caption = caption, # TODO: get rid of NOTE subtitle = subtitle, footer = footer, ... ) - .add_gt_options( - out, - style = select, - font_size = font_size, - line_padding = line_padding, - # we assume that model names are at the end of each column name, in parenthesis - original_colnames = gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1], - column_names = colnames(formatted_table), - user_labels = column_labels - ) + if (identical(engine, "tt")) { + out + } else { + .add_gt_options( + out, + style = select, + font_size = font_size, + line_padding = line_padding, + # we assume that model names are at the end of each column name, in parenthesis + original_colnames = gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1], + column_names = colnames(formatted_table), + user_labels = column_labels + ) + } } diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index 9ff986a2a1..d2a4aa40a5 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -31,7 +31,6 @@ line_padding = 4, column_labels = NULL, include_reference = FALSE, - engine = "gt", verbose = TRUE, ... ) @@ -181,14 +180,6 @@ categorical predictors. The coefficient for the reference level is always \code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}), so this is just for completeness.} -\item{engine}{Character string, naming the package or engine to be used for -printing into HTML or markdown format. Currently supported \code{"gt"} (or -\code{"default"}) to use the \emph{gt} package to print to HTML and the default easystats -engine to create markdown tables. If \code{engine = "tt"}, the \emph{tinytable} package -is used for printing to HTML or markdown. Not all \code{print()} methods support -the \code{"tt"} engine yet. If a specific \code{print()} method has no \code{engine} argument, -\code{insight::export_table()} is used, which uses \emph{gt} for HTML printing.} - \item{verbose}{Toggle messages and warnings.} \item{...}{Arguments passed down to \code{\link[=format.parameters_model]{format.parameters_model()}}, From 863988bf812e76a38779f73800bed7b15375ea51 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 18 Jul 2025 15:02:45 +0200 Subject: [PATCH 03/33] ... --- R/print_md.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/print_md.R b/R/print_md.R index 1ee016a3b2..fd53955246 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -156,7 +156,7 @@ print_md.compare_parameters <- function(x, } # markdown engine? - engine <- match.arg(engine, c("tt", "default")) + engine <- insight::validate_argument(engine, c("tt", "default")) formatted_table <- format( x, From da84bb312c6cf982ab80b38e1a98cef6daec48c5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 19 Jul 2025 17:51:51 +0200 Subject: [PATCH 04/33] save for now --- R/print_md.R | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/R/print_md.R b/R/print_md.R index fd53955246..cc2cef15ab 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -187,14 +187,28 @@ print_md.compare_parameters <- function(x, } else { outformat <- "markdown" } - .export_table_tt( - x, + + col_names <- gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table)) + col_groups <- sapply(attributes(x)$model_names, function(i) which(i == col_names), simplify = FALSE) + colnames(formatted_table) <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)) + + insight::export_table( formatted_table, - groups, + format = "tt", caption = caption, + subtitle = subtitle, footer = footer, - outformat = outformat + column_groups = col_groups ) + + # .export_table_tt( + # x, + # formatted_table, + # groups, + # caption = caption, + # footer = footer, + # outformat = outformat + # ) } else { insight::export_table( formatted_table, From 03aa88b64fc9a095178ce38559aaaf2fb743830b Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 13:47:19 +0200 Subject: [PATCH 05/33] update --- R/format.R | 11 ++--------- R/utils_format.R | 2 -- 2 files changed, 2 insertions(+), 11 deletions(-) diff --git a/R/format.R b/R/format.R index 7f4d79a917..62f7f7b826 100644 --- a/R/format.R +++ b/R/format.R @@ -122,7 +122,6 @@ format.parameters_model <- function(x, if (!is.null(groups)) { x <- .parameter_groups(x, groups) } - indent_groups <- attributes(x)$indent_groups indent_rows <- attributes(x)$indent_rows # prepare output, to have in shape for printing. this function removes @@ -210,12 +209,8 @@ format.parameters_model <- function(x, } } - if (!is.null(indent_rows)) { - attr(formatted_table, "indent_rows") <- indent_rows - attr(formatted_table, "indent_groups") <- NULL - } else if (!is.null(indent_groups)) { - attr(formatted_table, "indent_groups") <- indent_groups - } + # information about indention / row groups + attr(formatted_table, "indent_rows") <- indent_rows # vertical layout possible, if these have just one row if (identical(list(...)$layout, "vertical")) { @@ -405,8 +400,6 @@ format.compare_parameters <- function(x, if (!is.null(groups) && !identical(engine, "tt")) { out <- .parameter_groups(out, groups) } - indent_groups <- attributes(x)$indent_groups - indent_rows <- attributes(x)$indent_rows # check whether to split table by certain factors/columns (like component, response...) split_by <- split_column <- .prepare_splitby_for_print(x) diff --git a/R/utils_format.R b/R/utils_format.R index 7f08ba78dc..4ba9938502 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -843,7 +843,6 @@ for (i in rev(seq_along(groups))) { x[seq(groups[i] + 1, nrow(x) + 1), ] <- x[seq(groups[i], nrow(x)), ] x[groups[i], ] <- empty_row - x$Parameter[groups[i]] <- paste0("# ", names(groups[i])) } # find row indices of indented parameters @@ -858,7 +857,6 @@ attributes(x) <- utils::modifyList(att, attributes(x)) attr(x, "indent_rows") <- indent_rows - attr(x, "indent_groups") <- "# " x } From bf26f2cd0c0a46969cbecc8d6f688250d75daac4 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 13:47:50 +0200 Subject: [PATCH 06/33] version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 54b639736c..ca1f68667a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: parameters Title: Processing of Model Parameters -Version: 0.27.0.1 +Version: 0.27.0.2 Authors@R: c(person(given = "Daniel", family = "Lüdecke", From c2e3fc3f82acfc1f2847a1809b1332faaec76c36 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 14:09:22 +0200 Subject: [PATCH 07/33] fix --- R/format.R | 20 +++-------- R/utils_format.R | 94 ------------------------------------------------ 2 files changed, 4 insertions(+), 110 deletions(-) diff --git a/R/format.R b/R/format.R index 62f7f7b826..3b223f5bcc 100644 --- a/R/format.R +++ b/R/format.R @@ -116,14 +116,6 @@ format.parameters_model <- function(x, x <- .format_ranef_parameters(x) } - # group parameters - this function find those parameters that should be - # grouped, reorders parameters into groups and indents lines that belong - # to one group, adding a header for each group - if (!is.null(groups)) { - x <- .parameter_groups(x, groups) - } - indent_rows <- attributes(x)$indent_rows - # prepare output, to have in shape for printing. this function removes # empty columns, or selects only those columns that should be printed x <- .prepare_x_for_print(x, select, coef_name, s_value) @@ -210,7 +202,7 @@ format.parameters_model <- function(x, } # information about indention / row groups - attr(formatted_table, "indent_rows") <- indent_rows + attr(formatted_table, "indent_rows") <- groups # vertical layout possible, if these have just one row if (identical(list(...)$layout, "vertical")) { @@ -394,13 +386,6 @@ format.compare_parameters <- function(x, out <- datawizard::data_arrange(out, c("Effects", "Component")) } - # group parameters - this function find those parameters that should be - # grouped, reorders parameters into groups and indents lines that belong - # to one group, adding a header for each group - if (!is.null(groups) && !identical(engine, "tt")) { - out <- .parameter_groups(out, groups) - } - # check whether to split table by certain factors/columns (like component, response...) split_by <- split_column <- .prepare_splitby_for_print(x) @@ -462,6 +447,9 @@ format.compare_parameters <- function(x, formatted_table <- .add_obs_row(formatted_table, parameters_attributes, style = select) } + # information about indention / row groups + attr(formatted_table, "indent_rows") <- groups + formatted_table } diff --git a/R/utils_format.R b/R/utils_format.R index 4ba9938502..27b85edb9c 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -767,100 +767,6 @@ } -# helper grouping parameters ------------------- - - -.parameter_groups <- function(x, groups) { - # only apply to conditional component for now - if ("Component" %in% colnames(x) && !any(x$Component == "conditional")) { - return(x) - } - if ("Component" %in% colnames(x)) { - row_index <- which(x$Component == "conditional") - } else { - row_index <- seq_len(nrow(x)) - } - - x_other <- x[-row_index, ] - x <- x[row_index, ] - - att <- attributes(x) - indent_rows <- NULL - indent_parameters <- NULL - - if (is.list(groups)) { - # find parameter names and replace by rowindex - group_rows <- lapply(groups, function(i) { - if (is.character(i)) { - i <- match(i, x$Parameter) - } - i - }) - - # validation check - check if all parameter names in the - # group list are spelled correctly - misspelled <- vapply(group_rows, anyNA, TRUE) - - if (any(misspelled)) { - # remove invalid groups - group_rows[misspelled] <- NULL - # tell user - insight::format_alert( - "Couldn't find one or more parameters specified in following groups:", - toString(names(misspelled[misspelled])), - "Maybe you misspelled parameter names?" - ) - } - - - # sort parameters according to grouping - selected_rows <- unlist(group_rows) - indent_parameters <- x$Parameter[selected_rows] - x <- rbind(x[selected_rows, ], x[-selected_rows, ]) - - # set back correct indices - groups <- 1 - for (i in 2:length(group_rows)) { - groups <- c(groups, groups[i - 1] + length(group_rows[[i - 1]])) - } - names(groups) <- names(group_rows) - } else { - # find parameter names and replace by rowindex - group_names <- names(groups) - groups <- match(groups, x$Parameter) - names(groups) <- group_names - - # order groups - groups <- sort(groups, na.last = TRUE) - } - - - empty_row <- x[1, ] - for (i in seq_len(ncol(empty_row))) { - empty_row[[i]] <- NA - } - - for (i in rev(seq_along(groups))) { - x[seq(groups[i] + 1, nrow(x) + 1), ] <- x[seq(groups[i], nrow(x)), ] - x[groups[i], ] <- empty_row - } - - # find row indices of indented parameters - if (!is.null(indent_parameters)) { - indent_rows <- match(indent_parameters, x$Parameter) - } - - # add other rows back - if (nrow(x_other) > 0) { - x <- rbind(x, x_other) - } - - attributes(x) <- utils::modifyList(att, attributes(x)) - attr(x, "indent_rows") <- indent_rows - x -} - - # .insert_row <- function(x, newrow, r) { # existingDF[seq(r+1,nrow(existingDF)+1),] <- existingDF[seq(r,nrow(existingDF)),] # existingDF[r,] <- newrow From e0da29d28bb6878347012bb8f2b22920dc03e88a Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 21:35:42 +0200 Subject: [PATCH 08/33] fix --- tests/testthat/test-compare_parameters.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R index bad174d8a5..fa5e2f6cea 100644 --- a/tests/testthat/test-compare_parameters.R +++ b/tests/testthat/test-compare_parameters.R @@ -132,8 +132,8 @@ withr::with_options( cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") out <- print_md(cp, groups = list( - Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), + Groups = c("grp [2]", "grp [3]"), + Interactions = c("Days × grp [2]", "Days × grp [3]"), Controls = "Days" )) expect_snapshot(print(out)) @@ -145,7 +145,7 @@ withr::with_options( expect_error( print_md(cp, groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), + Interactions = c("Days × grp (2)", "Days × grp (3)"), Controls = "Days" )), regex = "Cannot combine" @@ -174,7 +174,7 @@ withr::with_options( expect_error( print_md(cp, groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), + Interactions = c("Days × grp (2)", "Days × grp (3)"), Controls = "XDays" )), regex = "Some group indices" @@ -192,7 +192,7 @@ withr::with_options( cp1 <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") out1 <- capture.output(print_md(cp1, groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), + Interactions = c("Days × grp (2)", "Days × grp (3)"), Controls = "Days" ))) cp2 <- compare_parameters( @@ -202,7 +202,7 @@ withr::with_options( drop = "^\\(Intercept", groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), + Interactions = c("Days × grp (2)", "Days × grp (3)"), Controls = "Days" ) ) From 0bff88021e7217115821a10ac442ba03f5396c7f Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 21:37:41 +0200 Subject: [PATCH 09/33] shorten --- R/print_md.R | 108 --------------------------------------------------- 1 file changed, 108 deletions(-) diff --git a/R/print_md.R b/R/print_md.R index cc2cef15ab..30434167c6 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -200,15 +200,6 @@ print_md.compare_parameters <- function(x, footer = footer, column_groups = col_groups ) - - # .export_table_tt( - # x, - # formatted_table, - # groups, - # caption = caption, - # footer = footer, - # outformat = outformat - # ) } else { insight::export_table( formatted_table, @@ -377,102 +368,3 @@ print_md.equivalence_test_lm <- function(x, insight::export_table(formatted_table, format = "markdown", caption = table_caption, align = "firstleft") } - - -# helper ----------------------- - -.export_table_tt <- function(x, formatted_table, groups, caption = NULL, footer = NULL, outformat = "markdown") { - insight::check_if_installed("tinytable", minimum_version = "0.1.0") - row_groups <- NULL - # check if we have a list of tables - if (!is.data.frame(formatted_table) && is.list(formatted_table) && length(formatted_table) > 1) { - # sanity check - cannot combine multiple tables when we have groups - if (!is.null(groups)) { - insight::format_error("Cannot combine multiple tables when groups are present.") - } - # add table caption as group variable, and bind tables - # we then extract row headers based on values in the group indices - formatted_table <- lapply(formatted_table, function(i) { - i$group <- attr(i, "table_caption") - i - }) - # bind tables - formatted_table <- do.call(rbind, formatted_table) - # find positions for sub headers - row_groups <- as.list(which(!duplicated(formatted_table$group))) - names(row_groups) <- formatted_table$group[unlist(row_groups)] - # remove no longer needed group variable - formatted_table$group <- NULL - } - # we need to find out which columns refer to which model, in order to - # add a column heading for each model - models <- attributes(x)$model_names - col_names <- gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table)) - col_groups <- sapply(models, function(i) which(i == col_names), simplify = FALSE) - # clean column names. These still contain the model name - colnames(formatted_table) <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)) - # check if we have column spans at all? - if (all(lengths(col_groups) == 1)) { - col_groups <- NULL - } - # group rows? - if (!is.null(groups)) { - # make sure we have numeric indices for groups - groups <- lapply(groups, function(g) { - if (is.character(g)) { - # if groups were provided as parameter names, we find the row position - # by matching the parameter name - match(g, formatted_table$Parameter) - } else { - # else, we assume that the group is a row position - g - } - }) - # sanity check - do all rows match a parameter? - group_indices <- unlist(groups, use.names = FALSE) - if (anyNA(group_indices) || any(group_indices < 1) || any(group_indices > nrow(formatted_table))) { - insight::format_error("Some group indices do not match any parameter.") - } - # if row indices are not sorted, we need to resort the parameters data frame - if (is.unsorted(unlist(groups))) { - new_rows <- c(unlist(groups), setdiff(seq_len(nrow(formatted_table)), unlist(groups))) - formatted_table <- formatted_table[new_rows, ] - # we need to update indices in groups as well. Therefore, we need to convert - # list of row indices into a vector with row indices, then subtract the - # differences of old and new row positions, and then split that vector into - # a list again - groups <- stats::setNames(unlist(groups), rep(names(groups), lengths(groups))) - groups <- groups - (unlist(groups) - sort(unlist(groups))) - groups <- split(unname(groups), factor(names(groups), levels = unique(names(groups)))) - } - # find matching rows for groups - row_groups <- lapply(seq_along(groups), function(i) { - g <- groups[[i]] - if (is.character(g)) { - # if groups were provided as parameter names, we find the row position - # by matching the parameter name - g <- match(g, formatted_table$Parameter)[1] - } else { - # else, we assume that the group is a row position - g <- g[1] - } - g - }) - # set element names - names(row_groups) <- names(groups) - if (identical(outformat, "markdown")) { - # for markdown, format italic - names(row_groups) <- paste0("*", names(row_groups), "*") - } - } - # replace NA in formatted_table by "" - formatted_table[is.na(formatted_table)] <- "" - # create base table - out <- tinytable::tt(formatted_table, notes = footer, caption = caption) - # insert sub header rows and column spans, if we have them - if (!(is.null(row_groups) && is.null(col_groups))) { - out <- tinytable::group_tt(out, i = row_groups, j = col_groups) - } - out@output <- outformat - out -} From f59866c3d80887c954ebc65decf6e4632e21e3cf Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 22:32:59 +0200 Subject: [PATCH 10/33] test --- R/format.R | 61 ++-------------- R/utils_format.R | 180 ++--------------------------------------------- 2 files changed, 8 insertions(+), 233 deletions(-) diff --git a/R/format.R b/R/format.R index 3b223f5bcc..ad54946e89 100644 --- a/R/format.R +++ b/R/format.R @@ -123,11 +123,6 @@ format.parameters_model <- function(x, # check whether to split table by certain factors/columns (like component, response...) split_by <- .prepare_splitby_for_print(x) - # add p-stars, if we need this for style-argument - if (!is.null(style) && grepl("{stars}", style, fixed = TRUE)) { - x$p_stars <- insight::format_p(x[["p"]], stars = TRUE, stars_only = TRUE) - } - # format everything now... if (split_components && !is.null(split_by) && length(split_by)) { # this function mainly sets the appropriate column names for each @@ -149,6 +144,7 @@ format.parameters_model <- function(x, ci_brackets = ci_brackets, zap_small = zap_small, include_reference = include_reference, + style = style, ... ) } else { @@ -166,6 +162,7 @@ format.parameters_model <- function(x, coef_name = coef_name, zap_small = zap_small, include_reference = include_reference, + style = style, ... ) } @@ -180,27 +177,6 @@ format.parameters_model <- function(x, formatted_table$CI <- NULL } - # we also allow style-argument for model parameters. In this case, we need - # some small preparation, namely, we need the p_stars column, and we need - # to "split" the formatted table, because the glue-function needs the columns - # without the parameters-column. - if (!is.null(style)) { - if (is.data.frame(formatted_table)) { - formatted_table <- .style_formatted_table( - formatted_table, - style = style, - format = format - ) - } else { - formatted_table[] <- lapply( - formatted_table, - .style_formatted_table, - style = style, - format = format - ) - } - } - # information about indention / row groups attr(formatted_table, "indent_rows") <- groups @@ -363,7 +339,6 @@ format.compare_parameters <- function(x, out$Parameter[out$Parameter == "SD (Observations: Residual)"] <- "SD (Residual)" } # save p-stars in extra column - cols$p_stars <- insight::format_p(cols$p, stars = TRUE, stars_only = TRUE) cols <- insight::format_table( cols, digits = digits, @@ -372,9 +347,10 @@ format.compare_parameters <- function(x, ci_digits = ci_digits, p_digits = p_digits, zap_small = zap_small, + select = select, ... ) - out <- cbind(out, .format_output_style(cols, style = select, format, i)) + out <- cbind(out, cols) } # remove group column @@ -491,35 +467,6 @@ format.parameters_sem <- function(x, } -# helper --------------------- - -.style_formatted_table <- function(formtab, style, format) { - additional_columns <- intersect(c("Effects", "Group", "Component"), colnames(formtab)) - if (length(additional_columns)) { - additional_columns <- formtab[additional_columns] - } - # define column names in case the glue-pattern has multiple columns. - if (grepl("|", style, fixed = TRUE)) { - cn <- NULL - } else { - cn <- .style_pattern_to_name(style) - } - formtab <- cbind( - formtab[1], - .format_output_style( - formtab[2:ncol(formtab)], - style = style, - format = format, - modelname = cn - ) - ) - if (!insight::is_empty_object(additional_columns)) { - formtab <- cbind(formtab, additional_columns) - } - formtab -} - - # footer functions ------------------ .format_footer <- function(x, diff --git a/R/utils_format.R b/R/utils_format.R index 27b85edb9c..4ae3b9e759 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -1,74 +1,5 @@ # output-format helper ------------------------- -# this function does the main composition of columns for the output. -# it's used by "compare_parameters()", where users can choose between -# different pre-sets of "print-layouts" - -.format_output_style <- function(x, style, format, modelname) { - if (identical(format, "html")) { - linesep <- "
" - } else { - linesep <- " " - } - if (!is.null(style) && style %in% c("se", "ci")) { - x$p_stars <- "" - } - - # find columns - coef_column <- colnames(x)[1] - ci_column <- colnames(x)[endsWith(colnames(x), " CI") | colnames(x) == "CI"] - - # make sure we have a glue-like syntax - style <- .convert_to_glue_syntax(style, linesep) - - # "|" indicates cell split - style <- unlist(strsplit(style, split = "|", fixed = TRUE)) - - # define column names - if (length(style) == 1) { - column_names <- modelname - } else { - column_names <- .style_pattern_to_name(style) - } - - # paste glue together - formatted_columns <- lapply(seq_along(style), function(i) { - .format_glue_output(x, coef_column, ci_column, style[i], format, column_names[i]) - }) - out <- do.call(cbind, formatted_columns) - - # add modelname to column names; for single column layout per model, we just - # need the column name. If the layout contains more than one column per model, - # add modelname in parenthesis. - if (!is.null(modelname) && nzchar(modelname, keepNA = TRUE)) { - if (ncol(out) > 1) { - colnames(out) <- paste0(colnames(out), " (", modelname, ")") - } else { - colnames(out) <- modelname - } - } - - # remove empty parenthesis - out[] <- lapply(out, function(i) { - # here we either have "
" or " " as line breaks, followed by empty "()" - i <- gsub("
()", "", i, fixed = TRUE) - i <- gsub(" ()", "", i, fixed = TRUE) - i <- gsub("
(, )", "", i, fixed = TRUE) - i <- gsub(" (, )", "", i, fixed = TRUE) - i[i == "()"] <- "" - i[i == "(, )"] <- "" - # remove other non-matched patterns - i <- gsub("{stars}", "", i, fixed = TRUE) - i <- gsub("{rhat}", "", i, fixed = TRUE) - i <- gsub("{ess}", "", i, fixed = TRUE) - i <- gsub("{pd}", "", i, fixed = TRUE) - i <- gsub("{rope}", "", i, fixed = TRUE) - i - }) - out -} - - .convert_to_glue_syntax <- function(style, linesep = NULL) { # set default if (is.null(linesep)) { @@ -113,112 +44,6 @@ } -.format_glue_output <- function(x, coef_column, ci_column, style, format, column_names) { - # separate CI columns, for custom layout - ci <- ci_low <- ci_high <- NULL - if (!insight::is_empty_object(ci_column)) { - ci <- x[[ci_column[1]]] - ci_low <- insight::trim_ws(gsub("(\\(|\\[)(.*),(.*)(\\)|\\])", "\\2", ci)) - ci_high <- insight::trim_ws(gsub("(\\(|\\[)(.*),(.*)(\\)|\\])", "\\3", ci)) - } - # fix p-layout - if ("p" %in% colnames(x)) { - x[["p"]] <- insight::trim_ws(x[["p"]]) - x[["p"]] <- gsub("< .", "<0.", x[["p"]], fixed = TRUE) - } - # handle aliases - style <- tolower(style) - style <- gsub("{coef}", "{estimate}", style, fixed = TRUE) - style <- gsub("{coefficient}", "{estimate}", style, fixed = TRUE) - style <- gsub("{std.error}", "{se}", style, fixed = TRUE) - style <- gsub("{standard error}", "{se}", style, fixed = TRUE) - style <- gsub("{pval}", "{p}", style, fixed = TRUE) - style <- gsub("{p.value}", "{p}", style, fixed = TRUE) - style <- gsub("{ci}", "{ci_low}, {ci_high}", style, fixed = TRUE) - # align columns width for text format - .align_values <- function(i) { - if (!is.null(i)) { - non_empty <- !is.na(i) & nzchar(i, keepNA = TRUE) - i[non_empty] <- format(insight::trim_ws(i[non_empty]), justify = "right") - } - i - } - # we put all elements (coefficient, SE, CI, p, ...) in one column. - # for text format, where columns are not center aligned, this can result in - # misaligned columns, which looks ugly. So we try to ensure that each element - # is formatted and justified to the same width - if (identical(format, "text") || is.null(format)) { - x[[coef_column]] <- .align_values(x[[coef_column]]) - x$SE <- .align_values(x$SE) - x[["p"]] <- .align_values(x[["p"]]) - x$p_stars <- .align_values(x$p_stars) - ci_low <- .align_values(ci_low) - ci_high <- .align_values(ci_high) - x$pd <- .align_values(x$pd) - x$Rhat <- .align_values(x$Rhat) - x$ESS <- .align_values(x$ESS) - x$ROPE_Percentage <- .align_values(x$ROPE_Percentage) - } - # create new string - table_row <- rep(style, times = nrow(x)) - for (r in seq_along(table_row)) { - table_row[r] <- gsub("{estimate}", x[[coef_column]][r], table_row[r], fixed = TRUE) - if (!is.null(ci_low) && !is.null(ci_high)) { - table_row[r] <- gsub("{ci_low}", ci_low[r], table_row[r], fixed = TRUE) - table_row[r] <- gsub("{ci_high}", ci_high[r], table_row[r], fixed = TRUE) - } - if ("SE" %in% colnames(x)) { - table_row[r] <- gsub("{se}", x[["SE"]][r], table_row[r], fixed = TRUE) - } - if ("p" %in% colnames(x)) { - table_row[r] <- gsub("{p}", x[["p"]][r], table_row[r], fixed = TRUE) - } - if ("p_stars" %in% colnames(x)) { - table_row[r] <- gsub("{stars}", x[["p_stars"]][r], table_row[r], fixed = TRUE) - } - if ("pd" %in% colnames(x)) { - table_row[r] <- gsub("{pd}", x[["pd"]][r], table_row[r], fixed = TRUE) - } - if ("Rhat" %in% colnames(x)) { - table_row[r] <- gsub("{rhat}", x[["Rhat"]][r], table_row[r], fixed = TRUE) - } - if ("ESS" %in% colnames(x)) { - table_row[r] <- gsub("{ess}", x[["ESS"]][r], table_row[r], fixed = TRUE) - } - if ("ROPE_Percentage" %in% colnames(x)) { - table_row[r] <- gsub("{rope}", x[["ROPE_Percentage"]][r], table_row[r], fixed = TRUE) - } - } - # some cleaning: columns w/o coefficient are empty - table_row[x[[coef_column]] == "" | is.na(x[[coef_column]])] <- "" # nolint - # fix some p-value stuff, e.g. if pattern is "p={p]}", - # we may have "p= <0.001", which we want to be "p<0.001" - table_row <- gsub("=<", "<", table_row, fixed = TRUE) - table_row <- gsub("= <", "<", table_row, fixed = TRUE) - table_row <- gsub("= ", "=", table_row, fixed = TRUE) - # final output - x <- data.frame(table_row) - colnames(x) <- column_names - x -} - - -.style_pattern_to_name <- function(style) { - column_names <- tolower(style) - # completely remove these patterns - column_names <- gsub("{stars}", "", column_names, fixed = TRUE) - # remove curlys - column_names <- gsub("{", "", column_names, fixed = TRUE) - column_names <- gsub("}", "", column_names, fixed = TRUE) - # manual renaming - column_names <- gsub("\\Qrope\\E", "% in ROPE", column_names) - column_names <- gsub("(estimate|coefficient|coef)", "Estimate", column_names) - column_names <- gsub("\\Qse\\E", "SE", column_names) - column_names <- gsub("
", "", column_names, fixed = TRUE) - column_names -} - - # global definition of valid "style" shortcuts .style_shortcuts <- c("ci_p2", "ci", "ci_p", "se", "se_p", "se_p2", "est", "coef") .select_shortcuts <- c("minimal", "short") @@ -281,6 +106,7 @@ coef_name = NULL, zap_small = FALSE, include_reference = FALSE, + style = NULL, ...) { # default brackets are parenthesis for HTML / MD if ((is.null(ci_brackets) || isTRUE(ci_brackets)) && (identical(format, "html") || identical(format, "markdown"))) { @@ -323,6 +149,7 @@ ci_digits = ci_digits, p_digits = p_digits, zap_small = zap_small, + select = style, ... ) } @@ -882,6 +709,7 @@ ci_brackets = TRUE, zap_small = FALSE, include_reference = FALSE, + style = NULL, ...) { final_table <- list() @@ -1072,7 +900,7 @@ tables[[type]], digits = digits, ci_digits = ci_digits, p_digits = p_digits, pretty_names = pretty_names, ci_width = ci_width, - ci_brackets = ci_brackets, zap_small = zap_small, ... + ci_brackets = ci_brackets, zap_small = zap_small, select = style, ... ) component_header <- .format_model_component_header( x, type, split_column, is_zero_inflated, is_ordinal_model, From daaefed951e5324f9f549eb364a666ddc730c230 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sun, 20 Jul 2025 23:43:39 +0200 Subject: [PATCH 11/33] fix --- R/format.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/format.R b/R/format.R index ad54946e89..03566cb28a 100644 --- a/R/format.R +++ b/R/format.R @@ -338,6 +338,7 @@ format.compare_parameters <- function(x, } out$Parameter[out$Parameter == "SD (Observations: Residual)"] <- "SD (Residual)" } + attributes(cols)$coef_name <- colnames(cols)[coef_column] # save p-stars in extra column cols <- insight::format_table( cols, From 1b2a056f4a975d82470c7f58aca3e42d4687a8d7 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 09:11:17 +0200 Subject: [PATCH 12/33] fix --- R/format.R | 10 ++++++++++ R/print_html.R | 13 +++++++++++++ 2 files changed, 23 insertions(+) diff --git a/R/format.R b/R/format.R index 03566cb28a..c2ca52467a 100644 --- a/R/format.R +++ b/R/format.R @@ -351,6 +351,16 @@ format.compare_parameters <- function(x, select = select, ... ) + + # add modelname to column names; for single column layout per model, we just + # need the column name. If the layout contains more than one column per model, + # add modelname in parenthesis. + if (ncol(cols) > 1) { + colnames(cols) <- paste0(colnames(cols), " (", i, ")") + } else { + colnames(cols) <- i + } + out <- cbind(out, cols) } diff --git a/R/print_html.R b/R/print_html.R index 3435d5396f..d5fe8155bb 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -215,12 +215,25 @@ print_html.compare_parameters <- function(x, formatted_table$Parameter <- gsub("]", ci_brackets[2], formatted_table$Parameter, fixed = TRUE) } + # setup grouping for tt-backend + if (identical(engine, "tt")) { + models <- unique(gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1]) + model_groups <- lapply(models, function(model) { + which(endsWith(colnames(formatted_table), paste0("(", model, ")"))) + }) + names(model_groups) <- models + colnames(formatted_table)[-1] <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)[-1]) + } else { + model_groups <- NULL + } + out <- insight::export_table( formatted_table, format = ifelse(identical(engine, "tt"), "tt", "html"), caption = caption, # TODO: get rid of NOTE subtitle = subtitle, footer = footer, + column_groups = model_groups, ... ) From d3157b5cbc7ec7879ee1db9348aeecffadafccbf Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 09:54:29 +0200 Subject: [PATCH 13/33] fix test --- tests/testthat/test-compare_parameters.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R index fa5e2f6cea..d774a5351c 100644 --- a/tests/testthat/test-compare_parameters.R +++ b/tests/testthat/test-compare_parameters.R @@ -58,8 +58,8 @@ withr::with_options( expect_identical( colnames(out), c( - "Parameter", "Estimate (SE) (m1)", "p (m1)", "Estimate (SE) (m2)", - "p (m2)", "Estimate (SE) (m3)", "p (m3)" + "Parameter", "Coefficient (SE) (m1)", "p (m1)", "Coefficient (SE) (m2)", + "p (m2)", "Log-Mean (SE) (m3)", "p (m3)" ) ) expect_identical( From b529f66bbc446f82ec49e9d6bc6ff398b40cec7f Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 10:04:00 +0200 Subject: [PATCH 14/33] fix --- tests/testthat/_snaps/printing.md | 229 +++++++++++++++++------------- tests/testthat/test-printing.R | 27 ++-- 2 files changed, 144 insertions(+), 112 deletions(-) diff --git a/tests/testthat/_snaps/printing.md b/tests/testthat/_snaps/printing.md index 769e0e3449..cd1c1dd559 100644 --- a/tests/testthat/_snaps/printing.md +++ b/tests/testthat/_snaps/printing.md @@ -103,23 +103,23 @@ # grouped parameters Code - print(out, groups = list(Engine = c("cyl6", "cyl8", "vs", "hp"), Interactions = c( - "gear4:vs", "gear5:vs"), Controls = c(2, 3, 7))) + print(out, groups = list(Engine = c(5, 6, 4, 1), Interactions = c(8, 9), + Controls = c(2, 3, 7))) Output - Parameter | Coefficient | SE | 95% CI | t(22) | p - ----------------------------------------------------------------------- - Engine | | | | | - cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276 - cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703 - vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410 - hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008 - Interactions | | | | | - gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541 - gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574 - Controls | | | | | - gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482 - gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182 - drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198 + Parameter | Coefficient | SE | 95% CI | t(22) | p + ---------------------------------------------------------------------- + Engine | | | | | + cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276 + cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703 + vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410 + hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008 + Interactions | | | | | + gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541 + gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574 + Controls | | | | | + gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482 + gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182 + drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198 Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed @@ -128,23 +128,48 @@ --- Code - print(out, sep = " ", groups = list(Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), Controls = c(2, 3, 7))) + print(out, groups = list(Engine = c("cyl [6]", "cyl [8]", "vs", "hp"), + Interactions = c("gear [4] * vs", "gear [5] * vs"), Controls = c(2, 3, 7))) Output - Parameter Coefficient SE 95% CI t(22) p - ------------------------------------------------------------------ - Engine - cyl [6] -2.47 2.21 [ -7.05, 2.12] -1.12 0.276 - cyl [8] 1.97 5.11 [ -8.63, 12.58] 0.39 0.703 - vs 3.18 3.79 [ -4.68, 11.04] 0.84 0.410 - hp -0.06 0.02 [ -0.11, -0.02] -2.91 0.008 - Interactions - gear [4] * vs -2.90 4.67 [-12.57, 6.78] -0.62 0.541 - gear [5] * vs 2.59 4.54 [ -6.82, 12.00] 0.57 0.574 - Controls - gear [4] 3.10 4.34 [ -5.90, 12.10] 0.71 0.482 - gear [5] 4.80 3.48 [ -2.42, 12.01] 1.38 0.182 - drat 2.70 2.03 [ -1.52, 6.91] 1.33 0.198 + Parameter | Coefficient | SE | 95% CI | t(22) | p + ---------------------------------------------------------------------- + Engine | | | | | + cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276 + cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703 + vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410 + hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008 + Interactions | | | | | + gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541 + gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574 + Controls | | | | | + gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482 + gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182 + drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198 + Message + + Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed + using a Wald t-distribution approximation. + +--- + + Code + print(out, sep = " ", groups = list(Engine = c(5, 6, 4, 1), Interactions = c(8, + 9), Controls = c(2, 3, 7))) + Output + Parameter Coefficient SE 95% CI t(22) p + ----------------------------------------------------------------- + Engine + cyl [6] -2.47 2.21 [ -7.05, 2.12] -1.12 0.276 + cyl [8] 1.97 5.11 [ -8.63, 12.58] 0.39 0.703 + vs 3.18 3.79 [ -4.68, 11.04] 0.84 0.410 + hp -0.06 0.02 [ -0.11, -0.02] -2.91 0.008 + Interactions + gear [4] * vs -2.90 4.67 [-12.57, 6.78] -0.62 0.541 + gear [5] * vs 2.59 4.54 [ -6.82, 12.00] 0.57 0.574 + Controls + gear [4] 3.10 4.34 [ -5.90, 12.10] 0.71 0.482 + gear [5] 4.80 3.48 [ -2.42, 12.01] 1.38 0.182 + drat 2.70 2.03 [ -1.52, 6.91] 1.33 0.198 Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed @@ -233,23 +258,23 @@ # select pattern Code - print(out, groups = list(Engine = c("cyl6", "cyl8", "vs", "hp"), Interactions = c( - "gear4:vs", "gear5:vs"), Controls = c(2, 3, 7))) + print(out, groups = list(Engine = c(5, 6, 4, 1), Interactions = c(8, 9), + Controls = c(2, 3, 7))) Output - Parameter | Coefficient | SE | 95% CI | t(22) | p - ----------------------------------------------------------------------- - Engine | | | | | - cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276 - cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703 - vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410 - hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008 - Interactions | | | | | - gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541 - gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574 - Controls | | | | | - gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482 - gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182 - drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198 + Parameter | Coefficient | SE | 95% CI | t(22) | p + ---------------------------------------------------------------------- + Engine | | | | | + cyl [6] | -2.47 | 2.21 | [ -7.05, 2.12] | -1.12 | 0.276 + cyl [8] | 1.97 | 5.11 | [ -8.63, 12.58] | 0.39 | 0.703 + vs | 3.18 | 3.79 | [ -4.68, 11.04] | 0.84 | 0.410 + hp | -0.06 | 0.02 | [ -0.11, -0.02] | -2.91 | 0.008 + Interactions | | | | | + gear [4] * vs | -2.90 | 4.67 | [-12.57, 6.78] | -0.62 | 0.541 + gear [5] * vs | 2.59 | 4.54 | [ -6.82, 12.00] | 0.57 | 0.574 + Controls | | | | | + gear [4] | 3.10 | 4.34 | [ -5.90, 12.10] | 0.71 | 0.482 + gear [5] | 4.80 | 3.48 | [ -2.42, 12.01] | 1.38 | 0.182 + drat | 2.70 | 2.03 | [ -1.52, 6.91] | 1.33 | 0.198 Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed @@ -260,17 +285,17 @@ Code print(out, select = "{coef} ({se})") Output - Parameter | Estimate (SE) - ----------------------------- - hp | -0.06 (0.02) - gear [4] | 3.10 (4.34) - gear [5] | 4.80 (3.48) - vs | 3.18 (3.79) - cyl [6] | -2.47 (2.21) - cyl [8] | 1.97 (5.11) - drat | 2.70 (2.03) - gear [4] * vs | -2.90 (4.67) - gear [5] * vs | 2.59 (4.54) + Parameter | Coefficient (SE) + -------------------------------- + hp | -0.06 (0.02) + gear [4] | 3.10 (4.34) + gear [5] | 4.80 (3.48) + vs | 3.18 (3.79) + cyl [6] | -2.47 (2.21) + cyl [8] | 1.97 (5.11) + drat | 2.70 (2.03) + gear [4] * vs | -2.90 (4.67) + gear [5] * vs | 2.59 (4.54) Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed @@ -281,17 +306,17 @@ Code print(out, select = "{coef}{stars}|[{ci}]") Output - Parameter | Estimate | [ci] - ------------------------------------------ - hp | -0.06** | [ -0.11, -0.02] - gear [4] | 3.10 | [ -5.90, 12.10] - gear [5] | 4.80 | [ -2.42, 12.01] - vs | 3.18 | [ -4.68, 11.04] - cyl [6] | -2.47 | [ -7.05, 2.12] - cyl [8] | 1.97 | [ -8.63, 12.58] - drat | 2.70 | [ -1.52, 6.91] - gear [4] * vs | -2.90 | [-12.57, 6.78] - gear [5] * vs | 2.59 | [ -6.82, 12.00] + Parameter | Coefficient | [CI] + --------------------------------------------- + hp | -0.06** | [ -0.11, -0.02] + gear [4] | 3.10 | [ -5.90, 12.10] + gear [5] | 4.80 | [ -2.42, 12.01] + vs | 3.18 | [ -4.68, 11.04] + cyl [6] | -2.47 | [ -7.05, 2.12] + cyl [8] | 1.97 | [ -8.63, 12.58] + drat | 2.70 | [ -1.52, 6.91] + gear [4] * vs | -2.90 | [-12.57, 6.78] + gear [5] * vs | 2.59 | [ -6.82, 12.00] Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed @@ -300,23 +325,23 @@ --- Code - print(out, groups = list(Engine = c("cyl6", "cyl8", "vs", "hp"), Interactions = c( - "gear4:vs", "gear5:vs"), Controls = c(2, 3, 7)), select = "{coef}{stars}|[{ci}]") + print(out, groups = list(Engine = c(5, 6, 4, 1), Interactions = c(8, 9), + Controls = c(2, 3, 7)), select = "{coef}{stars}|[{ci}]") Output - Parameter | Estimate | [ci] - --------------------------------------------- - Engine | | - cyl [6] | -2.47 | [ -7.05, 2.12] - cyl [8] | 1.97 | [ -8.63, 12.58] - vs | 3.18 | [ -4.68, 11.04] - hp | -0.06** | [ -0.11, -0.02] - Interactions | | - gear [4] * vs | -2.90 | [-12.57, 6.78] - gear [5] * vs | 2.59 | [ -6.82, 12.00] - Controls | | - gear [4] | 3.10 | [ -5.90, 12.10] - gear [5] | 4.80 | [ -2.42, 12.01] - drat | 2.70 | [ -1.52, 6.91] + Parameter | Coefficient | [CI] + ----------------------------------------------- + Engine | | + cyl [6] | -2.47 | [ -7.05, 2.12] + cyl [8] | 1.97 | [ -8.63, 12.58] + vs | 3.18 | [ -4.68, 11.04] + hp | -0.06** | [ -0.11, -0.02] + Interactions | | + gear [4] * vs | -2.90 | [-12.57, 6.78] + gear [5] * vs | 2.59 | [ -6.82, 12.00] + Controls | | + gear [4] | 3.10 | [ -5.90, 12.10] + gear [5] | 4.80 | [ -2.42, 12.01] + drat | 2.70 | [ -1.52, 6.91] Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed @@ -325,23 +350,23 @@ --- Code - print(out, sep = " ", groups = list(Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), Controls = c(2, 3, 7)), select = "{coef}{stars}|[{ci}]") + print(out, sep = " ", groups = list(Engine = c(5, 6, 4, 1), Interactions = c(8, + 9), Controls = c(2, 3, 7)), select = "{coef}{stars}|[{ci}]") Output - Parameter Estimate [ci] - ------------------------------------------- - Engine - cyl [6] -2.47 [ -7.05, 2.12] - cyl [8] 1.97 [ -8.63, 12.58] - vs 3.18 [ -4.68, 11.04] - hp -0.06** [ -0.11, -0.02] - Interactions - gear [4] * vs -2.90 [-12.57, 6.78] - gear [5] * vs 2.59 [ -6.82, 12.00] - Controls - gear [4] 3.10 [ -5.90, 12.10] - gear [5] 4.80 [ -2.42, 12.01] - drat 2.70 [ -1.52, 6.91] + Parameter Coefficient [CI] + --------------------------------------------- + Engine + cyl [6] -2.47 [ -7.05, 2.12] + cyl [8] 1.97 [ -8.63, 12.58] + vs 3.18 [ -4.68, 11.04] + hp -0.06** [ -0.11, -0.02] + Interactions + gear [4] * vs -2.90 [-12.57, 6.78] + gear [5] * vs 2.59 [ -6.82, 12.00] + Controls + gear [4] 3.10 [ -5.90, 12.10] + gear [5] 4.80 [ -2.42, 12.01] + drat 2.70 [ -1.52, 6.91] Message Uncertainty intervals (equal-tailed) and p-values (two-tailed) computed diff --git a/tests/testthat/test-printing.R b/tests/testthat/test-printing.R index 763c6acbb9..7fdb4e9c69 100644 --- a/tests/testthat/test-printing.R +++ b/tests/testthat/test-printing.R @@ -39,8 +39,15 @@ withr::with_options( out <- model_parameters(model, drop = "^\\(Intercept") expect_snapshot( print(out, groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), # c("cyl6", "cyl8", "vs", "hp"), + Interactions = c(8, 9), # c("gear4:vs", "gear5:vs"), + Controls = c(2, 3, 7) + )) + ) + expect_snapshot( + print(out, groups = list( + Engine = c("cyl [6]", "cyl [8]", "vs", "hp"), + Interactions = c("gear [4] * vs", "gear [5] * vs"), Controls = c(2, 3, 7) )) ) @@ -48,8 +55,8 @@ withr::with_options( print(out, sep = " ", groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9), Controls = c(2, 3, 7) ) ) @@ -80,8 +87,8 @@ withr::with_options( out <- model_parameters(model, drop = "^\\(Intercept") expect_snapshot( print(out, groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9), Controls = c(2, 3, 7) )) ) @@ -89,8 +96,8 @@ withr::with_options( expect_snapshot(print(out, select = "{coef}{stars}|[{ci}]")) expect_snapshot( print(out, groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9), Controls = c(2, 3, 7) ), select = "{coef}{stars}|[{ci}]") ) @@ -98,8 +105,8 @@ withr::with_options( print(out, sep = " ", groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9), Controls = c(2, 3, 7) ), select = "{coef}{stars}|[{ci}]" From b18bbc353fbe02ce795f1ed6aca257c2e0413bf8 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 10:21:09 +0200 Subject: [PATCH 15/33] fix --- R/print_html.R | 41 ++++++++++++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 9 deletions(-) diff --git a/R/print_html.R b/R/print_html.R index d5fe8155bb..54ef29d2e3 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -215,18 +215,37 @@ print_html.compare_parameters <- function(x, formatted_table$Parameter <- gsub("]", ci_brackets[2], formatted_table$Parameter, fixed = TRUE) } - # setup grouping for tt-backend + # setup grouping for tt-backend -------------------------------------------- + # -------------------------------------------------------------------------- + + model_groups <- NULL + by <- NULL + if (identical(engine, "tt")) { - models <- unique(gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1]) - model_groups <- lapply(models, function(model) { - which(endsWith(colnames(formatted_table), paste0("(", model, ")"))) - }) - names(model_groups) <- models - colnames(formatted_table)[-1] <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)[-1]) - } else { - model_groups <- NULL + # find columns that contain model names, which we want to group + models <- setdiff( + unique(gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1]), + c("Component", "Effects", "Response", "Group") + ) + # grouping only applies when we have custom column layout (with "select") + # else, we don't need grouping + if (any(grepl(paste0("(", models[1], ")"), colnames(formatted_table), fixed = TRUE))) { + model_groups <- lapply(models, function(model) { + which(endsWith(colnames(formatted_table), paste0("(", model, ")"))) + }) + names(model_groups) <- models + colnames(formatted_table)[-1] <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)[-1]) + } + if ("Component" %in% colnames(formatted_table)) { + by <- c(by, "Component") + } + if ("Effects" %in% colnames(formatted_table)) { + by <- c(by, "Effects") + } } + # export table ------------------------------------------------------------ + out <- insight::export_table( formatted_table, format = ifelse(identical(engine, "tt"), "tt", "html"), @@ -234,9 +253,13 @@ print_html.compare_parameters <- function(x, subtitle = subtitle, footer = footer, column_groups = model_groups, + by = by, ... ) + # setup gt-backend --------------------------------------------------------- + # -------------------------------------------------------------------------- + if (identical(engine, "tt")) { out } else { From ef047a493c10b03b521e2f13c508e09ccf782fd6 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 10:26:21 +0200 Subject: [PATCH 16/33] engines --- R/print_html.R | 19 ++++++++++++++++--- R/utils_pca_efa.R | 13 ++++++++++++- 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/R/print_html.R b/R/print_html.R index 54ef29d2e3..aae857fe51 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -286,6 +286,7 @@ print_html.parameters_efa <- function(x, sort = FALSE, threshold = NULL, labels = NULL, + engine = "gt", ...) { # extract attributes if (is.null(threshold)) { @@ -295,7 +296,7 @@ print_html.parameters_efa <- function(x, x, threshold = threshold, sort = sort, - format = "html", + format = engine, digits = digits, labels = labels, ... @@ -307,7 +308,13 @@ print_html.parameters_pca <- print_html.parameters_efa #' @export -print_html.parameters_efa_summary <- function(x, digits = 3, ...) { +print_html.parameters_efa_summary <- function(x, digits = 3, engine = "gt", ...) { + # html engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) + table_caption <- "(Explained) Variance of Components" if ("Parameter" %in% names(x)) { @@ -327,7 +334,13 @@ print_html.parameters_efa_summary <- function(x, digits = 3, ...) { x <- .safe(rbind(x, fc), x) } - insight::export_table(x, digits = digits, format = "html", caption = table_caption, align = "firstleft") + insight::export_table( + x, + digits = digits, + format = ifelse(identical(engine, "tt"), "tt", "html"), + caption = table_caption, + align = "firstleft" + ) } #' @export diff --git a/R/utils_pca_efa.R b/R/utils_pca_efa.R index 711f90a456..dabf64117a 100644 --- a/R/utils_pca_efa.R +++ b/R/utils_pca_efa.R @@ -363,7 +363,13 @@ print.parameters_omega_summary <- function(x, ...) { } -.print_parameters_cfa_efa <- function(x, threshold, sort, format, digits, labels, ...) { +.print_parameters_cfa_efa <- function(x, threshold, sort, format, digits, labels, engine = "gt", ...) { + # html engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) + # Method if (inherits(x, "parameters_pca")) { method <- "Principal Component Analysis" @@ -419,6 +425,11 @@ print.parameters_omega_summary <- function(x, ...) { alignment <- paste(c("ll", rep("r", ncol(x) - 2)), collapse = "") } + # set engine for html format + if (format == "html") { + format <- ifelse(identical(engine, "tt"), "tt", "html") + } + insight::export_table( x, digits = digits, From b82570976868b4e27321ffaa16a047cc464dd26c Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 12:53:44 +0200 Subject: [PATCH 17/33] no need for print_table --- NAMESPACE | 1 - R/display.R | 36 ++++--- R/print_html.R | 81 +++++++-------- R/print_table.R | 171 -------------------------------- man/display.parameters_model.Rd | 26 ++--- man/model_parameters.aov.Rd | 1 + man/model_parameters.htest.Rd | 1 + 7 files changed, 70 insertions(+), 247 deletions(-) delete mode 100644 R/print_table.R diff --git a/NAMESPACE b/NAMESPACE index 2a81e4bdca..4d721be7c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -981,7 +981,6 @@ export(pool_parameters) export(principal_components) export(print_html) export(print_md) -export(print_table) export(random_parameters) export(reduce_data) export(reduce_parameters) diff --git a/R/display.R b/R/display.R index 7b0db81d49..42a731b970 100644 --- a/R/display.R +++ b/R/display.R @@ -3,8 +3,7 @@ #' #' @description Prints tables (i.e. data frame) in different output formats. #' `print_md()` is an alias for `display(format = "markdown")`, `print_html()` -#' is an alias for `display(format = "html")`. `print_table()` is for specific -#' use cases only, and currently only works for `compare_parameters()` objects. +#' is an alias for `display(format = "html")`. #' #' @param x An object returned by [`model_parameters()`]. #' @param object An object returned by [`model_parameters()`],[`simulate_parameters()`], @@ -36,8 +35,7 @@ #' #' @return If `format = "markdown"`, the return value will be a character #' vector in markdown-table format. If `format = "html"`, an object of -#' class `gt_tbl`. For `print_table()`, an object of class `tinytable` is -#' returned. +#' class `gt_tbl`. #' #' @details `display()` is useful when the table-output from functions, #' which is usually printed as formatted text-table to console, should @@ -46,14 +44,6 @@ #' [vignette](https://easystats.github.io/parameters/articles/model_parameters_formatting.html) #' for examples. #' -#' `print_table()` is a special function for `compare_parameters()` objects, -#' which prints the output as a formatted HTML table. It is still somewhat -#' experimental, thus, only a fixed layout-style is available at the moment -#' (columns for estimates, confidence intervals and p-values). However, it -#' is possible to include other model components, like zero-inflation, or random -#' effects in the table. See 'Examples'. An alternative is to set `engine = "tt"` -#' in `print_html()` to use the _tinytable_ package for creating HTML tables. -#' #' @seealso [print.parameters_model()] and [print.compare_parameters()] #' #' @examplesIf require("gt", quietly = TRUE) @@ -81,6 +71,28 @@ #' column_labels = c("Est. (95% CI)") #' ) #' } +#' +#' @examplesIf all(insight::check_if_installed(c("glmmTMB", "lme4", "tinytable"), quietly = TRUE)) +#' \donttest{ +#' data(iris) +#' data(Salamanders, package = "glmmTMB") +#' m1 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) +#' m2 <- lme4::lmer( +#' Sepal.Length ~ Petal.Length + Petal.Width + (1 | Species), +#' data = iris +#' ) +#' m3 <- glmmTMB::glmmTMB( +#' count ~ spp + mined + (1 | site), +#' ziformula = ~mined, +#' family = poisson(), +#' data = Salamanders +#' ) +#' out <- compare_parameters(m1, m2, m3, effects = "all", component = "all") +#' +#' display(out, format = "tt") +#' +#' display(out, select = "{estimate}|{ci}", format = "tt") +#' } #' @export display.parameters_model <- function(object, format = "markdown", diff --git a/R/print_html.R b/R/print_html.R index aae857fe51..6b174e9e2b 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -221,28 +221,33 @@ print_html.compare_parameters <- function(x, model_groups <- NULL by <- NULL - if (identical(engine, "tt")) { - # find columns that contain model names, which we want to group - models <- setdiff( - unique(gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1]), - c("Component", "Effects", "Response", "Group") - ) - # grouping only applies when we have custom column layout (with "select") - # else, we don't need grouping - if (any(grepl(paste0("(", models[1], ")"), colnames(formatted_table), fixed = TRUE))) { - model_groups <- lapply(models, function(model) { - which(endsWith(colnames(formatted_table), paste0("(", model, ")"))) - }) - names(model_groups) <- models - colnames(formatted_table)[-1] <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)[-1]) - } - if ("Component" %in% colnames(formatted_table)) { - by <- c(by, "Component") - } - if ("Effects" %in% colnames(formatted_table)) { - by <- c(by, "Effects") + # find columns that contain model names, which we want to group + models <- setdiff( + unique(gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1]), + c("Component", "Effects", "Response", "Group") + ) + # grouping only applies when we have custom column layout (with "select") + # else, we don't need grouping + if (any(grepl(paste0("(", models[1], ")"), colnames(formatted_table), fixed = TRUE))) { + model_groups <- lapply(models, function(model) { + which(endsWith(colnames(formatted_table), paste0("(", model, ")"))) + }) + names(model_groups) <- models + if (identical(engine, "tt")) { + # for the tt backend, we need to add the model name to the column names + colnames(formatted_table)[-1] <- gsub( + "(.*) \\((.*)\\)$", + "\\1", + colnames(formatted_table)[-1] + ) } } + if ("Component" %in% colnames(formatted_table)) { + by <- c(by, "Component") + } + if ("Effects" %in% colnames(formatted_table)) { + by <- c(by, "Effects") + } # export table ------------------------------------------------------------ @@ -268,8 +273,6 @@ print_html.compare_parameters <- function(x, style = select, font_size = font_size, line_padding = line_padding, - # we assume that model names are at the end of each column name, in parenthesis - original_colnames = gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table))[-1], column_names = colnames(formatted_table), user_labels = column_labels ) @@ -353,7 +356,6 @@ print_html.parameters_pca_summary <- print_html.parameters_efa_summary style, font_size = "100%", line_padding = 4, - original_colnames = NULL, column_names = NULL, user_labels = NULL) { insight::check_if_installed("gt") @@ -375,29 +377,18 @@ print_html.parameters_pca_summary <- print_html.parameters_efa_summary ) new_labels <- as.list(new_labels) } - # add a column span? here we have multiple columns (like estimate, CI, p, ...) - # for each model. In this case, we want to add a column spanner, i.e. a - # separate heading for all columns of each model. - if (!is.null(original_colnames) && anyDuplicated(original_colnames) > 0) { - duplicates <- original_colnames[duplicated(original_colnames)] - for (d in duplicates) { - # we need +1 here, because first column is parameter column - span <- which(original_colnames == d) + 1 - # add column spanner - out <- gt::tab_spanner(out, label = d, columns = span) - } - # relabel columns. The single columns still have their old labels - # (like "Estimate (model1)", "p (model1)"), and we extracted the "model names" - # and used them for the column spanner. Now we no longer need this suffix, - # and remove it. In case user-defined column labels are provided, "new_labels" - # is not NULL, so we use user labels, else we extract labels from columns. - if (!is.null(column_names)) { - if (is.null(new_labels)) { - new_labels <- as.list(gsub("(.*) \\((.*)\\)$", "\\1", column_names)) - } - names(new_labels) <- column_names - out <- gt::cols_label(out, .list = new_labels) + + # relabel columns. The single columns still have their old labels + # (like "Estimate (model1)", "p (model1)"), and we extracted the "model names" + # and used them for the column spanner. Now we no longer need this suffix, + # and remove it. In case user-defined column labels are provided, "new_labels" + # is not NULL, so we use user labels, else we extract labels from columns. + if (!is.null(column_names)) { + if (is.null(new_labels)) { + new_labels <- as.list(gsub("(.*) \\((.*)\\)$", "\\1", column_names)) } + names(new_labels) <- column_names + out <- gt::cols_label(out, .list = new_labels) # default column label, if we have user labels } else if (!is.null(new_labels)) { names(new_labels) <- colnames(out[["_data"]]) diff --git a/R/print_table.R b/R/print_table.R deleted file mode 100644 index d86399c09f..0000000000 --- a/R/print_table.R +++ /dev/null @@ -1,171 +0,0 @@ -#' @examplesIf require("tinytable") && require("lme4") && require("glmmTMB") -#' \donttest{ -#' data(iris) -#' data(Salamanders, package = "glmmTMB") -#' m1 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris) -#' m2 <- lme4::lmer( -#' Sepal.Length ~ Petal.Length + Petal.Width + (1 | Species), -#' data = iris -#' ) -#' m3 <- glmmTMB::glmmTMB( -#' count ~ spp + mined + (1 | site), -#' ziformula = ~mined, -#' family = poisson(), -#' data = Salamanders -#' ) -#' out <- compare_parameters(m1, m2, m3, effects = "all", component = "all") -#' print_table(out) -#' } -#' @rdname display.parameters_model -#' @export -print_table <- function(x, digits = 2, p_digits = 3, theme = "default", ...) { - insight::check_if_installed(c("datawizard", "tinytable")) - - if (!inherits(x, "compare_parameters")) { - insight::format_error("`print_table` can only be used with `compare_parameters` objects.") - } - - # random parameters? - random_variances <- any(unlist(lapply(attributes(x)$all_attributes, function(i) { - i$ran_pars - }))) - - # remember attributes - ci_lvl <- attributes(x)$all_attributes[[1]]$ci - model_names <- attributes(x)$model_names - - # check if we have mixed models with random variance parameters. in such - # cases, we don't need the group-column, but we rather merge it with the - # parameter column - if (isTRUE(random_variances)) { - # if (any(c("brmsfit", "stanreg", "stanmvreg") %in% m_class)) { - # # rename random effect parameters names for stan models - # x <- .format_stan_parameters(x) - # } else { - # x <- .format_ranef_parameters(x) - # } - x <- .format_ranef_parameters(x) - x$Group <- NULL - } - - # check if we have only have fixed effects, and if so, remove column - if (!is.null(x$Effects) && all(x$Effects == "fixed")) { - x$Effects <- NULL - } - # check if we have only have conditional component, and if so, remove column - if (!is.null(x$Component) && all(x$Component == "conditional")) { - x$Component <- NULL - } - - # check if we have models with extra components (e.g., zero-inflated models) - # if so, we need to create a group variable, so we can include subheaders in - # the table, and we want to re-arrange rows - if (!is.null(x$Component) || !is.null(x$Effects)) { - # create group variable, so we can include subheaders in table - x$groups <- paste0(x$Component, ".", x$Effects) - x <- datawizard::data_arrange(x, c("Effects", "Component")) - # remove further unused columns - x$Component <- NULL - x$Effects <- NULL - } - - # we now iterate all model columns, remove non-used columns per model, - # and create the formated CI columns etc. - for (i in model_names) { - x[paste0("SE.", i)] <- NULL - x[paste0("df_error.", i)] <- NULL - x[paste0("z.", i)] <- NULL - x[paste0("t.", i)] <- NULL - ci_pos <- which(colnames(x) == paste0("CI.", i)) - x[paste0("CI.", i)] <- NULL - - # format estimate columns - estimate_col <- min(which(endsWith(colnames(x), paste0(".", i)))) - x[[estimate_col]] <- insight::format_value( - x[[estimate_col]], - digits = digits, - zap_small = TRUE - ) - - # format CI columns - x$CI <- insight::format_ci( - x[[paste0("CI_low.", i)]], - x[[paste0("CI_high.", i)]], - digits = digits, - ci = NULL, - brackets = FALSE, - zap_small = TRUE - ) - colnames(x)[colnames(x) == "CI"] <- paste0(sprintf("%g", 100 * ci_lvl), "% CI.", i) - x[paste0("CI_low.", i)] <- NULL - x[paste0("CI_high.", i)] <- NULL - - # format p-values - x[[paste0("p.", i)]] <- insight::format_p( - x[[paste0("p.", i)]], - digits = p_digits, - name = NULL - ) - - # relocate CI columns to right position - x <- x[c(1:(ci_pos - 1), ncol(x), ci_pos:(ncol(x) - 1))] - } - - # used for subgroup headers, if available - row_header_pos <- row_header_labels <- NULL - - if (!is.null(x$groups)) { - # find start row of each subgroup - row_header_pos <- which(!duplicated(x$groups)) - group_headers <- as.vector(x$groups[row_header_pos]) - for (i in seq_along(group_headers)) { - gh <- .format_model_component_header( - x = NULL, - type = group_headers[i], - split_column = "", - is_zero_inflated = FALSE, - is_ordinal_model = FALSE, - is_multivariate = FALSE, - ran_pars = random_variances, - formatted_table = NULL - ) - group_headers[i] <- gh$name - } - # create named list, required for tinytables - row_header_labels <- as.list(stats::setNames(row_header_pos, group_headers)) - # since we have the group names in "row_header_labels" now , we can remove the column - x$groups <- NULL - # make sure that the row header positions are correct - each header - # must be shifted by the number of rows above - for (i in 2:length(row_header_pos)) { - row_header_pos[i] <- row_header_pos[i] + (i - 1) - } - } - - # find out position of column groups - col_groups <- lapply(model_names, function(i) { - which(endsWith(colnames(x), paste0(".", i))) - }) - names(col_groups) <- model_names - - # fix column names - for (i in model_names) { - colnames(x) <- gsub(paste0("\\.", i, "$"), "", colnames(x)) - } - - # base table - out <- tinytable::tt(as.data.frame(x), caption = NULL, notes = NULL, ...) - # add subheaders, if any - if (is.null(row_header_labels)) { - out <- tinytable::group_tt(out, j = col_groups) - } else { - out <- tinytable::group_tt(out, i = row_header_labels, j = col_groups) - out <- tinytable::style_tt(out, i = row_header_pos, italic = TRUE) - } - # style table - out <- insight::apply_table_theme(out, x, theme = theme, sub_header_positions = row_header_pos) - # make sure HTML is default output - out@output <- "html" - - out -} diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index d2a4aa40a5..f53cae9f63 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -1,12 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/display.R, R/print_table.R +% Please edit documentation in R/display.R \name{display.parameters_model} \alias{display.parameters_model} \alias{display.parameters_sem} \alias{display.parameters_efa_summary} \alias{display.parameters_efa} \alias{display.equivalence_test_lm} -\alias{print_table} \title{Print tables in different output formats} \usage{ \method{display}{parameters_model}( @@ -58,8 +57,6 @@ ) \method{display}{equivalence_test_lm}(object, format = "markdown", digits = 2, ...) - -print_table(x, digits = 2, p_digits = 3, theme = "default", ...) } \arguments{ \item{object}{An object returned by \code{\link[=model_parameters]{model_parameters()}},\code{\link[=simulate_parameters]{simulate_parameters()}}, @@ -203,14 +200,12 @@ loadings data. Usually, the question related to the item.} \value{ If \code{format = "markdown"}, the return value will be a character vector in markdown-table format. If \code{format = "html"}, an object of -class \code{gt_tbl}. For \code{print_table()}, an object of class \code{tinytable} is -returned. +class \code{gt_tbl}. } \description{ Prints tables (i.e. data frame) in different output formats. \code{print_md()} is an alias for \code{display(format = "markdown")}, \code{print_html()} -is an alias for \code{display(format = "html")}. \code{print_table()} is for specific -use cases only, and currently only works for \code{compare_parameters()} objects. +is an alias for \code{display(format = "html")}. } \details{ \code{display()} is useful when the table-output from functions, @@ -219,14 +214,6 @@ be formatted for pretty table-rendering in markdown documents, or if knitted from rmarkdown to PDF or Word files. See \href{https://easystats.github.io/parameters/articles/model_parameters_formatting.html}{vignette} for examples. - -\code{print_table()} is a special function for \code{compare_parameters()} objects, -which prints the output as a formatted HTML table. It is still somewhat -experimental, thus, only a fixed layout-style is available at the moment -(columns for estimates, confidence intervals and p-values). However, it -is possible to include other model components, like zero-inflation, or random -effects in the table. See 'Examples'. An alternative is to set \code{engine = "tt"} -in \code{print_html()} to use the \emph{tinytable} package for creating HTML tables. } \examples{ \dontshow{if (require("gt", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} @@ -255,7 +242,7 @@ print_html( ) } \dontshow{\}) # examplesIf} -\dontshow{if (require("tinytable") && require("lme4") && require("glmmTMB")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (all(insight::check_if_installed(c("glmmTMB", "lme4", "tinytable"), quietly = TRUE))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ data(iris) data(Salamanders, package = "glmmTMB") @@ -271,7 +258,10 @@ m3 <- glmmTMB::glmmTMB( data = Salamanders ) out <- compare_parameters(m1, m2, m3, effects = "all", component = "all") -print_table(out) + +display(out, format = "tt") + +display(out, select = "{estimate}|{ci}", format = "tt") } \dontshow{\}) # examplesIf} } diff --git a/man/model_parameters.aov.Rd b/man/model_parameters.aov.Rd index 9b878a027c..a3e4b733d9 100644 --- a/man/model_parameters.aov.Rd +++ b/man/model_parameters.aov.Rd @@ -138,6 +138,7 @@ Parameters from ANOVAs \item A \strong{proportion test} returns \emph{p}. } \item Objects of class \code{anova}, \code{aov}, \code{aovlist} or \code{afex_aov}, depending on \code{type}: \code{"eta"} (default), \code{"omega"} or \code{"epsilon"} -squared, \code{"f"}, or \code{"f2"}. +\item Objects of class \code{datawizard_crosstab(s)} / \code{datawizard_table(s)} built with \code{\link[datawizard:data_tabulate]{datawizard::data_tabulate()}} - same as Chi-squared tests of independence / goodness-of-fit, respectively. \item Other objects are passed to \code{\link[parameters:standardize_parameters]{parameters::standardize_parameters()}}. } diff --git a/man/model_parameters.htest.Rd b/man/model_parameters.htest.Rd index 5254ca2ad2..e326d83eb6 100644 --- a/man/model_parameters.htest.Rd +++ b/man/model_parameters.htest.Rd @@ -128,6 +128,7 @@ Parameters of h-tests (correlations, t-tests, chi-squared, ...). \item A \strong{proportion test} returns \emph{p}. } \item Objects of class \code{anova}, \code{aov}, \code{aovlist} or \code{afex_aov}, depending on \code{type}: \code{"eta"} (default), \code{"omega"} or \code{"epsilon"} -squared, \code{"f"}, or \code{"f2"}. +\item Objects of class \code{datawizard_crosstab(s)} / \code{datawizard_table(s)} built with \code{\link[datawizard:data_tabulate]{datawizard::data_tabulate()}} - same as Chi-squared tests of independence / goodness-of-fit, respectively. \item Other objects are passed to \code{\link[parameters:standardize_parameters]{parameters::standardize_parameters()}}. } From c21d5c35afa2f6191c6b6e8d7d0c17b75b82128a Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:00:45 +0200 Subject: [PATCH 18/33] update --- R/display.R | 8 ++-- R/print_html.R | 10 ++++- R/print_md.R | 72 +++++++++++++-------------------- R/utils_pca_efa.R | 4 +- man/print.compare_parameters.Rd | 1 - 5 files changed, 43 insertions(+), 52 deletions(-) diff --git a/R/display.R b/R/display.R index 42a731b970..0a91674a34 100644 --- a/R/display.R +++ b/R/display.R @@ -216,7 +216,8 @@ display.parameters_sem <- function(object, digits = digits, ci_digits = ci_digits, p_digits = p_digits, - ci_brackets = ci_brackets + ci_brackets = ci_brackets, + engine = ifelse(format == "tt", "tt", "gt") ) if (format %in% c("html", "tt")) { @@ -234,7 +235,7 @@ display.parameters_sem <- function(object, #' @export display.parameters_efa_summary <- function(object, format = "markdown", digits = 3, ...) { format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) - fun_args <- list(x = object, digits = digits) + fun_args <- list(x = object, digits = digits, engine = ifelse(format == "tt", "tt", "gt")) if (format %in% c("html", "tt")) { do.call(print_html, c(fun_args, list(...))) @@ -261,7 +262,8 @@ display.parameters_efa <- function(object, format = "markdown", digits = 2, sort digits = digits, sort = sort, threshold = threshold, - labels = labels + labels = labels, + engine = ifelse(format == "tt", "tt", "gt") ) if (format %in% c("html", "tt")) { diff --git a/R/print_html.R b/R/print_html.R index 6b174e9e2b..0b019ad694 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -186,7 +186,7 @@ print_html.compare_parameters <- function(x, select <- attributes(x)$output_style } - # markdown engine? + # which engine? engine <- insight::validate_argument( getOption("easystats_html_engine", engine), c("gt", "default", "tt") @@ -291,6 +291,12 @@ print_html.parameters_efa <- function(x, labels = NULL, engine = "gt", ...) { + # which engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) + # extract attributes if (is.null(threshold)) { threshold <- attributes(x)$threshold @@ -299,7 +305,7 @@ print_html.parameters_efa <- function(x, x, threshold = threshold, sort = sort, - format = engine, + format = ifelse(identical(engine, "tt"), "tt", "html"), digits = digits, labels = labels, ... diff --git a/R/print_md.R b/R/print_md.R index 30434167c6..a861c573b4 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -98,7 +98,6 @@ print_md.parameters_model <- function(x, } } - insight::export_table( formatted_table, format = "markdown", @@ -134,7 +133,6 @@ print_md.compare_parameters <- function(x, ci_brackets = c("(", ")"), zap_small = FALSE, groups = NULL, - engine = "tt", ...) { # check if user supplied digits attributes if (missing(digits)) { @@ -155,9 +153,6 @@ print_md.compare_parameters <- function(x, groups <- attributes(x)$parameter_groups } - # markdown engine? - engine <- insight::validate_argument(engine, c("tt", "default")) - formatted_table <- format( x, select = select, @@ -169,8 +164,7 @@ print_md.compare_parameters <- function(x, ci_brackets = ci_brackets, format = "markdown", zap_small = zap_small, - groups = groups, - engine = engine + groups = groups ) # replace brackets by parenthesis @@ -179,36 +173,13 @@ print_md.compare_parameters <- function(x, formatted_table$Parameter <- gsub("]", ci_brackets[2], formatted_table$Parameter, fixed = TRUE) } - if (identical(engine, "tt")) { - # retrieve output format - print_md() may be called from print_html() - dots <- list(...) - if (identical(dots$outformat, "html")) { - outformat <- "html" - } else { - outformat <- "markdown" - } - - col_names <- gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table)) - col_groups <- sapply(attributes(x)$model_names, function(i) which(i == col_names), simplify = FALSE) - colnames(formatted_table) <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)) - - insight::export_table( - formatted_table, - format = "tt", - caption = caption, - subtitle = subtitle, - footer = footer, - column_groups = col_groups - ) - } else { - insight::export_table( - formatted_table, - format = "markdown", - caption = caption, - subtitle = subtitle, - footer = footer - ) - } + insight::export_table( + formatted_table, + format = "markdown", + caption = caption, + subtitle = subtitle, + footer = footer + ) } @@ -317,11 +288,13 @@ print_md.parameters_omega <- print_md.parameters_efa # Equivalence test ---------------------------- #' @export -print_md.equivalence_test_lm <- function(x, - digits = 2, - ci_brackets = c("(", ")"), - zap_small = FALSE, - ...) { +print_md.equivalence_test_lm <- function( + x, + digits = 2, + ci_brackets = c("(", ")"), + zap_small = FALSE, + ... +) { rule <- attributes(x)$rule rope <- attributes(x)$rope @@ -363,8 +336,19 @@ print_md.equivalence_test_lm <- function(x, } if (!is.null(rope)) { - names(formatted_table)[names(formatted_table) == "% in ROPE"] <- sprintf("%% in ROPE (%.*f, %.*f)", digits, rope[1], digits, rope[2]) # nolint + names(formatted_table)[names(formatted_table) == "% in ROPE"] <- sprintf( + "%% in ROPE (%.*f, %.*f)", + digits, + rope[1], + digits, + rope[2] + ) # nolint } - insight::export_table(formatted_table, format = "markdown", caption = table_caption, align = "firstleft") + insight::export_table( + formatted_table, + format = "markdown", + caption = table_caption, + align = "firstleft" + ) } diff --git a/R/utils_pca_efa.R b/R/utils_pca_efa.R index dabf64117a..4f2ce030c4 100644 --- a/R/utils_pca_efa.R +++ b/R/utils_pca_efa.R @@ -426,8 +426,8 @@ print.parameters_omega_summary <- function(x, ...) { } # set engine for html format - if (format == "html") { - format <- ifelse(identical(engine, "tt"), "tt", "html") + if (format == "html" && identical(engine, "tt")) { + format <- "tt" } insight::export_table( diff --git a/man/print.compare_parameters.Rd b/man/print.compare_parameters.Rd index 876899f2ea..2a63c8dc5e 100644 --- a/man/print.compare_parameters.Rd +++ b/man/print.compare_parameters.Rd @@ -73,7 +73,6 @@ ci_brackets = c("(", ")"), zap_small = FALSE, groups = NULL, - engine = "tt", ... ) } From b6d4627488694d8c68eabef512ce40d369bbd6ac Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:11:18 +0200 Subject: [PATCH 19/33] update --- tests/testthat/_snaps/compare_parameters.md | 144 +++---------- tests/testthat/_snaps/include_reference.md | 60 +++--- tests/testthat/_snaps/printing2.new.md | 211 ++++++++++++++++++++ tests/testthat/test-compare_parameters.R | 12 +- tests/testthat/test-include_reference.R | 3 +- 5 files changed, 288 insertions(+), 142 deletions(-) create mode 100644 tests/testthat/_snaps/printing2.new.md diff --git a/tests/testthat/_snaps/compare_parameters.md b/tests/testthat/_snaps/compare_parameters.md index c2e2d8d9d5..a477e60307 100644 --- a/tests/testthat/_snaps/compare_parameters.md +++ b/tests/testthat/_snaps/compare_parameters.md @@ -49,122 +49,42 @@ Code print(out) Output - +----------------+-----------------------+--------+----------------------+--------+ - | | lm1 | lm2 | - +----------------+-----------------------+--------+----------------------+--------+ - | Parameter | Estimate (ci) | p | Estimate (ci) | p | - +================+=======================+========+======================+========+ - | *Groups* | - +----------------+-----------------------+--------+----------------------+--------+ - | grp (2) | -4.31 (-15.95, 7.32) | 0.465 | 0.32 (-22.56, 23.20) | 0.978 | - +----------------+-----------------------+--------+----------------------+--------+ - | grp (3) | -1.31 (-13.47, 10.84) | 0.831 | 3.77 (-19.72, 27.26) | 0.752 | - +----------------+-----------------------+--------+----------------------+--------+ - | *Interactions* | - +----------------+-----------------------+--------+----------------------+--------+ - | Days * grp (2) | | | -1.01 (-5.35, 3.32) | 0.645 | - +----------------+-----------------------+--------+----------------------+--------+ - | Days * grp (3) | | | -1.11 (-5.53, 3.31) | 0.621 | - +----------------+-----------------------+--------+----------------------+--------+ - | *Controls* | - +----------------+-----------------------+--------+----------------------+--------+ - | Days | 10.44 (8.84, 12.03) | <0.001 | 11.23 (7.87, 14.60) | <0.001 | - +----------------+-----------------------+--------+----------------------+--------+ - | | | | | | - +----------------+-----------------------+--------+----------------------+--------+ - | Observations | 180 | | 180 | | - +----------------+-----------------------+--------+----------------------+--------+ + + + |Parameter | Coefficient (CI) (lm1)| p (lm1)| Coefficient (CI) (lm2)| p (lm2)| + |:--------------|----------------------:|-------:|----------------------:|-------:| + |Groups | | | | | + |grp (2) | -4.31 (-15.95, 7.32)| 0.465| 0.32 (-22.56, 23.20)| 0.978| + |grp (3) | -1.31 (-13.47, 10.84)| 0.831| 3.77 (-19.72, 27.26)| 0.752| + |Interactions | | | | | + |Days * grp (2) | | | -1.01 ( -5.35, 3.32)| 0.645| + |Days * grp (3) | | | -1.11 ( -5.53, 3.31)| 0.621| + |Controls | | | | | + |Days | 10.44 ( 8.84, 12.03)| <0.001| 11.23 ( 7.87, 14.60)| <0.001| + | | | | | | + |Observations | 180| | 180| | --- Code print_md(cp) Output - +-------------------------+-----------------------+--------+----------------------+--------+ - | | lm1 | lm2 | - +-------------------------+-----------------------+--------+----------------------+--------+ - | Parameter | Estimate (ci) | p | Estimate (ci) | p | - +=========================+=======================+========+======================+========+ - | Fixed Effects | - +-------------------------+-----------------------+--------+----------------------+--------+ - | Days | 10.44 (8.84, 12.03) | <0.001 | 11.23 (7.87, 14.60) | <0.001 | - +-------------------------+-----------------------+--------+----------------------+--------+ - | grp [2] | -4.31 (-15.95, 7.32) | 0.465 | 0.32 (-22.56, 23.20) | 0.978 | - +-------------------------+-----------------------+--------+----------------------+--------+ - | grp [3] | -1.31 (-13.47, 10.84) | 0.831 | 3.77 (-19.72, 27.26) | 0.752 | - +-------------------------+-----------------------+--------+----------------------+--------+ - | Days * grp [2] | | | -1.01 (-5.35, 3.32) | 0.645 | - +-------------------------+-----------------------+--------+----------------------+--------+ - | Days * grp [3] | | | -1.11 (-5.53, 3.31) | 0.621 | - +-------------------------+-----------------------+--------+----------------------+--------+ - | Random Effects | - +-------------------------+-----------------------+--------+----------------------+--------+ - | SD (Intercept: Subject) | 37.06 (25.85, 53.13) | | 37.08 (25.85, 53.19) | | - +-------------------------+-----------------------+--------+----------------------+--------+ - | SD (Residual) | 31.13 (27.89, 34.75) | | 31.30 (28.02, 34.96) | | - +-------------------------+-----------------------+--------+----------------------+--------+ - ---- - - Code - print(out) - Output - +----------------+-----------------------+--------+----------------------+--------+ - | | lm1 | lm2 | - +----------------+-----------------------+--------+----------------------+--------+ - | Parameter | Estimate (ci) | p | Estimate (ci) | p | - +================+=======================+========+======================+========+ - | *Groups* | - +----------------+-----------------------+--------+----------------------+--------+ - | grp (1) | 0.00 | | 0.00 | | - +----------------+-----------------------+--------+----------------------+--------+ - | grp (2) | -4.31 (-15.95, 7.32) | 0.465 | 0.32 (-22.56, 23.20) | 0.978 | - +----------------+-----------------------+--------+----------------------+--------+ - | grp (3) | -1.31 (-13.47, 10.84) | 0.831 | 3.77 (-19.72, 27.26) | 0.752 | - +----------------+-----------------------+--------+----------------------+--------+ - | *Interactions* | - +----------------+-----------------------+--------+----------------------+--------+ - | Days * grp (2) | | | -1.01 (-5.35, 3.32) | 0.645 | - +----------------+-----------------------+--------+----------------------+--------+ - | Days * grp (3) | | | -1.11 (-5.53, 3.31) | 0.621 | - +----------------+-----------------------+--------+----------------------+--------+ - | *Controls* | - +----------------+-----------------------+--------+----------------------+--------+ - | Days | 10.44 (8.84, 12.03) | <0.001 | 11.23 (7.87, 14.60) | <0.001 | - +----------------+-----------------------+--------+----------------------+--------+ - | | | | | | - +----------------+-----------------------+--------+----------------------+--------+ - | Observations | 180 | | 180 | | - +----------------+-----------------------+--------+----------------------+--------+ - ---- - - Code - print(out) - Output - +----------------+-----------------------+----------------------+ - | Parameter | lm1 | lm2 | - +================+=======================+======================+ - | *Groups* | - +----------------+-----------------------+----------------------+ - | grp (1) | 0.00 | 0.00 | - +----------------+-----------------------+----------------------+ - | grp (2) | -4.31 (-15.95, 7.32) | 0.32 (-22.56, 23.20) | - +----------------+-----------------------+----------------------+ - | grp (3) | -1.31 (-13.47, 10.84) | 3.77 (-19.72, 27.26) | - +----------------+-----------------------+----------------------+ - | *Interactions* | - +----------------+-----------------------+----------------------+ - | Days * grp (2) | | -1.01 (-5.35, 3.32) | - +----------------+-----------------------+----------------------+ - | Days * grp (3) | | -1.11 (-5.53, 3.31) | - +----------------+-----------------------+----------------------+ - | *Controls* | - +----------------+-----------------------+----------------------+ - | Days | 10.44 (8.84, 12.03) | 11.23 (7.87, 14.60) | - +----------------+-----------------------+----------------------+ - | | | | - +----------------+-----------------------+----------------------+ - | Observations | 180 | 180 | - +----------------+-----------------------+----------------------+ + + + Table: Fixed Effects + + |Parameter | Coefficient (CI) (lm1)| p (lm1)| Coefficient (CI) (lm2)| p (lm2)| + |:--------------|----------------------:|-------:|----------------------:|-------:| + |Days | 10.44 ( 8.84, 12.03)| <0.001| 11.23 ( 7.87, 14.60)| <0.001| + |grp [2] | -4.31 (-15.95, 7.32)| 0.465| 0.32 (-22.56, 23.20)| 0.978| + |grp [3] | -1.31 (-13.47, 10.84)| 0.831| 3.77 (-19.72, 27.26)| 0.752| + |Days * grp [2] | | | -1.01 ( -5.35, 3.32)| 0.645| + |Days * grp [3] | | | -1.11 ( -5.53, 3.31)| 0.621| + + Table: Random Effects + + |Parameter | Coefficient (CI) (lm1)| p (lm1)| Coefficient (CI) (lm2)| p (lm2)| + |:-----------------------|----------------------:|-------:|----------------------:|-------:| + |SD (Intercept: Subject) | 37.06 ( 25.85, 53.13)| | 37.08 ( 25.85, 53.19)| | + |SD (Residual) | 31.13 ( 27.89, 34.75)| | 31.30 ( 28.02, 34.96)| | diff --git a/tests/testthat/_snaps/include_reference.md b/tests/testthat/_snaps/include_reference.md index 86c83398c8..75d3f7d675 100644 --- a/tests/testthat/_snaps/include_reference.md +++ b/tests/testthat/_snaps/include_reference.md @@ -39,30 +39,44 @@ --- Code - print_md(out, engine = "tt") + print_md(out) Output - - +--------------+----------------------+----------------------+ - | Parameter | m1 | m2 | - +==============+======================+======================+ - | (Intercept) | 27.48 (23.43, 31.53) | 27.48 (23.43, 31.53) | - +--------------+----------------------+----------------------+ - | gear (3) | 0.00 | 0.00 | - +--------------+----------------------+----------------------+ - | gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) | - +--------------+----------------------+----------------------+ - | gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) | - +--------------+----------------------+----------------------+ - | am (0) | 0.00 | 0.00 | - +--------------+----------------------+----------------------+ - | am (1) | 4.14 (0.42, 7.85) | 4.14 (0.42, 7.85) | - +--------------+----------------------+----------------------+ - | hp | -0.06 (-0.09, -0.04) | -0.06 (-0.09, -0.04) | - +--------------+----------------------+----------------------+ - | | | | - +--------------+----------------------+----------------------+ - | Observations | 32 | 32 | - +--------------+----------------------+----------------------+ + [1] "|Parameter | m1 | m2 |" + [2] "|:------------|:--------------------|:--------------------|" + [3] "|(Intercept) |27.48 (23.43, 31.53) |27.48 (23.43, 31.53) |" + [4] "|gear (3) | 0.00 | 0.00 |" + [5] "|gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) |" + [6] "|gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) |" + [7] "|am (0) | 0.00 | 0.00 |" + [8] "|am (1) | 4.14 ( 0.42, 7.85) | 4.14 ( 0.42, 7.85) |" + [9] "|hp |-0.06 (-0.09, -0.04) |-0.06 (-0.09, -0.04) |" + [10] "| | | |" + [11] "|Observations | 32 | 32 |" + attr(,"format") + [1] "pipe" + attr(,"class") + [1] "knitr_kable" "character" + +--- + + Code + display(out, engine = "tt") + Output + [1] "|Parameter | m1 | m2 |" + [2] "|:------------|:--------------------|:--------------------|" + [3] "|(Intercept) |27.48 (23.43, 31.53) |27.48 (23.43, 31.53) |" + [4] "|gear (3) | 0.00 | 0.00 |" + [5] "|gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) |" + [6] "|gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) |" + [7] "|am (0) | 0.00 | 0.00 |" + [8] "|am (1) | 4.14 ( 0.42, 7.85) | 4.14 ( 0.42, 7.85) |" + [9] "|hp |-0.06 (-0.09, -0.04) |-0.06 (-0.09, -0.04) |" + [10] "| | | |" + [11] "|Observations | 32 | 32 |" + attr(,"format") + [1] "pipe" + attr(,"class") + [1] "knitr_kable" "character" # include_reference, different contrasts diff --git a/tests/testthat/_snaps/printing2.new.md b/tests/testthat/_snaps/printing2.new.md new file mode 100644 index 0000000000..a427b5fd35 --- /dev/null +++ b/tests/testthat/_snaps/printing2.new.md @@ -0,0 +1,211 @@ +# multiple model + + Code + print(out) + Output + Parameter | lm1 | lm2 | lm3 + ----------------------------------------------------------------------------------------------------- + (Intercept) | 5.01 (4.86, 5.15) | 3.68 ( 3.47, 3.89) | 4.21 ( 3.41, 5.02) + Species [versicolor] | 0.93 (0.73, 1.13) | -1.60 (-1.98, -1.22) | -1.81 (-2.99, -0.62) + Species [virginica] | 1.58 (1.38, 1.79) | -2.12 (-2.66, -1.58) | -3.15 (-4.41, -1.90) + Petal Length | | 0.90 ( 0.78, 1.03) | 0.54 ( 0.00, 1.09) + Species [versicolor] * Petal Length | | | 0.29 (-0.30, 0.87) + Species [virginica] * Petal Length | | | 0.45 (-0.12, 1.03) + ----------------------------------------------------------------------------------------------------- + Observations | 150 | 150 | 150 + +# templates + + Code + print(out) + Output + Parameter | lm1 | lm2 | lm3 + ---------------------------------------------------------------------------------------- + (Intercept) | 5.01*** (0.07) | 3.68*** (0.11) | 4.21*** (0.41) + Species [versicolor] | 0.93*** (0.10) | -1.60*** (0.19) | -1.81 ** (0.60) + Species [virginica] | 1.58*** (0.10) | -2.12*** (0.27) | -3.15*** (0.63) + Petal Length | | 0.90*** (0.06) | 0.54 (0.28) + Species [versicolor] * Petal Length | | | 0.29 (0.30) + Species [virginica] * Petal Length | | | 0.45 (0.29) + ---------------------------------------------------------------------------------------- + Observations | 150 | 150 | 150 + +# templates, glue-1 + + Code + print(out) + Output + Parameter | lm1 | lm2 | lm3 + ---------------------------------------------------------------------------------------- + (Intercept) | 5.01*** (0.07) | 3.68*** (0.11) | 4.21*** (0.41) + Species [versicolor] | 0.93*** (0.10) | -1.60*** (0.19) | -1.81 ** (0.60) + Species [virginica] | 1.58*** (0.10) | -2.12*** (0.27) | -3.15*** (0.63) + Petal Length | | 0.90*** (0.06) | 0.54 (0.28) + Species [versicolor] * Petal Length | | | 0.29 (0.30) + Species [virginica] * Petal Length | | | 0.45 (0.29) + ---------------------------------------------------------------------------------------- + Observations | 150 | 150 | 150 + +# templates, glue-2 + + Code + print(out) + Output + Parameter | lm1 | lm2 | lm3 + ----------------------------------------------------------------------------------------------------------------------------------------- + (Intercept) | 5.01 (4.86, 5.15), p<0.001*** | 3.68 ( 3.47, 3.89), p<0.001*** | 4.21 ( 3.41, 5.02), p<0.001*** + Species [versicolor] | 0.93 (0.73, 1.13), p<0.001*** | -1.60 (-1.98, -1.22), p<0.001*** | -1.81 (-2.99, -0.62), p=0.003 ** + Species [virginica] | 1.58 (1.38, 1.79), p<0.001*** | -2.12 (-2.66, -1.58), p<0.001*** | -3.15 (-4.41, -1.90), p<0.001*** + Petal Length | | 0.90 ( 0.78, 1.03), p<0.001*** | 0.54 ( 0.00, 1.09), p=0.052 + Species [versicolor] * Petal Length | | | 0.29 (-0.30, 0.87), p=0.334 + Species [virginica] * Petal Length | | | 0.45 (-0.12, 1.03), p=0.120 + ----------------------------------------------------------------------------------------------------------------------------------------- + Observations | 150 | 150 | 150 + +# templates, glue-3, separate columnns + + Code + print(out) + Output + Parameter | Coefficient (SE) (lm1) | p (lm1) | Coefficient (SE) (lm2) | p (lm2) | Coefficient (SE) (lm3) | p (lm3) + -------------------------------------------------------------------------------------------------------------------------------------------- + (Intercept) | 5.01 (0.07) | <0.001 | 3.68 (0.11) | <0.001 | 4.21 (0.41) | <0.001 + Species [versicolor] | 0.93 (0.10) | <0.001 | -1.60 (0.19) | <0.001 | -1.81 (0.60) | 0.003 + Species [virginica] | 1.58 (0.10) | <0.001 | -2.12 (0.27) | <0.001 | -3.15 (0.63) | <0.001 + Petal Length | | | 0.90 (0.06) | <0.001 | 0.54 (0.28) | 0.052 + Species [versicolor] * Petal Length | | | | | 0.29 (0.30) | 0.334 + Species [virginica] * Petal Length | | | | | 0.45 (0.29) | 0.120 + -------------------------------------------------------------------------------------------------------------------------------------------- + Observations | 150 | | 150 | | 150 | + +--- + + Code + print(out, groups = list(Species = c("Species [versicolor]", + "Species [virginica]"), Interactions = c( + "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), + Controls = "Petal Length")) + Output + Parameter | lm1 | lm2 + ----------------------------------------------------------------------------------- + Species | | + Species [versicolor] | -1.60 (-1.98, -1.22) | -1.69 (-2.80, -0.57) + Species [virginica] | -2.12 (-2.66, -1.58) | -1.19 (-2.37, -0.01) + Interactions | | + Species [versicolor] * Petal Length | | -0.01 (-0.56, 0.53) + Species [virginica] * Petal Length | | -0.15 (-0.69, 0.39) + Controls | | + Petal Length | 0.90 ( 0.78, 1.03) | 0.39 (-0.13, 0.90) + ----------------------------------------------------------------------------------- + Observations | 150 | 150 + +--- + + Code + print(out, groups = list(Species = c("Species [versicolor]", + "Species [virginica]"), Interactions = c( + "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), + Controls = "Petal Length"), select = "{estimate}{stars}") + Output + Parameter | lm1 | lm2 + ---------------------------------------------------------- + Species | | + Species [versicolor] | -1.60*** | -1.69** + Species [virginica] | -2.12*** | -1.19 * + Interactions | | + Species [versicolor] * Petal Length | | -0.01 + Species [virginica] * Petal Length | | -0.15 + Controls | | + Petal Length | 0.90*** | 0.39 + ---------------------------------------------------------- + Observations | 150 | 150 + +--- + + Code + print(out, groups = list(Species = c("Species [versicolor]", + "Species [virginica]"), Interactions = c( + "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), + Controls = "Petal Length"), select = "{estimate}|{p}") + Output + Parameter | Coefficient (lm1) | p (lm1) | Coefficient (lm2) | p (lm2) + ------------------------------------------------------------------------------------------------- + Species | | | | + Species [versicolor] | -1.60 | <0.001 | -1.69 | 0.003 + Species [virginica] | -2.12 | <0.001 | -1.19 | 0.048 + Interactions | | | | + Species [versicolor] * Petal Length | | | -0.01 | 0.961 + Species [virginica] * Petal Length | | | -0.15 | 0.574 + Controls | | | | + Petal Length | 0.90 | <0.001 | 0.39 | 0.138 + ------------------------------------------------------------------------------------------------- + Observations | 150 | | 150 | + +--- + + Code + print(out, groups = list(Species = c("Species [versicolor]", + "Species [virginica]"), Interactions = c( + "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), + Controls = "Petal Length"), select = "{estimate}|{p}") + Output + Parameter | Coefficient (lm1) | p (lm1) + ------------------------------------------------------------------- + Species | | + Species [versicolor] | -1.60 | <0.001 + Species [virginica] | -2.12 | <0.001 + Interactions | | + Species [versicolor] * Petal Length | | + Species [virginica] * Petal Length | | + Controls | | + Petal Length | 0.90 | <0.001 + ------------------------------------------------------------------- + Observations | 150 | + + Parameter | Coefficient (lm2) | p (lm2) + ------------------------------------------------------------------- + Species | | + Species [versicolor] | -1.69 | 0.003 + Species [virginica] | -1.19 | 0.048 + Interactions | | + Species [versicolor] * Petal Length | -0.01 | 0.961 + Species [virginica] * Petal Length | -0.15 | 0.574 + Controls | | + Petal Length | 0.39 | 0.138 + ------------------------------------------------------------------- + Observations | 150 | + +# combination of different models + + Code + print(cp) + Output + # Fixed Effects + + Parameter | m0 | m1 | m2 + -------------------------------------------------------------------------------- + (Intercept) | 0.91 ( 0.75, 1.07) | 0.68 (-0.54, 1.91) | 1.41 ( 1.06, 1.75) + child | -1.23 (-1.39, -1.08) | -1.67 (-1.84, -1.51) | -0.53 (-0.77, -0.29) + camper [1] | 1.05 ( 0.88, 1.23) | 0.94 ( 0.77, 1.12) | 0.58 ( 0.39, 0.78) + zg | | | 0.13 ( 0.05, 0.21) + + # Fixed Effects (Zero-Inflation Component) + + Parameter | m0 | m1 | m2 + -------------------------------------------- + (Intercept) | | | -0.92 (-2.07, 0.22) + child | | | 1.96 ( 1.38, 2.54) + + # Random Effects + + Parameter | m0 | m1 | m2 + -------------------------------------------------------------------------- + SD (Intercept: ID) | | 0.27 ( 0.11, 0.63) | 0.28 ( 0.13, 0.60) + SD (Intercept: persons) | | 1.21 ( 0.60, 2.43) | + + # Random Effects (Zero-Inflation Component) + + Parameter | m0 | m1 | m2 + -------------------------------------------------------- + SD (Intercept: persons) | | | 1.08 ( 0.49, 2.37) + diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R index d774a5351c..4f943b71de 100644 --- a/tests/testthat/test-compare_parameters.R +++ b/tests/testthat/test-compare_parameters.R @@ -132,8 +132,8 @@ withr::with_options( cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") out <- print_md(cp, groups = list( - Groups = c("grp [2]", "grp [3]"), - Interactions = c("Days × grp [2]", "Days × grp [3]"), + Groups = c("grp (2)", "grp (3)"), + Interactions = c("Days * grp (2)", "Days * grp (3)"), Controls = "Days" )) expect_snapshot(print(out)) @@ -145,7 +145,7 @@ withr::with_options( expect_error( print_md(cp, groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days × grp (2)", "Days × grp (3)"), + Interactions = c("Days * grp (2)", "Days * grp (3)"), Controls = "Days" )), regex = "Cannot combine" @@ -174,7 +174,7 @@ withr::with_options( expect_error( print_md(cp, groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days × grp (2)", "Days × grp (3)"), + Interactions = c("Days * grp (2)", "Days * grp (3)"), Controls = "XDays" )), regex = "Some group indices" @@ -192,7 +192,7 @@ withr::with_options( cp1 <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") out1 <- capture.output(print_md(cp1, groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days × grp (2)", "Days × grp (3)"), + Interactions = c("Days * grp (2)", "Days * grp (3)"), Controls = "Days" ))) cp2 <- compare_parameters( @@ -202,7 +202,7 @@ withr::with_options( drop = "^\\(Intercept", groups = list( Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days × grp (2)", "Days × grp (3)"), + Interactions = c("Days * grp (2)", "Days * grp (3)"), Controls = "Days" ) ) diff --git a/tests/testthat/test-include_reference.R b/tests/testthat/test-include_reference.R index 0201b0ca92..331412dd0a 100644 --- a/tests/testthat/test-include_reference.R +++ b/tests/testthat/test-include_reference.R @@ -19,7 +19,8 @@ test_that("include_reference, on-the-fly factors", { expect_equal(out1$Coefficient, out2$Coefficient, tolerance = 1e-4) out <- compare_parameters(m1, m2, include_reference = TRUE) - expect_snapshot(print_md(out, engine = "tt")) + expect_snapshot(print_md(out)) + expect_snapshot(display(out, engine = "tt")) }) skip_if(getRversion() < "4.3.3") From 0d47fe7f504c9eaec1d5032e0b281c4e19b4ab79 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:12:00 +0200 Subject: [PATCH 20/33] rem --- tests/testthat/_snaps/printing2.new.md | 211 ------------------------- 1 file changed, 211 deletions(-) delete mode 100644 tests/testthat/_snaps/printing2.new.md diff --git a/tests/testthat/_snaps/printing2.new.md b/tests/testthat/_snaps/printing2.new.md deleted file mode 100644 index a427b5fd35..0000000000 --- a/tests/testthat/_snaps/printing2.new.md +++ /dev/null @@ -1,211 +0,0 @@ -# multiple model - - Code - print(out) - Output - Parameter | lm1 | lm2 | lm3 - ----------------------------------------------------------------------------------------------------- - (Intercept) | 5.01 (4.86, 5.15) | 3.68 ( 3.47, 3.89) | 4.21 ( 3.41, 5.02) - Species [versicolor] | 0.93 (0.73, 1.13) | -1.60 (-1.98, -1.22) | -1.81 (-2.99, -0.62) - Species [virginica] | 1.58 (1.38, 1.79) | -2.12 (-2.66, -1.58) | -3.15 (-4.41, -1.90) - Petal Length | | 0.90 ( 0.78, 1.03) | 0.54 ( 0.00, 1.09) - Species [versicolor] * Petal Length | | | 0.29 (-0.30, 0.87) - Species [virginica] * Petal Length | | | 0.45 (-0.12, 1.03) - ----------------------------------------------------------------------------------------------------- - Observations | 150 | 150 | 150 - -# templates - - Code - print(out) - Output - Parameter | lm1 | lm2 | lm3 - ---------------------------------------------------------------------------------------- - (Intercept) | 5.01*** (0.07) | 3.68*** (0.11) | 4.21*** (0.41) - Species [versicolor] | 0.93*** (0.10) | -1.60*** (0.19) | -1.81 ** (0.60) - Species [virginica] | 1.58*** (0.10) | -2.12*** (0.27) | -3.15*** (0.63) - Petal Length | | 0.90*** (0.06) | 0.54 (0.28) - Species [versicolor] * Petal Length | | | 0.29 (0.30) - Species [virginica] * Petal Length | | | 0.45 (0.29) - ---------------------------------------------------------------------------------------- - Observations | 150 | 150 | 150 - -# templates, glue-1 - - Code - print(out) - Output - Parameter | lm1 | lm2 | lm3 - ---------------------------------------------------------------------------------------- - (Intercept) | 5.01*** (0.07) | 3.68*** (0.11) | 4.21*** (0.41) - Species [versicolor] | 0.93*** (0.10) | -1.60*** (0.19) | -1.81 ** (0.60) - Species [virginica] | 1.58*** (0.10) | -2.12*** (0.27) | -3.15*** (0.63) - Petal Length | | 0.90*** (0.06) | 0.54 (0.28) - Species [versicolor] * Petal Length | | | 0.29 (0.30) - Species [virginica] * Petal Length | | | 0.45 (0.29) - ---------------------------------------------------------------------------------------- - Observations | 150 | 150 | 150 - -# templates, glue-2 - - Code - print(out) - Output - Parameter | lm1 | lm2 | lm3 - ----------------------------------------------------------------------------------------------------------------------------------------- - (Intercept) | 5.01 (4.86, 5.15), p<0.001*** | 3.68 ( 3.47, 3.89), p<0.001*** | 4.21 ( 3.41, 5.02), p<0.001*** - Species [versicolor] | 0.93 (0.73, 1.13), p<0.001*** | -1.60 (-1.98, -1.22), p<0.001*** | -1.81 (-2.99, -0.62), p=0.003 ** - Species [virginica] | 1.58 (1.38, 1.79), p<0.001*** | -2.12 (-2.66, -1.58), p<0.001*** | -3.15 (-4.41, -1.90), p<0.001*** - Petal Length | | 0.90 ( 0.78, 1.03), p<0.001*** | 0.54 ( 0.00, 1.09), p=0.052 - Species [versicolor] * Petal Length | | | 0.29 (-0.30, 0.87), p=0.334 - Species [virginica] * Petal Length | | | 0.45 (-0.12, 1.03), p=0.120 - ----------------------------------------------------------------------------------------------------------------------------------------- - Observations | 150 | 150 | 150 - -# templates, glue-3, separate columnns - - Code - print(out) - Output - Parameter | Coefficient (SE) (lm1) | p (lm1) | Coefficient (SE) (lm2) | p (lm2) | Coefficient (SE) (lm3) | p (lm3) - -------------------------------------------------------------------------------------------------------------------------------------------- - (Intercept) | 5.01 (0.07) | <0.001 | 3.68 (0.11) | <0.001 | 4.21 (0.41) | <0.001 - Species [versicolor] | 0.93 (0.10) | <0.001 | -1.60 (0.19) | <0.001 | -1.81 (0.60) | 0.003 - Species [virginica] | 1.58 (0.10) | <0.001 | -2.12 (0.27) | <0.001 | -3.15 (0.63) | <0.001 - Petal Length | | | 0.90 (0.06) | <0.001 | 0.54 (0.28) | 0.052 - Species [versicolor] * Petal Length | | | | | 0.29 (0.30) | 0.334 - Species [virginica] * Petal Length | | | | | 0.45 (0.29) | 0.120 - -------------------------------------------------------------------------------------------------------------------------------------------- - Observations | 150 | | 150 | | 150 | - ---- - - Code - print(out, groups = list(Species = c("Species [versicolor]", - "Species [virginica]"), Interactions = c( - "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), - Controls = "Petal Length")) - Output - Parameter | lm1 | lm2 - ----------------------------------------------------------------------------------- - Species | | - Species [versicolor] | -1.60 (-1.98, -1.22) | -1.69 (-2.80, -0.57) - Species [virginica] | -2.12 (-2.66, -1.58) | -1.19 (-2.37, -0.01) - Interactions | | - Species [versicolor] * Petal Length | | -0.01 (-0.56, 0.53) - Species [virginica] * Petal Length | | -0.15 (-0.69, 0.39) - Controls | | - Petal Length | 0.90 ( 0.78, 1.03) | 0.39 (-0.13, 0.90) - ----------------------------------------------------------------------------------- - Observations | 150 | 150 - ---- - - Code - print(out, groups = list(Species = c("Species [versicolor]", - "Species [virginica]"), Interactions = c( - "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), - Controls = "Petal Length"), select = "{estimate}{stars}") - Output - Parameter | lm1 | lm2 - ---------------------------------------------------------- - Species | | - Species [versicolor] | -1.60*** | -1.69** - Species [virginica] | -2.12*** | -1.19 * - Interactions | | - Species [versicolor] * Petal Length | | -0.01 - Species [virginica] * Petal Length | | -0.15 - Controls | | - Petal Length | 0.90*** | 0.39 - ---------------------------------------------------------- - Observations | 150 | 150 - ---- - - Code - print(out, groups = list(Species = c("Species [versicolor]", - "Species [virginica]"), Interactions = c( - "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), - Controls = "Petal Length"), select = "{estimate}|{p}") - Output - Parameter | Coefficient (lm1) | p (lm1) | Coefficient (lm2) | p (lm2) - ------------------------------------------------------------------------------------------------- - Species | | | | - Species [versicolor] | -1.60 | <0.001 | -1.69 | 0.003 - Species [virginica] | -2.12 | <0.001 | -1.19 | 0.048 - Interactions | | | | - Species [versicolor] * Petal Length | | | -0.01 | 0.961 - Species [virginica] * Petal Length | | | -0.15 | 0.574 - Controls | | | | - Petal Length | 0.90 | <0.001 | 0.39 | 0.138 - ------------------------------------------------------------------------------------------------- - Observations | 150 | | 150 | - ---- - - Code - print(out, groups = list(Species = c("Species [versicolor]", - "Species [virginica]"), Interactions = c( - "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), - Controls = "Petal Length"), select = "{estimate}|{p}") - Output - Parameter | Coefficient (lm1) | p (lm1) - ------------------------------------------------------------------- - Species | | - Species [versicolor] | -1.60 | <0.001 - Species [virginica] | -2.12 | <0.001 - Interactions | | - Species [versicolor] * Petal Length | | - Species [virginica] * Petal Length | | - Controls | | - Petal Length | 0.90 | <0.001 - ------------------------------------------------------------------- - Observations | 150 | - - Parameter | Coefficient (lm2) | p (lm2) - ------------------------------------------------------------------- - Species | | - Species [versicolor] | -1.69 | 0.003 - Species [virginica] | -1.19 | 0.048 - Interactions | | - Species [versicolor] * Petal Length | -0.01 | 0.961 - Species [virginica] * Petal Length | -0.15 | 0.574 - Controls | | - Petal Length | 0.39 | 0.138 - ------------------------------------------------------------------- - Observations | 150 | - -# combination of different models - - Code - print(cp) - Output - # Fixed Effects - - Parameter | m0 | m1 | m2 - -------------------------------------------------------------------------------- - (Intercept) | 0.91 ( 0.75, 1.07) | 0.68 (-0.54, 1.91) | 1.41 ( 1.06, 1.75) - child | -1.23 (-1.39, -1.08) | -1.67 (-1.84, -1.51) | -0.53 (-0.77, -0.29) - camper [1] | 1.05 ( 0.88, 1.23) | 0.94 ( 0.77, 1.12) | 0.58 ( 0.39, 0.78) - zg | | | 0.13 ( 0.05, 0.21) - - # Fixed Effects (Zero-Inflation Component) - - Parameter | m0 | m1 | m2 - -------------------------------------------- - (Intercept) | | | -0.92 (-2.07, 0.22) - child | | | 1.96 ( 1.38, 2.54) - - # Random Effects - - Parameter | m0 | m1 | m2 - -------------------------------------------------------------------------- - SD (Intercept: ID) | | 0.27 ( 0.11, 0.63) | 0.28 ( 0.13, 0.60) - SD (Intercept: persons) | | 1.21 ( 0.60, 2.43) | - - # Random Effects (Zero-Inflation Component) - - Parameter | m0 | m1 | m2 - -------------------------------------------------------- - SD (Intercept: persons) | | | 1.08 ( 0.49, 2.37) - From 7366520cbb50851621182f80f215aeb3064fd960 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:13:07 +0200 Subject: [PATCH 21/33] update --- tests/testthat/_snaps/printing2.md | 96 +++++++++++++++--------------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/tests/testthat/_snaps/printing2.md b/tests/testthat/_snaps/printing2.md index 6e9f663db6..a427b5fd35 100644 --- a/tests/testthat/_snaps/printing2.md +++ b/tests/testthat/_snaps/printing2.md @@ -67,16 +67,16 @@ Code print(out) Output - Parameter | Estimate (SE) (lm1) | p (lm1) | Estimate (SE) (lm2) | p (lm2) | Estimate (SE) (lm3) | p (lm3) - ----------------------------------------------------------------------------------------------------------------------------------- - (Intercept) | 5.01 (0.07) | <0.001 | 3.68 (0.11) | <0.001 | 4.21 (0.41) | <0.001 - Species [versicolor] | 0.93 (0.10) | <0.001 | -1.60 (0.19) | <0.001 | -1.81 (0.60) | 0.003 - Species [virginica] | 1.58 (0.10) | <0.001 | -2.12 (0.27) | <0.001 | -3.15 (0.63) | <0.001 - Petal Length | | | 0.90 (0.06) | <0.001 | 0.54 (0.28) | 0.052 - Species [versicolor] * Petal Length | | | | | 0.29 (0.30) | 0.334 - Species [virginica] * Petal Length | | | | | 0.45 (0.29) | 0.120 - ----------------------------------------------------------------------------------------------------------------------------------- - Observations | 150 | | 150 | | 150 | + Parameter | Coefficient (SE) (lm1) | p (lm1) | Coefficient (SE) (lm2) | p (lm2) | Coefficient (SE) (lm3) | p (lm3) + -------------------------------------------------------------------------------------------------------------------------------------------- + (Intercept) | 5.01 (0.07) | <0.001 | 3.68 (0.11) | <0.001 | 4.21 (0.41) | <0.001 + Species [versicolor] | 0.93 (0.10) | <0.001 | -1.60 (0.19) | <0.001 | -1.81 (0.60) | 0.003 + Species [virginica] | 1.58 (0.10) | <0.001 | -2.12 (0.27) | <0.001 | -3.15 (0.63) | <0.001 + Petal Length | | | 0.90 (0.06) | <0.001 | 0.54 (0.28) | 0.052 + Species [versicolor] * Petal Length | | | | | 0.29 (0.30) | 0.334 + Species [virginica] * Petal Length | | | | | 0.45 (0.29) | 0.120 + -------------------------------------------------------------------------------------------------------------------------------------------- + Observations | 150 | | 150 | | 150 | --- @@ -97,7 +97,7 @@ Controls | | Petal Length | 0.90 ( 0.78, 1.03) | 0.39 (-0.13, 0.90) ----------------------------------------------------------------------------------- - Observations | 150 | 150 + Observations | 150 | 150 --- @@ -118,7 +118,7 @@ Controls | | Petal Length | 0.90*** | 0.39 ---------------------------------------------------------- - Observations | 150 | 150 + Observations | 150 | 150 --- @@ -128,18 +128,18 @@ "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), Controls = "Petal Length"), select = "{estimate}|{p}") Output - Parameter | Estimate (lm1) | p (lm1) | Estimate (lm2) | p (lm2) - ------------------------------------------------------------------------------------------- - Species | | | | - Species [versicolor] | -1.60 | <0.001 | -1.69 | 0.003 - Species [virginica] | -2.12 | <0.001 | -1.19 | 0.048 - Interactions | | | | - Species [versicolor] * Petal Length | | | -0.01 | 0.961 - Species [virginica] * Petal Length | | | -0.15 | 0.574 - Controls | | | | - Petal Length | 0.90 | <0.001 | 0.39 | 0.138 - ------------------------------------------------------------------------------------------- - Observations | 150 | | 150 | + Parameter | Coefficient (lm1) | p (lm1) | Coefficient (lm2) | p (lm2) + ------------------------------------------------------------------------------------------------- + Species | | | | + Species [versicolor] | -1.60 | <0.001 | -1.69 | 0.003 + Species [virginica] | -2.12 | <0.001 | -1.19 | 0.048 + Interactions | | | | + Species [versicolor] * Petal Length | | | -0.01 | 0.961 + Species [virginica] * Petal Length | | | -0.15 | 0.574 + Controls | | | | + Petal Length | 0.90 | <0.001 | 0.39 | 0.138 + ------------------------------------------------------------------------------------------------- + Observations | 150 | | 150 | --- @@ -149,31 +149,31 @@ "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"), Controls = "Petal Length"), select = "{estimate}|{p}") Output - Parameter | Estimate (lm1) | p (lm1) - ---------------------------------------------------------------- - Species | | - Species [versicolor] | -1.60 | <0.001 - Species [virginica] | -2.12 | <0.001 - Interactions | | - Species [versicolor] * Petal Length | | - Species [virginica] * Petal Length | | - Controls | | - Petal Length | 0.90 | <0.001 - ---------------------------------------------------------------- - Observations | 150 | + Parameter | Coefficient (lm1) | p (lm1) + ------------------------------------------------------------------- + Species | | + Species [versicolor] | -1.60 | <0.001 + Species [virginica] | -2.12 | <0.001 + Interactions | | + Species [versicolor] * Petal Length | | + Species [virginica] * Petal Length | | + Controls | | + Petal Length | 0.90 | <0.001 + ------------------------------------------------------------------- + Observations | 150 | - Parameter | Estimate (lm2) | p (lm2) - ---------------------------------------------------------------- - Species | | - Species [versicolor] | -1.69 | 0.003 - Species [virginica] | -1.19 | 0.048 - Interactions | | - Species [versicolor] * Petal Length | -0.01 | 0.961 - Species [virginica] * Petal Length | -0.15 | 0.574 - Controls | | - Petal Length | 0.39 | 0.138 - ---------------------------------------------------------------- - Observations | 150 | + Parameter | Coefficient (lm2) | p (lm2) + ------------------------------------------------------------------- + Species | | + Species [versicolor] | -1.69 | 0.003 + Species [virginica] | -1.19 | 0.048 + Interactions | | + Species [versicolor] * Petal Length | -0.01 | 0.961 + Species [virginica] * Petal Length | -0.15 | 0.574 + Controls | | + Petal Length | 0.39 | 0.138 + ------------------------------------------------------------------- + Observations | 150 | # combination of different models From 311b4ed7cfc682d0c27b4223a3cfade3ac3f138c Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:31:48 +0200 Subject: [PATCH 22/33] fix --- tests/testthat/_snaps/compare_parameters.md | 106 +++++++++++++++++++- tests/testthat/test-compare_parameters.R | 94 +++++++++++++---- 2 files changed, 177 insertions(+), 23 deletions(-) diff --git a/tests/testthat/_snaps/compare_parameters.md b/tests/testthat/_snaps/compare_parameters.md index a477e60307..c4e57f2f9e 100644 --- a/tests/testthat/_snaps/compare_parameters.md +++ b/tests/testthat/_snaps/compare_parameters.md @@ -44,7 +44,7 @@ -------------------------------------------------------- SD (Intercept: persons) | | | 1.08 ( 0.49, 2.37) -# compare_parameters, print_md +# compare_parameters, print_md-1 Code print(out) @@ -64,7 +64,38 @@ | | | | | | |Observations | 180| | 180| | ---- +# compare_parameters, print_md-2 + + Code + print(out) + Output + +----------------+-----------------------+--------+-----------------------+--------+ + | | lm1 | lm2 | + +----------------+-----------------------+--------+-----------------------+--------+ + | Parameter | Coefficient (CI) | p | Coefficient (CI) | p | + +================+=======================+========+=======================+========+ + | Groups | + +----------------+-----------------------+--------+-----------------------+--------+ + | grp (2) | -4.31 (-15.95, 7.32) | 0.465 | 0.32 (-22.56, 23.20) | 0.978 | + +----------------+-----------------------+--------+-----------------------+--------+ + | grp (3) | -1.31 (-13.47, 10.84) | 0.831 | 3.77 (-19.72, 27.26) | 0.752 | + +----------------+-----------------------+--------+-----------------------+--------+ + | Interactions | + +----------------+-----------------------+--------+-----------------------+--------+ + | Days * grp (2) | | | -1.01 ( -5.35, 3.32) | 0.645 | + +----------------+-----------------------+--------+-----------------------+--------+ + | Days * grp (3) | | | -1.11 ( -5.53, 3.31) | 0.621 | + +----------------+-----------------------+--------+-----------------------+--------+ + | Controls | + +----------------+-----------------------+--------+-----------------------+--------+ + | Days | 10.44 ( 8.84, 12.03) | <0.001 | 11.23 ( 7.87, 14.60) | <0.001 | + +----------------+-----------------------+--------+-----------------------+--------+ + | | | | | | + +----------------+-----------------------+--------+-----------------------+--------+ + | Observations | 180 | | 180 | | + +----------------+-----------------------+--------+-----------------------+--------+ + +# compare_parameters, print_md-3 Code print_md(cp) @@ -88,3 +119,74 @@ |SD (Intercept: Subject) | 37.06 ( 25.85, 53.13)| | 37.08 ( 25.85, 53.19)| | |SD (Residual) | 31.13 ( 27.89, 34.75)| | 31.30 ( 28.02, 34.96)| | +--- + + Code + display(cp, format = "tt") + Output + +-------------------------+-----------------------+--------+-----------------------+--------+ + | | lm1 | lm2 | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | Parameter | Coefficient (CI) | p | Coefficient (CI) | p | + +=========================+=======================+========+=======================+========+ + | Fixed Effects | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | Days | 10.44 ( 8.84, 12.03) | <0.001 | 11.23 ( 7.87, 14.60) | <0.001 | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | grp (2) | -4.31 (-15.95, 7.32) | 0.465 | 0.32 (-22.56, 23.20) | 0.978 | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | grp (3) | -1.31 (-13.47, 10.84) | 0.831 | 3.77 (-19.72, 27.26) | 0.752 | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | Days * grp (2) | | | -1.01 ( -5.35, 3.32) | 0.645 | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | Days * grp (3) | | | -1.11 ( -5.53, 3.31) | 0.621 | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | Random Effects | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | SD (Intercept: Subject) | 37.06 ( 25.85, 53.13) | | 37.08 ( 25.85, 53.19) | | + +-------------------------+-----------------------+--------+-----------------------+--------+ + | SD (Residual) | 31.13 ( 27.89, 34.75) | | 31.30 ( 28.02, 34.96) | | + +-------------------------+-----------------------+--------+-----------------------+--------+ + +# compare_parameters, print_md-4 + + Code + print(out) + Output + + + |Parameter | Coefficient (CI) (lm1)| p (lm1)| Coefficient (CI) (lm2)| p (lm2)| + |:--------------|----------------------:|-------:|----------------------:|-------:| + |Groups | | | | | + |grp (1) | 0.00| | 0.00| | + |grp (2) | -4.31 (-15.95, 7.32)| 0.465| 0.32 (-22.56, 23.20)| 0.978| + |grp (3) | -1.31 (-13.47, 10.84)| 0.831| 3.77 (-19.72, 27.26)| 0.752| + |Interactions | | | | | + |Days * grp (2) | | | -1.01 ( -5.35, 3.32)| 0.645| + |Days * grp (3) | | | -1.11 ( -5.53, 3.31)| 0.621| + |Controls | | | | | + |Days | 10.44 ( 8.84, 12.03)| <0.001| 11.23 ( 7.87, 14.60)| <0.001| + | | | | | | + |Observations | 180| | 180| | + +# compare_parameters, print_md-5 + + Code + print(out) + Output + + + |Parameter | lm1| lm2| + |:--------------|---------------------:|---------------------:| + |Groups | | | + |grp (1) | 0.00| 0.00| + |grp (2) | -4.31 (-15.95, 7.32)| 0.32 (-22.56, 23.20)| + |grp (3) | -1.31 (-13.47, 10.84)| 3.77 (-19.72, 27.26)| + |Interactions | | | + |Days * grp (2) | | -1.01 ( -5.35, 3.32)| + |Days * grp (3) | | -1.11 ( -5.53, 3.31)| + |Controls | | | + |Days | 10.44 ( 8.84, 12.03)| 11.23 ( 7.87, 14.60)| + | | | | + |Observations | 180| 180| + diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R index 4f943b71de..5ebe45e908 100644 --- a/tests/testthat/test-compare_parameters.R +++ b/tests/testthat/test-compare_parameters.R @@ -120,9 +120,10 @@ withr::with_options( }) - test_that("compare_parameters, print_md", { + test_that("compare_parameters, print_md-1", { skip_if_not_installed("lme4") skip_if_not_installed("knitr") + skip_if_not_installed("tinytable") data(sleepstudy, package = "lme4") set.seed(1234) @@ -132,24 +133,62 @@ withr::with_options( cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") out <- print_md(cp, groups = list( - Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), - Controls = "Days" + Groups = c(2, 3), + Interactions = c(4, 5), + Controls = 1 )) expect_snapshot(print(out)) + }) + + test_that("compare_parameters, print_md-2", { + skip_if_not_installed("lme4") + skip_if_not_installed("knitr") + skip_if_not_installed("tinytable") + + data(sleepstudy, package = "lme4") + set.seed(1234) + sleepstudy$grp <- as.factor(sample.int(3, nrow(sleepstudy), replace = TRUE)) + lm1 <- lme4::lmer(Reaction ~ Days + grp + (1 | Subject), data = sleepstudy) + lm2 <- lme4::lmer(Reaction ~ Days * grp + (1 | Subject), data = sleepstudy) + + cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") + out <- display(cp, groups = list( + Groups = c(2, 3), + Interactions = c(4, 5), + Controls = 1 + ), + format = "tt" + ) + expect_snapshot(print(out)) + }) + + test_that("compare_parameters, print_md-3", { + skip_if_not_installed("lme4") + skip_if_not_installed("knitr") + skip_if_not_installed("tinytable") + + data(sleepstudy, package = "lme4") + set.seed(1234) + sleepstudy$grp <- as.factor(sample.int(3, nrow(sleepstudy), replace = TRUE)) + lm1 <- lme4::lmer(Reaction ~ Days + grp + (1 | Subject), data = sleepstudy) + lm2 <- lme4::lmer(Reaction ~ Days * grp + (1 | Subject), data = sleepstudy) cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept", effects = "all") expect_snapshot(print_md(cp)) + expect_snapshot(display(cp, format = "tt")) + }) + + test_that("compare_parameters, print_md-4", { + skip_if_not_installed("lme4") + skip_if_not_installed("knitr") + skip_if_not_installed("tinytable") + + data(sleepstudy, package = "lme4") + set.seed(1234) + sleepstudy$grp <- as.factor(sample.int(3, nrow(sleepstudy), replace = TRUE)) + lm1 <- lme4::lmer(Reaction ~ Days + grp + (1 | Subject), data = sleepstudy) + lm2 <- lme4::lmer(Reaction ~ Days * grp + (1 | Subject), data = sleepstudy) - # error - expect_error( - print_md(cp, groups = list( - Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), - Controls = "Days" - )), - regex = "Cannot combine" - ) # with reference level cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept", include_reference = TRUE) @@ -160,6 +199,19 @@ withr::with_options( )) expect_snapshot(print(out)) + }) + + test_that("compare_parameters, print_md-5", { + skip_if_not_installed("lme4") + skip_if_not_installed("knitr") + skip_if_not_installed("tinytable") + + data(sleepstudy, package = "lme4") + set.seed(1234) + sleepstudy$grp <- as.factor(sample.int(3, nrow(sleepstudy), replace = TRUE)) + lm1 <- lme4::lmer(Reaction ~ Days + grp + (1 | Subject), data = sleepstudy) + lm2 <- lme4::lmer(Reaction ~ Days * grp + (1 | Subject), data = sleepstudy) + # with reference level cp <- compare_parameters(lm1, lm2, drop = "^\\(Intercept", include_reference = TRUE) out <- print_md(cp, groups = list( @@ -173,8 +225,8 @@ withr::with_options( cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") expect_error( print_md(cp, groups = list( - Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), + Groups = c(2, 3), + Interactions = c(4, 5), Controls = "XDays" )), regex = "Some group indices" @@ -191,9 +243,9 @@ withr::with_options( # output identical for both calls cp1 <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept") out1 <- capture.output(print_md(cp1, groups = list( - Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), - Controls = "Days" + Groups = 2:3, + Interactions = 4:5, + Controls = 1 ))) cp2 <- compare_parameters( lm1, @@ -201,9 +253,9 @@ withr::with_options( select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept", groups = list( - Groups = c("grp (2)", "grp (3)"), - Interactions = c("Days * grp (2)", "Days * grp (3)"), - Controls = "Days" + Groups = c(2, 3), + Interactions = c(4, 5), + Controls = 1 ) ) out2 <- capture.output(print_md(cp2)) From 6db2848a70b2a6153c34b792805d888de1493756 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:32:59 +0200 Subject: [PATCH 23/33] fix --- tests/testthat/_snaps/include_reference.md | 39 +++++++++++++--------- tests/testthat/test-include_reference.R | 2 +- 2 files changed, 24 insertions(+), 17 deletions(-) diff --git a/tests/testthat/_snaps/include_reference.md b/tests/testthat/_snaps/include_reference.md index 75d3f7d675..883f3612d7 100644 --- a/tests/testthat/_snaps/include_reference.md +++ b/tests/testthat/_snaps/include_reference.md @@ -60,23 +60,30 @@ --- Code - display(out, engine = "tt") + display(out, format = "tt") Output - [1] "|Parameter | m1 | m2 |" - [2] "|:------------|:--------------------|:--------------------|" - [3] "|(Intercept) |27.48 (23.43, 31.53) |27.48 (23.43, 31.53) |" - [4] "|gear (3) | 0.00 | 0.00 |" - [5] "|gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) |" - [6] "|gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) |" - [7] "|am (0) | 0.00 | 0.00 |" - [8] "|am (1) | 4.14 ( 0.42, 7.85) | 4.14 ( 0.42, 7.85) |" - [9] "|hp |-0.06 (-0.09, -0.04) |-0.06 (-0.09, -0.04) |" - [10] "| | | |" - [11] "|Observations | 32 | 32 |" - attr(,"format") - [1] "pipe" - attr(,"class") - [1] "knitr_kable" "character" + + +--------------+-------------------------+-------------------------+ + | Parameter | m1 | m2 | + +==============+=========================+=========================+ + | (Intercept) | 27.48
(23.43, 31.53) | 27.48
(23.43, 31.53) | + +--------------+-------------------------+-------------------------+ + | gear (3) | 0.00 | 0.00 | + +--------------+-------------------------+-------------------------+ + | gear (4) | 0.08
(-3.68, 3.83) | 0.08
(-3.68, 3.83) | + +--------------+-------------------------+-------------------------+ + | gear (5) | 2.39
(-2.50, 7.29) | 2.39
(-2.50, 7.29) | + +--------------+-------------------------+-------------------------+ + | am (0) | 0.00 | 0.00 | + +--------------+-------------------------+-------------------------+ + | am (1) | 4.14
( 0.42, 7.85) | 4.14
( 0.42, 7.85) | + +--------------+-------------------------+-------------------------+ + | hp | -0.06
(-0.09, -0.04) | -0.06
(-0.09, -0.04) | + +--------------+-------------------------+-------------------------+ + | | | | + +--------------+-------------------------+-------------------------+ + | Observations | 32 | 32 | + +--------------+-------------------------+-------------------------+ # include_reference, different contrasts diff --git a/tests/testthat/test-include_reference.R b/tests/testthat/test-include_reference.R index 331412dd0a..953752c546 100644 --- a/tests/testthat/test-include_reference.R +++ b/tests/testthat/test-include_reference.R @@ -20,7 +20,7 @@ test_that("include_reference, on-the-fly factors", { out <- compare_parameters(m1, m2, include_reference = TRUE) expect_snapshot(print_md(out)) - expect_snapshot(display(out, engine = "tt")) + expect_snapshot(display(out, format = "tt")) }) skip_if(getRversion() < "4.3.3") From 41b7de9f3f5e3ccc91caec4735b8bb562dd95f07 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:38:23 +0200 Subject: [PATCH 24/33] fix --- R/print_html.R | 28 +++++++++------ tests/testthat/_snaps/include_reference.md | 42 +++++++++++----------- 2 files changed, 39 insertions(+), 31 deletions(-) diff --git a/R/print_html.R b/R/print_html.R index 0b019ad694..8033a5bd86 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -26,6 +26,16 @@ print_html.parameters_model <- function(x, engine = "gt", verbose = TRUE, ...) { + # markdown engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) + + # line separator - for tinytable, we have no specific line separator, + # because the output format is context-dependent + line_sep <- ifelse(identical(engine, "tt"), " ", "
") + # check if user supplied digits attributes if (missing(digits)) { digits <- .additional_arguments(x, "digits", digits) @@ -53,15 +63,9 @@ print_html.parameters_model <- function(x, # we need glue-like syntax right now... if (!is.null(select)) { - select <- .convert_to_glue_syntax(style = select, "
") + select <- .convert_to_glue_syntax(style = select, line_sep) } - # markdown engine? - engine <- insight::validate_argument( - getOption("easystats_html_engine", engine), - c("gt", "default", "tt") - ) - # check options --------------- # check if pretty names should be replaced by value labels @@ -112,9 +116,9 @@ print_html.parameters_model <- function(x, format = "html" ) if (!is.null(footer)) { - footer <- paste0(footer, "
", paste(footer_stats, collapse = "
")) + footer <- paste0(footer, line_sep, paste(footer_stats, collapse = line_sep)) } else if (!is.null(footer_stats)) { - footer <- paste(footer_stats, collapse = "
") + footer <- paste(footer_stats, collapse = line_sep) } out <- insight::export_table( @@ -192,8 +196,12 @@ print_html.compare_parameters <- function(x, c("gt", "default", "tt") ) + # line separator - for tinytable, we have no specific line separator, + # because the output format is context-dependent + line_sep <- ifelse(identical(engine, "tt"), " ", "
") + # we need glue-like syntax right now... - select <- .convert_to_glue_syntax(style = select, "
") + select <- .convert_to_glue_syntax(style = select, line_sep) formatted_table <- format( x, diff --git a/tests/testthat/_snaps/include_reference.md b/tests/testthat/_snaps/include_reference.md index 883f3612d7..53d2b3c215 100644 --- a/tests/testthat/_snaps/include_reference.md +++ b/tests/testthat/_snaps/include_reference.md @@ -63,27 +63,27 @@ display(out, format = "tt") Output - +--------------+-------------------------+-------------------------+ - | Parameter | m1 | m2 | - +==============+=========================+=========================+ - | (Intercept) | 27.48
(23.43, 31.53) | 27.48
(23.43, 31.53) | - +--------------+-------------------------+-------------------------+ - | gear (3) | 0.00 | 0.00 | - +--------------+-------------------------+-------------------------+ - | gear (4) | 0.08
(-3.68, 3.83) | 0.08
(-3.68, 3.83) | - +--------------+-------------------------+-------------------------+ - | gear (5) | 2.39
(-2.50, 7.29) | 2.39
(-2.50, 7.29) | - +--------------+-------------------------+-------------------------+ - | am (0) | 0.00 | 0.00 | - +--------------+-------------------------+-------------------------+ - | am (1) | 4.14
( 0.42, 7.85) | 4.14
( 0.42, 7.85) | - +--------------+-------------------------+-------------------------+ - | hp | -0.06
(-0.09, -0.04) | -0.06
(-0.09, -0.04) | - +--------------+-------------------------+-------------------------+ - | | | | - +--------------+-------------------------+-------------------------+ - | Observations | 32 | 32 | - +--------------+-------------------------+-------------------------+ + +--------------+----------------------+----------------------+ + | Parameter | m1 | m2 | + +==============+======================+======================+ + | (Intercept) | 27.48 (23.43, 31.53) | 27.48 (23.43, 31.53) | + +--------------+----------------------+----------------------+ + | gear (3) | 0.00 | 0.00 | + +--------------+----------------------+----------------------+ + | gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) | + +--------------+----------------------+----------------------+ + | gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) | + +--------------+----------------------+----------------------+ + | am (0) | 0.00 | 0.00 | + +--------------+----------------------+----------------------+ + | am (1) | 4.14 ( 0.42, 7.85) | 4.14 ( 0.42, 7.85) | + +--------------+----------------------+----------------------+ + | hp | -0.06 (-0.09, -0.04) | -0.06 (-0.09, -0.04) | + +--------------+----------------------+----------------------+ + | | | | + +--------------+----------------------+----------------------+ + | Observations | 32 | 32 | + +--------------+----------------------+----------------------+ # include_reference, different contrasts From 52fa8430a28efe92a85b0e3947b9e0a1fa4dfa9c Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:39:15 +0200 Subject: [PATCH 25/33] fix --- tests/testthat/test-marginaleffects.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-marginaleffects.R b/tests/testthat/test-marginaleffects.R index b83ee45bbc..45c6f38b5b 100644 --- a/tests/testthat/test-marginaleffects.R +++ b/tests/testthat/test-marginaleffects.R @@ -185,8 +185,8 @@ test_that("predictions, using bayestestR #1063", { expect_named( out, c( - "Coefficient", "Days", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", - "ROPE_low", "ROPE_high", "ROPE_Percentage", "subgrp", "grp", "Subject" + "Median", "CI", "CI_low", "CI_high", "pd", "ROPE_CI", "ROPE_low", + "ROPE_high", "ROPE_Percentage", "Days", "subgrp", "grp", "Subject" ) ) }) From 5dcc307cc5c0d16763b2eb42039c7e37aad9abe7 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 14:55:13 +0200 Subject: [PATCH 26/33] add display method --- NAMESPACE | 1 + R/display.R | 29 +++++++++++++++++++++++++++++ R/p_function.R | 34 ++++++++++++---------------------- R/print_html.R | 25 ++++++++++++++++++++++++- R/print_md.R | 13 +++++++++++++ 5 files changed, 79 insertions(+), 23 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4d721be7c7..66a1717e17 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -128,6 +128,7 @@ S3method(display,parameters_efa_summary) S3method(display,parameters_model) S3method(display,parameters_omega) S3method(display,parameters_omega_summary) +S3method(display,parameters_p_function) S3method(display,parameters_pca) S3method(display,parameters_pca_summary) S3method(display,parameters_sem) diff --git a/R/display.R b/R/display.R index 0a91674a34..80c29915cd 100644 --- a/R/display.R +++ b/R/display.R @@ -288,3 +288,32 @@ display.parameters_omega <- display.parameters_efa display.equivalence_test_lm <- function(object, format = "markdown", digits = 2, ...) { print_md(x = object, digits = digits, ...) } + + +# p_function ---------------------------- + +#' @export +display.parameters_p_function <- function(x, + format = "markdown", + digits = 2, + ci_width = "auto", + ci_brackets = TRUE, + pretty_names = TRUE, + ...) { + format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) + + fun_args <- list( + x = x, + digits = digits, + ci_width = ci_width, + ci_brackets = ci_brackets, + pretty_names = pretty_names, + engine = ifelse(format == "tt", "tt", "gt") + ) + + if (format %in% c("html", "tt")) { + do.call(print_html, c(fun_args, list(...))) + } else { + do.call(print_md, c(fun_args, list(...))) + } +} diff --git a/R/p_function.R b/R/p_function.R index a4c060fe76..69f5087fbc 100644 --- a/R/p_function.R +++ b/R/p_function.R @@ -435,28 +435,6 @@ print.parameters_p_function <- function(x, } -#' @export -print_md.parameters_p_function <- function(x, - digits = 2, - ci_width = "auto", - ci_brackets = c("(", ")"), - pretty_names = TRUE, - ...) { - .print_p_function(x, digits, ci_width, ci_brackets, pretty_names, format = "markdown", ...) -} - - -#' @export -print_html.parameters_p_function <- function(x, - digits = 2, - ci_width = "auto", - ci_brackets = c("(", ")"), - pretty_names = TRUE, - ...) { - .print_p_function(x, digits, ci_width, ci_brackets, pretty_names, format = "html", ...) -} - - # helper ---------- .print_p_function <- function(x, @@ -465,7 +443,14 @@ print_html.parameters_p_function <- function(x, ci_brackets = c("(", ")"), pretty_names = TRUE, format = "html", + engine = "gt", ...) { + # which engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) + formatted_table <- format( x, digits = digits, @@ -476,6 +461,11 @@ print_html.parameters_p_function <- function(x, ... ) + # set engine for html format + if (format == "html" && identical(engine, "tt")) { + format <- "tt" + } + insight::export_table( formatted_table, format = format, diff --git a/R/print_html.R b/R/print_html.R index 8033a5bd86..12dd478162 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -26,7 +26,7 @@ print_html.parameters_model <- function(x, engine = "gt", verbose = TRUE, ...) { - # markdown engine? + # which engine? engine <- insight::validate_argument( getOption("easystats_html_engine", engine), c("gt", "default", "tt") @@ -434,3 +434,26 @@ print_html.parameters_pca_summary <- print_html.parameters_efa_summary ) out } + + +# p_function ---------------------------- + +#' @export +print_html.parameters_p_function <- function(x, + digits = 2, + ci_width = "auto", + ci_brackets = c("(", ")"), + pretty_names = TRUE, + engine = "gt", + ...) { + .print_p_function( + x, + digits, + ci_width, + ci_brackets, + pretty_names, + format = "html", + engine = engine, + ... + ) +} diff --git a/R/print_md.R b/R/print_md.R index a861c573b4..8570f8f186 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -352,3 +352,16 @@ print_md.equivalence_test_lm <- function( align = "firstleft" ) } + + +# p_function ---------------------------- + +#' @export +print_md.parameters_p_function <- function(x, + digits = 2, + ci_width = "auto", + ci_brackets = c("(", ")"), + pretty_names = TRUE, + ...) { + .print_p_function(x, digits, ci_width, ci_brackets, pretty_names, format = "markdown", ...) +} From f51577795a98f7dbf5a97f59326d29917b1e0ff2 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 15:00:27 +0200 Subject: [PATCH 27/33] add display methods --- NAMESPACE | 1 + R/print_html.R | 46 +++++++++++++++++++------------------- R/standardize_parameters.R | 25 +++++++++++++++++++-- 3 files changed, 47 insertions(+), 25 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 66a1717e17..6f3e67a91c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -133,6 +133,7 @@ S3method(display,parameters_pca) S3method(display,parameters_pca_summary) S3method(display,parameters_sem) S3method(display,parameters_simulate) +S3method(display,parameters_standardized) S3method(dof_satterthwaite,lmerMod) S3method(equivalence_test,MixMod) S3method(equivalence_test,feis) diff --git a/R/print_html.R b/R/print_html.R index 12dd478162..84385ed17a 100644 --- a/R/print_html.R +++ b/R/print_html.R @@ -364,6 +364,29 @@ print_html.parameters_efa_summary <- function(x, digits = 3, engine = "gt", ...) print_html.parameters_pca_summary <- print_html.parameters_efa_summary +# p_function ---------------------------- + +#' @export +print_html.parameters_p_function <- function(x, + digits = 2, + ci_width = "auto", + ci_brackets = c("(", ")"), + pretty_names = TRUE, + engine = "gt", + ...) { + .print_p_function( + x, + digits, + ci_width, + ci_brackets, + pretty_names, + format = "html", + engine = engine, + ... + ) +} + + # helper ------------------ .add_gt_options <- function(out, @@ -434,26 +457,3 @@ print_html.parameters_pca_summary <- print_html.parameters_efa_summary ) out } - - -# p_function ---------------------------- - -#' @export -print_html.parameters_p_function <- function(x, - digits = 2, - ci_width = "auto", - ci_brackets = c("(", ")"), - pretty_names = TRUE, - engine = "gt", - ...) { - .print_p_function( - x, - digits, - ci_width, - ci_brackets, - pretty_names, - format = "html", - engine = engine, - ... - ) -} diff --git a/R/standardize_parameters.R b/R/standardize_parameters.R index 8e8bcf2fd1..d799e05273 100644 --- a/R/standardize_parameters.R +++ b/R/standardize_parameters.R @@ -519,6 +519,22 @@ format.parameters_standardized <- function(x, } +#' @export +display.parameters_standardized <- function(x, + format = "markdown", + digits = 2, + ...) { + format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) + fun_args <- list(x = x, digits = digits, engine = ifelse(format == "tt", "tt", "gt")) + + if (format %in% c("html", "tt")) { + do.call(print_html, c(fun_args, list(...))) + } else { + do.call(print_md, c(fun_args, list(...))) + } +} + + #' @export print.parameters_standardized <- function(x, digits = 2, ...) { x_fmt <- format(x, digits = digits, output = "text", ...) @@ -533,9 +549,14 @@ print_md.parameters_standardized <- function(x, digits = 2, ...) { } #' @export -print_html.parameters_standardized <- function(x, digits = 2, ...) { +print_html.parameters_standardized <- function(x, digits = 2, engine = "gt", ...) { + # which engine? + engine <- insight::validate_argument( + getOption("easystats_html_engine", engine), + c("gt", "default", "tt") + ) x_fmt <- format(x, digits = digits, output = "html", ...) - insight::export_table(x_fmt, format = "html", ...) + insight::export_table(x_fmt, format = ifelse(identical(engine, "tt"), "tt", "html"), ...) } From 0478549533c9eac614a0be2cfb6ade6fa6968e39 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 15:15:04 +0200 Subject: [PATCH 28/33] fix --- R/display.R | 22 ++++++++++++---------- R/standardize_parameters.R | 4 ++-- man/display.parameters_model.Rd | 20 ++++++++++---------- man/print.compare_parameters.Rd | 4 +++- man/print.parameters_model.Rd | 4 +++- 5 files changed, 30 insertions(+), 24 deletions(-) diff --git a/R/display.R b/R/display.R index 80c29915cd..fbc920028e 100644 --- a/R/display.R +++ b/R/display.R @@ -3,13 +3,17 @@ #' #' @description Prints tables (i.e. data frame) in different output formats. #' `print_md()` is an alias for `display(format = "markdown")`, `print_html()` -#' is an alias for `display(format = "html")`. +#' is an alias for `display(format = "html")`, and `print_html(engine = "tt")` +#' is an alias for `display(format = "tt")`. The latter is a `tinytable` object, +#' which is either printed as markdown or HTML table, depending on the environment. #' -#' @param x An object returned by [`model_parameters()`]. -#' @param object An object returned by [`model_parameters()`],[`simulate_parameters()`], -#' [`equivalence_test()`] or [`principal_components()`]. +#' @param object An object returned by one of the package's function, for example +#' [`model_parameters()`], [`simulate_parameters()`], [`equivalence_test()`] or +#' [`principal_components()`]. #' @param format String, indicating the output format. Can be `"markdown"` -#' or `"html"`. +#' `"html"`, or `"tt"`. `format = "tt"` creates a `tinytable` object, which is +#' either printed as markdown or HTML table, depending on the environment. See +#' [`insight::export_table()`] for details. #' @param align Only applies to HTML tables. May be one of `"left"`, #' `"right"` or `"center"`. #' @param digits,ci_digits,p_digits Number of digits for rounding or @@ -26,8 +30,6 @@ #' @param line_padding For HTML tables, the distance (in pixel) between lines. #' @param column_labels Labels of columns for HTML tables. If `NULL`, automatic #' column names are generated. See 'Examples'. -#' @param theme String, indicating the table theme. Can be one of `"default"`, -#' `"grid"`, `"striped"`, `"bootstrap"` or `"darklines"`. #' @inheritParams print.parameters_model #' @inheritParams insight::format_table #' @inheritParams insight::export_table @@ -35,7 +37,7 @@ #' #' @return If `format = "markdown"`, the return value will be a character #' vector in markdown-table format. If `format = "html"`, an object of -#' class `gt_tbl`. +#' class `gt_tbl`. If `format = "tt"`, an object of class `tinytable`. #' #' @details `display()` is useful when the table-output from functions, #' which is usually printed as formatted text-table to console, should @@ -293,7 +295,7 @@ display.equivalence_test_lm <- function(object, format = "markdown", digits = 2, # p_function ---------------------------- #' @export -display.parameters_p_function <- function(x, +display.parameters_p_function <- function(object, format = "markdown", digits = 2, ci_width = "auto", @@ -303,7 +305,7 @@ display.parameters_p_function <- function(x, format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) fun_args <- list( - x = x, + x = object, digits = digits, ci_width = ci_width, ci_brackets = ci_brackets, diff --git a/R/standardize_parameters.R b/R/standardize_parameters.R index d799e05273..4bada328bf 100644 --- a/R/standardize_parameters.R +++ b/R/standardize_parameters.R @@ -520,12 +520,12 @@ format.parameters_standardized <- function(x, #' @export -display.parameters_standardized <- function(x, +display.parameters_standardized <- function(object, format = "markdown", digits = 2, ...) { format <- insight::validate_argument(format, c("markdown", "html", "md", "tt")) - fun_args <- list(x = x, digits = digits, engine = ifelse(format == "tt", "tt", "gt")) + fun_args <- list(x = object, digits = digits, engine = ifelse(format == "tt", "tt", "gt")) if (format %in% c("html", "tt")) { do.call(print_html, c(fun_args, list(...))) diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd index f53cae9f63..942ac5ad9f 100644 --- a/man/display.parameters_model.Rd +++ b/man/display.parameters_model.Rd @@ -59,11 +59,14 @@ \method{display}{equivalence_test_lm}(object, format = "markdown", digits = 2, ...) } \arguments{ -\item{object}{An object returned by \code{\link[=model_parameters]{model_parameters()}},\code{\link[=simulate_parameters]{simulate_parameters()}}, -\code{\link[=equivalence_test]{equivalence_test()}} or \code{\link[=principal_components]{principal_components()}}.} +\item{object}{An object returned by one of the package's function, for example +\code{\link[=model_parameters]{model_parameters()}}, \code{\link[=simulate_parameters]{simulate_parameters()}}, \code{\link[=equivalence_test]{equivalence_test()}} or +\code{\link[=principal_components]{principal_components()}}.} \item{format}{String, indicating the output format. Can be \code{"markdown"} -or \code{"html"}.} +\code{"html"}, or \code{"tt"}. \code{format = "tt"} creates a \code{tinytable} object, which is +either printed as markdown or HTML table, depending on the environment. See +\code{\link[insight:export_table]{insight::export_table()}} for details.} \item{pretty_names}{Can be \code{TRUE}, which will return "pretty" (i.e. more human readable) parameter names. Or \code{"labels"}, in which case value and variable @@ -191,21 +194,18 @@ only display the maximum loading per variable (the most simple structure).} \item{labels}{A character vector containing labels to be added to the loadings data. Usually, the question related to the item.} - -\item{x}{An object returned by \code{\link[=model_parameters]{model_parameters()}}.} - -\item{theme}{String, indicating the table theme. Can be one of \code{"default"}, -\code{"grid"}, \code{"striped"}, \code{"bootstrap"} or \code{"darklines"}.} } \value{ If \code{format = "markdown"}, the return value will be a character vector in markdown-table format. If \code{format = "html"}, an object of -class \code{gt_tbl}. +class \code{gt_tbl}. If \code{format = "tt"}, an object of class \code{tinytable}. } \description{ Prints tables (i.e. data frame) in different output formats. \code{print_md()} is an alias for \code{display(format = "markdown")}, \code{print_html()} -is an alias for \code{display(format = "html")}. +is an alias for \code{display(format = "html")}, and \code{print_html(engine = "tt")} +is an alias for \code{display(format = "tt")}. The latter is a \code{tinytable} object, +which is either printed as markdown or HTML table, depending on the environment. } \details{ \code{display()} is useful when the table-output from functions, diff --git a/man/print.compare_parameters.Rd b/man/print.compare_parameters.Rd index 2a63c8dc5e..75da32d19b 100644 --- a/man/print.compare_parameters.Rd +++ b/man/print.compare_parameters.Rd @@ -155,7 +155,9 @@ encompassed in square brackets (else in parentheses).} places than \code{digits} are printed in scientific notation.} \item{format}{String, indicating the output format. Can be \code{"markdown"} -or \code{"html"}.} +\code{"html"}, or \code{"tt"}. \code{format = "tt"} creates a \code{tinytable} object, which is +either printed as markdown or HTML table, depending on the environment. See +\code{\link[insight:export_table]{insight::export_table()}} for details.} \item{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 diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index 8fa8b04f7a..05484858ce 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -184,7 +184,9 @@ encompassed in square brackets (else in parentheses).} places than \code{digits} are printed in scientific notation.} \item{format}{String, indicating the output format. Can be \code{"markdown"} -or \code{"html"}.} +\code{"html"}, or \code{"tt"}. \code{format = "tt"} creates a \code{tinytable} object, which is +either printed as markdown or HTML table, depending on the environment. See +\code{\link[insight:export_table]{insight::export_table()}} for details.} \item{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 From dfd74616d676235c60d71fa193ab81c851e7bc9f Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 15:16:15 +0200 Subject: [PATCH 29/33] update snap --- tests/testthat/_snaps/include_reference.md | 28 ++++++++++------------ tests/testthat/test-include_reference.R | 1 + 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/tests/testthat/_snaps/include_reference.md b/tests/testthat/_snaps/include_reference.md index 53d2b3c215..aa2d2b4b99 100644 --- a/tests/testthat/_snaps/include_reference.md +++ b/tests/testthat/_snaps/include_reference.md @@ -41,21 +41,19 @@ Code print_md(out) Output - [1] "|Parameter | m1 | m2 |" - [2] "|:------------|:--------------------|:--------------------|" - [3] "|(Intercept) |27.48 (23.43, 31.53) |27.48 (23.43, 31.53) |" - [4] "|gear (3) | 0.00 | 0.00 |" - [5] "|gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) |" - [6] "|gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) |" - [7] "|am (0) | 0.00 | 0.00 |" - [8] "|am (1) | 4.14 ( 0.42, 7.85) | 4.14 ( 0.42, 7.85) |" - [9] "|hp |-0.06 (-0.09, -0.04) |-0.06 (-0.09, -0.04) |" - [10] "| | | |" - [11] "|Observations | 32 | 32 |" - attr(,"format") - [1] "pipe" - attr(,"class") - [1] "knitr_kable" "character" + + + |Parameter | m1 | m2 | + |:------------|:--------------------|:--------------------| + |(Intercept) |27.48 (23.43, 31.53) |27.48 (23.43, 31.53) | + |gear (3) | 0.00 | 0.00 | + |gear (4) | 0.08 (-3.68, 3.83) | 0.08 (-3.68, 3.83) | + |gear (5) | 2.39 (-2.50, 7.29) | 2.39 (-2.50, 7.29) | + |am (0) | 0.00 | 0.00 | + |am (1) | 4.14 ( 0.42, 7.85) | 4.14 ( 0.42, 7.85) | + |hp |-0.06 (-0.09, -0.04) |-0.06 (-0.09, -0.04) | + | | | | + |Observations | 32 | 32 | --- diff --git a/tests/testthat/test-include_reference.R b/tests/testthat/test-include_reference.R index 953752c546..9251dada86 100644 --- a/tests/testthat/test-include_reference.R +++ b/tests/testthat/test-include_reference.R @@ -1,4 +1,5 @@ skip_if_not_installed("tinytable") +skip_if_not_installed("knitr") test_that("include_reference, on-the-fly factors", { data(mtcars) From c01cc283daae4bb98f594e61365f77e8f9bfba1a Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 15:23:45 +0200 Subject: [PATCH 30/33] fix --- vignettes/model_parameters_print.Rmd | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/vignettes/model_parameters_print.Rmd b/vignettes/model_parameters_print.Rmd index 0b7eb47be1..90b1e4c093 100644 --- a/vignettes/model_parameters_print.Rmd +++ b/vignettes/model_parameters_print.Rmd @@ -192,7 +192,7 @@ print(mp, column_width = c(SE = 8, `95% CI` = 12, p = 7)) ## Group parameters -The `groups` argument can be used to group parameters in the table. `groups` must be a named list, where the names of the list elements equal the header of each group, while the values of the list elements equal the parameter names, or the position of the parameters in the table (data frame). +The `groups` argument can be used to group parameters in the table. `groups` must be a named list, where the names of the list elements equal the header of each group, while the values of the list elements equal the parameter names, or the position of the parameters in the table (data frame). Usually, indexing by position is easier, since the parameter names can be modified during formatting the output. In the following example, we see the names of the parameters in the `Parameter` column, while the rownumbers indicate their position. @@ -209,17 +209,17 @@ mp <- model_parameters(model, drop = "^\\(Intercept") as.data.frame(mp) ``` -Now we create a group named `"Engine"`, which encompasses the parameters `"cyl6"`, `"cyl8"`, `"vs"` and `"hp"`. The `"Interactions"` group includes `"gear4:vs"` and `"gear5:vs"`. The group `"controls"` has the parameters from rows 2, 3 and 7. +Now we create a group named `"Engine"`, which encompasses the parameters `"cyl6"`, `"cyl8"`, `"vs"` and `"hp"` (rows 5, 6, 4 and 1). The `"Interactions"` group includes `"gear4:vs"` and `"gear5:vs"` (rows 8 and 9). The group `"controls"` has the parameters from rows 2, 3 and 7. Note that the parameters in the table summary are re-ordered according to the order specified in `groups`. ```{r} # group parameters, either by parameter name or position print(mp, groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9), Controls = c(2, 3, 7) -)) # gear 4 and 5, drat +)) ``` If you prefer tables without vertical borders, use the `sep` argument to define the string that is used as border-separator. This argument is passed down to `insight::export_table()`. @@ -229,8 +229,8 @@ If you prefer tables without vertical borders, use the `sep` argument to define print(mp, sep = " ", groups = list( - Engine = c("cyl6", "cyl8", "vs", "hp"), - Interactions = c("gear4:vs", "gear5:vs"), + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9), Controls = c(2, 3, 7) ) ) @@ -382,6 +382,6 @@ print(tab, table_width = 80) # More advances tables and markdown / HTML formatting -The `print_md()` as well as `print_html()` functions can be used to create markdown (for knitting to PDF or Word) and HTML tables. +The `print_md()` as well as `print_html()` functions can be used to create markdown (for knitting to PDF or Word) and HTML tables, where HTML tables are created using the [**gt**](https://gt.rstudio.com/) package. There is also a `display()` function, which internally calls `print_md()` or `print_html()`, depending on the `format` argument. However, for `display()`, the `format` argument can also be `"tt"` to use the [**tinytable**](https://vincentarelbundock.github.io/tinytable/) package as engine to produce tables. This will create tables in different output formats, depending on the environment where the code is run (e.g. R Markdown, Jupyter Notebook, etc.). Meanwhile, there are a lot of additional packages that allow users to have even more flexibility regarding table layouts. One package we can recommend is the [*modelsummary* package](https://vincentarelbundock.github.io/modelsummary/). From a86ff339adb8b74d42c2eb647ceaff3f29b4600c Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 15:38:50 +0200 Subject: [PATCH 31/33] fix --- R/print.parameters_model.R | 11 +---------- inst/WORDLIST | 1 + man/print.parameters_model.Rd | 11 +---------- 3 files changed, 3 insertions(+), 20 deletions(-) diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index 4b1fb4edb2..e9db945069 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -205,18 +205,9 @@ #' ) #' # don't select "Intercept" parameter #' mp <- model_parameters(model, parameters = "^(?!\\(Intercept)") -#' groups <- list( -#' "Focal Predictors" = c("Speciesversicolor", "Speciesvirginica"), -#' "Controls" = c("Sepal.Length", "Petal.Length") -#' ) +#' groups <- list(`Focal Predictors` = c(1, 4), Controls = c(2, 3)) #' 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 #' diff --git a/inst/WORDLIST b/inst/WORDLIST index b9febb3f06..041b33efaa 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -92,6 +92,7 @@ JB JM JRM Jurs +Jupyter KJ KMO Kenward diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index 05484858ce..6ee51a0ae9 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -373,18 +373,9 @@ model <- lm( ) # don't select "Intercept" parameter mp <- model_parameters(model, parameters = "^(?!\\\\(Intercept)") -groups <- list( - "Focal Predictors" = c("Speciesversicolor", "Speciesvirginica"), - "Controls" = c("Sepal.Length", "Petal.Length") -) +groups <- list(`Focal Predictors` = c(1, 4), Controls = c(2, 3)) 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 From 863fd9cf25705f4bc361f20fd7b75d0098355c13 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 16:23:47 +0200 Subject: [PATCH 32/33] fix example --- R/print.parameters_model.R | 4 ++-- man/print.parameters_model.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R index e9db945069..a49554c94b 100644 --- a/R/print.parameters_model.R +++ b/R/print.parameters_model.R @@ -219,8 +219,8 @@ #' # 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") +#' Engine = c(5, 6, 4, 1), +#' Interactions = c(8, 9) #' )) #' } #' diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd index 6ee51a0ae9..c2cfa4105f 100644 --- a/man/print.parameters_model.Rd +++ b/man/print.parameters_model.Rd @@ -387,8 +387,8 @@ 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") + Engine = c(5, 6, 4, 1), + Interactions = c(8, 9) )) } From 0d45bb39def0be05740297c488ea530c27c6c035 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 21 Jul 2025 17:48:13 +0200 Subject: [PATCH 33/33] update news --- NEWS.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/NEWS.md b/NEWS.md index 278e013096..9102afa5bd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,21 @@ # parameters (devel) +## Breaking Changes + +* The experimental `print_table()` function was removed. The aim of this function + was to test the implementation of the `tinytable` backend for printing. Now, + `tinytable` is fully supported by `insight::export_table()` and thereby also + by the various `print()` resp. `display()` methods for model parameters. + +## Changes + +* All `print_html()` methods get an `engine` argument, to either use the `gt` + package or the `tinytable` package for printing HTML tables. Since `tinytable` + not only produces HTML tables, but rather different formats depending on the + environment, `print_html()` may also generate a markdown table. Thus, the + generic `display()` method can be used, too, which has a `format` argument that + also supports `"tt"` for `tinytable`. + ## Bug fixes * Fixed issue with models of class `selection` with multiple outcomes.