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

* `print(include_reference = TRUE)` doesn't work with pipes
Fixes #923

* style

* lintr

* desc

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
   }

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 |      |                |        |       "
+  )
+})