Still mixed labelling with coviariance strucutres (#1215)

* Still mixed labelling with coviariance strucutres
Fixes #1214

* don't show empty CI columns when `ci_random = FALSE`

* address comments

* remove duplicated code

* add lme4 test

* lintr

* fix test

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.28.3.16
+Version: 0.28.3.17
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

R/extract_random_variances.R

@@ -188,7 +188,11 @@
   # extract covariance structures. we now have the names of the covariance
   # structures ("us", "ar1", etc.) as character vector, and the related grouping
   # variables as names of its elements
-  cov_struc <- vapply(varcorr, function(i) gsub("vcmat_", "", class(i)[1]), character(1))
+  cov_struc <- vapply(
+    varcorr,
+    function(i) gsub("vcmat_", "", class(i)[1], fixed = TRUE),
+    character(1)
+  )
 
   # extract parameters from SD and COR separately, for sorting
   re_sd_intercept <- re_data$var1 == "(Intercept)" &
@@ -244,8 +248,9 @@
         }
       )
       # fix label for cov_structure correlation
-      re_data[which(re_cor_slope[to_select]), "var1"] <- new_label
-      re_data[which(re_cor_slope[to_select]), "var2"] <- ""
+      idx <- which(re_cor_slope & to_select)
+      re_data[idx, "var1"] <- new_label
+      re_data[idx, "var2"] <- ""
     }
   }
 
@@ -345,6 +350,10 @@
       component,
       verbose = verbose
     )
+  } else if (effects == "random") {
+    # no CI requested and we have only random effects variances? then we
+    # can safely remove the ci-columns CI_low and CI_high
+    ci_cols <- NULL
   }
 
   out <- out[c(

R/methods_lme4.R

@@ -1,20 +1,21 @@
 ############# .merMod -----------------
 
-
 #' @export
 model_parameters.merMod <- model_parameters.coxme
 
 # helper ----------------------------------------------------------------------
 
-.add_random_effects_lme4 <- function(model,
-                                     params,
-                                     ci,
-                                     ci_method,
-                                     ci_random,
-                                     effects,
-                                     group_level,
-                                     verbose = TRUE,
-                                     ...) {
+.add_random_effects_lme4 <- function(
+  model,
+  params,
+  ci,
+  ci_method,
+  ci_random,
+  effects,
+  group_level,
+  verbose = TRUE,
+  ...
+) {
   params_random <- params_variance <- NULL
 
   # only proceed if random effects are requested
@@ -51,18 +52,23 @@ model_parameters.merMod <- model_parameters.coxme
 
 
 #' @export
-ci.merMod <- function(x,
-                      ci = 0.95,
-                      dof = NULL,
-                      method = "wald",
-                      iterations = 500,
-                      ...) {
+ci.merMod <- function(x, ci = 0.95, dof = NULL, method = "wald", iterations = 500, ...) {
   method <- tolower(method)
-  method <- insight::validate_argument(method, c(
-    "wald", "ml1", "betwithin", "kr",
-    "satterthwaite", "kenward", "boot",
-    "profile", "residual", "normal"
-  ))
+  method <- insight::validate_argument(
+    method,
+    c(
+      "wald",
+      "ml1",
+      "betwithin",
+      "kr",
+      "satterthwaite",
+      "kenward",
+      "boot",
+      "profile",
+      "residual",
+      "normal"
+    )
+  )
 
   # bootstrapping
   if (method == "boot") {
@@ -86,12 +92,14 @@ ci.merMod <- function(x,
 
 
 #' @export
-standard_error.merMod <- function(model,
-                                  effects = "fixed",
-                                  method = NULL,
-                                  vcov = NULL,
-                                  vcov_args = NULL,
-                                  ...) {
+standard_error.merMod <- function(
+  model,
+  effects = "fixed",
+  method = NULL,
+  vcov = NULL,
+  vcov_args = NULL,
+  ...
+) {
   dots <- list(...)
   effects <- insight::validate_argument(effects, c("fixed", "random"))
 
@@ -102,17 +110,16 @@ standard_error.merMod <- function(model,
 
   if (is.null(method)) {
     method <- "wald"
-  } else if ((method == "robust" && is.null(vcov)) ||
-    # deprecated argument
-    isTRUE(list(...)[["robust"]])) {
+  } else if (
+    (method == "robust" && is.null(vcov)) ||
+      # deprecated argument
+      isTRUE(list(...)[["robust"]])
+  ) {
     vcov <- "vcovHC"
   }
 
   if (!is.null(vcov) || isTRUE(dots[["robust"]])) {
-    fun_args <- list(model,
-      vcov = vcov,
-      vcov_args = vcov_args
-    )
+    fun_args <- list(model, vcov = vcov, vcov_args = vcov_args)
     fun_args <- c(fun_args, dots)
     out <- do.call("standard_error.default", fun_args)
     return(out)
@@ -121,12 +128,11 @@ standard_error.merMod <- function(model,
   # kenward approx
   if (method %in% c("kenward", "kr")) {
     out <- se_kenward(model)
-    return(out)
   } else {
     # Classic and Satterthwaite SE
     out <- se_mixed_default(model)
-    return(out)
   }
+  out
 }
 
 
@@ -148,7 +154,7 @@ standard_error.merMod <- function(model,
     rand.se[[m]] <- array(NA, c(J, K))
 
     for (j in 1:J) {
-      rand.se[[m]][j, ] <- sqrt(diag(as.matrix(vars.m[, , j])))
+      rand.se[[m]][j, ] <- sqrt(diag(as.matrix(vars.m[,, j])))
     }
     dimnames(rand.se[[m]]) <- list(names.full[[1]], names.full[[2]])
   }
@@ -157,7 +163,8 @@ standard_error.merMod <- function(model,
 
 
 se_mixed_default <- function(model) {
-  params <- insight::find_parameters(model,
+  params <- insight::find_parameters(
+    model,
     effects = "fixed",
     component = "conditional",
     flatten = TRUE

R/methods_mjoint.R

@@ -1,14 +1,16 @@
 #' @export
-model_parameters.mjoint <- function(model,
-                                    ci = 0.95,
-                                    effects = "fixed",
-                                    component = "all",
-                                    exponentiate = FALSE,
-                                    p_adjust = NULL,
-                                    keep = NULL,
-                                    drop = NULL,
-                                    verbose = TRUE,
-                                    ...) {
+model_parameters.mjoint <- function(
+  model,
+  ci = 0.95,
+  effects = "fixed",
+  component = "all",
+  exponentiate = FALSE,
+  p_adjust = NULL,
+  keep = NULL,
+  drop = NULL,
+  verbose = TRUE,
+  ...
+) {
   effects <- insight::validate_argument(effects, c("fixed", "random", "all"))
   component <- insight::validate_argument(component, c("all", "conditional", "survival"))
 
@@ -45,7 +47,6 @@ model_parameters.mjoint <- function(model,
     params_variance$Component <- "conditional"
   }
 
-
   # merge random and fixed effects, if necessary
   if (!is.null(params) && !is.null(params_variance)) {
     params$Level <- NA
@@ -121,7 +122,11 @@ ci.mjoint <- function(x, ci = 0.95, ...) {
 
 
 #' @export
-standard_error.mjoint <- function(model, component = c("all", "conditional", "survival"), ...) {
+standard_error.mjoint <- function(
+  model,
+  component = c("all", "conditional", "survival"),
+  ...
+) {
   component <- match.arg(component)
   s <- summary(model)