Fix invariance error (#318)

juliuspfadt · web-flow · commit 4e59a5b2a6e7 · 2025-08-14T11:02:29.000+02:00
diff --git a/R/common.R b/R/common.R
@@ -42,9 +42,9 @@ lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL,
   startProgressbar(samples + 1)
 
   if (!standard) {
-    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coefWithCallback, iseed = iseed)
+    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coefWithCallback, iseed = iseed, type = "nonparametric")
   } else {
-    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coefWithCallbackStd, typeStd = typeStd, iseed = iseed)
+    bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coefWithCallbackStd, typeStd = typeStd, iseed = iseed, type = "nonparametric")
   }
 
   # Add the bootstrap samples to the fit object
@@ -59,24 +59,26 @@ lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL,
 
   # 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)
   } 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))
+    # we replace 1:P because the boot coef output contains also the constrained parameters
+    fit@ParTable$se[1:P] <- apply(fit@boot$coef, 2, sd)
+    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)
 }
 
 
+
 # Function to create a misfit plot
 .resCorToMisFitPlot <- function(rescor) {
   ggmisfit <- reshape2::melt(abs(t(rescor)))
diff --git a/R/mediationanalysis.R b/R/mediationanalysis.R
@@ -115,7 +115,7 @@ MediationAnalysisInternal <- function(jaspResults, dataset, options, ...) {
     mimic           = options$emulation,
     estimator       = options$estimator,
     missing         = miss
-  ))
+    ))
 
   if (inherits(medResult, "try-error")) {
     errmsg <- gettextf("Estimation failed\nMessage:\n%s", attr(medResult, "condition")$message)
diff --git a/inst/qml/MediationAnalysis.qml b/inst/qml/MediationAnalysis.qml
@@ -27,34 +27,39 @@ Form
 {
     VariablesForm
     {
-        AvailableVariablesList
-        {
-            name: "availableVariables"
-        }
-        AssignedVariablesList
-        {
-			title: qsTr("Predictors")
-            name:  "predictors"
-            allowedColumns: []
-        }
-        AssignedVariablesList
-        {
-			title: qsTr("Mediators")
-            name:  "mediators"
-            allowedColumns: ["scale", "ordinal"]
-        }
-        AssignedVariablesList
-        {
-			title: qsTr("Outcome")
-            name:  "outcomes"
-            allowedColumns: ["scale", "ordinal"]
-        }
-        AssignedVariablesList
-        {
-			title: qsTr("Background confounders")
-            name:  "confounds"
-            allowedColumns: []
-        }
+			AvailableVariablesList
+			{
+				name: "availableVariables"
+			}
+			AssignedVariablesList
+			{
+				title: qsTr("Predictors")
+				name:  "predictors"
+				id: predictors
+			}
+			AssignedVariablesList
+			{
+				title: qsTr("Mediators")
+				name:  "mediators"
+				allowedColumns: ["scale", "ordinal"]
+				allowTypeChange: true
+				id: mediators
+
+			}
+			AssignedVariablesList
+			{
+				title: qsTr("Outcome")
+				name:  "outcomes"
+				allowedColumns: ["scale", "ordinal"]
+				allowTypeChange: true
+				id: outcomes
+			}
+			AssignedVariablesList
+			{
+				title: qsTr("Background confounders")
+				name:  "confounds"
+				id: confounds
+			}
     }
 
 	Section
@@ -86,9 +91,10 @@ Form
 				CheckBox { label: qsTr("Path coefficients");        name: "pathCoefficient";    checked: true }
 			}
 		}
-
+	  // create a string with all variables types to pass to the error calc elements
+		// property bool ordinal: 
 		Common.ErrorCalculation{}
-		
+
 	}
 
 	Section 
diff --git a/inst/qml/SEM.qml b/inst/qml/SEM.qml
@@ -248,9 +248,9 @@ Form
 				label: qsTr("     Type")
 				name: "bootstrapCiType"
 				values: [
-						{ label: qsTr("Bias-corrected percentile"),	value: "percentileBiasCorrected"	},
-						{ label: qsTr("Percentile"),				value: "percentile"					},
-						{ label: qsTr("Normal theory"),				value: "normalTheory"				}
+					{ label: qsTr("Bias-corrected percentile"),	value: "percentileBiasCorrected"	},
+					{ label: qsTr("Percentile"),				value: "percentile"					},
+					{ label: qsTr("Normal theory"),				value: "normalTheory"				}
 				]
 			}
 
@@ -338,10 +338,10 @@ Form
 				name: "standardizedEstimate"; label: qsTr("Standardized estimates");
 				RadioButtonGroup
 				{
-						name: "standardizedEstimateType"
-						RadioButton { value: "all"; 	label: qsTr("All"); checked: true	}
-						RadioButton { value: "latents"; label: qsTr("Latents")	}
-						RadioButton { value: "nox"; 	label: qsTr("Except exogenous covariates")		}
+					name: "standardizedEstimateType"
+					RadioButton { value: "all"; 	label: qsTr("All"); checked: true	}
+					RadioButton { value: "latents"; label: qsTr("Latents")	}
+					RadioButton { value: "nox"; 	label: qsTr("Except exogenous covariates")		}
 				}
 			}
 			CheckBox
diff --git a/inst/qml/common/ErrorCalculation.qml b/inst/qml/common/ErrorCalculation.qml
@@ -21,10 +21,12 @@ import QtQuick.Layouts
 import JASP.Controls
 import JASP
 
+
 Group
 {
+	
 	CIField {
-			text: qsTr("Confidence intervals")
+			text: qsTr("Confidence intervals" )
 			name: "ciLevel"
 			info: qsTr("Set the confidence level for the interval estimates")
 	}
@@ -59,9 +61,9 @@ Group
 				label: qsTr("Type")
 				name: "bootstrapCiType"
 				values: [
-						{ label: qsTr("Bias-corrected percentile"), value: "percentileBiasCorrected"   },
-						{ label: qsTr("Percentile"),                value: "percentile"         },
-						{ label: qsTr("Normal theory"),             value: "normalTheory"         }
+					{ label: qsTr("Bias-corrected percentile"), value: "percentileBiasCorrected"   	},
+					{ label: qsTr("Percentile"),                value: "percentile"         			 	},
+					{ label: qsTr("Normal theory"),             value: "normalTheory"       			 	}
 				]
 				info: qsTr("Select the type of bootstrap confidence interval to compute")
 			}
diff --git a/tests/testthat/test-mediationanalysis.R b/tests/testthat/test-mediationanalysis.R
@@ -187,42 +187,42 @@ options$bootstrapCiType  <- "percentileBiasCorrected"
 options$naAction         <- "fiml"
 
 set.seed(1)
-results <- jaspTools::runAnalysis("MediationAnalysis", "test.csv", options)
+results <- jaspTools::runAnalysis("MediationAnalysis", "test.csv", options, makeTests = F)
 
 test_that("Direct effects table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_dir"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(0.0761400441342019, 0.671443275931248, 0.257757843176866, "contcor1",
-                                      "<unicode>", 0.0589199802205698, "contNormal", 0.136467182830779,
-                                      1.88878994810415))
+                                 list(0.0761400418471621, 0.67144328199062, 0.257757843176866, "contcor1",
+                                      "<unicode>", 0.0602005168476014, "contNormal", 0.137154686851546,
+                                      1.87932216604351))
 })
 
 test_that("Indirect effects table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_ind"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(-0.299720825954233, 0.073293678485771, -0.0893136104463747, "contcor2",
-                                      "<unicode>", "<unicode>", 0.321618931630391, 0.0901123208859354,
-                                      "contcor1", "contNormal", -0.991136501294072))
+                                 list(-0.299720820153127, 0.0732936772629952, -0.0893136104463748, "contcor2",
+                                      "<unicode>", "<unicode>", 0.321618931631225, 0.0901123208860908,
+                                      "contcor1", "contNormal", -0.991136501292364))
 })
 
 test_that("Path coefficients table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_path"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(-0.475862353202892, 0.110585521838546, -0.136980447123533, "contcor2",
-                                      "<unicode>", 0.306661780077382, "contNormal", 0.133998745278152,
-                                      -1.02225171466488, 0.0761400441342019, 0.671443275931248, 0.257757843176866,
-                                      "contcor1", "<unicode>", 0.0589199802205698, "contNormal", 0.136467182830779,
-                                      1.88878994810415, 0.481651777938874, 0.754639896102554, 0.652017220865318,
-                                      "contcor1", "<unicode>", 0, "contcor2", 0.06513006081573, 10.0110027950081
-                                 ))
+                                 list(-0.475862350312371, 0.11058551725881, -0.136980447123533, "contcor2",
+                                      "<unicode>", 0.309092736100577, "contNormal", 0.1346738091268,
+                                      -1.01712759156134, 0.0761400418471621, 0.67144328199062, 0.257757843176866,
+                                      "contcor1", "<unicode>", 0.0602005168476014, "contNormal", 0.137154686851546,
+                                      1.87932216604351, 0.481651772564286, 0.75463988878285, 0.652017220865318,
+                                      "contcor1", "<unicode>", 0, "contcor2", 0.0654581731453709,
+                                      9.960822148478))
 })
 
 test_that("Total effects table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_tot"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(-0.00126714302930483, 0.440665080716848, 0.168444232730491, "contcor1",
-                                      "<unicode>", 0.102761008345243, "contNormal", 0.103237850067971,
-                                      1.63161314013793))
+                                 list(-0.00126713143815475, 0.440665080659029, 0.168444232730491, "contcor1",
+                                      "<unicode>", 0.102761008340492, "contNormal", 0.103237850066545,
+                                      1.63161314016047))
 })
 
 
@@ -247,35 +247,35 @@ results <- jaspTools::runAnalysis("MediationAnalysis", "test.csv", options, make
 test_that("Direct effects table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_dir"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(0.00203607928291166, 0.515217977105027, 0.246415337256947, "contcor1",
-                                      "<unicode>", 0.0454269308884425, "contNormal", 0.123165817830769,
-                                      2.0006795846192))
+                                 list(0.00203609861592261, 0.515217972956754, 0.246415337277754, "contcor1",
+                                      "<unicode>", 0.0465192566969286, "contNormal", 0.123786300663823,
+                                      1.99065111370413))
 })
 
 test_that("Indirect effects table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_ind"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(-0.285927353530278, 0.072679544829816, -0.085383409360225, "contcor2",
-                                      "<unicode>", "<unicode>", 0.323289823674984, 0.086444958200602,
-                                      "contcor1", "contNormal", -0.987719945009244))
+                                 list(-0.285927353547018, 0.0726795446582816, -0.0853834093674345, "contcor2",
+                                      "<unicode>", "<unicode>", 0.325721157816279, 0.0868804491259142,
+                                      "contcor1", "contNormal", -0.982768968467117))
 })
 
 test_that("Path coefficients table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_path"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(-0.423032428335729, 0.125618203679588, -0.129957536543631, "contcor2",
-                                      "<unicode>", 0.299640536185824, "contNormal", 0.12529595637462,
-                                      -1.03720455395283, 0.00203607928291166, 0.515217977105027, 0.246415337256947,
-                                      "contcor1", "<unicode>", 0.0454269308884425, "contNormal", 0.123165817830769,
-                                      2.0006795846192, 0.514802944243485, 0.794776932027742, 0.657010063679986,
-                                      "contcor1", "<unicode>", 0, "contcor2", 0.0623901955114432,
-                                      10.5306620422352))
+                                 list(-0.42303242765298, 0.125618203587476, -0.129957536548202, "contcor2",
+                                      "<unicode>", 0.302069524845541, "contNormal", 0.125927170167018,
+                                      -1.0320055344358, 0.00203609861592261, 0.515217972956754, 0.246415337277754,
+                                      "contcor1", "<unicode>", 0.0465192566969286, "contNormal", 0.123786300663823,
+                                      1.99065111370413, 0.514802945031706, 0.794776935427497, 0.657010063712354,
+                                      "contcor1", "<unicode>", 0, "contcor2", 0.0627045055841268,
+                                      10.4778764714265))
 })
 
 test_that("Total effects table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_parest"]][["collection"]][["modelContainer_parest_tot"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(-0.0364757008466789, 0.347861388237319, 0.161031927896722, "contcor1",
-                                      "<unicode>", 0.0988448047762278, "contNormal", 0.0975667259740126,
-                                      1.65047997961533))
+                                 list(-0.0364756940559679, 0.347861392970991, 0.161031927910319, "contcor1",
+                                      "<unicode>", 0.100547140107636, "contNormal", 0.0980582478184411,
+                                      1.6422068667643))
 })
diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R
@@ -626,12 +626,12 @@ test_that("Residual covariances table results match", {
 test_that("Regression coefficients table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_reg"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(0.268681455197478, 0.452255911056787, 0.355178159312481, "x1",
-                                      1.14885878588211e-12, "x2", 0.0499449599194705, 7.1113914173754,
-                                      -0.0227477243021426, 0.150803629695307, 0.0779182588187377,
-                                      "x1", 0.0916339727882085, "x3", 0.046191827943223, 1.68684077440086,
-                                      -0.000464738405957426, 0.0538034631716805, 0.0306885890333795,
-                                      "x1", 0.022389186917765, "y1", 0.0134381019141957, 2.28369967941387
+                                 list(0.268681455197478, 0.452255911056786, 0.355178159312481, "x1",
+                                      1.48658862997308e-12, "x2", 0.0501965734037228, 7.07574512020654,
+                                      -0.0227477243021424, 0.150803629695307, 0.0779182588187374,
+                                      "x1", 0.0932718899905223, "x3", 0.0464245338299794, 1.67838537925006,
+                                      -0.000464738405957442, 0.0538034631716805, 0.0306885890333796,
+                                      "x1", 0.0230712646597004, "y1", 0.0135058006046709, 2.27225248851713
                                  ))
 })
 
@@ -650,8 +650,8 @@ test_that("Total effects table results match", {
 test_that("Residual variances table results match", {
   table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_var"]][["data"]]
   jaspTools::expect_equal_tables(table,
-                                 list(0.0692094432457097, 0.123114077566912, "x1", 0.0973808537831692,
-                                      "", "x1", 1.02584607475364e-13, 0.0130929931392748, 7.43763116250766,
+                                 list(0.0692094432457098, 0.123114077566911, "x1", 0.0973808537831693,
+                                      "", "x1", 1.35891298214119e-13, 0.013158953231437, 7.40034956203999,
                                       2.25167664969696, 2.25167664969696, "x2", 2.25167664969696,
                                       "", "x2", "", 0, "", 1.949678538072, 1.949678538072, "x3", 1.949678538072,
                                       "", "x3", "", 0, "", 6.78685155555555, 6.78685155555555, "y1",

Original file line number	Diff line number	Diff line change
`@@ -248,9 +248,9 @@ Form`
`248`	`248`	`label: qsTr(" Type")`
`249`	`249`	`name: "bootstrapCiType"`
`250`	`250`	`values: [`
`251`		`- { label: qsTr("Bias-corrected percentile"), value: "percentileBiasCorrected" },`
`252`		`- { label: qsTr("Percentile"), value: "percentile" },`
`253`		`- { label: qsTr("Normal theory"), value: "normalTheory" }`
	`251`	`+ { label: qsTr("Bias-corrected percentile"), value: "percentileBiasCorrected" },`
	`252`	`+ { label: qsTr("Percentile"), value: "percentile" },`
	`253`	`+ { label: qsTr("Normal theory"), value: "normalTheory" }`
`254`	`254`	`]`
`255`	`255`	`}`
`256`	`256`
`@@ -338,10 +338,10 @@ Form`
`338`	`338`	`name: "standardizedEstimate"; label: qsTr("Standardized estimates");`
`339`	`339`	`RadioButtonGroup`
`340`	`340`	`{`
`341`		`- name: "standardizedEstimateType"`
`342`		`- RadioButton { value: "all"; label: qsTr("All"); checked: true }`
`343`		`- RadioButton { value: "latents"; label: qsTr("Latents") }`
`344`		`- RadioButton { value: "nox"; label: qsTr("Except exogenous covariates") }`
	`341`	`+ name: "standardizedEstimateType"`
	`342`	`+ RadioButton { value: "all"; label: qsTr("All"); checked: true }`
	`343`	`+ RadioButton { value: "latents"; label: qsTr("Latents") }`
	`344`	`+ RadioButton { value: "nox"; label: qsTr("Except exogenous covariates") }`
`345`	`345`	`}`
`346`	`346`	`}`
`347`	`347`	`CheckBox`