R/find_random.R

In insight: Easy Access to Model Information for Various Model Objects

#' @title Find names of random effects
#' @name find_random
#'
#' @description Return the name of the grouping factors from mixed effects models.
#'
#' @param x A fitted mixed model.
#' @param split_nested Logical, if `TRUE`, terms from nested random
#'   effects will be returned as separated elements, not as single string
#'   with colon. See 'Examples'.
#'
#' @inheritParams find_predictors
#' @inheritParams find_variables
#'
#' @return A list of character vectors that represent the name(s) of the
#' random effects (grouping factors). Depending on the model, the
#' returned list has following elements:
#'
#' - `random`, the "random effects" terms from the conditional part of model
#' - `zero_inflated_random`, the "random effects" terms from the zero-inflation
#'   component of the model
#'
#' @examplesIf require("lme4", quietly = TRUE)
#' data(sleepstudy, package = "lme4")
#' sleepstudy$mygrp <- sample(1:5, size = 180, replace = TRUE)
#' sleepstudy$mysubgrp <- NA
#' for (i in 1:5) {
#'   filter_group <- sleepstudy$mygrp == i
#'   sleepstudy$mysubgrp[filter_group] <-
#'     sample(1:30, size = sum(filter_group), replace = TRUE)
#' }
#'
#' m <- lme4::lmer(
#'   Reaction ~ Days + (1 | mygrp / mysubgrp) + (1 | Subject),
#'   data = sleepstudy
#' )
#'
#' find_random(m)
#' find_random(m, split_nested = TRUE)
#' @export
find_random <- function(x, split_nested = FALSE, flatten = FALSE) {
  UseMethod("find_random")
}

#' @export
find_random.default <- function(x, split_nested = FALSE, flatten = FALSE) {
  f <- find_formula(x, verbose = FALSE)

  if (is_multivariate(x)) {
    rn <- names(find_response(x))
    l <- lapply(rn, function(i) .find_random_effects(x, f[[i]], split_nested))
    names(l) <- rn
    l <- compact_list(l)
  } else {
    l <- .find_random_effects(x, f, split_nested)
  }


  if (is_empty_object(l)) {
    return(NULL)
  }

  if (flatten) {
    unique(unlist(l, use.names = FALSE))
  } else {
    l
  }
}

#' @export
find_random.afex_aov <- function(x, split_nested = FALSE, flatten = FALSE) {
  if (flatten) {
    attr(x, "id")
  } else {
    list(random = attr(x, "id"))
  }
}



.find_random_effects <- function(x, f, split_nested) {
  if (!object_has_names(f, "random") && !object_has_names(f, "zero_inflated_random")) {
    return(NULL)
  }

  if (object_has_names(f, "random")) {
    if (is.list(f$random)) {
      r1 <- unique(unlist(lapply(
        f$random,
        .get_model_random,
        model = x,
        split_nested = split_nested
      ), use.names = FALSE))
    } else {
      r1 <- unique(unlist(
        .get_model_random(f$random, model = x, split_nested),
        use.names = FALSE
      ))
    }
  } else {
    r1 <- NULL
  }


  if (object_has_names(f, "zero_inflated_random")) {
    if (is.list(f$zero_inflated_random)) {
      r2 <- unique(unlist(
        lapply(f$zero_inflated_random, .get_model_random, model = x, split_nested = split_nested),
        use.names = FALSE
      ))
    } else {
      r2 <- unique(.get_model_random(f$zero_inflated_random, model = x, split_nested))
    }
  } else {
    r2 <- NULL
  }


  compact_list(list(random = r1, zero_inflated_random = r2))
}