Deal with missing values

semTools/R/emmeans_lavaan.R

@@ -73,7 +73,7 @@
 NULL
 
 ##' @rdname lavaan2emmeans
-recover_data.lavaan <- function(object, lavaan.DV, ...){
+recover_data.lavaan <- function(object, lavaan.DV, data = NULL, ...){
   if (!requireNamespace("emmeans", quietly = TRUE)){
     stop("'emmeans' is not installed.")
   }
@@ -93,11 +93,11 @@ recover_data.lavaan <- function(object, lavaan.DV, ...){
 
 
   # Fake it
-  recovered <- emmeans::recover_data(.emlav_fake_fit(object, lavaan.DV),
-                                     ...)
+  lavaan_data <- .emlav_recover_data(object, data)
+  recovered <- emmeans::recover_data(.emlav_fake_fit(object, lavaan.DV, lavaan_data),
+                                     data = lavaan_data, ...)
 
   # Make it
-  lavaan_data <- .emlav_recover_data(object)
   lavaan_data <- lavaan_data[, colnames(recovered), drop = FALSE]
 
   # Fill attributes (but keep lavaan_data in case of missing data)
@@ -250,23 +250,28 @@ emm_basis.lavaan <- function(object,trms, xlev, grid, lavaan.DV, ...){
 
 ##' @keywords internal
 ##' @importFrom lavaan lavInspect
-.emlav_recover_data <- function(object){
+.emlav_recover_data <- function(object, data = NULL, silent = FALSE){
   ##This function  was contributed by TDJ
-  dat <- lavaan::lavPredict(object, type = "lv",
+  dat <- lavaan::lavPredict(object, newdata = data,
+                            type = "lv",
                             assemble = TRUE,
                             append.data = TRUE)
   ## convert to data.frame, if necessary (single group)
   dat <- as.data.frame(dat)
-  ## mean-impute any NAs
-  for (i in 1:ncol(dat)) {
-    ## ignore non-numeric variables
-    if (!is.numeric(dat[,i])) next
-    ## any NAs?
-    idx.na <- which(is.na(dat[,i]))
-    if (length(idx.na)) {
-      dat[idx.na, i] <- mean(dat[,i], na.rm = TRUE)
+  if (anyNA(dat)) {
+    ## mean-impute any NAs
+    if (!silent) {
+      warning("'data' contains missing value. Mean-imputing them.", call. = FALSE)
     }
+
+    dat[] <- lapply(dat, function(v) {
+      if (is.numeric(v) && (ix <- length(which(is.na(v))))) {
+        v[ix] <- mean(v, na.rm = TRUE)
+      }
+      v
+    })
   }
+
   dat
 }
 #TODO: delete old function after verifying the new one (above) works
@@ -294,8 +299,10 @@ emm_basis.lavaan <- function(object,trms, xlev, grid, lavaan.DV, ...){
 
 ##' @keywords internal
 ##' @importFrom lavaan lavInspect
-.emlav_fake_fit <- function(object, lavaan.DV){
-  lavaan_data <- .emlav_recover_data(object)
+.emlav_fake_fit <- function(object, lavaan.DV, lavaan_data = NULL){
+  if (is.null(lavaan_data)) {
+    lavaan_data <- .emlav_recover_data(object, silent = TRUE)
+  }
 
   # Fake it
   pars <- lavaan::parameterEstimates(object)
@@ -544,17 +551,29 @@ grade ~ ageyr
   })
 
 
-  testthat::test_that("missing data - warn", {
-    utils::data("mtcars")
-    mtcars$hp[1] <- NA
+  testthat::test_that("missing data", {
+    data("mtcars")
+    raw_mtcars <- mtcars_na <- mtcars
+    mtcars_na$hp[1] <- NA
 
     model <- " mpg ~ hp + drat + hp:drat "
 
-    fit <- lavaan::sem(model, mtcars, missing = "fiml.x")
+    fit <- lavaan::sem(model, mtcars_na, missing = "fiml.x")
 
     testthat::expect_warning(
-      emmeans::ref_grid(fit, lavaan.DV = "mpg")
-    )
+      rg <- emmeans::ref_grid(fit, lavaan.DV = "mpg"),
+      regexp = "missing")
+
+    testthat::expect_false(anyNA(rg@grid))
+    testthat::expect_equal(rg@grid$hp, 147.871, tolerance = 0.01)
+
+
+    testthat::expect_warning(
+      rg2 <- emmeans::ref_grid(fit, lavaan.DV = "mpg",
+                               data = raw_mtcars),
+      regexp = NA)
+
+    testthat::expect_equal(rg2@grid$hp, mean(raw_mtcars$hp), tolerance = 0.01)
   })