fix format issue

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.3.8
+Version: 0.21.3.9
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -197,6 +197,7 @@ Suggests:
     survival,
     testthat,
     tidyselect,
+    tinytable,
     TMB,
     truncreg,
     VGAM,
@@ -206,7 +207,7 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Language: en-US
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true
@@ -215,3 +216,4 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: easystats/insight

NAMESPACE

@@ -965,6 +965,7 @@ export(pool_parameters)
 export(principal_components)
 export(print_html)
 export(print_md)
+export(print_table)
 export(random_parameters)
 export(reduce_data)
 export(reduce_parameters)

NEWS.md

@@ -24,6 +24,9 @@
 * `print(include_reference = TRUE)` for `model_parameters()` did not work when
   run inside a pipe-chain.
 
+* Fixed issues with `format()` for objects returned by `compare_parameters()`
+  that included mixed models.
+
 # parameters 0.21.3
 
 ## Changes

R/1_model_parameters.R

@@ -181,7 +181,7 @@
 #'
 #' Compared to fixed effects (or single-level) models, determining appropriate
 #' df for Wald-based inference in mixed models is more difficult.
 #' See [the R GLMM FAQ](https://bbolker.github.io/mixedmodels-misc/glmmFAQ.html#what-are-the-p-values-listed-by-summaryglmerfit-etc.-are-they-reliable)
 #' for a discussion.
 #'
 #' Several approximate methods for computing df are available, but you should
@@ -489,26 +489,24 @@
 
   # extract model parameters table, as data frame
   out <- tryCatch(
-    {
-      .model_parameters_generic(
-        model = model,
-        ci = ci,
-        ci_method = ci_method,
-        bootstrap = bootstrap,
-        iterations = iterations,
-        merge_by = "Parameter",
-        standardize = standardize,
-        exponentiate = exponentiate,
-        p_adjust = p_adjust,
-        summary = summary,
-        keep_parameters = keep,
-        drop_parameters = drop,
-        vcov = vcov,
-        vcov_args = vcov_args,
-        verbose = verbose,
-        ...
-      )
-    },
+    .model_parameters_generic(
+      model = model,
+      ci = ci,
+      ci_method = ci_method,
+      bootstrap = bootstrap,
+      iterations = iterations,
+      merge_by = "Parameter",
+      standardize = standardize,
+      exponentiate = exponentiate,
+      p_adjust = p_adjust,
+      summary = summary,
+      keep_parameters = keep,
+      drop_parameters = drop,
+      vcov = vcov,
+      vcov_args = vcov_args,
+      verbose = verbose,
+      ...
+    ),
     error = function(e) {
       fail <- NA
       attr(fail, "error") <- gsub("  ", " ", gsub("\\n", "", e$message), fixed = TRUE)

R/5_simulate_model.R

@@ -233,26 +233,26 @@
   if (is.null(iterations)) iterations <- 1000
 
   params <- insight::get_parameters(model, effects = effects, component = component, verbose = FALSE)
-  beta <- stats::setNames(params$Estimate, params$Parameter) # Transform to named vector
+  beta_mu <- stats::setNames(params$Estimate, params$Parameter) # Transform to named vector
 
   # "..." allow specification of vcov-args (#784)
   varcov <- insight::get_varcov(model, component = component, effects = effects, ...)
-  as.data.frame(.mvrnorm(n = iterations, mu = beta, Sigma = varcov))
+  as.data.frame(.mvrnorm(n = iterations, mu = beta_mu, Sigma = varcov))
 
   ## Alternative approach, similar to arm::sim()
 
   # k <- length(insight::find_parameters(model, effects = "fixed", component = "conditional", flatten = TRUE))
   # n <- insight::n_obs(model)
   # beta.cov <- stats::vcov(model) / stats::sigma(model)
   # s <- vector("double", iterations)
   # b <- array(NA, c(100, k))
   # for (i in 1:iterations) {
   #   s[i] <- stats::sigma(model) * sqrt((n - k) / rchisq(1, n - k))
-  #   b[i,] <- .mvrnorm(n = 1, mu = beta, Sigma = beta.cov * s[i] ^ 2)
+  #   b[i,] <- .mvrnorm(n = 1, mu = beta_mu, Sigma = beta.cov * s[i] ^ 2)
   # }
 }
 
 .mvrnorm <- function(n = 1, mu, Sigma, tol = 1e-06) {
   p <- length(mu)
   if (!all(dim(Sigma) == c(p, p))) {
     insight::format_error(

R/bootstrap_model.R

@@ -78,20 +78,18 @@ bootstrap_model.default <- function(model,
   type <- match.arg(type, choices = c("ordinary", "parametric", "balanced", "permutation", "antithetic"))
   parallel <- match.arg(parallel)
 
-  model_data <- data <- insight::get_data(model, verbose = FALSE)
+  model_data <- data <- insight::get_data(model, verbose = FALSE) # nolint
   model_response <- insight::find_response(model)
 
   boot_function <- function(model, data, indices) {
     d <- data[indices, ] # allows boot to select sample
 
     if (inherits(model, "biglm")) {
       fit <- suppressMessages(stats::update(model, moredata = d))
+    } else if (verbose) {
+      fit <- stats::update(model, data = d)
     } else {
-      if (verbose) {
-        fit <- stats::update(model, data = d)
-      } else {
-        fit <- suppressMessages(stats::update(model, data = d))
-      }
+      fit <- suppressMessages(stats::update(model, data = d))
     }
 
     params <- insight::get_parameters(fit, verbose = FALSE)
@@ -103,15 +101,15 @@ bootstrap_model.default <- function(model,
       params <- stats::setNames(params$Estimate, params$Parameter) # Transform to named vector
     }
 
-    return(params)
+    params
   }
 
   if (type == "parametric") {
     f <- function(x, mle) {
       out <- model_data
       resp <- stats::simulate(x, nsim = 1)
       out[[model_response]] <- resp
-      return(out)
+      out
     }
     results <- boot::boot(
       data = data,
@@ -233,7 +231,7 @@ bootstrap_model.nestedLogit <- function(model,
   type <- match.arg(type, choices = c("ordinary", "balanced", "permutation", "antithetic"))
   parallel <- match.arg(parallel)
 
-  model_data <- data <- insight::get_data(model, verbose = FALSE)
+  model_data <- data <- insight::get_data(model, verbose = FALSE) # nolint
   model_response <- insight::find_response(model)
 
   boot_function <- function(model, data, indices) {

R/bootstrap_parameters.R

@@ -60,8 +60,8 @@ bootstrap_parameters.default <- function(model,
                                          ci_method = "quantile",
                                          test = "p-value",
                                          ...) {
-  data <- bootstrap_model(model, iterations = iterations, ...)
-  bootstrap_parameters(data, centrality = centrality, ci = ci, ci_method = ci_method, test = test, ...)
+  boot_data <- bootstrap_model(model, iterations = iterations, ...)
+  bootstrap_parameters(boot_data, centrality = centrality, ci = ci, ci_method = ci_method, test = test, ...)
 }
 
 

R/ci_generic.R

@@ -26,7 +26,7 @@
   effects <- match.arg(effects)
   component <- match.arg(component)
 
-  if (method == "ml1") {
+  if (method == "ml1") { # nolint
     return(ci_ml1(model, ci = ci))
   } else if (method == "betwithin") {
     return(ci_betwithin(model, ci = ci))
@@ -110,9 +110,9 @@
       )
     } else {
       stderror <- switch(method,
-        "kenward" = se_kenward(model),
-        "kr" = se_kenward(model),
-        "satterthwaite" = se_satterthwaite(model),
+        kenward = se_kenward(model),
+        kr = se_kenward(model),
+        satterthwaite = se_satterthwaite(model),
         standard_error(model, component = component)
       )
     }

R/cluster_analysis.R

@@ -446,7 +446,7 @@ summary.cluster_analysis <- function(object, ...) {
 
 #' @export
 visualisation_recipe.cluster_analysis_summary <- function(x, ...) {
-  data <- datawizard::data_to_long(
+  data_long <- datawizard::data_to_long(
     x,
     select = names(x)[-1], # skip 'Cluster' column
     names_to = "Group",
@@ -459,13 +459,13 @@ visualisation_recipe.cluster_analysis_summary <- function(x, ...) {
 
   layers[["l1"]] <- list(
     geom = "bar",
-    data = data,
+    data = data_long,
     aes = list(x = "Cluster", y = "Center", fill = "Group"),
     position = "dodge"
   )
   layers[["l2"]] <- list(
     geom = "hline",
-    data = data,
+    data = data_long,
     aes = list(yintercept = 0),
     linetype = "dotted"
   )
@@ -479,7 +479,7 @@ visualisation_recipe.cluster_analysis_summary <- function(x, ...) {
 
   # Out
   class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers))
-  attr(layers, "data") <- data
+  attr(layers, "data") <- data_long
   layers
 }
 

R/cluster_meta.R

@@ -83,12 +83,12 @@ cluster_meta <- function(list_of_clusters, rownames = NULL, ...) {
   }
 
   # Convert to dataframe
-  data <- as.data.frame(x)
-  if (!is.null(names(solution))) row.names(data) <- names(solution)
-  if (!is.null(rownames)) row.names(data) <- rownames
+  cluster_data <- as.data.frame(x)
+  if (!is.null(names(solution))) row.names(cluster_data) <- names(solution)
+  if (!is.null(rownames)) row.names(cluster_data) <- rownames
 
   # Get probability matrix
-  m <- .cluster_meta_matrix(data)
+  m <- .cluster_meta_matrix(cluster_data)
   class(m) <- c("cluster_meta", class(m))
   m
 }
@@ -102,12 +102,10 @@ cluster_meta <- function(list_of_clusters, rownames = NULL, ...) {
   .get_prob <- function(x) {
     if (anyNA(x)) {
       NA
+    } else if (length(unique(x[!is.na(x)])) == 1) {
+      0
     } else {
-      if (length(unique(x[!is.na(x)])) == 1) {
-        0
-      } else {
-        1
-      }
+      1
     }
   }
 
@@ -120,8 +118,8 @@ cluster_meta <- function(list_of_clusters, rownames = NULL, ...) {
         m[row, col] <- 0
         next
       }
-      subset <- data[row.names(data) %in% c(row, col), ]
-      rez <- sapply(subset[2:ncol(subset)], .get_prob)
+      subset_rows <- data[row.names(data) %in% c(row, col), ]
+      rez <- sapply(subset_rows[2:ncol(subset_rows)], .get_prob)
       m[row, col] <- sum(rez, na.rm = TRUE) / length(stats::na.omit(rez))
     }
   }

R/compare_parameters.R

@@ -16,6 +16,11 @@
 #' @param ci_method Method for computing degrees of freedom for p-values
 #'   and confidence intervals (CI). See documentation for related model class
 #'   in [model_parameters()].
+#' @param coefficient_names Character vector with strings that should be used
+#'   as column headers for the coefficient column. Must be of same length as
+#'   number of models in `...`, or length 1. If length 1, this name will be
+#'   used for all coefficient columns. If `NULL`, the name for the coefficient
+#'   column will detected automatically (as in `model_parameters()`).
 #' @inheritParams model_parameters.default
 #' @inheritParams model_parameters.cpglmm
 #' @inheritParams print.parameters_model
@@ -75,6 +80,7 @@ compare_parameters <- function(...,
                                select = NULL,
                                column_names = NULL,
                                pretty_names = TRUE,
+                               coefficient_names = NULL,
                                keep = NULL,
                                drop = NULL,
                                verbose = TRUE) {
@@ -98,7 +104,7 @@ compare_parameters <- function(...,
       names(models) <- model_names
     }
   } else {
-    model_names <- match.call(expand.dots = FALSE)$`...`
+    model_names <- match.call(expand.dots = FALSE)[["..."]]
     if (length(names(model_names)) > 0) {
       model_names <- names(model_names)
     } else if (any(vapply(model_names, is.call, TRUE))) {
@@ -146,6 +152,11 @@ compare_parameters <- function(...,
     }
   }
 
+  # make sure we have enough coefficient names - else, repeat first value
+  if (!is.null(coefficient_names) && length(coefficient_names) < length(models)) {
+    coefficient_names <- rep(coefficient_names[1], length(models))
+  }
+
   # iterate all models and create list of model parameters
   m <- lapply(seq_along(models), function(i) {
     model <- models[[i]]
@@ -181,8 +192,10 @@ compare_parameters <- function(...,
 
     # set specific names for coefficient column
     coef_name <- attributes(dat)$coefficient_name
-    if (!is.null(coef_name)) {
+    if (!is.null(coef_name) && is.null(coefficient_names)) {
       colnames(dat)[colnames(dat) == "Coefficient"] <- coef_name
+    } else if (!is.null(coefficient_names)) {
+      colnames(dat)[colnames(dat) == "Coefficient"] <- coefficient_names[i]
     }
 
     # set pretty parameter names
@@ -233,7 +246,7 @@ compare_parameters <- function(...,
   all_models[model_cols] <- NULL
 
   # remove empty group-column
-  if (all(nchar(all_models$Group) == 0)) {
+  if (!any(nzchar(as.character(all_models$Group), keepNA = TRUE))) {
     all_models$Group <- NULL
   }
 
@@ -275,14 +288,14 @@ compare_models <- compare_parameters
       }
     } else {
       match_pretty_names <- att$pretty_names[x$Parameter]
-      if (!anyNA(match_pretty_names)) {
-        x$Parameter <- att$pretty_names[x$Parameter]
-      } else {
+      if (anyNA(match_pretty_names)) {
         match_pretty_names <- match(names(att$pretty_names), x$Parameter)
         match_pretty_names <- match_pretty_names[!is.na(match_pretty_names)]
         if (length(match_pretty_names)) {
           x$Parameter[match_pretty_names] <- att$pretty_names[x$Parameter[match_pretty_names]]
         }
+      } else {
+        x$Parameter <- att$pretty_names[x$Parameter]
       }
     }
   }