parameters(): performance=TRUE arg as alias for summary

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.22.2.16
+Version: 0.22.2.17
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -80,8 +80,8 @@ Depends:
     R (>= 3.6)
 Imports:
     bayestestR (>= 0.14.0),
-    datawizard (>= 0.12.3),
-    insight (>= 0.20.4),
+    datawizard (>= 0.13.0),
+    insight (>= 0.20.5),
     graphics,
     methods,
     stats,
@@ -224,4 +224,4 @@ Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/bayestestR, easystats/datawizard
+Remotes: easystats/bayestestR#678

NEWS.md

@@ -1,4 +1,13 @@
-# parameters 0.22.3
+# parameters 0.23.0
+
+## Breaking Changes
+
+* Argument `summary` in `model_parameters()` is now deprecated. Please use
+  `include_info` instead.
+
+* Changed output style for the included additional information on model formula,
+  sigma and R2 when printing model parameters. This information now also includes
+  the RMSE.
 
 ## Changes
 

R/1_model_parameters.R

@@ -398,8 +398,8 @@ model_parameters <- function(model, ...) {
 
 # Add new options to the docs in "print.parameters_model"
 
-# getOption("parameters_summary"): show model summary
-# getOption("parameters_mixed_summary"): show model summary for mixed models
+# getOption("parameters_info"): show model summary
+# getOption("parameters_mixed_info"): show model summary for mixed models
 # getOption("parameters_cimethod"): show message about CI approximation
 # getOption("parameters_exponentiate"): show warning about exp for log/logit links
 # getOption("parameters_labels"): use value/variable labels instead pretty names
@@ -466,9 +466,10 @@ parameters <- model_parameters
 #'   _Confidence intervals and approximation of degrees of freedom_ in
 #'   [`model_parameters()`] for further details. When `ci_method=NULL`, in most
 #'   cases `"wald"` is used then.
-#' @param summary Logical, if `TRUE`, prints summary information about the
+#' @param include_info Logical, if `TRUE`, prints summary information about the
 #'   model (model formula, number of observations, residual standard deviation
 #'   and more).
+#' @param summary Deprecated, please use `info` instead.
 #' @param keep Character containing a regular expression pattern that
 #'   describes the parameters that should be included (for `keep`) or excluded
 #'   (for `drop`) in the returned data frame. `keep` may also be a
@@ -566,16 +567,23 @@ model_parameters.default <- function(model,
                                      standardize = NULL,
                                      exponentiate = FALSE,
                                      p_adjust = NULL,
+                                     vcov = NULL,
+                                     vcov_args = NULL,
                                      summary = getOption("parameters_summary", FALSE),
+                                     include_info = getOption("parameters_info", FALSE),
                                      keep = NULL,
                                      drop = NULL,
                                      verbose = TRUE,
-                                     vcov = NULL,
-                                     vcov_args = NULL,
                                      ...) {
   # validation check for inputs
   .is_model_valid(model)
 
+  ## TODO remove deprecated later
+  if (!missing(summary)) {
+    .deprecated_warning("summary", "include_info", verbose)
+    include_info <- summary
+  }
+
   # validation check, warn if unsupported argument is used.
   # unsupported arguments will be removed from the argument list.
   dots <- .check_dots(
@@ -597,7 +605,7 @@ model_parameters.default <- function(model,
       standardize = standardize,
       exponentiate = exponentiate,
       p_adjust = p_adjust,
-      summary = summary,
+      include_info = include_info,
       keep_parameters = keep,
       drop_parameters = drop,
       vcov = vcov,
@@ -654,12 +662,12 @@ model_parameters.default <- function(model,
                                       component = "conditional",
                                       ci_method = NULL,
                                       p_adjust = NULL,
-                                      summary = FALSE,
+                                      include_info = FALSE,
                                       keep_parameters = NULL,
                                       drop_parameters = NULL,
-                                      verbose = TRUE,
                                       vcov = NULL,
                                       vcov_args = NULL,
+                                      verbose = TRUE,
                                       ...) {
   dots <- list(...)
 
@@ -726,7 +734,7 @@ model_parameters.default <- function(model,
     iterations,
     ci_method = ci_method,
     p_adjust = p_adjust,
-    summary = summary,
+    include_info = include_info,
     verbose = verbose,
     ...
   )
@@ -751,15 +759,22 @@ model_parameters.glm <- function(model,
                                  standardize = NULL,
                                  exponentiate = FALSE,
                                  p_adjust = NULL,
+                                 vcov = NULL,
+                                 vcov_args = NULL,
                                  summary = getOption("parameters_summary", FALSE),
+                                 include_info = getOption("parameters_info", FALSE),
                                  keep = NULL,
                                  drop = NULL,
-                                 vcov = NULL,
-                                 vcov_args = NULL,
                                  verbose = TRUE,
                                  ...) {
   dots <- list(...)
 
+  ## TODO remove deprecated later
+  if (!missing(summary)) {
+    .deprecated_warning("summary", "include_info", verbose)
+    include_info <- summary
+  }
+
   # set default
   if (is.null(ci_method)) {
     if (isTRUE(bootstrap)) {
@@ -797,7 +812,7 @@ model_parameters.glm <- function(model,
     standardize = standardize,
     exponentiate = exponentiate,
     p_adjust = p_adjust,
-    summary = summary,
+    include_info = include_info,
     keep_parameters = keep,
     drop_parameters = drop,
     vcov = vcov,

R/extract_parameters.R

@@ -16,7 +16,7 @@
                                         keep_parameters = NULL,
                                         drop_parameters = NULL,
                                         include_sigma = TRUE,
-                                        summary = FALSE,
+                                        include_info = FALSE,
                                         vcov = NULL,
                                         vcov_args = NULL,
                                         ...) {
@@ -301,7 +301,7 @@
 
   # ==== add sigma and residual df
 
-  if (isTRUE(include_sigma) || isTRUE(summary)) {
+  if (isTRUE(include_sigma) || isTRUE(include_info)) {
     parameters <- .add_sigma_residual_df(parameters, model)
   }
 
@@ -424,7 +424,7 @@
                                       keep_parameters = NULL,
                                       drop_parameters = NULL,
                                       include_sigma = FALSE,
-                                      summary = FALSE,
+                                      include_info = FALSE,
                                       vcov = NULL,
                                       vcov_args = NULL,
                                       verbose = TRUE,
@@ -639,7 +639,7 @@
 
 
   # add sigma
-  if (isTRUE(include_sigma) || isTRUE(summary)) {
+  if (isTRUE(include_sigma) || isTRUE(include_info)) {
     parameters <- .add_sigma_residual_df(parameters, model)
   }
 

R/format.R

@@ -542,13 +542,15 @@ format.parameters_sem <- function(x,
                            show_sigma = FALSE,
                            show_formula = FALSE,
                            show_r2 = FALSE,
+                           show_rmse = FALSE,
                            format = "text") {
   # prepare footer
   footer <- NULL
   type <- tolower(format)
 
   sigma_value <- attributes(x)$sigma
   r2 <- attributes(x)$r2
+  rmse <- attributes(x)$rmse
   residual_df <- attributes(x)$residual_df
   p_adjust <- attributes(x)$p_adjust
   model_formula <- attributes(x)$model_formula
@@ -575,29 +577,35 @@ format.parameters_sem <- function(x,
     footer <- .add_footer_r2(footer, digits, r2, type)
   }
 
+  # footer: r-squared
+  if (isTRUE(show_rmse)) {
+    footer <- .add_footer_values(footer, digits, value = rmse, text = "RMSE ", type)
+  }
+
   # footer: p-adjustment
-  if ("p" %in% colnames(x) && isTRUE(verbose)) {
-    footer <- .add_footer_padjust(footer, p_adjust, type)
+  if ("p" %in% colnames(x) && isTRUE(verbose) && !is.null(p_adjust) && p_adjust != "none") {
+    footer <- .add_footer_text(footer, text = paste("p-value adjustment method:", format_p_adjust(p_adjust)))
   }
 
   # footer: anova test
   if (!is.null(anova_test)) {
-    footer <- .add_footer_anova_test(footer, anova_test, type)
+    footer <- .add_footer_text(footer, text = sprintf("%s test statistic", anova_test))
   }
 
-  # footer: anova test
+  # footer: anova type
   if (!is.null(anova_type)) {
-    footer <- .add_footer_anova_type(footer, anova_type, type)
+    footer <- .add_footer_text(footer, text = sprintf("Anova Table (Type %s tests)", anova_type))
   }
 
+
   # footer: marginaleffects::comparisons()
   if (!is.null(prediction_type)) {
-    footer <- .add_footer_prediction_type(footer, prediction_type, type)
+    footer <- .add_footer_text(footer, text = sprintf("Prediction type: %s", prediction_type))
   }
 
   # footer: htest alternative
   if (!is.null(text_alternative)) {
-    footer <- .add_footer_alternative(footer, text_alternative, type)
+    footer <- .add_footer_text(footer, text = text_alternative)
   }
 
   # footer: generic text
@@ -627,7 +635,7 @@ format.parameters_sem <- function(x,
 
 # footer: generic text
 .add_footer_text <- function(footer = NULL, text = NULL, type = "text", is_ggeffects = FALSE) {
-  if (!is.null(text)) {
+  if (!is.null(text) && length(text)) {
     if (type == "text" || type == "markdown") {
       if (is.null(footer)) {
         fill <- "\n"
@@ -644,6 +652,29 @@ format.parameters_sem <- function(x,
 }
 
 
+# footer: generic values
+.add_footer_values <- function(footer = NULL,
+                               digits = 3,
+                               value = NULL,
+                               text = NULL,
+                               type = "text") {
+  if (!is.null(value) && !is.null(text)) {
+    string <- sprintf("%s: %s", text, insight::format_value(value, digits = digits))
+    if (type == "text" || type == "markdown") {
+      if (is.null(footer)) {
+        fill <- "\n"
+      } else {
+        fill <- ""
+      }
+      footer <- paste0(footer, fill, string, "\n")
+    } else if (type == "html") {
+      footer <- c(footer, string)
+    }
+  }
+  footer
+}
+
+
 # footer: residual standard deviation
 .add_footer_sigma <- function(footer = NULL, digits = 3, sigma = NULL, residual_df = NULL, type = "text") {
   if (!is.null(sigma)) {
@@ -660,9 +691,9 @@ format.parameters_sem <- function(x,
       } else {
         fill <- ""
       }
-      footer <- paste0(footer, sprintf("%sResidual standard deviation: %.*f%s\n", fill, digits, sigma, res_df))
+      footer <- paste0(footer, sprintf("%sSigma: %.*f%s\n", fill, digits, sigma, res_df))
     } else if (type == "html") {
-      footer <- c(footer, insight::trim_ws(sprintf("Residual standard deviation: %.*f%s", digits, sigma, res_df)))
+      footer <- c(footer, insight::trim_ws(sprintf("Sigma: %.*f%s", digits, sigma, res_df)))
     }
   }
   footer
@@ -693,96 +724,6 @@ format.parameters_sem <- function(x,
 }
 
 
-# footer: anova type
-.add_footer_anova_type <- function(footer = NULL, aov_type = NULL, type = "text") {
-  if (!is.null(aov_type)) {
-    if (type == "text" || type == "markdown") {
-      if (is.null(footer)) {
-        fill <- "\n"
-      } else {
-        fill <- ""
-      }
-      footer <- paste0(footer, sprintf("%sAnova Table (Type %s tests)\n", fill, aov_type))
-    } else if (type == "html") {
-      footer <- c(footer, sprintf("Anova Table (Type %s tests)", aov_type))
-    }
-  }
-  footer
-}
-
-
-# footer: marginaleffects::comparisions() prediction_type
-.add_footer_prediction_type <- function(footer = NULL, prediction_type = NULL, type = "text") {
-  if (!is.null(prediction_type)) {
-    if (type == "text" || type == "markdown") {
-      if (is.null(footer)) {
-        fill <- "\n"
-      } else {
-        fill <- ""
-      }
-      footer <- paste0(footer, sprintf("%sPrediction type: %s\n", fill, prediction_type))
-    } else if (type == "html") {
-      footer <- c(footer, sprintf("Prediction type: %s", prediction_type))
-    }
-  }
-  footer
-}
-
-
-# footer: anova test
-.add_footer_anova_test <- function(footer = NULL, test = NULL, type = "text") {
-  if (!is.null(test)) {
-    if (type == "text" || type == "markdown") {
-      if (is.null(footer)) {
-        fill <- "\n"
-      } else {
-        fill <- ""
-      }
-      footer <- paste0(footer, sprintf("%s%s test statistic\n", fill, test))
-    } else if (type == "html") {
-      footer <- c(footer, sprintf("%s test statistic", test))
-    }
-  }
-  footer
-}
-
-
-# footer: htest alternative
-.add_footer_alternative <- function(footer = NULL, text_alternative = NULL, type = "text") {
-  if (!is.null(text_alternative)) {
-    if (type == "text" || type == "markdown") {
-      if (is.null(footer)) {
-        fill <- "\n"
-      } else {
-        fill <- ""
-      }
-      footer <- paste0(footer, sprintf("%s%s\n", fill, text_alternative))
-    } else if (type == "html") {
-      footer <- c(footer, text_alternative)
-    }
-  }
-  footer
-}
-
-
-# footer: p-adjustment
-.add_footer_padjust <- function(footer = NULL, p_adjust = NULL, type = "text") {
-  if (!is.null(p_adjust) && p_adjust != "none") {
-    if (type == "text" || type == "markdown") {
-      if (is.null(footer)) {
-        fill <- "\n"
-      } else {
-        fill <- ""
-      }
-      footer <- paste0(footer, fill, "p-value adjustment method: ", format_p_adjust(p_adjust), "\n")
-    } else if (type == "html") {
-      footer <- c(footer, paste0("p-value adjustment method: ", format_p_adjust(p_adjust)))
-    }
-  }
-  footer
-}
-
-
 # footer: model formula
 .add_footer_formula <- function(footer = NULL, model_formula = NULL, n_obs = NULL, type = "text") {
   if (!is.null(model_formula)) {