save factor scores to data in CFA

jasp-stats · Jan 7, 2025 · 4ce65c9 · 4ce65c9
1 parent c560f60
commit 4ce65c9
Show file tree

Hide file tree

Showing 5 changed files with 1,105 additions and 465 deletions.
diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R
@@ -16,6 +16,7 @@
 
 
 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/")
 
 
@@ -59,6 +60,9 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   # Output model syntax
   .cfaSyntax(jaspResults, options, dataset, cfaResult) # Output model syntax to user
 
+  # add factor scores to data
+  .cfaAddScoresToData(jaspResults, options, cfaResult, dataset)
+
   return()
 }
 
@@ -637,6 +641,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 }
 
 .cfaTableRsquared <- function(jaspResults, options, cfaResult) {
+
   if (!options$rSquared || !is.null(jaspResults[["maincontainer"]][["rSquared"]])) return()
 
   jaspResults[["maincontainer"]][["rSquared"]] <- tabr2 <- createJaspTable(gettext("R-Squared"))
@@ -795,6 +800,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 }
 
 .cfaParEstToTablesHelper <- function(pei, options, cfaResult, jrobject, footnote) {
+
   pei <- as.data.frame(pei)
   facNames <- c(cfaResult[["spec"]]$latents)
 
@@ -1632,3 +1638,82 @@ lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL)
 
   return(fit)
 }
+
+
+.cfaAddScoresToData <- function(jaspResults, options, cfaResult, dataset) {
+
+  if (!is.null(jaspResults[["addedScoresContainer"]]) ||
+      is.null(cfaResult) ||
+      !options[["addScores"]] ||
+      options[["dataType"]] == "varianceCovariance")
+  {
+    return()
+  }
+
+
+  container    <- createJaspContainer()
+  container$dependOn(optionsFromObject = jaspResults[["maincontainer"]], options = c("addScores", "addedScoresPrefix",
+                                                                                     "naAction", "factors",
+                                                                                     "secondOrder"))
+
+  scores <- lavaan::lavPredict(cfaResult[["lav"]])
+  facNames <- cfaResult[["spec"]]$latents
+  facNames <- .translateFactorNames(facNames, options)
+  if (length(options$secondOrder) > 0)
+    facNames <- c(facNames, gettext("Second-Order"))
+
+  if (options$group != "") {
+    groupLabs <- cfaResult[["lav"]]@Data@group.label
+    colNamesR <- paste0(rep(groupLabs, each = ncol(scores[[1]])), "_", options[["addedScoresPrefix"]], "_", facNames)
+  } else {
+    colNamesR <- paste0(options[["addedScoresPrefix"]], "_", facNames)
+    scores <- list(scores)
+  }
+
+  z <- 1
+  for (ll in seq_len(length(scores))) {
+    for (ii in seq_len(ncol(scores[[ll]]))) {
+
+      colNameR <- colNamesR[z]
+      scoresTmp <- scores[[ll]]
+      if (jaspBase:::columnExists(colNameR) && !jaspBase:::columnIsMine(colNameR)) {
+        .quitAnalysis(gettextf("Column name %s already exists in the dataset", colNameR))
+      }
+
+      container[[colNameR]] <- jaspBase::createJaspColumn(colNameR)
+      if (options[["naAction"]] != "listwise") {
+        container[[colNameR]]$setScale(scoresTmp[, ii])
+      } else { # for listwise we need to identify the complete cases
+        # so we need to temporarily load the raw data with the NAs
+        dataTmp <- dataset
+        scoresTmpTmp <- rep(NA, nrow(dataTmp))
+        scoresTmpTmp[complete.cases(dataTmp)] <- scoresTmp[, ii]
+        container[[colNameR]]$setScale(scoresTmpTmp)
+
+      }
+      z <- z + 1
+
+    }
+  }
+
+  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/exploratoryfactoranalysis.R b/R/exploratoryfactoranalysis.R
@@ -46,7 +46,7 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
   .efaPathDiagram(       modelContainer, dataset, options, ready)
 
   # data saving
-  .commonAddScoresToData(jaspResults, modelContainer, options, ready)
+  .pcaAndEfaAddScoresToData(jaspResults, modelContainer, options, ready)
 }
 
 
@@ -907,64 +907,3 @@ exploratoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...
 }
 
 
-.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", "naAction"))
-
-  scores <- modelContainer[["model"]][["object"]][["scores"]]
-
-  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)
-    if (options[["naAction"]] == "pairwise") {
-      container[[colNameR]]$setScale(scores[, ii])
-    } else { # for listwise we need to identify the complete cases
-      # so we need to temporarily load the raw data with the NAs
-      dataTmp <- .readDataSetToEnd(columns.as.numeric = unlist(options$variables))
-      scoresTmp <- rep(NA, nrow(dataTmp))
-      scoresTmp[complete.cases(dataTmp)] <- scores[, ii]
-      container[[colNameR]]$setScale(scoresTmp)
-
-    }
-
-  }
-
-  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
@@ -46,7 +46,7 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
   .pcaPathDiagram(        modelContainer, dataset, options, ready)
 
   # data saving
-  .commonAddScoresToData(jaspResults, modelContainer, options, ready)
+  .pcaAndEfaAddScoresToData(jaspResults, modelContainer, options, ready)
 
 }
 
@@ -694,3 +694,66 @@ principalComponentAnalysisInternal <- function(jaspResults, dataset, options, ..
 }
 
 
+.pcaAndEfaAddScoresToData <- function(jaspResults, modelContainer, options, ready) {
+
+  if (!ready ||
+      !is.null(jaspResults[["addedScoresContainer"]]) ||
+      modelContainer$getError() ||
+      !options[["addScores"]] ||
+      options[["dataType"]] == "varianceCovariance")
+  {
+    return()
+  }
+
+  colNamesR <- paste0(options[["addedScoresPrefix"]], "_", seq_len(length(options$variables)))
+
+  container    <- createJaspContainer()
+  container$dependOn(optionsFromObject = modelContainer, options = c("addScores", "addedScoresPrefix", "naAction"))
+
+  scores <- modelContainer[["model"]][["object"]][["scores"]]
+
+  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)
+    if (options[["naAction"]] == "pairwise") {
+      container[[colNameR]]$setScale(scores[, ii])
+    } else { # for listwise we need to identify the complete cases
+      # so we need to temporarily load the raw data with the NAs
+      dataTmp <- .readDataSetToEnd(columns.as.numeric = unlist(options$variables))
+      scoresTmp <- rep(NA, nrow(dataTmp))
+      scoresTmp[complete.cases(dataTmp)] <- scores[, ii]
+      container[[colNameR]]$setScale(scoresTmp)
+
+    }
+
+  }
+
+  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/inst/qml/ConfirmatoryFactorAnalysis.qml b/inst/qml/ConfirmatoryFactorAnalysis.qml
@@ -169,13 +169,13 @@ Form
 		title: qsTr("Additional Output")
 		Group
 		{
-			CheckBox { label: qsTr("Additional fit measures")   ; name: "fitMeasures"   }
-			CheckBox { label: qsTr("Kaiser-Meyer-Olkin (KMO) test"); name: "kaiserMeyerOlkinTest"}
-			CheckBox { label: qsTr("Bartlett's test of sphericity"); name: "bartlettTest"}
-			CheckBox { label: qsTr("R-Squared")                 ; name: "rSquared"         }
-			CheckBox { name: "ave";						label: qsTr("Average variance extracted (AVE)")		}
-			CheckBox { name: "htmt";					label: qsTr("Heterotrait-monotrait ratio (HTMT)")	}
-			CheckBox { name: "reliability";		label: qsTr("Reliability")					}
+			CheckBox { name: "fitMeasures"; 					label: qsTr("Additional fit measures") 						}
+			CheckBox { name: "kaiserMeyerOlkinTest"; 	label: qsTr("Kaiser-Meyer-Olkin (KMO) test") 			}
+			CheckBox { name: "bartlettTest"; 					label: qsTr("Bartlett's test of sphericity")	 		}
+			CheckBox { name: "rSquared"; 							label: qsTr("R-Squared")										      }
+			CheckBox { name: "ave";										label: qsTr("Average variance extracted (AVE)")		}
+			CheckBox { name: "htmt";									label: qsTr("Heterotrait-monotrait ratio (HTMT)")	}
+			CheckBox { name: "reliability";						label: qsTr("Reliability")												}
 		}
 		Group
 		{
@@ -191,7 +191,23 @@ Form
 					defaultValue: 3.84
 				}
 			}
-			CheckBox { label: qsTr("Show lavaan syntax")         ; name: "lavaanSyntax" }
+			CheckBox { name: "lavaanSyntax"; label: qsTr("Show lavaan syntax") }
+
+			CheckBox
+			{
+				id: addScores
+				name: "addScores"
+				label: qsTr("Add factor scores to data")
+				enabled: variables.count > 1 & dataType.value == "raw"
+
+				TextField {
+					name: "addedScoresPrefix"
+					label: qsTr("Prefix")
+					defaultValue: "FS"
+					fieldWidth: 80
+					enabled: addScores.checked
+				}
+			}
 		}
 	}