diff --git a/DESCRIPTION b/DESCRIPTION index cb0d13f2..6184d3a1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: jaspFactor Type: Package Title: Factor Module for JASP Version: 0.19.0 -Date: 2023-04-14 +Date: 2024-08-19 Author: JASP Team Website: jasp-stats.org Maintainer: JASP Team diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R index 97689ece..1abaadf9 100644 --- a/R/confirmatoryfactoranalysis.R +++ b/R/confirmatoryfactoranalysis.R @@ -19,6 +19,7 @@ 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) @@ -189,21 +190,11 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. geq <- .CFAInvariance(options) if (options$group == "") grp <- NULL else grp <- options$group - # define estimator from options - estimator = switch(options[["estimator"]], - "default" = "default", - "maximumLikelihood" = "ML", - "generalizedLeastSquares" = "GLS", - "weightedLeastSquares" = "WLS", - "unweightedLeastSquares" = "ULS", - "diagonallyWeightedLeastSquares" = "DWLS" - ) - if (anyNA(dataset)) { naAction <- ifelse(options$naAction == "twoStageRobust", "robust.two.stage", ifelse(options$naAction == "twoStage", "two.stage", options$naAction)) } else { - naAction <- "default" + naAction <- "listwise" } cfaResult[["lav"]] <- try(lavaan::lavaan( @@ -227,7 +218,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. auto.delta = TRUE, auto.cov.y = TRUE, mimic = options$packageMimiced, - estimator = estimator, + estimator = options[["estimator"]], missing = naAction )) @@ -275,7 +266,15 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. # Bootstrapping with interruptible progress bar if (cfaResult[["spec"]]$bootstrap) { - cfaResult[["lav"]] <- jaspSem::lavBootstrap(cfaResult[["lav"]], options$bootstrapSamples) + type <- switch(options[["standardized"]], + "all" = "std.all", + "latentVariables" = "std.lv", + "noExogenousCovariates" = "std.nox") + # change this once jaspSem is merged + cfaResult[["lav"]] <- lavBootstrap(cfaResult[["lav"]], options$bootstrapSamples, + standard = options[["standardized"]] != "none", typeStd = type) + # cfaResult[["lav"]] <- jaspSem::lavBootstrap(cfaResult[["lav"]], options$bootstrapSamples, + # standard = options[["standardized"]] != "none", typeStd = type) } # Save cfaResult as state so it's available even when opts don't change @@ -283,7 +282,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. jaspResults[["stateCFAResult"]]$dependOn(c( "factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", - "group", "invarianceTesting", "interceptsFixedToZero" + "group", "invarianceTesting", "interceptsFixedToZero", "standardized" )) @@ -669,16 +668,31 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "seType", "bootstrapSamples", "group", "invarianceTesting", "standardized", "ciLevel", "interceptsFixedToZero")) - footnote <- NULL if (options[["seType"]] == "bootstrap" && nrow(cfaResult[["lav"]]@boot[["coef"]]) < options[["bootstrapSamples"]]) { footnote <- gettextf("Not all bootstrap samples were successful: CI based on %.0f samples.", nrow(cfaResult[["lav"]]@boot[["coef"]])) } - pe <- lavaan::parameterEstimates(cfaResult[["lav"]], standardized = TRUE, remove.eq = FALSE, remove.system.eq = TRUE, - remove.ineq = FALSE, remove.def = FALSE, add.attributes = TRUE, boot.ci.type = "perc", - level = options$ciLevel) + #### TODO + # - Also check testing + + if (options[["standardized"]] == "none" || + (options[["standardized"]] != "none" && options[["seType"]] == "bootstrap")) { + pe <- lavaan::parameterEstimates(cfaResult[["lav"]], remove.eq = FALSE, remove.system.eq = TRUE, + remove.ineq = FALSE, remove.def = FALSE, add.attributes = TRUE, boot.ci.type = "perc", + level = options$ciLevel) + } else { + type <- switch(options[["standardized"]], + "latentVariables" = "std.lv", + "all" = "std.all", + "noExogenousCovariates" = "std.nox") + + pe <- lavaan::standardizedSolution(cfaResult[["lav"]], level = options[["ciLevel"]], type = type, + remove.eq = FALSE, remove.ineq = FALSE, remove.def = FALSE) + colnames(pe)[colnames(pe) == "est.std"] <- "est" + } + .cfaParEstToTablesHelper(pe, options, cfaResult, ests, footnote) } @@ -688,12 +702,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. facNames <- c(cfaResult[["spec"]]$latents) colSel <- c("lhs", "rhs", "est", "se", "z", "pvalue", "ci.lower", "ci.upper") - standardization <- switch(options$standardized, - "none" = "none", - "latentVariables" = "lv", - "all" = "all", - "noExogenousCovariates" = "nox") - if (options$standardized != "none") colSel <- c(colSel, paste0("std.", standardization)) + + estTitle <- ifelse(options$standardized != "none", gettext("Std. estimate"), gettext("Estimate")) # First-order factor loadings ---- # Set up table @@ -706,7 +716,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fl1$addColumnInfo(name = "lhs", title = gettext("Factor"), type = "string", combine = TRUE) fl1$addColumnInfo(name = "rhs", title = gettext("Indicator"), type = "string") - fl1$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + fl1$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") fl1$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") fl1$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") fl1$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -716,10 +726,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fl1$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - fl1$addColumnInfo(name = paste0("std.", standardization), title = gettextf("Std. Est. (%s)", standardization), - type = "number", format = "sf:4;dp:3") - # add data fl1dat <- pei[pei$op == "=~" & !pei$rhs %in% facNames, colSel] fl1dat$lhs <- .translateFactorNames(fl1dat$lhs, options) @@ -743,7 +749,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fl2$addColumnInfo(name = "lhs", title = gettext("Factor"), type = "string", combine = TRUE) fl2$addColumnInfo(name = "rhs", title = gettext("Indicator"), type = "string") - fl2$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + fl2$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") fl2$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") fl2$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") fl2$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -753,10 +759,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fl2$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - fl2$addColumnInfo(name = paste0("std.", options$standardized), title = gettextf("Std. Est. (%s)", options$standardized), - type = "number", format = "sf:4;dp:3") - # add data fl2dat <- pei[pei$op == "=~" & pei$rhs %in% facNames, colSel] @@ -779,7 +781,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fv$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) } fv$addColumnInfo(name = "lhs", title = gettext("Factor"), type = "string", combine = TRUE) - fv$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + fv$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") fv$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") fv$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") fv$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -789,10 +791,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fv$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - fv$addColumnInfo(name = paste0("std.", standardization), title = gettextf("Std. Est. (%s)", standardization), - type = "number", format = "sf:4;dp:3") - # Add data fvdat <- pei[pei$op == "~~" & pei$lhs %in% c(facNames, "SecondOrder") & pei$lhs == pei$rhs, colSel[!colSel %in% c('rhs')]] @@ -817,7 +815,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fc$addColumnInfo(name = "lhs", title = "", type = "string") fc$addColumnInfo(name = "op", title = "", type = "string") fc$addColumnInfo(name = "rhs", title = "", type = "string") - fc$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + fc$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") fc$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") fc$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") fc$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -827,12 +825,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fc$addColumnInfo(name = "ci.upper", title = "Upper", type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - fc$addColumnInfo(name = paste0("std.", standardization), - title = gettextf("Std. Est. (%s)", standardization), - type = "number", - format = "sf:4;dp:3") - fcdat <- pei[pei$op == "~~" & pei$lhs %in% facNames & pei$lhs != pei$rhs, colSel] fcdat$lhs <- .translateFactorNames(fcdat$lhs, options) fcdat$rhs <- .translateFactorNames(fcdat$rhs, options) @@ -853,7 +845,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. rv$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) } rv$addColumnInfo(name = "lhs", title = gettext("Indicator"), type = "string", combine = TRUE) - rv$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + rv$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") rv$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") rv$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") rv$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -863,12 +855,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. rv$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - rv$addColumnInfo(name = paste0("std.", standardization), - title = gettextf("Std. Est. (%s)", standardization), - type = "number", - format = "sf:4;dp:3") - # add data rvdat <- pei[pei$op == "~~" & !pei$lhs %in% facNames & !pei$lhs == "SecondOrder" & pei$lhs == pei$rhs, colSel[!colSel %in% c('rhs')]] @@ -891,7 +877,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. rc$addColumnInfo(name = "lhs", title = "", type = "string") rc$addColumnInfo(name = "op", title = "", type = "string") rc$addColumnInfo(name = "rhs", title = "", type = "string") - rc$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + rc$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") rc$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") rc$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") rc$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -901,11 +887,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. rc$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - rc$addColumnInfo(name = paste0("std.", standardization), - title = gettextf("Std. Est. (%s)", standardization), - type = "number", - format = "sf:4;dp:3") # add data rcdat <- pei[pei$op == "~~" & !pei$lhs %in% facNames & pei$lhs != pei$rhs, colSel] rcdat$op <- rep("\u2194", nrow(rcdat)) @@ -926,7 +907,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fi$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) fi$addColumnInfo(name = "lhs", title = gettext("Factor"), type = "string", combine = TRUE) - fi$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + fi$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") fi$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") fi$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") fi$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -936,9 +917,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. fi$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", 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") # add data fidat <- pei[pei$op == "~1" & pei$lhs %in% facNames, colSel[!colSel %in% 'rhs']] @@ -956,7 +934,7 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. vi$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) } vi$addColumnInfo(name = "lhs", title = gettext("Indicator"), type = "string", combine = TRUE) - vi$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number", format = "sf:4;dp:3") + vi$addColumnInfo(name = "est", title = estTitle, type = "number", format = "sf:4;dp:3") vi$addColumnInfo(name = "se", title = gettext("Std. Error"), type = "number", format = "sf:4;dp:3") vi$addColumnInfo(name = "z", title = gettext("z-value"), type = "number", format = "sf:4;dp:3") vi$addColumnInfo(name = "pvalue", title = gettext("p"), type = "number", format = "dp:3;p:.001") @@ -966,10 +944,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. vi$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - vi$addColumnInfo(name = paste0("std.", standardization), title = gettextf("Std. Est. (%s)", standardization), - type = "number", format = "sf:4;dp:3") - # add data vidat <- pei[pei$op == "~1" & !pei$lhs == "SecondOrder" & !pei$lhs %in% facNames, colSel[!colSel %in% c('rhs')]] @@ -984,12 +958,12 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. # Thresholds if ("|" %in% pei$op) { - .cfaThresholdsTable(jrobject, footnote, options, standardization, pei, colSel, cfaResult) + .cfaThresholdsTable(jrobject, footnote, options, pei, colSel, cfaResult) } } -.cfaThresholdsTable <- function(jrobject, footnote, options, standardization, pei, colSel, cfaResult) { +.cfaThresholdsTable <- function(jrobject, footnote, options, pei, colSel, cfaResult) { # Manifest variable intercepts jrobject[["Thresholds"]] <- th <- createJaspTable(title = gettext("Thresholds")) if (!is.null(footnote)) th$addFootnote(footnote) @@ -1009,10 +983,6 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. th$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (options$standardized != "none") - th$addColumnInfo(name = paste0("std.", standardization), title = gettextf("Std. Est. (%s)", standardization), - type = "number") - # add data thdat <- pei[pei$op == "|", colSel[!colSel %in% 'rhs']] thdat$lhs <- thdat$lhs @@ -1488,4 +1458,71 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. } +# delete once jaspSem is merged +lavBootstrap <- function(fit, samples = 1000, standard = FALSE, typeStd = NULL) { + # Run bootstrap, track progress with progress bar + # Notes: faulty runs are simply ignored + # recommended: add a warning if not all boot samples are successful + # fit <- lavBootstrap(fit, samples = 1000) + # if (nrow(fit@boot$coef) < 1000) + # tab$addFootnote(gettextf("Not all bootstrap samples were successful: CI based on %.0f samples.", nrow(fit@boot$coef)), + # "Note.") + + + coef_with_callback <- function(lav_object) { + # Progress bar is ticked every time coef() is evaluated, which happens once on the main object: + # https://github.com/yrosseel/lavaan/blob/77a568a574e4113245e2f6aff1d7c3120a26dd90/R/lav_bootstrap.R#L107 + # and then every time on a successful bootstrap: + # https://github.com/yrosseel/lavaan/blob/77a568a574e4113245e2f6aff1d7c3120a26dd90/R/lav_bootstrap.R#L375 + # i.e., samples + 1 times + progressbarTick() + + return(lavaan::coef(lav_object)) + } + coef_with_callback_std <- function(lav_object, typeStd) { + std <- lavaan::standardizedSolution(lav_object, type = typeStd) + out <- std$est.std + + progressbarTick() + + return(out) + } + + startProgressbar(samples + 1) + + if (!standard) { + bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coef_with_callback) + } else { + bootres <- lavaan::bootstrapLavaan(object = fit, R = samples, FUN = coef_with_callback_std, typeStd = typeStd) + } + + # Add the bootstrap samples to the fit object + fit@boot <- list(coef = bootres) + fit@Options$se <- "bootstrap" + + # exclude error bootstrap runs + err_id <- attr(fit@boot$coef, "error.idx") + if (length(err_id) > 0L) { + fit@boot$coef <- fit@boot$coef[-err_id, , drop = FALSE] + } + + # we actually need the SEs from the bootstrap not the SEs from ML or something + N <- nrow(fit@boot$coef) + + # we multiply the var by (n-1)/n because lavaan actually uses n for the variance instead of n-1 + if (!standard) { + # for unstandardized + fit@ParTable$se[fit@ParTable$free != 0] <- apply(fit@boot$coef, 2, sd) * sqrt((N-1)/N) + } else { + fit@ParTable$se <- apply(fit@boot$coef, 2, sd) * sqrt((N-1)/N) + # the standardized solution gives all estimates not only the unconstrained, so we need to change + # the free prameters in the partable and also change the estimate + fit@ParTable$free <- seq_len(ncol(fit@boot$coef)) + std <- lavaan::standardizedSolution(fit, type = typeStd) + fit@ParTable$est <- std$est.std + } + + + return(fit) +} diff --git a/inst/help/ConfirmatoryFactorAnalysis.md b/inst/help/ConfirmatoryFactorAnalysis.md index feb54941..618d1b28 100644 --- a/inst/help/ConfirmatoryFactorAnalysis.md +++ b/inst/help/ConfirmatoryFactorAnalysis.md @@ -60,7 +60,7 @@ JASP allows the factors in turn to be indicators of a second-order factor. This ### Advanced ------- - Emulation: Emulate results from different software -- Error calculation: Change how standard errors for the parameters are computed +- Error calculation: Change how standard errors for the parameters are computed, if bootstrap the CIs are percentile bootstrap type - Estimator: change the estimator for the CFA (Auto: ML if only scale variables used, WLS otherwise) - Standardization: display standardized parameters for different standardization schemes - Missing data handling: change the missing data handling method. diff --git a/inst/help/forQml/tooltipEstimators.md b/inst/help/forQml/tooltipEstimators.md new file mode 100644 index 00000000..f51903ed --- /dev/null +++ b/inst/help/forQml/tooltipEstimators.md @@ -0,0 +1,21 @@ + +### Help on Estimators +Some of the estimators come with options that are set in the background: + +- Estimators without extra effects (standard errors and model test are standard): + - ML, GLS, WLS, ULS, DWLS, DLS + +- Extensions of ML-estimators with extra effects: + - MLM: classic robust se (se="robust.sem"), Satorra-Bentler test statistic (test="satorra.bentler") + - MLMV: classic robust se, scaled and shifted test statistic (test="scaled.shifted") + - MLMVS: classic robust se, mean and var adjusted Satterthwaite style test statistic (test="mean.var.adjusted") + - MLF: first-order standard se (information="first.order"), standard test + - MLR: Huber-White robust se (se="robust.huber.white"), Yuan-Bentler T2-star test statistic (test="yuan.bentler.mplus") + +- Others: + - WLSM: implies DWLS with scaled test and robust se + - WLSMV: implies DWLS with mean and var adjusted test and robust se + - ULSM: implies ULS with scaled test and robust se + - ULSMV: implies ULS with mean-var adjusted test and robust se + +- Note: If you specify "Standard errors" instead of leaving it at default the corresponding options set by the estimators in the background will be overwritten \ No newline at end of file diff --git a/inst/qml/ConfirmatoryFactorAnalysis.qml b/inst/qml/ConfirmatoryFactorAnalysis.qml index f6287843..2757c35f 100644 --- a/inst/qml/ConfirmatoryFactorAnalysis.qml +++ b/inst/qml/ConfirmatoryFactorAnalysis.qml @@ -102,8 +102,8 @@ Form label: qsTr("Model identification") name: "modelIdentification" values: [ - { label: qsTr("Factor variances"), value: "factorVariance" }, { label: qsTr("Marker variable"), value: "markerVariable" }, + { label: qsTr("Factor variances"), value: "factorVariance" }, { label: qsTr("Effects coding"), value: "effectsCoding" } ] } @@ -206,64 +206,88 @@ Form Section { title: qsTr("Advanced") - RadioButtonGroup - { - title: qsTr("Mimic package") - name: "packageMimiced" - RadioButton { label: qsTr("Lavaan"); value: "lavaan" ; checked: true } - RadioButton { label: qsTr("Mplus") ; value: "Mplus" } - RadioButton { label: qsTr("EQS") ; value: "EQS" } - } - Group - { - title: qsTr("Error calculation") - CIField { text: qsTr("CI level"); name: "ciLevel" } - RadioButtonGroup + Group { + DropDown { - title: qsTr("Standard error") - name: "seType" - RadioButton { label: qsTr("Standard"); value: "standard"; checked: true} - RadioButton { label: qsTr("Robust"); value: "robust" } - RadioButton { - label: qsTr("Bootstrap") - value: "bootstrap" - IntegerField { - label: qsTr("Bootstrap samples") - name: "bootstrapSamples" - defaultValue: 1000 - min: 100 - max: 1000000 - } + name: "packageMimiced" + label: qsTr("Mimic") + values: [ + { label: qsTr("Lavaan"), value: "lavaan" }, + { label: qsTr("Mplus"), value: "mplus" }, + { label: qsTr("EQS"), value: "eqs" } + ] + } + RowLayout + { + DropDown + { + name: "estimator" + label: qsTr("Estimator") + id: estimator + values: [ + { label: qsTr("Default"), value: "default" }, + { label: qsTr("ML"), value: "ml" }, + { label: qsTr("GLS"), value: "gls" }, + { label: qsTr("WLS"), value: "wls" }, + { label: qsTr("ULS"), value: "uls" }, + { label: qsTr("DWLS"), value: "dwls" }, + { label: qsTr("DLS"), value: "dls" }, + { label: qsTr("PML"), value: "pml" }, + { label: qsTr("MLM"), value: "mlm" }, + { label: qsTr("MLMV"), value: "mlmv" }, + { label: qsTr("MLMVS"), value: "mlmvs" }, + { label: qsTr("MLF"), value: "mlf" }, + { label: qsTr("MLR"), value: "mlr" }, + { label: qsTr("WLSM"), value: "wlsm" }, + { label: qsTr("WLSMV"), value: "wlsmv" }, + { label: qsTr("ULSM"), value: "ulsm" }, + { label: qsTr("ULSMV"), value: "ulsmv" } + ] + } + HelpButton + { + toolTip: qsTr("Click for more information") + helpPage: "forQml/tooltipEstimators" } } - } - - RadioButtonGroup - { - title: qsTr("Estimator") - name: "estimator" - RadioButton { label: qsTr("Auto") ; value: "default"; checked: true } - RadioButton { label: qsTr("ML") ; value: "maximumLikelihood" } - RadioButton { label: qsTr("GLS") ; value: "generalizedLeastSquares" } - RadioButton { label: qsTr("WLS") ; value: "weightedLeastSquares" } - RadioButton { label: qsTr("ULS") ; value: "unweightedLeastSquares" } - RadioButton { label: qsTr("DWLS") ; value: "diagonallyWeightedLeastSquares" } - } - - DropDown + DropDown + { + label: qsTr("Standard errors") + name: "seType" + id: errorCalc + values: [ + { label: qsTr("Default"), value: "default" }, + { label: qsTr("Standard"), value: "standard" }, + { label: qsTr("Robust"), value: "robust" }, + { label: qsTr("Bootstrap"), value: "bootstrap" } + ] + } + IntegerField + { + visible: errorCalc.value == "bootstrap" + name: "bootstrapSamples" + label: qsTr(" Bootstrap samples") + defaultValue: 1000 + min: 100 + max: 1000000 + } + CIField { text: qsTr(" CI level"); name: "ciLevel" } + + DropDown { name: "naAction" label: qsTr("Missing data handling") values: [ - { label: qsTr("FIML") , value: "fiml" }, { label: qsTr("Listwise deletion") , value: "listwise" }, + { label: qsTr("FIML") , value: "fiml" }, { label: qsTr("Pairwise") , value: "pairwise" }, { label: qsTr("Two-stage") , value: "twoStage" }, { label: qsTr("Robust two-stage") , value: "twoStageRobust" }, ] } + } RadioButtonGroup { diff --git a/tests/testthat/test-confirmatoryfactoranalysis.R b/tests/testthat/test-confirmatoryfactoranalysis.R index b95da7d1..88406a8b 100644 --- a/tests/testthat/test-confirmatoryfactoranalysis.R +++ b/tests/testthat/test-confirmatoryfactoranalysis.R @@ -201,48 +201,44 @@ test_that("[CFA Second order] Chi-square test table results match", { }) -test_that("Bootstrapping works", { - options <- jaspTools::analysisOptions("confirmatoryFactorAnalysis") - options$group <- "" - options$invarianceTesting <- "configural" - options$packageMimiced <- "lavaan" - options$seType <- "bootstrap" - options$bootstrapSamples <- 100 - options$estimator <- "default" - options$standardized <- "none" - options$factors <- list( - list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1", types = rep("scale", 3)), - list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2", types = rep("scale", 3)), - list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3", types = rep("scale", 3)) - ) - options$modelIdentification <- "factorVariance" - options$naAction <- "listwise" - set.seed(1) - results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswineford.csv", options) +# factor loadings with bootstrapping are correct +options <- jaspTools::analysisOptions("confirmatoryFactorAnalysis") +options$group <- "" +options$invarianceTesting <- "configural" +options$packageMimiced <- "lavaan" +options$seType <- "bootstrap" +options$bootstrapSamples <- 100 +options$estimator <- "default" +options$standardized <- "none" +options$factors <- list( + list(indicators = list("x1", "x2", "x3"), name = "Factor1", title = "Factor 1", types = rep("scale", 3)), + list(indicators = list("x4", "x5", "x6"), name = "Factor2", title = "Factor 2", types = rep("scale", 3)), + list(indicators = list("x7", "x8", "x9"), name = "Factor3", title = "Factor 3", types = rep("scale", 3)) +) +options$modelIdentification <- "factorVariance" +options$naAction <- "listwise" +set.seed(1) +results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswineford.csv", options) +test_that("Factor loadings table results match", { table <- results[["results"]][["estimates"]][["collection"]][["estimates_fl1"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.712022271311838, 1.11279383173753, 0.899620313867488, - "Factor 1", 0, "x1", 0.0808465333987386, 11.1275063512065, 0.339182433474584, - 0.693156723678194, 0.49794051110941, "Factor 1", - 1.28623778294923e-10, "x2", 0.0774547818506273, 6.42878979466621, - 0.539990088382033, 0.805660643384033, 0.656156092628451, - "Factor 1", 0, "x3", 0.0744212256974568, 8.81678696472846, 0.856032790026098, - 1.08543684864592, 0.989693449094392, "Factor 2", - 0, "x4", 0.0566367179185465, 17.4744138690689, 0.954112872546464, - 1.24054019999221, 1.10160465003145, "Factor 2", - 0, "x5", 0.0626757561168699, 17.5762482701815, 0.803928010900409, - 1.03630968014001, 0.916600977759373, "Factor 2", - 0, "x6", 0.0536584940344529, 17.0821226769958, 0.375767927218761, - 0.741040160352204, 0.619475433557926, "Factor 3", - 0, "x7", 0.0695825769015842, 8.90273774186456, 0.506218568773711, - 0.900974372672674, 0.730948802915075, "Factor 3", - 0, "x8", 0.0659093164600047, 11.0902197469857, 0.498364732719689, - 0.860170344673322, 0.669980108781259, "Factor 3", - 0, "x9", 0.0650169734598685, 10.3046954222623)) - - - + list(0.712022271311838, 1.11279383173753, 0.899620313867488, "Factor 1", + 0, "x1", 0.101880932132255, 8.8301146744482, 0.339182433474583, + 0.693156723678194, 0.49794051110941, "Factor 1", 5.03185138001072e-09, + "x2", 0.0851745954124038, 5.84611536689373, 0.539990088382032, + 0.805660643384033, 0.656156092628451, "Factor 1", 0, "x3", 0.0702283472359389, + 9.34318004699771, 0.856032790026097, 1.08543684864592, 0.989693449094393, + "Factor 2", 0, "x4", 0.060824826209009, 16.2712088266979, 0.954112872546464, + 1.24054019999221, 1.10160465003145, "Factor 2", 0, "x5", 0.0610564023902934, + 18.042410081577, 0.803928010900409, 1.03630968014001, 0.916600977759372, + "Factor 2", 0, "x6", 0.0544830064226891, 16.8236123140528, 0.37576792721876, + 0.741040160352204, 0.619475433557926, "Factor 3", 7.69848629289527e-11, + "x7", 0.0952105063825611, 6.50637683901018, 0.50621856877371, + 0.900974372672673, 0.730948802915075, "Factor 3", 2.32125429988628e-12, + "x8", 0.104217630469302, 7.0136770489172, 0.498364732719688, + 0.860170344673323, 0.669980108781259, "Factor 3", 5.52868861802835e-12, + "x9", 0.0972211926575642, 6.8912969535468)) })