From 160833ab37cf4eae5ac576afdac435205c9e8ea4 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 10:52:08 +0100
Subject: [PATCH 01/19] Use tinytable for `print_md.compare_parameters()`

---
 DESCRIPTION  |  2 +-
 R/format.R   |  3 ++-
 R/print_md.R | 28 ++++++++++++++++++++--------
 3 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index f34136fd9..7c2194936 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.5.6
+Version: 0.21.5.7
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
diff --git a/R/format.R b/R/format.R
index c12e20a86..790489abf 100644
--- a/R/format.R
+++ b/R/format.R
@@ -253,6 +253,7 @@ format.compare_parameters <- function(x,
                                       zap_small = FALSE,
                                       format = NULL,
                                       groups = NULL,
+                                      engine = NULL,
                                       ...) {
   m_class <- attributes(x)$model_class
   x$Method <- NULL
@@ -393,7 +394,7 @@ format.compare_parameters <- function(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)) {
+  if (!is.null(groups) && !identical(engine, "tt")) {
     out <- .parameter_groups(out, groups)
   }
   indent_groups <- attributes(x)$indent_groups
diff --git a/R/print_md.R b/R/print_md.R
index 7d2237d3b..a77f35732 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -136,6 +136,7 @@ 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)) {
@@ -153,6 +154,9 @@ print_md.compare_parameters <- function(x,
     select <- attributes(x)$output_style
   }
 
+  # markdown engine?
+  engine <- match.arg(engine, c("tt", "default"))
+
   formatted_table <- format(
     x,
     select = select,
@@ -164,16 +168,24 @@ print_md.compare_parameters <- function(x,
     ci_brackets = ci_brackets,
     format = "markdown",
     zap_small = zap_small,
-    groups = groups
+    groups = groups,
+    engine = engine
   )
 
-  insight::export_table(
-    formatted_table,
-    format = "markdown",
-    caption = caption,
-    subtitle = subtitle,
-    footer = footer
-  )
+  if (identical(engine, "tt")) {
+    insight::check_if_installed("tinytable", minimum_version = "0.1.0")
+    gsub("(.*) \\((.*)\\)$", "\\2", colnames(out))
+    gsub("(.*) \\((.*)\\)$", "\\1", colnames(out))
+    lapply(groups, function(i) match(i, out$Parameter))
+  } else {
+    insight::export_table(
+      formatted_table,
+      format = "markdown",
+      caption = caption,
+      subtitle = subtitle,
+      footer = footer
+    )
+  }
 }
 
 

From 2c6810fdba77d30ba02e9b8018f21faaca415dd9 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 14:45:58 +0100
Subject: [PATCH 02/19] fix

---
 R/print_md.R | 59 +++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 56 insertions(+), 3 deletions(-)

diff --git a/R/print_md.R b/R/print_md.R
index a77f35732..57cfc5647 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -174,9 +174,62 @@ print_md.compare_parameters <- function(x,
 
   if (identical(engine, "tt")) {
     insight::check_if_installed("tinytable", minimum_version = "0.1.0")
-    gsub("(.*) \\((.*)\\)$", "\\2", colnames(out))
-    gsub("(.*) \\((.*)\\)$", "\\1", colnames(out))
-    lapply(groups, function(i) match(i, out$Parameter))
+    # 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)
+    row_groups <- NULL
+    # clean column names. These still contain the model name
+    colnames(formatted_table) <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table))
+    # 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
+        }
+      })
+      # 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
+      })
+      names(row_groups) <- paste0("*", names(groups), "*")
+    }
+    # replace NA in formatted_table by ""
+    formatted_table[is.na(formatted_table)] <- ""
+    # create base table
+    out <- tinytable::tt(formatted_table)
+    # insert sub header rows and column spans
+    out <- tinytable::group_tt(out, i = row_groups, j = col_groups)
+    out@output <- "markdown"
+    out
   } else {
     insight::export_table(
       formatted_table,

From 81bde4cf8eb7e76ce6558a7044b31e0f7093a22b Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 15:24:32 +0100
Subject: [PATCH 03/19] final? add tests

---
 R/print_md.R                                | 152 +++++++----
 tests/testthat/_snaps/compare_parameters.md |  60 ++++
 tests/testthat/test-compare_parameters.R    | 287 ++++++++++++--------
 3 files changed, 326 insertions(+), 173 deletions(-)

diff --git a/R/print_md.R b/R/print_md.R
index 57cfc5647..3feeeebd6 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -173,63 +173,13 @@ print_md.compare_parameters <- function(x,
   )
 
   if (identical(engine, "tt")) {
-    insight::check_if_installed("tinytable", minimum_version = "0.1.0")
-    # 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)
-    row_groups <- NULL
-    # clean column names. These still contain the model name
-    colnames(formatted_table) <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table))
-    # 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
-        }
-      })
-      # 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
-      })
-      names(row_groups) <- paste0("*", names(groups), "*")
-    }
-    # replace NA in formatted_table by ""
-    formatted_table[is.na(formatted_table)] <- ""
-    # create base table
-    out <- tinytable::tt(formatted_table)
-    # insert sub header rows and column spans
-    out <- tinytable::group_tt(out, i = row_groups, j = col_groups)
-    out@output <- "markdown"
-    out
+    .export_table_tt(
+      x,
+      formatted_table,
+      groups,
+      caption = caption,
+      footer = footer
+    )
   } else {
     insight::export_table(
       formatted_table,
@@ -392,3 +342,91 @@ print_md.parameters_distribution <- function(x, digits = 2, ci_brackets = c("(",
 
   insight::export_table(formatted_table, format = "markdown", align = "firstleft", ...)
 }
+
+
+# helper -----------------------
+
+.export_table_tt <- function(x, formatted_table, groups, caption = NULL, footer = NULL) {
+  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))
+  # 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
+    })
+    names(row_groups) <- paste0("*", names(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
+  out <- tinytable::group_tt(out, i = row_groups, j = col_groups)
+  out@output <- "markdown"
+  out
+}
diff --git a/tests/testthat/_snaps/compare_parameters.md b/tests/testthat/_snaps/compare_parameters.md
index dac4e1410..357bbffa5 100644
--- a/tests/testthat/_snaps/compare_parameters.md
+++ b/tests/testthat/_snaps/compare_parameters.md
@@ -44,3 +44,63 @@
       --------------------------------------------------------
       SD (Intercept: persons) |    |    |  1.08 ( 0.49,  2.37)
 
+# compare_parameters, print_md
+
+    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                  |        |
+      +----------------+-----------------------+--------+----------------------+--------+ 
+
+---
+
+    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) |        |
+      +-------------------------+-----------------------+--------+----------------------+--------+ 
+
diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R
index 4c37549ff..502089471 100644
--- a/tests/testthat/test-compare_parameters.R
+++ b/tests/testthat/test-compare_parameters.R
@@ -1,117 +1,172 @@
+skip_if_not_installed("withr")
+
 # make sure we have the correct interaction mark for tests
-options(parameters_interaction = "*")
-
-data(iris)
-m1 <- lm(Sepal.Length ~ Species, data = iris)
-m2 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris)
-counts <- c(18, 17, 15, 20, 10, 20, 25, 13, 12)
-outcome <- gl(3, 1, 9)
-treatment <- gl(3, 3)
-m3 <- glm(counts ~ outcome + treatment, family = poisson())
-
-x <- compare_parameters(m1, m2, m3)
-test_that("compare_parameters, default", {
-  expect_identical(
-    colnames(x),
-    c(
-      "Parameter", "Component", "Effects", "Coefficient.m1", "SE.m1", "CI.m1",
-      "CI_low.m1", "CI_high.m1", "t.m1", "df_error.m1", "p.m1", "Coefficient.m2",
-      "SE.m2", "CI.m2", "CI_low.m2", "CI_high.m2", "t.m2", "df_error.m2",
-      "p.m2", "Log-Mean.m3", "SE.m3", "CI.m3", "CI_low.m3", "CI_high.m3",
-      "z.m3", "df_error.m3", "p.m3"
-    )
-  )
-  out <- capture.output(x)
-  expect_length(out, 14)
-  out <- format(x, select = "ci")
-  expect_identical(colnames(out), c("Parameter", "m1", "m2", "m3"))
-  expect_identical(
-    out$Parameter,
-    c(
-      "(Intercept)", "Species (versicolor)", "Species (virginica)",
-      "Petal Length", "Species (versicolor) * Petal Length",
-      "Species (virginica) * Petal Length", "outcome (2)", "outcome (3)",
-      "treatment (2)", "treatment (3)", NA, "Observations"
-    )
-  )
-})
-
-
-x <- compare_parameters(m1, m2, m3, select = "se_p2")
-test_that("compare_parameters, se_p2", {
-  expect_identical(
-    colnames(x),
-    c(
-      "Parameter", "Component", "Effects", "Coefficient.m1", "SE.m1", "CI.m1",
-      "CI_low.m1", "CI_high.m1", "t.m1", "df_error.m1", "p.m1", "Coefficient.m2",
-      "SE.m2", "CI.m2", "CI_low.m2", "CI_high.m2", "t.m2", "df_error.m2",
-      "p.m2", "Log-Mean.m3", "SE.m3", "CI.m3", "CI_low.m3", "CI_high.m3",
-      "z.m3", "df_error.m3", "p.m3"
-    )
-  )
-  out <- capture.output(x)
-  expect_length(out, 14)
-  out <- format(x, select = "se_p2")
-  expect_identical(
-    colnames(out),
-    c(
-      "Parameter", "Estimate (SE) (m1)", "p (m1)", "Estimate (SE) (m2)",
-      "p (m2)", "Estimate (SE) (m3)", "p (m3)"
-    )
-  )
-  expect_identical(
-    out$Parameter,
-    c(
-      "(Intercept)", "Species (versicolor)", "Species (virginica)",
-      "Petal Length", "Species (versicolor) * Petal Length",
-      "Species (virginica) * Petal Length", "outcome (2)", "outcome (3)",
-      "treatment (2)", "treatment (3)", NA, "Observations"
-    )
-  )
-})
-
-
-data(mtcars)
-m1 <- lm(mpg ~ wt, data = mtcars)
-m2 <- glm(vs ~ wt + cyl, data = mtcars, family = "binomial")
-
-test_that("compare_parameters, column name with escaping regex characters", {
-  out <- utils::capture.output(compare_parameters(m1, m2, column_names = c("linear model (m1)", "logistic reg. (m2)")))
-  expect_identical(out[1], "Parameter    |    linear model (m1) |   logistic reg. (m2)")
-})
-
-
-data(mtcars)
-m1 <- lm(mpg ~ hp, mtcars)
-m2 <- lm(mpg ~ hp, mtcars)
-test_that("compare_parameters, proper printing for CI=NULL #820", {
-  expect_snapshot(compare_parameters(m1, m2, ci = NULL))
-})
-
-
-skip_on_cran()
-
-
-test_that("compare_parameters, correct random effects", {
-  skip_if_not_installed("glmmTMB")
-  skip_if_not(getRversion() >= "4.0.0")
-
-  data("fish")
-  m0 <- glm(count ~ child + camper, data = fish, family = poisson())
-
-  m1 <- glmmTMB::glmmTMB(
-    count ~ child + camper + (1 | persons) + (1 | ID),
-    data = fish,
-    family = poisson()
-  )
-
-  m2 <- glmmTMB::glmmTMB(
-    count ~ child + camper + zg + (1 | ID),
-    ziformula = ~ child + (1 | persons),
-    data = fish,
-    family = glmmTMB::truncated_poisson()
-  )
-
-  cp <- compare_parameters(m0, m1, m2, effects = "all", component = "all")
-  expect_snapshot(cp)
-})
+withr::with_options(
+  list(parameters_interaction = "*"),
+  {
+    data(iris)
+    m1 <- lm(Sepal.Length ~ Species, data = iris)
+    m2 <- lm(Sepal.Length ~ Species * Petal.Length, data = iris)
+    counts <- c(18, 17, 15, 20, 10, 20, 25, 13, 12)
+    outcome <- gl(3, 1, 9)
+    treatment <- gl(3, 3)
+    m3 <- glm(counts ~ outcome + treatment, family = poisson())
+
+    x <- compare_parameters(m1, m2, m3)
+    test_that("compare_parameters, default", {
+      expect_identical(
+        colnames(x),
+        c(
+          "Parameter", "Component", "Effects", "Coefficient.m1", "SE.m1", "CI.m1",
+          "CI_low.m1", "CI_high.m1", "t.m1", "df_error.m1", "p.m1", "Coefficient.m2",
+          "SE.m2", "CI.m2", "CI_low.m2", "CI_high.m2", "t.m2", "df_error.m2",
+          "p.m2", "Log-Mean.m3", "SE.m3", "CI.m3", "CI_low.m3", "CI_high.m3",
+          "z.m3", "df_error.m3", "p.m3"
+        )
+      )
+      out <- capture.output(x)
+      expect_length(out, 14)
+      out <- format(x, select = "ci")
+      expect_identical(colnames(out), c("Parameter", "m1", "m2", "m3"))
+      expect_identical(
+        out$Parameter,
+        c(
+          "(Intercept)", "Species (versicolor)", "Species (virginica)",
+          "Petal Length", "Species (versicolor) * Petal Length",
+          "Species (virginica) * Petal Length", "outcome (2)", "outcome (3)",
+          "treatment (2)", "treatment (3)", NA, "Observations"
+        )
+      )
+    })
+
+
+    x <- compare_parameters(m1, m2, m3, select = "se_p2")
+    test_that("compare_parameters, se_p2", {
+      expect_identical(
+        colnames(x),
+        c(
+          "Parameter", "Component", "Effects", "Coefficient.m1", "SE.m1", "CI.m1",
+          "CI_low.m1", "CI_high.m1", "t.m1", "df_error.m1", "p.m1", "Coefficient.m2",
+          "SE.m2", "CI.m2", "CI_low.m2", "CI_high.m2", "t.m2", "df_error.m2",
+          "p.m2", "Log-Mean.m3", "SE.m3", "CI.m3", "CI_low.m3", "CI_high.m3",
+          "z.m3", "df_error.m3", "p.m3"
+        )
+      )
+      out <- capture.output(x)
+      expect_length(out, 14)
+      out <- format(x, select = "se_p2")
+      expect_identical(
+        colnames(out),
+        c(
+          "Parameter", "Estimate (SE) (m1)", "p (m1)", "Estimate (SE) (m2)",
+          "p (m2)", "Estimate (SE) (m3)", "p (m3)"
+        )
+      )
+      expect_identical(
+        out$Parameter,
+        c(
+          "(Intercept)", "Species (versicolor)", "Species (virginica)",
+          "Petal Length", "Species (versicolor) * Petal Length",
+          "Species (virginica) * Petal Length", "outcome (2)", "outcome (3)",
+          "treatment (2)", "treatment (3)", NA, "Observations"
+        )
+      )
+    })
+
+
+    data(mtcars)
+    m1 <- lm(mpg ~ wt, data = mtcars)
+    m2 <- glm(vs ~ wt + cyl, data = mtcars, family = "binomial")
+
+    test_that("compare_parameters, column name with escaping regex characters", {
+      out <- utils::capture.output(compare_parameters(m1, m2, column_names = c("linear model (m1)", "logistic reg. (m2)")))
+      expect_identical(out[1], "Parameter    |    linear model (m1) |   logistic reg. (m2)")
+    })
+
+
+    data(mtcars)
+    m1 <- lm(mpg ~ hp, mtcars)
+    m2 <- lm(mpg ~ hp, mtcars)
+    test_that("compare_parameters, proper printing for CI=NULL #820", {
+      expect_snapshot(compare_parameters(m1, m2, ci = NULL))
+    })
+
+
+    skip_on_cran()
+
+
+    test_that("compare_parameters, correct random effects", {
+      skip_if_not_installed("glmmTMB")
+      skip_if_not(getRversion() >= "4.0.0")
+
+      data("fish")
+      m0 <- glm(count ~ child + camper, data = fish, family = poisson())
+
+      m1 <- glmmTMB::glmmTMB(
+        count ~ child + camper + (1 | persons) + (1 | ID),
+        data = fish,
+        family = poisson()
+      )
+
+      m2 <- glmmTMB::glmmTMB(
+        count ~ child + camper + zg + (1 | ID),
+        ziformula = ~ child + (1 | persons),
+        data = fish,
+        family = glmmTMB::truncated_poisson()
+      )
+
+      cp <- compare_parameters(m0, m1, m2, effects = "all", component = "all")
+      expect_snapshot(cp)
+    })
+
+
+    test_that("compare_parameters, print_md", {
+      skip_if_not_installed("lme4")
+      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 <- print_md(cp, groups = list(
+        Groups = c("grp (2)", "grp (3)"),
+        Interactions = c("Days * grp (2)", "Days * grp (3)"),
+        Controls = "Days"
+      ))
+      expect_snapshot(print(out))
+
+      cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept", effects = "all")
+      expect_snapshot(print_md(cp))
+
+      # 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"
+      )
+
+      # error
+      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)"),
+          Controls = "XDays"
+        )),
+        regex = "Some group indices"
+      )
+      expect_error(
+        print_md(cp, groups = list(
+          Groups = 1:2,
+          Interactions = 4:5,
+          Controls = 10
+        )),
+        regex = "Some group indices"
+      )
+    })
+  }
+)

From 4b0a9d1c1a265d55cb5ed6ce235f27397fcba7fa Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 15:25:05 +0100
Subject: [PATCH 04/19] min version

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 7c2194936..4b825b4b9 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -199,7 +199,7 @@ Suggests:
     survival,
     testthat (>= 3.2.1),
     tidyselect,
-    tinytable,
+    tinytable (>= 0.1.0),
     TMB,
     truncreg,
     VGAM,

From 9c8a2c8b94d96a5e89ac6d1976b4e2fdf91ac4a6 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 15:39:23 +0100
Subject: [PATCH 05/19] allow reference category included

---
 R/compare_parameters.R                      |  2 ++
 R/utils_format.R                            |  2 ++
 man/compare_parameters.Rd                   |  8 +++++
 tests/testthat/_snaps/compare_parameters.md | 33 +++++++++++++++++++++
 tests/testthat/test-compare_parameters.R    |  9 ++++++
 5 files changed, 54 insertions(+)

diff --git a/R/compare_parameters.R b/R/compare_parameters.R
index cf6285cb7..4e1e7b6b8 100644
--- a/R/compare_parameters.R
+++ b/R/compare_parameters.R
@@ -83,6 +83,7 @@ compare_parameters <- function(...,
                                coefficient_names = NULL,
                                keep = NULL,
                                drop = NULL,
+                               include_reference = FALSE,
                                verbose = TRUE) {
   models <- list(...)
 
@@ -186,6 +187,7 @@ compare_parameters <- function(...,
         keep = keep,
         drop = drop,
         wb_component = FALSE,
+        include_reference = include_reference,
         verbose = verbose
       )
     }
diff --git a/R/utils_format.R b/R/utils_format.R
index 974e4da14..aba6a8381 100644
--- a/R/utils_format.R
+++ b/R/utils_format.R
@@ -53,7 +53,9 @@
     # here we either have "<br>" or " " as line breaks, followed by empty "()"
     i <- gsub("<br>()", "", 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)
diff --git a/man/compare_parameters.Rd b/man/compare_parameters.Rd
index db1dbf328..bd385e8fa 100644
--- a/man/compare_parameters.Rd
+++ b/man/compare_parameters.Rd
@@ -20,6 +20,7 @@ compare_parameters(
   coefficient_names = NULL,
   keep = NULL,
   drop = NULL,
+  include_reference = FALSE,
   verbose = TRUE
 )
 
@@ -38,6 +39,7 @@ compare_models(
   coefficient_names = NULL,
   keep = NULL,
   drop = NULL,
+  include_reference = FALSE,
   verbose = TRUE
 )
 }
@@ -179,6 +181,12 @@ names.}
 
 \item{drop}{See \code{keep}.}
 
+\item{include_reference}{Logical, if \code{TRUE}, the reference level of factors will
+be added to the parameters table. This is only relevant for models with
+categorical predictors. The coefficient for the reference level is always
+\code{0} (except when \code{exponentiate = TRUE}, then the coefficient will be \code{1}),
+so this is just for completeness.}
+
 \item{verbose}{Toggle warnings and messages.}
 }
 \value{
diff --git a/tests/testthat/_snaps/compare_parameters.md b/tests/testthat/_snaps/compare_parameters.md
index 357bbffa5..f4d4c4ced 100644
--- a/tests/testthat/_snaps/compare_parameters.md
+++ b/tests/testthat/_snaps/compare_parameters.md
@@ -104,3 +104,36 @@
       | SD (Residual)           | 31.13 (27.89, 34.75)  |        | 31.30 (28.02, 34.96) |        |
       +-------------------------+-----------------------+--------+----------------------+--------+ 
 
+---
+
+    Code
+      print(out)
+    Output
+      +----------------+-----------------------+----------------------+
+      |                | lm1                   | lm2                  |
+      +----------------+-----------------------+----------------------+
+      | 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 502089471..447dd28b5 100644
--- a/tests/testthat/test-compare_parameters.R
+++ b/tests/testthat/test-compare_parameters.R
@@ -149,6 +149,15 @@ withr::with_options(
         regex = "Cannot combine"
       )
 
+      # with reference level
+      cp <- compare_parameters(lm1, lm2, drop = "^\\(Intercept", include_reference = TRUE)
+      out <- print_md(cp, groups = list(
+        Groups = 2:4,
+        Interactions = 5:6,
+        Controls = 1
+      ))
+      expect_snapshot(print(out))
+
       # error
       cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept")
       expect_error(

From 09fa0ecf9aac0b3ca6be95e8a839b4a0ec70dfd7 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 15:41:30 +0100
Subject: [PATCH 06/19] update news

---
 NEWS.md | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 970877c72..e8aadb213 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -9,6 +9,10 @@
 * `include_reference` can now directly be set to `TRUE` in `model_parameters()`
   and doesn't require a call to `print()` anymore.
 
+* `print_md()` for `compare_parameters()` now by default uses the *tinytable*
+  package to create markdown tables. This allows better control for column
+  heading spanning over multiple columns.
+
 ## Bug fixes
 
 * Fixed issue with parameter names for `model_parameters()` and objects from

From 62aa8ba1ecdd12c442b501aca5b18059b25cda5d Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 15:42:06 +0100
Subject: [PATCH 07/19] news

---
 NEWS.md | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index e8aadb213..3e9bfe8f9 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -9,6 +9,9 @@
 * `include_reference` can now directly be set to `TRUE` in `model_parameters()`
   and doesn't require a call to `print()` anymore.
 
+* `compare_parameters()` gains a `include_reference` argument, to add the
+  reference category of categorical predictors to the parameters table.
+
 * `print_md()` for `compare_parameters()` now by default uses the *tinytable*
   package to create markdown tables. This allows better control for column
   heading spanning over multiple columns.

From 217ac371becffafe2e25401ff5dbb077f2c5214b Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 15:56:45 +0100
Subject: [PATCH 08/19] fix

---
 R/print_md.R                                |  4 +++
 tests/testthat/_snaps/compare_parameters.md | 35 +++++++++++++++++++--
 tests/testthat/test-compare_parameters.R    |  9 ++++++
 3 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/R/print_md.R b/R/print_md.R
index 3feeeebd6..cd4337212 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -376,6 +376,10 @@ print_md.parameters_distribution <- function(x, digits = 2, ci_brackets = c("(",
   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
diff --git a/tests/testthat/_snaps/compare_parameters.md b/tests/testthat/_snaps/compare_parameters.md
index f4d4c4ced..2e807d8ab 100644
--- a/tests/testthat/_snaps/compare_parameters.md
+++ b/tests/testthat/_snaps/compare_parameters.md
@@ -109,8 +109,39 @@
     Code
       print(out)
     Output
-      +----------------+-----------------------+----------------------+
-      |                | lm1                   | lm2                  |
+      +----------------+-----------------------+--------+----------------------+--------+
+      |                | 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                  |
       +================+=======================+======================+
diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R
index 447dd28b5..13248917f 100644
--- a/tests/testthat/test-compare_parameters.R
+++ b/tests/testthat/test-compare_parameters.R
@@ -149,6 +149,15 @@ withr::with_options(
         regex = "Cannot combine"
       )
 
+      # with reference level
+      cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept", include_reference = TRUE)
+      out <- print_md(cp, groups = list(
+        Groups = 2:4,
+        Interactions = 5:6,
+        Controls = 1
+      ))
+      expect_snapshot(print(out))
+
       # with reference level
       cp <- compare_parameters(lm1, lm2, drop = "^\\(Intercept", include_reference = TRUE)
       out <- print_md(cp, groups = list(

From 15864c56fc51507658ca04eeabc96bcd677a63b1 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 18:55:36 +0100
Subject: [PATCH 09/19] fix

---
 R/print_table.R | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/R/print_table.R b/R/print_table.R
index 029f40c3a..75229fafa 100644
--- a/R/print_table.R
+++ b/R/print_table.R
@@ -154,7 +154,7 @@ print_table <- function(x, digits = 2, p_digits = 3, theme = "default", ...) {
   }
 
   # base table
-  out <- tinytable::tt(x, caption = NULL, notes = NULL, ...)
+  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, i = row_header_labels, j = col_groups)
@@ -164,10 +164,8 @@ print_table <- function(x, digits = 2, p_digits = 3, theme = "default", ...) {
   }
   # style table
   out <- insight::apply_table_theme(out, x, theme = theme, sub_header_positions = row_header_pos)
-  # workaround, to make sure HTML is default output
-  m <- attr(out, "tinytable_meta")
-  m$output <- "html"
-  attr(out, "tinytable_meta") <- m
+  # make sure HTML is default output
+  out@output <- "html"
 
   out
 }

From 8c19f0bcedc0b6ea857683c2d33fef3d9ca163fb Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 19:00:40 +0100
Subject: [PATCH 10/19] minor

---
 R/print_md.R | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/R/print_md.R b/R/print_md.R
index cd4337212..68ae10356 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -346,7 +346,7 @@ print_md.parameters_distribution <- function(x, digits = 2, ci_brackets = c("(",
 
 # helper -----------------------
 
-.export_table_tt <- function(x, formatted_table, groups, caption = NULL, footer = NULL) {
+.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
@@ -423,7 +423,12 @@ print_md.parameters_distribution <- function(x, digits = 2, ci_brackets = c("(",
       }
       g
     })
-    names(row_groups) <- paste0("*", names(groups), "*")
+    # 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)] <- ""
@@ -431,6 +436,6 @@ print_md.parameters_distribution <- function(x, digits = 2, ci_brackets = c("(",
   out <- tinytable::tt(formatted_table, notes = footer, caption = caption)
   # insert sub header rows and column spans
   out <- tinytable::group_tt(out, i = row_groups, j = col_groups)
-  out@output <- "markdown"
+  out@output <- outformat
   out
 }

From e1f85dd2b682f3e495b9bcc7c01b3a93951a2124 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 19:14:36 +0100
Subject: [PATCH 11/19] also allow tinytable

---
 R/print_html.R | 24 ++++++++++++++++++++++++
 R/print_md.R   | 10 +++++++++-
 2 files changed, 33 insertions(+), 1 deletion(-)

diff --git a/R/print_html.R b/R/print_html.R
index 9b21d4180..0b10cef6d 100644
--- a/R/print_html.R
+++ b/R/print_html.R
@@ -150,6 +150,7 @@ print_html.compare_parameters <- function(x,
                                           font_size = "100%",
                                           line_padding = 4,
                                           column_labels = NULL,
+                                          engine = "gt",
                                           ...) {
   # check if user supplied digits attributes
   if (missing(digits)) {
@@ -169,6 +170,29 @@ print_html.compare_parameters <- function(x,
     select <- attributes(x)$output_style
   }
 
+  # markdown engine?
+  engine <- match.arg(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"
+    ))
+  }
+
   # we need glue-like syntax right now...
   select <- .convert_to_glue_syntax(style = select, "<br>")
 
diff --git a/R/print_md.R b/R/print_md.R
index 68ae10356..7793d8c9a 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -173,12 +173,20 @@ print_md.compare_parameters <- function(x,
   )
 
   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"
+    }
     .export_table_tt(
       x,
       formatted_table,
       groups,
       caption = caption,
-      footer = footer
+      footer = footer,
+      outformat = outformat
     )
   } else {
     insight::export_table(

From e05fb335b4287e05883f71511438b08d36813006 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 19:18:55 +0100
Subject: [PATCH 12/19] docs, option

---
 R/print.parameters_model.R    | 18 +++++++++++-------
 R/print_html.R                |  2 +-
 man/model_parameters.Rd       |  3 +++
 man/print.parameters_model.Rd |  3 +++
 4 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R
index b707ed422..7fd638de9 100644
--- a/R/print.parameters_model.R
+++ b/R/print.parameters_model.R
@@ -137,6 +137,10 @@
 #' default for the `select` argument. See argument's documentation for available
 #' options.
 #'
+#' - `easystats_html_engine`: `options(easystats_html_engine = "gt")` will set
+#' the default HTML engine for tables to `gt`, i.e. the _gt_ package is used to
+#' create HTML tables. If set to `tt`, the _tinytable_ package is used.
+#'
 #' @details `summary()` is a convenient shortcut for
 #'   `print(object, select = "minimal", show_sigma = TRUE, show_formula = TRUE)`.
 #'
@@ -412,7 +416,7 @@ print.parameters_random <- function(x, digits = 2, ...) {
                           show_formula = FALSE,
                           format = "text") {
   # get attributes
-  sigma <- attributes(x)$sigma
+  model_sigma <- attributes(x)$sigma
   show_summary <- isTRUE(attributes(x)$show_summary)
   verbose <- .additional_arguments(x, "verbose", TRUE)
 
@@ -423,7 +427,7 @@ print.parameters_random <- function(x, digits = 2, ...) {
   show_r2 <- .additional_arguments(x, "show_summary", FALSE)
 
   # set defaults, if necessary
-  if (is.null(sigma)) {
+  if (is.null(model_sigma)) {
     show_sigma <- FALSE
   }
 
@@ -522,10 +526,10 @@ print.parameters_random <- function(x, digits = 2, ...) {
   random_params$Term[is.na(random_params$Term)] <- ""
   random_params$SD[is.na(random_params$SD)] <- ""
 
-  non_empty <- random_params$Term != "" & random_params$Type != ""
+  non_empty <- random_params$Term != "" & random_params$Type != "" # nolint
   random_params$Line[non_empty] <- sprintf("%s (%s)", random_params$Type[non_empty], random_params$Term[non_empty])
 
-  non_empty <- random_params$Term != "" & random_params$Type == ""
+  non_empty <- random_params$Term != "" & random_params$Type == "" # nolint
   random_params$Line[non_empty] <- sprintf("%s", random_params$Term[non_empty])
 
   # final fix, indentions
@@ -567,9 +571,9 @@ print.parameters_random <- function(x, digits = 2, ...) {
   col_width <- rep(NA, length(shared_cols))
   for (i in seq_along(shared_cols)) {
     col_width[i] <- max(unlist(lapply(formatted_table, function(j) {
-      col <- j[[shared_cols[i]]]
-      if (!is.null(col)) {
-        max(nchar(col))
+      column <- j[[shared_cols[i]]]
+      if (!is.null(column)) {
+        max(nchar(column))
       } else {
         NA
       }
diff --git a/R/print_html.R b/R/print_html.R
index 0b10cef6d..2998b00d0 100644
--- a/R/print_html.R
+++ b/R/print_html.R
@@ -171,7 +171,7 @@ print_html.compare_parameters <- function(x,
   }
 
   # markdown engine?
-  engine <- match.arg(engine, c("gt", "default", "tt"))
+  engine <- match.arg(getOption("easystats_html_engine", engine), c("gt", "default", "tt"))
 
   # for tiny table, we can just call print_md()
   if (engine == "tt") {
diff --git a/man/model_parameters.Rd b/man/model_parameters.Rd
index 70e012556..d124d2cc9 100644
--- a/man/model_parameters.Rd
+++ b/man/model_parameters.Rd
@@ -374,6 +374,9 @@ will replace the interaction mark (by default, \code{*}) with the related charac
 \item \code{parameters_select}: \verb{options(parameters_select = <value>)} will set the
 default for the \code{select} argument. See argument's documentation for available
 options.
+\item \code{easystats_html_engine}: \code{options(easystats_html_engine = "gt")} will set
+the default HTML engine for tables to \code{gt}, i.e. the \emph{gt} package is used to
+create HTML tables. If set to \code{tt}, the \emph{tinytable} package is used.
 }
 }
 
diff --git a/man/print.parameters_model.Rd b/man/print.parameters_model.Rd
index 5b602b1d9..18bec59c7 100644
--- a/man/print.parameters_model.Rd
+++ b/man/print.parameters_model.Rd
@@ -185,6 +185,9 @@ will replace the interaction mark (by default, \code{*}) with the related charac
 \item \code{parameters_select}: \verb{options(parameters_select = <value>)} will set the
 default for the \code{select} argument. See argument's documentation for available
 options.
+\item \code{easystats_html_engine}: \code{options(easystats_html_engine = "gt")} will set
+the default HTML engine for tables to \code{gt}, i.e. the \emph{gt} package is used to
+create HTML tables. If set to \code{tt}, the \emph{tinytable} package is used.
 }
 }
 

From 669935d4974162a513351a99add4024f9d067a4b Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 19:20:30 +0100
Subject: [PATCH 13/19] docs

---
 R/display.R                     | 3 ++-
 man/display.parameters_model.Rd | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/R/display.R b/R/display.R
index deb95ca05..2b49df843 100644
--- a/R/display.R
+++ b/R/display.R
@@ -53,7 +53,8 @@
 #' 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'.
+#' effects in the table. See 'Examples'. An alternative is to set `engine = "tt"`
+#' in `print_html()` tp use the _tinytable_ package for creating HTML tables.
 #'
 #' @seealso [print.parameters_model()]
 #'
diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd
index 1a36422f7..d608bdb1f 100644
--- a/man/display.parameters_model.Rd
+++ b/man/display.parameters_model.Rd
@@ -305,7 +305,8 @@ 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'.
+effects in the table. See 'Examples'. An alternative is to set \code{engine = "tt"}
+in \code{print_html()} tp use the \emph{tinytable} package for creating HTML tables.
 }
 \examples{
 \dontshow{if (require("gt", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}

From 1510bb75a3e0031f11f960c86c1776c2d259310c Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 19:47:34 +0100
Subject: [PATCH 14/19] wordlist

---
 inst/WORDLIST | 1 +
 1 file changed, 1 insertion(+)

diff --git a/inst/WORDLIST b/inst/WORDLIST
index d31a439cc..7637348ab 100644
--- a/inst/WORDLIST
+++ b/inst/WORDLIST
@@ -313,6 +313,7 @@ subscales
 systemfit
 th
 tidymodels
+tinytable
 tseries
 unicode
 varEST

From 666f10e558a44884d8385bb1f6090b7f5f50d17e Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 21:22:26 +0100
Subject: [PATCH 15/19] lintr

---
 R/display.R                     |  2 +-
 R/print.parameters_model.R      | 12 ++++++------
 R/print_md.R                    | 20 +++++++++-----------
 R/print_table.R                 |  6 +++---
 man/display.parameters_model.Rd |  2 +-
 5 files changed, 20 insertions(+), 22 deletions(-)

diff --git a/R/display.R b/R/display.R
index 2b49df843..ba45e6a66 100644
--- a/R/display.R
+++ b/R/display.R
@@ -54,7 +54,7 @@
 #' (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()` tp use the _tinytable_ package for creating HTML tables.
+#' in `print_html()` to use the _tinytable_ package for creating HTML tables.
 #'
 #' @seealso [print.parameters_model()]
 #'
diff --git a/R/print.parameters_model.R b/R/print.parameters_model.R
index 7fd638de9..422791258 100644
--- a/R/print.parameters_model.R
+++ b/R/print.parameters_model.R
@@ -312,10 +312,10 @@ print.parameters_model <- function(x,
     footer <- ""
   }
   if (!identical(footer, "")) {
-    if (!is.null(footer)) {
-      footer <- paste0("\n", footer, "\n", footer_stats)
-    } else {
+    if (is.null(footer)) {
       footer <- footer_stats
+    } else {
+      footer <- paste0("\n", footer, "\n", footer_stats)
     }
   }
 
@@ -572,10 +572,10 @@ print.parameters_random <- function(x, digits = 2, ...) {
   for (i in seq_along(shared_cols)) {
     col_width[i] <- max(unlist(lapply(formatted_table, function(j) {
       column <- j[[shared_cols[i]]]
-      if (!is.null(column)) {
-        max(nchar(column))
-      } else {
+      if (is.null(column)) {
         NA
+      } else {
+        max(nchar(column))
       }
     })))
   }
diff --git a/R/print_md.R b/R/print_md.R
index 7793d8c9a..42a18d18d 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -91,10 +91,10 @@ print_md.parameters_model <- function(x,
     footer <- ""
   }
   if (!identical(footer, "")) {
-    if (!is.null(footer)) {
-      footer <- paste0("\n", footer, "\n", footer_stats)
-    } else {
+    if (is.null(footer)) {
       footer <- footer_stats
+    } else {
+      footer <- paste0("\n", footer, "\n", footer_stats)
     }
   }
 
@@ -285,14 +285,12 @@ print_md.equivalence_test_lm <- function(x, digits = 2, ci_brackets = c("(", ")"
   rule <- attributes(x)$rule
   rope <- attributes(x)$rope
 
-  if (!is.null(rule)) {
-    if (rule == "cet") {
-      table_caption <- "Conditional Equivalence Testing"
-    } else if (rule == "classic") {
-      table_caption <- "TOST-test for Practical Equivalence"
-    } else {
-      table_caption <- "Test for Practical Equivalence"
-    }
+  if (is.null(rule)) {
+    table_caption <- "Test for Practical Equivalence"
+  } else if (rule == "cet") {
+    table_caption <- "Conditional Equivalence Testing"
+  } else if (rule == "classic") {
+    table_caption <- "TOST-test for Practical Equivalence"
   } else {
     table_caption <- "Test for Practical Equivalence"
   }
diff --git a/R/print_table.R b/R/print_table.R
index 75229fafa..d86399c09 100644
--- a/R/print_table.R
+++ b/R/print_table.R
@@ -156,11 +156,11 @@ print_table <- function(x, digits = 2, p_digits = 3, theme = "default", ...) {
   # base table
   out <- tinytable::tt(as.data.frame(x), caption = NULL, notes = NULL, ...)
   # add subheaders, if any
-  if (!is.null(row_header_labels)) {
+  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)
-  } else {
-    out <- tinytable::group_tt(out, j = col_groups)
   }
   # style table
   out <- insight::apply_table_theme(out, x, theme = theme, sub_header_positions = row_header_pos)
diff --git a/man/display.parameters_model.Rd b/man/display.parameters_model.Rd
index d608bdb1f..f351e0c63 100644
--- a/man/display.parameters_model.Rd
+++ b/man/display.parameters_model.Rd
@@ -306,7 +306,7 @@ 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()} tp use the \emph{tinytable} package for creating HTML tables.
+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}

From adabe89cbeb329347bc484a3b4ba2a61734be18d Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 22:07:47 +0100
Subject: [PATCH 16/19] tests

---
 tests/testthat/test-model_parameters_df.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-model_parameters_df.R b/tests/testthat/test-model_parameters_df.R
index 5ad60ce95..f8d4637d7 100644
--- a/tests/testthat/test-model_parameters_df.R
+++ b/tests/testthat/test-model_parameters_df.R
@@ -28,7 +28,7 @@ test_that("model_parameters.glm", {
 
 
 test_that("model_parameters.BBmm", {
-  skip_if_not_installed("PROreg")
+  skip_if_not_installed("PROreg", minimum_version = "1.3.0")
   set.seed(1234)
 
   # defining the parameters
@@ -73,7 +73,7 @@ test_that("model_parameters.BBmm", {
 })
 
 test_that("model_parameters.BBreg", {
-  skip_if_not_installed("PROreg")
+  skip_if_not_installed("PROreg", minimum_version = "1.3.0")
   set.seed(18)
   # we simulate a covariate, fix the paramters of the beta-binomial
   # distribution and simulate a response variable.

From 78eba0208ad968ce99c4ed02d1a1c9c51f46c530 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 22:27:22 +0100
Subject: [PATCH 17/19] test

---
 R/compare_parameters.R                   |  2 ++
 R/print.compare_parameters.R             |  3 +++
 R/print_html.R                           |  3 +++
 R/print_md.R                             |  3 +++
 man/compare_parameters.Rd                | 12 ++++++++++++
 tests/testthat/test-compare_parameters.R | 21 +++++++++++++++++++++
 6 files changed, 44 insertions(+)

diff --git a/R/compare_parameters.R b/R/compare_parameters.R
index 4e1e7b6b8..2c6fa7943 100644
--- a/R/compare_parameters.R
+++ b/R/compare_parameters.R
@@ -84,6 +84,7 @@ compare_parameters <- function(...,
                                keep = NULL,
                                drop = NULL,
                                include_reference = FALSE,
+                               groups = NULL,
                                verbose = TRUE) {
   models <- list(...)
 
@@ -255,6 +256,7 @@ compare_parameters <- function(...,
   attr(all_models, "model_names") <- gsub("\"", "", unlist(lapply(model_names, insight::safe_deparse)), fixed = TRUE)
   attr(all_models, "output_style") <- select
   attr(all_models, "all_attributes") <- object_attributes
+  attr(all_models, "parameter_groups") <- groups
   class(all_models) <- c("compare_parameters", "see_compare_parameters", unique(class(all_models)))
 
   all_models
diff --git a/R/print.compare_parameters.R b/R/print.compare_parameters.R
index 2bcdab704..8845d0701 100644
--- a/R/print.compare_parameters.R
+++ b/R/print.compare_parameters.R
@@ -31,6 +31,9 @@ print.compare_parameters <- function(x,
   if (missing(select)) {
     select <- attributes(x)$output_style
   }
+  if (missing(groups)) {
+    groups <- attributes(x)$parameter_groups
+  }
 
   formatted_table <- format(
     x,
diff --git a/R/print_html.R b/R/print_html.R
index 2998b00d0..d71aa194b 100644
--- a/R/print_html.R
+++ b/R/print_html.R
@@ -46,6 +46,9 @@ print_html.parameters_model <- function(x,
   if (missing(select) || is.null(select)) {
     select <- attributes(x)$output_style
   }
+  if (missing(groups)) {
+    groups <- attributes(x)$parameter_groups
+  }
 
   # we need glue-like syntax right now...
   if (!is.null(select)) {
diff --git a/R/print_md.R b/R/print_md.R
index 42a18d18d..98a7adbec 100644
--- a/R/print_md.R
+++ b/R/print_md.R
@@ -153,6 +153,9 @@ print_md.compare_parameters <- function(x,
   if (missing(select) || is.null(select)) {
     select <- attributes(x)$output_style
   }
+  if (missing(groups)) {
+    groups <- attributes(x)$parameter_groups
+  }
 
   # markdown engine?
   engine <- match.arg(engine, c("tt", "default"))
diff --git a/man/compare_parameters.Rd b/man/compare_parameters.Rd
index bd385e8fa..0218c9bb0 100644
--- a/man/compare_parameters.Rd
+++ b/man/compare_parameters.Rd
@@ -21,6 +21,7 @@ compare_parameters(
   keep = NULL,
   drop = NULL,
   include_reference = FALSE,
+  groups = NULL,
   verbose = TRUE
 )
 
@@ -40,6 +41,7 @@ compare_models(
   keep = NULL,
   drop = NULL,
   include_reference = FALSE,
+  groups = NULL,
   verbose = TRUE
 )
 }
@@ -187,6 +189,16 @@ 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{groups}{Named list, can be used to group parameters in the printed output.
+List elements may either be character vectors that match the name of those
+parameters that belong to one group, or list elements can be row numbers
+of those parameter rows that should belong to one group. The names of the
+list elements will be used as group names, which will be inserted as "header
+row". A possible use case might be to emphasize focal predictors and control
+variables, see 'Examples'. Parameters will be re-ordered according to the
+order used in \code{groups}, while all non-matching parameters will be added
+to the end.}
+
 \item{verbose}{Toggle warnings and messages.}
 }
 \value{
diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R
index 13248917f..fe261d8d9 100644
--- a/tests/testthat/test-compare_parameters.R
+++ b/tests/testthat/test-compare_parameters.R
@@ -185,6 +185,27 @@ withr::with_options(
         )),
         regex = "Some group indices"
       )
+
+      # 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"
+      )))
+      cp2 <- compare_parameters(
+        lm1,
+        lm2,
+        select = "{estimate} ({ci})|{p}",
+        drop = "^\\(Intercept",
+        groups = list(
+          Groups = c("grp (2)", "grp (3)"),
+          Interactions = c("Days * grp (2)", "Days * grp (3)"),
+          Controls = "Days"
+        )
+      )
+      out2 <- capture.output(print_md(cp2))
+      expect_identical(out1, out2)
     })
   }
 )

From 614c71ad47e46e17a562a4963c56dbaf27a5fe80 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 13 Mar 2024 23:47:59 +0100
Subject: [PATCH 18/19] min version

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 4b825b4b9..1bfba562d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -182,7 +182,7 @@ Suggests:
     PMCMRplus,
     poorman,
     posterior,
-    PROreg,
+    PROreg (>= 1.3.0),
     pscl,
     psych,
     pvclust,

From ef6406f3a71a5015d3493e52a604cda94c57b98d Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Thu, 14 Mar 2024 00:13:29 +0100
Subject: [PATCH 19/19] fix

---
 tests/testthat/test-model_parameters_df.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/tests/testthat/test-model_parameters_df.R b/tests/testthat/test-model_parameters_df.R
index f8d4637d7..da8b44508 100644
--- a/tests/testthat/test-model_parameters_df.R
+++ b/tests/testthat/test-model_parameters_df.R
@@ -63,13 +63,13 @@ test_that("model_parameters.BBmm", {
   }))
   params <- suppressWarnings(model_parameters(model))
   expect_equal(params$df_error, c(96, 96), tolerance = 1e-3)
-  expect_equal(params$CI_low, c(0.26363, -1.46645), tolerance = 1e-3)
-  expect_equal(params$p, c(0.00811, 0), tolerance = 1e-3)
+  expect_equal(params$CI_low, c(0.26366, -1.46628), tolerance = 1e-3)
+  expect_equal(params$p, c(0.00814, 0), tolerance = 1e-3)
 
   params <- suppressWarnings(model_parameters(model, ci_method = "normal"))
   expect_equal(params$df_error, c(Inf, Inf), tolerance = 1e-3)
-  expect_equal(params$CI_low, c(0.27359, -1.46136), tolerance = 1e-3)
-  expect_equal(params$p, c(0.00811, 0), tolerance = 1e-3)
+  expect_equal(params$CI_low, c(0.27313, -1.46119), tolerance = 1e-3)
+  expect_equal(params$p, c(0.00814, 0), tolerance = 1e-3)
 })
 
 test_that("model_parameters.BBreg", {