diff --git a/DESCRIPTION b/DESCRIPTION index cb0d13f..6184d3a 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 247ebe6..8161c2c 100644 --- a/R/confirmatoryfactoranalysis.R +++ b/R/confirmatoryfactoranalysis.R @@ -14,15 +14,12 @@ # along with this program. If not, see . # -# This is a temporary fix -# TODO: remove it when R will solve this problem! -gettextf <- function(fmt, ..., domain = NULL) { - return(sprintf(gettext(fmt, domain = domain), ...)) -} + 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) @@ -193,16 +190,15 @@ 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 <- switch( + options$naAction, + "twoStageRobust" = "robust.two.stage", + "twoStage" = "two.stage", + options$naAction) + } else { + naAction <- "listwise" + } cfaResult[["lav"]] <- try(lavaan::lavaan( model = mod, @@ -225,9 +221,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. auto.delta = TRUE, auto.cov.y = TRUE, mimic = options$packageMimiced, - estimator = estimator, - missing = ifelse(options$naAction == "twoStageRobust", "robust.two.stage", - ifelse(options$naAction == "twoStage", "two.stage", options$naAction)) + estimator = options[["estimator"]], + missing = naAction )) # are there ordered variables in the data? @@ -274,7 +269,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 @@ -282,7 +285,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" )) @@ -447,28 +450,38 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. # get the model fit fitMeasures <- lavaan::fitmeasures(cfaResult[["lav"]]) - if (cfaResult[["orderedVariables"]] && options[["estimator"]] == "default") { + footnote <- "" + if (cfaResult[["orderedVariables"]]) { # when the estimator is not default lavaan does not use the robust test maintab[["mod"]] <- c(gettext("Baseline model"), gettext("Factor model")) maintab[["chisq"]] <- fitMeasures[c("baseline.chisq.scaled", "chisq.scaled")] maintab[["df"]] <- fitMeasures[c("baseline.df.scaled", "df.scaled")] maintab[["pvalue"]] <- c(NA, fitMeasures["pvalue.scaled"]) - footnote <- gettextf("The estimator is %1$s and the test statistic is %2$s because there are categorical variables in the data.", - fitOptions$estimator, fitOptions$test) + if (options[["seType"]] == "standard") { - footnote <- paste(footnote, gettext("You may consider changing the standard error method to 'robust'.")) + footnote <- gettextf("%s You may consider changing the standard error method to 'robust'.", footnote) } - maintab$addFootnote(footnote) + } else { maintab[["mod"]] <- c(gettext("Baseline model"), gettext("Factor model")) maintab[["chisq"]] <- fitMeasures[c("baseline.chisq", "chisq")] maintab[["df"]] <- fitMeasures[c("baseline.df", "df")] maintab[["pvalue"]] <- c(NA, fitMeasures["pvalue"]) - if (options[["estimator"]] == "default") { - maintab$addFootnote(gettextf("The estimator is %s.", fitOptions$estimator)) - } } + + if (options[["estimator"]] == "default") { + footnote <- gettextf("%1$s The estimator is %2$s. The test statistic is %3$s.", + footnote, fitOptions$estimator, fitOptions$test) + } + + if (options[["seType"]] == "default") { + footnote <- gettextf("%1$s The standard error method is %2$s.", footnote, fitOptions$se) + } + + maintab$addFootnote(footnote) + } + return() } .cfaTableKMO <- function(jaspResults, options, cfaResult) { @@ -668,16 +681,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) } @@ -687,12 +715,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 @@ -705,7 +729,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") @@ -715,10 +739,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) @@ -742,7 +762,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") @@ -752,10 +772,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] @@ -778,7 +794,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") @@ -788,10 +804,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')]] @@ -816,7 +828,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") @@ -826,12 +838,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) @@ -852,7 +858,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") @@ -862,12 +868,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')]] @@ -890,7 +890,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") @@ -900,11 +900,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)) @@ -925,7 +920,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") @@ -935,9 +930,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']] @@ -955,7 +947,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") @@ -965,10 +957,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')]] @@ -983,12 +971,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) @@ -1008,10 +996,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 @@ -1487,4 +1471,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 feb5494..618d1b2 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 0000000..f51903e --- /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 f628784..2757c35 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/po/R-ja.po b/po/R-ja.po index 7e644a5..bae356e 100644 --- a/po/R-ja.po +++ b/po/R-ja.po @@ -1,17 +1,29 @@ msgid "" msgstr "" "Project-Id-Version: jaspFactor 0.13.0\n" +<<<<<<< HEAD "POT-Creation-Date: 2024-07-13 03:29\n" "PO-Revision-Date: 2024-07-02 15:09+0000\n" "Last-Translator: Daiki Hojo \n" "Language-Team: Japanese \n" +======= +"POT-Creation-Date: 2023-05-08 16:33\n" +"PO-Revision-Date: 2024-06-24 10:09+0000\n" +"Last-Translator: 上野真翔 \n" +"Language-Team: Japanese \n" +>>>>>>> 1eb6579 (Translated using Weblate (Japanese) (#229)) "Language: ja\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=1; plural=0;\n" +<<<<<<< HEAD "X-Generator: Weblate 5.7-dev\n" +======= +"X-Generator: Weblate 5.6-rc\n" +>>>>>>> 1eb6579 (Translated using Weblate (Japanese) (#229)) msgid "Second-Order" msgstr "二次" @@ -334,7 +346,7 @@ msgid "Average variance extracted" msgstr "平均分散抽出" msgid "AVE" -msgstr "AVE" +msgstr "" msgid "Heterotrait-monotrait ratio" msgstr "Heterotrait-monotrait 比" diff --git a/tests/testthat/test-confirmatoryfactoranalysis.R b/tests/testthat/test-confirmatoryfactoranalysis.R index d3ce90e..88406a8 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)) }) @@ -584,35 +580,35 @@ results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswinef 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)) + list(0.264127499425447, 0.552335580285554, 0.4082315398555, 1, "Factor 1", + "", 2.81820449199444e-08, "Factor 2", 0.0735238206246278, + 5.55237114158833, 0.15192499892102, 0.372524536760297, 0.262224767840658, + 1, "Factor 1", "", 3.16848206827203e-06, "Factor 3", + 0.0562764263984793, 4.65958456537219, 0.07683979972175, 0.270149836341137, + 0.173494818031443, 1, "Factor 2", "", 0.000434621849370931, + "Factor 3", 0.0493146910209044, 3.51811629434927, 0.264127499425447, + 0.552335580285554, 0.4082315398555, 2, "Factor 1", "", + 2.81820449199444e-08, "Factor 2", 0.0735238206246278, 5.55237114158833, + 0.15192499892102, 0.372524536760297, 0.262224767840658, 2, "Factor 1", + "", 3.16848206827203e-06, "Factor 3", 0.0562764263984793, + 4.65958456537219, 0.0768397997217501, 0.270149836341137, 0.173494818031443, + 2, "Factor 2", "", 0.000434621849370931, "Factor 3", + 0.0493146910209044, 3.51811629434927)) }) 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 + list(0.524213173797399, 1.09441490168121, 0.809314037739305, 1, "Factor 1", + 2.64057073984247e-08, 0.145462297364005, 5.56373749353123, 0.759767572610602, + 1.19921426302452, 0.97949091781756, 1, "Factor 2", 0, 0.112105807525091, + 8.73720050228737, 0.214781179470692, 0.552715570797657, 0.383748375134174, + 1, "Factor 3", 8.53300875691687e-06, 0.0862093370063297, 4.45135513692674, + 0.524213173797399, 1.09441490168121, 0.809314037739305, 2, "Factor 1", + 2.64057073984247e-08, 0.145462297364005, 5.56373749353123, 0.759767572610602, + 1.19921426302452, 0.97949091781756, 2, "Factor 2", 0, 0.112105807525091, + 8.73720050228737, 0.214781179470692, 0.552715570797656, 0.383748375134174, + 2, "Factor 3", 8.53300875691687e-06, 0.0862093370063297, 4.45135513692674 )) }) @@ -649,18 +645,19 @@ test_that("Intercepts table results match", { 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 + list(4.86029752114904, 5.21482119001743, 5.03755935558323, 1, "Factor 1", + 0, 0.0904413733274764, 55.6997220436148, 2.75677120171169, 3.10373279405854, + 2.93025199788512, 1, "Factor 2", 0, 0.0885122367256859, 33.1056146165016, + 3.90407881578928, 4.2206242216325, 4.06235151871089, 1, "Factor 3", + 0, 0.0807528628944437, 50.3059752076035, 4.68063900389833, 5.03894993881863, + 4.85979447135848, 2, "Factor 1", 0, 0.0914075303797947, 53.1662375207625, + 3.03056822444163, 3.39107629675968, 3.21082226060066, 2, "Factor 2", + 0, 0.0919680349133189, 34.9123721478544, 4.13410767934369, 4.48973776888174, + 4.31192272411271, 2, "Factor 3", 0, 0.0907236286848159, 47.5281113269049 )) }) + options$interceptsFixedToZero <- "meanManifest" set.seed(1) results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswineford.csv", options) @@ -668,51 +665,52 @@ results <- jaspTools::runAnalysis("confirmatoryFactorAnalysis", "holzingerswinef 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)) + list(4.17946249998224, 7.33554341971368, 5.75750295984796, 1, "Factor 1", + 8.61755111714047e-13, 0.805137478195059, 7.15095634692725, 2.67401208793776, + 3.38257423864503, 3.02829316329139, 1, "Factor 2", 0, 0.180758972179162, + 16.7532107910519, 3.61178718674901, 5.85505485314677, 4.73342101994789, + 1, "Factor 3", 2.22044604925031e-16, 0.572272675440052, 8.27126861562646, + 5.00292685139523, 6.98910505353057, 5.9960159524629, 2, "Factor 1", + 0, 0.506687423289933, 11.833757217676, 2.93332374830556, 3.59818720167768, + 3.26575547499162, 2, "Factor 2", 0, 0.169611140463926, 19.2543689409729, + 2.91399967225576, 5.16301951397701, 4.03850959311639, 2, "Factor 3", + 1.9373391779709e-12, 0.573740094068369, 7.03891820506995)) }) 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)) + list(-2.29778247855469, 0.848986087595441, -0.724398195479626, 1, "x1", + 0.366853737408441, 0.802761834138649, -0.902382456008132, 1.85617988285797, + 4.72531692159857, 3.29074840222827, 1, "x2", 6.92600081286798e-06, + 0.731936163463202, 4.49595001107458, -4.02924675462711, -1.10345365887017, + -2.56635020674864, 1, "x3", 0.000585265324847928, 0.746389504816217, + -3.4383524824355, -0.436594394646065, 0.215624035960278, -0.110485179342894, + 1, "x4", 0.506669795232088, 0.166385310074817, -0.66403205483232, + 0.411738355496194, 1.09690396231017, 0.754321158903182, 1, "x5", + 1.59186892401131e-05, 0.174790356409219, 4.31557652492663, -0.963464116512774, + -0.324207842607803, -0.643835979560288, 1, "x6", 7.88032553507012e-05, + 0.163078576684914, -3.94801078503555, -1.79670881046573, 0.441838146039328, + -0.6774353322132, 1, "x7", 0.235519815460555, 0.571068390583304, + -1.18625955031629, -2.82560377715776, -0.0446667901569227, -1.43513528365734, + 1, "x8", 0.0430808812206047, 0.709435736813664, -2.02292499402844, + 1.1473885322431, 3.07775269949798, 2.11257061587054, 1, "x9", + 1.78730489270862e-05, 0.492448887449298, 4.28992870064723, -2.13315005814143, + -0.170708937633256, -1.15192949788734, 2, "x1", 0.0213944067107943, + 0.500631934052784, -2.30095089732308, 1.7331229546958, 3.49858914314841, + 2.6158560489221, 2, "x2", 6.31936569739366e-09, 0.450382303547, + 5.8080791103932, -2.32301431624246, -0.604838785827062, -1.46392655103476, + 2, "x3", 0.000838169615160922, 0.438318138488296, -3.33987216701472, + -0.364138025561973, 0.224025771510095, -0.070056127025939, 2, + "x4", 0.640569850098464, 0.150044542071035, -0.466902201566069, + 0.591160705852981, 1.21629568733627, 0.903728196594626, 2, "x5", + 1.45442131671558e-08, 0.15947613997356, 5.66685522200663, -1.12225205224369, + -0.545092086893686, -0.833672069568687, 2, "x6", 1.49536132365569e-08, + 0.147237390559869, -5.66209484152535, -0.856856508594173, 1.3963872624749, + 0.269765376940363, 2, "x7", 0.638850919242091, 0.574817646865548, + 0.469306011065214, 0.17776569210359, 2.10083727362224, 1.13930148286292, + 2, "x8", 0.0202159309776238, 0.490588499760096, 2.32231591939079, + -2.58679331205368, -0.231340407552876, -1.40906685980328, 2, + "x9", 0.0190291696997005, 0.600891884514286, -2.34495904524032 + )) })