From da58cf1adc63bce55c12bb63d3cc7151ccc440b6 Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Wed, 21 Feb 2024 14:06:20 +0100 Subject: [PATCH 01/10] merge conflicts --- R/sem.R | 138 +++++++++++++++++++++++++++++++++++--- tests/testthat/test-sem.R | 23 +++++++ 2 files changed, 150 insertions(+), 11 deletions(-) diff --git a/R/sem.R b/R/sem.R index ef2c059e..0c1a7dca 100644 --- a/R/sem.R +++ b/R/sem.R @@ -206,7 +206,7 @@ checkLavaanModel <- function(model, availableVars) { modelContainer <- createJaspContainer() modelContainer$dependOn(c("samplingWeights", "meanStructure", "manifestInterceptFixedToZero", "latentInterceptFixedToZero", "exogenousCovariateFixed", "orthogonal", "factorScaling", "residualSingleIndicatorOmitted", "residualVariance", "exogenousLatentCorrelation", - "dependentCorrelation", "threshold", "scalingParameter", "efaConstrained", "standardizedVariable", "naAction", "estimator", "test", + "dependentCorrelation", "threshold", "scalingParameter", "efaConstrained", "standardizedVariable", "naAction", "estimator", "modelTest", "errorCalculationMethod", "informationMatrix", "emulation", "group", "equalLoading", "equalIntercept", "equalResidual", "equalResidualCovariance", "equalMean", "equalThreshold", "equalRegression", "equalLatentVariance", "equalLatentCovariance", "dataType", "sampleSize", "freeParameters", "manifestMeanFixedToZero")) @@ -387,11 +387,11 @@ checkLavaanModel <- function(model, availableVars) { lavopts[["estimator"]] <- options[["estimator"]] lavopts[["se"]] <- ifelse(options[["errorCalculationMethod"]] == "bootstrap", "standard", options[["errorCalculationMethod"]]) lavopts[["information"]] <- options[["informationMatrix"]] - lavopts[["test"]] <- ifelse(options[["modelTest"]] == "satorraBentler", "Satorra.Bentler", - ifelse(options[["modelTest"]] == "yuanBentler", "Yuan.Bentler", + lavopts[["test"]] <- ifelse(options[["modelTest"]] == "satorraBentler", "satorra.bentler", + ifelse(options[["modelTest"]] == "yuanBentler", "yuan.bentler", ifelse(options[["modelTest"]] == "meanAndVarianceAdjusted", "mean.var.adjusted", ifelse(options[["modelTest"]] == "scaledAndShifted", "scaled.shifted", - ifelse(options[["modelTest"]] == "bollenStine", "Bollen.Stine", + ifelse(options[["modelTest"]] == "bollenStine", "bollen.stine", options[["modelTest"]]))))) # group.equal options @@ -633,7 +633,7 @@ checkLavaanModel <- function(model, availableVars) { fittab$dependOn("models") fittab$position <- 0 - fittab$addColumnInfo(name = "Model", title = "", type = "string" ) + fittab$addColumnInfo(name = "Model", title = "", type = "string" , combine = TRUE) fittab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" ) fittab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" ) fittab$addColumnInfo(name = "N", title = gettext("n"), type = "integer") @@ -652,6 +652,35 @@ checkLavaanModel <- function(model, availableVars) { modelContainer[["fittab"]] <- fittab + if (options[["group"]] != "") { + grouptab <- createJaspTable(title = gettext("Model fit by group")) + grouptab$dependOn("models") + grouptab$position <- 0.05 + + grouptab$addColumnInfo(name = "Model", title = "", type = "string" , combine = TRUE) + grouptab$addColumnInfo(name = "group", title = gettext("Group"), type = "string" ) + grouptab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" ) + grouptab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" ) + grouptab$addColumnInfo(name = "N", title = gettext("n"), type = "integer") + grouptab$addColumnInfo(name = "Chisq", title = gettext("χ²"), type = "number" , + overtitle = gettext("Baseline test")) + grouptab$addColumnInfo(name = "Df", title = gettext("df"), type = "integer", + overtitle = gettext("Baseline test")) + grouptab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue", + overtitle = gettext("Baseline test")) + if (length(options[["models"]]) > 1) { + grouptab$addColumnInfo(name = "dchisq", title = gettext("\u0394\u03C7\u00B2"), type = "number" , + overtitle = gettext("Difference test")) + grouptab$addColumnInfo(name = "ddf", title = gettext("\u0394df"), type = "integer", + overtitle = gettext("Difference test")) + grouptab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" , + overtitle = gettext("Difference test")) + } + + modelContainer[["grouptab"]] <- grouptab + } + + if (!ready) return() # add data to the table! @@ -659,8 +688,19 @@ checkLavaanModel <- function(model, availableVars) { if (modelContainer$getError()) return() + testName <- switch(options[["modelTest"]], + "satorraBentler" = "satorra.bentler", + "yuanBentler" = "yuan.bentler", + "scaledAndShifted" = "scaled.shifted", + "meanAndVarianceAdjusted" = "mean.var.adjusted", + "bollenStine" = "bollen.stine", + options[["modelTest"]]) + if (testName == "default") + testName <- "standard" if (length(semResults) == 1) { - lrt <- .withWarnings(lavaan::lavTestLRT(semResults[[1]])[-1, ]) + lrt <- .withWarnings(lavaan::lavTestLRT(semResults[[1]], type = "Chisq")[-1, ]) + chiSq <- lavaan::lavInspect(semResults[[1]], what = "test")[[testName]]$stat + dfs <- lavaan::lavInspect(semResults[[1]], what = "test")[[testName]]$df rownames(lrt$value) <- options[["models"]][[1]][["name"]] Ns <- lavaan::lavInspect(semResults[[1]], "ntotal") } else { @@ -668,6 +708,7 @@ checkLavaanModel <- function(model, availableVars) { lrt_args <- semResults names(lrt_args) <- "object" # (the first result is object, the others ...) lrt_args[["model.names"]] <- vapply(options[["models"]], getElement, name = "name", "") + lrt_args[["type"]] <- "Chisq" lrt <- .withWarnings(do.call(lavaan::lavTestLRT, lrt_args)) # the lrt test in lavaan produces the standard chisq values and df and pvalue, even when each model is using a scaled test @@ -682,16 +723,17 @@ checkLavaanModel <- function(model, availableVars) { lrt$value[["PrChisq"]] <- chis[3, ] lrt$value[1,5:7] <- NA - + chiSq <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat})) + dfs <- unlist(lapply(semResults, function(x) {round(lavaan::lavInspect(x, what = "test")[[testName]]$df, 3)})) } fittab[["Model"]] <- rownames(lrt$value) fittab[["AIC"]] <- lrt$value[["AIC"]] fittab[["BIC"]] <- lrt$value[["BIC"]] fittab[["N"]] <- Ns - fittab[["Chisq"]] <- lrt$value[["Chisq"]] - fittab[["Df"]] <- lrt$value[["Df"]] - fittab[["PrChisq"]] <- pchisq(q = lrt$value[["Chisq"]], df = lrt$value[["Df"]], lower.tail = FALSE) + fittab[["Chisq"]] <- chiSq + fittab[["Df"]] <- dfs + fittab[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) fittab[["dchisq"]] <- lrt$value[["Chisq diff"]] fittab[["ddf"]] <- lrt$value[["Df diff"]] fittab[["dPrChisq"]] <- lrt$value[["Pr(>Chisq)"]] @@ -729,13 +771,87 @@ checkLavaanModel <- function(model, availableVars) { "boot", gettext("bootstrap (Bollen-Stine) probability value") ) testname <- LUT[test == tolower(LUT$option), "name"][[1]] - ftext <- gettextf("Model tests based on %s.", testname) + if (length(semResults) == 1) + ftext <- gettextf("Baseline tests based on %s.", testname) + if (length(semResults) > 1) + ftext <- gettextf("Baseline tests based on %s. Difference tests based on a function of two standard test-statistics.", testname) + fittab$addFootnote(message = ftext) } if (options$estimator %in% c("dwls", "gls", "wls", "uls")) { fittab$addFootnote(message = gettext("The AIC, BIC and additional information criteria are only available with ML-type estimators")) } + if (options[["group"]] != "") { + + groupNames <- semResults[[1]]@Data@group.label + models <- rep(rownames(lrt$value), each = length(groupNames)) + lavopts <- .semOptionsToLavOptions(options, dataset) + lavopts[["group"]] <- NULL + results_grouped <- list() + k = 1 + for (i in 1:length(options[["models"]])) { + syntax <- lavaan::parTable(semResults[[i]]) + for (group in seq_along(groupNames)) { + lav_args <- lavopts + syntax_group <- syntax[syntax$group == group,] + equalityConstraints <- syntax[syntax$op == "==",] + if (nrow(equalityConstraints) > 0) { + for (j in 1:nrow(equalityConstraints)) { + if(equalityConstraints[j, "lhs"] %in% syntax_group[, "plabel"]) { + syntax_group <- rbind(syntax_group, equalityConstraints[j,]) + } + } + } + syntax_group[["group"]] <- syntax_group[["block"]] <- rep(1, nrow(syntax_group)) + lav_args[["model"]] <- syntax_group + dataset_group <- dataset[dataset[[options[["group"]]]] == groupNames[group],] + lav_args[["data"]] <- dataset_group + fit_group <- try(do.call(lavaan::lavaan, lav_args)) + if (isTryError(fit_group)) { + errormsg <- gettextf("The model fit by group is unavailable for the specified model: %s", options[["models"]][[i]][["name"]]) + grouptab$setError(errormsg) + break + } + results_grouped[[k]] <- fit_group + k = k + 1 + } + } + + chiSq <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat.group})) + dfs <- vapply(results_grouped, function(x) {round(lavaan::lavInspect(x, what = "test")[[testName]]$df, 3)}, 0) + + aic <- vapply(results_grouped, AIC, 0) + bic <- vapply(results_grouped, BIC, 0) + Ns <- vapply(results_grouped, lavaan::lavInspect, 0, what = "ntotal") + + grouptab[["Model"]] <- models + grouptab[["group"]] <- rep(groupNames, length(rownames(lrt$value))) + grouptab[["AIC"]] <- aic + grouptab[["BIC"]] <- bic + grouptab[["N"]] <- Ns + grouptab[["Chisq"]] <- chiSq + grouptab[["Df"]] <- dfs + grouptab[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) + if (length(semResults) > 1) { + dchisq <- rep(NA, length(groupNames)) + ddf <- rep(NA, length(groupNames)) + dPrChisq <- rep(NA, length(groupNames)) + for(i in 1:(length(chiSq)-length(groupNames))) { + lrt <- lavaan::lavTestLRT(results_grouped[[i]], results_grouped[[i+length(groupNames)]]) + dchisq <- c(dchisq, ifelse(lrt[2, "Chisq diff"] < 1e-05, 0, lrt[2, "Chisq diff"])) + ddf <- c(ddf, lrt[2, "Df diff"]) + dPrChisq <- c(dPrChisq, lrt[2, "Pr(>Chisq)"]) + } + grouptab[["dchisq"]] <- dchisq + grouptab[["ddf"]] <- ddf + grouptab[["dPrChisq"]] <- dPrChisq + + } + if (test != "standard") { + grouptab$addFootnote(message = ftext) + } + } } .semParameters <- function(modelContainer, dataset, options, ready) { diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index c49d8c36..a74d6401 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -179,12 +179,35 @@ test_that("Multigroup, multimodel SEM works", { results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) fittab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] +<<<<<<< HEAD expect_equal_tables(fittab, list(3189.26691715402, 3383.93591869107, 85.6796813843018, 70, "default", 75, 0.0980338951401478, "", "", "", 3184.34803034567, 3372.06456754211, 87.9549367720082, 73, "constrained", 75, 0.111927575441416, 0.647754490401111, 1.65156784895969, 3, 3181.07183366569, 3361.83590652152, 92.7433708195334, 76, "more constrained", 75, 0.0929761753674234, 0.110596895607335, 6.02091896557529, 3), "Model fit table") +======= + expect_equal_tables(fittab, list(3189.26691715402, 3383.93591869107, 85.6796813843025, 70, "default", + 75, 0.0980338951401389, "", "", "", 3184.34803034567, 3372.06456754211, + 87.9549367720072, 73, "constrained", 75, 0.111927575441429, + 0.647754490401136, 1.65156784895958, 3, 3181.07183366569, 3361.83590652152, + 92.7433708195597, 76, "more constrained", 75, 0.0929761753671129, + 0.110596895607244, 6.02091896557718, 3), "Model fit table") + + grouptab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_grouptab"]][["data"]] + expect_equal_tables(grouptab, list(1554.81154499834, 1622.4700973294, 51.6035277328317, 35, "default", + 37, 0.0348827227017026, "", "", "", 1, 1634.45537215556, 1703.23399086407, + 34.0761536514708, 35, "default", 38, 0.512542051610495, "", + "", "", 2, 1549.89265811707, 1612.7184567102, 53.4279668719255, + 38, "constrained", 37, 0.0495817824685969, 0.647670229628093, + 1.65194318186774, 3, 1, 1634.45537215827, 1703.23399086677, + 34.5269699000817, 35, "constrained", 38, 0.490791865857937, + "", 0, 0, 2, 1549.89265811344, 1612.71845670656, 54.5525537466226, + 38, "more constrained", 37, 0.0399564191888851, "", 0, 0, 1, + 1631.17917549795, 1695.04503572728, 38.1908170729371, 38, "more constrained", + 38, 0.460812777513164, 0.110723819122933, 6.0182887677031, 3, + 2), "Model fit by group table") +>>>>>>> 6daf3fe21 (added fit by group table) rsquared <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] From 649810802f80d4f83c15a30aeaef6c9cc2353b70 Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Wed, 21 Feb 2024 14:04:41 +0100 Subject: [PATCH 02/10] small changes requested by simon --- R/sem.R | 6 +++--- tests/testthat/test-sem.R | 10 +--------- 2 files changed, 4 insertions(+), 12 deletions(-) diff --git a/R/sem.R b/R/sem.R index 0c1a7dca..257d248a 100644 --- a/R/sem.R +++ b/R/sem.R @@ -662,16 +662,16 @@ checkLavaanModel <- function(model, availableVars) { grouptab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" ) grouptab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" ) grouptab$addColumnInfo(name = "N", title = gettext("n"), type = "integer") - grouptab$addColumnInfo(name = "Chisq", title = gettext("χ²"), type = "number" , + grouptab$addColumnInfo(name = "Chisq", title = "\u03C7\u00B2", type = "number" , overtitle = gettext("Baseline test")) grouptab$addColumnInfo(name = "Df", title = gettext("df"), type = "integer", overtitle = gettext("Baseline test")) grouptab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue", overtitle = gettext("Baseline test")) if (length(options[["models"]]) > 1) { - grouptab$addColumnInfo(name = "dchisq", title = gettext("\u0394\u03C7\u00B2"), type = "number" , + grouptab$addColumnInfo(name = "dchisq", title = "\u0394\u03C7\u00B2", type = "number" , overtitle = gettext("Difference test")) - grouptab$addColumnInfo(name = "ddf", title = gettext("\u0394df"), type = "integer", + grouptab$addColumnInfo(name = "ddf", title = gettextf("%1$sdf", "\u0394"), type = "integer", overtitle = gettext("Difference test")) grouptab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" , overtitle = gettext("Difference test")) diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index a74d6401..55538e97 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -179,14 +179,7 @@ test_that("Multigroup, multimodel SEM works", { results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) fittab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] -<<<<<<< HEAD - expect_equal_tables(fittab, list(3189.26691715402, 3383.93591869107, 85.6796813843018, 70, "default", - 75, 0.0980338951401478, "", "", "", 3184.34803034567, 3372.06456754211, - 87.9549367720082, 73, "constrained", 75, 0.111927575441416, 0.647754490401111, - 1.65156784895969, 3, 3181.07183366569, 3361.83590652152, 92.7433708195334, - 76, "more constrained", 75, 0.0929761753674234, 0.110596895607335, - 6.02091896557529, 3), "Model fit table") -======= + expect_equal_tables(fittab, list(3189.26691715402, 3383.93591869107, 85.6796813843025, 70, "default", 75, 0.0980338951401389, "", "", "", 3184.34803034567, 3372.06456754211, 87.9549367720072, 73, "constrained", 75, 0.111927575441429, @@ -207,7 +200,6 @@ test_that("Multigroup, multimodel SEM works", { 1631.17917549795, 1695.04503572728, 38.1908170729371, 38, "more constrained", 38, 0.460812777513164, 0.110723819122933, 6.0182887677031, 3, 2), "Model fit by group table") ->>>>>>> 6daf3fe21 (added fit by group table) rsquared <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] From f6b85c942e7edb629552abc4d0f803b9d98f064f Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Wed, 21 Feb 2024 16:52:05 +0100 Subject: [PATCH 03/10] change layout of multigroup fit table --- R/sem.R | 122 ++++++++++++++++++-------------------- tests/testthat/test-sem.R | 31 +++++++--- 2 files changed, 82 insertions(+), 71 deletions(-) diff --git a/R/sem.R b/R/sem.R index 257d248a..9eafb2f1 100644 --- a/R/sem.R +++ b/R/sem.R @@ -634,6 +634,11 @@ checkLavaanModel <- function(model, availableVars) { fittab$position <- 0 fittab$addColumnInfo(name = "Model", title = "", type = "string" , combine = TRUE) + + if (options[["group"]] != "") { + fittab$addColumnInfo(name = "group", title = gettext("Group"), type = "string" ) + } + fittab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" ) fittab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" ) fittab$addColumnInfo(name = "N", title = gettext("n"), type = "integer") @@ -643,43 +648,17 @@ checkLavaanModel <- function(model, availableVars) { overtitle = gettext("Baseline test")) fittab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue", overtitle = gettext("Baseline test")) - fittab$addColumnInfo(name = "dchisq", title = gettext("Δχ²"), type = "number" , - overtitle = gettext("Difference test")) - fittab$addColumnInfo(name = "ddf", title = gettext("Δdf"), type = "integer", - overtitle = gettext("Difference test")) - fittab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" , - overtitle = gettext("Difference test")) - - modelContainer[["fittab"]] <- fittab - if (options[["group"]] != "") { - grouptab <- createJaspTable(title = gettext("Model fit by group")) - grouptab$dependOn("models") - grouptab$position <- 0.05 - - grouptab$addColumnInfo(name = "Model", title = "", type = "string" , combine = TRUE) - grouptab$addColumnInfo(name = "group", title = gettext("Group"), type = "string" ) - grouptab$addColumnInfo(name = "AIC", title = gettext("AIC"), type = "number" ) - grouptab$addColumnInfo(name = "BIC", title = gettext("BIC"), type = "number" ) - grouptab$addColumnInfo(name = "N", title = gettext("n"), type = "integer") - grouptab$addColumnInfo(name = "Chisq", title = "\u03C7\u00B2", type = "number" , - overtitle = gettext("Baseline test")) - grouptab$addColumnInfo(name = "Df", title = gettext("df"), type = "integer", - overtitle = gettext("Baseline test")) - grouptab$addColumnInfo(name = "PrChisq", title = gettext("p"), type = "pvalue", - overtitle = gettext("Baseline test")) - if (length(options[["models"]]) > 1) { - grouptab$addColumnInfo(name = "dchisq", title = "\u0394\u03C7\u00B2", type = "number" , - overtitle = gettext("Difference test")) - grouptab$addColumnInfo(name = "ddf", title = gettextf("%1$sdf", "\u0394"), type = "integer", - overtitle = gettext("Difference test")) - grouptab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" , - overtitle = gettext("Difference test")) - } - - modelContainer[["grouptab"]] <- grouptab + if (length(options[["models"]]) > 1) { + fittab$addColumnInfo(name = "dchisq", title = "\u0394\u03C7\u00B2", type = "number" , + overtitle = gettext("Difference test")) + fittab$addColumnInfo(name = "ddf", title = gettextf("%1$sdf", "\u0394"), type = "integer", + overtitle = gettext("Difference test")) + fittab$addColumnInfo(name = "dPrChisq", title = gettext("p"), type = "pvalue" , + overtitle = gettext("Difference test")) } + modelContainer[["fittab"]] <- fittab if (!ready) return() @@ -722,25 +701,32 @@ checkLavaanModel <- function(model, availableVars) { lrt$value[["Df"]] <- chis[2, ] lrt$value[["PrChisq"]] <- chis[3, ] + lrt$value[1,5:7] <- NA chiSq <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat})) dfs <- unlist(lapply(semResults, function(x) {round(lavaan::lavInspect(x, what = "test")[[testName]]$df, 3)})) } - fittab[["Model"]] <- rownames(lrt$value) - fittab[["AIC"]] <- lrt$value[["AIC"]] - fittab[["BIC"]] <- lrt$value[["BIC"]] - fittab[["N"]] <- Ns - fittab[["Chisq"]] <- chiSq - fittab[["Df"]] <- dfs - fittab[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) - fittab[["dchisq"]] <- lrt$value[["Chisq diff"]] - fittab[["ddf"]] <- lrt$value[["Df diff"]] - fittab[["dPrChisq"]] <- lrt$value[["Pr(>Chisq)"]] + dtFill <- data.frame(matrix(ncol = 0, nrow = length(rownames(lrt$value)))) + + dtFill[["Model"]] <- rownames(lrt$value) + dtFill[["AIC"]] <- lrt$value[["AIC"]] + dtFill[["BIC"]] <- lrt$value[["BIC"]] + dtFill[["N"]] <- Ns + dtFill[["Chisq"]] <- chiSq + dtFill[["Df"]] <- dfs + dtFill[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) + + if (length(options[["models"]]) > 1) { + dtFill[["dchisq"]] <- lrt$value[["Chisq diff"]] + dtFill[["ddf"]] <- lrt$value[["Df diff"]] + dtFill[["dPrChisq"]] <- lrt$value[["Pr(>Chisq)"]] + } # add warning footnote + fnote <- "" if (!is.null(lrt$warnings)) { - fittab$addFootnote(gsub("lavaan WARNING: ", "", lrt$warnings[[1]]$message)) + fnote <- paste0(fnote, gsub("lavaan WARNING: ", "", lrt$warnings[[1]]$message)) } if(options$naAction == "listwise"){ @@ -748,7 +734,7 @@ checkLavaanModel <- function(model, availableVars) { if (nrm != 0) { missingFootnote <- gettextf("A total of %g cases were removed due to missing values. You can avoid this by choosing 'FIML' under 'Missing Data Handling' in the Estimation options.", nrm) - fittab$addFootnote(message = missingFootnote) + fnote <- paste0(fnote, missingFootnote) } } @@ -776,12 +762,14 @@ checkLavaanModel <- function(model, availableVars) { if (length(semResults) > 1) ftext <- gettextf("Baseline tests based on %s. Difference tests based on a function of two standard test-statistics.", testname) - fittab$addFootnote(message = ftext) + fnote <- paste0(fnote, ftext) + } if (options$estimator %in% c("dwls", "gls", "wls", "uls")) { - fittab$addFootnote(message = gettext("The AIC, BIC and additional information criteria are only available with ML-type estimators")) + fnote <- paste0(fnote, gettext("The AIC, BIC and additional information criteria are only available with ML-type estimators")) } + if (options[["group"]] != "") { groupNames <- semResults[[1]]@Data@group.label @@ -810,7 +798,7 @@ checkLavaanModel <- function(model, availableVars) { fit_group <- try(do.call(lavaan::lavaan, lav_args)) if (isTryError(fit_group)) { errormsg <- gettextf("The model fit by group is unavailable for the specified model: %s", options[["models"]][[i]][["name"]]) - grouptab$setError(errormsg) + fittab$setError(errormsg) break } results_grouped[[k]] <- fit_group @@ -825,14 +813,17 @@ checkLavaanModel <- function(model, availableVars) { bic <- vapply(results_grouped, BIC, 0) Ns <- vapply(results_grouped, lavaan::lavInspect, 0, what = "ntotal") - grouptab[["Model"]] <- models - grouptab[["group"]] <- rep(groupNames, length(rownames(lrt$value))) - grouptab[["AIC"]] <- aic - grouptab[["BIC"]] <- bic - grouptab[["N"]] <- Ns - grouptab[["Chisq"]] <- chiSq - grouptab[["Df"]] <- dfs - grouptab[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) + dtFillGroup <- data.frame(matrix(ncol = 0, nrow = length(models))) + + dtFillGroup[["Model"]] <- models + dtFillGroup[["group"]] <- rep(groupNames, length(rownames(lrt$value))) + dtFillGroup[["AIC"]] <- aic + dtFillGroup[["BIC"]] <- bic + dtFillGroup[["N"]] <- Ns + dtFillGroup[["Chisq"]] <- chiSq + dtFillGroup[["Df"]] <- dfs + dtFillGroup[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) + if (length(semResults) > 1) { dchisq <- rep(NA, length(groupNames)) ddf <- rep(NA, length(groupNames)) @@ -843,15 +834,20 @@ checkLavaanModel <- function(model, availableVars) { ddf <- c(ddf, lrt[2, "Df diff"]) dPrChisq <- c(dPrChisq, lrt[2, "Pr(>Chisq)"]) } - grouptab[["dchisq"]] <- dchisq - grouptab[["ddf"]] <- ddf - grouptab[["dPrChisq"]] <- dPrChisq + dtFillGroup[["dchisq"]] <- dchisq + dtFillGroup[["ddf"]] <- ddf + dtFillGroup[["dPrChisq"]] <- dPrChisq } - if (test != "standard") { - grouptab$addFootnote(message = ftext) - } + dtFill[["group"]] <- gettext("all") + dtFill <- dtFill[, c(1, ncol(dtFill), 2:(ncol(dtFill)-1))] + dtFill <- rbind(dtFill, NA, dtFillGroup) + } + + fittab$setData(dtFill) + fittab$addFootnote(message = fnote) + } .semParameters <- function(modelContainer, dataset, options, ready) { diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index 55538e97..a808baaf 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -178,14 +178,29 @@ test_that("Multigroup, multimodel SEM works", { results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) - fittab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] - - expect_equal_tables(fittab, list(3189.26691715402, 3383.93591869107, 85.6796813843025, 70, "default", - 75, 0.0980338951401389, "", "", "", 3184.34803034567, 3372.06456754211, - 87.9549367720072, 73, "constrained", 75, 0.111927575441429, - 0.647754490401136, 1.65156784895958, 3, 3181.07183366569, 3361.83590652152, - 92.7433708195597, 76, "more constrained", 75, 0.0929761753671129, - 0.110596895607244, 6.02091896557718, 3), "Model fit table") + + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] + jaspTools::expect_equal_tables(table, + list(3189.26691715401, 3383.93591869106, 85.6796813843018, 70, "default", + 75, 0.0980338951401478, "", "", "", "all", 3184.34803034567, + 3372.06456754211, 87.9549367720082, 73, "constrained", 75, 0.111927575441416, + 0.647754490400887, 1.65156784896069, 3, "all", 3181.07183366569, + 3361.83590652152, 92.7433708195334, 76, "more constrained", + 75, 0.0929761753674234, 0.110596895611682, 6.02091896548516, + 3, "all", "", "", "", "", "", "", "", "", "", "", "", 1554.81154499834, + 1622.4700973294, 51.6035277328312, 35, "default", 37, 0.0348827227017056, + "", "", "", 1, 1634.45537215556, 1703.23399086407, 34.0761536514705, + 35, "default", 38, 0.512542051610508, "", "", "", 2, 1549.89265811708, + 1612.71845671021, 53.4279668719259, 38, "constrained", 37, 0.0495817824685928, + 0.647670189286977, 1.65194336157068, 3, 1, 1634.45537215827, + 1703.23399086677, 34.5269699000823, 35, "constrained", 38, 0.490791865857913, + "", 0, 0, 2, 1549.89265811344, 1612.71845670656, 54.5525537466071, + 38, "more constrained", 37, 0.0399564191890052, "", 0, 0, 1, + 1631.17917549794, 1695.04503572727, 38.1908170729263, 38, "more constrained", + 38, 0.460812777513654, 0.110723813861605, 6.01828887667228, + 3, 2), "Model fit table") + + grouptab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_grouptab"]][["data"]] expect_equal_tables(grouptab, list(1554.81154499834, 1622.4700973294, 51.6035277328317, 35, "default", From cc83c77d6a73f4d85376e7c19df00fa90c7c850f Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Wed, 21 Feb 2024 18:00:00 +0100 Subject: [PATCH 04/10] try fixing the tests, but more work to do --- R/sem.R | 8 +++++--- tests/testthat/test-sem.R | 5 ++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/R/sem.R b/R/sem.R index 9eafb2f1..a45acbf8 100644 --- a/R/sem.R +++ b/R/sem.R @@ -777,16 +777,16 @@ checkLavaanModel <- function(model, availableVars) { lavopts <- .semOptionsToLavOptions(options, dataset) lavopts[["group"]] <- NULL results_grouped <- list() - k = 1 + k <- 1 for (i in 1:length(options[["models"]])) { syntax <- lavaan::parTable(semResults[[i]]) for (group in seq_along(groupNames)) { lav_args <- lavopts syntax_group <- syntax[syntax$group == group,] - equalityConstraints <- syntax[syntax$op == "==",] + equalityConstraints <- syntax[syntax$op == "==", ] if (nrow(equalityConstraints) > 0) { for (j in 1:nrow(equalityConstraints)) { - if(equalityConstraints[j, "lhs"] %in% syntax_group[, "plabel"]) { + if (equalityConstraints[j, "lhs"] %in% syntax_group[, "plabel"]) { syntax_group <- rbind(syntax_group, equalityConstraints[j,]) } } @@ -795,7 +795,9 @@ checkLavaanModel <- function(model, availableVars) { lav_args[["model"]] <- syntax_group dataset_group <- dataset[dataset[[options[["group"]]]] == groupNames[group],] lav_args[["data"]] <- dataset_group + fit_group <- try(do.call(lavaan::lavaan, lav_args)) + if (isTryError(fit_group)) { errormsg <- gettextf("The model fit by group is unavailable for the specified model: %s", options[["models"]][[i]][["name"]]) fittab$setError(errormsg) diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index a808baaf..5db2b74d 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -15,7 +15,7 @@ fittab <- results[["results"]][["modelContainer"]][["collection"]][["modelCont test_that("Basic SEM fit table works", { if (jaspBase::getOS() == "linux") skip("Skipped for now cause that part of the table is removed in another PR anyways") - expect_equal_tables(fittab, list(48.156355426353, 59.7437959940346, 0, 0, "Model1", 75, 1, "", 0, 0), "Model fit table") + expect_equal_tables(fittab, list(48.156355426353, 59.7437959940346, 0, 0, "Model1", 75, 1), "Model fit table") }) parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]] @@ -646,8 +646,7 @@ test_that("Bootstrapping model fit table works", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] jaspTools::expect_equal_tables(table, - list(48.1563554263444, 59.7437959940259, 0, 0, "Model1", 75, 1, "", - 0, 0), + list(48.1563554263444, 59.7437959940259, 0, 0, "Model1", 75, 1), label = "Model fit table results match") }) From 2016c9d728504dbfc2a01c9c7be3a49489357e7e Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Fri, 23 Feb 2024 09:48:08 +0100 Subject: [PATCH 05/10] fit per group needs more work --- R/sem.R | 81 ++++++++++++++------------------------- tests/testthat/test-sem.R | 16 -------- 2 files changed, 28 insertions(+), 69 deletions(-) diff --git a/R/sem.R b/R/sem.R index a45acbf8..7a278ee1 100644 --- a/R/sem.R +++ b/R/sem.R @@ -18,6 +18,8 @@ SEMInternal <- 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/") + sink(file = "~/Downloads/log.txt") + on.exit(sink(NULL)) # Read dataset options <- .semPrepOpts(options) @@ -774,76 +776,49 @@ checkLavaanModel <- function(model, availableVars) { groupNames <- semResults[[1]]@Data@group.label models <- rep(rownames(lrt$value), each = length(groupNames)) - lavopts <- .semOptionsToLavOptions(options, dataset) - lavopts[["group"]] <- NULL - results_grouped <- list() - k <- 1 - for (i in 1:length(options[["models"]])) { - syntax <- lavaan::parTable(semResults[[i]]) - for (group in seq_along(groupNames)) { - lav_args <- lavopts - syntax_group <- syntax[syntax$group == group,] - equalityConstraints <- syntax[syntax$op == "==", ] - if (nrow(equalityConstraints) > 0) { - for (j in 1:nrow(equalityConstraints)) { - if (equalityConstraints[j, "lhs"] %in% syntax_group[, "plabel"]) { - syntax_group <- rbind(syntax_group, equalityConstraints[j,]) - } - } - } - syntax_group[["group"]] <- syntax_group[["block"]] <- rep(1, nrow(syntax_group)) - lav_args[["model"]] <- syntax_group - dataset_group <- dataset[dataset[[options[["group"]]]] == groupNames[group],] - lav_args[["data"]] <- dataset_group + modelDfs <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$df})) + print(modelDfs) - fit_group <- try(do.call(lavaan::lavaan, lav_args)) + # so the models from the lrt are ordered so the model with fewer dfs is up, we should check that and + # adjust accorindlgy + # also need to check what happens with the likelihood and a different test? + # shouldnt the likleihood come before the test + # so does the LRT for models then depend on the test in each model? - if (isTryError(fit_group)) { - errormsg <- gettextf("The model fit by group is unavailable for the specified model: %s", options[["models"]][[i]][["name"]]) - fittab$setError(errormsg) - break - } - results_grouped[[k]] <- fit_group - k = k + 1 - } - } + # also see if unlist is the way to go, probably not: - chiSq <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat.group})) - dfs <- vapply(results_grouped, function(x) {round(lavaan::lavInspect(x, what = "test")[[testName]]$df, 3)}, 0) - aic <- vapply(results_grouped, AIC, 0) - bic <- vapply(results_grouped, BIC, 0) - Ns <- vapply(results_grouped, lavaan::lavInspect, 0, what = "ntotal") + chiSq <- lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat.group}) + logLGroup <- unlist(lapply(semResults, function(x) x@loglik$loglik.group)) + npar <- unlist(lapply(semResults, function(x) x@loglik$npar)) + aics <- -2 * logLGroup + 2 * npar + Ns <- unlist(lapply(semResults, function(x) x@Data@nobs)) + bics <- -2 * logLGroup + npar * log(Ns) dtFillGroup <- data.frame(matrix(ncol = 0, nrow = length(models))) dtFillGroup[["Model"]] <- models dtFillGroup[["group"]] <- rep(groupNames, length(rownames(lrt$value))) - dtFillGroup[["AIC"]] <- aic - dtFillGroup[["BIC"]] <- bic + dtFillGroup[["AIC"]] <- aics + dtFillGroup[["BIC"]] <- bics dtFillGroup[["N"]] <- Ns dtFillGroup[["Chisq"]] <- chiSq - dtFillGroup[["Df"]] <- dfs - dtFillGroup[["PrChisq"]] <- pchisq(q = chiSq, df = dfs, lower.tail = FALSE) + dtFillGroup[["Df"]] <- NA + dtFillGroup[["PrChisq"]] <- NA + # we want the LRT for multiple models if (length(semResults) > 1) { - dchisq <- rep(NA, length(groupNames)) - ddf <- rep(NA, length(groupNames)) - dPrChisq <- rep(NA, length(groupNames)) - for(i in 1:(length(chiSq)-length(groupNames))) { - lrt <- lavaan::lavTestLRT(results_grouped[[i]], results_grouped[[i+length(groupNames)]]) - dchisq <- c(dchisq, ifelse(lrt[2, "Chisq diff"] < 1e-05, 0, lrt[2, "Chisq diff"])) - ddf <- c(ddf, lrt[2, "Df diff"]) - dPrChisq <- c(dPrChisq, lrt[2, "Pr(>Chisq)"]) - } - dtFillGroup[["dchisq"]] <- dchisq - dtFillGroup[["ddf"]] <- ddf - dtFillGroup[["dPrChisq"]] <- dPrChisq + + # lrts <- -2 * log() + + # dtFillGroup[["dchisq"]] <- dchisq + # dtFillGroup[["ddf"]] <- ddf + # dtFillGroup[["dPrChisq"]] <- dPrChisq } dtFill[["group"]] <- gettext("all") dtFill <- dtFill[, c(1, ncol(dtFill), 2:(ncol(dtFill)-1))] - dtFill <- rbind(dtFill, NA, dtFillGroup) + dtFill <- rbind(dtFill, dtFillGroup) } diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index 5db2b74d..1878fa6b 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -201,22 +201,6 @@ test_that("Multigroup, multimodel SEM works", { 3, 2), "Model fit table") - - grouptab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_grouptab"]][["data"]] - expect_equal_tables(grouptab, list(1554.81154499834, 1622.4700973294, 51.6035277328317, 35, "default", - 37, 0.0348827227017026, "", "", "", 1, 1634.45537215556, 1703.23399086407, - 34.0761536514708, 35, "default", 38, 0.512542051610495, "", - "", "", 2, 1549.89265811707, 1612.7184567102, 53.4279668719255, - 38, "constrained", 37, 0.0495817824685969, 0.647670229628093, - 1.65194318186774, 3, 1, 1634.45537215827, 1703.23399086677, - 34.5269699000817, 35, "constrained", 38, 0.490791865857937, - "", 0, 0, 2, 1549.89265811344, 1612.71845670656, 54.5525537466226, - 38, "more constrained", 37, 0.0399564191888851, "", 0, 0, 1, - 1631.17917549795, 1695.04503572728, 38.1908170729371, 38, "more constrained", - 38, 0.460812777513164, 0.110723819122933, 6.0182887677031, 3, - 2), "Model fit by group table") - - rsquared <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] expect_equal_tables(rsquared, list(1, "x1", 0.883076871616545, 0.88344099961725, 0.883440941017356, 1, "x2", 0.993698159869737, 0.993307380054294, 0.993308312239008, From 4483550715e16dc8001eb1b0fdef9b1909e5d51a Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Fri, 23 Feb 2024 14:25:58 +0100 Subject: [PATCH 06/10] model fit by group table finish --- R/sem.R | 44 +- tests/testthat/test-sem.R | 985 +++++++++++++++++++------------------- 2 files changed, 508 insertions(+), 521 deletions(-) diff --git a/R/sem.R b/R/sem.R index 7a278ee1..940834ee 100644 --- a/R/sem.R +++ b/R/sem.R @@ -18,8 +18,6 @@ SEMInternal <- 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/") - sink(file = "~/Downloads/log.txt") - on.exit(sink(NULL)) # Read dataset options <- .semPrepOpts(options) @@ -777,43 +775,43 @@ checkLavaanModel <- function(model, availableVars) { groupNames <- semResults[[1]]@Data@group.label models <- rep(rownames(lrt$value), each = length(groupNames)) modelDfs <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$df})) - print(modelDfs) - # so the models from the lrt are ordered so the model with fewer dfs is up, we should check that and - # adjust accorindlgy - # also need to check what happens with the likelihood and a different test? - # shouldnt the likleihood come before the test - # so does the LRT for models then depend on the test in each model? - # also see if unlist is the way to go, probably not: + modelDfs <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$df})) + ord <- match(modelDfs, sort(modelDfs)) + + chiSq <- sapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat.group}) + logLGroup <- sapply(semResults, function(x) x@loglik$loglik.group) + npar <- sapply(semResults, function(x) x@loglik$npar) + aics <- -2 * logLGroup + 2 * matrix(npar, nrow(logLGroup), ncol(logLGroup), byrow = TRUE) + Ns <- sapply(semResults, function(x) x@Data@nobs) + bics <- -2 * logLGroup + matrix(npar, nrow(logLGroup), ncol(logLGroup), byrow = TRUE) * matrix(sapply(Ns, log), nrow(Ns), ncol(Ns)) - chiSq <- lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat.group}) - logLGroup <- unlist(lapply(semResults, function(x) x@loglik$loglik.group)) - npar <- unlist(lapply(semResults, function(x) x@loglik$npar)) - aics <- -2 * logLGroup + 2 * npar - Ns <- unlist(lapply(semResults, function(x) x@Data@nobs)) - bics <- -2 * logLGroup + npar * log(Ns) + aics <- aics[, ord] + bics <- bics[, ord] dtFillGroup <- data.frame(matrix(ncol = 0, nrow = length(models))) dtFillGroup[["Model"]] <- models dtFillGroup[["group"]] <- rep(groupNames, length(rownames(lrt$value))) - dtFillGroup[["AIC"]] <- aics - dtFillGroup[["BIC"]] <- bics - dtFillGroup[["N"]] <- Ns - dtFillGroup[["Chisq"]] <- chiSq + dtFillGroup[["AIC"]] <- c(aics) + dtFillGroup[["BIC"]] <- c(bics) + dtFillGroup[["N"]] <- c(Ns) + dtFillGroup[["Chisq"]] <- c(chiSq) dtFillGroup[["Df"]] <- NA dtFillGroup[["PrChisq"]] <- NA # we want the LRT for multiple models if (length(semResults) > 1) { - # lrts <- -2 * log() + # so the LRT for the models by group depends on the test statistic used + # but lavaan does not provide this + # it is also not very clear how sensible it is to calculate the fit for each group anyways - # dtFillGroup[["dchisq"]] <- dchisq - # dtFillGroup[["ddf"]] <- ddf - # dtFillGroup[["dPrChisq"]] <- dPrChisq + dtFillGroup[["dchisq"]] <- NA + dtFillGroup[["ddf"]] <- NA + dtFillGroup[["dPrChisq"]] <- NA } dtFill[["group"]] <- gettext("all") diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index 1878fa6b..f4fd2f30 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -99,86 +99,84 @@ test_that("reliability/ AVE/ htmt works", { "total", 0.91494164193877, 0.919205517992938)) }) +# Multigroup, multimodel SEM works +options <- jaspTools::analysisOptions("SEM") +options$emulation = "lavaan" +options$estimator = "default" +options$group = "group" +options$informationMatrix = "expected" +options$meanStructure = TRUE +options$modificationIndexLowHidden = TRUE +options$naAction = "listwise" +options$impliedCovariance = TRUE +options$mardiasCoefficient = TRUE +options$modificationIndex = TRUE +options$observedCovariance = TRUE +options$pathPlot = TRUE +options$rSquared = TRUE +options$residualCovariance = TRUE +options$standardizedResidual = TRUE +options$pathPlotParameter = TRUE +options$standardizedEstimate = TRUE +options$modelTest = "satorraBentler" +options$samplingWeights = "" +modelDefault <- list(model = " +# latent variable definitions + ind60 =~ x1 + x2 + x3 + dem60 =~ y1 + y2 + y3 + y4 + dem65 =~ y5 + y6 + y7 + y8 +# regressions + dem60 ~ ind60 + dem65 ~ ind60 + dem60 +# residual (co)variances + y1 ~~ y5 + y2 ~~ y4 + y6 + y3 ~~ y7 + y4 ~~ y8 + y6 ~~ y8 +", columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")) +modelConstrained <- list(model = " +# latent variable definitions + ind60 =~ x1 + x2 + x3 + dem60 =~ c(a1,a2)*y1 + c(b1,b2)*y2 + c(c1,c2)*y3 + c(d1,d2)*y4 + dem65 =~ c(a1,a3)*y5 + c(b1,b3)*y6 + c(c1,c3)*y7 + c(d1,d3)*y8 +# regressions + dem60 ~ ind60 + dem65 ~ ind60 + dem60 +# residual (co)variances + y1 ~~ y5 + y2 ~~ y4 + y6 + y3 ~~ y7 + y4 ~~ y8 + y6 ~~ y8 +", columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")) +modelMoreConstrained <- list(model = " +# latent variable definitions + ind60 =~ x1 + x2 + x3 + dem60 =~ c(a1, a2)*y1 + c(b1, b2)*y2 + c(c1, c2)*y3 + c(d1, d2)*y4 + dem65 =~ c(a1, a2)*y5 + c(b1, b2)*y6 + c(c1, c2)*y7 + c(d1, d2)*y8 +# regressions + dem60 ~ ind60 + dem65 ~ ind60 + dem60 +# residual (co)variances + y1 ~~ y5 + y2 ~~ y4 + y6 + y3 ~~ y7 + y4 ~~ y8 + y6 ~~ y8 +", columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")) -test_that("Multigroup, multimodel SEM works", { - options <- jaspTools::analysisOptions("SEM") - options$emulation = "lavaan" - options$estimator = "default" - options$group = "group" - options$informationMatrix = "expected" - options$meanStructure = TRUE - options$modificationIndexLowHidden = TRUE - options$naAction = "listwise" - options$impliedCovariance = TRUE - options$mardiasCoefficient = TRUE - options$modificationIndex = TRUE - options$observedCovariance = TRUE - options$pathPlot = TRUE - options$rSquared = TRUE - options$residualCovariance = TRUE - options$standardizedResidual = TRUE - options$pathPlotParameter = TRUE - options$standardizedEstimate = TRUE - options$latentInterceptFixedToZero <- TRUE - options$modelTest = "satorraBentler" - options$samplingWeights = "" - - modelDefault <- list(model = " - # latent variable definitions - ind60 =~ x1 + x2 + x3 - dem60 =~ y1 + y2 + y3 + y4 - dem65 =~ y5 + y6 + y7 + y8 - # regressions - dem60 ~ ind60 - dem65 ~ ind60 + dem60 - # residual (co)variances - y1 ~~ y5 - y2 ~~ y4 + y6 - y3 ~~ y7 - y4 ~~ y8 - y6 ~~ y8 - ", columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")) - modelConstrained <- list(model = " - # latent variable definitions - ind60 =~ x1 + x2 + x3 - dem60 =~ c(a1,a2)*y1 + c(b1,b2)*y2 + c(c1,c2)*y3 + c(d1,d2)*y4 - dem65 =~ c(a1,a3)*y5 + c(b1,b3)*y6 + c(c1,c3)*y7 + c(d1,d3)*y8 - # regressions - dem60 ~ ind60 - dem65 ~ ind60 + dem60 - # residual (co)variances - y1 ~~ y5 - y2 ~~ y4 + y6 - y3 ~~ y7 - y4 ~~ y8 - y6 ~~ y8 - ", columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")) - modelMoreConstrained <- list(model = " - # latent variable definitions - ind60 =~ x1 + x2 + x3 - dem60 =~ c(a1, a2)*y1 + c(b1, b2)*y2 + c(c1, c2)*y3 + c(d1, d2)*y4 - dem65 =~ c(a1, a2)*y5 + c(b1, b2)*y6 + c(c1, c2)*y7 + c(d1, d2)*y8 - # regressions - dem60 ~ ind60 - dem65 ~ ind60 + dem60 - # residual (co)variances - y1 ~~ y5 - y2 ~~ y4 + y6 - y3 ~~ y7 - y4 ~~ y8 - y6 ~~ y8 - ", columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")) - - options$models = list( - list(name = "default", syntax = modelDefault), - list(name = "constrained", syntax = modelConstrained), - list(name = "more constrained", syntax = modelMoreConstrained) - ) +options$models = list( + list(name = "default", syntax = modelDefault), + list(name = "constrained", syntax = modelConstrained), + list(name = "more constrained", syntax = modelMoreConstrained) +) - results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) +results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) +test_that("Model fit table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] jaspTools::expect_equal_tables(table, list(3189.26691715401, 3383.93591869106, 85.6796813843018, 70, "default", @@ -187,421 +185,420 @@ test_that("Multigroup, multimodel SEM works", { 0.647754490400887, 1.65156784896069, 3, "all", 3181.07183366569, 3361.83590652152, 92.7433708195334, 76, "more constrained", 75, 0.0929761753674234, 0.110596895611682, 6.02091896548516, - 3, "all", "", "", "", "", "", "", "", "", "", "", "", 1554.81154499834, - 1622.4700973294, 51.6035277328312, 35, "default", 37, 0.0348827227017056, - "", "", "", 1, 1634.45537215556, 1703.23399086407, 34.0761536514705, - 35, "default", 38, 0.512542051610508, "", "", "", 2, 1549.89265811708, - 1612.71845671021, 53.4279668719259, 38, "constrained", 37, 0.0495817824685928, - 0.647670189286977, 1.65194336157068, 3, 1, 1634.45537215827, - 1703.23399086677, 34.5269699000823, 35, "constrained", 38, 0.490791865857913, - "", 0, 0, 2, 1549.89265811344, 1612.71845670656, 54.5525537466071, - 38, "more constrained", 37, 0.0399564191890052, "", 0, 0, 1, - 1631.17917549794, 1695.04503572727, 38.1908170729263, 38, "more constrained", - 38, 0.460812777513654, 0.110723813861605, 6.01828887667228, - 3, 2), "Model fit table") - - - rsquared <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] - expect_equal_tables(rsquared, list(1, "x1", 0.883076871616545, 0.88344099961725, 0.883440941017356, - 1, "x2", 0.993698159869737, 0.993307380054294, 0.993308312239008, - 1, "x3", 0.734550879193546, 0.734754000085834, 0.734752992615769, - 1, "y1", 0.76374604003533, 0.783825225382152, 0.783824495338428, - 1, "y2", 0.526988232837519, 0.469805811235219, 0.469797871843766, - 1, "y3", 0.540743668690899, 0.602813004892641, 0.602813008520997, - 1, "y4", 0.758371834315633, 0.715732725592277, 0.715727580943472, - 1, "y5", 0.74873567690424, 0.760689523184987, 0.760685788176897, - 1, "y6", 0.626089440009365, 0.636528021958327, 0.636530171924641, - 1, "y7", 0.729758226751308, 0.710375682244039, 0.71037601689489, - 1, "y8", 0.574575906571731, 0.588831799668115, 0.588835817501729, - 1, "dem60", 0.275927380324134, 0.258157185403394, 0.258145005894915, - 1, "dem65", 0.941713333219213, 0.938883931908498, 0.938882940520396, - 2, "x1", 0.787475869571125, 0.78747617521673, 0.788439850883342, - 2, "x2", 0.90066092940223, 0.900660946749863, 0.900202685338541, - 2, "x3", 0.749867733548725, 0.749868295135393, 0.749372699570588, - 2, "y1", 0.731921944773149, 0.731929437708713, 0.683849857838249, - 2, "y2", 0.550065444500199, 0.55006739915162, 0.519184271086883, - 2, "y3", 0.465824888188388, 0.465819890503162, 0.543696244446076, - 2, "y4", 0.651968126202522, 0.651959003998254, 0.694898810552775, - 2, "y5", 0.536001769615456, 0.535995620432757, 0.598318029638657, - 2, "y6", 0.625808175301569, 0.625823134164411, 0.607599332020539, - 2, "y7", 0.658946836103404, 0.658945492261667, 0.618117097165422, - 2, "y8", 0.842442637402788, 0.842449295416932, 0.821972120799197, - 2, "dem60", 0.0753599955960172, 0.0753581296999281, 0.0905522598180797, - 2, "dem65", 0.956917027167473, 0.956910675588687, 0.977886505597527), "R-squared table") - - mardia <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_mardiasTable"]][["data"]] - expect_equal_tables(mardia, list(330.8978096739, 26.471824773912, 286, "Skewness", 0.0347860345067638, - "", "", 134.567190822067, "", "Kurtosis", 0.0308358026617131, - -2.15918518879414), "Mardia's coefficient table") - - # parameter tables (use only the most constrained one, model 3) - parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][[3]][["collection"]] - - parcov <- parcont[["modelContainer_params_more constrained_cov"]][["data"]] - parind <- parcont[["modelContainer_params_more constrained_ind"]][["data"]] - parlvar <- parcont[["modelContainer_params_more constrained_lvar"]][["data"]] - parmu <- parcont[["modelContainer_params_more constrained_mu"]][["data"]] - parreg <- parcont[["modelContainer_params_more constrained_reg"]][["data"]] - parvar <- parcont[["modelContainer_params_more constrained_var"]][["data"]] - partoteff <- parcont[["modelContainer_params_more constrained_toteff"]][["data"]] - parindeff <- parcont[["modelContainer_params_more constrained_indeff"]][["data"]] - - expect_equal_tables(parcov, list(-0.6954531542207, 1.13004177555805, 0.217294310668675, 1, "", - "y1 - y5", 0.640785259230165, 0.465696039360422, 0.122229400273098, - 0.217294310668675, 0.122229400273098, 0.466601156769773, 0.433556460847837, - 4.21291697813377, 2.3232367194908, 1, "", "y2 - y4", 0.0159680098210626, - 0.964140297244501, 0.551561502186759, 2.3232367194908, 0.551561502186759, - 2.40964590540462, -0.453419237958842, 2.505951236881, 1.02626599946108, - 1, "", "y2 - y6", 0.17402837160491, 0.754955320144396, 0.193560311396125, - 1.02626599946108, 0.193560311396125, 1.35937316034119, -0.360831524130165, - 2.44595509715802, 1.04256178651393, 1, "", "y3 - y7", 0.145384170743897, - 0.716030152448658, 0.308401783418161, 1.04256178651393, 0.308401783418161, - 1.45603056372502, -1.1752514946784, 0.804530353606003, -0.185360570536198, - 1, "", "y4 - y8", 0.713611427442158, 0.505055670384933, -0.055456132680955, - -0.185360570536198, -0.055456132680955, -0.367010176115681, - -0.214945884704212, 3.12165697220468, 1.45335554375024, 1, "", - "y6 - y8", 0.0877403085916073, 0.851189839004082, 0.345429944587142, - 1.45335554375024, 0.345429944587142, 1.70743995892938, -0.118867422075107, - 1.57858876509683, 0.729860671510864, 2, "", "y1 - y5", 0.0918990888281448, - 0.433032494617569, 0.378922580175638, 0.729860671510864, 0.378922580175638, - 1.68546397922271, -0.465368071384461, 3.32132373684828, 1.42797783273191, - 2, "", "y2 - y4", 0.139348430266928, 0.966010558893349, 0.272324473644576, - 1.42797783273191, 0.272324473644576, 1.47822176433329, 0.0620106319581817, - 4.11438168212343, 2.0881961570408, 2, "", "y2 - y6", 0.0433887887248896, - 1.0337871211231, 0.353104277180419, 2.0881961570408, 0.353104277180419, - 2.01994793161304, -1.37202057656756, 2.36286703932311, 0.495423231377773, - 2, "", "y3 - y7", 0.603085629226917, 0.95279496086433, 0.102496109909358, - 0.495423231377773, 0.102496109909358, 0.519968358069766, -0.467325344619643, - 1.95619519341019, 0.744434924395273, 2, "", "y4 - y8", 0.228555681753865, - 0.618256395818049, 0.289753166031978, 0.744434924395273, 0.289753166031978, - 1.20408770443898, -0.397060222176712, 2.20355649897539, 0.903248138399338, - 2, "", "y6 - y8", 0.173364480031275, 0.663434823717536, 0.311727419658627, - 0.903248138399338, 0.311727419658627, 1.3614723046011), "Covariance parameter table") - expect_equal_tables(parind, list(1, 1, 1, 1, "a1", "dem60", "", "y1", 0, 0.885338633144645, 2.42166834175017, - 0.885338633144645, "", 0.760887096093346, 1.33133716576763, - 1.04611213093049, 1, "b1", "dem60", 6.55031584528842e-13, "y2", - 0.145525651025714, 0.685418027078195, 2.53333662939518, 0.685418027078195, - 7.18850679283783, 0.783222538721785, 1.29591955303148, 1.03957104587663, - 1, "c1", "dem60", 1.99840144432528e-15, "y3", 0.130792458012948, - 0.776410335145661, 2.51749629079955, 0.776410335145661, 7.94824917025196, - 0.796321916480285, 1.25466669817794, 1.02549430732911, 1, "d1", - "dem60", 0, "y4", 0.116926837766668, 0.846006844501551, 2.48340709870393, - 0.846006844501551, 8.77039289624442, 1, 1, 1, 1, "a1", "dem65", - "", "y5", 0, 0.872173026513029, 2.49219827699714, 0.872173026513029, - "", 0.760887096093347, 1.33133716576763, 1.04611213093049, 1, - "b1", "dem65", 6.55031584528842e-13, "y6", 0.145525651025714, - 0.797828410076152, 2.60711885025078, 0.797828410076152, 7.18850679283783, - 0.783222538721786, 1.29591955303148, 1.03957104587663, 1, "c1", - "dem65", 1.99840144432528e-15, "y7", 0.130792458012948, 0.842838072760652, - 2.59081716934986, 0.842838072760652, 7.94824917025198, 0.796321916480285, - 1.25466669817794, 1.02549430732911, 1, "d1", "dem65", 0, "y8", - 0.116926837766668, 0.767356382329443, 2.55573514579599, 0.767356382329443, - 8.77039289624441, 1, 1, 1, 1, "", "ind60", "", "x1", 0, 0.9399153903503, - 0.657997769223687, 0.9399153903503, "", 1.94762156768515, 2.55197241207641, - 2.24979698988078, 1, "", "ind60", 0, "x2", 0.154173966756102, - 0.996648539977362, 1.48036140054772, 0.996648539977362, 14.5925867850302, - 1.40827986384489, 2.23529739101974, 1.82178862743232, 1, "", - "ind60", 0, "x3", 0.21097773573858, 0.857177340236995, 1.19873285284755, - 0.857177340236995, 8.63498046869587, 1, 1, 1, 2, "a2", "dem60", - "", "y1", 0, 0.826952149666623, 1.88731847029611, 0.826952149666623, - "", 1.00619302224548, 1.96819575821973, 1.4871943902326, 2, - "b2", "dem60", 1.3615824023816e-09, "y2", 0.245413370746198, - 0.720544426865466, 2.80680944160676, 0.720544426865466, 6.05995665888404, - 0.971906075502799, 1.81486423470296, 1.39338515510288, 2, "c2", - "dem60", 9.20110654334394e-11, "y3", 0.215044298224178, 0.737357609607493, - 2.62976153946208, 0.737357609607493, 6.47952615628205, 1.13497135653258, - 1.96970928417875, 1.55234032035566, 2, "d2", "dem60", 3.10418357685194e-13, - "y4", 0.212947261845238, 0.833605908420025, 2.92976055879263, - 0.833605908420025, 7.28978765401475, 1, 1, 1, 2, "a2", "dem65", - "", "y5", 0, 0.773510200087017, 1.83190459395535, 0.773510200087017, - "", 1.00619302224548, 1.96819575821973, 1.4871943902326, 2, - "b2", "dem65", 1.3615824023816e-09, "y6", 0.245413370746198, - 0.779486582322325, 2.72439823557173, 0.779486582322325, 6.05995665888404, - 0.971906075502799, 1.81486423470296, 1.39338515510288, 2, "c2", - "dem65", 9.20110654334394e-11, "y7", 0.215044298224178, 0.786204233749362, - 2.55254866678216, 0.786204233749362, 6.47952615628205, 1.13497135653258, - 1.96970928417875, 1.55234032035566, 2, "d2", "dem65", 3.10418357685194e-13, - "y8", 0.212947261845238, 0.906626781426181, 2.84373936424167, - 0.906626781426181, 7.28978765401476, 1, 1, 1, 2, "", "ind60", - "", "x1", 0, 0.887941355542888, 0.569877660945511, 0.887941355542888, - "", 1.83150200846409, 2.88878207416714, 2.36014204131561, 2, - "", "ind60", 0, "x2", 0.269719258629941, 0.948790116589829, - 1.34499222600411, 0.948790116589829, 8.75036529947522, 1.44864109706262, - 2.4658864657564, 1.95726378140951, 2, "", "ind60", 4.61852778244065e-14, - "x3", 0.259506138050923, 0.865663155950736, 1.11540090560302, - 0.865663155950736, 7.54226391757035), "Loadings parameter table") - expect_equal_tables(parlvar, list(0.209581796157056, 0.656340332449642, "ind60", 0.432961064303349, - 1, "", "ind60", 0.000145359164061443, 0.113971108606219, 1, - 1, 1, 3.79886683211329, 1.81562506860136, 6.88555885899937, - "dem60", 4.35059196380036, 1, "", "dem60", 0.000768902080227507, - 1.29337422278904, 0.741854994105085, 0.741854994105085, 0.741854994105085, - 3.3637534188819, -0.373266498808562, 1.1324689986252, "dem65", - 0.379601249908318, 1, "", "dem65", 0.323041135527759, 0.384123256679921, - 0.0611170594796042, 0.0611170594796042, 0.0611170594796042, - 0.988227719376618, 0.139438652248914, 0.51008244464054, "ind60", - 0.324760548444727, 2, "", "ind60", 0.000593282653738703, 0.0945537253018976, - 1, 1, 1, 3.43466687756415, 1.1885891662882, 5.29026380193365, - "dem60", 3.23942648411092, 2, "", "dem60", 0.00196225561471564, - 1.04636479751642, 0.90944774018192, 0.90944774018192, 0.90944774018192, - 3.09588634078651, -0.343713422100036, 0.492133643448633, "dem65", - 0.0742101106742985, 2, "", "dem65", 0.727819060322371, 0.213230210386957, - 0.0221134944024726, 0.0221134944024726, 0.0221134944024726, - 0.348028126688176), "Latent variance parameter table") - expect_equal_tables(parmu, list(5.114583249089, 5.56572485901911, 5.34015405405405, 1, "", "x1", - 0, 0.115089260182496, 7.62813069741675, 5.34015405405405, 7.62813069741675, - 46.4001075824643, 4.69962810017044, 5.65682865658632, 5.17822837837838, - 1, "", "x2", 0, 0.244188302429574, 3.48622556023865, 5.17822837837838, - 3.48622556023865, 21.2058822099876, 3.4912357243792, 4.39245184318836, - 3.94184378378378, 1, "", "x3", 0, 0.229906295706921, 2.81869239020784, - 3.94184378378378, 2.81869239020784, 17.145436455593, 5.0659390403021, - 6.8286555542925, 5.9472972972973, 1, "", "y1", 0, 0.449680843090609, - 2.17427463923019, 5.9472972972973, 2.17427463923019, 13.2255963060871, - 2.8433068923923, 5.22515797247257, 4.03423243243243, 1, "", - "y2", 3.1510793974121e-11, 0.607626236723739, 1.09149948827483, - 4.03423243243243, 1.09149948827483, 6.6393321891178, 5.71017508116214, - 7.79973464856759, 6.75495486486486, 1, "", "y3", 0, 0.533060705167961, - 2.08326693059709, 6.75495486486486, 2.08326693059709, 12.6720180260454, - 4.36666487548144, 6.25836052992396, 5.3125127027027, 1, "", - "y4", 0, 0.482584289651232, 1.80978064785815, 5.3125127027027, - 1.80978064785815, 11.0084659128504, 4.76881059441114, 6.61024886504832, - 5.68952972972973, 1, "", "y5", 0, 0.469763292887578, 1.99111539784598, - 5.68952972972973, 1.99111539784598, 12.1114821355174, 1.69721605838774, - 3.80307150917983, 2.75014378378378, 1, "", "y6", 3.0678012175045e-07, - 0.537217894666127, 0.841596785005017, 2.75014378378378, 0.841596785005017, - 5.11923338944798, 5.40096255495839, 7.38189582341999, 6.39142918918919, - 1, "", "y7", 0, 0.505349405419424, 2.07924353896195, 6.39142918918919, - 2.07924353896195, 12.6475446901625, 3.28677224232016, 5.43309959551768, - 4.35993591891892, 1, "", "y8", 1.77635683940025e-15, 0.547542549283426, - 1.30906547943089, 4.35993591891892, 1.30906547943089, 7.96273444798913, - 0, 0, 0, 1, "", "ind60", "", 0, 0, 0, 0, "", 0, 0, 0, 1, "", - "dem60", "", 0, 0, 0, 0, "", 0, 0, 0, 1, "", "dem65", "", 0, - 0, 0, 0, "", 4.57207725542129, 4.9801932708945, 4.77613526315789, - 2, "", "x1", 0, 0.10411314154045, 7.44182183380953, 4.77613526315789, - 7.44182183380953, 45.8744707199359, 3.96560094944749, 4.86703905055251, - 4.41632, 2, "", "x2", 0, 0.229962924884195, 3.11537917222519, - 4.41632, 3.11537917222519, 19.204486993823, 2.77397157389089, - 3.59331947874069, 3.18364552631579, 2, "", "x3", 0, 0.209021163478693, - 2.47082875753002, 3.18364552631579, 2.47082875753002, 15.2312113918566, - 4.2690970296885, 5.72037665452202, 4.99473684210526, 2, "", - "y1", 0, 0.370231197175312, 2.18850630331085, 4.99473684210526, - 2.18850630331085, 13.4908589017153, 3.23427002973344, 5.71134102289814, - 4.47280552631579, 2, "", "y2", 1.46083145580178e-12, 0.631917477235172, - 1.14822725286081, 4.47280552631579, 1.14822725286081, 7.07814815612578, - 5.24236503773425, 7.51026812016048, 6.37631657894737, 2, "", - "y3", 0, 0.578557335827383, 1.787852426998, 6.37631657894737, - 1.787852426998, 11.0210625362286, 2.49773616542863, 4.73263378193979, - 3.61518497368421, 2, "", "y4", 2.28425278692157e-10, 0.570137419396414, - 1.02862998310564, 3.61518497368421, 1.02862998310564, 6.3409010717302, - 3.84453746449672, 5.35053095655592, 4.59753421052632, 2, "", - "y5", 0, 0.384189072844778, 1.94127992190503, 4.59753421052632, - 1.94127992190503, 11.9668531342739, 2.0887392465132, 4.31127233243417, - 3.20000578947368, 2, "", "y6", 1.66224263242753e-08, 0.566983144448578, - 0.915564231278779, 3.20000578947368, 0.915564231278779, 5.64391696791245, - 4.97396373438834, 7.03851152876955, 6.00623763157895, 2, "", - "y7", 0, 0.526680033578704, 1.84996647323673, 6.00623763157895, - 1.84996647323673, 11.4039592326437, 2.73789322525061, 4.73245519580203, - 3.73517421052632, 2, "", "y8", 2.1227464230833e-13, 0.508826179022745, - 1.19082958696484, 3.73517421052632, 1.19082958696484, 7.34076658103582, - 0, 0, 0, 2, "", "ind60", "", 0, 0, 0, 0, "", 0, 0, 0, 2, "", - "dem60", "", 0, 0, 0, 0, "", 0, 0, 0, 2, "", "dem65", "", 0, - 0, 0, 0, ""), "Means parameter table") - expect_equal_tables(parreg, list(0.721100887386564, 3.01873119149832, 1.86991603944244, 1, "dem60", - 0.00142166660030174, "ind60", 0.586140950097851, 0.508079723955714, - 0.508079723955714, 0.508079723955714, 3.19021566251304, 0.478026990501928, - 1.96570674995725, 1.22186687022959, 1, "dem65", 0.00128400773281667, - "ind60", 0.379517116434269, 0.322601007439955, 0.322601007439955, - 0.322601007439955, 3.21953033820864, 0.572218807581072, 1.00102151163503, - 0.78662015960805, 1, "dem65", 6.43485265072741e-13, "dem60", - 0.109390454987004, 0.764358580570299, 0.764358580570299, 0.764358580570299, - 7.19093964552485, -0.154169499851477, 2.14733425618112, 0.99658237816482, - 2, "dem60", 0.0896244560523969, "ind60", 0.587129093745232, - 0.300919025350807, 0.300919025350807, 0.300919025350807, 1.69738203877401, - -0.115343312911686, 0.965518339191284, 0.425087513139799, 2, - "dem65", 0.12315820352967, "ind60", 0.275735079988375, 0.132238260925043, - 0.132238260925043, 0.132238260925043, 1.54165191152943, 0.730849486044932, - 1.09592060871138, 0.913385047378158, 2, "dem65", 0, "dem60", - 0.0931320997595074, 0.941014327982574, 0.941014327982574, 0.941014327982574, - 9.80741387488061), "Regressions parameter table") - expect_equal_tables(parvar, list(0.019971862523661, 0.0942758067618645, "x1", 0.0571238346427628, - 1, "", "x1", 0.00258179957955118, 0.0189554361264553, 0.116559058982644, - 0.0571238346427628, 0.116559058982644, 3.01358587909447, -0.119066895021194, - 0.148593743772327, "x2", 0.0147634243755663, 1, "", "x2", 0.828822156218558, - 0.0682820299007519, 0.00669168776099212, 0.0147634243755663, - 0.00669168776099212, 0.216212441209275, 0.265760017116629, 0.77173003351152, - "x3", 0.518745025314075, 1, "", "x3", 5.84703635451156e-05, - 0.129076355582531, 0.265247007384231, 0.518745025314075, 0.265247007384231, - 4.01890046378318, 0.416929012723307, 2.81786755996509, "y1", - 1.6173982863442, 1, "", "y1", 0.00827424337847726, 0.612495578025943, - 0.216175504661572, 1.6173982863442, 0.216175504661572, 2.64066932786197, - 3.64229436414009, 10.8436303032633, "y2", 7.24296233370169, - 1, "", "y2", 8.06075272521412e-05, 1.8371092519879, 0.530202128156234, - 7.24296233370169, 0.530202128156234, 3.94258660766322, 1.93231536174354, - 6.41948442904567, "y3", 4.17589989539461, 1, "", "y3", 0.000264281837194513, - 1.1447070208168, 0.397186991479003, 4.17589989539461, 0.397186991479003, - 3.64800758574445, 0.931737730528367, 3.96732278343115, "y4", - 2.44953025697976, 1, "", "y4", 0.00156076961142304, 0.774398171815168, - 0.284272419056528, 2.44953025697976, 0.284272419056528, 3.16314054724345, - 0.731947613472583, 3.17608668229141, "y5", 1.95401714788199, - 1, "", "y5", 0.00172519104089064, 0.623516321753329, 0.239314211823103, - 1.95401714788199, 0.239314211823103, 3.13386687679209, 1.83678103920313, - 5.92570847199455, "y6", 3.88124475559884, 1, "", "y6", 0.000198569846390217, - 1.04311290029928, 0.363469828075359, 3.88124475559884, 0.363469828075359, - 3.72082902482106, 1.19521510119136, 4.2780912840873, "y7", 2.73665319263933, - 1, "", "y7", 0.000501976062955434, 0.786462457273012, 0.28962398310511, - 2.73665319263933, 0.28962398310511, 3.47969972035084, 2.19176630693849, - 6.93007982455653, "y8", 4.56092306574751, 1, "", "y8", 0.000161182628549028, - 1.20877565990836, 0.411164182498271, 4.56092306574751, 0.411164182498271, - 3.7731757984714, 0.0313581547372507, 0.142926262721349, "x1", - 0.0871422087292997, 2, "", "x1", 0.00220063448354591, 0.0284617750285549, - 0.211560149116658, 0.0871422087292997, 0.211560149116658, 3.06172783116557, - -0.0362625145249454, 0.437358296920339, "x2", 0.200547891197697, - 2, "", "x2", 0.0969472731768826, 0.120823855739479, 0.0997973146614593, - 0.200547891197697, 0.0997973146614593, 1.65983687551007, 0.174335809406066, - 0.65785418558488, "x3", 0.416094997495473, 2, "", "x3", 0.000742674694836687, - 0.123348791098394, 0.250627300429412, 0.416094997495473, 0.250627300429412, - 3.37332043378973, 0.67728943233645, 2.61617514252359, "y1", - 1.64673228743002, 2, "", "y1", 0.000870742833376514, 0.494622790388198, - 0.316150142161751, 1.64673228743002, 0.316150142161751, 3.32926892862662, - 3.61992130179251, 10.9720172659021, "y2", 7.29596928384731, - 2, "", "y2", 0.000100243055731752, 1.87556914874508, 0.480815728913117, - 7.29596928384731, 0.480815728913117, 3.89000282326511, 2.80111563779673, - 8.80696575715111, "y3", 5.80404069747392, 2, "", "y3", 0.000151736573070549, - 1.53213277558357, 0.456303755553924, 5.80404069747392, 0.456303755553924, - 3.78820999718072, 1.47037447709196, 6.06693911089053, "y4", - 3.76865679399125, 2, "", "y4", 0.00130948831028421, 1.17261456589399, - 0.305101189447225, 3.76865679399125, 0.305101189447225, 3.21389218896327, - 1.06639719058268, 3.43954844740097, "y5", 2.25297281899183, - 2, "", "y5", 0.000198106085773642, 0.605406853273174, 0.401681970361344, - 2.25297281899183, 0.401681970361344, 3.72141941705974, 2.22486686951239, - 7.36215298126356, "y6", 4.79350992538798, 2, "", "y6", 0.00025457326577949, - 1.31055625314379, 0.392400667979461, 4.79350992538798, 0.392400667979461, - 3.65761478295129, 1.87928674169851, 6.1714850562742, "y7", 4.02538589898636, - 2, "", "y7", 0.000236681377467019, 1.09496866994292, 0.381882902834578, - 4.02538589898636, 0.381882902834578, 3.67625669070166, 0.346950686712466, - 3.15605228468781, "y8", 1.75150148570014, 2, "", "y8", 0.0145209073086436, - 0.716620718577785, 0.178027879200803, 1.75150148570014, 0.178027879200803, - 2.44411226230828), "(Residual) variances parameter table") - expect_equal_tables(partoteff, list(1.63130176674587, 3.75425928051304, 2.69278052362946, 1, " ind60 dem65", - 6.62397930284442e-07, 0.541580746001658, 0.710956104059294, - 0.710956104059294, 0.710956104059294, 4.97207580496447, 0.721100887386564, - 3.01873119149832, 1.86991603944244, 1, " ind60 dem60", - 0.00142166660030174, 0.586140950097851, 0.508079723955714, 0.508079723955714, - 0.508079723955714, 3.19021566251304, 0.572218807581072, 1.00102151163503, - 0.78662015960805, 1, " dem60 dem65", 6.43485265072741e-13, - 0.109390454987004, 0.764358580570299, 0.764358580570299, 0.764358580570299, - 7.19093964552485, 0.247077278790176, 2.42362463288204, 1.33535095583611, - 2, " ind60 dem65", 0.0161748412862954, 0.55525187484571, - 0.415407375342704, 0.415407375342704, 0.415407375342704, 2.40494632495778, - -0.154169499851477, 2.14733425618112, 0.99658237816482, 2, " ind60 dem60", - 0.0896244560523969, 0.587129093745232, 0.300919025350807, 0.300919025350807, - 0.300919025350807, 1.69738203877401, 0.730849486044932, 1.09592060871138, - 0.913385047378158, 2, " dem60 dem65", 0, 0.0931320997595074, - 0.941014327982574, 0.941014327982574, 0.941014327982574, 9.80741387488061), "Total effects table") - expect_equal_tables(parindeff, list(0.481357882787227, 2.46046942401251, 1.47091365339987, 1, "ind60 dem60 dem65", - 0.00357555663622788, 0.504884670544015, 0.388355096619339, 0.388355096619339, - 0.388355096619339, 2.91336564410829, -0.159005756965501, 1.97953264235812, - 0.910263442696311, 2, "ind60 dem60 dem65", - 0.0952150456736578, 0.545555534742511, 0.283169114417661, 0.283169114417661, - 0.283169114417661, 1.66850739242511), "Indirect effects table") - - # covariance tables. Use model 2, but the way this is ordered uses actually the default model - covcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][[2]][["collection"]] - covimp <- covcont[["modelContainer_covars_default_implied"]][["collection"]][["modelContainer_covars_default_implied_1"]][["data"]] - covobs <- covcont[["modelContainer_covars_default_observed"]][["collection"]][["modelContainer_covars_default_observed_1"]][["data"]] - covres <- covcont[["modelContainer_covars_default_residual"]][["collection"]][["modelContainer_covars_default_residual_1"]][["data"]] - covstd <- covcont[["modelContainer_covars_default_stdres"]][["collection"]][["modelContainer_covars_default_stdres_1"]][["data"]] - - expect_equal_tables(covimp, list(0.49008300563634, "", "", "", "", "", "", "", "", "", "", 0.974061924820936, - 2.20622852804642, "", "", "", "", "", "", "", "", "", 0.788491080043323, - 1.77466015582184, 1.95570584174645, "", "", "", "", "", "", - "", "", 0.835178540092752, 1.87973981648419, 1.5216261310825, - 7.64797977172544, "", "", "", "", "", "", "", 0.955666527250095, - 2.15092263069125, 1.74114526494313, 6.6837892939784, 14.5127221504755, - "", "", "", "", "", "", 0.788253740427639, 1.77412597456093, - 1.43613303237535, 5.51292920802481, 6.30825824454682, 9.62227326013948, - "", "", "", "", "", 0.904244744111686, 2.03518740934666, 1.647459034785, - 6.32415300473142, 9.23882105681506, 5.96882824654787, 9.02873362112345, - "", "", "", "", 1.14334478995368, 2.57333087773904, 2.08307951619225, - 5.82366205597868, 6.32427984118539, 5.21639829184987, 5.98398776520799, - 7.98119516009606, "", "", "", 1.18710886159188, 2.6718308559361, - 2.16281403020389, 5.73848644656917, 7.58931007411123, 5.41606756969487, - 6.21303824196686, 6.20454284533332, 10.2893215377554, "", "", - 1.25970543427747, 2.83522426425121, 2.29507897323411, 6.0894184140595, - 6.96791532513603, 6.91162808862569, 6.59299099686961, 6.58397607191045, - 6.83599243915776, 9.9403352106315, "", 1.15531617741013, 2.60027492931625, - 2.10489039267504, 5.58480055205702, 6.39049819021453, 5.27101657115423, - 5.85298682041024, 6.03837521104465, 7.68811256412372, 6.65291356937697, - 10.6193105678442), "Model-implied covariance table") - - expect_equal_tables(covobs, list(0.490082575997078, "", "", "", "", "", "", "", "", "", "", 0.973932449184952, - 2.20622591129467, "", "", "", "", "", "", "", "", "", 0.78518275394412, - 1.77565205254938, 1.95570361423433, "", "", "", "", "", "", - "", "", 0.842173686632578, 1.60646357669832, 1.14904644265887, - 7.62580350620891, "", "", "", "", "", "", "", 0.966640855417166, - 2.56661076528232, 2.30600417597728, 6.02486581738495, 14.676007521986, - "", "", "", "", "", "", 0.569651258731629, 1.29778304025924, - 0.751981605089701, 6.44636651314828, 5.79397804058276, 9.73209047934931, - "", "", "", "", "", 1.07850808055391, 2.50663181045844, 2.0195628491114, - 6.09461043973703, 9.30788611653126, 5.64475186161118, 9.01279131583053, - "", "", "", "", 1.23810412812272, 2.61063748721578, 1.81722127066318, - 5.59878435062089, 6.6520705502466, 5.03859665459321, 6.05661431962235, - 7.93189524242966, "", "", "", 1.43792308816034, 2.91763544604397, - 2.84145873393433, 5.38621551022644, 8.42865402090701, 4.21966332811402, - 6.90922843998977, 6.08535469304967, 10.3746040258343, "", "", - 1.04665319855464, 2.45836864046895, 1.77472198140307, 6.2463340788897, - 7.67698969559927, 6.73419489425259, 7.01801387855084, 6.81611022694302, - 6.30443702471928, 9.78003437719124, "", 1.23565159843141, 2.65937421505933, - 1.72765599854139, 5.4174694403214, 7.39753077439182, 4.59181056574472, - 6.45111697395995, 5.63862367744565, 7.7210072538895, 6.57011319209561, - 10.545706988345), "Observed covariance table") - - expect_equal_tables(covres, list(-4.29639262000681e-07, "", "", "", "", "", "", "", "", "", "", - -0.000129475635983867, -2.61675175305953e-06, "", "", "", "", - "", "", "", "", "", -0.00330832609920362, 0.000991896727542851, - -2.22751211431671e-06, "", "", "", "", "", "", "", "", 0.00699514653982602, - -0.273276239785871, -0.372579688423628, -0.0221762655165261, - "", "", "", "", "", "", "", 0.0109743281670703, 0.415688134591076, - 0.56485891103415, -0.65892347659345, 0.163285371510497, "", - "", "", "", "", "", -0.21860248169601, -0.476342934301688, -0.684151427285647, - 0.933437305123476, -0.514280203964063, 0.109817219209827, "", - "", "", "", "", 0.174263336442222, 0.471444401111776, 0.372103814326393, - -0.229542564994383, 0.0690650597162001, -0.324076384936694, - -0.0159423052929153, "", "", "", "", 0.094759338169033, 0.0373066094767367, - -0.265858245529067, -0.224877705357793, 0.327790709061214, -0.177801637256668, - 0.0726265544143621, -0.0492999176663993, "", "", "", 0.250814226568454, - 0.245804590107875, 0.678644703730438, -0.352270936342729, 0.839343946795778, - -1.19640424158084, 0.696190198022915, -0.119188152283651, 0.0852824880789491, - "", "", -0.213052235722835, -0.376855623782256, -0.52035699183104, - 0.156915664830205, 0.709074370463244, -0.177433194373092, 0.425022881681233, - 0.232134155032578, -0.531555414438472, -0.160300833440264, "", - 0.0803354210212817, 0.0590992857430783, -0.377234394133652, - -0.167331111735621, 1.00703258417729, -0.679206005409508, 0.598130153549711, - -0.399751533598995, 0.0328946897657785, -0.0828003772813588, - -0.073603579499208), "Residual covariance table") - - jaspTools::expect_equal_tables(covstd, - list(-4.29639261390058e-07, "", "", "", "", "", "", "", "", "", "", - -0.906062050868875, -2.61675175172726e-06, "", "", "", "", "", - "", "", "", "", -0.38600980945636, 1.26765266847845, -2.22751211365058e-06, - "", "", "", "", "", "", "", "", 0.0846242017037755, -1.78626926801858, - -1.50899731338318, -0.979353662950849, "", "", "", "", "", "", - "", 0.0462187188848366, 0.915104116857723, 1.26724625016898, - -3.10613908775842, 1.19239959132546, "", "", "", "", "", "", - -1.56053141398542, -1.98571672118215, -1.95273558316733, 3.48139850416601, - -0.952297065273875, 1.24738002520415, "", "", "", "", "", 1.70227576368358, - 2.48446501830506, 1.72887724327013, -2.99331507437673, 0.771585871131651, - -1.33482628389656, -0.761717885855758, "", "", "", "", 1.47327037945452, - 0.272709782087463, -1.29757118956179, -2.40643758666971, 0.874896574845907, - -0.503887231903551, 0.376035675353966, -2.1367412250306, "", - "", "", 2.35212346611526, 1.25498978664384, 3.0336022528353, - -1.19107613633585, 2.12597830042835, -2.99704518860994, 2.32847953539758, - -0.590849981828543, 0.804440146444814, "", "", -2.69577565127516, - -2.24649212532572, -1.71719477088287, 0.64413121241335, 1.49678459768851, - -0.987168253316867, 1.96201526731966, 1.27341637632111, -2.11609347217146, - -2.41207540474584, "", 0.623012707174373, 0.275105560993146, - -1.61236921599306, -0.52937530261534, 1.44125542894765, -1.29066565900691, - 2.4993679036409, -2.1413979271183, 0.273074594418328, -0.249446746350577, - -2.59387512655313), "Standardized residual covariance table") + 3, "all", 1638.81154499845, 1774.12864966057, 51.6035277328312, + "", "default", 37, "", "", "", "", 1, 1718.45537215556, 1856.01260957258, + 34.0761536514705, "", "default", 38, "", "", "", "", 2, 1633.89265814398, + 1764.37700906817, 53.4279668719259, "", "constrained", 37, "", + "", "", "", 1, 1712.45537220169, 1845.09985113953, 34.5269699000823, + "", "constrained", 38, "", "", "", "", 2, 1627.89265813238, + 1753.54425531862, 54.5525537466071, "", "more constrained", + 37, "", "", "", "", 1, 1709.17917553332, 1836.91089599197, 38.1908170729263, + "", "more constrained", 38, "", "", "", "", 2)) +}) + +test_that("Multigroup, multimodel SEM works", { + +rsquared <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] +expect_equal_tables(rsquared, list(1, "x1", 0.883076871616545, 0.88344099961725, 0.883440941017356, + 1, "x2", 0.993698159869737, 0.993307380054294, 0.993308312239008, + 1, "x3", 0.734550879193546, 0.734754000085834, 0.734752992615769, + 1, "y1", 0.76374604003533, 0.783825225382152, 0.783824495338428, + 1, "y2", 0.526988232837519, 0.469805811235219, 0.469797871843766, + 1, "y3", 0.540743668690899, 0.602813004892641, 0.602813008520997, + 1, "y4", 0.758371834315633, 0.715732725592277, 0.715727580943472, + 1, "y5", 0.74873567690424, 0.760689523184987, 0.760685788176897, + 1, "y6", 0.626089440009365, 0.636528021958327, 0.636530171924641, + 1, "y7", 0.729758226751308, 0.710375682244039, 0.71037601689489, + 1, "y8", 0.574575906571731, 0.588831799668115, 0.588835817501729, + 1, "dem60", 0.275927380324134, 0.258157185403394, 0.258145005894915, + 1, "dem65", 0.941713333219213, 0.938883931908498, 0.938882940520396, + 2, "x1", 0.787475869571125, 0.78747617521673, 0.788439850883342, + 2, "x2", 0.90066092940223, 0.900660946749863, 0.900202685338541, + 2, "x3", 0.749867733548725, 0.749868295135393, 0.749372699570588, + 2, "y1", 0.731921944773149, 0.731929437708713, 0.683849857838249, + 2, "y2", 0.550065444500199, 0.55006739915162, 0.519184271086883, + 2, "y3", 0.465824888188388, 0.465819890503162, 0.543696244446076, + 2, "y4", 0.651968126202522, 0.651959003998254, 0.694898810552775, + 2, "y5", 0.536001769615456, 0.535995620432757, 0.598318029638657, + 2, "y6", 0.625808175301569, 0.625823134164411, 0.607599332020539, + 2, "y7", 0.658946836103404, 0.658945492261667, 0.618117097165422, + 2, "y8", 0.842442637402788, 0.842449295416932, 0.821972120799197, + 2, "dem60", 0.0753599955960172, 0.0753581296999281, 0.0905522598180797, + 2, "dem65", 0.956917027167473, 0.956910675588687, 0.977886505597527), "R-squared table") + +mardia <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_mardiasTable"]][["data"]] +expect_equal_tables(mardia, list(330.8978096739, 26.471824773912, 286, "Skewness", 0.0347860345067638, + "", "", 134.567190822067, "", "Kurtosis", 0.0308358026617131, + -2.15918518879414), "Mardia's coefficient table") + +# parameter tables (use only the most constrained one, model 3) +parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][[3]][["collection"]] + +parcov <- parcont[["modelContainer_params_more constrained_cov"]][["data"]] +parind <- parcont[["modelContainer_params_more constrained_ind"]][["data"]] +parlvar <- parcont[["modelContainer_params_more constrained_lvar"]][["data"]] +parmu <- parcont[["modelContainer_params_more constrained_mu"]][["data"]] +parreg <- parcont[["modelContainer_params_more constrained_reg"]][["data"]] +parvar <- parcont[["modelContainer_params_more constrained_var"]][["data"]] +partoteff <- parcont[["modelContainer_params_more constrained_toteff"]][["data"]] +parindeff <- parcont[["modelContainer_params_more constrained_indeff"]][["data"]] + +expect_equal_tables(parcov, list(-0.6954531542207, 1.13004177555805, 0.217294310668675, 1, "", + "y1 - y5", 0.640785259230165, 0.465696039360422, 0.122229400273098, + 0.217294310668675, 0.122229400273098, 0.466601156769773, 0.433556460847837, + 4.21291697813377, 2.3232367194908, 1, "", "y2 - y4", 0.0159680098210626, + 0.964140297244501, 0.551561502186759, 2.3232367194908, 0.551561502186759, + 2.40964590540462, -0.453419237958842, 2.505951236881, 1.02626599946108, + 1, "", "y2 - y6", 0.17402837160491, 0.754955320144396, 0.193560311396125, + 1.02626599946108, 0.193560311396125, 1.35937316034119, -0.360831524130165, + 2.44595509715802, 1.04256178651393, 1, "", "y3 - y7", 0.145384170743897, + 0.716030152448658, 0.308401783418161, 1.04256178651393, 0.308401783418161, + 1.45603056372502, -1.1752514946784, 0.804530353606003, -0.185360570536198, + 1, "", "y4 - y8", 0.713611427442158, 0.505055670384933, -0.055456132680955, + -0.185360570536198, -0.055456132680955, -0.367010176115681, + -0.214945884704212, 3.12165697220468, 1.45335554375024, 1, "", + "y6 - y8", 0.0877403085916073, 0.851189839004082, 0.345429944587142, + 1.45335554375024, 0.345429944587142, 1.70743995892938, -0.118867422075107, + 1.57858876509683, 0.729860671510864, 2, "", "y1 - y5", 0.0918990888281448, + 0.433032494617569, 0.378922580175638, 0.729860671510864, 0.378922580175638, + 1.68546397922271, -0.465368071384461, 3.32132373684828, 1.42797783273191, + 2, "", "y2 - y4", 0.139348430266928, 0.966010558893349, 0.272324473644576, + 1.42797783273191, 0.272324473644576, 1.47822176433329, 0.0620106319581817, + 4.11438168212343, 2.0881961570408, 2, "", "y2 - y6", 0.0433887887248896, + 1.0337871211231, 0.353104277180419, 2.0881961570408, 0.353104277180419, + 2.01994793161304, -1.37202057656756, 2.36286703932311, 0.495423231377773, + 2, "", "y3 - y7", 0.603085629226917, 0.95279496086433, 0.102496109909358, + 0.495423231377773, 0.102496109909358, 0.519968358069766, -0.467325344619643, + 1.95619519341019, 0.744434924395273, 2, "", "y4 - y8", 0.228555681753865, + 0.618256395818049, 0.289753166031978, 0.744434924395273, 0.289753166031978, + 1.20408770443898, -0.397060222176712, 2.20355649897539, 0.903248138399338, + 2, "", "y6 - y8", 0.173364480031275, 0.663434823717536, 0.311727419658627, + 0.903248138399338, 0.311727419658627, 1.3614723046011), "Covariance parameter table") +expect_equal_tables(parind, list(1, 1, 1, 1, "a1", "dem60", "", "y1", 0, 0.885338633144645, 2.42166834175017, + 0.885338633144645, "", 0.760887096093346, 1.33133716576763, + 1.04611213093049, 1, "b1", "dem60", 6.55031584528842e-13, "y2", + 0.145525651025714, 0.685418027078195, 2.53333662939518, 0.685418027078195, + 7.18850679283783, 0.783222538721785, 1.29591955303148, 1.03957104587663, + 1, "c1", "dem60", 1.99840144432528e-15, "y3", 0.130792458012948, + 0.776410335145661, 2.51749629079955, 0.776410335145661, 7.94824917025196, + 0.796321916480285, 1.25466669817794, 1.02549430732911, 1, "d1", + "dem60", 0, "y4", 0.116926837766668, 0.846006844501551, 2.48340709870393, + 0.846006844501551, 8.77039289624442, 1, 1, 1, 1, "a1", "dem65", + "", "y5", 0, 0.872173026513029, 2.49219827699714, 0.872173026513029, + "", 0.760887096093347, 1.33133716576763, 1.04611213093049, 1, + "b1", "dem65", 6.55031584528842e-13, "y6", 0.145525651025714, + 0.797828410076152, 2.60711885025078, 0.797828410076152, 7.18850679283783, + 0.783222538721786, 1.29591955303148, 1.03957104587663, 1, "c1", + "dem65", 1.99840144432528e-15, "y7", 0.130792458012948, 0.842838072760652, + 2.59081716934986, 0.842838072760652, 7.94824917025198, 0.796321916480285, + 1.25466669817794, 1.02549430732911, 1, "d1", "dem65", 0, "y8", + 0.116926837766668, 0.767356382329443, 2.55573514579599, 0.767356382329443, + 8.77039289624441, 1, 1, 1, 1, "", "ind60", "", "x1", 0, 0.9399153903503, + 0.657997769223687, 0.9399153903503, "", 1.94762156768515, 2.55197241207641, + 2.24979698988078, 1, "", "ind60", 0, "x2", 0.154173966756102, + 0.996648539977362, 1.48036140054772, 0.996648539977362, 14.5925867850302, + 1.40827986384489, 2.23529739101974, 1.82178862743232, 1, "", + "ind60", 0, "x3", 0.21097773573858, 0.857177340236995, 1.19873285284755, + 0.857177340236995, 8.63498046869587, 1, 1, 1, 2, "a2", "dem60", + "", "y1", 0, 0.826952149666623, 1.88731847029611, 0.826952149666623, + "", 1.00619302224548, 1.96819575821973, 1.4871943902326, 2, + "b2", "dem60", 1.3615824023816e-09, "y2", 0.245413370746198, + 0.720544426865466, 2.80680944160676, 0.720544426865466, 6.05995665888404, + 0.971906075502799, 1.81486423470296, 1.39338515510288, 2, "c2", + "dem60", 9.20110654334394e-11, "y3", 0.215044298224178, 0.737357609607493, + 2.62976153946208, 0.737357609607493, 6.47952615628205, 1.13497135653258, + 1.96970928417875, 1.55234032035566, 2, "d2", "dem60", 3.10418357685194e-13, + "y4", 0.212947261845238, 0.833605908420025, 2.92976055879263, + 0.833605908420025, 7.28978765401475, 1, 1, 1, 2, "a2", "dem65", + "", "y5", 0, 0.773510200087017, 1.83190459395535, 0.773510200087017, + "", 1.00619302224548, 1.96819575821973, 1.4871943902326, 2, + "b2", "dem65", 1.3615824023816e-09, "y6", 0.245413370746198, + 0.779486582322325, 2.72439823557173, 0.779486582322325, 6.05995665888404, + 0.971906075502799, 1.81486423470296, 1.39338515510288, 2, "c2", + "dem65", 9.20110654334394e-11, "y7", 0.215044298224178, 0.786204233749362, + 2.55254866678216, 0.786204233749362, 6.47952615628205, 1.13497135653258, + 1.96970928417875, 1.55234032035566, 2, "d2", "dem65", 3.10418357685194e-13, + "y8", 0.212947261845238, 0.906626781426181, 2.84373936424167, + 0.906626781426181, 7.28978765401476, 1, 1, 1, 2, "", "ind60", + "", "x1", 0, 0.887941355542888, 0.569877660945511, 0.887941355542888, + "", 1.83150200846409, 2.88878207416714, 2.36014204131561, 2, + "", "ind60", 0, "x2", 0.269719258629941, 0.948790116589829, + 1.34499222600411, 0.948790116589829, 8.75036529947522, 1.44864109706262, + 2.4658864657564, 1.95726378140951, 2, "", "ind60", 4.61852778244065e-14, + "x3", 0.259506138050923, 0.865663155950736, 1.11540090560302, + 0.865663155950736, 7.54226391757035), "Loadings parameter table") +expect_equal_tables(parlvar, list(0.209581796157056, 0.656340332449642, "ind60", 0.432961064303349, + 1, "", "ind60", 0.000145359164061443, 0.113971108606219, 1, + 1, 1, 3.79886683211329, 1.81562506860136, 6.88555885899937, + "dem60", 4.35059196380036, 1, "", "dem60", 0.000768902080227507, + 1.29337422278904, 0.741854994105085, 0.741854994105085, 0.741854994105085, + 3.3637534188819, -0.373266498808562, 1.1324689986252, "dem65", + 0.379601249908318, 1, "", "dem65", 0.323041135527759, 0.384123256679921, + 0.0611170594796042, 0.0611170594796042, 0.0611170594796042, + 0.988227719376618, 0.139438652248914, 0.51008244464054, "ind60", + 0.324760548444727, 2, "", "ind60", 0.000593282653738703, 0.0945537253018976, + 1, 1, 1, 3.43466687756415, 1.1885891662882, 5.29026380193365, + "dem60", 3.23942648411092, 2, "", "dem60", 0.00196225561471564, + 1.04636479751642, 0.90944774018192, 0.90944774018192, 0.90944774018192, + 3.09588634078651, -0.343713422100036, 0.492133643448633, "dem65", + 0.0742101106742985, 2, "", "dem65", 0.727819060322371, 0.213230210386957, + 0.0221134944024726, 0.0221134944024726, 0.0221134944024726, + 0.348028126688176), "Latent variance parameter table") +expect_equal_tables(parmu, list(5.114583249089, 5.56572485901911, 5.34015405405405, 1, "", "x1", + 0, 0.115089260182496, 7.62813069741675, 5.34015405405405, 7.62813069741675, + 46.4001075824643, 4.69962810017044, 5.65682865658632, 5.17822837837838, + 1, "", "x2", 0, 0.244188302429574, 3.48622556023865, 5.17822837837838, + 3.48622556023865, 21.2058822099876, 3.4912357243792, 4.39245184318836, + 3.94184378378378, 1, "", "x3", 0, 0.229906295706921, 2.81869239020784, + 3.94184378378378, 2.81869239020784, 17.145436455593, 5.0659390403021, + 6.8286555542925, 5.9472972972973, 1, "", "y1", 0, 0.449680843090609, + 2.17427463923019, 5.9472972972973, 2.17427463923019, 13.2255963060871, + 2.8433068923923, 5.22515797247257, 4.03423243243243, 1, "", + "y2", 3.1510793974121e-11, 0.607626236723739, 1.09149948827483, + 4.03423243243243, 1.09149948827483, 6.6393321891178, 5.71017508116214, + 7.79973464856759, 6.75495486486486, 1, "", "y3", 0, 0.533060705167961, + 2.08326693059709, 6.75495486486486, 2.08326693059709, 12.6720180260454, + 4.36666487548144, 6.25836052992396, 5.3125127027027, 1, "", + "y4", 0, 0.482584289651232, 1.80978064785815, 5.3125127027027, + 1.80978064785815, 11.0084659128504, 4.76881059441114, 6.61024886504832, + 5.68952972972973, 1, "", "y5", 0, 0.469763292887578, 1.99111539784598, + 5.68952972972973, 1.99111539784598, 12.1114821355174, 1.69721605838774, + 3.80307150917983, 2.75014378378378, 1, "", "y6", 3.0678012175045e-07, + 0.537217894666127, 0.841596785005017, 2.75014378378378, 0.841596785005017, + 5.11923338944798, 5.40096255495839, 7.38189582341999, 6.39142918918919, + 1, "", "y7", 0, 0.505349405419424, 2.07924353896195, 6.39142918918919, + 2.07924353896195, 12.6475446901625, 3.28677224232016, 5.43309959551768, + 4.35993591891892, 1, "", "y8", 1.77635683940025e-15, 0.547542549283426, + 1.30906547943089, 4.35993591891892, 1.30906547943089, 7.96273444798913, + 0, 0, 0, 1, "", "ind60", "", 0, 0, 0, 0, "", 0, 0, 0, 1, "", + "dem60", "", 0, 0, 0, 0, "", 0, 0, 0, 1, "", "dem65", "", 0, + 0, 0, 0, "", 4.57207725542129, 4.9801932708945, 4.77613526315789, + 2, "", "x1", 0, 0.10411314154045, 7.44182183380953, 4.77613526315789, + 7.44182183380953, 45.8744707199359, 3.96560094944749, 4.86703905055251, + 4.41632, 2, "", "x2", 0, 0.229962924884195, 3.11537917222519, + 4.41632, 3.11537917222519, 19.204486993823, 2.77397157389089, + 3.59331947874069, 3.18364552631579, 2, "", "x3", 0, 0.209021163478693, + 2.47082875753002, 3.18364552631579, 2.47082875753002, 15.2312113918566, + 4.2690970296885, 5.72037665452202, 4.99473684210526, 2, "", + "y1", 0, 0.370231197175312, 2.18850630331085, 4.99473684210526, + 2.18850630331085, 13.4908589017153, 3.23427002973344, 5.71134102289814, + 4.47280552631579, 2, "", "y2", 1.46083145580178e-12, 0.631917477235172, + 1.14822725286081, 4.47280552631579, 1.14822725286081, 7.07814815612578, + 5.24236503773425, 7.51026812016048, 6.37631657894737, 2, "", + "y3", 0, 0.578557335827383, 1.787852426998, 6.37631657894737, + 1.787852426998, 11.0210625362286, 2.49773616542863, 4.73263378193979, + 3.61518497368421, 2, "", "y4", 2.28425278692157e-10, 0.570137419396414, + 1.02862998310564, 3.61518497368421, 1.02862998310564, 6.3409010717302, + 3.84453746449672, 5.35053095655592, 4.59753421052632, 2, "", + "y5", 0, 0.384189072844778, 1.94127992190503, 4.59753421052632, + 1.94127992190503, 11.9668531342739, 2.0887392465132, 4.31127233243417, + 3.20000578947368, 2, "", "y6", 1.66224263242753e-08, 0.566983144448578, + 0.915564231278779, 3.20000578947368, 0.915564231278779, 5.64391696791245, + 4.97396373438834, 7.03851152876955, 6.00623763157895, 2, "", + "y7", 0, 0.526680033578704, 1.84996647323673, 6.00623763157895, + 1.84996647323673, 11.4039592326437, 2.73789322525061, 4.73245519580203, + 3.73517421052632, 2, "", "y8", 2.1227464230833e-13, 0.508826179022745, + 1.19082958696484, 3.73517421052632, 1.19082958696484, 7.34076658103582, + 0, 0, 0, 2, "", "ind60", "", 0, 0, 0, 0, "", 0, 0, 0, 2, "", + "dem60", "", 0, 0, 0, 0, "", 0, 0, 0, 2, "", "dem65", "", 0, + 0, 0, 0, ""), "Means parameter table") +expect_equal_tables(parreg, list(0.721100887386564, 3.01873119149832, 1.86991603944244, 1, "dem60", + 0.00142166660030174, "ind60", 0.586140950097851, 0.508079723955714, + 0.508079723955714, 0.508079723955714, 3.19021566251304, 0.478026990501928, + 1.96570674995725, 1.22186687022959, 1, "dem65", 0.00128400773281667, + "ind60", 0.379517116434269, 0.322601007439955, 0.322601007439955, + 0.322601007439955, 3.21953033820864, 0.572218807581072, 1.00102151163503, + 0.78662015960805, 1, "dem65", 6.43485265072741e-13, "dem60", + 0.109390454987004, 0.764358580570299, 0.764358580570299, 0.764358580570299, + 7.19093964552485, -0.154169499851477, 2.14733425618112, 0.99658237816482, + 2, "dem60", 0.0896244560523969, "ind60", 0.587129093745232, + 0.300919025350807, 0.300919025350807, 0.300919025350807, 1.69738203877401, + -0.115343312911686, 0.965518339191284, 0.425087513139799, 2, + "dem65", 0.12315820352967, "ind60", 0.275735079988375, 0.132238260925043, + 0.132238260925043, 0.132238260925043, 1.54165191152943, 0.730849486044932, + 1.09592060871138, 0.913385047378158, 2, "dem65", 0, "dem60", + 0.0931320997595074, 0.941014327982574, 0.941014327982574, 0.941014327982574, + 9.80741387488061), "Regressions parameter table") +expect_equal_tables(parvar, list(0.019971862523661, 0.0942758067618645, "x1", 0.0571238346427628, + 1, "", "x1", 0.00258179957955118, 0.0189554361264553, 0.116559058982644, + 0.0571238346427628, 0.116559058982644, 3.01358587909447, -0.119066895021194, + 0.148593743772327, "x2", 0.0147634243755663, 1, "", "x2", 0.828822156218558, + 0.0682820299007519, 0.00669168776099212, 0.0147634243755663, + 0.00669168776099212, 0.216212441209275, 0.265760017116629, 0.77173003351152, + "x3", 0.518745025314075, 1, "", "x3", 5.84703635451156e-05, + 0.129076355582531, 0.265247007384231, 0.518745025314075, 0.265247007384231, + 4.01890046378318, 0.416929012723307, 2.81786755996509, "y1", + 1.6173982863442, 1, "", "y1", 0.00827424337847726, 0.612495578025943, + 0.216175504661572, 1.6173982863442, 0.216175504661572, 2.64066932786197, + 3.64229436414009, 10.8436303032633, "y2", 7.24296233370169, + 1, "", "y2", 8.06075272521412e-05, 1.8371092519879, 0.530202128156234, + 7.24296233370169, 0.530202128156234, 3.94258660766322, 1.93231536174354, + 6.41948442904567, "y3", 4.17589989539461, 1, "", "y3", 0.000264281837194513, + 1.1447070208168, 0.397186991479003, 4.17589989539461, 0.397186991479003, + 3.64800758574445, 0.931737730528367, 3.96732278343115, "y4", + 2.44953025697976, 1, "", "y4", 0.00156076961142304, 0.774398171815168, + 0.284272419056528, 2.44953025697976, 0.284272419056528, 3.16314054724345, + 0.731947613472583, 3.17608668229141, "y5", 1.95401714788199, + 1, "", "y5", 0.00172519104089064, 0.623516321753329, 0.239314211823103, + 1.95401714788199, 0.239314211823103, 3.13386687679209, 1.83678103920313, + 5.92570847199455, "y6", 3.88124475559884, 1, "", "y6", 0.000198569846390217, + 1.04311290029928, 0.363469828075359, 3.88124475559884, 0.363469828075359, + 3.72082902482106, 1.19521510119136, 4.2780912840873, "y7", 2.73665319263933, + 1, "", "y7", 0.000501976062955434, 0.786462457273012, 0.28962398310511, + 2.73665319263933, 0.28962398310511, 3.47969972035084, 2.19176630693849, + 6.93007982455653, "y8", 4.56092306574751, 1, "", "y8", 0.000161182628549028, + 1.20877565990836, 0.411164182498271, 4.56092306574751, 0.411164182498271, + 3.7731757984714, 0.0313581547372507, 0.142926262721349, "x1", + 0.0871422087292997, 2, "", "x1", 0.00220063448354591, 0.0284617750285549, + 0.211560149116658, 0.0871422087292997, 0.211560149116658, 3.06172783116557, + -0.0362625145249454, 0.437358296920339, "x2", 0.200547891197697, + 2, "", "x2", 0.0969472731768826, 0.120823855739479, 0.0997973146614593, + 0.200547891197697, 0.0997973146614593, 1.65983687551007, 0.174335809406066, + 0.65785418558488, "x3", 0.416094997495473, 2, "", "x3", 0.000742674694836687, + 0.123348791098394, 0.250627300429412, 0.416094997495473, 0.250627300429412, + 3.37332043378973, 0.67728943233645, 2.61617514252359, "y1", + 1.64673228743002, 2, "", "y1", 0.000870742833376514, 0.494622790388198, + 0.316150142161751, 1.64673228743002, 0.316150142161751, 3.32926892862662, + 3.61992130179251, 10.9720172659021, "y2", 7.29596928384731, + 2, "", "y2", 0.000100243055731752, 1.87556914874508, 0.480815728913117, + 7.29596928384731, 0.480815728913117, 3.89000282326511, 2.80111563779673, + 8.80696575715111, "y3", 5.80404069747392, 2, "", "y3", 0.000151736573070549, + 1.53213277558357, 0.456303755553924, 5.80404069747392, 0.456303755553924, + 3.78820999718072, 1.47037447709196, 6.06693911089053, "y4", + 3.76865679399125, 2, "", "y4", 0.00130948831028421, 1.17261456589399, + 0.305101189447225, 3.76865679399125, 0.305101189447225, 3.21389218896327, + 1.06639719058268, 3.43954844740097, "y5", 2.25297281899183, + 2, "", "y5", 0.000198106085773642, 0.605406853273174, 0.401681970361344, + 2.25297281899183, 0.401681970361344, 3.72141941705974, 2.22486686951239, + 7.36215298126356, "y6", 4.79350992538798, 2, "", "y6", 0.00025457326577949, + 1.31055625314379, 0.392400667979461, 4.79350992538798, 0.392400667979461, + 3.65761478295129, 1.87928674169851, 6.1714850562742, "y7", 4.02538589898636, + 2, "", "y7", 0.000236681377467019, 1.09496866994292, 0.381882902834578, + 4.02538589898636, 0.381882902834578, 3.67625669070166, 0.346950686712466, + 3.15605228468781, "y8", 1.75150148570014, 2, "", "y8", 0.0145209073086436, + 0.716620718577785, 0.178027879200803, 1.75150148570014, 0.178027879200803, + 2.44411226230828), "(Residual) variances parameter table") +expect_equal_tables(partoteff, list(1.63130176674587, 3.75425928051304, 2.69278052362946, 1, " ind60 dem65", + 6.62397930284442e-07, 0.541580746001658, 0.710956104059294, + 0.710956104059294, 0.710956104059294, 4.97207580496447, 0.721100887386564, + 3.01873119149832, 1.86991603944244, 1, " ind60 dem60", + 0.00142166660030174, 0.586140950097851, 0.508079723955714, 0.508079723955714, + 0.508079723955714, 3.19021566251304, 0.572218807581072, 1.00102151163503, + 0.78662015960805, 1, " dem60 dem65", 6.43485265072741e-13, + 0.109390454987004, 0.764358580570299, 0.764358580570299, 0.764358580570299, + 7.19093964552485, 0.247077278790176, 2.42362463288204, 1.33535095583611, + 2, " ind60 dem65", 0.0161748412862954, 0.55525187484571, + 0.415407375342704, 0.415407375342704, 0.415407375342704, 2.40494632495778, + -0.154169499851477, 2.14733425618112, 0.99658237816482, 2, " ind60 dem60", + 0.0896244560523969, 0.587129093745232, 0.300919025350807, 0.300919025350807, + 0.300919025350807, 1.69738203877401, 0.730849486044932, 1.09592060871138, + 0.913385047378158, 2, " dem60 dem65", 0, 0.0931320997595074, + 0.941014327982574, 0.941014327982574, 0.941014327982574, 9.80741387488061), "Total effects table") +expect_equal_tables(parindeff, list(0.481357882787227, 2.46046942401251, 1.47091365339987, 1, "ind60 dem60 dem65", + 0.00357555663622788, 0.504884670544015, 0.388355096619339, 0.388355096619339, + 0.388355096619339, 2.91336564410829, -0.159005756965501, 1.97953264235812, + 0.910263442696311, 2, "ind60 dem60 dem65", + 0.0952150456736578, 0.545555534742511, 0.283169114417661, 0.283169114417661, + 0.283169114417661, 1.66850739242511), "Indirect effects table") + +# covariance tables. Use model 2, but the way this is ordered uses actually the default model +covcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][[2]][["collection"]] +covimp <- covcont[["modelContainer_covars_default_implied"]][["collection"]][["modelContainer_covars_default_implied_1"]][["data"]] +covobs <- covcont[["modelContainer_covars_default_observed"]][["collection"]][["modelContainer_covars_default_observed_1"]][["data"]] +covres <- covcont[["modelContainer_covars_default_residual"]][["collection"]][["modelContainer_covars_default_residual_1"]][["data"]] +covstd <- covcont[["modelContainer_covars_default_stdres"]][["collection"]][["modelContainer_covars_default_stdres_1"]][["data"]] + +expect_equal_tables(covimp, list(0.49008300563634, "", "", "", "", "", "", "", "", "", "", 0.974061924820936, + 2.20622852804642, "", "", "", "", "", "", "", "", "", 0.788491080043323, + 1.77466015582184, 1.95570584174645, "", "", "", "", "", "", + "", "", 0.835178540092752, 1.87973981648419, 1.5216261310825, + 7.64797977172544, "", "", "", "", "", "", "", 0.955666527250095, + 2.15092263069125, 1.74114526494313, 6.6837892939784, 14.5127221504755, + "", "", "", "", "", "", 0.788253740427639, 1.77412597456093, + 1.43613303237535, 5.51292920802481, 6.30825824454682, 9.62227326013948, + "", "", "", "", "", 0.904244744111686, 2.03518740934666, 1.647459034785, + 6.32415300473142, 9.23882105681506, 5.96882824654787, 9.02873362112345, + "", "", "", "", 1.14334478995368, 2.57333087773904, 2.08307951619225, + 5.82366205597868, 6.32427984118539, 5.21639829184987, 5.98398776520799, + 7.98119516009606, "", "", "", 1.18710886159188, 2.6718308559361, + 2.16281403020389, 5.73848644656917, 7.58931007411123, 5.41606756969487, + 6.21303824196686, 6.20454284533332, 10.2893215377554, "", "", + 1.25970543427747, 2.83522426425121, 2.29507897323411, 6.0894184140595, + 6.96791532513603, 6.91162808862569, 6.59299099686961, 6.58397607191045, + 6.83599243915776, 9.9403352106315, "", 1.15531617741013, 2.60027492931625, + 2.10489039267504, 5.58480055205702, 6.39049819021453, 5.27101657115423, + 5.85298682041024, 6.03837521104465, 7.68811256412372, 6.65291356937697, + 10.6193105678442), "Model-implied covariance table") + +expect_equal_tables(covobs, list(0.490082575997078, "", "", "", "", "", "", "", "", "", "", 0.973932449184952, + 2.20622591129467, "", "", "", "", "", "", "", "", "", 0.78518275394412, + 1.77565205254938, 1.95570361423433, "", "", "", "", "", "", + "", "", 0.842173686632578, 1.60646357669832, 1.14904644265887, + 7.62580350620891, "", "", "", "", "", "", "", 0.966640855417166, + 2.56661076528232, 2.30600417597728, 6.02486581738495, 14.676007521986, + "", "", "", "", "", "", 0.569651258731629, 1.29778304025924, + 0.751981605089701, 6.44636651314828, 5.79397804058276, 9.73209047934931, + "", "", "", "", "", 1.07850808055391, 2.50663181045844, 2.0195628491114, + 6.09461043973703, 9.30788611653126, 5.64475186161118, 9.01279131583053, + "", "", "", "", 1.23810412812272, 2.61063748721578, 1.81722127066318, + 5.59878435062089, 6.6520705502466, 5.03859665459321, 6.05661431962235, + 7.93189524242966, "", "", "", 1.43792308816034, 2.91763544604397, + 2.84145873393433, 5.38621551022644, 8.42865402090701, 4.21966332811402, + 6.90922843998977, 6.08535469304967, 10.3746040258343, "", "", + 1.04665319855464, 2.45836864046895, 1.77472198140307, 6.2463340788897, + 7.67698969559927, 6.73419489425259, 7.01801387855084, 6.81611022694302, + 6.30443702471928, 9.78003437719124, "", 1.23565159843141, 2.65937421505933, + 1.72765599854139, 5.4174694403214, 7.39753077439182, 4.59181056574472, + 6.45111697395995, 5.63862367744565, 7.7210072538895, 6.57011319209561, + 10.545706988345), "Observed covariance table") + +expect_equal_tables(covres, list(-4.29639262000681e-07, "", "", "", "", "", "", "", "", "", "", + -0.000129475635983867, -2.61675175305953e-06, "", "", "", "", + "", "", "", "", "", -0.00330832609920362, 0.000991896727542851, + -2.22751211431671e-06, "", "", "", "", "", "", "", "", 0.00699514653982602, + -0.273276239785871, -0.372579688423628, -0.0221762655165261, + "", "", "", "", "", "", "", 0.0109743281670703, 0.415688134591076, + 0.56485891103415, -0.65892347659345, 0.163285371510497, "", + "", "", "", "", "", -0.21860248169601, -0.476342934301688, -0.684151427285647, + 0.933437305123476, -0.514280203964063, 0.109817219209827, "", + "", "", "", "", 0.174263336442222, 0.471444401111776, 0.372103814326393, + -0.229542564994383, 0.0690650597162001, -0.324076384936694, + -0.0159423052929153, "", "", "", "", 0.094759338169033, 0.0373066094767367, + -0.265858245529067, -0.224877705357793, 0.327790709061214, -0.177801637256668, + 0.0726265544143621, -0.0492999176663993, "", "", "", 0.250814226568454, + 0.245804590107875, 0.678644703730438, -0.352270936342729, 0.839343946795778, + -1.19640424158084, 0.696190198022915, -0.119188152283651, 0.0852824880789491, + "", "", -0.213052235722835, -0.376855623782256, -0.52035699183104, + 0.156915664830205, 0.709074370463244, -0.177433194373092, 0.425022881681233, + 0.232134155032578, -0.531555414438472, -0.160300833440264, "", + 0.0803354210212817, 0.0590992857430783, -0.377234394133652, + -0.167331111735621, 1.00703258417729, -0.679206005409508, 0.598130153549711, + -0.399751533598995, 0.0328946897657785, -0.0828003772813588, + -0.073603579499208), "Residual covariance table") + +jaspTools::expect_equal_tables(covstd, + list(-4.29639261390058e-07, "", "", "", "", "", "", "", "", "", "", + -0.906062050868875, -2.61675175172726e-06, "", "", "", "", "", + "", "", "", "", -0.38600980945636, 1.26765266847845, -2.22751211365058e-06, + "", "", "", "", "", "", "", "", 0.0846242017037755, -1.78626926801858, + -1.50899731338318, -0.979353662950849, "", "", "", "", "", "", + "", 0.0462187188848366, 0.915104116857723, 1.26724625016898, + -3.10613908775842, 1.19239959132546, "", "", "", "", "", "", + -1.56053141398542, -1.98571672118215, -1.95273558316733, 3.48139850416601, + -0.952297065273875, 1.24738002520415, "", "", "", "", "", 1.70227576368358, + 2.48446501830506, 1.72887724327013, -2.99331507437673, 0.771585871131651, + -1.33482628389656, -0.761717885855758, "", "", "", "", 1.47327037945452, + 0.272709782087463, -1.29757118956179, -2.40643758666971, 0.874896574845907, + -0.503887231903551, 0.376035675353966, -2.1367412250306, "", + "", "", 2.35212346611526, 1.25498978664384, 3.0336022528353, + -1.19107613633585, 2.12597830042835, -2.99704518860994, 2.32847953539758, + -0.590849981828543, 0.804440146444814, "", "", -2.69577565127516, + -2.24649212532572, -1.71719477088287, 0.64413121241335, 1.49678459768851, + -0.987168253316867, 1.96201526731966, 1.27341637632111, -2.11609347217146, + -2.41207540474584, "", 0.623012707174373, 0.275105560993146, + -1.61236921599306, -0.52937530261534, 1.44125542894765, -1.29066565900691, + 2.4993679036409, -2.1413979271183, 0.273074594418328, -0.249446746350577, + -2.59387512655313), "Standardized residual covariance table") }) @@ -844,14 +841,6 @@ options$models = list( results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) -test_that("Model fit table results match", { - table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] - jaspTools::expect_equal_tables(table, - list(3132.86971459993, 3255.69658461736, 87.8060617718737, 79, "default", - 75, 0.233090294836104, 0.233090294836104, 87.8060617718737, - 79)) -}) - test_that("Residual covariances table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_cov"]][["data"]] jaspTools::expect_equal_tables(table, From f7c732eba410e0b21f6699e0e01ffe19a4254e32 Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Tue, 30 Apr 2024 19:26:53 +0200 Subject: [PATCH 07/10] fix multi model fit table bug, and add chisq diff teststs for multiple groups --- R/sem.R | 42 +++++++++++--------------- tests/testthat/test-sem.R | 63 +++++++++++++++++++++------------------ 2 files changed, 52 insertions(+), 53 deletions(-) diff --git a/R/sem.R b/R/sem.R index 940834ee..12d31856 100644 --- a/R/sem.R +++ b/R/sem.R @@ -690,21 +690,12 @@ checkLavaanModel <- function(model, availableVars) { lrt_args[["type"]] <- "Chisq" lrt <- .withWarnings(do.call(lavaan::lavTestLRT, lrt_args)) - # the lrt test in lavaan produces the standard chisq values and df and pvalue, even when each model is using a scaled test - # so we should replace the necessary values - chis <- sapply(semResults, function(x) { - ins <- lavaan::inspect(x, what = "fit") - if (is.na(ins["chisq.scaled"])) return(c(ins["chisq"], ins["df"], ins["pvalue"])) - else return(c(ins["chisq.scaled"], ins["df.scaled"], ins["pvalue.scaled"])) - }) - lrt$value[["Chisq"]] <- chis[1, ] - lrt$value[["Df"]] <- chis[2, ] - lrt$value[["PrChisq"]] <- chis[3, ] - - - lrt$value[1,5:7] <- NA chiSq <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat})) dfs <- unlist(lapply(semResults, function(x) {round(lavaan::lavInspect(x, what = "test")[[testName]]$df, 3)})) + # because the LRT orders the models according to the df, we need to reorder this as well + chiSq <- chiSq[order(dfs)] + dfs <- sort(dfs) + } dtFill <- data.frame(matrix(ncol = 0, nrow = length(rownames(lrt$value)))) @@ -774,11 +765,10 @@ checkLavaanModel <- function(model, availableVars) { groupNames <- semResults[[1]]@Data@group.label models <- rep(rownames(lrt$value), each = length(groupNames)) - modelDfs <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$df})) - - modelDfs <- unlist(lapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$df})) ord <- match(modelDfs, sort(modelDfs)) + modelDfs <- modelDfs[ord] + chiSq <- sapply(semResults, function(x) {lavaan::lavInspect(x, what = "test")[[testName]]$stat.group}) logLGroup <- sapply(semResults, function(x) x@loglik$loglik.group) @@ -790,6 +780,8 @@ checkLavaanModel <- function(model, availableVars) { aics <- aics[, ord] bics <- bics[, ord] + chiSq <- chiSq[, ord] + modelDfsRep <- rep(modelDfs, each = length(groupNames)) dtFillGroup <- data.frame(matrix(ncol = 0, nrow = length(models))) @@ -799,19 +791,21 @@ checkLavaanModel <- function(model, availableVars) { dtFillGroup[["BIC"]] <- c(bics) dtFillGroup[["N"]] <- c(Ns) dtFillGroup[["Chisq"]] <- c(chiSq) - dtFillGroup[["Df"]] <- NA - dtFillGroup[["PrChisq"]] <- NA + dtFillGroup[["Df"]] <- c(modelDfsRep) + + dtFillGroup[["PrChisq"]] <- apply(data.frame(c(chiSq), modelDfsRep), 1, function(x) {pchisq(x[1], x[2], lower.tail = FALSE)}) # we want the LRT for multiple models if (length(semResults) > 1) { - # so the LRT for the models by group depends on the test statistic used - # but lavaan does not provide this - # it is also not very clear how sensible it is to calculate the fit for each group anyways + nGroups <- length(groupNames) + dchisq <- diff(c(chiSq), lag = nGroups) + ddf <- diff(c(modelDfsRep), lag = nGroups) + dprchisq <- apply(data.frame(dchisq, ddf), 1, function(x) {pchisq(x[1], x[2], lower.tail = FALSE)}) - dtFillGroup[["dchisq"]] <- NA - dtFillGroup[["ddf"]] <- NA - dtFillGroup[["dPrChisq"]] <- NA + dtFillGroup[["dchisq"]] <- c(rep(NA, nGroups), dchisq) + dtFillGroup[["ddf"]] <- c(rep(NA, nGroups), ddf) + dtFillGroup[["dPrChisq"]] <- c(rep(NA, nGroups), dprchisq) } dtFill[["group"]] <- gettext("all") diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index f4fd2f30..d0f1d909 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -11,18 +11,19 @@ options$naAction <- "fiml" options$modelTest <- "standard" results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) -fittab <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] - -test_that("Basic SEM fit table works", { +test_that("Model fit table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] if (jaspBase::getOS() == "linux") skip("Skipped for now cause that part of the table is removed in another PR anyways") - expect_equal_tables(fittab, list(48.156355426353, 59.7437959940346, 0, 0, "Model1", 75, 1), "Model fit table") + jaspTools::expect_equal_tables(table, + list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 0, "Model1", + 75, 0)) }) - parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]] - parcov <- parcont[["modelContainer_params_cov"]][["data"]] - parreg <- parcont[["modelContainer_params_reg"]][["data"]] - parvar <- parcont[["modelContainer_params_var"]][["data"]] - partot <- parcont[["modelContainer_params_toteff"]][["data"]] +parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]] +parcov <- parcont[["modelContainer_params_cov"]][["data"]] +parreg <- parcont[["modelContainer_params_reg"]][["data"]] +parvar <- parcont[["modelContainer_params_var"]][["data"]] +partot <- parcont[["modelContainer_params_toteff"]][["data"]] test_that("Basic SEM covariance parameter table works", { @@ -179,21 +180,25 @@ results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) test_that("Model fit table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] jaspTools::expect_equal_tables(table, - list(3189.26691715401, 3383.93591869106, 85.6796813843018, 70, "default", - 75, 0.0980338951401478, "", "", "", "all", 3184.34803034567, - 3372.06456754211, 87.9549367720082, 73, "constrained", 75, 0.111927575441416, - 0.647754490400887, 1.65156784896069, 3, "all", 3181.07183366569, - 3361.83590652152, 92.7433708195334, 76, "more constrained", - 75, 0.0929761753674234, 0.110596895611682, 6.02091896548516, - 3, "all", 1638.81154499845, 1774.12864966057, 51.6035277328312, - "", "default", 37, "", "", "", "", 1, 1718.45537215556, 1856.01260957258, - 34.0761536514705, "", "default", 38, "", "", "", "", 2, 1633.89265814398, - 1764.37700906817, 53.4279668719259, "", "constrained", 37, "", - "", "", "", 1, 1712.45537220169, 1845.09985113953, 34.5269699000823, - "", "constrained", 38, "", "", "", "", 2, 1627.89265813238, - 1753.54425531862, 54.5525537466071, "", "more constrained", - 37, "", "", "", "", 1, 1709.17917553332, 1836.91089599197, 38.1908170729263, - "", "more constrained", 38, "", "", "", "", 2)) + list(3189.26691715402, 3383.93591869107, 85.6796813843016, 70, "default", + 75, 0.0980338951401504, "", "", "", "all", 3184.34803034567, + 3372.06456754211, 87.9549367720077, 73, "constrained", 75, 0.111927575441422, + 0.647754490400877, 1.65156784896073, 3, "all", 3181.07183366569, + 3361.83590652152, 92.7433708195404, 76, "more constrained", + 75, 0.0929761753673403, 0.110596895610444, 6.02091896551083, + 3, "all", 1638.81154499845, 1774.12864966057, 51.603527732831, + 70, "default", 37, 0.951434618744164, "", "", "", 1, 1718.45537215556, + 1856.01260957258, 34.0761536514706, 70, "default", 38, 0.999909631385078, + "", "", "", 2, 1633.89265814398, 1764.37700906817, 53.4279668719256, + 73, "constrained", 37, 0.958714294372556, 0.60963120104942, + 1.82443913909461, 3, 1, 1712.45537220169, 1845.09985113953, + 34.5269699000821, 73, "constrained", 38, 0.999963257835091, + 0.929556093266984, 0.450816248611524, 3, 2, 1627.89265813238, + 1753.54425531862, 54.5525537466108, 76, "more constrained", + 37, 0.970044580307764, 0.771142273547438, 1.12458687468521, + 3, 1, 1709.17917553332, 1836.91089599197, 38.1908170729296, + 76, "more constrained", 38, 0.999911473827655, 0.300125123328537, + 3.66384717284747, 3, 2)) }) test_that("Multigroup, multimodel SEM works", { @@ -627,8 +632,8 @@ test_that("Bootstrapping model fit table works", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] jaspTools::expect_equal_tables(table, - list(48.1563554263444, 59.7437959940259, 0, 0, "Model1", 75, 1), - label = "Model fit table results match") + list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 0, "Model1", + 75, 0)) }) @@ -758,9 +763,9 @@ test_that("Variance-covariance input works", { results <- jaspTools::runAnalysis("SEM", data, options) table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] jaspTools::expect_equal_tables(table, - list(707.570148255052, 721.47507693627, 0, 0, "Model1", 75, 1, "", - "", "", 1095.63355300897, 1109.53848169019, 0, 0, "Model2", 75, - 1, "", 0, 0)) + list(707.570148255052, 721.47507693627, 6.66133814775094e-14, 0, "Model1", + 75, 0, "", "", "", 1095.63355300897, 1109.53848169019, 0, 0, + "Model2", 75, 1, "", -6.66133814775094e-14, 0)) }) From 7912e99871fc3edd2cfd6f051f950cd7cd7cb5a1 Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Fri, 17 May 2024 12:11:26 +0200 Subject: [PATCH 08/10] fix the test --- tests/testthat/test-sem.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index d0f1d909..6c1a2540 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -107,6 +107,7 @@ options$estimator = "default" options$group = "group" options$informationMatrix = "expected" options$meanStructure = TRUE +options$latentInterceptFixedToZero = TRUE options$modificationIndexLowHidden = TRUE options$naAction = "listwise" options$impliedCovariance = TRUE From fed8b7ed3764ae57b1c1e304018e9efaba3d66fb Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Fri, 17 May 2024 14:51:57 +0200 Subject: [PATCH 09/10] catch error with meanstructure and no intercepts fixed to zero --- R/sem.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/R/sem.R b/R/sem.R index 12d31856..c21b8c9c 100644 --- a/R/sem.R +++ b/R/sem.R @@ -117,7 +117,7 @@ SEMInternal <- function(jaspResults, dataset, options, ...) { } } - # Check mean structure: + # Check variance covariance matrix input and its implications: if (options[["dataType"]] == "varianceCovariance") { if (options[["meanStructure"]]) { modelContainer$setError(gettext("Mean structure can not be included when data is variance-covariance matrix")) @@ -143,6 +143,15 @@ SEMInternal <- function(jaspResults, dataset, options, ...) { return() } } + + # Check if meanstructure is true but then no checkbox to fix the intercepts to zero is checked + if (options[["meanStructure"]]) { + if (!any(c(options[["manifestInterceptFixedToZero"]], options[["latentInterceptFixedToZero"]], + options[["manifestMeanFixedToZero"]]))) { + .quitAnalysis(gettext("When mean structure is included, at least one of the checkboxes to fix the intercepts to zero has to be checked")) + return() + } + } } checkLavaanModel <- function(model, availableVars) { From 588e4e546e31dd563abdefccb9f27ed55db524aa Mon Sep 17 00:00:00 2001 From: Julius Pfadt Date: Sat, 18 May 2024 15:56:48 +0200 Subject: [PATCH 10/10] try fixing failing tests --- tests/testthat/test-sem.R | 49 ++++++++++++++++++++++++++++----------- 1 file changed, 36 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index 6c1a2540..f09302bf 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -13,10 +13,16 @@ results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) test_that("Model fit table results match", { table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] - if (jaspBase::getOS() == "linux") skip("Skipped for now cause that part of the table is removed in another PR anyways") - jaspTools::expect_equal_tables(table, - list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 0, "Model1", - 75, 0)) + if (jaspBase::getOS() == "windows") { + jaspTools::expect_equal_tables(table, + list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 1, "Model1", + 75, 0)) + } else { + jaspTools::expect_equal_tables(table, + list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 0, "Model1", + 75, 0)) + } + }) parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]] @@ -629,12 +635,18 @@ results <- jaspTools::runAnalysis("SEM", "poldem_grouped.csv", options) # Model fit table results match test_that("Bootstrapping model fit table works", { - if (jaspBase::getOS() == "linux") skip("Skipped for now cause that part of the table is removed in another PR anyways") - table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] - jaspTools::expect_equal_tables(table, - list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 0, "Model1", - 75, 0)) + + if (jaspBase::getOS() == "windows") { + jaspTools::expect_equal_tables(table, + list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 1, "Model1", + 75, 0)) + } else { + jaspTools::expect_equal_tables(table, + list(48.156355426345, 59.7437959940266, 9.99200722162641e-14, 0, "Model1", + 75, 0)) + } + }) @@ -757,16 +769,27 @@ test_that("Variance-covariance input works", { ) data <- read.csv("poldem_grouped.csv") + # data <- read.csv("tests/testthat/poldem_grouped.csv") data <- cov(data) data <- as.data.frame(data) set.seed(1) results <- jaspTools::runAnalysis("SEM", data, options) table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_fittab"]][["data"]] - jaspTools::expect_equal_tables(table, - list(707.570148255052, 721.47507693627, 6.66133814775094e-14, 0, "Model1", - 75, 0, "", "", "", 1095.63355300897, 1109.53848169019, 0, 0, - "Model2", 75, 1, "", -6.66133814775094e-14, 0)) + + if (jaspBase::getOS() == "osx") { + jaspTools::expect_equal_tables(table, + list(707.570148255052, 721.47507693627, 6.66133814775094e-14, 0, "Model1", + 75, 0, "", "", "", 1095.63355300897, 1109.53848169019, 0, 0, + "Model2", 75, 1, "", -6.66133814775094e-14, 0)) + } else { + jaspTools::expect_equal_tables(table, + list(707.570148255052, 721.47507693627, 6.66133814775094e-14, 1, "Model1", + 75, 0, "", "", "", 1095.63355300897, 1109.53848169019, 0, 0, + "Model2", 75, 1, "", -6.66133814775094e-14, 0)) + + } + })