tests/testthat/test-parameter_id.R

In semfindr: Influential Cases in Structural Equation Modeling

library(testthat)
library(lavaan)

dat <- sem_dat
set.seed(64264)
dat$gp <- sample(c("gp1", "gp2", "gp3"),
                 nrow(dat),
                 replace = TRUE)
sem_model <-
"
f1 =~  x1 + x2 + x3
f2 =~  x4 + x5 + x6
f3 =~  x7 + x8 + x9
f2 ~   f1
f3 ~   f2
"

sem_model_eq <-
"
f1 =~  x1 + a * x2 + b * x3
f2 =~  x4 + d * x5 + d * x6
f3 =~  x7 + x8 + x9
f2 ~   f1
f3 ~   f2
a == b
"

sem_model_gp_eq <-
"
f1 =~  x1 + c(a21, a22, a23) * x2 + x3
f2 =~  x4 + x5 + c(a61, a62, a63) * x6
f3 =~  x7 + x8 + x9
f2 ~   f1
f3 ~   f2
"

fit_ng <- sem(sem_model, dat)
fit_ng_eq <- sem(sem_model_eq, dat)
fit_gp <- sem(sem_model, dat, group = "gp")
fit_gp_eq <- sem(sem_model_gp_eq, dat, group = "gp")

fit_ng_eq@Model@eq.constraints
fit_gp_eq@Model@eq.constraints

# Test conditions
# Single-group model / Single-group specification
# Single-group model / Multi-group specification
# Single-group model with equality constraints / Single-group specification
# Single-group model with equality constraints / Multi-group specification
# Multi-group model with equality constraints / Single-group specification
# Multi-group model with equality constraints / Multi-group specification

pt_ng <- parameterTable(fit_ng)
pt_ng_eq <- parameterTable(fit_ng_eq)
pt_gp <- parameterTable(fit_gp)
pt_gp_labelled <- pt_gp
pt_gp_labelled$group <- lavInspect(fit_gp, "group.label")[pt_gp_labelled$group]


est_ng <- parameterEstimates(fit_ng, standardized = TRUE)
est_ng_eq <- parameterEstimates(fit_ng_eq, standardized = TRUE)
est_gp <- parameterEstimates(fit_gp, standardized = TRUE)

pl_ng <- lavaan::lav_partable_labels(pt_ng, type = "user")
pl_ng_eq <- lavaan::lav_partable_labels(pt_ng_eq, type = "user")
pl_gp <- lavaan::lav_partable_labels(pt_gp, type = "user")
setdiff(names(coef(fit_ng)), pl_ng)
setdiff(names(coef(fit_ng_eq)), pl_ng_eq)
setdiff(names(coef(fit_gp)), pl_gp)
setdiff(pl_gp, names(coef(fit_gp)))

pars1 <- c("f1 =~ x2", "f2 =~ x5", "f2 ~ f1")
pars2 <- c("f1 =~ x2", "f2 =~ c(NA, 1, NA) * x5", "f2 ~ f1")
pars3 <- c("f1 =~ x2", "f2 =~ c(NA, 1, NA) * x5", "f2 ~ c(1, NA, 1) * f1")

test_that("pars_id: default, where = 'coef'", {
    expect_true(setequal(pars_id(pars1, fit_ng),
                    c(1, 3, 7)))
    expect_true(setequal(pars_id(pars2, fit_ng),
                    c(1, 7)))
    expect_true(setequal(pars_id(pars3, fit_ng),
                    c(1)))
    expect_true(setequal(pars_id(pars1, fit_ng_eq),
                    c(1, 3, 7)))
    expect_true(setequal(pars_id(pars2, fit_ng_eq),
                    c(1, 7)))
    expect_true(setequal(pars_id(pars3, fit_ng_eq),
                    c(1)))
    expect_true(setequal(pars_id(pars1, fit_gp),
                    c(1, 3, 7, 30, 32, 36, 59, 61, 65)))
    expect_true(setequal(pars_id(pars2, fit_gp),
                    c(1, 3, 7, 30, 36, 59, 61, 65)))
    expect_true(setequal(pars_id(pars3, fit_gp),
                    c(1, 3, 30, 36, 59, 61)))
  })


test_that("pars_id: where = 'partable'", {
    expect_true(setequal(pars_id(pars1, fit_ng, where = "partable"),
                    which(pt_ng$free %in% c(1, 3, 7))))
    expect_true(setequal(pars_id(pars2, fit_ng, where = "partable"),
                    which(pt_ng$free %in% c(1, 7))))
    expect_true(setequal(pars_id(pars3, fit_ng, where = "partable"),
                    which(pt_ng$free %in% c(1))))
    expect_true(setequal(pars_id(pars1, fit_ng_eq, where = "partable"),
                    which(pt_ng_eq$free %in% c(1, 3, 7))))
    expect_true(setequal(pars_id(pars2, fit_ng_eq, where = "partable"),
                    which(pt_ng_eq$free %in% c(1, 7))))
    expect_true(setequal(pars_id(pars3, fit_ng_eq, where = "partable"),
                    which(pt_ng_eq$free %in% c(1))))
    expect_true(setequal(pars_id(pars1, fit_gp, where = "partable"),
                    which(pt_gp$free %in% c(1, 3, 7, 30, 32, 36, 59, 61, 65))))
    expect_true(setequal(pars_id(pars2, fit_gp, where = "partable"),
                    which(pt_gp$free %in% c(1, 3, 7, 30, 36, 59, 61, 65))))
    expect_true(setequal(pars_id(pars3, fit_gp, where = "partable"),
                    which(pt_gp$free %in% c(1, 3, 30, 36, 59, 61))))
  })

# pars_id_lorg

pars1 <- c("f1 =~ x2", "f2 =~ x5", "f2 ~ f1")
pars2 <- c("f1 =~ x2", "f2 =~ x5.gp2", "f2 ~ f1", "f2 =~ x5.gp3")
pars3 <- c("f1 =~ x2", "f2 =~ x5.gp2", "f2 =~ x5.gp3", "f2 ~ f1.gp1")

test_that("pars_id_lorg: default, where = 'coef'", {
    expect_true(setequal(pars_id_lorg(pars1, fit_ng),
                    c(1, 3, 7)))
    expect_true(setequal(pars_id_lorg(pars2, fit_ng),
                    c(1, 7)))
    expect_true(setequal(pars_id_lorg(pars3, fit_ng),
                    c(1)))
    expect_true(setequal(pars_id_lorg(pars1, fit_ng_eq),
                    c(1, 3, 7)))
    expect_true(setequal(pars_id_lorg(pars2, fit_ng_eq),
                    c(1, 7)))
    expect_true(setequal(pars_id_lorg(pars3, fit_ng_eq),
                    c(1)))
    expect_true(setequal(pars_id_lorg(pars1, fit_gp),
                    c(1, 3, 7, 30, 32, 36, 59, 61, 65)))
    expect_true(setequal(pars_id_lorg(pars2, fit_gp),
                    c(1, 3, 7, 30, 36, 59, 61, 65)))
    expect_true(setequal(pars_id_lorg(pars3, fit_gp),
                    c(1, 3, 30, 36, 59, 61)))
  })

test_that("pars_id_lorg: where = 'partable'", {
    expect_true(setequal(pars_id_lorg(pars1, fit_ng, where = "partable"),
                    which(pt_ng$free %in% c(1, 3, 7))))
    expect_true(setequal(pars_id_lorg(pars2, fit_ng, where = "partable"),
                    which(pt_ng$free %in% c(1, 7))))
    expect_true(setequal(pars_id_lorg(pars3, fit_ng, where = "partable"),
                    which(pt_ng$free %in% c(1))))
    expect_true(setequal(pars_id_lorg(pars1, fit_ng_eq, where = "partable"),
                    which(pt_ng_eq$free %in% c(1, 3, 7))))
    expect_true(setequal(pars_id_lorg(pars2, fit_ng_eq, where = "partable"),
                    which(pt_ng_eq$free %in% c(1, 7))))
    expect_true(setequal(pars_id_lorg(pars3, fit_ng_eq, where = "partable"),
                    which(pt_ng_eq$free %in% c(1))))
    expect_true(setequal(pars_id_lorg(pars1, fit_gp, where = "partable"),
                    which(pt_gp$free %in% c(1, 3, 7, 30, 32, 36, 59, 61, 65))))
    expect_true(setequal(pars_id_lorg(pars2, fit_gp, where = "partable"),
                    which(pt_gp$free %in% c(1, 3, 7, 30, 36, 59, 61, 65))))
    expect_true(setequal(pars_id_lorg(pars3, fit_gp, where = "partable"),
                    which(pt_gp$free %in% c(1, 3, 30, 36, 59, 61))))
  })

test_that("pars_id_lorg and pars_id_to_lorg: where = 'partable'", {
    tmp1 <- pars_id_lorg(pars1, fit_ng, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_ng, type = "all")
    expect_true(all(paste0(tmp2$lhs, tmp2$op, tmp2$rhs) %in%
                    gsub(" ", "", pars1)))
    tmp1 <- pars_id_lorg(pars2, fit_ng, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_ng, type = "all")
    expect_true(all(paste0(tmp2$lhs, tmp2$op, tmp2$rhs) %in%
                    gsub(" ", "", pars2)))
    tmp1 <- pars_id_lorg(pars3, fit_ng, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_ng, type = "all")
    expect_true(all(paste0(tmp2$lhs, tmp2$op, tmp2$rhs) %in%
                    gsub(" ", "", pars3)))

    tmp1 <- pars_id_lorg(pars1, fit_ng_eq, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_ng_eq, type = "all")
    expect_true(all(paste0(tmp2$lhs, tmp2$op, tmp2$rhs) %in%
                    gsub(" ", "", pars1)))
    tmp1 <- pars_id_lorg(pars2, fit_ng_eq, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_ng_eq, type = "all")
    expect_true(all(paste0(tmp2$lhs, tmp2$op, tmp2$rhs) %in%
                    gsub(" ", "", pars2)))
    tmp1 <- pars_id_lorg(pars3, fit_ng_eq, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_ng_eq, type = "all")
    expect_true(all(paste0(tmp2$lhs, tmp2$op, tmp2$rhs) %in%
                    gsub(" ", "", pars3)))

    tmp1 <- pars_id_lorg(pars1, fit_gp, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_gp, type = "all")
    tmp2$group <- lavInspect(fit_gp, "group.label")[tmp2$group]
    expect_true(all(unique(paste0(tmp2$lhs, tmp2$op, tmp2$rhs)) %in%
                    gsub(" ", "", pars1)))
    tmp1 <- pars_id_lorg(pars2, fit_gp, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_gp, type = "all")
    tmp2$group <- lavInspect(fit_gp, "group.label")[tmp2$group]
    expect_true(any(gsub(" ", "", pars2) %in%
                    unique(paste0(tmp2$lhs, tmp2$op, tmp2$rhs))))
    expect_true(any(gsub(" ", "", pars2) %in%
                  unique(paste0(tmp2$lhs, tmp2$op, tmp2$rhs, ".", tmp2$group))))
    tmp1 <- pars_id_lorg(pars3, fit_gp, where = "partable")
    tmp2 <- pars_id_to_lorg(tmp1, pt_gp, type = "all")
    tmp2$group <- lavInspect(fit_gp, "group.label")[tmp2$group]
    expect_true(any(gsub(" ", "", pars3) %in%
                    unique(paste0(tmp2$lhs, tmp2$op, tmp2$rhs))))
    expect_true(any(gsub(" ", "", pars3) %in%
                  unique(paste0(tmp2$lhs, tmp2$op, tmp2$rhs, ".", tmp2$group))))

  })



# pars_id_op

pars1 <- c("f1 =~ x2", "f2 =~ x5", "=~", "f2 ~ f1")
pars2 <- c("f1 =~ x2", "~~.gp2", "f2 =~ x5.gp2", "f2 ~ f1", "=~.gp1")
pars3 <- c("f1 =~ x2", "~~", "f2 =~ x5.gp2", "~1.gp2",
           "f2 =~ x5.gp3", "f2 ~ f1.gp1")

# coef
test_that("pars_id_op: where = 'coef'", {
    expect_true(all.equal(pars_id_op(pars1, fit_ng),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "=~"), "free"]))
    expect_true(all.equal(pars_id_op(pars2, fit_ng), integer(0)))
    expect_true(all.equal(pars_id_op(pars3, fit_ng),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "~~"), "free"]))
    expect_true(all.equal(pars_id_op(pars1, fit_ng_eq),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "=~"), "free"]))
    expect_true(all.equal(pars_id_op(pars2, fit_ng_eq), integer(0)))
    expect_true(all.equal(pars_id_op(pars3, fit_ng_eq),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "~~"), "free"]))
    expect_true(all.equal(pars_id_op(pars1, fit_gp),
                          pt_gp[(pt_gp$free > 0) &
                                (pt_gp$op == "=~"), "free"]))
    expect_true(all.equal(pars_id_op(pars2, fit_gp),
                  pt_gp[(pt_gp$free > 0) &
                        (((pt_gp$op == "=~") & (pt_gp$group == 2)) |
                          ((pt_gp$op == "~~") & (pt_gp$group == 1))), "free"]))
    expect_true(all.equal(pars_id_op(pars3, fit_gp),
                  pt_gp[(pt_gp$free > 0) &
                        (((pt_gp$op == "~1") & (pt_gp$group == 1)) |
                        (pt_gp$op == "~~")), "free"]))
  })

test_that("pars_id_op: where = 'partable'", {
    expect_true(all.equal(pars_id_op(pars1, fit_ng, where = "partable"),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "=~"), "id"]))
    expect_true(all.equal(pars_id_op(pars2, fit_ng, where = "partable"),
                          integer(0)))
    expect_true(all.equal(pars_id_op(pars3, fit_ng, where = "partable"),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "~~"), "id"]))
    expect_true(all.equal(pars_id_op(pars1, fit_ng_eq, where = "partable"),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "=~"), "id"]))
    expect_true(all.equal(pars_id_op(pars2, fit_ng_eq, where = "partable"),
                          integer(0)))
    expect_true(all.equal(pars_id_op(pars3, fit_ng_eq, where = "partable"),
                          pt_ng[(pt_ng$free > 0) &
                                (pt_ng$op == "~~"), "id"]))
    expect_true(all.equal(pars_id_op(pars1, fit_gp, where = "partable"),
                          pt_gp[(pt_gp$free > 0) &
                                (pt_gp$op == "=~"), "id"]))
    expect_true(all.equal(pars_id_op(pars2, fit_gp, where = "partable"),
                  pt_gp[(pt_gp$free > 0) &
                        (((pt_gp$op == "=~") & (pt_gp$group == 2)) |
                          ((pt_gp$op == "~~") & (pt_gp$group == 1))), "id"]))
    expect_true(all.equal(pars_id_op(pars3, fit_gp, where = "partable"),
                  pt_gp[(pt_gp$free > 0) &
                        (((pt_gp$op == "~1") & (pt_gp$group == 1)) |
                        (pt_gp$op == "~~")), "id"]))
  })

test_that("pars_id_op: where = 'partable', type = 'all'", {
    expect_true(all.equal(pars_id_op(pars1, fit_ng, where = "partable",
                                     free_only = FALSE),
                          pt_ng[(pt_ng$free > -1) &
                                (pt_ng$op == "=~"), "id"]))
    expect_true(all.equal(pars_id_op(pars2, fit_ng, where = "partable",
                                     free_only = FALSE),
                          integer(0)))
    expect_true(all.equal(pars_id_op(pars3, fit_ng, where = "partable",
                                     free_only = FALSE),
                          pt_ng[(pt_ng$free > -1) &
                                (pt_ng$op == "~~"), "id"]))
    expect_true(all.equal(pars_id_op(pars1, fit_ng_eq, where = "partable",
                                     free_only = FALSE),
                          pt_ng[(pt_ng$free > -1) &
                                (pt_ng$op == "=~"), "id"]))
    expect_true(all.equal(pars_id_op(pars2, fit_ng_eq, where = "partable",
                                     free_only = FALSE),
                          integer(0)))
    expect_true(all.equal(pars_id_op(pars3, fit_ng_eq, where = "partable",
                                     free_only = FALSE),
                          pt_ng[(pt_ng$free > -1) &
                                (pt_ng$op == "~~"), "id"]))
    expect_true(all.equal(pars_id_op(pars1, fit_gp, where = "partable",
                                     free_only = FALSE),
                          pt_gp[(pt_gp$free > -1) &
                                (pt_gp$op == "=~"), "id"]))
    expect_true(all.equal(pars_id_op(pars2, fit_gp, where = "partable",
                                     free_only = FALSE),
                  pt_gp[(pt_gp$free > -1) &
                        (((pt_gp$op == "=~") & (pt_gp$group == 2)) |
                          ((pt_gp$op == "~~") & (pt_gp$group == 1))), "id"]))
    expect_true(all.equal(pars_id_op(pars3, fit_gp, where = "partable",
                                     free_only = FALSE),
                  pt_gp[(pt_gp$free > -1) &
                        (((pt_gp$op == "~1") & (pt_gp$group == 1)) |
                        (pt_gp$op == "~~")), "id"]))
  })