#' @title Find names of model parameters from mixed models
#' @name find_parameters.glmmTMB
#'
#' @description Returns the names of model parameters, like they typically
#' appear in the `summary()` output.
#'
#' @param component Which type of parameters to return, such as parameters for
#' the conditional model, the zero-inflated part of the model or the
#' dispersion term? Applies to models with zero-inflated and/or dispersion
#' formula. Note that the *conditional* component is also called
#' *count* or *mean* component, depending on the model. There are
#' three convenient shortcuts: `component = "all"` returns all possible
#' parameters. If `component = "location"`, location parameters such as
#' `conditional` or `zero_inflated` are returned (everything that
#' are fixed or random effects - depending on the `effects` argument -
#' but no auxiliary parameters). For `component = "distributional"` (or
#' `"auxiliary"`), components like `sigma` or `dispersion` (and
#' other auxiliary parameters) are returned.
#' @param ... Currently not used.
#' @inheritParams find_parameters
#' @inheritParams find_parameters.betamfx
#' @inheritParams find_parameters.BGGM
#' @inheritParams find_predictors
#'
#' @return A list of parameter names. The returned list may have following
#' elements:
#'
#' - `conditional`, the "fixed effects" part from the model.
#' - `random`, the "random effects" part from the model.
#' - `zero_inflated`, the "fixed effects" part from the zero-inflation component
#' of the model.
#' - `zero_inflated_random`, the "random effects" part from the zero-inflation
#' component of the model.
#' - `dispersion`, the dispersion parameters (auxiliary parameter)
#' - `dispersion_random`, the "random effects" part from the dispersion
#' parameters (auxiliary parameter)
#' - `nonlinear`, the parameters from the nonlinear formula.
#'
#' @examples
#' data(mtcars)
#' m <- lm(mpg ~ wt + cyl + vs, data = mtcars)
#' find_parameters(m)
#' @export
find_parameters.glmmTMB <- function(x,
effects = c("all", "fixed", "random"),
component = c("all", "conditional", "zi", "zero_inflated", "dispersion"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
component <- match.arg(component)
# installed
check_if_installed("lme4")
# we extract random effects only when really necessary, to save
# computational time. In particular model with large sample and
# many random effects groups may take some time to return random effects
if (effects == "fixed") {
l <- compact_list(list(
conditional = names(lme4::fixef(x)$cond),
zero_inflated = names(lme4::fixef(x)$zi),
dispersion = names(lme4::fixef(x)$disp)
))
} else {
l <- compact_list(list(
conditional = names(lme4::fixef(x)$cond),
random = lapply(lme4::ranef(x)$cond, colnames),
zero_inflated = names(lme4::fixef(x)$zi),
zero_inflated_random = lapply(lme4::ranef(x)$zi, colnames),
dispersion = names(lme4::fixef(x)$disp),
dispersion_random = names(lme4::ranef(x)$disp)
))
}
.filter_parameters(l,
effects = effects,
component = component,
flatten = flatten
)
}
#' @export
find_parameters.MixMod <- function(x,
effects = c("all", "fixed", "random"),
component = c("all", "conditional", "zi", "zero_inflated"),
flatten = FALSE,
...) {
# installed
check_if_installed("lme4")
re.names <- dimnames(lme4::ranef(x))[[2]]
has_zeroinf <- !is.null(find_formula(x)[["zero_inflated"]])
if (has_zeroinf) {
z_inflated <- names(lme4::fixef(x, sub_model = "zero_part"))
z_inflated_random <- re.names[startsWith(re.names, "zi_")]
} else {
z_inflated <- NULL
z_inflated_random <- NULL
}
l <- compact_list(list(
conditional = names(lme4::fixef(x, sub_model = "main")),
random = grep("^(?!zi_)", re.names, perl = TRUE, value = TRUE),
zero_inflated = z_inflated,
zero_inflated_random = z_inflated_random
))
l <- lapply(l, text_remove_backticks)
effects <- match.arg(effects)
component <- match.arg(component)
elements <- .get_elements(effects = effects, component = component)
l <- compact_list(l[elements])
if (flatten) {
unique(unlist(l, use.names = FALSE))
} else {
l
}
}
#' @rdname find_parameters.glmmTMB
#' @export
find_parameters.nlmerMod <- function(x,
effects = c("all", "fixed", "random"),
component = c("all", "conditional", "nonlinear"),
flatten = FALSE,
...) {
# installed
check_if_installed("lme4")
effects <- match.arg(effects)
component <- match.arg(component)
startvectors <- .get_startvector_from_env(x)
if (effects == "fixed") {
l <- compact_list(list(
conditional = setdiff(names(lme4::fixef(x)), startvectors),
nonlinear = startvectors
))
} else {
l <- compact_list(list(
conditional = setdiff(names(lme4::fixef(x)), startvectors),
nonlinear = startvectors,
random = lapply(lme4::ranef(x), colnames)
))
}
.filter_parameters(l, effects = effects, component = component, flatten = flatten)
}
#' @rdname find_parameters.glmmTMB
#' @export
find_parameters.hglm <- function(x,
effects = c("all", "fixed", "random"),
component = c("all", "conditional", "dispersion"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
fe <- x$fixef
re <- x$ranef
f <- find_formula(x)
if (is.null(f$dispersion)) {
disp_name <- NULL
} else {
disp <- summary(x)$SummVC1
disp_name <- rownames(disp)
}
l <- compact_list(list(
conditional = names(fe),
random = names(re),
dispersion = disp_name
))
.filter_parameters(l, effects = effects, component = component, flatten = flatten)
}
#' @rdname find_parameters.glmmTMB
#' @export
find_parameters.merMod <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
# installed
check_if_installed("lme4")
# we extract random effects only when really necessary, to save
# computational time. In particular model with large sample and
# many random effects groups may take some time to return random effects
if (effects == "fixed") {
l <- list(conditional = names(lme4::fixef(x)))
} else {
l <- compact_list(list(
conditional = names(lme4::fixef(x)),
random = lapply(lme4::ranef(x), colnames)
))
}
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.rlmerMod <- find_parameters.merMod
#' @export
find_parameters.glmmadmb <- find_parameters.merMod
#' @export
find_parameters.merModList <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
find_parameters(x[[1]], effects = effects, flatten = flatten, ...)
}
#' @export
find_parameters.svy2lme <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
# we extract random effects only when really necessary, to save
# computational time. In particular model with large sample and
# many random effects groups may take some time to return random effects
if (effects == "fixed") {
l <- list(conditional = names(stats::coef(x)))
} else {
l <- compact_list(list(
conditional = names(stats::coef(x)),
random = stats::setNames(as.list(unname(x$znames)), names(x$znames))
))
}
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.HLfit <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
# installed
check_if_installed("lme4")
# we extract random effects only when really necessary, to save
# computational time. In particular model with large sample and
# many random effects groups may take some time to return random effects
if (effects == "fixed") {
l <- list(conditional = names(lme4::fixef(x)))
} else {
utils::capture.output(s <- summary(x)) # nolint
l <- compact_list(list(
conditional = names(lme4::fixef(x)),
random = s$lambda_table$Term
))
}
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.sem <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
if (!.is_semLme(x)) {
return(NULL)
}
effects <- match.arg(effects)
l <- compact_list(list(
conditional = names(x$coef),
random = colnames(x$ranef)
))
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.cpglmm <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
# installed
check_if_installed("cplm")
effects <- match.arg(effects)
# we extract random effects only when really necessary, to save
# computational time. In particular model with large sample and
# many random effects groups may take some time to return random effects
if (effects == "fixed") {
l <- list(conditional = names(cplm::fixef(x)))
} else {
l <- compact_list(list(
conditional = names(cplm::fixef(x)),
random = lapply(cplm::ranef(x), colnames)
))
}
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.coxme <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
check_if_installed("lme4")
effects <- match.arg(effects)
if (effects == "fixed") {
l <- list(conditional = names(lme4::fixef(x)))
} else {
l <- compact_list(list(
conditional = names(lme4::fixef(x)),
random = names(lme4::ranef(x))
))
}
.filter_parameters(l,
effects = effects,
flatten = flatten,
recursive = FALSE
)
}
#' @export
find_parameters.mixed <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
# installed
check_if_installed("lme4")
effects <- match.arg(effects)
if (effects == "fixed") {
l <- list(conditional = names(lme4::fixef(x$full_model)))
} else {
l <- compact_list(list(
conditional = names(lme4::fixef(x$full_model)),
random = lapply(lme4::ranef(x$full_model), colnames)
))
}
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.lme <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
check_if_installed("lme4")
effects <- match.arg(effects)
if (effects == "fixed") {
l <- list(conditional = names(lme4::fixef(x)))
} else {
re <- lme4::ranef(x)
if (is.data.frame(re)) {
rn <- colnames(re)
} else {
rn <- lapply(re, colnames)
}
l <- compact_list(list(
conditional = names(lme4::fixef(x)),
random = rn
))
}
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.glmm <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
s <- summary(x)
fe_params <- rownames(s$coefmat)
re_params <- rownames(s$nucoefmat)
l <- compact_list(list(
conditional = fe_params,
random = re_params
))
.filter_parameters(l, effects = effects, flatten = flatten)
}
#' @export
find_parameters.BBmm <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
l <- compact_list(list(
conditional = rownames(x$fixed.coef),
random = x$namesRand
))
effects <- match.arg(effects)
.filter_parameters(l,
effects = effects,
flatten = flatten,
recursive = FALSE
)
}
#' @export
find_parameters.glimML <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
l <- compact_list(list(
conditional = names(x@fixed.param),
random = names(x@random.param)
))
effects <- match.arg(effects)
.filter_parameters(l,
effects = effects,
flatten = flatten,
recursive = FALSE
)
}
#' @export
find_parameters.mixor <- function(x,
effects = c("all", "fixed", "random"),
flatten = FALSE,
...) {
effects <- match.arg(effects)
coefs <- x$Model
random_start <- grep("(\\(Intercept\\) \\(Intercept\\)|Random\\.\\(Intercept\\))", rownames(coefs))
thresholds <- grep("Threshold\\d", rownames(coefs))
l <- list(
conditional = rownames(coefs)[c(1, thresholds, 2:(random_start - 1))],
random = rownames(coefs)[random_start:(thresholds[1] - 1)]
)
.filter_parameters(l, effects = effects, flatten = flatten)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.