tests/testthat/test-multigroup_mx.R

In tidySEM: Tidy Structural Equation Modeling

test_that("multigroup_mx works", {
  tidySEM:::skip_if_not_local()
  library(lavaan)
  HS.model <- ' visual  =~ x1 + x2 + x3
              textual =~ x4 + x5 + x6
              speed   =~ x7 + x8 + x9 '

  tmp <- as_ram(HS.model, groups = c("a", "b"))

  expect_equal(names(tmp@submodels), letters[1:2])


  fitL <- cfa(HS.model,
              data = HolzingerSwineford1939,
              group = "school")
  parL <- table_results(fitL, columns = NULL)

  fitM <- run_mx(tmp, data = HolzingerSwineford1939, groups = "school")
  parM <- table_results(fitM, columns = NULL)

  tidySEM:::skip_if_not_local()
  expect_equivalent(as.numeric(parL$est[parL$op == "=~" & grepl("^x\\d$", parL$rhs)]),
                    as.numeric(parM$est)[grepl("\\.BY\\.", parM$label)], tolerance = .01)


  tmp <- as_ram(HS.model, groups = c("school"), data = HolzingerSwineford1939)

  fitM <- run_mx(tmp)
  parM <- table_results(fitM, columns = NULL)
  # Note: Order of groups is reversed by lavaan
  parL <- parL[order(parL$group), ]
  expect_equivalent(as.numeric(parL$est[parL$op == "=~"]),
                    as.numeric(parM$est)[grepl("\\.BY\\.", parM$label)], tolerance = .01)


  dat <- HolzingerSwineford1939[c("school", paste0("x", 1:9))]
  names(dat)[-1] <- paste(rep(c("vis", "tex", "spd"), each = 3), rep(1:3, 3), sep ="_")
  tmp <- tidy_sem(dat)
  tmp <- measurement(tmp, groups = "school")
  run_mx(tmp) -> tst
  resM <- summary(tst)$parameters
  parL <- parL[order(parL$group, decreasing = T), ]

  expect_equivalent(as.numeric(parL$est[parL$op == "=~" & grepl("^x[2-3,5-6,8-9]$", parL$rhs)]),
                    resM$Estimate[grepl("^(vis|tex|spd)_\\d$", resM$row) & resM$col %in% c("vis", "tex", "spd")], tolerance = .01)



  # Add paths to multigroup -------------------------------------------------

  tmp <- add_paths(tmp, "vis ~ tex + spd")
  run_mx(tmp) -> res_add
  tab <- summary(res_add)$parameters
  #tab <- table_results(res_add, columns = NULL)

  expect_true(sum(endsWith(tab$matrix, ".A") & tab$row == "vis") == 4)
  #expect_true(sum(tab$openmx_label == "a") == 2 & sum(tab$openmx_label == "b") == 2)

  tmp <- add_paths(tmp, "vis ~ c(a, a)*tex + c(b, b)*spd")
  run_mx(tmp) -> res_add
  tab <- table_results(res_add, NULL)


  expect_true(sum(tab$openmx_label == "a", na.rm = TRUE) == 2 & sum(tab$openmx_label == "b", na.rm = TRUE) == 2)
})