From 3649ddd37ccfe68cd1d95b4c058ec8f6ad2c73a5 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Wed, 3 Jan 2024 21:30:19 +0800 Subject: [PATCH] 0.1.6.1: Revise the tests for nonconvergence tests and checks passed. --- DESCRIPTION | 2 +- NEWS.md | 7 +++ README.md | 2 +- .../test-lavaan_rerun_multi_nonconvergence.R | 57 +++++++++++++------ .../test-lavaan_rerun_single_nonconvergence.R | 48 +++++++++++----- 5 files changed, 84 insertions(+), 32 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3d9853d..209a8e2 100644 --- 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 index f782054..d9af911 100644 --- 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 index b66a7dc..fffbfae 100644 --- 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) -(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 diff --git a/tests/testthat/test-lavaan_rerun_multi_nonconvergence.R b/tests/testthat/test-lavaan_rerun_multi_nonconvergence.R index e9b5cd2..92e2533 100644 --- 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 index 0434c84..a1926ea 100644 --- 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) })