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)
@@ -621,6 +623,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/methods_psych.R

@@ -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,77 @@
 
 
 #' @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,
+                                   verbose = TRUE,
+                                   ...) {
+  # 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)
+
+  # 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"
 
-  out <- table_om
-  attr(out, "summary") <- table_var
-  class(out) <- c("parameters_omega", class(out))
-  out
+  # Add attributes
+  attr(loadings, "summary") <- data_summary
+  attr(loadings, "omega_coefficients") <- omega_coefficients
+  attr(loadings, "model") <- model
+  attr(loadings, "rotation") <- model$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 +316,23 @@
 
   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/print_md.R

@@ -273,6 +273,38 @@ print_md.parameters_efa_summary <- function(x, digits = 3, ...) {
 #' @export
 print_md.parameters_pca_summary <- print_md.parameters_efa_summary
 
+#' @export
+print_md.parameters_omega_summary <- function(x, ...) {
+  orig_x <- x
+
+  # extract summary tables
+  omega_coefficients <- attributes(x)$omega_coefficients
+  variance_summary <- attributes(x)$summary
+
+  # rename columns
+  if (!is.null(omega_coefficients)) {
+    names(omega_coefficients) <- c(
+      "Composite", "Omega (total)", "Omega (hierarchical)", "Omega (group)"
+    )
+    caption1 <- "Omega Coefficients"
+  }
+  if (!is.null(variance_summary)) {
+    names(variance_summary) <- c(
+      "Composite", "Total (%)", "General Factor (%)",
+      "Group Factor (%)"
+    )
+    caption2 <- "Variances"
+  }
+
+  # list for export
+  out <- insight::compact_list(list(omega_coefficients, variance_summary))
+  captions <- insight::compact_list(list(caption1, caption2))
+
+  cat(insight::export_table(out, caption = captions, format = "markdown", ...))
+  invisible(orig_x)
+}
+
+
 #' @export
 print_md.parameters_efa <- function(x,
                                     digits = 2,
@@ -298,6 +330,9 @@ print_md.parameters_efa <- function(x,
 #' @export
 print_md.parameters_pca <- print_md.parameters_efa
 
+#' @export
+print_md.parameters_omega <- print_md.parameters_efa
+
 
 # Equivalence test ----------------------------
 

R/utils_pca_efa.R

@@ -129,9 +129,8 @@ summary.parameters_pca <- summary.parameters_efa
 
 #' @export
 summary.parameters_omega <- function(object, ...) {
-  table_var <- attributes(object)$summary
-  class(table_var) <- c("parameters_omega_summary", class(table_var))
-  table_var
+  class(object) <- c("parameters_omega_summary", "data.frame")
+  object
 }
 
 
@@ -284,28 +283,41 @@ print.parameters_efa <- function(x,
   invisible(x)
 }
 
-
 #' @export
 print.parameters_pca <- print.parameters_efa
 
-
 #' @export
-print.parameters_omega <- function(x, ...) {
-  orig_x <- x
-  names(x) <- c("Composite", "Omega (total)", "Omega (hierarchical)", "Omega (group)")
-  cat(insight::export_table(x))
-  invisible(orig_x)
-}
+print.parameters_omega <- print.parameters_efa
 
 
 #' @export
 print.parameters_omega_summary <- function(x, ...) {
   orig_x <- x
-  names(x) <- c(
-    "Composite", "Total Variance (%)", "Variance due to General Factor (%)",
-    "Variance due to Group Factor (%)"
-  )
-  cat(insight::export_table(x))
+
+  # extract summary tables
+  omega_coefficients <- attributes(x)$omega_coefficients
+  variance_summary <- attributes(x)$summary
+
+  # rename columns
+  if (!is.null(omega_coefficients)) {
+    names(omega_coefficients) <- c(
+      "Composite", "Omega (total)", "Omega (hierarchical)", "Omega (group)"
+    )
+    caption1 <- c("# Omega Coefficients", "blue")
+  }
+  if (!is.null(variance_summary)) {
+    names(variance_summary) <- c(
+      "Composite", "Total (%)", "General Factor (%)",
+      "Group Factor (%)"
+    )
+    caption2 <- c("# Variances", "blue")
+  }
+
+  # list for export
+  out <- insight::compact_list(list(omega_coefficients, variance_summary))
+  captions <- insight::compact_list(list(caption1, caption2))
+
+  cat(insight::export_table(out, caption = captions, format = "text", ...))
   invisible(orig_x)
 }
 
@@ -317,8 +329,10 @@ print.parameters_omega_summary <- function(x, ...) {
   # Method
   if (inherits(x, "parameters_pca")) {
     method <- "Principal Component Analysis"
-  } else {
+  } else if (inherits(x, "parameters_efa")) {
     method <- "Factor Analysis"
+  } else {
+    method <- "Omega"
   }
 
   # Rotation
@@ -341,7 +355,13 @@ print.parameters_omega_summary <- function(x, ...) {
   }
 
   # table caption
-  if (is.null(rotation_name) || rotation_name == "none") {
+  if (method == "Omega") {
+    if (format %in% c("markdown", "html")) {
+      table_caption <- "Omega"
+    } else {
+      table_caption <- c("# Omega", "blue")
+    }
+  } else if (is.null(rotation_name) || rotation_name == "none") {
     if (format %in% c("markdown", "html")) {
       table_caption <- sprintf("Loadings from %s (no rotation)", method)
     } else {