Fix std bayes error

R/extract_parameters.R

@@ -1,7 +1,7 @@
 # generic function ------------------------------------------------------
 
 #' @keywords internal
 .extract_parameters_generic <- function(
   model,
   ci,
   component,
@@ -48,6 +48,7 @@
     fun_args[["robust"]] <- NULL
     fun <- datawizard::standardize
     model <- do.call(fun, fun_args)
+    standardize <- NULL
   }
 
   parameters <- insight::get_parameters(
@@ -290,7 +291,7 @@
 
   # ==== Std Coefficients for other methods than "refit"
 
-  if (!is.null(standardize) && !isTRUE(standardize == "refit")) {
+  if (!is.null(standardize)) {
     # give minimal attributes required for standardization
     temp_pars <- parameters
     class(temp_pars) <- c("parameters_model", class(temp_pars))
@@ -775,16 +776,75 @@
   verbose = TRUE,
   ...
 ) {
+  if (
+    isTRUE(test == "all") && (!is.null(standardize) || insight::is_multivariate(model))
+  ) {
+    exception_type <- ifelse(
+      is.null(standardize),
+      "for multivariate models",
+      "when standardizing"
+    )
+    insight::format_error(
+      sprintf("`test = \"all\"` is not supported %s;", exception_type),
+      "Please specify the tests you want to perform using the `test` argument."
+    )
+  }
+
+  # No scale-dependent inferential statistics
+  if (
+    !is.null(standardize) &&
+      any(
+        c(
+          "bf",
+          "bayesfactor",
+          "bayes_factor",
+          "rope",
+          "p_rope",
+          "equivalence_test",
+          "equitest"
+        ) %in%
+          test
+      )
+  ) {
+    test <- setdiff(
+      test,
+      c(
+        "bf",
+        "bayesfactor",
+        "bayes_factor",
+        "rope",
+        "p_rope",
+        "equivalence_test",
+        "equitest"
+      )
+    )
+    if (verbose) {
+      insight::format_warning(
+        "Scale-dependent inferential statistics (such as `rope` and `bayes_factor`) are not meaningful for standardized parameters",
+        "These have been removed from the output."
+      )
+    }
+  }
+
   # no ROPE for multi-response models
   if (insight::is_multivariate(model) && any(c("rope", "p_rope") %in% test)) {
     test <- setdiff(test, c("rope", "p_rope"))
     if (verbose) {
-      insight::format_alert(
+      insight::format_warning(
         "Multivariate response models are not yet supported for tests `rope` and `p_rope`."
       )
     }
   }
 
+  if (length(test) == 0) {
+    test <- NULL
+  }
+
+  if (isTRUE(standardize == "refit")) {
+    model <- datawizard::standardize(model, verbose = verbose)
+    standardize <- NULL
+  }
+
   # MCMCglmm need special handling
   if (inherits(model, "MCMCglmm")) {
     parameters <- bayestestR::describe_posterior(
@@ -816,36 +876,24 @@
       verbose = verbose,
       ...
     )
+  }
 
-    if (!is.null(standardize)) {
-      # Don't test BF on standardized params
-      test_no_BF <- test[!test %in% c("bf", "bayesfactor", "bayes_factor")]
-      if (length(test_no_BF) == 0) {
-        test_no_BF <- NULL
-      }
-      std_post <- standardize_posteriors(model, method = standardize)
-      std_parameters <- bayestestR::describe_posterior(
-        std_post,
-        centrality = centrality,
-        dispersion = dispersion,
-        ci = ci,
-        ci_method = ci_method,
-        test = test_no_BF,
-        rope_range = rope_range,
-        rope_ci = rope_ci,
-        verbose = verbose,
-        ...
-      )
+  if (!is.null(standardize)) {
+    # give minimal attributes required for standardization
+    temp_pars <- parameters
+    class(temp_pars) <- c("parameters_model", class(temp_pars))
+    attr(temp_pars, "ci") <- ci
+    attr(temp_pars, "object_name") <- model # pass the model as is (this is a cheat - teehee!)
 
-      parameters <- merge(
-        std_parameters,
-        parameters[c(
-          "Parameter",
-          setdiff(colnames(parameters), colnames(std_parameters))
-        )],
-        sort = FALSE
-      )
-    }
+    std_parameters <- standardize_parameters(temp_pars, method = standardize)
+
+    parameters <- merge(
+      std_parameters,
+      parameters[c("Parameter", setdiff(colnames(parameters), colnames(std_parameters)))],
+      sort = FALSE
+    )
+
+    parameters <- .NA_inferential_cols(parameters)
   }
 
   if (length(ci) > 1) {
@@ -1057,11 +1105,15 @@
 .NA_inferential_cols <- function(pr) {
   # For models where the response is NOT standardized, the (Intercept) is set
   # to NA and so we also need to set all inferential statistics to NA
-  rows_to_NA <- pr$Parameter %in% "(Intercept)" | is.na(pr$Std_Coefficient)
+  coef_name <- colnames(pr)[startsWith(colnames(pr), "Std_")]
+  if (length(coef_name) != 1L) {
+    insight::format_error("Wrong number of standardized coefficient columns detected.")
+  }
+  rows_to_NA <- pr$Parameter == "(Intercept)" | is.na(pr[[coef_name]])
   if (any(rows_to_NA)) {
     # fmt: skip
     cols_not_to_NA <- c(".id", "Parameter", "Component", "Response", "Effects", "Group",
-                        "CI", "Std_Coefficient")
+                        "CI", coef_name)
     cols_to_NA <- setdiff(colnames(pr), cols_not_to_NA)
     pr[rows_to_NA, cols_to_NA] <- NA
   }

R/methods_coxme.R

@@ -1,24 +1,26 @@
 #' @export
-model_parameters.coxme <- function(model,
-                                   ci = 0.95,
-                                   ci_method = NULL,
-                                   ci_random = NULL,
-                                   bootstrap = FALSE,
-                                   iterations = 1000,
-                                   standardize = NULL,
-                                   effects = "all",
-                                   group_level = FALSE,
-                                   exponentiate = FALSE,
-                                   p_adjust = NULL,
-                                   vcov = NULL,
-                                   vcov_args = NULL,
-                                   wb_component = FALSE,
-                                   include_info = getOption("parameters_mixed_info", FALSE),
-                                   include_sigma = FALSE,
-                                   keep = NULL,
-                                   drop = NULL,
-                                   verbose = TRUE,
-                                   ...) {
+model_parameters.coxme <- function(
+  model,
+  ci = 0.95,
+  ci_method = NULL,
+  ci_random = NULL,
+  bootstrap = FALSE,
+  iterations = 1000,
+  standardize = NULL,
+  effects = "all",
+  group_level = FALSE,
+  exponentiate = FALSE,
+  p_adjust = NULL,
+  vcov = NULL,
+  vcov_args = NULL,
+  wb_component = FALSE,
+  include_info = getOption("parameters_mixed_info", FALSE),
+  include_sigma = FALSE,
+  keep = NULL,
+  drop = NULL,
+  verbose = TRUE,
+  ...
+) {
   insight::check_if_installed("lme4")
   dots <- list(...)
 
@@ -27,7 +29,8 @@ model_parameters.coxme <- function(model,
     if (isTRUE(bootstrap)) {
       ci_method <- "quantile"
     } else {
-      ci_method <- switch(insight::find_statistic(model),
+      ci_method <- switch(
+        insight::find_statistic(model),
         `t-statistic` = "residual",
         "wald"
       )
@@ -46,8 +49,17 @@ model_parameters.coxme <- function(model,
     ci_method <- insight::validate_argument(
       ci_method,
       c(
-        "wald", "normal", "residual", "ml1", "betwithin", "satterthwaite",
-        "kenward", "kr", "boot", "profile", "uniroot"
+        "wald",
+        "normal",
+        "residual",
+        "ml1",
+        "betwithin",
+        "satterthwaite",
+        "kenward",
+        "kr",
+        "boot",
+        "profile",
+        "uniroot"
       )
     )
   }
@@ -88,7 +100,7 @@ model_parameters.coxme <- function(model,
 
   # for refit, we completely refit the model, than extract parameters,
   # ci etc. as usual - therefor, we set "standardize" to NULL
-  if (!is.null(standardize) && standardize == "refit") {
+  if (isTRUE(standardize == "refit")) {
     model <- datawizard::standardize(model, verbose = FALSE)
     standardize <- NULL
   }
@@ -99,16 +111,13 @@ model_parameters.coxme <- function(model,
   if (effects %in% c("fixed", "all")) {
     # Processing
     if (bootstrap) {
-      params <- bootstrap_parameters(
-        model,
-        iterations = iterations,
-        ci = ci,
-        ...
-      )
+      params <- bootstrap_parameters(model, iterations = iterations, ci = ci, ...)
       if (effects != "fixed") {
         effects <- "fixed"
         if (verbose) {
-          insight::format_alert("Bootstrapping only returns fixed effects of the mixed model.")
+          insight::format_alert(
+            "Bootstrapping only returns fixed effects of the mixed model."
+          )
         }
       }
     } else {
@@ -183,7 +192,6 @@ model_parameters.coxme <- function(model,
     ...
   )
 
-
   attr(params, "object_name") <- insight::safe_deparse_symbol(substitute(model))
   class(params) <- c("parameters_model", "see_parameters_model", class(params))