Support for psych::omega models

DESCRIPTION

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

NAMESPACE

@@ -126,6 +126,8 @@ S3method(display,parameters_brms_meta)
 S3method(display,parameters_efa)
 S3method(display,parameters_efa_summary)
 S3method(display,parameters_model)
+S3method(display,parameters_omega)
+S3method(display,parameters_omega_summary)
 S3method(display,parameters_pca)
 S3method(display,parameters_pca_summary)
 S3method(display,parameters_sem)
@@ -150,7 +152,9 @@ S3method(equivalence_test,wbm)
 S3method(equivalence_test,zeroinfl)
 S3method(factor_analysis,data.frame)
 S3method(factor_scores,fa)
+S3method(factor_scores,omega)
 S3method(factor_scores,parameters_efa)
+S3method(factor_scores,parameters_omega)
 S3method(format,compare_parameters)
 S3method(format,equivalence_test_lm)
 S3method(format,p_calibrate)
@@ -621,6 +625,8 @@ S3method(print_md,parameters_brms_meta)
 S3method(print_md,parameters_efa)
 S3method(print_md,parameters_efa_summary)
 S3method(print_md,parameters_model)
+S3method(print_md,parameters_omega)
+S3method(print_md,parameters_omega_summary)
 S3method(print_md,parameters_p_function)
 S3method(print_md,parameters_pca)
 S3method(print_md,parameters_pca_summary)

NEWS.md

@@ -12,7 +12,7 @@
 * New function `factor_scores()` to extract factor scores from EFA (`psych::fa()`
   or `factor_analysis()`).
 
-* Added and/or improved print-methods for all functions around PCA and FA.
+* Added and/or improved print-methods for all functions around PCA, FA and Omega.
 
 * Improved efficiency in `model_parameters()` for models from packages *brms*
   and *rstanarm*.

R/display.R

@@ -232,11 +232,14 @@
 #' @export
 display.parameters_pca_summary <- display.parameters_efa_summary
 
+#' @export
+display.parameters_omega_summary <- display.parameters_efa_summary
+
 
 #' @inheritParams model_parameters.principal
 #' @rdname display.parameters_model
 #' @export
 display.parameters_efa <- function(object, format = "markdown", digits = 2, sort = FALSE, threshold = NULL, labels = NULL, ...) {
   format <- insight::validate_argument(format, c("markdown", "html", "md", "tt"))
 
   fun_args <- list(
@@ -257,6 +260,9 @@
 #' @export
 display.parameters_pca <- display.parameters_efa
 
+#' @export
+display.parameters_omega <- display.parameters_efa
+
 
 # Equivalence tests ------------------------
 

R/factor_scores.R

@@ -1,9 +1,10 @@
-#' Extract factor scores from Factor Analysis (EFA)
+#' Extract factor scores from Factor Analysis (EFA) or Omega
 #'
 #' `factor_scores()` extracts the factor scores from objects returned by
-#' [`psych::fa()`] or [`factor_analysis()`].
+#' [`psych::fa()`], [`factor_analysis()`], or [`psych::omega()`]
 #'
-#' @param x An object returned by [`psych::fa()`] or [`factor_analysis()`].
+#' @param x An object returned by [`psych::fa()`], [`factor_analysis()`], or
+#' [`psych::omega()`].
 #' @param ... Currently unused.
 #'
 #' @return A data frame with the factor scores. It simply extracts the `$scores`
@@ -24,6 +25,11 @@ factor_scores.fa <- function(x, ...) {
   as.data.frame(x$scores)
 }
 
+#' @export
+factor_scores.omega <- function(x, ...) {
+  as.data.frame(x$scores)
+}
+
 #' @export
 factor_scores.parameters_efa <- function(x, ...) {
   model <- attributes(x)$model
@@ -32,3 +38,6 @@ factor_scores.parameters_efa <- function(x, ...) {
   }
   as.data.frame(model$scores)
 }
+
+#' @export
+factor_scores.parameters_omega <- factor_scores.parameters_efa

R/methods_psych.R

@@ -1,6 +1,8 @@
 #' Parameters from PCA, FA, CFA, SEM
 #'
-#' Format structural models from the **psych** or **FactoMineR** packages.
+#' Format structural models from the **psych** or **FactoMineR** packages. There
+#' is a `summary()` method for the returned output from `model_parameters()`, to
+#' show further information. See 'Examples'.
 #'
 #' @param standardize Return standardized parameters (standardized coefficients).
 #'   Can be `TRUE` (or `"all"` or `"std.all"`) for standardized
@@ -46,81 +48,79 @@
 #'    PCA. The value should be > 0.6, and desirable values are > 0.8
 #'    (\cite{Tabachnick and Fidell, 2013}).
 #'
-#' @examples
-#' \donttest{
+#' @examplesIf all(insight::check_if_installed(c("psych", "lavaan"), quietly = TRUE))
 #' library(parameters)
-#' if (require("psych", quietly = TRUE)) {
-#'   # Principal Component Analysis (PCA) ---------
-#'   pca <- psych::principal(attitude)
-#'   model_parameters(pca)
+#' \donttest{
+#' # Principal Component Analysis (PCA) ---------
+#' data(attitude)
+#' pca <- psych::principal(attitude)
+#' model_parameters(pca)
+#' summary(model_parameters(pca))
 #'
-#'   pca <- psych::principal(attitude, nfactors = 3, rotate = "none")
-#'   model_parameters(pca, sort = TRUE, threshold = 0.2)
+#' pca <- psych::principal(attitude, nfactors = 3, rotate = "none")
+#' model_parameters(pca, sort = TRUE, threshold = 0.2)
 #'
-#'   principal_components(attitude, n = 3, sort = TRUE, threshold = 0.2)
+#' principal_components(attitude, n = 3, sort = TRUE, threshold = 0.2)
 #'
 #'
-#'   # Exploratory Factor Analysis (EFA) ---------
-#'   efa <- psych::fa(attitude, nfactors = 3)
-#'   model_parameters(efa,
-#'     threshold = "max", sort = TRUE,
-#'     labels = as.character(1:ncol(attitude))
-#'   )
+#' # Exploratory Factor Analysis (EFA) ---------
+#' efa <- psych::fa(attitude, nfactors = 3)
+#' model_parameters(efa,
+#'   threshold = "max", sort = TRUE,
+#'   labels = as.character(1:ncol(attitude))
+#' )
 #'
 #'
-#'   # Omega ---------
-#'   omega <- psych::omega(mtcars, nfactors = 3)
-#'   params <- model_parameters(omega)
-#'   params
-#'   summary(params)
+#' # Omega ---------
+#' data(mtcars)
+#' omega <- psych::omega(mtcars, nfactors = 3, plot = FALSE)
+#' params <- model_parameters(omega)
+#' params
+#' summary(params)
 #' }
-#' }
-#'
-#' # lavaan
 #'
-#' library(parameters)
 #'
 #' # lavaan -------------------------------------
-#' if (require("lavaan", quietly = TRUE)) {
-#'   # Confirmatory Factor Analysis (CFA) ---------
+#' # Confirmatory Factor Analysis (CFA) ---------
 #'
-#'   structure <- " visual  =~ x1 + x2 + x3
-#'                  textual =~ x4 + x5 + x6
-#'                  speed   =~ x7 + x8 + x9 "
-#'   model <- lavaan::cfa(structure, data = HolzingerSwineford1939)
-#'   model_parameters(model)
-#'   model_parameters(model, standardize = TRUE)
+#' data(HolzingerSwineford1939, package = "lavaan")
+#' structure <- " visual  =~ x1 + x2 + x3
+#'                textual =~ x4 + x5 + x6
+#'                speed   =~ x7 + x8 + x9 "
+#' model <- lavaan::cfa(structure, data = HolzingerSwineford1939)
+#' model_parameters(model)
+#' model_parameters(model, standardize = TRUE)
 #'
-#'   # filter parameters
-#'   model_parameters(
-#'     model,
-#'     parameters = list(
-#'       To = "^(?!visual)",
-#'       From = "^(?!(x7|x8))"
-#'     )
+#' # filter parameters
+#' model_parameters(
+#'   model,
+#'   parameters = list(
+#'     To = "^(?!visual)",
+#'     From = "^(?!(x7|x8))"
 #'   )
+#' )
 #'
-#'   # Structural Equation Model (SEM) ------------
+#' # Structural Equation Model (SEM) ------------
 #'
-#'   structure <- "
-#'     # latent variable definitions
-#'       ind60 =~ x1 + x2 + x3
-#'       dem60 =~ y1 + a*y2 + b*y3 + c*y4
-#'       dem65 =~ y5 + a*y6 + b*y7 + c*y8
-#'     # regressions
-#'       dem60 ~ ind60
-#'       dem65 ~ ind60 + dem60
-#'     # residual correlations
-#'       y1 ~~ y5
-#'       y2 ~~ y4 + y6
-#'       y3 ~~ y7
-#'       y4 ~~ y8
-#'       y6 ~~ y8
-#'   "
-#'   model <- lavaan::sem(structure, data = PoliticalDemocracy)
-#'   model_parameters(model)
-#'   model_parameters(model, standardize = TRUE)
-#' }
+#' data(PoliticalDemocracy, package = "lavaan")
+#' structure <- "
+#'   # latent variable definitions
+#'     ind60 =~ x1 + x2 + x3
+#'     dem60 =~ y1 + a*y2 + b*y3 + c*y4
+#'     dem65 =~ y5 + a*y6 + b*y7 + c*y8
+#'   # regressions
+#'     dem60 ~ ind60
+#'     dem65 ~ ind60 + dem60
+#'   # residual correlations
+#'     y1 ~~ y5
+#'     y2 ~~ y4 + y6
+#'     y3 ~~ y7
+#'     y4 ~~ y8
+#'     y6 ~~ y8
+#' "
+#' model <- lavaan::sem(structure, data = PoliticalDemocracy)
+#' model_parameters(model)
+#' model_parameters(model, standardize = TRUE)
 #'
 #' @return A data frame of indices or loadings.
 #' @references
@@ -158,16 +158,16 @@
   data_summary <- .get_fa_variance_summary(model)
 
   # Get loadings
   loadings <- as.data.frame(unclass(model$loadings))
 
   # Format
   loadings <- cbind(data.frame(Variable = row.names(loadings)), loadings)
   row.names(loadings) <- NULL
 
   # Labels
   if (!is.null(labels)) {
     loadings$Label <- labels
     loadings <- loadings[c("Variable", "Label", names(loadings)[!names(loadings) %in% c("Variable", "Label")])]
     loading_cols <- 3:(n + 2)
   } else {
     loading_cols <- 2:(n + 1)
@@ -192,7 +192,7 @@
 
   # Sorting
   if (isTRUE(sort)) {
     loadings <- .sort_loadings(loadings)
   }
 
   # Add some more attributes
@@ -224,29 +224,80 @@
 
 
 #' @export
-model_parameters.omega <- function(model, verbose = TRUE, ...) {
-  # Table of omega coefficients
-  table_om <- model$omega.group
-  colnames(table_om) <- c("Omega_Total", "Omega_Hierarchical", "Omega_Group")
-  table_om$Composite <- row.names(table_om)
-  row.names(table_om) <- NULL
-  table_om <- table_om[c("Composite", names(table_om)[names(table_om) != "Composite"])]
+model_parameters.omega <- function(model,
+                                   sort = FALSE,
+                                   threshold = NULL,
+                                   labels = NULL,
+                                   ...) {
+  # n
+  n <- model$stats$factors
 
-  # Get summary: Table of Variance
-  table_var <- as.data.frame(unclass(model$omega.group))
-  table_var$Composite <- rownames(model$omega.group)
-  table_var$Total <- table_var$total * 100
-  table_var$General <- table_var$general * 100
-  table_var$Group <- table_var$group * 100
-  table_var <- table_var[c("Composite", "Total", "General", "Group")]
+  # Get summary
+  data_summary <- .get_omega_variance_summary(model)
+
+  # Get omega coefficients
+  omega_coefficients <- .get_omega_coefficients_summary(model)
 
-  out <- table_om
-  attr(out, "summary") <- table_var
-  class(out) <- c("parameters_omega", class(out))
-  out
+  # Get loadings
+  loadings <- as.data.frame(unclass(model$schmid$sl))
+
+  # Format
+  loadings <- cbind(data.frame(Variable = row.names(loadings)), loadings)
+  row.names(loadings) <- NULL
+
+  # Labels
+  if (!is.null(labels)) {
+    loadings$Label <- labels
+    loadings <- loadings[c("Variable", "Label", names(loadings)[!names(loadings) %in% c("Variable", "Label")])]
+    loading_cols <- 3:(n + 4)
+  } else {
+    loading_cols <- 2:(n + 3)
+  }
+
+  # Add information
+  colnames(loadings)[colnames(loadings) == "com"] <- "Complexity"
+  rotation <- model$Call$rotate
+  if (is.null(rotation)) {
+    rotation <- "oblimin"
+  }
+
+  # Add attributes
+  attr(loadings, "summary") <- data_summary
+  attr(loadings, "omega_coefficients") <- omega_coefficients
+  attr(loadings, "model") <- model
+  attr(loadings, "rotation") <- rotation
+  attr(loadings, "scores") <- model$scores
+  attr(loadings, "additional_arguments") <- list(...)
+  attr(loadings, "n") <- n
+  attr(loadings, "threshold") <- threshold
+  attr(loadings, "sort") <- sort
+  attr(loadings, "loadings_columns") <- loading_cols
+
+  # Sorting
+  if (isTRUE(sort)) {
+    loadings <- .sort_loadings(loadings)
+  }
+
+  # Add some more attributes
+  attr(loadings, "loadings_long") <- .long_loadings(loadings, threshold = threshold, loadings_columns = loading_cols)
+  # here we match the original columns in the data set with the assigned components
+  # for each variable, so we know which column in the original data set belongs
+  # to which extracted component...
+  attr(loadings, "closest_component") <- .closest_component(
+    loadings,
+    loadings_columns = loading_cols,
+    variable_names = rownames(model$schmid$sl)
+  )
+
+  # add class-attribute for printing
+  class(loadings) <- c("parameters_omega", class(loadings))
+  loadings
 }
 
 
+# helper ------------------------------------------------
+
+
 .get_fa_variance_summary <- function(model) {
   n <- model$factors
   variance <- as.data.frame(unclass(model$Vaccounted))
@@ -268,3 +319,24 @@
 
   data_summary
 }
+
+
+.get_omega_variance_summary <- function(model) {
+  # Get summary: Table of Variance
+  table_var <- as.data.frame(unclass(model$omega.group))
+  table_var$Composite <- rownames(model$omega.group)
+  table_var$Total <- table_var$total * 100
+  table_var$General <- table_var$general * 100
+  table_var$Group <- table_var$group * 100
+  table_var[c("Composite", "Total", "General", "Group")]
+}
+
+
+.get_omega_coefficients_summary <- function(model) {
+  # Table of omega coefficients
+  table_om <- model$omega.group
+  colnames(table_om) <- c("Omega_Total", "Omega_Hierarchical", "Omega_Group")
+  table_om$Composite <- row.names(table_om)
+  row.names(table_om) <- NULL
+  table_om[c("Composite", names(table_om)[names(table_om) != "Composite"])]
+}

R/n_clusters_easystats.R

@@ -289,7 +289,7 @@ print.n_clusters_dbscan <- function(x, ...) {
 
 #' @export
 print.n_clusters_hclust <- function(x, ...) {
-  insight::print_color(paste0("The bootstrap analysis of hierachical clustering highlighted ", attributes(x)$n, " significant clusters."), "green") # nolint
+  insight::print_color(paste0("The bootstrap analysis of hierarchical clustering highlighted ", attributes(x)$n, " significant clusters."), "green") # nolint
   invisible(x)
 }