Merge pull request #728 from anya-decarlo/master

Add fallback for lmer objects in pool() without requiring broom.mixed

Author: stefvanbuuren

R/summary.R

@@ -23,7 +23,29 @@ summary.mira <- function(object,
   type <- match.arg(type)
   fitlist <- getfit(object)
   if (type == "tidy") {
-    v <- lapply(fitlist, tidy, effects = "fixed", parametric = TRUE, ...) %>% bind_rows()
+    # Try standard tidy() first, with fallback for lmer objects
+    v <- tryCatch({
+      lapply(fitlist, tidy, effects = "fixed", parametric = TRUE, ...) %>% bind_rows()
+    }, error = function(e) {
+      # Check if this is an lmerMod object without broom.mixed
+      if (inherits(fitlist[[1]], "lmerMod") && 
+          grepl("No.*tidy.*method", e$message, ignore.case = TRUE)) {
+        # Manual extraction for lmer objects using built-in methods
+        lapply(fitlist, function(fit) {
+          coefs <- lme4::fixef(fit)
+          se <- sqrt(diag(as.matrix(stats::vcov(fit))))
+          data.frame(
+            term = names(coefs),
+            estimate = as.numeric(coefs),
+            std.error = as.numeric(se),
+            stringsAsFactors = FALSE
+          )
+        }) %>% bind_rows()
+      } else {
+        # Re-throw the error if it's not an lmer issue
+        stop(e)
+      }
+    })
   }
   if (type == "glance") {
     v <- lapply(fitlist, glance, ...) %>% bind_rows()

test_lmer_fix.R

@@ -0,0 +1,35 @@
+# Test script for lmer pooling fix
+# This tests whether pool() works with lmer objects without broom.mixed
+
+library(mice)
+library(lme4)
+
+# Create simple test data with missing values
+set.seed(123)
+n <- 100
+test_data <- data.frame(
+  id = rep(1:20, each = 5),
+  x = rnorm(n),
+  y = rnorm(n)
+)
+
+# Introduce some missingness
+test_data$y[sample(1:n, 20)] <- NA
+
+# Impute
+cat("Running imputation...\n")
+imp <- mice(test_data, m = 5, print = FALSE, seed = 456)
+
+# Fit mixed model
+cat("Fitting mixed models to imputed data...\n")
+fit <- with(imp, lmer(y ~ x + (1 | id)))
+
+# Try to pool - this should work now without broom.mixed!
+cat("\nAttempting to pool results (without broom.mixed)...\n")
+pooled <- pool(fit)
+
+cat("\n=== SUCCESS! ===\n")
+cat("Pooled results:\n")
+print(summary(pooled))
+
+cat("\n✅ The fix works! pool() can now handle lmer objects without broom.mixed\n")

test_verify_accuracy.R

@@ -0,0 +1,62 @@
+# Verification test: Compare our manual extraction vs broom.mixed
+# This proves we're getting the EXACT same numbers
+
+library(mice)
+library(lme4)
+
+# Create test data
+set.seed(123)
+n <- 100
+test_data <- data.frame(
+  id = rep(1:20, each = 5),
+  x = rnorm(n),
+  y = rnorm(n)
+)
+test_data$y[sample(1:n, 20)] <- NA
+
+# Impute
+cat("Running imputation...\n")
+imp <- mice(test_data, m = 5, print = FALSE, seed = 456)
+
+# Fit mixed model
+cat("Fitting mixed models...\n")
+fit <- with(imp, lmer(y ~ x + (1 | id)))
+
+cat("\n=== METHOD 1: Our Fix (without broom.mixed) ===\n")
+pooled_our_fix <- pool(fit)
+print(summary(pooled_our_fix))
+
+cat("\n=== METHOD 2: With broom.mixed (the old way) ===\n")
+library(broom.mixed)
+pooled_broom <- pool(fit)
+print(summary(pooled_broom))
+
+cat("\n=== COMPARISON ===\n")
+our_results <- summary(pooled_our_fix)
+broom_results <- summary(pooled_broom)
+
+cat("\nIntercept estimate difference:", 
+    abs(our_results$estimate[1] - broom_results$estimate[1]), "\n")
+cat("Intercept SE difference:", 
+    abs(our_results$std.error[1] - broom_results$std.error[1]), "\n")
+cat("x coefficient estimate difference:", 
+    abs(our_results$estimate[2] - broom_results$estimate[2]), "\n")
+cat("x coefficient SE difference:", 
+    abs(our_results$std.error[2] - broom_results$std.error[2]), "\n")
+
+# Check if they're identical (within floating point precision)
+if (all.equal(our_results$estimate, broom_results$estimate, tolerance = 1e-10) == TRUE &&
+    all.equal(our_results$std.error, broom_results$std.error, tolerance = 1e-10) == TRUE) {
+  cat("\n✅ PERFECT MATCH! Our fix produces IDENTICAL results to broom.mixed\n")
+  cat("We're not making up numbers - we're using the exact same math!\n")
+} else {
+  cat("\n❌ WARNING: Results differ!\n")
+}
+
+cat("\n=== MANUAL VERIFICATION ===\n")
+cat("Let's also manually check one imputation to prove the math:\n\n")
+single_fit <- getfit(fit, 1)
+cat("Manual fixef() extraction:\n")
+print(lme4::fixef(single_fit))
+cat("\nManual vcov() extraction (standard errors):\n")
+print(sqrt(diag(vcov(single_fit))))