Merge branch 'main' into strengejacke/issue1169

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.28.2
+Version: 0.28.2.3
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -231,3 +231,4 @@ Config/testthat/parallel: true
 Config/Needs/website: easystats/easystatstemplate
 Config/Needs/check: stan-dev/cmdstanr
 Config/rcmdcheck/ignore-inconsequential-notes: true
+Remotes: easystats/insight, easystats/modelbased

NAMESPACE

@@ -34,6 +34,9 @@ S3method(ci,crq)
 S3method(ci,default)
 S3method(ci,deltaMethod)
 S3method(ci,effectsize_table)
+S3method(ci,estimate_contrasts)
+S3method(ci,estimate_means)
+S3method(ci,estimate_slopes)
 S3method(ci,fixest_multi)
 S3method(ci,flac)
 S3method(ci,flic)
@@ -137,6 +140,9 @@ S3method(display,parameters_simulate)
 S3method(display,parameters_standardized)
 S3method(dof_satterthwaite,lmerMod)
 S3method(equivalence_test,MixMod)
+S3method(equivalence_test,estimate_contrasts)
+S3method(equivalence_test,estimate_means)
+S3method(equivalence_test,estimate_slopes)
 S3method(equivalence_test,feis)
 S3method(equivalence_test,felm)
 S3method(equivalence_test,gee)
@@ -239,6 +245,9 @@ S3method(model_parameters,emm_list)
 S3method(model_parameters,epi.2by2)
 S3method(model_parameters,externVar)
 S3method(model_parameters,externX)
+S3method(model_parameters,estimate_contrasts)
+S3method(model_parameters,estimate_means)
+S3method(model_parameters,estimate_slopes)
 S3method(model_parameters,fa)
 S3method(model_parameters,fa.ci)
 S3method(model_parameters,feglm)
@@ -796,6 +805,9 @@ S3method(standard_error,emmGrid)
 S3method(standard_error,emm_list)
 S3method(standard_error,externVar)
 S3method(standard_error,externX)
+S3method(standard_error,estimate_contrasts)
+S3method(standard_error,estimate_means)
+S3method(standard_error,estimate_slopes)
 S3method(standard_error,factor)
 S3method(standard_error,feglm)
 S3method(standard_error,fitdistr)

NEWS.md

@@ -1,3 +1,7 @@
+# parameters 0.28.2.1
+
+* `equivalence_test()` gets methods for objects from the *modelbased* package.
+
 # parameters 0.28.2
 
 ## Bug fixes

R/equivalence_test.R

@@ -355,6 +355,98 @@ equivalence_test.glmmTMB <- equivalence_test.merMod
 equivalence_test.MixMod <- equivalence_test.merMod
 
 
+# modelbased ------------------------------
+
+#' @export
+equivalence_test.estimate_means <- function(
+  x,
+  range = "default",
+  ci = 0.95,
+  rule = "classic",
+  vcov = NULL,
+  vcov_args = NULL,
+  verbose = TRUE,
+  ...
+) {
+  # ==== define rope range ====
+
+  range <- .check_rope_range(x, range, verbose)
+
+  if (length(ci) > 1) {
+    insight::format_alert("`ci` may only be of length 1. Using first ci-value now.")
+    ci <- ci[1]
+  }
+
+  # ==== check degrees of freedom ====
+
+  dof <- unique(insight::get_df(x))
+  if (length(dof) > 1) {
+    dof <- Inf
+  }
+
+  # ==== requested confidence intervals ====
+
+  conf_int <- as.data.frame(t(x[c("CI_low", "CI_high")]))
+
+  # ==== the "narrower" intervals (1-2*alpha) for CET-rules. ====
+
+  alpha <- 1 - ci
+  insight::check_if_installed("modelbased")
+
+  # we need to call the modelbased function again, so get the call
+  # modify CI and evaluate that call
+  cl <- insight::get_call(x)
+  cl$ci <- ci - alpha
+  x2 <- eval(cl)
+  conf_int2 <- as.data.frame(t(x2[c("CI_low", "CI_high")]))
+
+  # ==== equivalence test for each parameter ====
+
+  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
+  )
+
+  dat <- do.call(rbind, l)
+  params <- insight::get_parameters(x)
+
+  out <- data.frame(
+    Parameter = params$Parameter,
+    CI = ifelse(rule == "bayes", ci, ci - alpha),
+    dat,
+    stringsAsFactors = FALSE
+  )
+
+  # ==== (adjusted) p-values for tests ====
+
+  out$p <- .add_p_to_equitest(x, ci, range, vcov = vcov, vcov_args = vcov_args, ...)
+
+  attr(out, "rope") <- range
+  attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(x))
+  attr(out, "rule") <- rule
+  class(out) <- c("equivalence_test_lm", "see_equivalence_test_lm", class(out))
+
+  out
+}
+
+#' @export
+equivalence_test.estimate_contrasts <- equivalence_test.estimate_means
+
+#' @export
+equivalence_test.estimate_slopes <- equivalence_test.estimate_means
+
+
 # Special classes -------------------------
 
 #' @export
@@ -407,6 +499,14 @@ equivalence_test.parameters_model <- function(x,
 
 #' @keywords internal
 .check_rope_range <- function(x, range, verbose) {
+  # for modelbased-objects, we extract the model to define the rope range
+  if (inherits(x, c("estimate_means", "estimate_contrasts", "estimate_slopes"))) {
+    x <- .safe(insight::get_model(x))
+    # if not successful, return defaults
+    if (is.null(x)) {
+      return(c(-1, 1))
+    }
+  }
   if (all(range == "default")) {
     range <- bayestestR::rope_range(x, verbose = verbose)
     if (is.list(range)) {
@@ -439,7 +539,6 @@ equivalence_test.parameters_model <- function(x,
     ci <- ci[1]
   }
 
-
   # ==== check degrees of freedom ====
 
   df_column <- grep("(df|df_error)", colnames(x))

R/methods_modelbased.R

@@ -0,0 +1,56 @@
+# model_parameters ----------------
+
+#' @export
+model_parameters.estimate_means <- function(model, ...) {
+  out <- model
+  class(out) <- c("parameters_model", "see_parameters_model", class(out))
+  out
+}
+
+#' @export
+model_parameters.estimate_slopes <- model_parameters.estimate_means
+
+#' @export
+model_parameters.estimate_contrasts <- model_parameters.estimate_means
+
+
+# standard_error ----------------
+
+#' @export
+standard_error.estimate_means <- function(model, ...) {
+  params <- insight::get_parameters(model)
+  data.frame(Parameter = params$Parameter, SE = model$SE, stringsAsFactors = FALSE)
+}
+
+#' @export
+standard_error.estimate_slopes <- standard_error.estimate_means
+
+#' @export
+standard_error.estimate_contrasts <- standard_error.estimate_means
+
+
+# ci ----------------
+
+#' @export
+ci.estimate_means <- function(x, ...) {
+  params <- insight::get_parameters(x)
+
+  ci_value <- attributes(x)$ci
+  if (is.null(ci_value)) {
+    ci_value <- 0.95
+  }
+
+  data.frame(
+    Parameter = params$Parameter,
+    CI = ci_value,
+    CI_low = x$CI_low,
+    CI_high = x$CI_high,
+    stringsAsFactors = FALSE
+  )
+}
+
+#' @export
+ci.estimate_slopes <- ci.estimate_means
+
+#' @export
+ci.estimate_contrasts <- ci.estimate_means

R/n_clusters_easystats.R

@@ -246,20 +246,34 @@ n_clusters_hclust <- function(x,
 
 # Utils -------------------------------------------------------------------
 
-
 #' @keywords internal
-.n_clusters_factoextra <- function(x,
-                                   method = "wss",
-                                   standardize = TRUE,
-                                   include_factors = FALSE,
-                                   clustering_function = stats::kmeans,
-                                   n_max = 10,
-                                   ...) {
-  x <- .prepare_data_clustering(x, include_factors = include_factors, standardize = standardize, ...)
+.n_clusters_factoextra <- function(
+  x,
+  method = "wss",
+  standardize = TRUE,
+  include_factors = FALSE,
+  clustering_function = stats::kmeans,
+  n_max = 10,
+  ...
+) {
+  x <- .prepare_data_clustering(
+    x,
+    include_factors = include_factors,
+    standardize = standardize,
+    ...
+  )
 
   insight::check_if_installed("factoextra")
 
-  factoextra::fviz_nbclust(x, clustering_function, method = method, k.max = n_max, verbose = FALSE)$data
+  suppressWarnings(
+    factoextra::fviz_nbclust(
+      x,
+      clustering_function,
+      method = method,
+      k.max = n_max,
+      verbose = FALSE
+    )$data
+  )
 }
 
 

inst/WORDLIST

@@ -319,6 +319,7 @@ mgcv
 mhurdle
 mlogit
 mmrm
+modelbased
 modelsummary
 multcomp
 multicollinearity