add more options to meanstrcuture

jasp-stats · Nov 3, 2023 · a596472 · a596472
1 parent 61b7094
commit a596472
Show file tree

Hide file tree

Showing 5 changed files with 216 additions and 108 deletions.
diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R
@@ -23,7 +23,6 @@ gettextf <- function(fmt, ..., domain = NULL)  {
 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/")
 
-
   # Preprocess options
   options <- .cfaPreprocessOptions(options)
 
@@ -188,6 +187,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
                      "diagonallyWeightedLeastSquares"  = "DWLS"
   )
 
+
   cfaResult[["lav"]] <- try(lavaan::lavaan(
     model           = mod,
     data            = dataset,
@@ -198,8 +198,10 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
     std.lv          = options$modelIdentification == "factorVariance",
     auto.fix.first  = options$modelIdentification == "markerVariable",
     orthogonal      = options$factorsUncorrelated,
-    int.ov.free     = TRUE,
-    int.lv.free     = FALSE,
+    int.ov.free     = (options$interceptsFixedToZero == "latent" || options$interceptsFixedToZero == "meanManifest"),
+    int.lv.free     = (options$interceptsFixedToZero == "manifest" || options$interceptsFixedToZero == "meanManifest"),
+    effect.coding   = ifelse(options$modelIdentification == "effectsCoding", TRUE,
+                             ifelse(options$interceptsFixedToZero == "meanManifest", "intercepts", FALSE)),
     auto.fix.single = TRUE,
     auto.var        = TRUE,
     auto.cov.lv.x   = TRUE,
@@ -212,6 +214,31 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
                              ifelse(options$naAction == "twoStage", "two.stage", options$naAction))
   ))
 
+  # cfaResult[["lav"]] <- try(lavaan::lavaan(
+  #   model           = mod,
+  #   data            = dataset,
+  #   group           = grp,
+  #   group.equal     = geq,
+  #   meanstructure   = options$meanStructure,
+  #   se              = cfaResult[["spec"]]$se,
+  #   std.lv          = options$modelIdentification == "factorVariance",
+  #   auto.fix.first  = options$modelIdentification == "markerVariable",
+  #   orthogonal      = options$factorsUncorrelated,
+  #   effect.coding   = ifelse(options$modelIdentification == "effectsCoding", "loadings", FALSE),
+  #   int.ov.free     = TRUE,
+  #   int.lv.free     = FALSE,
+  #   auto.fix.single = TRUE,
+  #   auto.var        = TRUE,
+  #   auto.cov.lv.x   = TRUE,
+  #   auto.th         = TRUE,
+  #   auto.delta      = TRUE,
+  #   auto.cov.y      = TRUE,
+  #   mimic           = options$packageMimiced,
+  #   estimator       = estimator,
+  #   missing         = ifelse(options$naAction == "twoStageRobust", "robust.two.stage",
+  #                            ifelse(options$naAction == "twoStage", "two.stage", options$naAction))
+  # ))
+
   # are there ordered variables in the data?
   cfaResult[["orderedVariables"]] <- any(sapply(dataset, is.ordered))
 
@@ -264,7 +291,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults[["stateCFAResult"]]$dependOn(c(
     "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification",
     "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples",
-    "group", "invarianceTesting"
+    "group", "invarianceTesting", "interceptsFixedToZero"
 
   ))
 
@@ -378,45 +405,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
     rc <- NULL
   }
 
-  #' I dont think we need this bit of code, as setting meanstructure to TRUE
-  #' does already fix the latent means to zero across groups,
-  #' which is exactly what this piece of code does
-  if (options$meanStructure && options$group != "") {
-    lm <- "# Latent means"
-    lvs <- c(cfaResult[["spec"]]$latents, cfaResult[["spec"]]$soLatents)
-    for (i in seq_along(lvs)) {
-      lm <- paste0(lm, '\n', lvs[i], " ~ c(0,",
-                   paste(rep(NA, length(unique(na.omit(dataset[[gv]]))) - 1), collapse = ","),
-                   ")*1")
-    }
-  } else {
-    lm <- NULL
-  }
-  # lm <- NULL
-
-  if (options$modelIdentification == "effectsCoding") {
-    ef <- "# effects coding restrictions"
-    for (i in 1:length(labels)) {
-      if (nchar(options$group) == 0 || options$invarianceTesting !="configural") {
-        restr <- paste0(labels[[i]][1], " == ",
-                        paste(c(length(labels[[i]]), labels[[i]][-1]),
-                              collapse = " - "))
-        ef <- paste0(ef, "\n", restr)
-      } else { # configural invarianceTesting
-        restr <- ""
-        for (j in 1:n_levels) {
-          restr <- paste0(restr, unlist(labels[[i]][1])[j], " == ",
-                          paste(c(length(labels[[i]]), lapply(labels[[i]][-1], function(x) x[j])),
-                                collapse = " - "), "\n")
-        }
-        ef <- paste0(ef, "\n", restr)
-      }
-    }
-  } else {
-    ef <- NULL
-  }
 
-  return(list(model = paste0(c(fo, so, rc, lm, ef), collapse = "\n\n"), simple_model = fo_simp))
+  return(list(model = paste0(c(fo, so, rc), collapse = "\n\n"), simple_model = fo_simp))
 }
 
 .CFAInvariance <- function(options) {
@@ -438,7 +428,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults[["maincontainer"]]$dependOn(c(
     "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification",
     "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples",
-    "group", "invarianceTesting"
+    "group", "invarianceTesting", "interceptsFixedToZero"
   ))
 }
 
@@ -495,7 +485,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 
   jaspResults[["maincontainer"]][["kmo"]] <- tabkmo <- createJaspTable(gettext("Kaiser-Meyer-Olkin (KMO) test"))
   tabkmo$addColumnInfo(name = "indicator", title = "Indicator", type = "string")
-  tabkmo$dependOn(c("factors", "naAction", "group", "kaiserMeyerOlkinTest"))
+  tabkmo$dependOn("kaiserMeyerOlkinTest")
   if (is.null(cfaResult)) return()
 
   cov_implied <- lavaan::fitted(cfaResult[["lav"]])
@@ -525,7 +515,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   if (!options$bartlettTest || !is.null(jaspResults[["maincontainer"]][["bartlett"]])) return()
 
   jaspResults[["maincontainer"]][["bartlett"]] <- tabbartlett <- createJaspTable(gettext("Bartlett's test of sphericity"))
-  tabbartlett$dependOn(c("factors", "naAction", "group", "bartlettTest"))
+  tabbartlett$dependOn("bartlettTest")
   if (is.null(cfaResult)) return()
 
   cov_implied <- lavaan::fitted(cfaResult[["lav"]])
@@ -564,8 +554,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults[["maincontainer"]][["rSquared"]] <- tabr2 <- createJaspTable(gettext("R-Squared"))
   tabr2$addColumnInfo(name = "__var__", title = "", type = "string")
   tabr2$setExpectedSize(rows = 1, cols = 1)
-  tabr2$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
-                   "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "rSquared"))
+  tabr2$dependOn("rSquared")
 
   if (is.null(cfaResult)) return()
 
@@ -598,8 +587,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 .cfaTableFitMeasures <- function(jaspResults, options, cfaResult) {
   if (!options$fitMeasures || !is.null(jaspResults[["maincontainer"]][["fits"]])) return()
   jaspResults[["maincontainer"]][["fits"]] <- fitms <- createJaspContainer(gettext("Additional fit measures"))
-  fitms$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
-                   "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "fitMeasures"))
+  fitms$dependOn("fitMeasures")
 
   # Fit indices
   fitms[["indices"]] <- fitin <- createJaspTable(gettext("Fit indices"))
@@ -687,7 +675,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults[["estimates"]] <- ests <- createJaspContainer(gettext("Parameter estimates"), position = 2)
   ests$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification",
                   "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples",
-                  "group", "invarianceTesting", "standardized", "ciLevel"))
+                  "group", "invarianceTesting", "standardized", "ciLevel", "interceptsFixedToZero"))
 
 
   footnote <- NULL
@@ -1004,12 +992,12 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 
   # Thresholds
   if ("|" %in% pei$op) {
-    .thresholdsTable(jrobject, footnote, options, standardization, pei, colSel, cfaResult)
+    .cfaThresholdsTable(jrobject, footnote, options, standardization, pei, colSel, cfaResult)
   }
 
 }
 
-.thresholdsTable <- function(jrobject, footnote, options, standardization, pei, colSel, cfaResult) {
+.cfaThresholdsTable <- function(jrobject, footnote, options, standardization, pei, colSel, cfaResult) {
   # Manifest variable intercepts
   jrobject[["Thresholds"]] <- th <- createJaspTable(title = gettext("Thresholds"))
   if (!is.null(footnote)) th$addFootnote(footnote)
@@ -1052,7 +1040,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults[["modind"]] <- mic <- createJaspContainer(gettext("Modification Indices"), position = 5)
   mic$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
                  "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "modificationIndices",
-                 "modificationIndicesCutoff"))
+                 "modificationIndicesCutoff", "interceptsFixedToZero"))
 
   if (isTryError(mi)) {
     mic$setError(.extractErrorMessage(mi))
@@ -1187,7 +1175,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 
   icc$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification",
                  "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples",
-                 "group", "invarianceTesting", "impliedCovarianceMatrix"))
+                 "group", "invarianceTesting", "impliedCovarianceMatrix", "interceptsFixedToZero"))
 }
 
 .cfaTableResCov <- function(jaspResults, options, cfaResult) {
@@ -1221,7 +1209,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   }
 
   rcc$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
-                 "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "residualCovarianceMatrix"))
+                 "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting",
+                 "residualCovarianceMatrix", "interceptsFixedToZero"))
 }
 
 .cfaInitPlots <- function(jaspResults, options, cfaResult) {
@@ -1230,7 +1219,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   jaspResults[["plots"]] <- createJaspContainer(gettext("Plots"), position = 6)
   jaspResults[["plots"]]$dependOn(c(
     "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced",
-    "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting"
+    "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "interceptsFixedToZero"
   ))
 }
 
@@ -1387,7 +1376,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   aveTable$addColumnInfo(name = "factor", title = gettext("Factor"), type = "string")
   aveTable$addColumnInfo(name = "ave", title = gettext("AVE"), type = "number")
   aveTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
-                      "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "ave"))
+                      "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "ave", "interceptsFixedToZero"))
 
   if (options$group != "") {
     ave_result <- semTools::AVE(cfaResult[["lav"]])
@@ -1412,7 +1401,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 
   htmtTable <- createJaspTable(gettext("Heterotrait-monotrait ratio"), position = 4.2)
   htmtTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
-                       "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "htmt"))
+                       "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "htmt", "interceptsFixedToZero"))
 
   if (options[["group"]] != "") {
     htmtTable$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE)
@@ -1475,7 +1464,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   relTable$addColumnInfo(name = "rel", title = gettextf("Coefficient %s", "\u03C9"), type = "number")
   relTable$addColumnInfo(name = "alpha", title = gettextf("Coefficient %s", "\u03B1"), type = "number")
   relTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated",
-                      "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "reliability"))
+                      "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "reliability", "interceptsFixedToZero"))
 
   nfac <- length(cfaResult[["spec"]][["latents"]])
 

diff --git a/inst/help/ConfirmatoryFactorAnalysis.md b/inst/help/ConfirmatoryFactorAnalysis.md
@@ -16,14 +16,27 @@ JASP allows the factors in turn to be indicators of a second-order factor. This
 
 ### Model options
 -------
-- Include mean structure: display means for the indicators and, in the case of multi-group CFA, the means of the latent variables.
+- Include mean structure: display means for the indicators and, in the case of multi-group CFA, the means of the latent variables. To identify the model, the following options can be selected:
+  - Fix latent intercepts to zero
+  - Fix manifest intercepts to zero
+  - Fix mean of manifest intercepts to zero: translates to effect coding
 - Assume factors uncorrelated: set the correlation between the different latent variables to 0.
 - Factor scaling: factors can be given a scale in one of three ways:
   - Factor variances (default): the factor has a fixed variance of 1
   - Marker variable: the factor has the same scale as its first indicator as its factor loading is fixed to 1
   - Effects coding: the mean of the factor loadings is fixed to 1. For more information on the interpretation of effects coding, see Veen (2018)
 - Residual covariances: to allow for covariance between indicators not explained by their respective factor, for example because questions were phrased in a similar way, drag two variables to the right-side assignment box.
 
+### Multigroup CFA
+------
+- Grouping variable: Select a categorical variable here to create CFA models for each group 
+- Invariance testing: Select a level of constraining parameters over the different groups.
+  - configural: the different groups have the same CFA structure
+  - metric: same as configural and the factor loadings are constrained to be equal across groups
+  - scalar: same as metric and the means of the indicators (intercepts) are constrained to be equal across groups
+  - strict: same as scalar and the residual variances, and residual covariances are constrained to be equal across groups
+  - structural: same as strict and the latent means, variances, and covariances are constrained to be equal across groups
+
 ### Additional output
 -------
 - Additional fit measures: select these to display the value of the various fit indices in the output pane
@@ -38,15 +51,6 @@ JASP allows the factors in turn to be indicators of a second-order factor. This
 - Modification indices: Display MIs with a minimum cutoff. A MI shows how much the chi-square value of overall fit would change if the parameter in question is freed up. EPC shows the expected change of the parameter itself.
 - Show lavaan syntax: Display the lavaan modeling syntax that would be needed to run the model in R
 
-### Multigroup CFA
-------
-- Grouping variable: Select a categorical variable here to create CFA models for each group 
-- Invariance testing: Select a level of constraining parameters over the different groups.
-  - configural: the different groups have the same CFA structure
-  - metric: same as configural and the factor loadings are constrained to be equal across groups
-  - scalar: same as metric and the means of the indicators (intercepts) are constrained to be equal across groups
-  - strict: same as scalar and the residual variances, and residual covariances are constrained to be equal across groups
-  - structural: same as strict and the latent means, variances, and covariances are constrained to be equal across groups
 
 ### Plots
 -------