From dddb52ccb0f67d1dd97c1c09dd40812abebc49b1 Mon Sep 17 00:00:00 2001 From: Jack Leary Date: Sat, 19 Oct 2024 09:51:46 -0400 Subject: [PATCH] fixed a bug in GLMM RE bootstrapper --- R/bootstrapRandomEffects.R | 19 +++++++++++++++++++ tests/testthat/test_scLANE.R | 8 ++++---- 2 files changed, 23 insertions(+), 4 deletions(-) diff --git a/R/bootstrapRandomEffects.R b/R/bootstrapRandomEffects.R index 2fdac60..b826e4d 100644 --- a/R/bootstrapRandomEffects.R +++ b/R/bootstrapRandomEffects.R @@ -113,10 +113,29 @@ bootstrapRandomEffects <- function(glmm.mod = NULL, parallel::stopCluster(cl) } }) + # clean up potential errors with warning + error_count <- 0 + ranef_boot <- purrr::map(ranef_boot, \(x) { + if (inherits(x, "simpleError")) { + error_df <- data.frame(iter = NA_real_, + subject = NA_character_, + term = NA_character_, + effect = NA_real_) + error_count <- error_count + 1 + return(error_df) + } else { + return(x) + } + }) + if (error_count > 0) { + warning(paste0(error_count, " bootstrap summaries failed, likely due to computationally singular effects matrices. Take caution.")) + } # summarize bootstrap resample lower_bound <- alpha / 2 upper_bound <- 1 - alpha / 2 ranef_sumy <- purrr::reduce(ranef_boot, rbind) %>% + as.data.frame() %>% + na.omit() %>% dplyr::with_groups(c(subject, term), dplyr::summarise, QL = stats::quantile(effect, probs = lower_bound), diff --git a/tests/testthat/test_scLANE.R b/tests/testthat/test_scLANE.R index 5478051..7bfee2e 100644 --- a/tests/testthat/test_scLANE.R +++ b/tests/testthat/test_scLANE.R @@ -136,7 +136,7 @@ withr::with_output_sink(tempfile(), { # run GEE Wald test wald_test <- waldTestGEE(marge_mod_GEE_offset, mod.0 = null_mod_GEE) # run GLMM model -- no offset - glmm_mod <- fitGLMM(X_pred = pt_test, + glmm_mod <- fitGLMM(pt_test, Y = counts_test[, 4], id.vec = sim_data$subject, adaptive = TRUE, @@ -144,14 +144,14 @@ withr::with_output_sink(tempfile(), { return.basis = TRUE, return.GCV = TRUE) # run GLMM model -- with offset - glmm_mod_offset <- fitGLMM(X_pred = pt_test, + glmm_mod_offset <- fitGLMM(pt_test, Y = counts_test[, 4], Y.offset = cell_offset, id.vec = sim_data$subject, adaptive = TRUE, M.glm = 3, return.basis = TRUE, - return.GCV = TRUE) + return.GCV = FALSE) # bootstrap GLMM random effects re_sumy <- bootstrapRandomEffects(glmm_mod_offset, id.vec = sim_data$subject, @@ -404,7 +404,7 @@ test_that("fitGLMM() output", { expect_equal(glmm_mod$model_type, "GLMM") expect_equal(glmm_mod_offset$model_type, "GLMM") expect_s3_class(re_sumy, "data.frame") - expect_equal(nrow(re_sumy), 6) + expect_equal(nrow(re_sumy), 4) expect_equal(ncol(re_sumy), 4) })