Add scores to data (#215)

* fix degrees of freedom bug for configural invariance testing

* failing to get the scores to work

* try Joris changes

* add scores to data and also delete old added  scores

* add factor scores to data

* allow prefix for scores and requested error message

R/exploratoryfactoranalysis.R

@@ -45,7 +45,7 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
   .efaPathDiagram(       modelContainer, dataset, options, ready)
 
   # data saving
-  # .efaAddComponentsToData(jaspResults, modelContainer, options, ready)
+  .commonAddScoresToData(jaspResults, modelContainer, options, ready)
 }
 
 
@@ -892,17 +892,55 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
 
 }
 
-.efaAddComponentsToData <- function(jaspResults, modelContainer, options, ready) {
-  if(!ready || !options[["addPC"]] || options[["PCPrefix"]] == "" || modelContainer$getError()) return()
+
+.commonAddScoresToData <- function(jaspResults, modelContainer, options, ready) {
+
+  if (!ready ||
+      !is.null(jaspResults[["addedScoresContainer"]]) ||
+      modelContainer$getError() ||
+      !options[["addScores"]])
+  {
+    return()
+  }
+
+  colNamesR <- paste0(options[["addedScoresPrefix"]], "_", seq_len(length(options$variables)))
+
+  container    <- createJaspContainer()
+  container$dependOn(optionsFromObject = modelContainer, options = c("addScores", "addedScoresPrefix"))
 
   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(gettextf("Column name %s already exists in the dataset", colNameR))
+    }
+
+    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()
+
 }
+

R/principalcomponentanalysis.R

@@ -16,6 +16,7 @@
 #
 
 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
@@ -41,7 +42,8 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
   .pcaPathDiagram(        modelContainer, dataset, options, ready)
 
   # data saving
-  .pcaAddComponentsToData(jaspResults, modelContainer, options, ready)
+  .commonAddScoresToData(jaspResults, modelContainer, options, ready)
+
 }
 
 # Preprocessing functions ----
@@ -245,8 +247,11 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
     goodnessOfFitTable$addFootnote(message = gettext("Degrees of freedom below 0, model is unidentified."), symbol = gettext("<em>Warning:</em>"))
 }
 
+
 .pcaLoadingsTable <- function(modelContainer, dataset, options, ready) {
+
   if (!is.null(modelContainer[["loadingsTable"]])) return()
+
   loadingsTable <- createJaspTable(gettext("Component Loadings"))
   loadingsTable$dependOn(c("loadingsDisplayLimit", "componentLoadingsOrder"))
   loadingsTable$position <- 2
@@ -625,16 +630,3 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
 
 }
 
-.pcaAddComponentsToData <- function(jaspResults, modelContainer, options, ready) {
-  if(!ready || !options[["addComponentScores"]] || options[["componentsPrefix"]] == "" || modelContainer$getError()) return()
-
-  scores <- modelContainer[["model"]][["object"]][["scores"]]
-  for (i in 1:ncol(scores)) {
-    scorename <- paste0(options[["componentsPrefix"]], "_", i)
-    if (is.null(jaspResults[[scorename]])) {
-      jaspResults[[scorename]] <- createJaspColumn(scorename)
-      jaspResults[[scorename]]$dependOn(optionsFromObject = modelContainer)
-      jaspResults[[scorename]]$setScale(scores[, i])
-    }
-  }
-}

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 
 ---

inst/qml/ConfirmatoryFactorAnalysis.qml

@@ -279,12 +279,12 @@ Form
 		{
 			title: qsTr("Options")
 			debug: true
-			CheckBox { label: qsTr("Fix manifest intercepts to zero")	; name: "manifestInterceptsFixedToZero" }
+			CheckBox { label: qsTr("Fix manifest intercepts to zero")	; 	name: "manifestInterceptsFixedToZero" }
 			CheckBox { label: qsTr("Fix latent intercepts to zero")   	; name: "latentInterceptsFixedToZero";		checked: true }
 			CheckBox { label: qsTr("Omit residual single indicator")  	; name: "residualSingleIndicatorOmitted";	checked: true }
 			CheckBox { label: qsTr("Residual variances")              	; name: "residualVariances";				checked: true }
 			CheckBox { label: qsTr("Correlate exogenous latents")     	; name: "exogenousLatentsCorrelated";		checked: true }
-			CheckBox { label: qsTr("Add thresholds")                 	; name: "thresholds";						checked: true }
+			CheckBox { label: qsTr("Add thresholds")                 	; 	name: "thresholds";						checked: true }
 			CheckBox { label: qsTr("Add scalings parameters")         	; name: "scalingParamaters";				checked: true }
 			CheckBox { label: qsTr("Correlate dependent variables")   	; name: "dependentVariablesCorrelated";		checked: true }
 		}

inst/qml/ExploratoryFactorAnalysis.qml

@@ -261,5 +261,21 @@ Form
 			RadioButton { value: "pairwise";	label: qsTr("Exclude cases pairwise"); checked: true	}
 			RadioButton { value: "listwise";	label: qsTr("Exclude cases listwise")					}
 		}
+
+		CheckBox
+		{
+			id: addScores
+			name: "addScores"
+			label: qsTr("Add FA scores to data")
+			enabled: variables.count > 1
+
+			TextField {
+				name: "addedScoresPrefix"
+				label: qsTr("Prefix")
+				defaultValue: "FA"
+				fieldWidth: 80
+				enabled: addScores.checked
+			}
+		}
 	}
 }

inst/qml/PrincipalComponentAnalysis.qml

@@ -161,8 +161,6 @@ Form
 			value: 0.4
 		}
 
-		Group
-		{
 			RadioButtonGroup
 			{
 				name: "componentLoadingsOrder"
@@ -216,7 +214,6 @@ Form
 					}
 				}
 			}
-		}
 
 		Group
 		{
@@ -234,21 +231,21 @@ Form
 			RadioButton { value: "listwise";		label: qsTr("Exclude cases listwise")					}
 		}
 
-
 		CheckBox
 		{
-			debug: true
-			id: addPC
-			name: "addComponentScores"
-			text: qsTr("Add PC scores to data")
+			id: addScores
+			name: "addScores"
+			label: qsTr("Add PC scores to data")
 			enabled: variables.count > 1
 
-			ComputedColumnField {
-				name: 		"componentsPrefix"
-				text: 		"Prefix: "
-				fieldWidth: 120
-				visible:    addPC.checked
+			TextField {
+				name: "addedScoresPrefix"
+				label: qsTr("Prefix")
+				defaultValue: "PC"
+				fieldWidth: 80
+				enabled: addScores.checked
 			}
 		}
+
 	}
 }