fix issue in print_html

easystats · Sep 29, 2023 · 7d86627 · 7d86627
1 parent e6b951a
commit 7d86627
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 7 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.2.3
+Version: 0.21.2.4
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NEWS.md b/NEWS.md
@@ -8,6 +8,10 @@
 * `print_md()` for `compare_parameters()` now gains more arguments, similar to
   the `print()` method.
 
+## Bug fixes
+
+* Fixed issue in `print_html()` for objects from package _ggeffects_.
+
 # parameters 0.21.2
 
 ## Changes

diff --git a/R/format.R b/R/format.R
@@ -556,6 +556,7 @@ format.parameters_sem <- function(x,
   footer_text <- attributes(x)$footer_text
   text_alternative <- attributes(x)$text_alternative
   n_obs <- attributes(x)$n_obs
+  is_ggeffects <- isTRUE(attributes(x)$is_ggeffects)
 
   # footer: model formula
   if (isTRUE(show_formula)) {
@@ -599,7 +600,7 @@ format.parameters_sem <- function(x,
 
   # footer: generic text
   if (!is.null(footer_text)) {
-    footer <- .add_footer_text(footer, footer_text, type)
+    footer <- .add_footer_text(footer, footer_text, type, is_ggeffects)
   }
 
   # add color code, if we have a footer
@@ -612,12 +613,18 @@ format.parameters_sem <- function(x,
     footer[1] <- substr(footer[1], 0, nchar(x) - 1)
   }
 
+  # finally, for ggeffects and HTML, remove *
+  if (is_ggeffects && type == "html") {
+    footer <- gsub("*", "", footer, fixed = TRUE)
+    footer <- gsub(":;", ":", footer, fixed = TRUE)
+  }
+
   footer
 }
 
 
 # footer: generic text
-.add_footer_text <- function(footer = NULL, text, type = "text") {
+.add_footer_text <- function(footer = NULL, text, type = "text", is_ggeffects = FALSE) {
   if (!is.null(text)) {
     if (type == "text" || type == "markdown") {
       if (is.null(footer)) {
@@ -627,7 +634,8 @@ format.parameters_sem <- function(x,
       }
       footer <- paste0(footer, sprintf("%s%s\n", fill, text))
     } else if (type == "html") {
-      footer <- c(footer, gsub("\n", "", text, fixed = TRUE))
+      replacement <- ifelse(is_ggeffects, ";", "")
+      footer <- c(footer, gsub("\n", replacement, text, fixed = TRUE))
     }
   }
   footer

diff --git a/R/print_html.R b/R/print_html.R
@@ -265,16 +265,18 @@ print_html.compare_parameters <- function(x,
     names(new_labels) <- colnames(out[["_data"]])
     out <- gt::cols_label(out, .list = new_labels)
   }
+  # find name of parameter column
+  pcol_name <- colnames(out[["_data"]])[1]
   # check where last parameter row ends. For "compare_models()", the
   # first Parameter value after data rows is "". If this is not found,
   # simply use number of rows as last row
-  last_row <- which(out[["_data"]]$Parameter == "")[1]
+  last_row <- which(out[["_data"]][[pcol_name]] == "")[1]
   if (is.na(last_row)) {
     last_row <- nrow(out[["_data"]])
   } else {
     last_row <- last_row - 1
   }
-  # add a border to the first column (Parameters)
+  # add a border to the first column.
   out <- gt::tab_style(
     out,
     style = gt::cell_borders(
@@ -283,7 +285,7 @@ print_html.compare_parameters <- function(x,
       color = "#d3d3d3"
     ),
     locations = gt::cells_body(
-      columns = "Parameter",
+      columns = pcol_name,
       rows = 1:last_row
     )
   )