Skip to content

Commit

Permalink
Merge pull request #109 from sfcheung/devel
Browse files Browse the repository at this point in the history
0.1.6.1: Revise the tests for nonconvergence
  • Loading branch information
sfcheung committed Jan 3, 2024
2 parents f09cd68 + e6d5dc7 commit bf1e481
Show file tree
Hide file tree
Showing 5 changed files with 84 additions and 32 deletions.
2 changes: 1 addition & 1 deletion 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",
Expand Down
7 changes: 7 additions & 0 deletions 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
Expand Down
2 changes: 1 addition & 1 deletion README.md
Expand Up @@ -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" />

Expand Down
57 changes: 40 additions & 17 deletions 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)
Expand All @@ -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)
})

48 changes: 35 additions & 13 deletions 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)
})

0 comments on commit bf1e481

Please sign in to comment.