Improve printing for special brms models, remove ggeffects-metods (#1078)

* Improve printing for special brms models, remove ggeffects-metods

* remove suggested

* fix

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.24.2.7
+Version: 0.24.2.8
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -133,7 +133,6 @@ Suggests:
     gamlss,
     gee,
     geepack,
-    ggeffects (>= 1.3.2),
     ggplot2,
     GLMMadaptive,
     glmmTMB (>= 1.1.10),

NAMESPACE

@@ -136,7 +136,6 @@ S3method(equivalence_test,MixMod)
 S3method(equivalence_test,feis)
 S3method(equivalence_test,felm)
 S3method(equivalence_test,gee)
-S3method(equivalence_test,ggeffects)
 S3method(equivalence_test,glm)
 S3method(equivalence_test,glmmTMB)
 S3method(equivalence_test,gls)
@@ -238,7 +237,6 @@ S3method(model_parameters,flic)
 S3method(model_parameters,gam)
 S3method(model_parameters,gamlss)
 S3method(model_parameters,gamm)
-S3method(model_parameters,ggeffects)
 S3method(model_parameters,glht)
 S3method(model_parameters,glimML)
 S3method(model_parameters,glm)

R/1_model_parameters.R

@@ -30,11 +30,12 @@
 #' - [Zero-inflated and hurdle][model_parameters.zcpglm()]: **cplm**, **mhurdle**,
 #'   **pscl**, ...
 #' - [Other models][model_parameters.glimML()]: **aod**, **bbmle**, **betareg**,
-#'   **emmeans**, **epiR**, **ggeffects**, **glmx**, **ivfixed**, **ivprobit**,
-#'   **JRM**, **lmodel2**, **logitsf**, **marginaleffects**, **margins**, **maxLik**,
+#'   **emmeans**, **epiR**, **glmx**, **ivfixed**, **ivprobit**, **JRM**,
+#'   **lmodel2**, **logitsf**, **marginaleffects**, **margins**, **maxLik**,
 #'   **mediation**, **mfx**, **multcomp**, **mvord**, **plm**, **PMCMRplus**,
 #'   **quantreg**, **selection**, **systemfit**, **tidymodels**, **varEST**,
-#'   **WRS2**, `bfsl`, `deltaMethod`, `fitdistr`, `mjoint`, `mle`, `model.avg`, ...
+#'   **WRS2**, `bfsl`, `deltaMethod`, `fitdistr`, `mjoint`, `mle`, `model.avg`,
+#'   ...
 #'
 #' A full overview can be found here:
 #' https://easystats.github.io/parameters/reference/

R/equivalence_test.R

@@ -14,9 +14,6 @@ bayestestR::equivalence_test
 #' @param ci Confidence Interval (CI) level. Default to `0.95` (`95%`).
 #' @param rule Character, indicating the rules when testing for practical
 #' equivalence. Can be `"bayes"`, `"classic"` or `"cet"`. See 'Details'.
-#' @param test Hypothesis test for computing contrasts or pairwise comparisons.
-#' See [`?ggeffects::test_predictions`](https://strengejacke.github.io/ggeffects/reference/test_predictions.html)
-#' for details.
 #' @param verbose Toggle warnings and messages.
 #' @param ... Arguments passed to or from other methods.
 #' @inheritParams model_parameters.glmmTMB
@@ -405,85 +402,6 @@ equivalence_test.parameters_model <- function(x,
 }
 
 
-#' @rdname equivalence_test.lm
-#' @export
-equivalence_test.ggeffects <- function(x,
-                                       range = "default",
-                                       rule = "classic",
-                                       test = "pairwise",
-                                       verbose = TRUE,
-                                       ...) {
-  insight::check_if_installed("ggeffects")
-
-  # get attributes from ggeffects objects, so we have the original model and terms
-  focal <- attributes(x)$original.terms
-  obj_name <- attributes(x)$model.name
-  ci <- attributes(x)$ci.lvl
-  dof <- attributes(x)$df
-
-  x <- .get_ggeffects_model(x)
-
-  # validation check rope range
-  rule <- match.arg(tolower(rule), choices = c("bayes", "classic", "cet"))
-  range <- .check_rope_range(x, range, verbose)
-
-  out <- ggeffects::test_predictions(
-    x,
-    terms = focal,
-    test = test,
-    equivalence = range,
-    verbose = verbose,
-    ...
-  )
-
-  out <- insight::standardize_names(out)
-
-  # we only have one type of CIs
-  conf_int <- conf_int2 <- as.data.frame(t(out[c("CI_low", "CI_high")]))
-
-  l <- Map(
-    function(ci_wide, ci_narrow) {
-      .equivalence_test_numeric(
-        ci = ci,
-        ci_wide,
-        ci_narrow,
-        range_rope = range,
-        rule = rule,
-        dof = dof,
-        verbose = verbose
-      )
-    }, conf_int, conf_int2
-  )
-
-  # bind to data frame
-  dat <- do.call(rbind, l)
-
-  # remove old CIs, bind results from equivalence test
-  out$CI_low <- out$CI_high <- NULL
-  out$CI <- ci
-  out <- cbind(out, dat)
-
-  # standardize column order
-  cols <- c(
-    "Estimate", "Contrast", "Slope", "Predicted", "CI", "CI_low", "CI_high",
-    "SGPV", "ROPE_low", "ROPE_high", "ROPE_Percentage", "ROPE_Equivalence", "p"
-  )
-
-  # order of shared columns
-  shared_order <- intersect(cols, colnames(out))
-  parameter_columns <- setdiff(colnames(out), shared_order)
-  # add remaining columns, sort
-  out <- out[c(parameter_columns, shared_order)]
-
-  attr(out, "object_name") <- obj_name
-  attr(out, "parameter_columns") <- parameter_columns
-  attr(out, "rule") <- rule
-  attr(out, "rope") <- range
-  class(out) <- c("equivalence_test_lm", "see_equivalence_test_ggeffects", "data.frame")
-  out
-}
-
-
 # helper -------------------
 
 

R/format.R

@@ -561,7 +561,6 @@ 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)) {
@@ -611,26 +610,20 @@ format.parameters_sem <- function(x,
 
   # footer: generic text
   if (!is.null(footer_text)) {
-    footer <- .add_footer_text(footer, footer_text, type, is_ggeffects)
+    footer <- .add_footer_text(footer, footer_text, type)
   }
 
   # if we have two trailing newlines, remove one
   if (identical(type, "text") && !is.null(footer) && endsWith(footer[1], "\n\n")) {
     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 = NULL, type = "text", is_ggeffects = FALSE) {
+.add_footer_text <- function(footer = NULL, text = NULL, type = "text") {
   if (!is.null(text) && length(text)) {
     if (type == "text" || type == "markdown") {
       if (is.null(footer)) {
@@ -640,8 +633,7 @@ format.parameters_sem <- function(x,
       }
       footer <- paste0(footer, sprintf("%s%s\n", fill, text))
     } else if (type == "html") {
-      replacement <- ifelse(is_ggeffects, ";", "")
-      footer <- c(footer, gsub("\n", replacement, text, fixed = TRUE))
+      footer <- c(footer, gsub("\n", "", text, fixed = TRUE))
     }
   }
   footer

R/group_level_total.R

@@ -137,7 +137,7 @@
   )
 
   # select parameters to keep. We want all intercepts, and all random slopes
-  components <- insight::find_auxiliary(x)
+  components <- .safe(insight::find_auxiliary(x))
   # standard components
   parameters_to_keep <- params$Parameter %in% c("Intercept", random_slopes$random)
   parameters_to_keep <- parameters_to_keep |

R/methods_ggeffects.R

@@ -486,11 +486,7 @@ print.parameters_random <- function(x, digits = 2, ...) {
 
   # caption = NULL, set default for HTML tables
   if (identical(format, "html") && is.null(caption)) {
-    if (isTRUE(attributes(x)$is_ggeffects)) {
-      table_caption <- title_attribute
-    } else {
-      table_caption <- "Model Summary"
-    }
+    table_caption <- "Model Summary"
   } else if (isTRUE(attributes(x)$ordinal_model)) {
     table_caption <- ""