fix standardization and MGCFA invariance bug

Author: juliuspfadt

R/confirmatoryfactoranalysis.R

@@ -322,8 +322,12 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
     if (options[["dataType"]] == "varianceCovariance") {
       .quitAnalysis(gettext("Bootstrapping is not available for variance-covariance matrix input."))
     }
-    cfaResult[["lav"]] <- jaspSem::lavBootstrap(cfaResult[["lav"]], options$bootstrapSamples,
-                                                standard = options[["standardized"]] != "none", typeStd = type)
+
+    # cfaResult[["lav"]] <- jaspSem::lavBootstrap(cfaResult[["lav"]], options$bootstrapSamples,
+    #                                             standard = options[["standardized"]] != "none", typeStd = type)
+
+    cfaResult[["lav"]] <- lavBootstrap(cfaResult[["lav"]], options$bootstrapSamples,
+                                       standard = options[["standardized"]] != "none", typeStd = type)
   }
 
   # Save cfaResult as state so it's available even when opts don't change
@@ -961,7 +965,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
   }
 
   # Intercepts ----
-  if (options$meanStructure) {
+  if (options$meanStructure || options$group != "") {
 
     if (options$group != "") {
 
@@ -1530,29 +1534,20 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ..
 
 }
 
-# delete once jaspSem is merged
-lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL) {
-  # Run bootstrap, track progress with progress bar
-  # Notes: faulty runs are simply ignored
-  # recommended: add a warning if not all boot samples are successful
-  # fit <- lavBootstrap(fit, samples = 1000)
-  # if (nrow(fit@boot$coef) < 1000)
-  #  tab$addFootnote(gettextf("Not all bootstrap samples were successful: CI based on %.0f samples.", nrow(fit@boot$coef)),
-  #                  "<em>Note.</em>")
-
+# delete this once jaspSem is merged
+lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL, iseed = NULL) {
 
-  coef_with_callback <- function(lav_object) {
+  coefWithCallback <- function(lav_object) {
     # Progress bar is ticked every time coef() is evaluated, which happens once on the main object:
     # https://github.com/yrosseel/lavaan/blob/77a568a574e4113245e2f6aff1d7c3120a26dd90/R/lav_bootstrap.R#L107
     # and then every time on a successful bootstrap:
     # https://github.com/yrosseel/lavaan/blob/77a568a574e4113245e2f6aff1d7c3120a26dd90/R/lav_bootstrap.R#L375
     # i.e., samples + 1 times
     progressbarTick()
-
     return(lavaan::coef(lav_object))
   }
 
-  coef_with_callback_std <- function(lav_object, typeStd) {
+  coefWithCallbackStd <- function(lav_object, typeStd) {
     std <- lavaan::standardizedSolution(lav_object, type = typeStd)
     out <- std$est.std
 
@@ -1564,38 +1559,39 @@ lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL)
   startProgressbar(samples + 1)
 
   if (!standard) {
-    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coef_with_callback)
+    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coefWithCallback, iseed = iseed)
   } else {
-    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coef_with_callback_std, typeStd = typeStd)
+    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coefWithCallbackStd, typeStd = typeStd, iseed = iseed)
   }
 
   # Add the bootstrap samples to the fit object
   fit@boot       <- list(coef = bootres)
   fit@Options$se <- "bootstrap"
 
   # exclude error bootstrap runs
-  err_id <- attr(fit@boot$coef, "error.idx")
-  if (length(err_id) > 0L) {
-    fit@boot$coef <- fit@boot$coef[-err_id, , drop = FALSE]
+  errId <- attr(fit@boot$coef, "error.idx")
+  if (length(errId) > 0L) {
+    fit@boot$coef <- fit@boot$coef[-errId, , drop = FALSE]
   }
 
-  # we actually need the SEs from the bootstrap not the SEs from ML or something
+  # we actually need the SEs from the bootstrap not the SEs from ML or some other estimator
   N <- nrow(fit@boot$coef)
+  P <- ncol(fit@boot$coef)
+  freePars <- which(fit@ParTable$free != 0)
 
   # we multiply the var by (n-1)/n because lavaan actually uses n for the variance instead of n-1
   if (!standard) {
     # for unstandardized
-    fit@ParTable$se[fit@ParTable$free != 0] <- apply(fit@boot$coef, 2, sd) * sqrt((N-1)/N)
+    fit@ParTable$se[freePars] <- apply(fit@boot$coef, 2, sd) * sqrt((N-1)/N)
   } else {
-    fit@ParTable$se <- apply(fit@boot$coef, 2, sd) * sqrt((N-1)/N)
-    # the standardized solution gives all estimates not only the unconstrained, so we need to change
-    # the free prameters in the partable and also change the estimate
-    fit@ParTable$free <- seq_len(ncol(fit@boot$coef))
+    # when there are contraints the parameterestimates() function expects a boot sample for the free parameters only
+    fit@ParTable$se[1:P] <- apply(fit@boot$coef, 2, sd) * sqrt((N-1)/N)
+    fit@boot$coef <- fit@boot$coef[, freePars, drop = FALSE]
     std <- lavaan::standardizedSolution(fit, type = typeStd)
-    fit@ParTable$est <- std$est.std
+    # for the standardized output we also replace some constrained elements
+    fit@ParTable$est[1:P] <- std$est.std
   }
 
-
   return(fit)
 }
 

renv.lock

@@ -125,7 +125,7 @@
     },
     "RUnit": {
       "Package": "RUnit",
-      "Version": "0.4.33",
+      "Version": "0.4.33.1",
       "Source": "Repository",
       "Requirements": [
         "graphics",
@@ -136,7 +136,7 @@
     },
     "Rcpp": {
       "Package": "Rcpp",
-      "Version": "1.0.14",
+      "Version": "1.1.0",
       "Source": "Repository",
       "Requirements": [
         "methods",
@@ -176,7 +176,7 @@
     },
     "Rcsdp": {
       "Package": "Rcsdp",
-      "Version": "0.1.57.5",
+      "Version": "0.1.57.6",
       "Source": "Repository",
       "Requirements": [
         "methods"
@@ -419,7 +419,7 @@
     },
     "cluster": {
       "Package": "cluster",
-      "Version": "2.1.8",
+      "Version": "2.1.8.1",
       "Source": "Repository",
       "Requirements": [
         "graphics",
@@ -551,7 +551,7 @@
     },
     "evaluate": {
       "Package": "evaluate",
-      "Version": "1.0.3",
+      "Version": "1.0.4",
       "Source": "Repository",
       "Requirements": [
         "R"
@@ -1303,7 +1303,7 @@
     },
     "pbapply": {
       "Package": "pbapply",
-      "Version": "1.7-2",
+      "Version": "1.7-4",
       "Source": "Repository",
       "Requirements": [
         "parallel",
@@ -1318,7 +1318,7 @@
     },
     "pillar": {
       "Package": "pillar",
-      "Version": "1.10.2",
+      "Version": "1.11.0",
       "Source": "Repository",
       "Requirements": [
         "cli",
@@ -1413,7 +1413,7 @@
     },
     "psych": {
       "Package": "psych",
-      "Version": "2.4.12",
+      "Version": "2.5.6",
       "Source": "Repository",
       "Requirements": [
         "GPArotation",
@@ -1429,7 +1429,7 @@
     },
     "purrr": {
       "Package": "purrr",
-      "Version": "1.0.4",
+      "Version": "1.1.0",
       "Source": "Repository",
       "Requirements": [
         "cli",