Factor analysis minor improvements (#877)

* Revert hotfix and fail informatively #268 * minor * add max_per_dimension arg to efa_to_cfa * comments * news, version * minor --------- Co-authored-by: Daniel <[email protected]>
easystats · Sep 11, 2023 · 90ce679 · 90ce679
1 parent 3415c02
commit 90ce679
Show file tree

Hide file tree

Showing 8 changed files with 100 additions and 25 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: parameters
 Title: Processing of Model Parameters
-Version: 0.21.1.7
+Version: 0.21.1.8
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,8 @@
 
 ## Changes
 
+* Minor improvements to factor analysis functions.
+
 * The `ci_digits` argument of the `print()` method for `model_parameters()` now
   defaults to the same value of `digits`.
 

diff --git a/R/cluster_analysis.R b/R/cluster_analysis.R
@@ -449,6 +449,12 @@ visualisation_recipe.cluster_analysis_summary <- function(x, ...) {
 #' @export
 visualisation_recipe.cluster_analysis <- function(x, show_data = "text", ...) {
   ori_data <- stats::na.omit(attributes(x)$data)
+
+  # Check number of columns: if more than 2, display PCs, if less, fail
+  if (ncol(ori_data) <= 2) {
+    insight::format_error("Less than 2 variables in the dataset. Cannot compute enough principal components to represent clustering.")
+  }
+
   # Get 2 PCA Components
   pca <- principal_components(ori_data, n = 2)
   data <- stats::predict(pca)

diff --git a/R/convert_efa_to_cfa.R b/R/convert_efa_to_cfa.R
@@ -4,8 +4,9 @@
 #' Confirmatory Factor Analysis (CFA) `lavaan`-ready structure.
 #'
 #' @param model An EFA model (e.g., a `psych::fa` object).
-#' @inheritParams principal_components
 #' @param names Vector containing dimension names.
+#' @param max_per_dimension Maximum number of variables to keep per dimension.
+#' @inheritParams principal_components
 #'
 #' @examples
 #' \donttest{
@@ -15,10 +16,12 @@
 #'
 #'   model1 <- efa_to_cfa(efa)
 #'   model2 <- efa_to_cfa(efa, threshold = 0.3)
+#'   model3 <- efa_to_cfa(efa, max_per_dimension = 2)
 #'
 #'   suppressWarnings(anova(
 #'     lavaan::cfa(model1, data = attitude),
-#'     lavaan::cfa(model2, data = attitude)
+#'     lavaan::cfa(model2, data = attitude),
+#'     lavaan::cfa(model3, data = attitude)
 #'   ))
 #' }
 #' }
@@ -33,8 +36,15 @@ convert_efa_to_cfa <- function(model, ...) {
 #' @rdname convert_efa_to_cfa
 #' @inheritParams model_parameters.principal
 #' @export
-convert_efa_to_cfa.fa <- function(model, threshold = "max", names = NULL, ...) {
-  .efa_to_cfa(model_parameters(model, threshold = threshold, ...), names = names, ...)
+convert_efa_to_cfa.fa <- function(model,
+                                  threshold = "max",
+                                  names = NULL,
+                                  max_per_dimension = NULL,
+                                  ...) {
+  .efa_to_cfa(model_parameters(model, threshold = threshold, ...),
+              names = names,
+              max_per_dimension = max_per_dimension,
+              ...)
 }
 
 #' @export
@@ -46,12 +56,13 @@ convert_efa_to_cfa.fa.ci <- convert_efa_to_cfa.fa
 convert_efa_to_cfa.parameters_efa <- function(model,
                                               threshold = NULL,
                                               names = NULL,
+                                              max_per_dimension = NULL,
                                               ...) {
   if (!is.null(threshold)) {
     model <- model_parameters(attributes(model)$model, threshold = threshold, ...)
   }
 
-  .efa_to_cfa(model, names = names, ...)
+  .efa_to_cfa(model, names = names, max_per_dimension = max_per_dimension, ...)
 }
 
 #' @export
@@ -67,7 +78,7 @@ efa_to_cfa <- convert_efa_to_cfa
 
 
 #' @keywords internal
-.efa_to_cfa <- function(loadings, names = NULL, ...) {
+.efa_to_cfa <- function(loadings, names = NULL, max_per_dimension=NULL, ...) {
   loadings <- attributes(loadings)$loadings_long
 
   # Get dimension names
@@ -78,17 +89,31 @@ efa_to_cfa <- convert_efa_to_cfa
   # Catch error
   if (length(names) != insight::n_unique(loadings$Component)) {
     insight::format_error(
-      paste0("The `names` vector must be of same length as the number of dimensions, in this case ", length(unique(loadings$Component)), ".")
+      paste0(
+        "The `names` vector must be of same length as the number of dimensions, in this case ",
+        length(unique(loadings$Component)),
+        "."
+      )
     )
   }
 
   cfa <- NULL
   # Iterate over dimensions
   for (i in seq_along(names)) {
-    cfa <- c(
-      cfa,
-      paste0(names[i], " =~ ", paste(as.character(loadings[loadings$Component == unique(loadings$Component)[i], "Variable"]), collapse = " + "))
-    )
+
+    # Find correct subset
+    items <- loadings[loadings$Component == unique(loadings$Component)[i], ]
+
+    # Find corresponding items
+    items <- as.character(loadings[loadings$Component == unique(loadings$Component)[i], "Variable"])
+
+    # Subset if need be to keep only a certain number
+    if (!is.null(max_per_dimension) && max_per_dimension > 0) {
+      items <- as.character(stats::na.omit(items[1:max_per_dimension]))
+    }
+
+    # Append that list
+    cfa <- c(cfa, paste0(names[i], " =~ ", paste(items, collapse = " + ")))
   }
 
   cfa <- paste0(cfa, collapse = "\n")

diff --git a/R/factor_analysis.R b/R/factor_analysis.R
@@ -24,7 +24,7 @@ factor_analysis.data.frame <- function(x,
                                        ...) {
   # Standardize
   if (standardize && is.null(cor)) {
-    x <- as.data.frame(scale(x))
+    x <- datawizard::standardize(x, ...)
   }
 
   # N factors

diff --git a/R/n_factors.R b/R/n_factors.R
@@ -130,15 +130,23 @@ n_factors <- function(x,
       package <- package[!package %in% c("pcdimension", "PCDimension")]
     } else if (is.matrix(x) || inherits(x, "easycormatrix")) {
       insight::format_error(
-        "Please input the correlation matrix via the `cor = ...` argument and the number of rows / observations via the first argument."
+        "Please input the correlation matrix via the `cor` argument and the number of rows / observations via the first argument."
       )
     }
   } else {
     nobs <- nrow(x)
   }
 
   # Get only numeric
-  x <- x[vapply(x, is.numeric, TRUE)]
+  numerics <- vapply(x, is.numeric, TRUE)
+  if (!all(numerics)) {
+    insight::format_warning(paste0(
+      "Some variables are not numeric (",
+      toString(names(x)[!numerics]),
+      "). Dropping them."
+    ))
+  }
+  x <- x[numerics]
 
   # Correlation matrix
   if (is.null(cor)) {
@@ -247,7 +255,7 @@ n_factors <- function(x,
       out <- rbind(
         out,
         tryCatch(.n_factors_ega(x, cor, nobs, eigen_values, type),
-          warning = function(w) data.frame(),
+          # warning = function(w) data.frame(),
           error = function(e) data.frame()
         )
       )
@@ -268,7 +276,7 @@ n_factors <- function(x,
       out <- rbind(
         out,
         tryCatch(.n_factors_vss(x, cor, nobs, type, rotation, algorithm),
-          warning = function(w) data.frame(),
+          # warning = function(w) data.frame(),
           error = function(e) data.frame()
         )
       )
@@ -300,7 +308,7 @@ n_factors <- function(x,
     }
   }
 
-  # fit -------------------------------------------
+  # pcdimension -------------------------------------------
   if ("pcdimension" %in% tolower(package)) {
     insight::check_if_installed("PCDimension")
 
@@ -564,6 +572,32 @@ print.n_clusters <- print.n_factors
 
 # psych ------------------------
 
+#' @keywords internal
+.n_factors_parallel <- function(x = NULL,
+                                cor = NULL,
+                                nobs = NULL,
+                                type = "FA") {
+
+  # Altnerative version of parralel analysis
+  # Not used because already included in nFactors
+
+  if (tolower(type) %in% c("fa", "factor", "efa")) {
+    fa <- "fa"
+  } else {
+    fa <- "pc"
+  }
+
+  insight::check_if_installed("psych")
+  out <- psych::fa.parallel(cor, n.obs = nobs, fa = fa, plot = FALSE, fm = "ml")
+
+
+  .data_frame(
+    n_Factors = as.numeric(stats::na.omit(c(out$nfact, out$ncomp))),
+    Method = "Parallel",
+    Family = "psych"
+  )
+}
+
 #' @keywords internal
 .n_factors_vss <- function(x = NULL,
                            cor = NULL,
@@ -580,6 +614,7 @@ print.n_clusters <- print.n_factors
   }
 
 
+  insight::check_if_installed("psych")
   # Compute VSS
   vss <- psych::VSS(
     cor,
@@ -631,6 +666,7 @@ print.n_clusters <- print.n_factors
     }
   }
 
+  insight::check_if_installed("psych")
   rez <- data.frame()
   for (n in 1:(ncol(cor) - 1)) {
     if (tolower(type) %in% c("fa", "factor", "efa")) {
@@ -738,7 +774,7 @@ print.n_clusters <- print.n_factors
 .n_factors_PCDimension <- function(x = NULL, type = "PCA") {
   # This package is a strict dependency of PCDimension so if users have the
   # former they should have it
-  insight::check_if_installed("ClassDiscovery")
+  insight::check_if_installed(c("ClassDiscovery", "PCDimension"))
 
   # Only applies to PCA with full data
   if (tolower(type) %in% c("fa", "factor", "efa") || !is.data.frame(x)) {

diff --git a/R/principal_components.R b/R/principal_components.R
@@ -420,10 +420,6 @@ principal_components.data.frame <- function(x,
   } else if (n >= ncol(x)) {
     n <- ncol(x) - 1
   }
-  # sanity check - we need at least two factors
-  if (n < 2 && ncol(x) >= 2) {
-    n <- 2
-  }
   n
 }
 

diff --git a/man/convert_efa_to_cfa.Rd b/man/convert_efa_to_cfa.Rd