cov matrix input for PCA and EFA

jasp-stats · Oct 15, 2024 · 3f023f7 · 3f023f7
1 parent 70e1f71
commit 3f023f7
Show file tree

Hide file tree

Showing 12 changed files with 3,425 additions and 203 deletions.
diff --git a/.Rprofile b/.Rprofile
@@ -0,0 +1 @@
+source("renv/activate.R")
diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R
@@ -14,11 +14,6 @@
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 #
 
-# This is a temporary fix
-# TODO: remove it when R will solve this problem!
-gettextf <- function(fmt, ..., domain = NULL)  {
-  return(sprintf(gettext(fmt, domain = domain), ...))
-}
 
 confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...) {
   jaspResults$addCitation("Rosseel, Y. (2012). lavaan: An R Package for Structural Equation Modeling. Journal of Statistical Software, 48(2), 1-36. URL http://www.jstatsoft.org/v48/i02/")
@@ -64,6 +59,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 
 # Preprocessing functions ----
 .cfaReadData <- function(dataset, options) {
+
   if (!is.null(dataset)) return(dataset)
 
   # NOTE: The GUI does not yet allow for putting the same variable in different factors.

diff --git a/R/exploratoryfactoranalysis.R b/R/exploratoryfactoranalysis.R
@@ -19,8 +19,9 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
   jaspResults$addCitation("Revelle, W. (2018) psych: Procedures for Personality and Psychological Research, Northwestern University, Evanston, Illinois, USA, https://CRAN.R-project.org/package=psych Version = 1.8.12.")
 
   # Read dataset
-  dataset <- .efaReadData(dataset, options)
+  dataset <- .pcaAndEfaReadData(dataset, options)
   ready   <- length(options$variables) > 1
+  dataset <- .pcaAndEfaDataCovariance(dataset, options)
 
   if (ready)
     .efaCheckErrors(dataset, options)
@@ -49,16 +50,6 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
 }
 
 
-.efaReadData <- function(dataset, options) {
-  if (!is.null(dataset)) return(dataset)
-
-  if (options[["naAction"]] == "listwise") {
-    return(.readDataSetToEnd(columns.as.numeric = unlist(options$variables), exclude.na.listwise = unlist(options$variables)))
-  } else {
-    return(.readDataSetToEnd(columns.as.numeric = unlist(options$variables)))
-  }
-}
-
 .efaCheckErrors <- function(dataset, options) {
   customChecksEFA <- list(
     function() {
@@ -101,10 +92,20 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
       if (all(S == 1)) {
         return(gettext("Data not valid: all variables are collinear"))
       }
+    },
+    function() {
+      if (ncol(dataset) > 0 && !nrow(dataset) > ncol(dataset)) {
+        return(gettext("Not more cases than number of variables. Is your data a variance-covariance matrix?"))
+      }
     }
   )
-  error <- .hasErrors(dataset = dataset, type = c("infinity", "variance"), custom = customChecksEFA,
-                      exitAnalysisIfErrors = TRUE)
+
+  if (options[["dataType"]] == "raw") {
+    error <- .hasErrors(dataset = dataset, type = c("infinity", "variance"), custom = customChecksEFA,
+                        exitAnalysisIfErrors = TRUE)
+  }
+
+
   return()
 }
 
@@ -115,7 +116,7 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
     modelContainer <- createJaspContainer()
     modelContainer$dependOn(c("rotationMethod", "orthogonalSelector", "obliqueSelector", "variables", "factorCountMethod",
                               "eigenValuesAbove", "manualNumberOfFactors", "naAction", "analysisBasedOn", "factoringMethod",
-                              "parallelAnalysisMethod"))
+                              "parallelAnalysisMethod", "dataType", "sampleSize"))
     jaspResults[["modelContainer"]] <- modelContainer
   }
 
@@ -143,7 +144,6 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
                             "minimumChiSquare"        = "minchi",
                             "minimumRank"             = "minrank"
                             )
-
   efaResult <- try(
     psych::fa(
       r        = dataset,
@@ -152,7 +152,8 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
       scores   = TRUE,
       covar    = options$analysisBasedOn == "covarianceMatrix",
       cor      = corMethod,
-      fm       = factoringMethod
+      fm       = factoringMethod,
+      n.obs    = ifelse(options[["dataType"]] == "raw", NULL, options[["sampleSize"]])
     )
   )
 

diff --git a/R/principalcomponentanalysis.R b/R/principalcomponentanalysis.R
@@ -20,12 +20,15 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults$addCitation("Revelle, W. (2018) psych: Procedures for Personality and Psychological Research, Northwestern University, Evanston, Illinois, USA, https://CRAN.R-project.org/package=psych Version = 1.8.12.")
 
   # Read dataset
-  dataset <- .pcaReadData(dataset, options)
+  dataset <- .pcaAndEfaReadData(dataset, options)
   ready   <- length(options$variables) > 1
 
+  dataset <- .pcaAndEfaDataCovariance(dataset, options)
+
   if (ready)
     .pcaCheckErrors(dataset, options)
 
+
   modelContainer <- .pcaModelContainer(jaspResults)
 
   # output functions
@@ -47,17 +50,52 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
 }
 
 # Preprocessing functions ----
-.pcaReadData <- function(dataset, options) {
+.pcaAndEfaReadData <- function(dataset, options) {
+
+  # browser()
   if (!is.null(dataset)) return(dataset)
 
-  if (options[["naAction"]] == "listwise") {
-    return(.readDataSetToEnd(columns.as.numeric = unlist(options$variables), exclude.na.listwise = unlist(options$variables)))
-  } else {
-    return(.readDataSetToEnd(columns.as.numeric = unlist(options$variables)))
+  if (options[["dataType"]] == "raw") {
+    if (options[["naAction"]] == "listwise") {
+      return(.readDataSetToEnd(columns.as.numeric = unlist(options$variables), exclude.na.listwise = unlist(options$variables)))
+    } else {
+
+      return(.readDataSetToEnd(columns.as.numeric = unlist(options$variables)))
+    }
+  } else { # if variance covariance matrix as input
+    return(.readDataSetToEnd(all.columns = TRUE))
+  }
+
+}
+
+.pcaAndEfaDataCovariance <- function(dataset, options) {
+
+  if (options[["dataType"]] == "raw") {
+    return(dataset)
+  }
+  usedvars <- unlist(options[["variables"]])
+  var_idx  <- match(usedvars, colnames(dataset))
+  mat <- try(as.matrix(dataset[var_idx, var_idx]))
+  if (inherits(mat, "try-error") || any(is.na(mat)))
+    .quitAnalysis("Input data does not seem to be a covariance matrix! Please check the format of the input data.
+                   All cells must be numeric, and the number of rows must equal the number of columns.")
+  .hasErrors(mat, type = "varCovMatrix", message='default', exitAnalysisIfErrors = TRUE)
+
+  colnames(mat) <- rownames(mat) <- colnames(dataset)[var_idx]
+
+  if (anyNA(mat)) {
+    inds <- which(is.na(mat))
+    mat <- mat[-inds, -inds]
+    if (ncol(mat) < 3) {
+      .quitAnalysis("Not enough valid columns to run this analysis")
+    }
   }
+  return(mat)
 }
 
+
 .pcaCheckErrors <- function(dataset, options) {
+
   customChecksPCAEFA <- list(
     function() {
       if (length(options$variables) > 0 && options$componentCountMethod == "manual" &&
@@ -99,10 +137,19 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
       if (all(S == 1)) {
         return(gettext("Data not valid: all variables are collinear"))
       }
+    },
+    function() {
+      if (ncol(dataset) > 0 && !nrow(dataset) > ncol(dataset)) {
+        return(gettext("Not more cases than number of variables. Is your data a variance-covariance matrix?"))
+      }
     }
   )
-  error <- .hasErrors(dataset = dataset, type = c("infinity", "variance"), custom = customChecksPCAEFA,
-                      exitAnalysisIfErrors = TRUE)
+
+  if (options[["dataType"]] == "raw") {
+    error <- .hasErrors(dataset = dataset, type = c("infinity", "variance"), custom = customChecksPCAEFA,
+                        exitAnalysisIfErrors = TRUE)
+  }
+
   return()
 }
 
@@ -113,7 +160,7 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
     modelContainer <- createJaspContainer()
     modelContainer$dependOn(c("rotationMethod", "orthogonalSelector", "obliqueSelector", "variables", "componentCountMethod",
                               "eigenValuesAbove", "manualNumberOfComponents", "naAction", "analysisBasedOn",
-                              "parallelAnalysisMethod"))
+                              "parallelAnalysisMethod", "dataType", "sampleSize"))
     jaspResults[["modelContainer"]] <- modelContainer
   }
 
@@ -148,15 +195,15 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
                       "correlationMatrix" = "cor",
                       "covarianceMatrix" = "cov",
                       "polyTetrachoricCorrelationMatrix" = "mixed")
-
   pcaResult <- try(
     psych::principal(
       r        = dataset,
       nfactors = .pcaGetNComp(dataset, options, modelContainer),
       rotate   = rotate,
       scores   = TRUE,
       covar    = options$analysisBasedOn == "covarianceMatrix",
-      cor      = corMethod
+      cor      = corMethod,
+      n.obs    = ifelse(options[["dataType"]] == "raw", NULL, options[["sampleSize"]])
     ))
 
   if (isTryError(pcaResult)) {
@@ -237,12 +284,13 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
 
   pcaResults <- .pcaComputeResults(modelContainer, dataset, options)
   if (modelContainer$getError()) return()
-
   goodnessOfFitTable[["model"]] <- "Model"
+
   goodnessOfFitTable[["chisq"]] <- pcaResults$STATISTIC
   goodnessOfFitTable[["df"]]    <- pcaResults$dof
   goodnessOfFitTable[["p"]]     <- pcaResults$PVAL
 
+
   if (pcaResults$dof < 0)
     goodnessOfFitTable$addFootnote(message = gettext("Degrees of freedom below 0, model is unidentified."), symbol = gettext("<em>Warning:</em>"))
 }
@@ -630,3 +678,4 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
 
 }
 
+
diff --git a/inst/qml/ConfirmatoryFactorAnalysis.qml b/inst/qml/ConfirmatoryFactorAnalysis.qml
@@ -30,6 +30,22 @@ Form
 		allowedColumns:		["ordinal", "scale"]
 		allowTypeChange:	true
 	}
+	Group 
+	{
+		// columns: 4
+		title: qsTr("Data")
+		RadioButtonGroup
+		{
+			name: "dataType"
+			columns: 2
+			RadioButton { value: "raw"; label: qsTr("Raw"); checked: true }
+			RadioButton
+			{
+				value: "varianceCovariance"; label: qsTr("Variance-covariance matrix")
+				IntegerField { name: "sampleSize"; label: qsTr("Sample size"); defaultValue: 200 }
+			}
+		}
+	}
 
 	Section
 	{

diff --git a/inst/qml/ExploratoryFactorAnalysis.qml b/inst/qml/ExploratoryFactorAnalysis.qml
@@ -24,7 +24,7 @@ Form
 
 	VariablesForm
 	{
-		preferredHeight: jaspTheme.smallDefaultVariablesFormHeight
+		// preferredHeight: jaspTheme.smallDefaultVariablesFormHeight
 		AvailableVariablesList { name: "allVariablesList" }
 		AssignedVariablesList
 		{
@@ -33,6 +33,22 @@ Form
 			title: qsTr("Variables")
 			allowedColumns: ["scale"]
 		}
+			Group 
+		{
+			// columns: 4
+			title: qsTr("Data")
+			RadioButtonGroup
+			{
+				name: "dataType"
+				columns: 2
+				RadioButton { value: "raw"; label: qsTr("Raw"); checked: true }
+				RadioButton
+				{
+					value: "varianceCovariance"; label: qsTr("Variance-covariance matrix")
+					IntegerField { name: "sampleSize"; label: qsTr("Sample size"); defaultValue: 200 }
+				}
+			}
+		}
 	}
 
 	Group

diff --git a/inst/qml/PrincipalComponentAnalysis.qml b/inst/qml/PrincipalComponentAnalysis.qml
@@ -24,7 +24,7 @@ Form
 {
 	VariablesForm
 	{
-		preferredHeight: jaspTheme.smallDefaultVariablesFormHeight
+		// preferredHeight: jaspTheme.smallDefaultVariablesFormHeight
 		AvailableVariablesList { name: "allVariablesList" }
 		AssignedVariablesList
 		{
@@ -33,6 +33,22 @@ Form
 			title: qsTr("Variables")
 			allowedColumns: ["scale"]
 		}
+		Group 
+		{
+			// columns: 4
+			title: qsTr("Data")
+			RadioButtonGroup
+			{
+				name: "dataType"
+				columns: 2
+				RadioButton { value: "raw"; label: qsTr("Raw"); checked: true }
+				RadioButton
+				{
+					value: "varianceCovariance"; label: qsTr("Variance-covariance matrix")
+					IntegerField { name: "sampleSize"; label: qsTr("Sample size"); defaultValue: 200 }
+				}
+			}
+		}
 	}