print(include_reference = TRUE) doesn't work with pipes

DESCRIPTION

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

NEWS.md

@@ -14,6 +14,11 @@
 * `n_factors()` now also returns the explained variance for the number of
   factors as attributes.
 
+## Bug fixes
+
+* `print(include_reference = TRUE)` for `model_parameters()` did not work when
+  run inside a pipe-chain.
+
 # parameters 0.21.3
 
 ## Changes

R/methods_ggeffects.R

@@ -1,10 +1,10 @@
 #' @export
 model_parameters.ggeffects <- function(model, keep = NULL, drop = NULL, verbose = TRUE, ...) {
   ci <- attributes(model)$ci.lvl
-  terms <- attributes(model)$terms[-1]
+  co_terms <- attributes(model)$terms[-1]
   focal_term <- attributes(model)$terms[1]
   constant_values <- attributes(model)$constant.values
-  title <- attr(model, "title")
+  caption <- attr(model, "title")
 
   # exception for survival
   if (attributes(model)$type %in% c("surv", "survival", "cumhaz", "cumulative_hazard")) {
@@ -33,14 +33,14 @@ model_parameters.ggeffects <- function(model, keep = NULL, drop = NULL, verbose
     colnames(model)[1] <- focal_term
   }
 
-  if (length(terms) >= 1) {
-    model$Component <- paste0(terms[1], " = ", model$Component)
+  if (length(co_terms) >= 1) {
+    model$Component <- paste0(co_terms[1], " = ", model$Component)
   }
-  if (length(terms) >= 2) {
-    model$Group <- paste0(terms[2], " = ", model$Group)
+  if (length(co_terms) >= 2) {
+    model$Group <- paste0(co_terms[2], " = ", model$Group)
   }
-  if (length(terms) >= 3) {
-    model$Subgroup <- paste0(terms[3], " = ", model$Subgroup)
+  if (length(co_terms) >= 3) {
+    model$Subgroup <- paste0(co_terms[3], " = ", model$Subgroup)
   }
 
   # filter parameters
@@ -57,7 +57,7 @@ model_parameters.ggeffects <- function(model, keep = NULL, drop = NULL, verbose
   # special attributes
   attr(model, "is_ggeffects") <- TRUE
   attr(model, "footer_text") <- .generate_ggeffects_footer(constant_values)
-  attr(model, "title") <- c(title, "blue")
+  attr(model, "title") <- c(caption, "blue")
 
   attr(model, "object_name") <- insight::safe_deparse_symbol(substitute(model))
   class(model) <- c("parameters_model", "data.frame")
@@ -81,16 +81,16 @@ model_parameters.ggeffects <- function(model, keep = NULL, drop = NULL, verbose
 
     # ignore this string when determining maximum length
     poplev <- which(cv %in% c("NA (population-level)", "0 (population-level)"))
-    if (!insight::is_empty_object(poplev)) {
-      mcv <- cv[-poplev]
-    } else {
+    if (insight::is_empty_object(poplev)) {
       mcv <- cv
+    } else {
+      mcv <- cv[-poplev]
     }
 
-    if (!insight::is_empty_object(mcv)) {
-      cv.space2 <- max(nchar(mcv))
-    } else {
+    if (insight::is_empty_object(mcv)) {
       cv.space2 <- 0
+    } else {
+      cv.space2 <- max(nchar(mcv))
     }
 
     adjusted_predictors <- paste0(sprintf("* %*s = %*s", cv.space, cv.names, cv.space2, cv), collapse = "\n")

R/utils.R

@@ -91,6 +91,10 @@
     if (is.null(model) || inherits(model, "parameters_model")) {
       model <- .safe(get(obj_name, envir = globalenv()))
     }
+    # prevent self reference
+    if (is.null(model) || inherits(model, "parameters_model")) {
+      model <- .safe(.dynGet(obj_name))
+    }
   }
   model
 }

R/utils_format.R

@@ -40,7 +40,7 @@
   # add modelname to column names; for single column layout per model, we just
   # need the column name. If the layout contains more than one column per model,
   # add modelname in parenthesis.
-  if (!is.null(modelname) && nchar(modelname) > 0) {
+  if (!is.null(modelname) && nzchar(modelname, keepNA = TRUE)) {
     if (ncol(out) > 1) {
       colnames(out) <- paste0(colnames(out), " (", modelname, ")")
     } else {
@@ -135,7 +135,7 @@
   # align columns width for text format
   .align_values <- function(i) {
     if (!is.null(i)) {
-      non_empty <- !is.na(i) & nchar(i) > 0
+      non_empty <- !is.na(i) & nzchar(i, keepNA = TRUE)
       i[non_empty] <- format(insight::trim_ws(i[non_empty]), justify = "right")
     }
     i
@@ -157,44 +157,44 @@
     x$ROPE_Percentage <- .align_values(x$ROPE_Percentage)
   }
   # create new string
-  row <- rep(style, times = nrow(x))
-  for (r in seq_along(row)) {
-    row[r] <- gsub("{estimate}", x[[coef_column]][r], row[r], fixed = TRUE)
+  table_row <- rep(style, times = nrow(x))
+  for (r in seq_along(table_row)) {
+    table_row[r] <- gsub("{estimate}", x[[coef_column]][r], table_row[r], fixed = TRUE)
     if (!is.null(ci_low) && !is.null(ci_high)) {
-      row[r] <- gsub("{ci_low}", ci_low[r], row[r], fixed = TRUE)
-      row[r] <- gsub("{ci_high}", ci_high[r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{ci_low}", ci_low[r], table_row[r], fixed = TRUE)
+      table_row[r] <- gsub("{ci_high}", ci_high[r], table_row[r], fixed = TRUE)
     }
     if ("SE" %in% colnames(x)) {
-      row[r] <- gsub("{se}", x[["SE"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{se}", x[["SE"]][r], table_row[r], fixed = TRUE)
     }
     if ("p" %in% colnames(x)) {
-      row[r] <- gsub("{p}", x[["p"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{p}", x[["p"]][r], table_row[r], fixed = TRUE)
     }
     if ("p_stars" %in% colnames(x)) {
-      row[r] <- gsub("{stars}", x[["p_stars"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{stars}", x[["p_stars"]][r], table_row[r], fixed = TRUE)
     }
     if ("pd" %in% colnames(x)) {
-      row[r] <- gsub("{pd}", x[["pd"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{pd}", x[["pd"]][r], table_row[r], fixed = TRUE)
     }
     if ("Rhat" %in% colnames(x)) {
-      row[r] <- gsub("{rhat}", x[["Rhat"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{rhat}", x[["Rhat"]][r], table_row[r], fixed = TRUE)
     }
     if ("ESS" %in% colnames(x)) {
-      row[r] <- gsub("{ess}", x[["ESS"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{ess}", x[["ESS"]][r], table_row[r], fixed = TRUE)
     }
     if ("ROPE_Percentage" %in% colnames(x)) {
-      row[r] <- gsub("{rope}", x[["ROPE_Percentage"]][r], row[r], fixed = TRUE)
+      table_row[r] <- gsub("{rope}", x[["ROPE_Percentage"]][r], table_row[r], fixed = TRUE)
     }
   }
   # some cleaning: columns w/o coefficient are empty
-  row[x[[coef_column]] == "" | is.na(x[[coef_column]])] <- ""
+  table_row[x[[coef_column]] == "" | is.na(x[[coef_column]])] <- "" # nolint
   # fix some p-value stuff, e.g. if pattern is "p={p]}",
   # we may have "p= <0.001", which we want to be "p<0.001"
-  row <- gsub("=<", "<", row, fixed = TRUE)
-  row <- gsub("= <", "<", row, fixed = TRUE)
-  row <- gsub("= ", "=", row, fixed = TRUE)
+  table_row <- gsub("=<", "<", table_row, fixed = TRUE)
+  table_row <- gsub("= <", "<", table_row, fixed = TRUE)
+  table_row <- gsub("= ", "=", table_row, fixed = TRUE)
   # final output
-  x <- data.frame(row)
+  x <- data.frame(table_row)
   colnames(x) <- column_names
   x
 }
@@ -332,11 +332,14 @@
   # check if we have a model object, else return parameter table
   model <- .get_object(params)
   if (is.null(model)) {
-    params
+    # get data from model call
+    model_data <- .safe(eval(attributes(params)$model_call$data))
+  } else {
+    # get data from model object
+    model_data <- insight::get_data(model, verbose = FALSE)
   }
 
   # check if we have model data, else return parameter table
-  model_data <- insight::get_data(model, verbose = FALSE)
   if (is.null(model_data)) {
     params
   }
@@ -477,7 +480,7 @@
                                            is_zero_inflated,
                                            is_ordinal_model,
                                            is_multivariate = FALSE,
                                            ran_pars,
                                            formatted_table = NULL) {
   # prepare component names
   .conditional_fixed_text <- if (is_zero_inflated) {
@@ -557,7 +560,7 @@
 
   if (grepl("^conditional\\.(r|R)andom_variances", component_name)) {
     component_name <- insight::trim_ws(gsub("^conditional\\.(r|R)andom_variances(\\.)*", "", component_name))
     if (nchar(component_name) == 0) {
       component_name <- "Random Effects Variances"
     } else {
       component_name <- paste0("Random Effects Variances: ", component_name)
@@ -565,7 +568,7 @@
   }
   if (grepl("^conditional\\.(r|R)andom", component_name)) {
     component_name <- insight::trim_ws(gsub("^conditional\\.(r|R)andom(\\.)*", "", component_name))
     if (nchar(component_name) == 0) {
       component_name <- ifelse(ran_pars, "Random Effects Variances", "Random Effects (Count Model)")
     } else {
       component_name <- paste0("Random Effects (Count Model): ", component_name)
@@ -573,7 +576,7 @@
   }
   if (grepl("^zero_inflated\\.(r|R)andom", component_name)) {
     component_name <- insight::trim_ws(gsub("^zero_inflated\\.(r|R)andom(\\.)*", "", component_name))
     if (nchar(component_name) == 0) {
       component_name <- "Random Effects (Zero-Inflation Component)"
     } else {
       component_name <- paste0("Random Effects (Zero-Inflation Component): ", component_name)
@@ -828,7 +831,7 @@
   if ("Subgroup" %in% names(x) && insight::n_unique(x$Subgroup) > 1) {
     split_by <- c(split_by, "Subgroup")
   }
   split_by <- split_by[nchar(split_by) > 0]
   split_by
 }
 
@@ -901,7 +904,7 @@
 
   # fix column output
   if (inherits(attributes(x)$model, c("lavaan", "blavaan")) && "Label" %in% colnames(x)) {
     x$From <- ifelse(x$Label == "" | x$Label == x$To, x$From, paste0(x$From, " (", x$Label, ")"))
     x$Label <- NULL
   }
 
@@ -994,8 +997,8 @@
 
     # Don't print if empty col
     tables[[type]][vapply(colnames(tables[[type]]), function(x) {
       col <- tables[[type]][[x]]
       (all(col == "") | all(is.na(col))) && !grepl("_CI_(high|low)$", x)
     }, logical(1))] <- NULL
 
     attr(tables[[type]], "digits") <- digits
@@ -1019,7 +1022,7 @@
     # rename columns for zero-inflation part
     if (startsWith(type, "zero") && !is.null(zi_coef_name) && !is.null(coef_column)) {
       colnames(tables[[type]])[which(colnames(tables[[type]]) == coef_column)] <- zi_coef_name
       colnames(tables[[type]])[which(colnames(tables[[type]]) == paste0("Std_", coef_column))] <- paste0("Std_", zi_coef_name)
     }
 
     # rename columns for correlation, location or scale part
@@ -1099,7 +1102,7 @@
       }
       # replace brackets by parenthesis
       if (!is.null(parameter_column) && parameter_column %in% colnames(formatted_table)) {
         formatted_table[[parameter_column]] <- gsub("[", ci_brackets[1], formatted_table[[parameter_column]], fixed = TRUE)
         formatted_table[[parameter_column]] <- gsub("]", ci_brackets[2], formatted_table[[parameter_column]], fixed = TRUE)
       }
     }

R/utils_model_parameters.R

@@ -61,6 +61,9 @@
   # add parameters with value and variable
   attr(params, "pretty_labels") <- .format_value_labels(params, model)
 
+  # save model call
+  attr(params, "model_call") <- .safe(insight::get_call(model))
+
   # use tryCatch, these might fail...
   attr(params, "test_statistic") <- .safe(insight::find_statistic(model))
   attr(params, "log_response") <- .safe(isTRUE(grepl("log", insight::find_transformation(model), fixed = TRUE)))

tests/testthat/test-pipe.R

@@ -0,0 +1,15 @@
+skip_on_cran()
+skip_if(getRversion() < "4.2.0")
+
+test_that("print in pipe", {
+  data(iris)
+  out <- capture.output(
+    lm(Sepal.Length ~ Petal.Length + Species, data = iris) |>
+      model_parameters() |>
+      print(include_reference = TRUE)
+  )
+  expect_identical(
+    out[5],
+    "Species [setosa]     |        0.00 |      |                |        |       "
+  )
+})