diff --git a/NEWS.md b/NEWS.md index 2c2d1b0d..f1cfa4d5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -22,6 +22,7 @@ * EFA: polychoric/tetrachoric correlation matrix errors are now caught and shown as a user-friendly message, including which variables have missing response categories. * EFA, PCA: ordinal variables with value labels (e.g., from SPSS) were incorrectly treated as having missing values when computing polychoric correlations; fixed by improving factor/ordered-to-numeric coercion ([jasp-issues#4129](https://github.com/jasp-stats/jasp-issues/issues/4129), [jasp-issues#4224](https://github.com/jasp-stats/jasp-issues/issues/4224)) ([PR #336](https://github.com/jasp-stats/jaspFactor/pull/336)). * CFA: Chi-square table footnote now always reports the estimator, test statistic, and standard error method, making it clear which defaults lavaan applied (e.g., Browne.residual.nt when DWLS is used on continuous data) ([jasp-issues#4157](https://github.com/jasp-stats/jasp-issues/issues/4157), [jasp-issues#4171](https://github.com/jasp-stats/jasp-issues/issues/4171)) ([PR #336](https://github.com/jasp-stats/jaspFactor/pull/336)). +* CFA: the heterotrait-monotrait ratio treated ordinal indicators as continuous, so it was based on Pearson instead of polychoric correlations ([jasp-issues#4434](https://github.com/jasp-stats/jasp-issues/issues/4434)). --- diff --git a/R/confirmatoryfactoranalysis.R b/R/confirmatoryfactoranalysis.R index 9a497fbb..d5745f6f 100644 --- a/R/confirmatoryfactoranalysis.R +++ b/R/confirmatoryfactoranalysis.R @@ -1484,10 +1484,13 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. } .cfaTableHtmt <- function(jaspResults, options, cfaResult, dataset) { - #### this has an ordering argument that still needs to be implemented once the categorical data stuff is done if (is.null(cfaResult) || !options[["htmt"]] || !is.null(jaspResults[["resHtmtTable"]])) return() + # the data extracted from the fitted object is numeric, so the ordered variables have to be named + # explicitly, otherwise htmt() falls back to Pearson instead of polychoric correlations + orderedVars <- lavaan::lavNames(cfaResult[["lav"]], "ov.ord") + htmtTable <- createJaspTable(gettext("Heterotrait-monotrait ratio"), position = 4.2) htmtTable$dependOn(c("factors", "secondOrder", "residualsCovarying", "meanStructure", "modelIdentification", "factorsUncorrelated", "packageMimiced", "estimator", "naAction", "group", "invarianceTesting", "htmt", "interceptsFixedToZero")) @@ -1513,7 +1516,8 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. dataGroup <- as.data.frame(dataList[[gg]]) colnames(dataGroup) <- cfaResult[["lav"]]@Data@ov.names[[ind]] htmt_result <- semTools::htmt(model = cfaResult[["model_simple"]], data = dataGroup, - missing = cfaResult[["lav"]]@Options[["missing"]]) + missing = cfaResult[["lav"]]@Options[["missing"]], + ordered = orderedVars) htmt_result[upper.tri(htmt_result)] <- NA tmp_dat[tmp_dat$group == gg, facNames] <- htmt_result } @@ -1533,10 +1537,12 @@ confirmatoryFactorAnalysisInternal <- function(jaspResults, dataset, options, .. if (is.null(cfaResult[["spec"]][["soIndics"]])) { htmt_result <- semTools::htmt(model = cfaResult[["model"]], data = dataset, sample.cov = sampCov, - missing = cfaResult[["lav"]]@Options[["missing"]]) + missing = cfaResult[["lav"]]@Options[["missing"]], + ordered = orderedVars) } else { # the htmt does not allow a second order factor, so we take the model syntax without the seco htmt_result <- semTools::htmt(model = cfaResult[["model_simple"]], data = dataset, sample.cov = sampCov, - missing = cfaResult[["lav"]]@Options[["missing"]]) + missing = cfaResult[["lav"]]@Options[["missing"]], + ordered = orderedVars) } htmt_result[upper.tri(htmt_result)] <- NA diff --git a/tests/testthat/test-confirmatoryfactoranalysis.R b/tests/testthat/test-confirmatoryfactoranalysis.R index fc8fbbf8..e8679c41 100644 --- a/tests/testthat/test-confirmatoryfactoranalysis.R +++ b/tests/testthat/test-confirmatoryfactoranalysis.R @@ -427,6 +427,7 @@ options$naAction <- "pairwise" options$thresholds <- TRUE options$group <- "gender" options$fitMeasures <- TRUE +options$htmt <- TRUE dt <- read.csv("cavalini_group.csv") dt[, c("V1", "V5", "V8")] <- lapply(dt[, c("V1", "V5", "V8")], ordered) @@ -501,6 +502,14 @@ test_that("Chi-square test table results match", { 38, "Factor model", 0)) }) +# htmt must use polychoric correlations for the ordinal indicators, see jasp-issues #4434 +test_that("Heterotrait-monotrait ratio table results match for ordinal data", { + table <- results[["results"]][["resHtmtTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, "", "Factor 1", "f", 0.934652527995396, 1, "Factor 2", "f", + 1, "", "Factor 1", "m", 0.977492107173945, 1, "Factor 2", "m")) +}) + # scalar invariance with ordinal data: thresholds must be constrained (equal) across groups options <- jaspTools::analysisOptions("confirmatoryFactorAnalysis")