tests/testthat/test-mark_mg.R

In sfcheung/semptools: Customizing Structural Equation Modelling Plots

library(lavaan)
library(semPlot)
library(semptools)

# Multigroup CFA

model <- "visual  =~ x1 + x2 + x3
          textual =~ x4 + x5 + x6
          speed   =~ x7 + x8 + x9"
fit <- cfa(model = model, data = HolzingerSwineford1939, group = "school")
plot(1)
p0s <- semPaths(object = fit,
                thresholds = FALSE,
                whatLabels = "std",
                intercepts = FALSE,
                exoCov = TRUE,
                style = "ram",
                curvePivot = TRUE,
                edge.color = "black",
                DoNotPlot = TRUE)
p1s <- lapply(p0s,
              set_cfa_layout,
              loading_position = .9)

est <- parameterEstimates(fit, standardized = TRUE)
std <- standardizedSolution(fit)
id <- c(37:45)
p_se_chk <- paste0(formatC(std$est.std[id], digits = 2, format = "f"),
                   " (",
                   formatC(est$se[id], digits = 2, format = "f"),
                   ")")
alphas <- c("*" = .05, "**" = .01, "***" = .001)
alphas_sorted <- sort(alphas, decreasing = FALSE)
tmp <- sapply(est$pvalue[id], function(x) {
                                  ind <- which(x < alphas_sorted)[1]
                                  ifelse(is.na(ind), "", names(ind[1]))
                                })
p_sig_chk <- paste0(formatC(std$est.std[id], digits = 2, format = "f"),
                    tmp)

test_that(
  "mark_se and mark_sig", {
    p2s_se <- mark_se(p1s,
                      object = fit)
    p2s_sig <- mark_sig(p1s,
                        object = fit)
    expect_identical(p2s_se[[2]]$graphAttributes$Edges$labels[1:9],
                     p_se_chk)
    expect_identical(p2s_sig[[2]]$graphAttributes$Edges$labels[1:9],
                     p_sig_chk)
  })

# Multigroup Path Model

n <- nrow(pa_example)
pa_example$group <- rep(c("gp2", "gp1"), times = n / 2)
mod_pa <-
  'x1 ~~ x2
   x3 ~  x1 + x2
   x4 ~  x1 + x3
  '
fit_pa <- lavaan::sem(mod_pa, pa_example,
                      group = "group")
m <- matrix(c("x1",   NA,  NA,   NA,
              NA, "x3",  NA, "x4",
              "x2",   NA,  NA,   NA), byrow = TRUE, 3, 4)
plot(1)
p_pa <- semPaths(fit_pa, whatLabels = "est",
                 sizeMan = 10,
                 edge.label.cex = 1.15,
                 layout = m,
                 intercepts = FALSE,
                 DoNotPlot = TRUE)

est <- parameterEstimates(fit_pa)
id <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 1) + 13
p_pa_se_chk <- paste0(formatC(est$est[id], digits = 2, format = "f"),
                      " (",
                      formatC(est$se[id], digits = 2, format = "f"),
                      ")")
alphas <- c("*" = .05, "**" = .01, "***" = .001)
alphas_sorted <- sort(alphas, decreasing = FALSE)
tmp <- sapply(est$pvalue[id], function(x) {
                                  ind <- which(x < alphas_sorted)[1]
                                  ifelse(is.na(ind), "", names(ind[1]))
                                })
p_pa_sig_chk <- paste0(formatC(est$est[id], digits = 2, format = "f"),
                       tmp)

test_that(
  "mark_se and mark_sig", {
    p_pa_se <- mark_se(p_pa, fit_pa)
    p_pa_sig <- mark_sig(p_pa, fit_pa)
    expect_identical(p_pa_se[[2]]$graphAttributes$Edges$labels,
                     p_pa_se_chk)
    expect_identical(p_pa_sig[[2]]$graphAttributes$Edges$labels,
                     p_pa_sig_chk)
  })