Merge branch 'main' into strengejacke/issue962

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.22.2.18
+Version: 0.22.2.20
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -34,6 +34,14 @@
 
 * Improved printing for `simulate_parameters()` for models from packages *mclogit*.
 
+* `print()` for `compare_parameters()` now also puts factor levels into square
+  brackets, like the `print()` method for `model_parameters()`.
+
+## Bug fixes
+
+* Arguments like `digits` etc. were ignored in `model_parameters() for objects
+  from the *marginaleffects* package.
+
 # parameters 0.22.2
 
 ## New supported models

R/1_model_parameters.R

@@ -61,7 +61,7 @@
 #'   [`print_md()`][print_md.parameters_model]. \cr \cr **For developers**, if
 #'   speed performance is an issue, you can use the (undocumented) `pretty_names`
 #'   argument, e.g. `model_parameters(..., pretty_names = FALSE)`. This will
-#'   skip the formatting of the coefficient names and make `model_parameters()`
+#'   skip the formatting of the coefficient names and makes `model_parameters()`
 #'   faster.
 #'
 #' @section Standardization of model coefficients:

R/compare_parameters.R

@@ -2,15 +2,15 @@
 #' @name compare_parameters
 #'
 #' @description Compute and extract model parameters of multiple regression
-#'   models. See [model_parameters()] for further details.
+#'   models. See [`model_parameters()`] for further details.
 #'
 #' @param ... One or more regression model objects, or objects returned by
 #'   `model_parameters()`. Regression models may be of different model
 #'   types. Model objects may be passed comma separated, or as a list.
 #'   If model objects are passed with names or the list has named elements,
 #'   these names will be used as column names.
 #' @param component Model component for which parameters should be shown. See
-#'   documentation for related model class in [model_parameters()].
+#'   documentation for related model class in [`model_parameters()`].
 #' @param column_names Character vector with strings that should be used as
 #'   column headers. Must be of same length as number of models in `...`.
 #' @param ci_method Method for computing degrees of freedom for p-values
@@ -303,11 +303,6 @@ compare_models <- compare_parameters
       }
     }
   }
-
-  if (!is.null(x$Parameter)) {
-    x$Parameter <- gsub("]", ")", gsub("[", "(", x$Parameter, fixed = TRUE), fixed = TRUE)
-  }
-
   x
 }
 

R/format.R

@@ -573,13 +573,13 @@ format.parameters_sem <- function(x,
   }
 
   # footer: r-squared
-  if (isTRUE(show_r2)) {
-    footer <- .add_footer_r2(footer, digits, r2, type)
+  if (isTRUE(show_rmse)) {
+    footer <- .add_footer_values(footer, digits, value = rmse, text = "RMSE ", type)
   }
 
   # footer: r-squared
-  if (isTRUE(show_rmse)) {
-    footer <- .add_footer_values(footer, digits, value = rmse, text = "RMSE ", type)
+  if (isTRUE(show_r2)) {
+    footer <- .add_footer_r2(footer, digits, r2, type)
   }
 
   # footer: p-adjustment

R/methods_marginaleffects.R

@@ -45,6 +45,15 @@ model_parameters.marginaleffects <- function(model,
   # exponentiate coefficients and SE/CI, if requested
   out <- .exponentiate_parameters(out, model = NULL, exponentiate)
 
+  # add further information as attributes
+  out <- .add_model_parameters_attributes(
+    out,
+    model = model,
+    ci = ci,
+    exponentiate = exponentiate,
+    ...
+  )
+
   class(out) <- c("parameters_model", "see_parameters_model", class(out))
   out
 }
@@ -97,6 +106,15 @@ model_parameters.predictions <- function(model,
   # exponentiate coefficients and SE/CI, if requested
   out <- .exponentiate_parameters(out, model = NULL, exponentiate)
 
+  # add further information as attributes
+  out <- .add_model_parameters_attributes(
+    out,
+    model = model,
+    ci = ci,
+    exponentiate = exponentiate,
+    ...
+  )
+
   class(out) <- c("parameters_model", "see_parameters_model", class(out))
   out
 }

R/print.compare_parameters.R

@@ -42,7 +42,7 @@ print.compare_parameters <- function(x,
                                      zap_small = FALSE,
                                      groups = NULL,
                                      column_width = NULL,
-                                     ci_brackets = c("(", ")"),
+                                     ci_brackets = c("[", "]"),
                                      select = NULL,
                                      ...) {
   # save original input

R/print.parameters_model.R

@@ -12,26 +12,33 @@
 #' printed. There are three options for this argument:
 #'
 #' 1. Selecting columns by name or index
-#' \cr
+#'
 #'   `select` can be a character vector (or numeric index) of column names that
-#'   should be printed. There are two pre-defined options for selecting columns:
-#'   `select = "minimal"` prints coefficients, confidence intervals and p-values,
-#'   while `select = "short"` prints coefficients, standard errors and p-values.
+#'   should be printed, where columns are extracted from the data frame returned
+#'   by `model_parameters()` and related functions.
+#'
+#'   There are two pre-defined options for selecting columns:
+#'   `select = "minimal"` prints coefficients, confidence intervals and
+#'   p-values, while `select = "short"` prints coefficients, standard errors and
+#'   p-values.
 #'
 #' 2. A string expression with layout pattern
-#' \cr
-#'   `select` is a string with "tokens" enclosed in braces. These tokens will
-#'   be replaced by their associated columns, where the selected columns will
-#'   be collapsed into one column. However, it is possible to create multiple
-#'   columns as well. Following tokens are replaced by the related coefficients
-#'   or statistics: `{estimate}`, `{se}`, `{ci}` (or `{ci_low}` and `{ci_high}`),
-#'   `{p}` and `{stars}`. The token `{ci}` will be replaced by `{ci_low}, {ci_high}`.
-#'   Furthermore, a `|` separates values into new cells/columns. If
-#'   `format = "html"`, a `<br>` inserts a line break inside a cell. See
+#'
+#'   `select` is a string with "tokens" enclosed in braces. These tokens will be
+#'   replaced by their associated columns, where the selected columns will be
+#'   collapsed into one column. Following tokens are replaced by the related
+#'   coefficients or statistics: `{estimate}`, `{se}`, `{ci}` (or `{ci_low}` and
+#'   `{ci_high}`), `{p}` and `{stars}`. The token `{ci}` will be replaced by
+#'   `{ci_low}, {ci_high}`. Example: `select = "{estimate}{stars} ({ci})"`
+#'
+#'   It is possible to create multiple columns as well. A `|` separates values
+#'   into new cells/columns. Example: `select = "{estimate} ({ci})|{p}"`.
+#'
+#'   If `format = "html"`, a `<br>` inserts a line break inside a cell. See
 #'   'Examples'.
 #'
 #' 3. A string indicating a pre-defined layout
-#' \cr
+#'
 #'   `select` can be one of the following string values, to create one of the
 #'   following pre-defined column layouts:
 #'

R/print_html.R

@@ -214,6 +214,12 @@ print_html.compare_parameters <- function(x,
     groups = groups
   )
 
+  # replace brackets by parenthesis
+  if (!is.null(ci_brackets) && "Parameter" %in% colnames(formatted_table)) {
+    formatted_table$Parameter <- gsub("[", ci_brackets[1], formatted_table$Parameter, fixed = TRUE)
+    formatted_table$Parameter <- gsub("]", ci_brackets[2], formatted_table$Parameter, fixed = TRUE)
+  }
+
   out <- insight::export_table(
     formatted_table,
     format = "html",

R/print_md.R

@@ -176,6 +176,12 @@ print_md.compare_parameters <- function(x,
     engine = engine
   )
 
+  # replace brackets by parenthesis
+  if (!is.null(ci_brackets) && "Parameter" %in% colnames(formatted_table)) {
+    formatted_table$Parameter <- gsub("[", ci_brackets[1], formatted_table$Parameter, fixed = TRUE)
+    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(...)
@@ -285,7 +291,11 @@ print_md.parameters_pca <- 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
 

R/utils_format.R

@@ -371,7 +371,7 @@
 
   # check if we have model data, else return parameter table
   if (is.null(model_data)) {
-    params
+    return(params)
   }
 
   # find factors and factor levels and check if we have any factors in the data
@@ -385,7 +385,17 @@
     factors <- factors[setdiff(names(factors), remove_contrasts)]
   }
   if (!length(factors)) {
-    params
+    # in case of "on-the-fly" factors, e.g.:
+    # m <- lm(mpg ~ cut(wt, c(0, 2.5, 3, 5)), data = mtcars)
+    # we need to receive the data from the model frame, in order to find factors
+    model_data <- insight::get_data(model, source = "mf", verbose = FALSE)
+    if (!is.null(model_data)) {
+      factors <- .find_factor_levels(model_data, model, model_call = attributes(params)$model_call)
+    }
+    # if we still didn't find anything, quit...
+    if (!length(factors)) {
+      return(params)
+    }
   }
 
   # we need some more information about prettified labels etc.
@@ -438,6 +448,19 @@
       }
       # create a pretty level for the reference category
       pretty_level <- paste0(fn_clean, " [", sub(fn, "", reference_level, fixed = TRUE), "]")
+      pretty_level <- gsub("_", " ", pretty_level, fixed = TRUE)
+      # special handling for "cut()"
+      pattern_cut_right <- "(.*)\\((.*),(.*)\\]\\]$"
+      pattern_cut_left <- "(.*)\\[(.*),(.*)\\)\\]$"
+      if (all(grepl(pattern_cut_right, pretty_level))) {
+        lower_bounds <- gsub(pattern_cut_right, "\\2", pretty_level)
+        upper_bounds <- gsub(pattern_cut_right, "\\3", pretty_level)
+        pretty_level <- gsub(pattern_cut_right, paste0("\\1>", as.numeric(lower_bounds), "-", upper_bounds, "]"), pretty_level)
+      } else if (all(grepl(pattern_cut_left, pretty_level))) {
+        lower_bounds <- gsub(pattern_cut_left, "\\2", pretty_level)
+        upper_bounds <- gsub(pattern_cut_left, "\\3", pretty_level)
+        pretty_level <- gsub(pattern_cut_left, paste0("\\1", as.numeric(lower_bounds), "-<", upper_bounds, "]"), pretty_level)
+      }
       # insert new pretty level at the correct position in "pretty_names"
       pretty_names <- .insert_element_at(
         pretty_names,