Fix for non-converged lavaan

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.15.0.1
+Version: 0.15.0.2
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -168,4 +168,4 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/insight
+Remotes: easystats/insight#1104

NEWS.md

@@ -4,6 +4,8 @@
 
 * `display()` now supports the `tinytable` format, when `format = "tt"`.
 
+* Better handling of non-converged lavaan-models in `model_performance()`.
+
 # performance 0.15.0
 
 ## New functions

R/model_performance.lavaan.R

@@ -102,47 +102,70 @@
 model_performance.lavaan <- function(model, metrics = "all", verbose = TRUE, ...) {
   insight::check_if_installed("lavaan")
 
+  # All possible metrics that this function can return.
+  all_metric_names <- c(
+    "Chi2", "Chi2_df", "p_Chi2", "Baseline", "Baseline_df", "p_Baseline", "GFI",
+    "AGFI", "NFI", "NNFI", "CFI", "RMSEA", "RMSEA_CI_low", "RMSEA_CI_high",
+    "p_RMSEA", "RMR", "SRMR", "RFI", "PNFI", "IFI", "RNI", "Loglikelihood",
+    "AIC", "BIC", "BIC_adjusted"
+  )
 
-  if (isTRUE(verbose)) {
-    measures <- as.data.frame(t(as.data.frame(lavaan::fitmeasures(model, ...))))
+  # extract valid column names based on metrics
+  if (is.character(metrics) && !all(metrics == "all")) {
+    out_names <- intersect(metrics, all_metric_names)
   } else {
-    measures <- as.data.frame(t(as.data.frame(suppressWarnings(lavaan::fitmeasures(model, ...)))))
+    out_names <- all_metric_names
   }
 
-  row.names(measures) <- NULL
+  # Check if converged
+  if (insight::is_converged(model)) {
+    if (isTRUE(verbose)) {
+      measures <- as.data.frame(t(as.data.frame(lavaan::fitmeasures(model, ...))))
+    } else {
+      measures <- as.data.frame(t(as.data.frame(suppressWarnings(lavaan::fitmeasures(model, ...)))))
+    }
 
-  out <- data.frame(
-    Chi2 = measures$chisq,
-    Chi2_df = measures$df,
-    p_Chi2 = measures$pvalue,
-    Baseline = measures$baseline.chisq,
-    Baseline_df = measures$baseline.df,
-    p_Baseline = measures$baseline.pvalue,
-    GFI = measures$gfi,
-    AGFI = measures$agfi,
-    NFI = measures$nfi,
-    NNFI = measures$tli,
-    CFI = measures$cfi,
-    RMSEA = measures$rmsea,
-    RMSEA_CI_low = measures$rmsea.ci.lower,
-    RMSEA_CI_high = measures$rmsea.ci.upper,
-    p_RMSEA = measures$rmsea.pvalue,
-    RMR = measures$rmr,
-    SRMR = measures$srmr,
-    RFI = measures$rfi,
-    PNFI = measures$pnfi,
-    IFI = measures$ifi,
-    RNI = measures$rni,
-    Loglikelihood = measures$logl,
-    AIC = measures$aic,
-    BIC = measures$bic,
-    BIC_adjusted = measures$bic2
-  )
+    row.names(measures) <- NULL
 
-  if (all(metrics == "all")) {
-    metrics <- names(out)
+    out <- data.frame(
+      Chi2 = measures$chisq,
+      Chi2_df = measures$df,
+      p_Chi2 = measures$pvalue,
+      Baseline = measures$baseline.chisq,
+      Baseline_df = measures$baseline.df,
+      p_Baseline = measures$baseline.pvalue,
+      GFI = measures$gfi,
+      AGFI = measures$agfi,
+      NFI = measures$nfi,
+      NNFI = measures$tli,
+      CFI = measures$cfi,
+      RMSEA = measures$rmsea,
+      RMSEA_CI_low = measures$rmsea.ci.lower,
+      RMSEA_CI_high = measures$rmsea.ci.upper,
+      p_RMSEA = measures$rmsea.pvalue,
+      RMR = measures$rmr,
+      SRMR = measures$srmr,
+      RFI = measures$rfi,
+      PNFI = measures$pnfi,
+      IFI = measures$ifi,
+      RNI = measures$rni,
+      Loglikelihood = measures$logl,
+      AIC = measures$aic,
+      BIC = measures$bic,
+      BIC_adjusted = measures$bic2
+    )
+  } else {
+    if (verbose) {
+      insight::format_warning("This lavaan model did not converge, no performance indices can be computed. Returning `NA`.")
+    }
+    out <- as.data.frame(stats::setNames(
+      rep(list(NA), length(out_names)),
+      out_names
+    ))
   }
-  out <- out[, metrics]
+
+  # select only the requested metrics
+  out <- out[out_names]
 
   class(out) <- c("performance_lavaan", "performance_model", class(out))
   out
@@ -153,7 +176,6 @@
 model_performance.blavaan <- function(model, metrics = "all", verbose = TRUE, ...) {
   insight::check_if_installed(c("lavaan", "blavaan"))
 
-
   if (isTRUE(verbose)) {
     measures <- as.data.frame(t(as.data.frame(lavaan::fitmeasures(model, ...))))
     fitind <- summary(blavaan::blavFitIndices(model))
@@ -186,7 +208,7 @@
   if (all(metrics == "all")) {
     metrics <- names(out)
   }
-  out <- out[, metrics]
+  out <- out[, metrics, drop = FALSE]
 
   class(out) <- c("performance_lavaan", "performance_model", class(out))
   out

tests/testthat/test-model_performance.lavaan.R

@@ -0,0 +1,33 @@
+skip_on_cran()
+skip_if_not_installed("lavaan")
+
+test_that("model_performance.lavaan", {
+  data(HolzingerSwineford1939, package = "lavaan")
+  structure <- " visual  =~ x1 + x2 + x3
+                textual =~ x4 + x5 + x6
+                speed   =~ x7 + x8 + x9 "
+  model <- lavaan::cfa(structure, data = HolzingerSwineford1939)
+  out <- expect_silent(model_performance(model))
+  expect_named(
+    out,
+    c(
+      "Chi2", "Chi2_df", "p_Chi2", "Baseline", "Baseline_df", "p_Baseline",
+      "GFI", "AGFI", "NFI", "NNFI", "CFI", "RMSEA", "RMSEA_CI_low",
+      "RMSEA_CI_high", "p_RMSEA", "RMR", "SRMR", "RFI", "PNFI", "IFI",
+      "RNI", "Loglikelihood", "AIC", "BIC", "BIC_adjusted"
+    )
+  )
+
+  out <- model_performance(model, metrics = c("Chi2", "RMSEA"))
+  expect_named(out, c("Chi2", "RMSEA"))
+
+  model <- suppressWarnings(lavaan::cfa(structure, data = HolzingerSwineford1939[1:10, ]))
+  expect_warning(
+    {
+      out <- model_performance(model)
+    },
+    regex = "This lavaan model did not converge"
+  )
+  expect_identical(out$Chi2, NA)
+  expect_silent(model_performance(model, verbose = FALSE))
+})