#' Parameters from Bayesian Exploratory Factor Analysis
#'
#' Format Bayesian Exploratory Factor Analysis objects from the BayesFM package.
#'
#' @param model Bayesian EFA created by the `BayesFM::befa`.
#' @inheritParams principal_components
#' @inheritParams bayestestR::describe_posterior
#' @inheritParams model_parameters.default
#' @param ... Arguments passed to or from other methods.
#'
#' @examples
#' library(parameters)
#' \donttest{
#' if (require("BayesFM")) {
#' efa <- BayesFM::befa(mtcars, iter = 1000)
#' results <- model_parameters(efa, sort = TRUE, verbose = FALSE)
#' results
#' efa_to_cfa(results, verbose = FALSE)
#' }
#' }
#' @return A data frame of loadings.
#' @export
model_parameters.befa <- function(model,
sort = FALSE,
centrality = "median",
dispersion = FALSE,
ci = 0.95,
ci_method = "eti",
test = NULL,
verbose = TRUE,
...) {
if (!attr(model, "post.column.switch") || !attr(model, "post.sign.switch")) {
insight::check_if_installed("BayesFM")
if (!attr(model, "post.column.switch")) model <- BayesFM::post.column.switch(model)
if (!attr(model, "post.sign.switch")) model <- BayesFM::post.sign.switch(model)
}
loadings <- as.data.frame(model$alpha)
names(loadings) <- gsub("alpha:", "", names(loadings), fixed = TRUE)
loadings <- stats::reshape(
loadings,
direction = "long",
varying = list(names(loadings)),
sep = "_",
timevar = "Variable",
v.names = "Loading",
idvar = "Draw",
times = names(loadings)
)
components <- as.data.frame(model$dedic)
names(components) <- gsub("dedic:", "", names(components), fixed = TRUE)
components <- stats::reshape(
components,
direction = "long",
varying = list(names(components)),
sep = "_",
timevar = "Variable",
v.names = "Component",
idvar = "Draw",
times = names(components)
)
loadings <- merge(components, loadings)
# Compute posterior by dedic
long_loadings <- data.frame()
for (var in unique(loadings$Variable)) {
for (comp in unique(loadings$Component)) {
chunk <- loadings[loadings$Variable == var & loadings$Component == comp, ]
if (nrow(chunk) == 0) {
rez <-
bayestestR::describe_posterior(
loadings$Loading,
centrality = centrality,
dispersion = dispersion,
ci = ci,
ci_method = ci_method,
test = test,
verbose = verbose,
...
)
rez[1, ] <- NA
} else {
rez <-
bayestestR::describe_posterior(
chunk$Loading,
centrality = centrality,
dispersion = dispersion,
ci = ci,
ci_method = ci_method,
test = test,
verbose = verbose,
...
)
}
long_loadings <- rbind(
long_loadings,
cbind(data.frame(Component = comp, Variable = var), rez)
)
}
}
long_loadings$Component <- paste0("F", long_loadings$Component)
# Clean
long_loadings$Parameter <- NULL
if ("CI" %in% names(long_loadings) && insight::n_unique(long_loadings$CI) == 1) {
long_loadings$CI <- NULL
}
long_loadings <- long_loadings[long_loadings$Component != 0, ]
loadings <- .wide_loadings(long_loadings, loadings_columns = names(long_loadings)[3], component_column = "Component", variable_column = "Variable")
# Add attributes
attr(loadings, "model") <- model
attr(loadings, "additional_arguments") <- list(...)
attr(loadings, "n") <- insight::n_unique(long_loadings$Component)
attr(loadings, "loadings_columns") <- names(loadings)[2:ncol(loadings)]
attr(loadings, "ci") <- ci
# Sorting
if (isTRUE(sort)) {
loadings <- .sort_loadings(loadings)
}
# Add some more attributes
long_loadings <- stats::na.omit(long_loadings)
row.names(long_loadings) <- NULL
attr(loadings, "loadings_long") <- long_loadings
# add class-attribute for printing
class(loadings) <- c("parameters_efa", class(loadings))
loadings
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.