tests/testthat/test_sam_update_internal.R

In manymome: Mediation, Moderation and Moderated-Mediation After Model Fitting

skip("WIP")

# On hold. It is difficult to update
# a call to sam() reliability, except
# when the only changes is the cases
# generated by resampling.

skip_on_cran()

# The internal general update function

library(manymome)
library(testthat)
suppressMessages(library(lavaan))

# NOTE:
# - Only a limited number of options are supported.
# - For internal use only.
# Input:
# - An output of sam()
# - new_data: New data to be used.
#   If NULL, the original data will be
#   used.
# - boot_idx (row numbers in each group).
#   Must be used if new_data was a bootstrap
#   samples. Used to update another
#   slot. If NULL, the stored data is used.
# - ...: lavOptions
# Output:
# - An updated sam output
sam_update_internal <- function(
  object,
  new_data = NULL,
  boot_idx = NULL,
  ...
) {
  # If an official update function is
  # available for the output of sam(),
  # this function should be replaced by
  # the official update function.

  if (!is.null(new_data)) {
    stop("new_data not supported for now")
  }

  # Most values in ddd not used by
  # if the object is an output of sam().
  # Only retain a few used by sam().

  ddd <- list(...)

  lavmodel <- object@Model
  lavdata <- object@Data
  lavoptions <- lavaan::lavInspect(
                  object,
                  "options"
                )

  # ==== Update lavOptions ====

  lavoptions <- utils::modifyList(
                  lavoptions,
                  ddd
                )

  # ==== Update data ====

  if (is.null(boot_idx)) {
    newX <- lavdata@X
  } else {
    newX <- mapply(
              function(x, y) {
                x[y, , drop = FALSE]
              },
              x = lavdata@X,
              y = boot_idx,
              SIMPLIFY = FALSE
            )
  }
  newdata <- lavaan::lav_data_update(
              lavdata = lavdata,
              newX = newX,
              BOOT.idx = boot_idx,
              lavoptions = lavoptions
            )

  # ==== Update sampleStats ====

  newsampleStats <- lavaan::lav_samplestats_from_data(
                        lavdata = newdata,
                        lavoptions = lavoptions
                      )

  # ==== lavaan::lavaan() ====

  # Based on lavaan:::lav_sam_step0()

  # Updated arguments to be used here

  x <- object

  if (!is.null(ddd$sam.method)) {
    x@internal$sam.method <- ddd$sam.method
  }
  if (!is.null(ddd$se)) {
    x@Options$se <- ddd$se
  }

  x@Options$do.fit <- FALSE
  if (x@internal$sam.method %in%
      c("local", "fsr", "cfsr")) {
    x@Options$sample.icov <- TRUE
  }
  x@Options$se <- "none"
  x@Options$test <- "none"
  x@Options$ceq.simple <- TRUE
  x@Options$check.lv.interaction <- FALSE
  if (x@Options$se %in%
      c("local", "ij", "twostep.robust")) {
    x@Options$sample.icov <- TRUE
    x@Options$NACOV <- TRUE
    x@Options$fixed.x <- FALSE
    x@Options$ov.order <- "force.model"
  }
  # Any lv interaction terms?
  if (length(lavaan::lavNames(x, "lv.interaction")) > 0L) {
    x@Options$meanstructure  <- TRUE
  }

  x@internal <- list()

  # Adapted from bootstrapLavaan()

  if (lavmodel@fixed.x
      &&
      (length(lavaan::lavNames(object, "ov.x")) > 0L)) {
    model_boot <- NULL
  } else {
    model_boot <- lavmodel
  }

  x <- lavaan::lavaan(
    slotData = newdata,
    slotSampleStats = newsampleStats,
    slotModel = model_boot,
    slotOptions = x@Options,
    slotParTable = x@ParTable
  )

  x@internal <- object@internal

  # ==== Update arguments ====

  if (!is.null(ddd$cmd)) {
    x@internal$sam.cmd <- ddd$cmd
  }
  if (!is.null(ddd$se)) {
    x@internal$sam.lavoptions$se <- ddd$se
  }
  if (!is.null(ddd$mm.list)) {
    x@internal$sam.mm.list <- ddd$mm.list
  }
  if (!is.null(ddd$mm.args)) {
    x@internal$sam.mm.args <- ddd$mm.args
  }
  if (!is.null(ddd$struc.args)) {
    x@internal$sam.struc.args <- ddd$struc.args
  }
  if (!is.null(ddd$sam.method)) {
    x@internal$sam.method <- ddd$sam.method
  }
  if (!is.null(ddd$local.options)) {
    x@internal$sam.local.options <- ddd$sam.local.options
  }
  if (!is.null(ddd$global.options)) {
    x@internal$sam.global.options <- ddd$sam.global.options
  }
  # ddd Other options can be used directly
  #   in the call to sam()
  # bootstrap.args can be used in the call directly
  # output can be used in the call directly

  if ((x@Model@categorical) &&
      (x@Options$se == "twostep")) {
    if (x@internal$sam.method == "local") {
      x@Options$se <- "twostep.robust"
    }
  }

  PT <- x@ParTable
  PT$est <- PT$ustart
  if (any(PT$exo > 0L)) {
    PT$est[PT$exo > 0L] <- PT$start[PT$exo > 0L]
  }
  PT$se <- rep(as.numeric(NA), length(PT$lhs))
  PT$se[(PT$free == 0L) & (!is.na(PT$ustart))] <- 0.0
  x@ParTable <- PT

  # Only update arguments of sam()
  # In case some arguments need to be in the call

  if (length(ddd) > 0) {
    sam_arg_names <- c(
      "cmd",
      "se",
      "mm.list",
      "mm.args",
      "struc.args",
      "sam.method",
      "local.options",
      "global.options",
      "bootstrap.args",
      "output"
    )
    tmp <- intersect(names(ddd), sam_arg_names)
    ddd2 <- ddd[tmp]
  } else {
    ddd2 <- list()
  }

  # Options should have been set. Ignore ddd
  # Suppress the harmless warning that will
  # appear in lavaan 0.7-1

  suppressWarnings(out <- do.call(
          lavaan::sam,
          c(list(model = x),
            ddd2)
          ))
  # out <- lavaan::sam(
  #   model = x,
  #   ...
  # )
  out
}

# ==== Multigroup, FIML, some cases empty ====

test_that("SAM: Internal update", {

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~ f2 + f3
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  missing = "fiml",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-4)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})

# ==== Multigroup, FIML, no cases empty ====

test_that("SAM: Internal update", {

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~ f2 + f3
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  missing = "fiml",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Multigroup, listwise, some cases empty ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~  f2 + f3
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Multigroup, listwise, no cases empty ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
# data_sem_miss[41:50, ] <- NA
# data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~  f2 + f3
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Single-group, FIML, some cases empty ====

test_that("SAM: Internal update", {

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~ f2 + f3
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)


})

# ==== Single-group, FIML, no cases empty ====

test_that("SAM: Internal update", {

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~ f2 + f3
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Single-group, listwise, some cases empty ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~  f2 + f3
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Single-group, listwise, no cases empty ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
# data_sem_miss[41:50, ] <- NA
# data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06 + x07
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13 + x14
f2 ~ f1
f3 ~ f1
f4 ~  f2 + f3
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})

# ==== Multigroup, FIML, some cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  missing = "fiml",
  sam.method = "global",
  fixed.x = FALSE,
  warn = FALSE
)

suppressWarnings(fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global",
  fixed.x = FALSE
))

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Multigroup, listwise, some cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

# Check only coefficient.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Multigroup, listwise, no cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
# data_sem_miss[41:50, ] <- NA
# data_sem_miss[200, ] <- NA


mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

set.seed(5981470)
data_sem_miss$gp <- sample(c("gp1", "gp2"),
                      size = nrow(data_sem_miss),
                      replace = TRUE)

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  group = "gp",
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Single-group, FIML, some cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Single-group, FIML, no cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  missing = "fiml",
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})

# ==== Single-group, listwise, some cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now.

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
data_sem_miss[41:50, ] <- NA
data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})


# ==== Single-group, listwise, no cases empty, fixed.x ====

test_that("SAM: Internal update", {

skip("WIP")

# Does not work for now

data_sem_miss <- data_sem
data_sem_miss[1:10, 2:14] <- NA
data_sem_miss[11:20, c(1:3, 5:14)] <- NA
data_sem_miss[21:30, c(1:7, 9:14)] <- NA
data_sem_miss[31:40, c(1:10, 12:14)] <- NA
# data_sem_miss[41:50, ] <- NA
# data_sem_miss[200, ] <- NA

mod <-
"
f1 =~ x01 + x02 + x03
f2 =~ x04 + x05 + x06
f3 =~ x08 + x09 + x10
f4 =~ x11 + x12 + x13
f2 ~ f1 + x07
f3 ~ f1
f4 ~ f2 + f3 + x14
"

# The warning is expected
fit1 <- sam(
  model = mod,
  data = data_sem_miss,
  warn = FALSE
)

fit1_chk <- sam(
  model = mod,
  data = data_sem_miss,
  sam.method = "global",
  warn = FALSE
)

fit1_updated <- sam_update_internal(
  fit1,
  sam.method = "global"
)

# Expected to be different
expect_true(!isTRUE(
             all.equal(
              coef(fit1_updated)[names(coef(fit1))],
              coef(fit1),
              tolerance = 1e-5)
))

expect_equal(coef(fit1_updated)[names(coef(fit1_chk))],
             coef(fit1_chk),
             tolerance = 1e-5)

expect_equal(vcov(fit1_chk),
             vcov(fit1_updated),
             tolerance = 1e-4)

})