Generate a table to list the settings related to each estimator in lavaan

check_estimator_settings.R

## Generate a table to list the settings related to
## each estimator in lavaan.

# estimator
# Documented:
# - ML
# - MLR
# - MLM
# - MLMV
# - MLMVS
# - GLS
# - WLS
# - WLSM
# - WLSMV
# - ULS
# - ULSM
# - ULSMV
# - DLS
# - DWLS
# - MLF
# - default
# Undocumented:
# - none
# - NTRLS
# - UMN
# - REML
# - FML
# - MML
# - PML
# - ULSMVS
# - WLSMVS

### Short version ###
# Only examine the impact of `estimator` on the settings
# Other options left at default.

options(width = 132)
library(lavaan)
mod <-
"
m ~ x
y ~ m
"
dat <- as.data.frame(MASS::mvrnorm(100, c(x = 0, m = 0, y = 0), diag(3)))
# Only documented estimators are included
estimators <- c(
"ML",
"MLR",
"MLM",
"MLMV",
"MLMVS",
"GLS",
"WLS",
"WLSM",
"WLSMV",
"ULS",
"ULSM",
"ULSMV",
"DLS",
"DWLS",
"MLF"
)
fits <- sapply(estimators,
               function(x) sem(mod, dat, estimator = x),
               simplify = FALSE,
               USE.NAMES = TRUE)
fit_options <- lapply(fits, function(x) x@Options)
options0 <- c(
"estimator",
"se",
"missing",
"information",
"test"
)
fit_options0 <- t(sapply(fit_options, function(x) unlist(x[options0]),
                       USE.NAMES = TRUE))
fit_options0 <- as.data.frame(fit_options0)
fit_options0 <- fit_options0[order(fit_options0$estimator,
                                   fit_options0$se,
                                   fit_options0$test), ]
print(fit_options0, quote = FALSE)

### Long version ###
# Examine the impact of `estimator`, `missing`, and `fixed.x` on the settings
# Other options left at default.

options(width = 140)
library(lavaan)
mod <-
"
m ~ x
y ~ m
"
dat <- as.data.frame(MASS::mvrnorm(100, c(x = 0, m = 0, y = 0), diag(3)))
# Only documented estimators are included
estimators <- c(
"ML",
"MLR",
"MLM",
"MLMV",
"MLMVS",
"GLS",
"WLS",
"WLSM",
"WLSMV",
"ULS",
"ULSM",
"ULSMV",
"DLS",
"DWLS",
"MLF"
)
missings <- c(
"listwise",
"ml", # aliases: fiml, direct
"ml.x",
"two.stages",
"robust.two.stages",
"pairwise",
"available.cases",
"doubly.robust"
)
options_df <- expand.grid(estimator = estimators,
                          missing = missings,
                          fixed.x = c(TRUE, FALSE),
                          stringsAsFactors = FALSE)
fct <- function(estimator, missing, fixed.x) {
    out <- tryCatch(sem(model = mod, data = dat,
                        estimator = estimator,
                        missing = missing,
                        fixed.x = fixed.x),
                    error = function(e) e)
    out
  }
fits <- mapply(fct,
               estimator = options_df$estimator,
               missing = options_df$missing,
               fixed.x = options_df$fixed.x)
fits_error <- sapply(fits, inherits, "error")
fct2 <- function(x) {
    if (inherits(x, "error")) {
        return(NA)
      } else {
        return(x@Options)
      }
  }
fit_options <- lapply(fits, fct2)
options0 <- c(
"estimator",
"se",
"information1",
"information2",
"test",
"missing",
"mimic"
)
empty_row <- unlist(fit_options[[!fits_error[1]]])
empty_row[] <- NA
fct3 <- function(x) {
    out <- empty_row
    if (length(x) == 1) {
        return(out[options0])
      } else {
        out[options0] <- unlist(x)[options0]
        return(out[options0])
      }
  }
fit_options0 <- t(sapply(fit_options, fct3,
                         USE.NAMES = TRUE))
fit_options0 <- cbind(options_df, fit_options0)
fit_options0 <- as.data.frame(fit_options0[!fits_error, ])
rownames(fit_options0) <- NULL
fit_options0 <- fit_options0[order(fit_options0$fixed.x,
                                   fit_options0$missing,
                                   fit_options0$estimator,
                                   fit_options0$se,
                                   fit_options0$test), ]
print(fit_options0, quote = FALSE)