diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R index bbf5d6a4..a4572329 100644 --- a/R/confirmatoryfactoranalysis.R +++ b/R/confirmatoryfactoranalysis.R @@ -23,7 +23,6 @@ gettextf <- function(fmt, ..., domain = NULL) { confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, ...) { jaspResults$addCitation("Rosseel, Y. (2012). lavaan: An R Package for Structural Equation Modeling. Journal of Statistical Software, 48(2), 1-36. URL http://www.jstatsoft.org/v48/i02/") - # Preprocess options options <- .cfaPreprocessOptions(options) @@ -180,13 +179,14 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. # define estimator from options estimator = switch(options[["estimator"]], - "default" = "default", - "maximumLikelihood" = "ML", - "generalizedLeastSquares" = "GLS", - "weightedLeastSquares" = "WLS", - "unweightedLeastSquares" = "ULS", - "diagonallyWeightedLeastSquares" = "DWLS" - ) + "default" = "default", + "maximumLikelihood" = "ML", + "generalizedLeastSquares" = "GLS", + "weightedLeastSquares" = "WLS", + "unweightedLeastSquares" = "ULS", + "diagonallyWeightedLeastSquares" = "DWLS" + ) + cfaResult[["lav"]] <- try(lavaan::lavaan( model = mod, @@ -198,8 +198,10 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. std.lv = options$modelIdentification == "factorVariance", auto.fix.first = options$modelIdentification == "markerVariable", orthogonal = options$factorsUncorrelated, - int.ov.free = TRUE, - int.lv.free = FALSE, + int.ov.free = (options$interceptsFixedToZero == "latent" || options$interceptsFixedToZero == "meanManifest"), + int.lv.free = (options$interceptsFixedToZero == "manifest" || options$interceptsFixedToZero == "meanManifest"), + effect.coding = ifelse(options$modelIdentification == "effectsCoding", TRUE, + ifelse(options$interceptsFixedToZero == "meanManifest", "intercepts", FALSE)), auto.fix.single = TRUE, auto.var = TRUE, auto.cov.lv.x = TRUE, @@ -210,7 +212,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. estimator = estimator, missing = ifelse(options$naAction == "twoStageRobust", "robust.two.stage", ifelse(options$naAction == "twoStage", "two.stage", options$naAction)) - )) + )) # are there ordered variables in the data? cfaResult[["orderedVariables"]] <- any(sapply(dataset, is.ordered)) @@ -264,7 +266,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["stateCFAResult"]]$dependOn(c( "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", - "group", "invarianceTesting" + "group", "invarianceTesting", "interceptsFixedToZero" )) @@ -378,45 +380,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. rc <- NULL } - #' I dont think we need this bit of code, as setting meanstructure to TRUE - #' does already fix the latent means to zero across groups, - #' which is exactly what this piece of code does - if (options$meanStructure && options$group != "") { - lm <- "# Latent means" - lvs <- c(cfaResult[["spec"]]$latents, cfaResult[["spec"]]$soLatents) - for (i in seq_along(lvs)) { - lm <- paste0(lm, '\n', lvs[i], " ~ c(0,", - paste(rep(NA, length(unique(na.omit(dataset[[gv]]))) - 1), collapse = ","), - ")*1") - } - } else { - lm <- NULL - } - # lm <- NULL - if (options$modelIdentification == "effectsCoding") { - ef <- "# effects coding restrictions" - for (i in 1:length(labels)) { - if (nchar(options$group) == 0 || options$invarianceTesting !="configural") { - restr <- paste0(labels[[i]][1], " == ", - paste(c(length(labels[[i]]), labels[[i]][-1]), - collapse = " - ")) - ef <- paste0(ef, "\n", restr) - } else { # configural invarianceTesting - restr <- "" - for (j in 1:n_levels) { - restr <- paste0(restr, unlist(labels[[i]][1])[j], " == ", - paste(c(length(labels[[i]]), lapply(labels[[i]][-1], function(x) x[j])), - collapse = " - "), "\n") - } - ef <- paste0(ef, "\n", restr) - } - } - } else { - ef <- NULL - } - - return(list(model = paste0(c(fo, so, rc, lm, ef), collapse = "\n\n"), simple_model = fo_simp)) + return(list(model = paste0(c(fo, so, rc), collapse = "\n\n"), simple_model = fo_simp)) } .CFAInvariance <- function(options) { @@ -425,7 +390,9 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. "configural" = return(""), "metric" = return("loadings"), "scalar" = return(c("loadings", "intercepts")), - "strict" = return(c("loadings", "intercepts", "residuals", "residual.covariances")) + "strict" = return(c("loadings", "intercepts", "residuals", "residual.covariances")), + "structural" = return(c("loadings", "intercepts", "residuals", "residual.covariances", + "means", "lv.variances", "lv.covariances")) ) } @@ -436,7 +403,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["maincontainer"]]$dependOn(c( "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", - "group", "invarianceTesting" + "group", "invarianceTesting", "interceptsFixedToZero" )) } @@ -493,7 +460,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["maincontainer"]][["kmo"]] <- tabkmo <- createJaspTable(gettext("Kaiser-Meyer-Olkin (KMO) test")) tabkmo$addColumnInfo(name = "indicator", title = "Indicator", type = "string") - tabkmo$dependOn(c("factors", "naAction", "group", "kaiserMeyerOlkinTest")) + tabkmo$dependOn("kaiserMeyerOlkinTest") if (is.null(cfaResult)) return() cov_implied <- lavaan::fitted(cfaResult[["lav"]]) @@ -523,7 +490,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. if (!options$bartlettTest || !is.null(jaspResults[["maincontainer"]][["bartlett"]])) return() jaspResults[["maincontainer"]][["bartlett"]] <- tabbartlett <- createJaspTable(gettext("Bartlett's test of sphericity")) - tabbartlett$dependOn(c("factors", "naAction", "group", "bartlettTest")) + tabbartlett$dependOn("bartlettTest") if (is.null(cfaResult)) return() cov_implied <- lavaan::fitted(cfaResult[["lav"]]) @@ -562,8 +529,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["maincontainer"]][["rSquared"]] <- tabr2 <- createJaspTable(gettext("R-Squared")) tabr2$addColumnInfo(name = "__var__", title = "", type = "string") tabr2$setExpectedSize(rows = 1, cols = 1) - tabr2$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "rSquared")) + tabr2$dependOn("rSquared") if (is.null(cfaResult)) return() @@ -596,8 +562,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. .cfaTableFitMeasures <- function(jaspResults, options, cfaResult) { if (!options$fitMeasures || !is.null(jaspResults[["maincontainer"]][["fits"]])) return() jaspResults[["maincontainer"]][["fits"]] <- fitms <- createJaspContainer(gettext("Additional fit measures")) - fitms$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "fitMeasures")) + fitms$dependOn("fitMeasures") # Fit indices fitms[["indices"]] <- fitin <- createJaspTable(gettext("Fit indices")) @@ -685,7 +650,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["estimates"]] <- ests <- createJaspContainer(gettext("Parameter estimates"), position = 2) ests$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", - "group", "invarianceTesting", "standardized", "ciLevel")) + "group", "invarianceTesting", "standardized", "ciLevel", "interceptsFixedToZero")) footnote <- NULL @@ -915,9 +880,9 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. rc$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") rc$addColumnInfo(name = "ci.lower", title = gettext("Lower"), type = "number", format = "sf:4;dp:3", - overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) + overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) rc$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", - overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) + overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) if (options$standardized != "none") rc$addColumnInfo(name = paste0("std.", standardization), @@ -950,13 +915,13 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fi$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") fi$addColumnInfo(name = "ci.lower", title = gettext("Lower"), type = "number", format = "sf:4;dp:3", - overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) + overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) fi$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", - overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) + overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) if (options$standardized != "none") fi$addColumnInfo(name = paste0("std.", standardization), title = gettextf("Std. Est. (%s)", standardization), - type = "number", format = "sf:4;dp:3") + type = "number", format = "sf:4;dp:3") # add data fidat <- pei[pei$op == "~1" & pei$lhs %in% facNames, colSel[!colSel %in% 'rhs']] @@ -986,7 +951,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. if (options$standardized != "none") vi$addColumnInfo(name = paste0("std.", standardization), title = gettextf("Std. Est. (%s)", standardization), - type = "number", format = "sf:4;dp:3") + type = "number", format = "sf:4;dp:3") # add data vidat <- pei[pei$op == "~1" & !pei$lhs == "SecondOrder" & !pei$lhs %in% facNames, @@ -1002,12 +967,12 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. # Thresholds if ("|" %in% pei$op) { - .thresholdsTable(jrobject, footnote, options, standardization, pei, colSel, cfaResult) + .cfaThresholdsTable(jrobject, footnote, options, standardization, pei, colSel, cfaResult) } } -.thresholdsTable <- function(jrobject, footnote, options, standardization, pei, colSel, cfaResult) { +.cfaThresholdsTable <- function(jrobject, footnote, options, standardization, pei, colSel, cfaResult) { # Manifest variable intercepts jrobject[["Thresholds"]] <- th <- createJaspTable(title = gettext("Thresholds")) if (!is.null(footnote)) th$addFootnote(footnote) @@ -1049,8 +1014,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. mi <- try(lavaan::modindices(cfaResult[["lav"]])) jaspResults[["modind"]] <- mic <- createJaspContainer(gettext("Modification Indices"), position = 5) mic$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "modificationIndices", - "modificationIndicesCutoff")) + "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "modificationIndices", + "modificationIndicesCutoff", "interceptsFixedToZero")) if (isTryError(mi)) { mic$setError(.extractErrorMessage(mi)) @@ -1185,7 +1150,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. icc$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", - "group", "invarianceTesting", "impliedCovarianceMatrix")) + "group", "invarianceTesting", "impliedCovarianceMatrix", "interceptsFixedToZero")) } .cfaTableResCov <- function(jaspResults, options, cfaResult) { @@ -1219,7 +1184,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. } rcc$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "residualCovarianceMatrix")) + "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", + "residualCovarianceMatrix", "interceptsFixedToZero")) } .cfaInitPlots <- function(jaspResults, options, cfaResult) { @@ -1228,7 +1194,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["plots"]] <- createJaspContainer(gettext("Plots"), position = 6) jaspResults[["plots"]]$dependOn(c( "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", - "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting" + "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "interceptsFixedToZero" )) } @@ -1385,7 +1351,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. aveTable$addColumnInfo(name = "factor", title = gettext("Factor"), type = "string") aveTable$addColumnInfo(name = "ave", title = gettext("AVE"), type = "number") aveTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "ave")) + "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "ave", "interceptsFixedToZero")) if (options$group != "") { ave_result <- semTools::AVE(cfaResult[["lav"]]) @@ -1410,7 +1376,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. htmtTable <- createJaspTable(gettext("Heterotrait-monotrait ratio"), position = 4.2) htmtTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "htmt")) + "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "htmt", "interceptsFixedToZero")) if (options[["group"]] != "") { htmtTable$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) @@ -1473,7 +1439,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. relTable$addColumnInfo(name = "rel", title = gettextf("Coefficient %s", "\u03C9"), type = "number") relTable$addColumnInfo(name = "alpha", title = gettextf("Coefficient %s", "\u03B1"), type = "number") relTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", - "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "reliability")) + "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "reliability", "interceptsFixedToZero")) nfac <- length(cfaResult[["spec"]][["latents"]]) diff --git a/inst/help/ConfirmatoryFactorAnalysis.md b/inst/help/ConfirmatoryFactorAnalysis.md index 08cc83cf..0dc5a3a6 100644 --- a/inst/help/ConfirmatoryFactorAnalysis.md +++ b/inst/help/ConfirmatoryFactorAnalysis.md @@ -16,7 +16,10 @@ JASP allows the factors in turn to be indicators of a second-order factor. This ### Model options ------- -- Include mean structure: display means for the indicators and, in the case of multi-group CFA, the means of the latent variables. +- Include mean structure: display means for the indicators and, in the case of multi-group CFA, the means of the latent variables. To identify the model, the following options can be selected: + - Fix latent intercepts to zero + - Fix manifest intercepts to zero + - Fix mean of manifest intercepts to zero: translates to effect coding - Assume factors uncorrelated: set the correlation between the different latent variables to 0. - Factor scaling: factors can be given a scale in one of three ways: - Factor variances (default): the factor has a fixed variance of 1 @@ -24,6 +27,16 @@ JASP allows the factors in turn to be indicators of a second-order factor. This - Effects coding: the mean of the factor loadings is fixed to 1. For more information on the interpretation of effects coding, see Veen (2018) - Residual covariances: to allow for covariance between indicators not explained by their respective factor, for example because questions were phrased in a similar way, drag two variables to the right-side assignment box. +### Multigroup CFA +------ +- Grouping variable: Select a categorical variable here to create CFA models for each group +- Invariance testing: Select a level of constraining parameters over the different groups. + - configural: the different groups have the same CFA structure + - metric: same as configural and the factor loadings are constrained to be equal across groups + - scalar: same as metric and the means of the indicators (intercepts) are constrained to be equal across groups + - strict: same as scalar and the residual variances, and residual covariances are constrained to be equal across groups + - structural: same as strict and the latent means, variances, and covariances are constrained to be equal across groups + ### Additional output ------- - Additional fit measures: select these to display the value of the various fit indices in the output pane @@ -38,14 +51,6 @@ JASP allows the factors in turn to be indicators of a second-order factor. This - Modification indices: Display MIs with a minimum cutoff. A MI shows how much the chi-square value of overall fit would change if the parameter in question is freed up. EPC shows the expected change of the parameter itself. - Show lavaan syntax: Display the lavaan modeling syntax that would be needed to run the model in R -### Multigroup CFA ------- -- Grouping variable: Select a categorical variable here to create CFA models for each group -- Invariance testing: Select a level of constraining parameters over the different groups. - - configural: the different groups have the same CFA structure - - metric: the factor loadings are constrained to be equal across groups - - scalar: the factor loadings and means of the indicators are constrained to be equal across groups - - strict: the factor loadings, means of the indicators, residual variances, and residual covariances are constrained to be equal across groups ### Plots ------- diff --git a/inst/help/ConfirmatoryFactorAnalysis_nl.md b/inst/help/ConfirmatoryFactorAnalysis_nl.md index b0f0799b..3ab15e9c 100644 --- a/inst/help/ConfirmatoryFactorAnalysis_nl.md +++ b/inst/help/ConfirmatoryFactorAnalysis_nl.md @@ -15,7 +15,10 @@ JASP staat toe dat factoren op hun beurt indicatoren worden van een tweede-orde ### Model opties ------- -- Voeg gemiddelde structuur toe: Toon gemiddeldes van de indicatoren en, in the geval van multi-groep CFA, de gemiddeldes van de latente variabelen. +- Gemiddeldestructuur opnemen: gemiddelden weergeven voor de indicatoren en, in het geval van CFA voor meerdere groepen, de gemiddelden van de latente variabelen. Om het model te identificeren, kunnen de volgende opties worden geselecteerd: + - Fixeer latente intercepts op nul + - Fixeer manifeste intercepts op nul + - Zet gemiddelde van manifeste intercepts op nul: vertaalt zich naar effectcodering - Neem ongecorreleerde factoren aan: Zet de correlatie tussen verschillende latente variabelen op 0. - Factor schalen: Factoren kunnen op drie manier geschaald zijn: - Factor varianties (standaardoptie): De factor heeft een vaste variantie van 1. @@ -23,6 +26,16 @@ JASP staat toe dat factoren op hun beurt indicatoren worden van een tweede-orde - Effecten coderen: Het gemiddelde van de factorlading is vastgezet op 1. Voor meer informatie over de interpretatie van effecten coderen, zie Veen (2018). - Residu covarianties: Om ook covariantie toe te staan tussen indicatoren die niet verklaard worden door hun respectieve factor, bijvoorbeeld omdat vragen in een vergelijkbare manier verwoord zijn, sleep twee variabelen naar het rechter invoerveld. +### Multigroep CFA +------ +- Groepen: Selecteer hier een categorische variabele om CFA modellen voor iedere groep te creëren. +- Invariantie testen: Selecteer een niveau van beperkende parameters over de verschillende groepen. + - configureel: De verschilllende groepen hebben dezelfde CFA structuur. + - metrisch: hetzelfde als configureel, maar de factorladingen moeten voor alle groepen gelijk zijn + - scalair: hetzelfde als metrisch en de gemiddelden van de indicatoren (intercepts) moeten voor alle groepen gelijk zijn + - strikt: hetzelfde als scalair en de restvarianties en restcovarianties moeten gelijk zijn voor alle groepen. + - structureel: hetzelfde als strikt en de latente gemiddelden, varianties en covarianties moeten voor alle groepen gelijk zijn. + ### Aanvullende uitvoer ------- - Extra pasmaten: Kies deze om de waarde van verschillende model pasmaten te tonen in de resultaten. @@ -36,15 +49,6 @@ JASP staat toe dat factoren op hun beurt indicatoren worden van een tweede-orde - Residu covariantiematrix: Toon de covarianties tussen indicatoren die behouden blijft met het model. Een perfect model toont enkel 0-en hier. - Modificatie indices: Toont MIs met een minimum grens. Een MI toont hoeveel de chi-square waarde van de passing zou veranderen als de gespecificeerde parameter vrij zou zijn. EPC toont de verwachten verandering van de parameter zelf. - Toon lavaan syntax: Toon de lavaan modeleer syntax die nodig zou zijn om het model in R weer te geven. - -### Multigroep CFA ------- -- Groepen: Selecteer hier een categorische variabele om CFA modellen voor iedere groep te creëren. -- Invariantie testen: Selecteer een niveau van beperkende parameters over de verschillende groepen. - - Configureel: De verschilllende groepen hebben dezelfde CFA structuur. - - Metrisch: De factorladingen van de groepen zijn gelijk. - - Scalar: De factorladingen en gemiddeldes van de indicatoren van de groepen zijn gelijk. - - Strikt: De factorladingen, gemiddeldes van de indicatoren, residu varianties, en residu covarianties van de groepen zijn gelijk. ### Grafieken ------- diff --git a/inst/qml/ConfirmatoryFactorAnalysis.qml b/inst/qml/ConfirmatoryFactorAnalysis.qml index c6c9d9bf..e2c9354c 100644 --- a/inst/qml/ConfirmatoryFactorAnalysis.qml +++ b/inst/qml/ConfirmatoryFactorAnalysis.qml @@ -79,7 +79,22 @@ Form Group { title: qsTr("Model Options") - CheckBox { label: qsTr("Include mean structure") ; name: "meanStructure" ; id: meanstructure } + CheckBox + { + label: qsTr("Include mean structure") ; + name: "meanStructure" ; + id: meanstructure + + RadioButtonGroup + { + // ChildrenOnSameRow: true + name: "interceptsFixedToZero" + RadioButton { label: qsTr("Fix latent intercepts to zero") ; value: "latent"; checked: true} + RadioButton { label: qsTr("Fix manifest intercepts to zero"); value: "manifest"} + RadioButton { label: qsTr("Fix mean of manifest intercepts to zero"); value: "meanManifest"} + + } + } CheckBox { label: qsTr("Assume factors uncorrelated") ; name: "factorsUncorrelated" } CheckBox { label: qsTr("Fix exogenous covariates") ; name: "exogenousCovariatesFixed" ; checked: true ; visible: false } DropDown @@ -107,6 +122,31 @@ Form } } + Section + { + title: qsTr("Multigroup CFA") + DropDown + { + label: qsTr("Grouping variable") ; + name: "group"; + showVariableTypeIcon: true; + addEmptyValue: true; + } // No model: it takes all variables per default + DropDown + { + label: qsTr("Invariance testing") + name: "invarianceTesting" + values: [ + { label: qsTr("Configural") , value: "configural"}, + { label: qsTr("Metric") , value: "metric" }, + { label: qsTr("Scalar") , value: "scalar" }, + { label: qsTr("Strict") , value: "strict" }, + { label: qsTr("Structural") , value: "structural"}, + ] + } + } + + Section { title: qsTr("Additional Output") @@ -138,28 +178,6 @@ Form } } - Section - { - title: qsTr("Multigroup CFA") - DropDown - { - label: qsTr("Grouping variable") ; - name: "group"; - showVariableTypeIcon: true; - addEmptyValue: true; - } // No model: it takes all variables per default - DropDown - { - label: qsTr("Invariance testing") - name: "invarianceTesting" - values: [ - { label: qsTr("Configural") , value: "configural" }, - { label: qsTr("Metric") , value: "metric" }, - { label: qsTr("Scalar") , value: "scalar" }, - { label: qsTr("Strict") , value: "strict" } - ] - } - } Section { diff --git a/tests/testthat/test-confirmatoryfactoranalysis.R b/tests/testthat/test-confirmatoryfactoranalysis.R index 25b01e2e..91946c84 100644 --- a/tests/testthat/test-confirmatoryfactoranalysis.R +++ b/tests/testthat/test-confirmatoryfactoranalysis.R @@ -61,36 +61,36 @@ test_that("[CFA 3-Factor] Factor loadings table results match", { test_that("[CFA 3-Factor] Factor variances table results match", { table <- results[["results"]][["estimates"]][["collection"]][["estimates_fv"]][["data"]] jaspTools::expect_equal_tables(table, - list(1, 1, 1, "Factor 1", "", 0, "", 1, 1, 1, "Factor 2", "", 0, "", - 1, 1, 1, "Factor 3", "", 0, "")) + list(1, 1, 1, "Factor 1", "", 0, "", 1, 1, 1, "Factor 2", "", 0, "", + 1, 1, 1, "Factor 3", "", 0, "")) }) test_that("[CFA 3-Factor] Residual variances table results match", { table <- results[["results"]][["estimates"]][["collection"]][["estimates_rv"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.326399894319287, 0.771706936936134, 0.549053415627711, "x1", - 1.34368055770828e-06, 0.113600822803218, 4.83318168019605, 0.934462587447057, - 1.33321007058646, 1.13383632901676, "x2", 0, 0.10172316590628, - 11.1462941495686, 0.666706476085054, 1.02194282083783, 0.844324648461441, - "x3", 0, 0.0906231817407956, 9.31687270566615, 0.277647747273574, - 0.464697982595281, 0.371172864934427, "x4", 7.32747196252603e-15, - 0.047717773591029, 7.77850341710428, 0.331807290171594, 0.560702710555418, - 0.446255000363506, "x5", 2.1316282072803e-14, 0.0583927618541264, - 7.64229993913142, 0.271855645519897, 0.44054959934542, 0.356202622432658, - "x6", 2.22044604925031e-16, 0.0430349626718039, 8.27705196700539, - 0.639885213665674, 0.958894859526553, 0.799390036596114, "x7", - 0, 0.0813815071034943, 9.82274800563124, 0.342279857209668, - 0.63311496350216, 0.487697410355914, "x8", 4.92208496183366e-11, - 0.0741939924882706, 6.57327357646934, 0.427489578257306, 0.704773115754749, - 0.566131347006028, "x9", 1.11022302462516e-15, 0.0707368961074339, - 8.00333882541577)) + list(0.326399894319287, 0.771706936936134, 0.549053415627711, "x1", + 1.34368055770828e-06, 0.113600822803218, 4.83318168019605, 0.934462587447057, + 1.33321007058646, 1.13383632901676, "x2", 0, 0.10172316590628, + 11.1462941495686, 0.666706476085054, 1.02194282083783, 0.844324648461441, + "x3", 0, 0.0906231817407956, 9.31687270566615, 0.277647747273574, + 0.464697982595281, 0.371172864934427, "x4", 7.32747196252603e-15, + 0.047717773591029, 7.77850341710428, 0.331807290171594, 0.560702710555418, + 0.446255000363506, "x5", 2.1316282072803e-14, 0.0583927618541264, + 7.64229993913142, 0.271855645519897, 0.44054959934542, 0.356202622432658, + "x6", 2.22044604925031e-16, 0.0430349626718039, 8.27705196700539, + 0.639885213665674, 0.958894859526553, 0.799390036596114, "x7", + 0, 0.0813815071034943, 9.82274800563124, 0.342279857209668, + 0.63311496350216, 0.487697410355914, "x8", 4.92208496183366e-11, + 0.0741939924882706, 6.57327357646934, 0.427489578257306, 0.704773115754749, + 0.566131347006028, "x9", 1.11022302462516e-15, 0.0707368961074339, + 8.00333882541577)) }) test_that("[CFA 3-Factor] Chi-square test table results match", { table <- results[["results"]][["maincontainer"]][["collection"]][["maincontainer_cfatab"]][["data"]] jaspTools::expect_equal_tables(table, - list(918.851589292384, 36, "Baseline model", "", 85.305521772505, 24, - "Factor model", 8.50255310602677e-09)) + list(918.851589292384, 36, "Baseline model", "", 85.305521772505, 24, + "Factor model", 8.50255310602677e-09)) }) test_that("Kaiser-Meyer-Olkin (KMO) test table results match", { @@ -167,37 +167,37 @@ test_that("[CFA Second order] Second-order factor loadings table results match", test_that("[CFA Second order] Factor variances table results match", { table <- results[["results"]][["estimates"]][["collection"]][["estimates_fv"]][["data"]] jaspTools::expect_equal_tables(table, - list(1, 1, 1, "Factor 1", "", 0, "", 1, 1, 1, "Factor 2", "", 0, "", - 1, 1, 1, "Factor 3", "", 0, "", 1, 1, 1, "Second-Order", "", - 0, "")) + list(1, 1, 1, "Factor 1", "", 0, "", 1, 1, 1, "Factor 2", "", 0, "", + 1, 1, 1, "Factor 3", "", 0, "", 1, 1, 1, "Second-Order", "", + 0, "")) }) test_that("[CFA Second order] Residual variances table results match", { table <- results[["results"]][["estimates"]][["collection"]][["estimates_rv"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.326401450955574, 0.771708269797423, 0.549054860376498, "x1", - 1.34357828596165e-06, 0.11360076571671, 4.83319682673349, 0.934464040890642, - 1.33321206655867, 1.13383805372466, "x2", 0, 0.101723304308982, - 11.1462959390372, 0.666705522978852, 1.02194196604298, 0.844323744510915, - "x3", 0, 0.0906232068206831, 9.3168601524065, 0.2776477911548, - 0.464698082724097, 0.371172936939448, "x4", 7.32747196252603e-15, - 0.0477177879401676, 7.77850258701964, 0.331807404885689, 0.560702857278213, - 0.446255131081951, "x5", 2.1316282072803e-14, 0.0583927700197611, - 7.64230110904024, 0.271855604188449, 0.44054957527582, 0.356202589732134, - "x6", 2.22044604925031e-16, 0.0430349670754176, 8.27705036018498, - 0.63988809304374, 0.958898264282657, 0.799393178663198, "x7", - 0, 0.0813816411309667, 9.82277043758238, 0.342280111000572, - 0.633115637435664, 0.487697874218118, "x8", 4.92219598413612e-11, - 0.0741940996694749, 6.57327033269154, 0.427488355941731, 0.704772286642682, - 0.566130321292206, "x9", 1.11022302462516e-15, 0.0707369964162943, - 8.00331297586447)) + list(0.326401450955574, 0.771708269797423, 0.549054860376498, "x1", + 1.34357828596165e-06, 0.11360076571671, 4.83319682673349, 0.934464040890642, + 1.33321206655867, 1.13383805372466, "x2", 0, 0.101723304308982, + 11.1462959390372, 0.666705522978852, 1.02194196604298, 0.844323744510915, + "x3", 0, 0.0906232068206831, 9.3168601524065, 0.2776477911548, + 0.464698082724097, 0.371172936939448, "x4", 7.32747196252603e-15, + 0.0477177879401676, 7.77850258701964, 0.331807404885689, 0.560702857278213, + 0.446255131081951, "x5", 2.1316282072803e-14, 0.0583927700197611, + 7.64230110904024, 0.271855604188449, 0.44054957527582, 0.356202589732134, + "x6", 2.22044604925031e-16, 0.0430349670754176, 8.27705036018498, + 0.63988809304374, 0.958898264282657, 0.799393178663198, "x7", + 0, 0.0813816411309667, 9.82277043758238, 0.342280111000572, + 0.633115637435664, 0.487697874218118, "x8", 4.92219598413612e-11, + 0.0741940996694749, 6.57327033269154, 0.427488355941731, 0.704772286642682, + 0.566130321292206, "x9", 1.11022302462516e-15, 0.0707369964162943, + 8.00331297586447)) }) test_that("[CFA Second order] Chi-square test table results match", { table <- results[["results"]][["maincontainer"]][["collection"]][["maincontainer_cfatab"]][["data"]] jaspTools::expect_equal_tables(table, - list(918.851589292384, 36, "Baseline model", "", 85.3055217707089, - 24, "Factor model", 8.50255321704907e-09)) + list(918.851589292384, 36, "Baseline model", "", 85.3055217707089, + 24, "Factor model", 8.50255321704907e-09)) }) @@ -567,3 +567,154 @@ test_that("Reliability table results match", { "total", 2, 0.832040767424991, "", "SecondOrder", 2, 0.568295638332184 )) }) + + +# structural invariance test +options <- jaspTools::analysisOptions("confirmatoryFactorAnalysis") +options$group <- "sex" +options$invarianceTesting <- "structural" + +options$factors <- list( + list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1"), + list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2"), + list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3") +) +options$modelIdentification <- "markerVariable" +set.seed(1) +results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswineford.csv", options) + +test_that("Factor Covariances table results match", { + table <- results[["results"]][["estimates"]][["collection"]][["estimates_fc"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.252069643751425, 0.564393435959575, 0.4082315398555, 1, "Factor 1", + "", 2.99674828285745e-07, "Factor 2", 0.0796759008511687, + 5.12365138635909, 0.153674632748802, 0.370774902932515, 0.262224767840658, + 1, "Factor 1", "", 2.1939154322137e-06, "Factor 3", + 0.0553837396748543, 4.73468872597123, 0.0768417287748731, 0.270147907288013, + 0.173494818031443, 1, "Factor 2", "", 0.000434506858657757, + "Factor 3", 0.0493137067920418, 3.51818651076219, 0.252069643751426, + 0.564393435959575, 0.4082315398555, 2, "Factor 1", "", + 2.99674828285745e-07, "Factor 2", 0.0796759008511687, 5.1236513863591, + 0.153674632748802, 0.370774902932515, 0.262224767840658, 2, + "Factor 1", "", 2.1939154322137e-06, "Factor 3", 0.0553837396748543, + 4.73468872597123, 0.0768417287748731, 0.270147907288013, 0.173494818031443, + 2, "Factor 2", "", 0.000434506858657757, "Factor 3", + 0.0493137067920418, 3.51818651076219)) +}) + +test_that("Factor variances table results match", { + table <- results[["results"]][["estimates"]][["collection"]][["estimates_fv"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.51579922628888, 1.10282884918973, 0.809314037739304, 1, "Factor 1", + 6.50814258040811e-08, 0.149755206608709, 5.40424641030303, 0.759562812574203, + 1.19941902306092, 0.97949091781756, 1, "Factor 2", 0, 0.112210278851102, + 8.7290658917023, 0.203306550279352, 0.564190199988996, 0.383748375134174, + 1, "Factor 3", 3.06899737032573e-05, 0.0920638472329718, 4.16828523538758, + 0.51579922628888, 1.10282884918973, 0.809314037739304, 2, "Factor 1", + 6.50814258040811e-08, 0.149755206608709, 5.40424641030303, 0.759562812574203, + 1.19941902306092, 0.97949091781756, 2, "Factor 2", 0, 0.112210278851102, + 8.72906589170229, 0.203306550279352, 0.564190199988996, 0.383748375134174, + 2, "Factor 3", 3.06899737032573e-05, 0.0920638472329717, 4.16828523538759 + )) +}) + + +# fix manifest intercepts tests +options <- jaspTools::analysisOptions("confirmatoryFactorAnalysis") +options$group <- "sex" +options$meanStructure <- TRUE +options$interceptsFixedToZero <- "manifest" + +options$factors <- list( + list(indicators = list("x1", "x2", "x3"), name = "f1", title = "Factor 1"), + list(indicators = list("x4", "x5", "x6"), name = "f2", title = "Factor 2"), + list(indicators = list("x7", "x8", "x9"), name = "f3", title = "Factor 3") +) +options$modelIdentification <- "markerVariable" +set.seed(1) +results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswineford.csv", options) + +test_that("Intercepts table results match", { + table <- results[["results"]][["estimates"]][["collection"]][["estimates_Intercepts"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0, 0, 0, 1, "x1", "", 0, "", 0, 0, 0, 1, "x2", "", 0, "", 0, 0, + 0, 1, "x3", "", 0, "", 0, 0, 0, 1, "x4", "", 0, "", 0, 0, 0, + 1, "x5", "", 0, "", 0, 0, 0, 1, "x6", "", 0, "", 0, 0, 0, 1, + "x7", "", 0, "", 0, 0, 0, 1, "x8", "", 0, "", 0, 0, 0, 1, "x9", + "", 0, "", 0, 0, 0, 2, "x1", "", 0, "", 0, 0, 0, 2, "x2", "", + 0, "", 0, 0, 0, 2, "x3", "", 0, "", 0, 0, 0, 2, "x4", "", 0, + "", 0, 0, 0, 2, "x5", "", 0, "", 0, 0, 0, 2, "x6", "", 0, "", + 0, 0, 0, 2, "x7", "", 0, "", 0, 0, 0, 2, "x8", "", 0, "", 0, + 0, 0, 2, "x9", "", 0, "")) +}) + +test_that("Factor Intercepts table results match", { + table <- results[["results"]][["estimates"]][["collection"]][["estimates_Factor Intercepts"]][["data"]] + jaspTools::expect_equal_tables(table, + list(4.86032703729577, 5.21479167387077, 5.03755935558327, 1, "Factor 1", + 0, 0.090426313792235, 55.7089982364829, 2.75710153479434, 3.10340246097582, + 2.93025199788508, 1, "Factor 2", 0, 0.088343696341633, 33.1687728635842, + 3.90410200426111, 4.22060103316011, 4.06235151871061, 1, "Factor 3", + 0, 0.0807410318239286, 50.3133465964288, 4.68082259954853, 5.03876634316866, + 4.85979447135859, 2, "Factor 1", 0, 0.0913138574084872, 53.2207773199043, + 3.03093169693174, 3.3907128242691, 3.21082226060042, 2, "Factor 2", + 0, 0.0917825863575222, 34.9829132957014, 4.13415749314571, 4.48968795507957, + 4.31192272411264, 2, "Factor 3", 0, 0.0906982130126474, 47.5414297689786 + )) +}) + +options$interceptsFixedToZero <- "meanManifest" +set.seed(1) +results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswineford.csv", options) + +test_that("Factor Intercepts table results match", { + table <- results[["results"]][["estimates"]][["collection"]][["estimates_Factor Intercepts"]][["data"]] + jaspTools::expect_equal_tables(table, + list(3.65754400738779, 7.85746191244071, 5.75750295991425, 1, "Factor 1", + 7.71475485716877e-08, 1.0714273165684, 5.37367572291749, 2.67329743888011, + 3.38328888769281, 3.02829316328646, 1, "Factor 2", 0, 0.181123595742837, + 16.7194845644854, 3.71374413938686, 5.75309790047635, 4.7334210199316, + 1, "Factor 3", 0, 0.520252866168884, 9.09830839527763, 4.96696097397706, + 7.02507093096112, 5.99601595246909, 2, "Factor 1", 0, 0.525037697941945, + 11.4201627349282, 2.92991249413903, 3.60159845584644, 3.26575547499273, + 2, "Factor 2", 0, 0.171351608245249, 19.058796753857, 2.793007701454, + 5.28401148493782, 4.03850959319591, 2, "Factor 3", 2.08242978416706e-10, + 0.635471825791837, 6.35513555327757)) +}) + +test_that("Intercepts table results match", { + table <- results[["results"]][["estimates"]][["collection"]][["estimates_Intercepts"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-2.82086049306897, 1.37206410197526, -0.724398195546852, 1, "x1", + 0.498257853951389, 1.06964327613096, -0.677233440074615, 1.6579921814542, + 4.92350462308137, 3.29074840226779, 1, "x2", 7.80789775793878e-05, + 0.833054195736533, 3.95022126904759, -3.9895831284748, -1.14311728496707, + -2.56635020672093, 1, "x3", 0.000409050402817135, 0.726152589017015, + -3.53417483534002, -0.437370677504958, 0.216400318827097, -0.110485179338931, + 1, "x4", 0.507679587603854, 0.166781380037826, -0.662455121272365, + 0.417590399459313, 1.09105191834536, 0.754321158902338, 1, "x5", + 1.13050308931939e-05, 0.17180456482829, 4.39057693057366, -0.968470973968885, + -0.319200985157928, -0.643835979563407, 1, "x6", 0.000101440416994558, + 0.165633142734335, -3.88712046957944, -1.69451524371202, 0.339644579320786, + -0.677435332195615, 1, "x7", 0.191739032345593, 0.518927857623404, + -1.30545185085678, -2.84093538587357, -0.0293351814438569, -1.43513528365872, + 1, "x8", 0.0454071513513012, 0.717258129896075, -2.00086304196601, + 1.05054048576094, 3.17460074594772, 2.11257061585433, 1, "x9", + 9.67009333712188e-05, 0.541862064033088, 3.89872396700082, -2.16953548981766, + -0.134323505968075, -1.15192949789287, 2, "x1", 0.0265086185992982, + 0.51919627092719, -2.21867829642869, 1.74677342548164, 3.48493867238887, + 2.61585604893525, 2, "x2", 3.65035446314721e-09, 0.443417649665415, + 5.89930520562065, -2.34974383123603, -0.578109270848743, -1.46392655104239, + 2, "x3", 0.00119911054203281, 0.451955896731194, -3.23909160524368, + -0.36798865865047, 0.227876404599755, -0.0700561270253575, 2, + "x4", 0.64489351397835, 0.152009186890762, -0.460867717657759, + 0.592141420248959, 1.21531497293793, 0.903728196593445, 2, "x5", + 1.31048960572144e-08, 0.158975766290729, 5.68469155821359, -1.12184965654026, + -0.545494482595909, -0.833672069568086, 2, "x6", 1.4279661453287e-08, + 0.14703208285728, -5.67000108661529, -0.977643544907075, 1.51717429862637, + 0.269765376859647, 2, "x7", 0.671665767304788, 0.636444818173255, + 0.423862947983357, 0.174180036260091, 2.10442292951146, 1.13930148288577, + 2, "x8", 0.0206848446354611, 0.492417949635013, 2.31368796310175, + -2.8898649408433, 0.071731221352461, -1.40906685974542, 2, "x9", + 0.0621783869832733, 0.755523107964345, -1.86502152600198)) +})