Merge pull request #109 from sfcheung/devel

0.1.6.1: Revise the tests for nonconvergence
sfcheung · Jan 3, 2024 · bf1e481 · bf1e481
2 parents f09cd68 + e6d5dc7
commit bf1e481
Show file tree

Hide file tree

Showing 5 changed files with 84 additions and 32 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: semfindr
 Title: Influential Cases in Structural Equation Modeling
-Version: 0.1.6
+Version: 0.1.6.1
 Authors@R: c(
     person(given = "Shu Fai",
            family = "Cheung",

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# semfindr 0.1.6.1
+
+- Updated the two tests for nonconvergence.
+  Will check against results generated
+  by directly calling `lavaan` functions.
+  (0.1.6.1)
+
 # semfindr 0.1.6
 
 ## New Features

diff --git a/README.md b/README.md
@@ -9,7 +9,7 @@
 [![R-CMD-check](https://github.com/sfcheung/semfindr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/semfindr/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 
-(Version 0.1.6, updated on 2023-11-13, [release history](https://sfcheung.github.io/semfindr/news/index.html))
+(Version 0.1.6.1, updated on 2024-01-03, [release history](https://sfcheung.github.io/semfindr/news/index.html))
 
 # semfindr: Finding influential cases in SEM <img src="man/figures/logo.png" align="right" height="150" />
 

diff --git a/tests/testthat/test-lavaan_rerun_multi_nonconvergence.R b/tests/testthat/test-lavaan_rerun_multi_nonconvergence.R
@@ -1,3 +1,6 @@
+skip_on_cran()
+# "Essential but may be machine dependent"
+
 library(testthat)
 library(lavaan)
 library(semfindr)
@@ -7,48 +10,68 @@ mod <-
 f1 =~ x1 + x2 + x3
 f2 =~ x4 + x5 + x6
 '
-dat <- cfa_dat[1:100, ]
-set.seed(54532)
-dat$gp <- sample(c("gp2", "gp1"), size = nrow(dat), replace = TRUE)
+dat <- cfa_dat[1:60, ]
+# set.seed(123456)
+# dat$gp <- sample(c("gp2", "gp1"), size = nrow(dat), replace = TRUE)
+dat$gp <- c("gp1", "gp1", "gp1", "gp2", "gp1", "gp2", "gp2", "gp1", "gp1",
+"gp1", "gp1", "gp2", "gp2", "gp1", "gp2", "gp1", "gp2", "gp2",
+"gp2", "gp2", "gp1", "gp1", "gp1", "gp1", "gp1", "gp2", "gp2",
+"gp1", "gp1", "gp2", "gp1", "gp1", "gp1", "gp2", "gp2", "gp1",
+"gp2", "gp2", "gp1", "gp1", "gp1", "gp2", "gp2", "gp1", "gp2",
+"gp1", "gp2", "gp1", "gp2", "gp1", "gp1", "gp1", "gp1", "gp1",
+"gp2", "gp1", "gp1", "gp2", "gp2", "gp1")
 
-suppressWarnings(fit <- lavaan::cfa(mod, dat, control = list(iter.max = 53),
-                   group = "gp", group.equal = "loadings"))
+fit <- lavaan::cfa(mod, dat, control = list(iter.max = 53),
+                   group = "gp", group.equal = "loadings")
 lavInspect(fit, "iterations")
 lavInspect(fit, "post.check")
 
 # This rerun has both runs that failed to converge and runs that failed post.check.
-fit_rerun <- lavaan_rerun(fit, to_rerun = 1:20)
+j <- 8:13
+fit_rerun <- lavaan_rerun(fit, to_rerun = j, skip_all_checks = TRUE)
 table(sapply(fit_rerun$rerun, lavInspect, what = "converged"))
 suppressWarnings(table(sapply(fit_rerun$rerun, lavInspect, what = "post.check")))
 
+tmp <- sapply(j, function(x) suppressWarnings(lavaan::cfa(mod, dat[-x, ], control = list(iter.max = 53),
+                                              group = "gp", group.equal = "loadings")))
+nc_check0 <- sapply(tmp, lavInspect, what = "converged")
+nc_check1 <- sum(nc_check0)
+pc_check0 <- suppressWarnings(sapply(tmp, lavInspect, what = "post.check"))
+pc_check1 <- sum(!pc_check0)
+
 test_that("Convergence", {
     expect_equal(sum(sapply(fit_rerun$rerun, lavInspect,
                             what = "converged")),
-                 18)
-    expect_true(all(fit_rerun$converged[-c(3, 12)]))
+                 nc_check1)
+    expect_equal(fit_rerun$converged,
+                 nc_check0,
+                 ignore_attr = TRUE)
   })
 
 test_that("Warnings", {
     expect_equal(sum(sapply(fit_rerun$post_check, inherits,
                             what = "simpleWarning")),
-                 1)
-    expect_true(all(sapply(fit_rerun$post_check, inherits,
-                            what = "simpleWarning")[c(3)]))
+                 pc_check1)
+    expect_equal(which(sapply(fit_rerun$post_check, inherits,
+                      what = "simpleWarning")),
+                 which(!pc_check0),
+                 ignore_attr = TRUE)
   })
 
 test_that("est_change_raw", {
     tmp <- est_change_raw(fit_rerun)
-    expect_true(all(!complete.cases(tmp)[c(3, 12)]))
+    expect_equal(complete.cases(tmp),
+                 nc_check0)
   })
 
 test_that("est_change", {
-    suppressMessages(tmp <- est_change(fit_rerun))
-    expect_true(all(!complete.cases(tmp)[c(3, 12)]))
+    tmp <- est_change(fit_rerun)
+    expect_equal(complete.cases(tmp),
+                 nc_check0)
   })
 
 test_that("fit_measures_change", {
     tmp <- fit_measures_change(fit_rerun, fit_measures = "chisq")
-    expect_equal(which(is.na(tmp)),
-                 c(3, 12))
+    expect_equal(as.vector(!is.na(tmp)),
+                 nc_check0)
   })
-
diff --git a/tests/testthat/test-lavaan_rerun_single_nonconvergence.R b/tests/testthat/test-lavaan_rerun_single_nonconvergence.R
@@ -1,50 +1,72 @@
+skip_on_cran()
+# "Essential but may be machine dependent"
+
 library(testthat)
 library(lavaan)
 library(semfindr)
 
-mod <- 
+mod <-
 '
 f1 =~ x1 + x2 + x3
 f2 =~ x4 + x5 + x6
 '
-dat <- cfa_dat[1:50, ]
+# set.seed(2468)
+# dput(sample.int(100, 40))
+i <- c(21L, 22L, 16L, 72L, 13L, 50L, 39L, 91L, 66L, 100L, 62L, 26L,
+17L, 35L, 48L, 81L, 55L, 97L, 98L, 3L, 59L, 89L, 77L, 84L, 4L,
+20L, 41L, 43L, 49L, 90L, 34L, 47L, 71L, 14L, 52L, 5L, 80L, 31L,
+2L, 53L)
+dat <- cfa_dat[i, ]
 
-fit <- lavaan::cfa(mod, dat, control = list(iter.max = 39))
+fit <- lavaan::cfa(mod, dat, control = list(iter.max = 45))
 lavInspect(fit, "iterations")
 
 # This rerun has both runs that failed to converge and runs that failed post.check.
-fit_rerun <- lavaan_rerun(fit, to_rerun = 1:20)
+j <- c(1, c(2, 16, 20, 21, 22, 24), 25)
+fit_rerun <- lavaan_rerun(fit, to_rerun = j, skip_all_checks = TRUE)
 table(sapply(fit_rerun$rerun, lavInspect, what = "converged"))
 suppressWarnings(table(sapply(fit_rerun$rerun, lavInspect, what = "post.check")))
 
+tmp <- sapply(j, function(x) suppressWarnings(lavaan::cfa(mod, dat[-x, ], control = list(iter.max = 45))))
+nc_check0 <- sapply(tmp, lavInspect, what = "converged")
+nc_check1 <- sum(nc_check0)
+pc_check0 <- suppressWarnings(sapply(tmp, lavInspect, what = "post.check"))
+pc_check1 <- sum(!pc_check0)
+
 test_that("Convergence", {
     expect_equal(sum(sapply(fit_rerun$rerun, lavInspect,
                             what = "converged")),
-                 19)
-    expect_true(all(fit_rerun$converged[-3]))
+                 nc_check1)
+    expect_equal(fit_rerun$converged,
+                 nc_check0,
+                 ignore_attr = TRUE)
   })
 
 test_that("Warnings", {
     expect_equal(sum(sapply(fit_rerun$post_check, inherits,
                             what = "simpleWarning")),
-                 2)
-    expect_true(all(sapply(fit_rerun$post_check, inherits,
-                            what = "simpleWarning")[c(1, 20)]))
+                 pc_check1)
+    expect_equal(which(sapply(fit_rerun$post_check, inherits,
+                      what = "simpleWarning")),
+                 which(!pc_check0),
+                 ignore_attr = TRUE)
   })
 
 test_that("est_change_raw", {
     tmp <- est_change_raw(fit_rerun)
-    expect_true(all(!complete.cases(tmp)[c(1, 3, 20)]))
+    expect_equal(complete.cases(tmp),
+                 nc_check0)
   })
 
 test_that("est_change", {
     tmp <- est_change(fit_rerun)
-    expect_true(all(!complete.cases(tmp)[c(1, 3, 20)]))
+    expect_equal(complete.cases(tmp),
+                 nc_check0)
   })
 
 test_that("fit_measures_change", {
     tmp <- fit_measures_change(fit_rerun, fit_measures = "chisq")
-    expect_equal(which(is.na(tmp)),
-                 c(1, 3, 20))
+    expect_equal(as.vector(!is.na(tmp)),
+                 nc_check0)
   })