add factor scores to data

jasp-stats · May 7, 2024 · 0edbee4 · 0edbee4
1 parent 1980f5d
commit 0edbee4
Show file tree

Hide file tree

Showing 4 changed files with 83 additions and 39 deletions.
diff --git a/R/exploratoryfactoranalysis.R b/R/exploratoryfactoranalysis.R
@@ -45,7 +45,7 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
   .efaPathDiagram(       modelContainer, dataset, options, ready)
 
   # data saving
-  # .efaAddComponentsToData(jaspResults, modelContainer, options, ready)
+  .efaAddFactorsToData(jaspResults, modelContainer, options, ready)
 }
 
 
@@ -892,17 +892,54 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
 
 }
 
-.efaAddComponentsToData <- function(jaspResults, modelContainer, options, ready) {
-  if(!ready || !options[["addPC"]] || options[["PCPrefix"]] == "" || modelContainer$getError()) return()
+.efaAddFactorsToData <- function(jaspResults, modelContainer, options, ready) {
+
+  if (!ready ||
+      !is.null(jaspResults[["addedScoresContainer"]]) ||
+      modelContainer$getError() ||
+      !options[["addFactorScores"]])
+  {
+    return()
+  }
+
+  colNamesR <- gettextf("Factor_%s", seq_len(length(options$variables)))
+
+  container    <- createJaspContainer()
+  container$dependOn(optionsFromObject = modelContainer, options = "addFactorScores")
 
   scores <- modelContainer[["model"]][["object"]][["scores"]]
 
-  for (i in 1:ncol(scores)) {
-    scorename <- paste0(options[["PCPrefix"]], "_", i)
-    if (is.null(jaspResults[[scorename]])) {
-      jaspResults[[scorename]] <- createJaspColumn(scorename)
-      jaspResults[[scorename]]$dependOn(optionsFromObject = modelContainer)
-      jaspResults[[scorename]]$setScale(scores[, i])
+  for (ii in seq_len(ncol(scores))) {
+
+    colNameR <- colNamesR[ii]
+
+    if (jaspBase:::columnExists(colNameR) && !jaspBase:::columnIsMine(colNameR)) {
+      .quitAnalysis(gettext("Column name already exists in the dataset"))
     }
+
+    container[[colNameR]] <- jaspBase::createJaspColumn(colNameR)
+    container[[colNameR]]$setScale(scores[, ii])
   }
+
+  jaspResults[["addedScoresContainer"]] <- container
+
+  # check if there are previous colNames that are not needed anymore and delete the cols
+  oldNames <- jaspResults[["createdColumnNames"]][["object"]]
+  newNames <- colNamesR[1:ii]
+  if (!is.null(oldNames)) {
+    noMatch <- which(!(oldNames %in% newNames))
+    if (length(noMatch) > 0) {
+      for (i in 1:length(noMatch)) {
+        jaspBase:::columnDelete(oldNames[noMatch[i]])
+      }
+    }
+  }
+
+  # save the created col names
+  jaspResults[["createdColumnNames"]] <- createJaspState(newNames)
+
+
+  return()
+
 }
+
diff --git a/R/principalcomponentanalysis.R b/R/principalcomponentanalysis.R
@@ -17,9 +17,6 @@
 
 principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ...) {
 
-  # sink(file="~/Downloads/log.txt")
-  # on.exit(sink(NULL))
-
   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
@@ -636,50 +633,49 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
 
   if (!ready ||
       !is.null(jaspResults[["addedScoresContainer"]]) ||
-      modelContainer$getError())
+      modelContainer$getError() ||
+      !options[["addComponentScores"]])
       {
     return()
   }
 
   colNamesR <- gettextf("Component_%s", seq_len(length(options$variables)))
 
-  if (options[["addComponentScores"]]) {
+  container    <- createJaspContainer()
+  container$dependOn(optionsFromObject = modelContainer, options = "addComponentScores")
 
-    container    <- createJaspContainer()
-    container$dependOn(optionsFromObject = modelContainer)
+  scores <- modelContainer[["model"]][["object"]][["scores"]]
 
-    scores <- modelContainer[["model"]][["object"]][["scores"]]
+  for (ii in seq_len(ncol(scores))) {
 
-    for (ii in seq_len(ncol(scores))) {
+    colNameR <- colNamesR[ii]
 
-      colNameR <- colNamesR[ii]
+    if (jaspBase:::columnExists(colNameR) && !jaspBase:::columnIsMine(colNameR)) {
+      .quitAnalysis(gettext("Column name already exists in the dataset"))
+    }
 
-      if (jaspBase:::columnExists(colNameR) && !jaspBase:::columnIsMine(colNameR)) {
-        .quitAnalysis(gettext("Column name already exists in the dataset"))
-      }
+    container[[colNameR]] <- jaspBase::createJaspColumn(colNameR)
+    container[[colNameR]]$setScale(scores[, ii])
+  }
 
-      container[[colNameR]] <- jaspBase::createJaspColumn(colNameR)
-      container[[colNameR]]$setScale(scores[, ii])
-    }
+  jaspResults[["addedScoresContainer"]] <- container
 
-    jaspResults[["addedScoresContainer"]] <- container
-
-    # check if there are previous colNames that are not needed anymore and delete the cols
-    oldNames <- jaspResults[["createdColumnNames"]][["object"]]
-    newNames <- colNamesR[1:ii]
-    if (!is.null(oldNames)) {
-      noMatch <- which(!(oldNames %in% newNames))
-      if (length(noMatch) > 0) {
-        for (i in 1:length(noMatch)) {
-          jaspBase:::columnDelete(oldNames[noMatch[i]])
-        }
+  # check if there are previous colNames that are not needed anymore and delete the cols
+  oldNames <- jaspResults[["createdColumnNames"]][["object"]]
+  newNames <- colNamesR[1:ii]
+  if (!is.null(oldNames)) {
+    noMatch <- which(!(oldNames %in% newNames))
+    if (length(noMatch) > 0) {
+      for (i in 1:length(noMatch)) {
+        jaspBase:::columnDelete(oldNames[noMatch[i]])
       }
     }
-
-    # save the created col names
-    jaspResults[["createdColumnNames"]] <- createJaspState(newNames)
   }
 
+  # save the created col names
+  jaspResults[["createdColumnNames"]] <- createJaspState(newNames)
+
+
   return()
 
 }

diff --git a/inst/help/ExploratoryFactorAnalysis.md b/inst/help/ExploratoryFactorAnalysis.md
@@ -68,6 +68,8 @@ With Exploratory Factor Analysis it is possible to identify one or more factors
 - Missing values: 
     - Exclude cases pairwise: If one observation from a variable is missing, all the other variable observations from the same case will still be used for the analysis. In this scenario, it is not necessary to have an observation for all the variables to include the case in the analysis. This option is selected by default. 
     - Exclude cases listwise: If one observation from a variable is missing, the whole case, so all the other connected variable observations, will be dismissed from the analysis. In this scenario, observations for every variable are needed to include the case in the analysis. 
+- Add FA scores to data: Adds the estimated factor scores as new columns to the data set
+
 
 ### Output 
 ---

diff --git a/inst/qml/ExploratoryFactorAnalysis.qml b/inst/qml/ExploratoryFactorAnalysis.qml
@@ -261,5 +261,14 @@ Form
 			RadioButton { value: "pairwise";	label: qsTr("Exclude cases pairwise"); checked: true	}
 			RadioButton { value: "listwise";	label: qsTr("Exclude cases listwise")					}
 		}
+
+		CheckBox
+		{
+			id: addFA
+			name: "addFactorScores"
+			text: qsTr("Add FA scores to data")
+			enabled: variables.count > 1
+
+		}
 	}
 }