fix data reading (#232)

* fix data reading * fix unit tests
jasp-stats · Jul 12, 2024 · 17c1bd9 · 17c1bd9
1 parent c25436d
commit 17c1bd9
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 34 deletions.
diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R
@@ -66,12 +66,28 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 .cfaReadData <- function(dataset, options) {
   if (!is.null(dataset)) return(dataset)
 
-  vars <- unique(unlist(lapply(options$factors, function(x) x$indicators)))
-  if (options$group == "") {
-    return(.readDataSetToEnd(columns = vars))
-  } else {
-    return(.readDataSetToEnd(columns = vars, columns.as.factor = options$group))
-  }
+  # NOTE: The GUI does not yet allow for putting the same variable in different factors.
+  # if the same variable is used twice but with a different type then this would
+  # crash the R code. However, since this is not possible yet, this should be okay for now
+  vars  <- unlist(lapply(options[["factors"]], `[[`, "indicators"),       use.names = FALSE)
+  types <- unlist(lapply(options[["factors"]], `[[`, "types"),            use.names = FALSE)
+
+  if (length(vars) == 0)
+    return(data.frame())
+
+  duplicateVars <- duplicated(vars)
+  vars  <- vars[!duplicateVars]
+  types <- types[!duplicateVars]
+
+  splitVars <- split(vars, types)
+  groupVar <- if (options[["group"]] == "") NULL else options[["group"]]
+
+  return(.readDataSetToEnd(
+    columns.as.numeric = splitVars[["scale"]],
+    columns.as.ordinal = splitVars[["ordinal"]],
+    columns.as.factor  = groupVar
+  ))
+
 }
 
 .cfaPreprocessOptions <- function(options) {

diff --git a/inst/qml/ConfirmatoryFactorAnalysis.qml b/inst/qml/ConfirmatoryFactorAnalysis.qml
@@ -24,9 +24,11 @@ Form
 
 	FactorsForm
 	{
-		id: factors
-		name: "factors"
-		initNumberFactors: 1
+		id:					factors
+		name:				"factors"
+		initNumberFactors:	1
+		allowedColumns:		["ordinal", "scale"]
+		allowTypeChange:	true
 	}
 
 	Section

diff --git a/tests/testthat/test-confirmatoryfactoranalysis.R b/tests/testthat/test-confirmatoryfactoranalysis.R
@@ -9,9 +9,9 @@ options$seType <- "standard"
 options$estimator <- "default"
 options$standardized <- "none"
 options$factors <- list(
-  list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1"),
-  list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2"),
-  list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3")
+  list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1", types = rep("scale", 3)),
+  list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2", types = rep("scale", 3)),
+  list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3", types = rep("scale", 3))
 )
 options$modelIdentification <- "factorVariance"
 options$naAction <- "listwise"
@@ -119,9 +119,9 @@ options$seType <- "standard"
 options$estimator <- "default"
 options$standardized <- "none"
 options$factors <- list(
-  list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1"),
-  list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2"),
-  list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3")
+  list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1", types = rep("scale", 3)),
+  list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2", types = rep("scale", 3)),
+  list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3", types = rep("scale", 3))
 )
 options$modelIdentification <- "factorVariance"
 options$naAction <- "listwise"
@@ -211,9 +211,9 @@ test_that("Bootstrapping works", {
   options$estimator <- "default"
   options$standardized <- "none"
   options$factors <- list(
-    list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1"),
-    list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2"),
-    list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3")
+    list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1", types = rep("scale", 3)),
+    list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2", types = rep("scale", 3)),
+    list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3", types = rep("scale", 3))
   )
   options$modelIdentification <- "factorVariance"
   options$naAction <- "listwise"
@@ -269,9 +269,9 @@ options$seType <- "standard"
 options$estimator <- "default"
 options$standardized <- "none"
 options$factors <- list(
-  list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "visual"),
-  list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "textual"),
-  list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "speed")
+  list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "visual",  types = rep("scale", 3)),
+  list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "textual", types = rep("scale", 3)),
+  list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "speed",   types = rep("scale", 3))
 )
 options$modelIdentification <- "effectsCoding"
 options$residualsCovarying <-  list(c("x7", "x8"))
@@ -431,10 +431,8 @@ options$packageMimiced <- "lavaan"
 options$seType <- "robust"
 options$estimator <- "default"
 options$factors <- list(
-  list(indicators = list("V1", "V2", "V3", "V4"),
-       name = "Factor1", title = "Factor 1"),
-  list(indicators = list("V5", "V6", "V7", "V8"),
-       name = "Factor2", title = "Factor 2")
+  list(indicators = list("V1", "V2", "V3", "V4"), name = "Factor1", title = "Factor 1", types = c("ordinal", rep("scale", 3))),
+  list(indicators = list("V5", "V6", "V7", "V8"), name = "Factor2", title = "Factor 2", types = c("ordinal", "scale", "scale", "ordinal"))
 )
 options$modelIdentification <- "factorVariance"
 options$naAction <- "pairwise"
@@ -525,9 +523,9 @@ options$seType <- "standard"
 options$estimator <- "default"
 options$standardized <- "none"
 options$factors <- list(
-  list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1"),
-  list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2"),
-  list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3")
+  list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1", types = rep("scale", 3)),
+  list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2", types = rep("scale", 3)),
+  list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3", types = rep("scale", 3))
 )
 options$secondOrder <- list("Factor 1", "Factor 2", "Factor 3")
 options$modelIdentification <- "factorVariance"
@@ -575,9 +573,9 @@ options$group <- "sex"
 options$invarianceTesting <- "structural"
 
 options$factors <- list(
-  list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1"),
-  list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2"),
-  list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3")
+  list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1", types = rep("scale", 3)),
+  list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2", types = rep("scale", 3)),
+  list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3", types = rep("scale", 3))
 )
 options$modelIdentification <- "markerVariable"
 set.seed(1)
@@ -626,9 +624,9 @@ options$meanStructure <- TRUE
 options$interceptsFixedToZero <- "manifest"
 
 options$factors <- list(
-  list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1"),
-  list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2"),
-  list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3")
+  list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1", types = rep("scale", 3)),
+  list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2", types = rep("scale", 3)),
+  list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3", types = rep("scale", 3))
 )
 options$modelIdentification <- "markerVariable"
 set.seed(1)