From 55f23c79eb1902c179ee01b666df5d089d6fee2e Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 06:26:17 +0100
Subject: [PATCH 01/46] Move code from `check_conv()` out into a stand-alone
 helper function

for checking the convergence of a single submodel fit (not of a whole `outdmin`
object).
---
 R/divergence_minimizers.R | 75 +++++++++++++++++++++------------------
 1 file changed, 40 insertions(+), 35 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 99b7184e9..6c53ae719 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -918,42 +918,9 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 
 # Convergence checker -----------------------------------------------------
 
+# For checking the convergence of a whole `outdmin` object:
 check_conv <- function(fit) {
-  is_conv <- unlist(lapply(fit, function(fit_s) {
-    if (inherits(fit_s, "gam")) {
-      # TODO (GAMs): There is also `fit_s$mgcv.conv` (see `?mgcv::gamObject`).
-      # Do we need to take this into account?
-      return(fit_s$converged)
-    } else if (inherits(fit_s, "gamm4")) {
-      # TODO (GAMMs): Needs to be implemented. Return `TRUE` for now.
-      return(TRUE)
-    } else if (inherits(fit_s, c("lmerMod", "glmerMod"))) {
-      # The following was inferred from the source code of lme4::checkConv() and
-      # lme4::.prt.warn() (see also `?lme4::mkMerMod`).
-      return(fit_s@optinfo$conv$opt == 0 && (
-        # Since lme4::.prt.warn() does not refer to `optinfo$conv$lme4$code`,
-        # that element might not always exist:
-        (!is.null(fit_s@optinfo$conv$lme4$code) &&
-           all(fit_s@optinfo$conv$lme4$code == 0)) ||
-          is.null(fit_s@optinfo$conv$lme4$code)
-      ) && length(unlist(fit_s@optinfo$conv$lme4$messages)) == 0 &&
-        length(fit_s@optinfo$warnings) == 0)
-    } else if (inherits(fit_s, "glm")) {
-      return(fit_s$converged)
-    } else if (inherits(fit_s, "lm")) {
-      # Note: There doesn't seem to be a better way to check for convergence
-      # other than checking `NA` coefficients (see below).
-      return(all(!is.na(coef(fit_s))))
-    } else if (inherits(fit_s, "subfit")) {
-      # Note: There doesn't seem to be any way to check for convergence, so
-      # return `TRUE` for now.
-      # TODO (GLMs with ridge regularization): Add a logical indicating
-      # convergence to objects of class `subfit` (i.e., from glm_ridge())?
-      return(TRUE)
-    } else {
-      stop("Unrecognized submodel fit. Please notify the package maintainer.")
-    }
-  }))
+  is_conv <- unlist(lapply(fit, check_conv_s))
   if (any(!is_conv)) {
     warning(sum(!is_conv), " out of ", length(is_conv), " submodel fits ",
             "(there is one submodel fit per projected draw) probably have not ",
@@ -965,6 +932,44 @@ check_conv <- function(fit) {
   return(invisible(TRUE))
 }
 
+# Helper function for checking the convergence of a single submodel fit (not of
+# a whole `outdmin` object):
+check_conv_s <- function(fit_s) {
+  if (inherits(fit_s, "gam")) {
+    # TODO (GAMs): There is also `fit_s$mgcv.conv` (see `?mgcv::gamObject`).
+    # Do we need to take this into account?
+    return(fit_s$converged)
+  } else if (inherits(fit_s, "gamm4")) {
+    # TODO (GAMMs): Needs to be implemented. Return `TRUE` for now.
+    return(TRUE)
+  } else if (inherits(fit_s, c("lmerMod", "glmerMod"))) {
+    # The following was inferred from the source code of lme4::checkConv() and
+    # lme4::.prt.warn() (see also `?lme4::mkMerMod`).
+    return(fit_s@optinfo$conv$opt == 0 && (
+      # Since lme4::.prt.warn() does not refer to `optinfo$conv$lme4$code`,
+      # that element might not always exist:
+      (!is.null(fit_s@optinfo$conv$lme4$code) &&
+         all(fit_s@optinfo$conv$lme4$code == 0)) ||
+        is.null(fit_s@optinfo$conv$lme4$code)
+    ) && length(unlist(fit_s@optinfo$conv$lme4$messages)) == 0 &&
+      length(fit_s@optinfo$warnings) == 0)
+  } else if (inherits(fit_s, "glm")) {
+    return(fit_s$converged)
+  } else if (inherits(fit_s, "lm")) {
+    # Note: There doesn't seem to be a better way to check for convergence
+    # other than checking `NA` coefficients (see below).
+    return(all(!is.na(coef(fit_s))))
+  } else if (inherits(fit_s, "subfit")) {
+    # Note: There doesn't seem to be any way to check for convergence, so
+    # return `TRUE` for now.
+    # TODO (GLMs with ridge regularization): Add a logical indicating
+    # convergence to objects of class `subfit` (i.e., from glm_ridge())?
+    return(TRUE)
+  } else {
+    stop("Unrecognized submodel fit. Please notify the package maintainer.")
+  }
+}
+
 # Prediction functions for submodels --------------------------------------
 
 subprd <- function(fits, newdata) {

From 2cf3db9e121196d63ee4e964ac94834806709acd Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 07:56:54 +0100
Subject: [PATCH 02/46] Make the `check_conv()` warning more general.

---
 R/divergence_minimizers.R | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 6c53ae719..2e8efb04e 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -922,12 +922,15 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 check_conv <- function(fit) {
   is_conv <- unlist(lapply(fit, check_conv_s))
   if (any(!is_conv)) {
-    warning(sum(!is_conv), " out of ", length(is_conv), " submodel fits ",
-            "(there is one submodel fit per projected draw) probably have not ",
-            "converged (appropriately). It is recommended to inspect this in ",
-            "detail and (if necessary) to adjust lme4's tuning parameters via ",
-            "`...` or via a custom `divergence_minimizer` function. ",
-            "Formula (right-hand side): ", update(formula(fit[[1]]), NULL ~ .))
+    warning(
+      sum(!is_conv), " out of ", length(is_conv), " submodel fits (there is ",
+      "one submodel fit per projected draw) probably have not converged ",
+      "(appropriately). It is recommended to inspect this in detail and (if ",
+      "necessary) to adjust tuning parameters (e.g., for the lme4 package in ",
+      "case of a multilevel submodel) via `...` or via a custom ",
+      "`divergence_minimizer` function. Formula (right-hand side): ",
+      update(formula(fit[[1]]), NULL ~ .)
+    )
   }
   return(invisible(TRUE))
 }

From 3a2c8a356fb9d16f8edb07c8552573250f8fe9bc Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 12:41:08 +0100
Subject: [PATCH 03/46] Fix a comment in `check_conv_s()`.

---
 R/divergence_minimizers.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 2e8efb04e..7653a82b3 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -959,8 +959,8 @@ check_conv_s <- function(fit_s) {
   } else if (inherits(fit_s, "glm")) {
     return(fit_s$converged)
   } else if (inherits(fit_s, "lm")) {
-    # Note: There doesn't seem to be a better way to check for convergence
-    # other than checking `NA` coefficients (see below).
+    # There doesn't seem to be a better way to check for convergence other than
+    # checking `NA` coefficients:
     return(all(!is.na(coef(fit_s))))
   } else if (inherits(fit_s, "subfit")) {
     # Note: There doesn't seem to be any way to check for convergence, so

From b41a4f09015084d8b19c8e7e3c0e8b7e6fedb878 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 08:02:22 +0100
Subject: [PATCH 04/46] Enhance `check_conv_s()` in case of an additive
 multilevel (GAMM) submodel.

---
 R/divergence_minimizers.R | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 7653a82b3..04181f722 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -943,8 +943,11 @@ check_conv_s <- function(fit_s) {
     # Do we need to take this into account?
     return(fit_s$converged)
   } else if (inherits(fit_s, "gamm4")) {
-    # TODO (GAMMs): Needs to be implemented. Return `TRUE` for now.
-    return(TRUE)
+    # TODO (GAMMs): I couldn't find any convergence-related information in
+    # element `fit_s$gam`, so the GAM part is currently not checked for
+    # convergence. For now, all we can check is the GLMM part from element
+    # `fit_s$mer`:
+    return(check_conv_s(fit_s$mer))
   } else if (inherits(fit_s, c("lmerMod", "glmerMod"))) {
     # The following was inferred from the source code of lme4::checkConv() and
     # lme4::.prt.warn() (see also `?lme4::mkMerMod`).

From 77b51834dae8eed8fe0e5d506b2f30acc77abcfb Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 08:08:21 +0100
Subject: [PATCH 05/46] Enhance `check_conv_s()` in case of an additive (GAM)
 submodel.

---
 R/divergence_minimizers.R | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 04181f722..c9e18db53 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -939,9 +939,8 @@ check_conv <- function(fit) {
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
   if (inherits(fit_s, "gam")) {
-    # TODO (GAMs): There is also `fit_s$mgcv.conv` (see `?mgcv::gamObject`).
-    # Do we need to take this into account?
-    return(fit_s$converged)
+    # TODO (GAMs): Is this correct?:
+    return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
   } else if (inherits(fit_s, "gamm4")) {
     # TODO (GAMMs): I couldn't find any convergence-related information in
     # element `fit_s$gam`, so the GAM part is currently not checked for

From 40b303af0e9c9c52203a0aad8c87437570910add Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 11:07:07 +0100
Subject: [PATCH 06/46] Turn the `stdout()` output from `glm_ridge()` and
 `glm_elnet()` into warnings.

---
 R/divergence_minimizers.R | 16 +++++++++++-----
 R/search.R                | 20 ++++++++++++--------
 2 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index c9e18db53..097907acb 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -142,11 +142,17 @@ fit_glm_ridge_callback <- function(formula, data,
     methods::formalArgs(glm_ridge)
   )]
   # Call the submodel fitter:
-  fit <- do.call(glm_ridge, c(
-    list(x = x, y = y, obsvar = projpred_var, lambda = regul,
-         thresh = thresh_conv),
-    dot_args
-  ))
+  out_capt <- utils::capture.output(
+    fit <- do.call(glm_ridge, c(
+      list(x = x, y = y, obsvar = projpred_var, lambda = regul,
+           thresh = thresh_conv),
+      dot_args
+    ))
+  )
+  out_capt <- grep("[Ww]arning|bug", out_capt, value = TRUE)
+  if (length(out_capt) > 0) {
+    warning(paste(out_capt, collapse = "\n"))
+  }
   # Post-processing:
   rownames(fit$beta) <- colnames(x)
   sub <- nlist(alpha = fit$beta0, beta = fit$beta, w = fit$w, formula, x, y,
diff --git a/R/search.R b/R/search.R
index d879206d1..5a2b973f3 100644
--- a/R/search.R
+++ b/R/search.R
@@ -212,15 +212,19 @@ search_L1_surrogate <- function(p_ref, d_train, family, intercept, nterms_max,
   ## (Notice: here we use pmax = nterms_max+1 so that the computation gets
   ## carried until all the way down to the least regularization also for model
   ## size nterms_max)
-  search <- glm_elnet(
-    d_train$x, mu, family,
-    lambda_min_ratio = search_control$lambda_min_ratio %||% 1e-5,
-    nlambda = search_control$nlambda %||% 150,
-    pmax = nterms_max + 1, pmax_strict = FALSE,
-    weights = d_train$weights,
-    intercept = intercept, obsvar = v, penalty = penalty,
-    thresh = search_control$thresh %||% 1e-6
+  out_capt <- utils::capture.output(
+    search <- glm_elnet(
+      d_train$x, mu, family,
+      lambda_min_ratio = search_control$lambda_min_ratio %||% 1e-5,
+      nlambda = search_control$nlambda %||% 150, pmax = nterms_max + 1,
+      pmax_strict = FALSE, weights = d_train$weights, intercept = intercept,
+      obsvar = v, penalty = penalty, thresh = search_control$thresh %||% 1e-6
+    )
   )
+  out_capt <- grep("[Ww]arning|bug", out_capt, value = TRUE)
+  if (length(out_capt) > 0) {
+    warning(paste(out_capt, collapse = "\n"))
+  }
 
   ## sort the variables according to the order in which they enter the model in
   ## the L1-path

From ffe961bca01ed9ee17f75ce6599fab105c5b3422 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 14 Nov 2023 21:44:34 +0100
Subject: [PATCH 07/46] Use `capt_mssgs_warns()` in `divmin()`.

---
 R/divergence_minimizers.R | 207 ++++++++++++++++++--------------------
 1 file changed, 98 insertions(+), 109 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 097907acb..153be5ce5 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -65,18 +65,21 @@ divmin <- function(
                                   initial = 0)
       on.exit(close(pb))
     }
-    return(lapply(seq_along(formulas), function(s) {
+    outdmin <- lapply(seq_along(formulas), function(s) {
       if (verbose_divmin) {
         on.exit(utils::setTxtProgressBar(pb, s))
       }
-      sdivmin(
-        formula = formulas[[s]],
-        projpred_var = projpred_var[, s, drop = FALSE],
-        projpred_formula_no_random = projpred_formulas_no_random[[s]],
-        projpred_random = projpred_random,
-        ...
+      mssgs_warns_capt <- capt_mssgs_warns(
+        soutdmin <- sdivmin(
+          formula = formulas[[s]],
+          projpred_var = projpred_var[, s, drop = FALSE],
+          projpred_formula_no_random = projpred_formulas_no_random[[s]],
+          projpred_random = projpred_random,
+          ...
+        )
       )
-    }))
+      return(nlist(soutdmin, mssgs_warns_capt))
+    })
   } else {
     # Parallel case.
     if (!requireNamespace("foreach", quietly = TRUE)) {
@@ -87,7 +90,7 @@ divmin <- function(
     }
     dot_args <- list(...)
     `%do_projpred%` <- foreach::`%dopar%`
-    return(foreach::foreach(
+    outdmin <- foreach::foreach(
       formula_s = formulas,
       projpred_var_s = iterators::iter(projpred_var, by = "column"),
       projpred_formula_no_random_s = projpred_formulas_no_random,
@@ -97,16 +100,40 @@ divmin <- function(
         "projpred_var", "projpred_formulas_no_random"
       )
     ) %do_projpred% {
-      do.call(
-        sdivmin,
-        c(list(formula = formula_s,
-               projpred_var = projpred_var_s,
-               projpred_formula_no_random = projpred_formula_no_random_s,
-               projpred_random = projpred_random),
-          dot_args)
+      mssgs_warns_capt <- capt_mssgs_warns(
+        soutdmin <- do.call(
+          sdivmin,
+          c(list(formula = formula_s,
+                 projpred_var = projpred_var_s,
+                 projpred_formula_no_random = projpred_formula_no_random_s,
+                 projpred_random = projpred_random),
+            dot_args)
+        )
       )
-    })
+      return(nlist(soutdmin, mssgs_warns_capt))
+    }
   }
+  mssgs_warns_capts <- unlist(lapply(outdmin, "[[", "mssgs_warns_capt"))
+  outdmin <- lapply(outdmin, "[[", "soutdmin")
+  # Filter out some warnings:
+  mssgs_warns_capts <- setdiff(mssgs_warns_capts, "")
+  mssgs_warns_capts <- grep("Warning in .*:$", mssgs_warns_capts, value = TRUE,
+                            invert = TRUE)
+  mssgs_warns_capts <- grep("non-integer #successes in a binomial glm!$",
+                            mssgs_warns_capts, value = TRUE, invert = TRUE)
+  mssgs_warns_capts <- grep(paste("Using formula\\(x\\) is deprecated when x",
+                                  "is a character vector of length > 1\\.$"),
+                            mssgs_warns_capts, value = TRUE, invert = TRUE)
+  mssgs_warns_capts <- grep(
+    "Consider formula\\(paste\\(x, collapse = .*\\)\\) instead\\.$",
+    mssgs_warns_capts, value = TRUE, invert = TRUE
+  )
+  mssgs_warns_capts <- unique(mssgs_warns_capts)
+  if (length(mssgs_warns_capts) > 0 &&
+      getOption("projpred.warn_submodel_fits", TRUE)) {
+    warning(mssgs_warns_capts)
+  }
+  return(outdmin)
 }
 
 # Use projpred's own implementation to fit non-multilevel non-additive
@@ -175,10 +202,7 @@ fit_glm_callback <- function(formula, family, ...) {
         methods::formalArgs(stats::lm.wfit))
     )]
     # Call the submodel fitter:
-    return(suppressMessages(suppressWarnings(do.call(stats::lm, c(
-      list(formula = formula),
-      dot_args
-    )))))
+    return(do.call(stats::lm, c(list(formula = formula), dot_args)))
   } else {
     # Exclude arguments from `...` which cannot be passed to stats::glm():
     dot_args <- list(...)
@@ -188,10 +212,8 @@ fit_glm_callback <- function(formula, family, ...) {
         methods::formalArgs(stats::glm.control))
     )]
     # Call the submodel fitter:
-    return(suppressMessages(suppressWarnings(do.call(stats::glm, c(
-      list(formula = formula, family = family),
-      dot_args
-    )))))
+    return(do.call(stats::glm, c(list(formula = formula, family = family),
+                                 dot_args)))
   }
 }
 
@@ -205,10 +227,7 @@ fit_gam_callback <- function(formula, ...) {
       methods::formalArgs(mgcv::gam.fit))
   )]
   # Call the submodel fitter:
-  return(suppressMessages(suppressWarnings(do.call(mgcv::gam, c(
-    list(formula = formula),
-    dot_args
-  )))))
+  return(do.call(mgcv::gam, c(list(formula = formula), dot_args)))
 }
 
 # Use package "gamm4" to fit additive multilevel submodels:
@@ -225,11 +244,11 @@ fit_gamm_callback <- function(formula, projpred_formula_no_random,
   )]
   # Call the submodel fitter:
   fit <- tryCatch({
-    suppressMessages(suppressWarnings(do.call(gamm4::gamm4, c(
+    do.call(gamm4::gamm4, c(
       list(formula = projpred_formula_no_random, random = projpred_random,
            data = data, family = family, control = control),
       dot_args
-    ))))
+    ))
   }, error = function(e) {
     if (grepl("not positive definite", as.character(e))) {
       if ("optimx" %in% control$optimizer &&
@@ -334,11 +353,11 @@ fit_glmer_callback <- function(formula, projpred_formula_no_random,
         stop("Unexpected length of `random_fmls`.")
       }
       # Call the submodel fitter:
-      return(suppressMessages(suppressWarnings(do.call(MASS::glmmPQL, c(
+      return(do.call(MASS::glmmPQL, c(
         list(fixed = projpred_formula_no_random, random = random_fmls,
              family = family, control = control),
         dot_args
-      )))))
+      )))
     } else if (family$family == "gaussian" && family$link == "identity" &&
                getOption("projpred.gaussian_not_as_generalized", TRUE)) {
       # Exclude arguments from `...` which cannot be passed to lme4::lmer():
@@ -348,10 +367,8 @@ fit_glmer_callback <- function(formula, projpred_formula_no_random,
         methods::formalArgs(lme4::lmer)
       )]
       # Call the submodel fitter:
-      return(suppressMessages(suppressWarnings(do.call(lme4::lmer, c(
-        list(formula = formula, control = control),
-        dot_args
-      )))))
+      return(do.call(lme4::lmer, c(list(formula = formula, control = control),
+                                   dot_args)))
     } else {
       # Exclude arguments from `...` which cannot be passed to lme4::glmer():
       dot_args <- list(...)
@@ -360,10 +377,9 @@ fit_glmer_callback <- function(formula, projpred_formula_no_random,
         methods::formalArgs(lme4::glmer)
       )]
       # Call the submodel fitter:
-      return(suppressMessages(suppressWarnings(do.call(lme4::glmer, c(
-        list(formula = formula, family = family, control = control),
-        dot_args
-      )))))
+      return(do.call(lme4::glmer, c(list(formula = formula, family = family,
+                                         control = control),
+                                    dot_args)))
     }
   }, error = function(e) {
     if (grepl("No random effects", as.character(e))) {
@@ -673,21 +689,15 @@ fit_cumul <- function(formula, data, family, weights, ...) {
   } else if (link_nm == "probit_approx") {
     link_nm <- "probit"
   }
-  # For catching warnings via capture.output() (which is necessary to filter out
-  # the warning "non-integer #successes in a binomial glm!"):
-  warn_orig <- options(warn = 1)
   # Call the submodel fitter:
-  warn_capt <- utils::capture.output({
-    fitobj <- try(do.call(MASS::polr, c(
-      list(formula = formula,
-           data = data,
-           weights = quote(projpred_internal_w_aug),
-           model = FALSE,
-           method = link_nm),
-      dot_args
-    )), silent = TRUE)
-  }, type = "message")
-  options(warn_orig)
+  fitobj <- try(do.call(MASS::polr, c(
+    list(formula = formula,
+         data = data,
+         weights = quote(projpred_internal_w_aug),
+         model = FALSE,
+         method = link_nm),
+    dot_args
+  )), silent = TRUE)
   if (inherits(fitobj, "try-error") &&
       grepl(paste("initial value in 'vmmin' is not finite",
                   "attempt to find suitable starting values failed",
@@ -706,29 +716,19 @@ fit_cumul <- function(formula, data, family, weights, ...) {
     # Start with thresholds which imply equal probabilities for the response
     # categories:
     start_thres <- linkfun_raw(seq_len(nthres) / ncats, link_nm = link_nm)
-    warn_orig <- options(warn = 1)
-    warn_capt <- utils::capture.output({
-      fitobj <- try(do.call(MASS::polr, c(
-        list(formula = formula,
-             data = data,
-             weights = quote(projpred_internal_w_aug),
-             model = FALSE,
-             method = link_nm,
-             start = c(start_coefs, start_thres)),
-        dot_args
-      )), silent = TRUE)
-    }, type = "message")
-    options(warn_orig)
+    fitobj <- try(do.call(MASS::polr, c(
+      list(formula = formula,
+           data = data,
+           weights = quote(projpred_internal_w_aug),
+           model = FALSE,
+           method = link_nm,
+           start = c(start_coefs, start_thres)),
+      dot_args
+    )), silent = TRUE)
   }
   if (inherits(fitobj, "try-error")) {
     stop(attr(fitobj, "condition")$message)
   }
-  warn_capt <- grep("Warning in .*:$", warn_capt, value = TRUE, invert = TRUE)
-  warn_capt <- grep("non-integer #successes in a binomial glm!$", warn_capt,
-                    value = TRUE, invert = TRUE)
-  if (length(warn_capt) > 0) {
-    warning(warn_capt)
-  }
   return(fitobj)
 }
 
@@ -767,39 +767,20 @@ fit_cumul_mlvl <- function(formula, data, family, weights, ...) {
   if (link_nm == "probit_approx") {
     link_nm <- "probit"
   }
-  # For catching warnings via capture.output() (which is necessary to filter out
-  # the warning "Using formula(x) is deprecated when x is a character vector of
-  # length > 1. [...]"):
-  warn_orig <- options(warn = 1)
   # Call the submodel fitter:
-  warn_capt <- utils::capture.output({
-    fitobj <- try(do.call(ordinal::clmm, c(
-      list(formula = formula,
-           data = data,
-           weights = quote(projpred_internal_w_aug),
-           contrasts = NULL,
-           Hess = FALSE,
-           model = FALSE,
-           link = link_nm),
-      dot_args
-    )), silent = TRUE)
-  }, type = "message")
-  options(warn_orig)
+  fitobj <- try(do.call(ordinal::clmm, c(
+    list(formula = formula,
+         data = data,
+         weights = quote(projpred_internal_w_aug),
+         contrasts = NULL,
+         Hess = FALSE,
+         model = FALSE,
+         link = link_nm),
+    dot_args
+  )), silent = TRUE)
   if (inherits(fitobj, "try-error")) {
     stop(attr(fitobj, "condition")$message)
   }
-  warn_capt <- grep(
-    paste("Using formula\\(x\\) is deprecated when x is a character vector of",
-          "length > 1\\.$"),
-    warn_capt, value = TRUE, invert = TRUE
-  )
-  warn_capt <- grep(
-    "Consider formula\\(paste\\(x, collapse = .*\\)\\) instead\\.$",
-    warn_capt, value = TRUE, invert = TRUE
-  )
-  if (length(warn_capt) > 0) {
-    warning(warn_capt)
-  }
   # Needed for the ordinal:::predict.clm() workaround (the value `"negative"` is
   # the default, see `?ordinal::clm.control`):
   fitobj$control$sign.location <- "negative"
@@ -839,16 +820,20 @@ fit_categ <- function(formula, data, family, weights, ...) {
     }
   }
   # Call the submodel fitter:
-  out_capt <- utils::capture.output({
+  out_capt <- utils::capture.output(
     fitobj <- do.call(nnet::multinom, c(
       list(formula = formula,
            data = data,
            weights = weights),
       dot_args
     ))
-  })
+  )
   if (utils::tail(out_capt, 1) != "converged") {
-    warning("The nnet::multinom() submodel fit did not converge.")
+    warning(
+      "Could not find the string \"converged\" at the end of the `stdout` ",
+      "output from the nnet::multinom() submodel fit, so perhaps this fitting ",
+      "procedure did not converge."
+    )
   }
   return(fitobj)
 }
@@ -903,7 +888,7 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
     random_fmls <- random_fmls[[1]]
   }
   # Call the submodel fitter:
-  out_capt <- utils::capture.output({
+  out_capt <- utils::capture.output(
     fitobj <- do.call(mclogit::mblogit, c(
       list(formula = projpred_formula_no_random,
            data = data,
@@ -915,9 +900,13 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
            method = "PQL"),
       dot_args
     ))
-  })
+  )
   if (utils::tail(out_capt, 1) != "converged") {
-    warning("The mclogit::mblogit() submodel fit did not converge.")
+    warning(
+      "Could not find the string \"converged\" at the end of the `stdout` ",
+      "output from the mclogit::mblogit() submodel fit, so perhaps this ",
+      "fitting procedure did not converge."
+    )
   }
   return(fitobj)
 }

From 3abb890d3bbe939c04ddff40c618a5c5a5103892 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 10:27:01 +0100
Subject: [PATCH 08/46] Throw warnings like `"Warning in foo() : some warning
 starting here:"`.

---
 R/divergence_minimizers.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 153be5ce5..68fd49019 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -117,8 +117,8 @@ divmin <- function(
   outdmin <- lapply(outdmin, "[[", "soutdmin")
   # Filter out some warnings:
   mssgs_warns_capts <- setdiff(mssgs_warns_capts, "")
-  mssgs_warns_capts <- grep("Warning in .*:$", mssgs_warns_capts, value = TRUE,
-                            invert = TRUE)
+  mssgs_warns_capts <- grep("Warning in [^:]*:$",
+                            mssgs_warns_capts, value = TRUE, invert = TRUE)
   mssgs_warns_capts <- grep("non-integer #successes in a binomial glm!$",
                             mssgs_warns_capts, value = TRUE, invert = TRUE)
   mssgs_warns_capts <- grep(paste("Using formula\\(x\\) is deprecated when x",

From 6ef0cbee13c1e7dd066b177a6088929fedfbdeca Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 06:02:30 +0100
Subject: [PATCH 09/46] Don't use `try()` where not necessary.

---
 R/divergence_minimizers.R | 14 +++++---------
 1 file changed, 5 insertions(+), 9 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 68fd49019..791b967ff 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -716,7 +716,7 @@ fit_cumul <- function(formula, data, family, weights, ...) {
     # Start with thresholds which imply equal probabilities for the response
     # categories:
     start_thres <- linkfun_raw(seq_len(nthres) / ncats, link_nm = link_nm)
-    fitobj <- try(do.call(MASS::polr, c(
+    fitobj <- do.call(MASS::polr, c(
       list(formula = formula,
            data = data,
            weights = quote(projpred_internal_w_aug),
@@ -724,9 +724,8 @@ fit_cumul <- function(formula, data, family, weights, ...) {
            method = link_nm,
            start = c(start_coefs, start_thres)),
       dot_args
-    )), silent = TRUE)
-  }
-  if (inherits(fitobj, "try-error")) {
+    ))
+  } else if (inherits(fitobj, "try-error")) {
     stop(attr(fitobj, "condition")$message)
   }
   return(fitobj)
@@ -768,7 +767,7 @@ fit_cumul_mlvl <- function(formula, data, family, weights, ...) {
     link_nm <- "probit"
   }
   # Call the submodel fitter:
-  fitobj <- try(do.call(ordinal::clmm, c(
+  fitobj <- do.call(ordinal::clmm, c(
     list(formula = formula,
          data = data,
          weights = quote(projpred_internal_w_aug),
@@ -777,10 +776,7 @@ fit_cumul_mlvl <- function(formula, data, family, weights, ...) {
          model = FALSE,
          link = link_nm),
     dot_args
-  )), silent = TRUE)
-  if (inherits(fitobj, "try-error")) {
-    stop(attr(fitobj, "condition")$message)
-  }
+  ))
   # Needed for the ordinal:::predict.clm() workaround (the value `"negative"` is
   # the default, see `?ordinal::clm.control`):
   fitobj$control$sign.location <- "negative"

From fdad1fdf6e3693d26aecead89b98e97e64b10214 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 12:10:38 +0100
Subject: [PATCH 10/46] Check messages and warnings on a draw-by-draw basis.

---
 R/divergence_minimizers.R | 33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 791b967ff..e25e07f69 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -113,22 +113,25 @@ divmin <- function(
       return(nlist(soutdmin, mssgs_warns_capt))
     }
   }
-  mssgs_warns_capts <- unlist(lapply(outdmin, "[[", "mssgs_warns_capt"))
+  mssgs_warns_capts <- lapply(outdmin, "[[", "mssgs_warns_capt")
   outdmin <- lapply(outdmin, "[[", "soutdmin")
-  # Filter out some warnings:
-  mssgs_warns_capts <- setdiff(mssgs_warns_capts, "")
-  mssgs_warns_capts <- grep("Warning in [^:]*:$",
-                            mssgs_warns_capts, value = TRUE, invert = TRUE)
-  mssgs_warns_capts <- grep("non-integer #successes in a binomial glm!$",
-                            mssgs_warns_capts, value = TRUE, invert = TRUE)
-  mssgs_warns_capts <- grep(paste("Using formula\\(x\\) is deprecated when x",
-                                  "is a character vector of length > 1\\.$"),
-                            mssgs_warns_capts, value = TRUE, invert = TRUE)
-  mssgs_warns_capts <- grep(
-    "Consider formula\\(paste\\(x, collapse = .*\\)\\) instead\\.$",
-    mssgs_warns_capts, value = TRUE, invert = TRUE
-  )
-  mssgs_warns_capts <- unique(mssgs_warns_capts)
+  mssgs_warns_capts <- lapply(mssgs_warns_capts, function(mssgs_warns_capt) {
+    # Filter out some warnings:
+    mssgs_warns_capt <- setdiff(mssgs_warns_capt, "")
+    mssgs_warns_capt <- grep("Warning in [^:]*:$",
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    mssgs_warns_capt <- grep("non-integer #successes in a binomial glm!$",
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    mssgs_warns_capt <- grep(paste("Using formula\\(x\\) is deprecated when x",
+                                   "is a character vector of length > 1\\.$"),
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    mssgs_warns_capt <- grep(
+      "Consider formula\\(paste\\(x, collapse = .*\\)\\) instead\\.$",
+      mssgs_warns_capt, value = TRUE, invert = TRUE
+    )
+    return(mssgs_warns_capt)
+  })
+  mssgs_warns_capts <- unique(unlist(mssgs_warns_capts))
   if (length(mssgs_warns_capts) > 0 &&
       getOption("projpred.warn_submodel_fits", TRUE)) {
     warning(mssgs_warns_capts)

From 71bda6dc1e51966bf9c0615d89a02b00e5243523 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 12:41:08 +0100
Subject: [PATCH 11/46] Allow re-use of object `mssgs_warns_capts` and enhance
 the warning

thrown in case of global option `projpred.warn_submodel_fits` set to `TRUE`.
---
 R/divergence_minimizers.R | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index e25e07f69..a28bcba94 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -115,8 +115,8 @@ divmin <- function(
   }
   mssgs_warns_capts <- lapply(outdmin, "[[", "mssgs_warns_capt")
   outdmin <- lapply(outdmin, "[[", "soutdmin")
+  # Filter out some warnings:
   mssgs_warns_capts <- lapply(mssgs_warns_capts, function(mssgs_warns_capt) {
-    # Filter out some warnings:
     mssgs_warns_capt <- setdiff(mssgs_warns_capt, "")
     mssgs_warns_capt <- grep("Warning in [^:]*:$",
                              mssgs_warns_capt, value = TRUE, invert = TRUE)
@@ -131,10 +131,16 @@ divmin <- function(
     )
     return(mssgs_warns_capt)
   })
-  mssgs_warns_capts <- unique(unlist(mssgs_warns_capts))
-  if (length(mssgs_warns_capts) > 0 &&
-      getOption("projpred.warn_submodel_fits", TRUE)) {
-    warning(mssgs_warns_capts)
+  # Throw the unique set of messages and warnings:
+  if (getOption("projpred.warn_submodel_fits", TRUE)) {
+    mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
+    if (length(mssgs_warns_capts_unq) > 0) {
+      warning(paste(
+        c("The following warnings have been thrown by submodel fitters:",
+          mssgs_warns_capts_unq),
+        collapse = "\n"
+      ))
+    }
   }
   return(outdmin)
 }

From c5cf96aeee7d662eb238c53ba6c41f707ae515e3 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 12:42:10 +0100
Subject: [PATCH 12/46] `check_conv_s()`: Turn the error (in case of an
 unrecognized submodel fit) to a warning

(to avoid that this causes an error; the code should still run through).
---
 R/divergence_minimizers.R | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index a28bcba94..68fdf1a66 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -971,7 +971,8 @@ check_conv_s <- function(fit_s) {
     # convergence to objects of class `subfit` (i.e., from glm_ridge())?
     return(TRUE)
   } else {
-    stop("Unrecognized submodel fit. Please notify the package maintainer.")
+    warning("Unrecognized submodel fit. Please notify the package maintainer.")
+    return(TRUE)
   }
 }
 

From f13f17797e21cc8c76e6333524c019e7c572f962 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 15:20:24 +0100
Subject: [PATCH 13/46] Use a default of `TRUE` for global option
 `projpred.check_conv`.

---
 R/projfun.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/projfun.R b/R/projfun.R
index d967eb9fb..4fed8a505 100644
--- a/R/projfun.R
+++ b/R/projfun.R
@@ -39,7 +39,7 @@ proj_to_submodl <- function(predictor_terms, p_ref, refmodel,
   }
   outdmin <- do.call(refmodel$div_minimizer, args_divmin)
 
-  if (isTRUE(getOption("projpred.check_conv", FALSE))) {
+  if (getOption("projpred.check_conv", TRUE)) {
     check_conv(outdmin)
   }
 

From 3efdd68a090693cb6f9d5dd5a6de12470058f6b1 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 12:41:08 +0100
Subject: [PATCH 14/46] Move the `check_conv()` call to `divmin()`.

---
 R/divergence_minimizers.R | 11 ++++++++---
 R/projfun.R               |  4 ----
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 68fdf1a66..cd07b9508 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -142,6 +142,10 @@ divmin <- function(
       ))
     }
   }
+  # Check convergence (also taking messages and warnings into account):
+  if (getOption("projpred.check_conv", TRUE)) {
+    check_conv(outdmin, lengths(mssgs_warns_capts))
+  }
   return(outdmin)
 }
 
@@ -919,8 +923,9 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 # Convergence checker -----------------------------------------------------
 
 # For checking the convergence of a whole `outdmin` object:
-check_conv <- function(fit) {
-  is_conv <- unlist(lapply(fit, check_conv_s))
+check_conv <- function(outdmin, lengths_mssgs_warns) {
+  is_conv <- unlist(lapply(outdmin, check_conv_s))
+  is_conv <- is_conv & (lengths_mssgs_warns == 0)
   if (any(!is_conv)) {
     warning(
       sum(!is_conv), " out of ", length(is_conv), " submodel fits (there is ",
@@ -929,7 +934,7 @@ check_conv <- function(fit) {
       "necessary) to adjust tuning parameters (e.g., for the lme4 package in ",
       "case of a multilevel submodel) via `...` or via a custom ",
       "`divergence_minimizer` function. Formula (right-hand side): ",
-      update(formula(fit[[1]]), NULL ~ .)
+      update(formula(outdmin[[1]]), NULL ~ .)
     )
   }
   return(invisible(TRUE))
diff --git a/R/projfun.R b/R/projfun.R
index 4fed8a505..998f1d6b7 100644
--- a/R/projfun.R
+++ b/R/projfun.R
@@ -39,10 +39,6 @@ proj_to_submodl <- function(predictor_terms, p_ref, refmodel,
   }
   outdmin <- do.call(refmodel$div_minimizer, args_divmin)
 
-  if (getOption("projpred.check_conv", TRUE)) {
-    check_conv(outdmin)
-  }
-
   return(init_submodl(
     outdmin = outdmin, p_ref = p_ref, refmodel = refmodel,
     predictor_terms = predictor_terms, wobs = refmodel$wobs

From 5e95b72efda6424407188f558e5dc6099ba460f1 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 13:28:33 +0100
Subject: [PATCH 15/46] Move option `projpred.check_conv` into `check_conv()`.

---
 R/divergence_minimizers.R | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index cd07b9508..f76c08646 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -143,9 +143,7 @@ divmin <- function(
     }
   }
   # Check convergence (also taking messages and warnings into account):
-  if (getOption("projpred.check_conv", TRUE)) {
-    check_conv(outdmin, lengths(mssgs_warns_capts))
-  }
+  check_conv(outdmin, lengths(mssgs_warns_capts))
   return(outdmin)
 }
 
@@ -924,6 +922,7 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 
 # For checking the convergence of a whole `outdmin` object:
 check_conv <- function(outdmin, lengths_mssgs_warns) {
+  if (!getOption("projpred.check_conv", TRUE)) return()
   is_conv <- unlist(lapply(outdmin, check_conv_s))
   is_conv <- is_conv & (lengths_mssgs_warns == 0)
   if (any(!is_conv)) {

From 7e21049c1f2aef049de29b1145d520ef946b06c8 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 13:28:50 +0100
Subject: [PATCH 16/46] Return `NULL` consistently (see `warn_pareto()`).

---
 R/divergence_minimizers.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index f76c08646..92c0da580 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -936,7 +936,7 @@ check_conv <- function(outdmin, lengths_mssgs_warns) {
       update(formula(outdmin[[1]]), NULL ~ .)
     )
   }
-  return(invisible(TRUE))
+  return()
 }
 
 # Helper function for checking the convergence of a single submodel fit (not of

From f8b42db97cd56e0b1c9a578eae90f54c22bbae0c Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 13:31:48 +0100
Subject: [PATCH 17/46] Create function `warn_submodel_fits()`.

---
 R/divergence_minimizers.R | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 92c0da580..bc67acdfa 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -132,16 +132,7 @@ divmin <- function(
     return(mssgs_warns_capt)
   })
   # Throw the unique set of messages and warnings:
-  if (getOption("projpred.warn_submodel_fits", TRUE)) {
-    mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
-    if (length(mssgs_warns_capts_unq) > 0) {
-      warning(paste(
-        c("The following warnings have been thrown by submodel fitters:",
-          mssgs_warns_capts_unq),
-        collapse = "\n"
-      ))
-    }
-  }
+  warn_submodel_fits(mssgs_warns_capts)
   # Check convergence (also taking messages and warnings into account):
   check_conv(outdmin, lengths(mssgs_warns_capts))
   return(outdmin)
@@ -918,7 +909,20 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
   return(fitobj)
 }
 
-# Convergence checker -----------------------------------------------------
+# Convergence issues ------------------------------------------------------
+
+warn_submodel_fits <- function(mssgs_warns_capts) {
+  if (!getOption("projpred.warn_submodel_fits", TRUE)) return()
+  mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
+  if (length(mssgs_warns_capts_unq) > 0) {
+    warning(paste(
+      c("The following warnings have been thrown by submodel fitters:", "---",
+        mssgs_warns_capts_unq, "---"),
+      collapse = "\n"
+    ))
+  }
+  return()
+}
 
 # For checking the convergence of a whole `outdmin` object:
 check_conv <- function(outdmin, lengths_mssgs_warns) {

From b86982cb83d1b3a2cbcb6bf2ff45ed5126b53a66 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 14:09:42 +0100
Subject: [PATCH 18/46] Add local arguments corresponding to global options
 `projpred.warn_submodel_fits` and `projpred.check_conv`

(these local arguments can be passed to top-level functions like `varsel()`,
`cv_varsel()`, and `project()`).
---
 R/divergence_minimizers.R | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index bc67acdfa..042609147 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -13,6 +13,8 @@ divmin <- function(
     formula,
     projpred_var,
     verbose_divmin = getOption("projpred.verbose_project", FALSE),
+    throw_warn_sdivmin = getOption("projpred.warn_submodel_fits", TRUE),
+    do_check_conv = getOption("projpred.check_conv", TRUE),
     ...
 ) {
   trms_all <- extract_terms_response(formula)
@@ -132,9 +134,9 @@ divmin <- function(
     return(mssgs_warns_capt)
   })
   # Throw the unique set of messages and warnings:
-  warn_submodel_fits(mssgs_warns_capts)
+  warn_submodel_fits(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
   # Check convergence (also taking messages and warnings into account):
-  check_conv(outdmin, lengths(mssgs_warns_capts))
+  check_conv(outdmin, lengths(mssgs_warns_capts), do_check = do_check_conv)
   return(outdmin)
 }
 
@@ -911,8 +913,8 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 
 # Convergence issues ------------------------------------------------------
 
-warn_submodel_fits <- function(mssgs_warns_capts) {
-  if (!getOption("projpred.warn_submodel_fits", TRUE)) return()
+warn_submodel_fits <- function(mssgs_warns_capts, throw_warn = TRUE) {
+  if (!throw_warn) return()
   mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
   if (length(mssgs_warns_capts_unq) > 0) {
     warning(paste(
@@ -925,8 +927,8 @@ warn_submodel_fits <- function(mssgs_warns_capts) {
 }
 
 # For checking the convergence of a whole `outdmin` object:
-check_conv <- function(outdmin, lengths_mssgs_warns) {
-  if (!getOption("projpred.check_conv", TRUE)) return()
+check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
+  if (!do_check) return()
   is_conv <- unlist(lapply(outdmin, check_conv_s))
   is_conv <- is_conv & (lengths_mssgs_warns == 0)
   if (any(!is_conv)) {

From 9fd72c7355818e49e656ae686f9961b886d4989a Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 15:23:10 +0100
Subject: [PATCH 19/46] Adapt `divmin_augdat()` analogously to `divmin()`.

---
 R/divergence_minimizers.R | 97 +++++++++++++++++++++++----------------
 1 file changed, 57 insertions(+), 40 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 042609147..b55146c59 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -117,25 +117,7 @@ divmin <- function(
   }
   mssgs_warns_capts <- lapply(outdmin, "[[", "mssgs_warns_capt")
   outdmin <- lapply(outdmin, "[[", "soutdmin")
-  # Filter out some warnings:
-  mssgs_warns_capts <- lapply(mssgs_warns_capts, function(mssgs_warns_capt) {
-    mssgs_warns_capt <- setdiff(mssgs_warns_capt, "")
-    mssgs_warns_capt <- grep("Warning in [^:]*:$",
-                             mssgs_warns_capt, value = TRUE, invert = TRUE)
-    mssgs_warns_capt <- grep("non-integer #successes in a binomial glm!$",
-                             mssgs_warns_capt, value = TRUE, invert = TRUE)
-    mssgs_warns_capt <- grep(paste("Using formula\\(x\\) is deprecated when x",
-                                   "is a character vector of length > 1\\.$"),
-                             mssgs_warns_capt, value = TRUE, invert = TRUE)
-    mssgs_warns_capt <- grep(
-      "Consider formula\\(paste\\(x, collapse = .*\\)\\) instead\\.$",
-      mssgs_warns_capt, value = TRUE, invert = TRUE
-    )
-    return(mssgs_warns_capt)
-  })
-  # Throw the unique set of messages and warnings:
   warn_submodel_fits(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
-  # Check convergence (also taking messages and warnings into account):
   check_conv(outdmin, lengths(mssgs_warns_capts), do_check = do_check_conv)
   return(outdmin)
 }
@@ -556,6 +538,8 @@ divmin_augdat <- function(
     projpred_var,
     projpred_ws_aug,
     verbose_divmin = getOption("projpred.verbose_project", FALSE),
+    throw_warn_sdivmin = getOption("projpred.warn_submodel_fits", TRUE),
+    do_check_conv = getOption("projpred.check_conv", TRUE),
     ...
 ) {
   trms_all <- extract_terms_response(formula)
@@ -620,20 +604,23 @@ divmin_augdat <- function(
                                   style = 3, initial = 0)
       on.exit(close(pb))
     }
-    return(lapply(seq_len(ncol(projpred_ws_aug)), function(s) {
+    outdmin <- lapply(seq_len(ncol(projpred_ws_aug)), function(s) {
       if (verbose_divmin) {
         on.exit(utils::setTxtProgressBar(pb, s))
       }
-      sdivmin(
-        formula = formula,
-        data = data,
-        family = family,
-        weights = projpred_ws_aug[, s],
-        projpred_formula_no_random = projpred_formula_no_random,
-        projpred_random = projpred_random,
-        ...
+      mssgs_warns_capt <- capt_mssgs_warns(
+        soutdmin <- sdivmin(
+          formula = formula,
+          data = data,
+          family = family,
+          weights = projpred_ws_aug[, s],
+          projpred_formula_no_random = projpred_formula_no_random,
+          projpred_random = projpred_random,
+          ...
+        )
       )
-    }))
+      return(nlist(soutdmin, mssgs_warns_capt))
+    })
   } else {
     # Parallel case.
     if (!requireNamespace("foreach", quietly = TRUE)) {
@@ -644,7 +631,7 @@ divmin_augdat <- function(
     }
     dot_args <- list(...)
     `%do_projpred%` <- foreach::`%dopar%`
-    return(foreach::foreach(
+    outdmin <- foreach::foreach(
       projpred_w_aug_s = iterators::iter(projpred_ws_aug, by = "column"),
       .export = c(
         "sdivmin", "formula", "data", "family", "projpred_formula_no_random",
@@ -655,18 +642,45 @@ divmin_augdat <- function(
         "projpred_ws_aug", "linkobjs"
       )
     ) %do_projpred% {
-      do.call(
-        sdivmin,
-        c(list(formula = formula,
-               data = data,
-               family = family,
-               weights = as.vector(projpred_w_aug_s),
-               projpred_formula_no_random = projpred_formula_no_random,
-               projpred_random = projpred_random),
-          dot_args)
+      mssgs_warns_capt <- capt_mssgs_warns(
+        soutdmin <- do.call(
+          sdivmin,
+          c(list(formula = formula,
+                 data = data,
+                 family = family,
+                 weights = as.vector(projpred_w_aug_s),
+                 projpred_formula_no_random = projpred_formula_no_random,
+                 projpred_random = projpred_random),
+            dot_args)
+        )
       )
-    })
+      return(nlist(soutdmin, mssgs_warns_capt))
+    }
   }
+  mssgs_warns_capts <- lapply(outdmin, "[[", "mssgs_warns_capt")
+  outdmin <- lapply(outdmin, "[[", "soutdmin")
+  mssgs_warns_capts <- lapply(mssgs_warns_capts, function(mssgs_warns_capt) {
+    # Filter out some warnings.
+    mssgs_warns_capt <- setdiff(mssgs_warns_capt, "")
+    mssgs_warns_capt <- grep("Warning in [^:]*:$",
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    # For MASS::polr():
+    mssgs_warns_capt <- grep("non-integer #successes in a binomial glm!$",
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    # For ordinal::clmm():
+    mssgs_warns_capt <- grep(paste("Using formula\\(x\\) is deprecated when x",
+                                   "is a character vector of length > 1\\.$"),
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    # For ordinal::clmm():
+    mssgs_warns_capt <- grep(
+      "Consider formula\\(paste\\(x, collapse = .*\\)\\) instead\\.$",
+      mssgs_warns_capt, value = TRUE, invert = TRUE
+    )
+    return(mssgs_warns_capt)
+  })
+  warn_submodel_fits(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
+  check_conv(outdmin, lengths(mssgs_warns_capts), do_check = do_check_conv)
+  return(outdmin)
 }
 
 # Use MASS::polr() to fit submodels for the brms::cumulative() family:
@@ -913,6 +927,7 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 
 # Convergence issues ------------------------------------------------------
 
+# Throw unique messages and warnings from a list of messages and warnings:
 warn_submodel_fits <- function(mssgs_warns_capts, throw_warn = TRUE) {
   if (!throw_warn) return()
   mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
@@ -926,7 +941,9 @@ warn_submodel_fits <- function(mssgs_warns_capts, throw_warn = TRUE) {
   return()
 }
 
-# For checking the convergence of a whole `outdmin` object:
+# Check the convergence of the submodel fits from a whole `outdmin` object, also
+# taking into account whether messages and warnings were thrown (indicated by
+# argument `lengths_mssgs_warns` which must be of the same length as `outdmin`):
 check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
   if (!do_check) return()
   is_conv <- unlist(lapply(outdmin, check_conv_s))

From 313ac99c11335eeed61333ce714ef9a0789e8255 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 7 Nov 2023 11:07:07 +0100
Subject: [PATCH 20/46] `check_conv_s()`: Enhance a comment for `subfit`s.

---
 R/divergence_minimizers.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index b55146c59..5f3e6f322 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -992,10 +992,10 @@ check_conv_s <- function(fit_s) {
     # checking `NA` coefficients:
     return(all(!is.na(coef(fit_s))))
   } else if (inherits(fit_s, "subfit")) {
-    # Note: There doesn't seem to be any way to check for convergence, so
-    # return `TRUE` for now.
-    # TODO (GLMs with ridge regularization): Add a logical indicating
-    # convergence to objects of class `subfit` (i.e., from glm_ridge())?
+    # For a submodel of class `subfit`, non-convergence is only indicated by
+    # output written to the console (which is converted to a warning in
+    # fit_glm_ridge_callback() and then checked in check_conv()), so we need to
+    # return `TRUE` here:
     return(TRUE)
   } else {
     warning("Unrecognized submodel fit. Please notify the package maintainer.")

From 01830f0320934d2c3f535f3f1415ac9ee3cbfd68 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 15:28:04 +0100
Subject: [PATCH 21/46] `check_conv_s()`: Re-order the `if` cases from least
 complex model to most complex model.

---
 R/divergence_minimizers.R | 42 +++++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 21 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 5f3e6f322..268c932d9 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -965,15 +965,18 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
 # Helper function for checking the convergence of a single submodel fit (not of
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
-  if (inherits(fit_s, "gam")) {
-    # TODO (GAMs): Is this correct?:
-    return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
-  } else if (inherits(fit_s, "gamm4")) {
-    # TODO (GAMMs): I couldn't find any convergence-related information in
-    # element `fit_s$gam`, so the GAM part is currently not checked for
-    # convergence. For now, all we can check is the GLMM part from element
-    # `fit_s$mer`:
-    return(check_conv_s(fit_s$mer))
+  if (inherits(fit_s, "subfit")) {
+    # For a submodel of class `subfit`, non-convergence is only indicated by
+    # output written to the console (which is converted to a warning in
+    # fit_glm_ridge_callback() and then checked in check_conv()), so we need to
+    # return `TRUE` here:
+    return(TRUE)
+  } else if (inherits(fit_s, "lm")) {
+    # There doesn't seem to be a better way to check for convergence other than
+    # checking `NA` coefficients:
+    return(all(!is.na(coef(fit_s))))
+  } else if (inherits(fit_s, "glm")) {
+    return(fit_s$converged)
   } else if (inherits(fit_s, c("lmerMod", "glmerMod"))) {
     # The following was inferred from the source code of lme4::checkConv() and
     # lme4::.prt.warn() (see also `?lme4::mkMerMod`).
@@ -985,18 +988,15 @@ check_conv_s <- function(fit_s) {
         is.null(fit_s@optinfo$conv$lme4$code)
     ) && length(unlist(fit_s@optinfo$conv$lme4$messages)) == 0 &&
       length(fit_s@optinfo$warnings) == 0)
-  } else if (inherits(fit_s, "glm")) {
-    return(fit_s$converged)
-  } else if (inherits(fit_s, "lm")) {
-    # There doesn't seem to be a better way to check for convergence other than
-    # checking `NA` coefficients:
-    return(all(!is.na(coef(fit_s))))
-  } else if (inherits(fit_s, "subfit")) {
-    # For a submodel of class `subfit`, non-convergence is only indicated by
-    # output written to the console (which is converted to a warning in
-    # fit_glm_ridge_callback() and then checked in check_conv()), so we need to
-    # return `TRUE` here:
-    return(TRUE)
+  } else if (inherits(fit_s, "gam")) {
+    # TODO (GAMs): Is this correct?:
+    return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
+  } else if (inherits(fit_s, "gamm4")) {
+    # TODO (GAMMs): I couldn't find any convergence-related information in
+    # element `fit_s$gam`, so the GAM part is currently not checked for
+    # convergence. For now, all we can check is the GLMM part from element
+    # `fit_s$mer`:
+    return(check_conv_s(fit_s$mer))
   } else {
     warning("Unrecognized submodel fit. Please notify the package maintainer.")
     return(TRUE)

From 84460644cc57454034eb71dcc5d3717acf6edff7 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 12:41:08 +0100
Subject: [PATCH 22/46] Enhance the warning in `check_conv()` by giving a more
 precise hint

where tuning parameters may be found (which in turn is achieved by mentioning
the class(es) of the submodel fits).
---
 R/divergence_minimizers.R | 25 +++++++++++++++++++------
 R/projfun.R               |  4 ++--
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 268c932d9..c949c01d9 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -948,14 +948,27 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
   if (!do_check) return()
   is_conv <- unlist(lapply(outdmin, check_conv_s))
   is_conv <- is_conv & (lengths_mssgs_warns == 0)
-  if (any(!is_conv)) {
+  not_conv <- sum(!is_conv)
+  if (not_conv > 0) {
+    if (getOption("projpred.additional_checks", FALSE)) {
+      cls <- unique(lapply(outdmin, class))
+      stopifnot(length(cls) == 1)
+      cls <- cls[[1]]
+    } else {
+      cls <- class(outdmin[[1]])
+    }
+    cls <- paste0("c(", paste(paste0("\"", cls, "\""), collapse = ", "), ")")
     warning(
-      sum(!is_conv), " out of ", length(is_conv), " submodel fits (there is ",
-      "one submodel fit per projected draw) probably have not converged ",
+      not_conv, " out of ", length(is_conv), " submodel fits (there is one ",
+      "submodel fit per projected draw) seem to have not converged ",
       "(appropriately). It is recommended to inspect this in detail and (if ",
-      "necessary) to adjust tuning parameters (e.g., for the lme4 package in ",
-      "case of a multilevel submodel) via `...` or via a custom ",
-      "`divergence_minimizer` function. Formula (right-hand side): ",
+      "necessary) to adjust tuning parameters via `...` (the ellipsis of the ",
+      "employed top-level function such as project(), varsel(), or ",
+      "cv_varsel()) or via a custom `div_minimizer` function (an argument of ",
+      "init_refmodel()). In the present case, the submodel fits are of ",
+      "class(es) `", cls, "`. Documentation for corresponding tuning ",
+      "parameters is linked in section \"Draw-wise divergence minimizers\" of ",
+      "`` ?`projpred-package` ``. Current submodel formula (right-hand side): ",
       update(formula(outdmin[[1]]), NULL ~ .)
     )
   }
diff --git a/R/projfun.R b/R/projfun.R
index 998f1d6b7..114ad6782 100644
--- a/R/projfun.R
+++ b/R/projfun.R
@@ -149,8 +149,8 @@ perf_eval <- function(search_path,
   return(out)
 }
 
-# Process the output of the `divergence_minimizer` function (see
-# init_refmodel()) to create an object of class `submodl`.
+# Process the output of the `div_minimizer` function (see init_refmodel()) to
+# create an object of class `submodl`.
 init_submodl <- function(outdmin, p_ref, refmodel, predictor_terms, wobs) {
   p_ref$mu <- p_ref$mu_offs
   if (!(all(is.na(p_ref$var)) ||

From efed1ddad05c399684329e5107f58e403a4e552b Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 15:55:24 +0100
Subject: [PATCH 23/46] Filter out some warnings also in `divmin()`.

---
 R/divergence_minimizers.R | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index c949c01d9..7cfa0f30a 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -117,6 +117,13 @@ divmin <- function(
   }
   mssgs_warns_capts <- lapply(outdmin, "[[", "mssgs_warns_capt")
   outdmin <- lapply(outdmin, "[[", "soutdmin")
+  mssgs_warns_capts <- lapply(mssgs_warns_capts, function(mssgs_warns_capt) {
+    # Filter out some warnings.
+    mssgs_warns_capt <- setdiff(mssgs_warns_capt, "")
+    mssgs_warns_capt <- grep("Warning in [^:]*:$",
+                             mssgs_warns_capt, value = TRUE, invert = TRUE)
+    return(mssgs_warns_capt)
+  })
   warn_submodel_fits(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
   check_conv(outdmin, lengths(mssgs_warns_capts), do_check = do_check_conv)
   return(outdmin)

From b6e5ef7c2bbd02b497374ae62aaebfbc88cbcbb5 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 11:48:01 +0100
Subject: [PATCH 24/46] Tests: Remove unnecessary braces.

---
 tests/testthat/test_proj_predfun.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/tests/testthat/test_proj_predfun.R b/tests/testthat/test_proj_predfun.R
index 8295280a8..fa7082bc0 100644
--- a/tests/testthat/test_proj_predfun.R
+++ b/tests/testthat/test_proj_predfun.R
@@ -411,7 +411,7 @@ test_that(paste(
     NA
   }
   expect_warning(
-    out_capt <- capture.output({
+    out_capt <- capture.output(
       mfit <- mclogit::mblogit(
         formula = cell ~ treat + age + Karn + prior,
         data = VA,
@@ -419,7 +419,7 @@ test_that(paste(
         model = FALSE,
         y = FALSE
       )
-    }),
+    ),
     warn_expected
   )
   expect_identical(tail(out_capt, 1), "converged")
@@ -653,7 +653,7 @@ test_that(paste(
     NA
   }
   expect_warning(
-    out_capt <- capture.output({
+    out_capt <- capture.output(
       mfit <- mclogit::mblogit(
         formula = cell ~ treat + age + Karn + prior,
         data = VA,
@@ -662,7 +662,7 @@ test_that(paste(
         model = FALSE,
         y = FALSE
       )
-    }),
+    ),
     warn_expected
   )
   expect_identical(tail(out_capt, 1), "converged")

From 13a19583a3e93430e904f72dd9319debc89b61d6 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 11:54:40 +0100
Subject: [PATCH 25/46] Tests: Use the global option to suppress warnings
 collected across all posterior draws.

---
 tests/testthat/setup.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index 0517d6b53..ea2910d24 100755
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -904,6 +904,8 @@ options(projpred.additional_checks = TRUE)
 # Suppress the warning thrown if `cvrefbuilder` is `NULL` (here in the tests,
 # this should only be relevant for `datafit`s):
 options(projpred.warn_cvrefbuilder_NULL = FALSE)
+# Suppress warnings thrown while fitting the submodels:
+options(projpred.warn_submodel_fits = FALSE)
 # Set default number of significant digits to be printed:
 options(projpred.digits = getOption("digits"))
 

From 5ad503d66b6e6e91abc64eb4f86b64113b38638e Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 15 Nov 2023 13:32:49 +0100
Subject: [PATCH 26/46] Tests: Don't use the convergence checker.

---
 tests/testthat/setup.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index ea2910d24..e440d813c 100755
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -906,6 +906,8 @@ options(projpred.additional_checks = TRUE)
 options(projpred.warn_cvrefbuilder_NULL = FALSE)
 # Suppress warnings thrown while fitting the submodels:
 options(projpred.warn_submodel_fits = FALSE)
+# Don't use the convergence checker:
+options(projpred.check_conv = FALSE)
 # Set default number of significant digits to be printed:
 options(projpred.digits = getOption("digits"))
 

From d55b66ffa0a73b1420e77402b60c75b86c810ac1 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Thu, 16 Nov 2023 17:48:50 +0100
Subject: [PATCH 27/46] Revert "`check_conv_s()`: Re-order the `if` cases from
 least complex model to most complex model."

Reason for the revert: For example, `class(<gam_fit>)` yields `c("gam", "glm",
"lm")`, so it's indeed better to start with the most complex type of model.
---
 R/divergence_minimizers.R | 42 +++++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 21 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 7cfa0f30a..f2d41f548 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -985,18 +985,15 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
 # Helper function for checking the convergence of a single submodel fit (not of
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
-  if (inherits(fit_s, "subfit")) {
-    # For a submodel of class `subfit`, non-convergence is only indicated by
-    # output written to the console (which is converted to a warning in
-    # fit_glm_ridge_callback() and then checked in check_conv()), so we need to
-    # return `TRUE` here:
-    return(TRUE)
-  } else if (inherits(fit_s, "lm")) {
-    # There doesn't seem to be a better way to check for convergence other than
-    # checking `NA` coefficients:
-    return(all(!is.na(coef(fit_s))))
-  } else if (inherits(fit_s, "glm")) {
-    return(fit_s$converged)
+  if (inherits(fit_s, "gam")) {
+    # TODO (GAMs): Is this correct?:
+    return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
+  } else if (inherits(fit_s, "gamm4")) {
+    # TODO (GAMMs): I couldn't find any convergence-related information in
+    # element `fit_s$gam`, so the GAM part is currently not checked for
+    # convergence. For now, all we can check is the GLMM part from element
+    # `fit_s$mer`:
+    return(check_conv_s(fit_s$mer))
   } else if (inherits(fit_s, c("lmerMod", "glmerMod"))) {
     # The following was inferred from the source code of lme4::checkConv() and
     # lme4::.prt.warn() (see also `?lme4::mkMerMod`).
@@ -1008,15 +1005,18 @@ check_conv_s <- function(fit_s) {
         is.null(fit_s@optinfo$conv$lme4$code)
     ) && length(unlist(fit_s@optinfo$conv$lme4$messages)) == 0 &&
       length(fit_s@optinfo$warnings) == 0)
-  } else if (inherits(fit_s, "gam")) {
-    # TODO (GAMs): Is this correct?:
-    return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
-  } else if (inherits(fit_s, "gamm4")) {
-    # TODO (GAMMs): I couldn't find any convergence-related information in
-    # element `fit_s$gam`, so the GAM part is currently not checked for
-    # convergence. For now, all we can check is the GLMM part from element
-    # `fit_s$mer`:
-    return(check_conv_s(fit_s$mer))
+  } else if (inherits(fit_s, "glm")) {
+    return(fit_s$converged)
+  } else if (inherits(fit_s, "lm")) {
+    # There doesn't seem to be a better way to check for convergence other than
+    # checking `NA` coefficients:
+    return(all(!is.na(coef(fit_s))))
+  } else if (inherits(fit_s, "subfit")) {
+    # For a submodel of class `subfit`, non-convergence is only indicated by
+    # output written to the console (which is converted to a warning in
+    # fit_glm_ridge_callback() and then checked in check_conv()), so we need to
+    # return `TRUE` here:
+    return(TRUE)
   } else {
     warning("Unrecognized submodel fit. Please notify the package maintainer.")
     return(TRUE)

From 60aa9fba9075d0a1ab7e7705bcc394a64927df8a Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Thu, 16 Nov 2023 21:35:28 +0100
Subject: [PATCH 28/46] Extend `check_conv_s()` to `polr` fits.

---
 R/divergence_minimizers.R | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index f2d41f548..b8558d574 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -985,7 +985,9 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
 # Helper function for checking the convergence of a single submodel fit (not of
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
-  if (inherits(fit_s, "gam")) {
+  if (inherits(fit_s, "polr")) {
+    return(fit_s$convergence == 0)
+  } else if (inherits(fit_s, "gam")) {
     # TODO (GAMs): Is this correct?:
     return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
   } else if (inherits(fit_s, "gamm4")) {

From ca247dd7a9b428c53d6ef533ab0fcbf4180ec1f7 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Thu, 16 Nov 2023 21:54:06 +0100
Subject: [PATCH 29/46] Extend `check_conv_s()` to `clmm` fits.

---
 R/divergence_minimizers.R | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index b8558d574..69364f707 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -985,7 +985,9 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
 # Helper function for checking the convergence of a single submodel fit (not of
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
-  if (inherits(fit_s, "polr")) {
+  if (inherits(fit_s, "clmm")) {
+    return(fit_s$optRes$convergence == 0)
+  } else if (inherits(fit_s, "polr")) {
     return(fit_s$convergence == 0)
   } else if (inherits(fit_s, "gam")) {
     # TODO (GAMs): Is this correct?:

From 24477ca5a3a9c179ed614241eb8a973cb567a737 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Thu, 16 Nov 2023 22:06:32 +0100
Subject: [PATCH 30/46] Extend `check_conv_s()` to `multinom` fits.

---
 R/divergence_minimizers.R | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 69364f707..552599c84 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -985,7 +985,9 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
 # Helper function for checking the convergence of a single submodel fit (not of
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
-  if (inherits(fit_s, "clmm")) {
+  if (inherits(fit_s, "multinom")) {
+    return(fit_s$convergence == 0)
+  } else if (inherits(fit_s, "clmm")) {
     return(fit_s$optRes$convergence == 0)
   } else if (inherits(fit_s, "polr")) {
     return(fit_s$convergence == 0)

From c9e6650c2703c0fb4a89a07c8f6f89be9b874d71 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Thu, 16 Nov 2023 22:17:34 +0100
Subject: [PATCH 31/46] Extend `check_conv_s()` to `mmblogit` fits.

---
 R/divergence_minimizers.R | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 552599c84..eb47994cf 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -985,7 +985,9 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
 # Helper function for checking the convergence of a single submodel fit (not of
 # a whole `outdmin` object):
 check_conv_s <- function(fit_s) {
-  if (inherits(fit_s, "multinom")) {
+  if (inherits(fit_s, "mmblogit")) {
+    return(fit_s$converged)
+  } else if (inherits(fit_s, "multinom")) {
     return(fit_s$convergence == 0)
   } else if (inherits(fit_s, "clmm")) {
     return(fit_s$optRes$convergence == 0)

From 6a7a5e541817432a1b5386d9352e12d97a89b3d3 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Fri, 17 Nov 2023 10:12:32 +0100
Subject: [PATCH 32/46] `search_L1_surrogate()` and `fit_glm_ridge_callback()`:
 Only throw unique

`stdout()` output messages as warnings.
---
 R/divergence_minimizers.R | 2 +-
 R/search.R                | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index eb47994cf..2a42b187b 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -169,7 +169,7 @@ fit_glm_ridge_callback <- function(formula, data,
       dot_args
     ))
   )
-  out_capt <- grep("[Ww]arning|bug", out_capt, value = TRUE)
+  out_capt <- unique(grep("[Ww]arning|bug", out_capt, value = TRUE))
   if (length(out_capt) > 0) {
     warning(paste(out_capt, collapse = "\n"))
   }
diff --git a/R/search.R b/R/search.R
index 5a2b973f3..302280856 100644
--- a/R/search.R
+++ b/R/search.R
@@ -221,7 +221,7 @@ search_L1_surrogate <- function(p_ref, d_train, family, intercept, nterms_max,
       obsvar = v, penalty = penalty, thresh = search_control$thresh %||% 1e-6
     )
   )
-  out_capt <- grep("[Ww]arning|bug", out_capt, value = TRUE)
+  out_capt <- unique(grep("[Ww]arning|bug", out_capt, value = TRUE))
   if (length(out_capt) > 0) {
     warning(paste(out_capt, collapse = "\n"))
   }

From d8f558592bf6c5be210f09ab53e6be0940ebcb27 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Fri, 17 Nov 2023 10:20:27 +0100
Subject: [PATCH 33/46] L1 search: Enhance the warning message.

---
 R/search.R | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/R/search.R b/R/search.R
index 302280856..8b17f3bba 100644
--- a/R/search.R
+++ b/R/search.R
@@ -223,7 +223,15 @@ search_L1_surrogate <- function(p_ref, d_train, family, intercept, nterms_max,
   )
   out_capt <- unique(grep("[Ww]arning|bug", out_capt, value = TRUE))
   if (length(out_capt) > 0) {
-    warning(paste(out_capt, collapse = "\n"))
+    warning(paste(
+      c(paste0("The following warnings have been thrown by projpred's ",
+               "internal L1-search function:"),
+        "---", out_capt, "---",
+        paste0("It is recommended to inspect this in detail and (if ",
+               "necessary) to adjust tuning parameters via argument ",
+               "`search_control` (of varsel() or cv_varsel()).")),
+      collapse = "\n"
+    ))
   }
 
   ## sort the variables according to the order in which they enter the model in

From 29ec58283474fc35ad61c05c1674dcf66de358cd Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Fri, 17 Nov 2023 10:48:19 +0100
Subject: [PATCH 34/46] `warn_submodel_fits()`: Fix the warning message.

---
 R/divergence_minimizers.R | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 2a42b187b..2418369c2 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -940,8 +940,9 @@ warn_submodel_fits <- function(mssgs_warns_capts, throw_warn = TRUE) {
   mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
   if (length(mssgs_warns_capts_unq) > 0) {
     warning(paste(
-      c("The following warnings have been thrown by submodel fitters:", "---",
-        mssgs_warns_capts_unq, "---"),
+      c(paste0("The following warnings have been thrown by the current ",
+               "draw-wise divergence minimizer (i.e., \"submodel fitter\"):"),
+        "---", mssgs_warns_capts_unq, "---"),
       collapse = "\n"
     ))
   }

From 08302f300b4df77ff4f523a693a197bccb30aefe Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Fri, 17 Nov 2023 10:52:34 +0100
Subject: [PATCH 35/46] Replace all occurrences of `warn_submodel_fits` by
 `warn_prj_drawwise`.

---
 R/divergence_minimizers.R | 10 +++++-----
 tests/testthat/setup.R    |  2 +-
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 2418369c2..a4d647a8d 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -13,7 +13,7 @@ divmin <- function(
     formula,
     projpred_var,
     verbose_divmin = getOption("projpred.verbose_project", FALSE),
-    throw_warn_sdivmin = getOption("projpred.warn_submodel_fits", TRUE),
+    throw_warn_sdivmin = getOption("projpred.warn_prj_drawwise", TRUE),
     do_check_conv = getOption("projpred.check_conv", TRUE),
     ...
 ) {
@@ -124,7 +124,7 @@ divmin <- function(
                              mssgs_warns_capt, value = TRUE, invert = TRUE)
     return(mssgs_warns_capt)
   })
-  warn_submodel_fits(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
+  warn_prj_drawwise(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
   check_conv(outdmin, lengths(mssgs_warns_capts), do_check = do_check_conv)
   return(outdmin)
 }
@@ -545,7 +545,7 @@ divmin_augdat <- function(
     projpred_var,
     projpred_ws_aug,
     verbose_divmin = getOption("projpred.verbose_project", FALSE),
-    throw_warn_sdivmin = getOption("projpred.warn_submodel_fits", TRUE),
+    throw_warn_sdivmin = getOption("projpred.warn_prj_drawwise", TRUE),
     do_check_conv = getOption("projpred.check_conv", TRUE),
     ...
 ) {
@@ -685,7 +685,7 @@ divmin_augdat <- function(
     )
     return(mssgs_warns_capt)
   })
-  warn_submodel_fits(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
+  warn_prj_drawwise(mssgs_warns_capts, throw_warn = throw_warn_sdivmin)
   check_conv(outdmin, lengths(mssgs_warns_capts), do_check = do_check_conv)
   return(outdmin)
 }
@@ -935,7 +935,7 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 # Convergence issues ------------------------------------------------------
 
 # Throw unique messages and warnings from a list of messages and warnings:
-warn_submodel_fits <- function(mssgs_warns_capts, throw_warn = TRUE) {
+warn_prj_drawwise <- function(mssgs_warns_capts, throw_warn = TRUE) {
   if (!throw_warn) return()
   mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
   if (length(mssgs_warns_capts_unq) > 0) {
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index e440d813c..0149978e3 100755
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -905,7 +905,7 @@ options(projpred.additional_checks = TRUE)
 # this should only be relevant for `datafit`s):
 options(projpred.warn_cvrefbuilder_NULL = FALSE)
 # Suppress warnings thrown while fitting the submodels:
-options(projpred.warn_submodel_fits = FALSE)
+options(projpred.warn_prj_drawwise = FALSE)
 # Don't use the convergence checker:
 options(projpred.check_conv = FALSE)
 # Set default number of significant digits to be printed:

From 94e7a317f418240161a6e4496d34d26d6f1e358d Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Fri, 17 Nov 2023 10:54:45 +0100
Subject: [PATCH 36/46] Minor enhancements for `warn_prj_drawwise()`.

---
 R/divergence_minimizers.R | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index a4d647a8d..0ebc30d48 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -934,14 +934,15 @@ fit_categ_mlvl <- function(formula, projpred_formula_no_random,
 
 # Convergence issues ------------------------------------------------------
 
-# Throw unique messages and warnings from a list of messages and warnings:
+# Throw unique messages and warnings from a list of messages and warnings
+# retrieved during draw-wise projections:
 warn_prj_drawwise <- function(mssgs_warns_capts, throw_warn = TRUE) {
   if (!throw_warn) return()
   mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
   if (length(mssgs_warns_capts_unq) > 0) {
     warning(paste(
       c(paste0("The following warnings have been thrown by the current ",
-               "draw-wise divergence minimizer (i.e., \"submodel fitter\"):"),
+               "submodel fitter (i.e., draw-wise divergence minimizer):"),
         "---", mssgs_warns_capts_unq, "---"),
       collapse = "\n"
     ))

From e0426c1c5643aad8d0623cc7d83f194f1eb4be10 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 21 Nov 2023 10:44:12 +0100
Subject: [PATCH 37/46] Tests: testthat handles `stderr()` in its own way

(that's why we already needed all those `warn_expected <- "non-integer
tests to `warn_prj_drawwise()` and `check_conv()` as well.
---
 tests/testthat/setup.R | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index 0149978e3..231a36784 100755
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -904,10 +904,6 @@ options(projpred.additional_checks = TRUE)
 # Suppress the warning thrown if `cvrefbuilder` is `NULL` (here in the tests,
 # this should only be relevant for `datafit`s):
 options(projpred.warn_cvrefbuilder_NULL = FALSE)
-# Suppress warnings thrown while fitting the submodels:
-options(projpred.warn_prj_drawwise = FALSE)
-# Don't use the convergence checker:
-options(projpred.check_conv = FALSE)
 # Set default number of significant digits to be printed:
 options(projpred.digits = getOption("digits"))
 
@@ -1149,6 +1145,9 @@ if (run_vs) {
       warn_expected <- "non-integer #successes in a binomial glm!"
     } else if (!is.null(args_vs_i$avoid.increase)) {
       warn_expected <- warn_mclogit
+    } else if (args_vs_i$mod_nm %in% c("glmm", "gamm") &&
+               args_vs_i$fam_nm %in% c("brnll", "binom")) {
+      warn_expected <- "boundary"
     } else {
       warn_expected <- NA
     }

From 9643525589366ffa003ed12ede50fc903b731e26 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 21 Nov 2023 10:45:00 +0100
Subject: [PATCH 38/46] The tests revealed that for GAMs with the binomial
 family,

`fit_s$mgcv.conv$fully.converged` may be (or perhaps is always) `NULL`.
---
 R/divergence_minimizers.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 0ebc30d48..78143a038 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -997,7 +997,7 @@ check_conv_s <- function(fit_s) {
     return(fit_s$convergence == 0)
   } else if (inherits(fit_s, "gam")) {
     # TODO (GAMs): Is this correct?:
-    return(fit_s$converged && fit_s$mgcv.conv$fully.converged)
+    return(fit_s$converged && fit_s$mgcv.conv$fully.converged %||% TRUE)
   } else if (inherits(fit_s, "gamm4")) {
     # TODO (GAMMs): I couldn't find any convergence-related information in
     # element `fit_s$gam`, so the GAM part is currently not checked for

From cb0cf8486f40633f422e2cacb4b6d0e051eb3f56 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 21 Nov 2023 11:31:29 +0100
Subject: [PATCH 39/46] fixup! Tests: testthat handles `stderr()` in its own
 way

---
 tests/testthat/setup.R | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index 231a36784..1ccf4fbac 100755
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -1145,9 +1145,14 @@ if (run_vs) {
       warn_expected <- "non-integer #successes in a binomial glm!"
     } else if (!is.null(args_vs_i$avoid.increase)) {
       warn_expected <- warn_mclogit
-    } else if (args_vs_i$mod_nm %in% c("glmm", "gamm") &&
-               args_vs_i$fam_nm %in% c("brnll", "binom")) {
+    } else if ((args_vs_i$mod_nm == "glmm" &&
+                args_vs_i$fam_nm %in% c("brnll", "binom", "cumul")) ||
+               (args_vs_i$mod_nm == "gamm" &&
+                args_vs_i$fam_nm %in% c("brnll", "binom") &&
+                args_vs_i$prj_nm == "trad_compare")) {
       warn_expected <- "boundary"
+    } else if (args_vs_i$mod_nm == "gamm" && args_vs_i$fam_nm == "gauss") {
+      warn_expected <- "seem to have not converged"
     } else {
       warn_expected <- NA
     }

From b769378b9760df8693547ce8f7b457a46ed16d74 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 21 Nov 2023 11:52:45 +0100
Subject: [PATCH 40/46] `fit_glmer_callback()`: Avoid the lme4 warning `unused
 control arguments ignored`.

---
 R/divergence_minimizers.R | 34 +++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 78143a038..3f2597189 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -433,17 +433,30 @@ fit_glmer_callback <- function(formula, projpred_formula_no_random,
     } else if (grepl("pwrssUpdate did not converge in \\(maxit\\) iterations",
                      as.character(e))) {
       tolPwrss_new <- 10 * control$tolPwrss
-      if (length(control$optCtrl$maxfun) > 0) {
-        maxfun_new <- 10 * control$optCtrl$maxfun
-      } else {
-        maxfun_new <- 1e4
+      optCtrl_new <- list()
+      if (length(control$optimizer) == 0) {
+        stop("Unexpected length of `control$optimizer`. Please notify the ",
+             "package maintainer.")
       }
-      if (length(control$optCtrl$maxit) > 0) {
-        maxit_new <- 10 * control$optCtrl$maxit
-      } else {
-        maxit_new <- 1e4
+      if (any(control$optimizer %in% c("Nelder_Mead", "bobyqa"))) {
+        if (length(control$optCtrl$maxfun) > 0) {
+          maxfun_new <- 10 * control$optCtrl$maxfun
+        } else {
+          maxfun_new <- 1e4
+        }
+        optCtrl_new <- c(optCtrl_new, list(maxfun = maxfun_new))
+      }
+      if (any(!control$optimizer %in% c("Nelder_Mead", "bobyqa"))) {
+        if (length(control$optCtrl$maxit) > 0) {
+          maxit_new <- 10 * control$optCtrl$maxit
+        } else {
+          maxit_new <- 1e4
+        }
+        optCtrl_new <- c(optCtrl_new, list(maxit = maxit_new))
       }
-      if (tolPwrss_new > 1e-4 && maxfun_new > 1e7 && maxit_new > 1e7) {
+      if (tolPwrss_new > 1e-4 &&
+          (optCtrl_new$maxfun %||% -Inf > 1e7 ||
+           optCtrl_new$maxit %||% -Inf > 1e7)) {
         stop("Encountering the ",
              "`pwrssUpdate did not converge in (maxit) iterations` error ",
              "while running the lme4 fitting procedure, but cannot fix this ",
@@ -456,8 +469,7 @@ fit_glmer_callback <- function(formula, projpred_formula_no_random,
         projpred_random = projpred_random,
         family = family,
         control = control_callback(family, tolPwrss = tolPwrss_new,
-                                   optCtrl = list(maxfun = maxfun_new,
-                                                  maxit = maxit_new)),
+                                   optCtrl = optCtrl_new),
         ...
       ))
     } else if (getOption("projpred.PQL", FALSE) &&

From b51fcfe11d4d920b7619d31b4fdeb5dcb80894c3 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Tue, 21 Nov 2023 15:23:34 +0100
Subject: [PATCH 41/46] Tests: Unfortunately, we need to suppress warnings.

---
 tests/testthat/setup.R              |  79 +++--------
 tests/testthat/test_div_minimizer.R |   7 +-
 tests/testthat/test_parallel.R      |   4 +-
 tests/testthat/test_proj_pred.R     |  30 +---
 tests/testthat/test_project.R       |  22 +--
 tests/testthat/test_varsel.R        | 212 +++++++++++-----------------
 6 files changed, 121 insertions(+), 233 deletions(-)

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index 1ccf4fbac..05b94b4fc 100755
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -208,15 +208,6 @@ fam_nms_aug_regex <- paste0("\\.(", paste(fam_nms_aug, collapse = "|"), ")\\.")
 fam_nms_unsupp_regex <- paste0("\\.(", paste(fam_nms_unsupp, collapse = "|"),
                                ")\\.")
 
-# Needed for package mclogit (providing the submodel fitter for multilevel
-# brms::categorical() models):
-warn_mclogit <- if (packageVersion("mclogit") >= "0.9.6") {
-  "Inner iterations did not coverge"
-} else {
-  paste0("^step size truncated due to possible divergence$|",
-         "^Algorithm stopped due to false convergence$")
-}
-
 # Data --------------------------------------------------------------------
 
 ## Setup ------------------------------------------------------------------
@@ -904,6 +895,10 @@ options(projpred.additional_checks = TRUE)
 # Suppress the warning thrown if `cvrefbuilder` is `NULL` (here in the tests,
 # this should only be relevant for `datafit`s):
 options(projpred.warn_cvrefbuilder_NULL = FALSE)
+# Suppress warnings thrown while fitting the submodels:
+options(projpred.warn_prj_drawwise = FALSE)
+# Don't use the convergence checker:
+options(projpred.check_conv = FALSE)
 # Set default number of significant digits to be printed:
 options(projpred.digits = getOption("digits"))
 
@@ -1141,30 +1136,10 @@ if (run_vs) {
   })) >= 1)
 
   vss <- lapply(args_vs, function(args_vs_i) {
-    if (args_vs_i$prj_nm == "augdat" && args_vs_i$fam_nm == "cumul") {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_vs_i$avoid.increase)) {
-      warn_expected <- warn_mclogit
-    } else if ((args_vs_i$mod_nm == "glmm" &&
-                args_vs_i$fam_nm %in% c("brnll", "binom", "cumul")) ||
-               (args_vs_i$mod_nm == "gamm" &&
-                args_vs_i$fam_nm %in% c("brnll", "binom") &&
-                args_vs_i$prj_nm == "trad_compare")) {
-      warn_expected <- "boundary"
-    } else if (args_vs_i$mod_nm == "gamm" && args_vs_i$fam_nm == "gauss") {
-      warn_expected <- "seem to have not converged"
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      vs_out <- do.call(varsel, c(
-        list(object = refmods[[args_vs_i$tstsetup_ref]]),
-        excl_nonargs(args_vs_i)
-      )),
-      warn_expected,
-      info = args_vs_i$tstsetup_ref
-    )
-    return(vs_out)
+    do.call(varsel, c(
+      list(object = refmods[[args_vs_i$tstsetup_ref]]),
+      excl_nonargs(args_vs_i)
+    ))
   })
 }
 
@@ -1427,24 +1402,10 @@ if (run_prj) {
   args_prj <- unlist_cust(args_prj)
 
   prjs <- lapply(args_prj, function(args_prj_i) {
-    if (args_prj_i$prj_nm == "augdat" && args_prj_i$fam_nm == "cumul" &&
-        !any(grepl("\\|", args_prj_i$predictor_terms))) {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_prj_i$avoid.increase) &&
-               any(grepl("\\|", args_prj_i$predictor_terms))) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      prj_out <- do.call(project, c(
-        list(object = refmods[[args_prj_i$tstsetup_ref]]),
-        excl_nonargs(args_prj_i)
-      )),
-      warn_expected,
-      info = args_prj_i$tstsetup_ref
-    )
-    return(prj_out)
+    do.call(project, c(
+      list(object = refmods[[args_prj_i$tstsetup_ref]]),
+      excl_nonargs(args_prj_i)
+    ))
   })
 }
 
@@ -1562,16 +1523,12 @@ if (run_cvvs) {
   args_prj_cvvs <- cre_args_prj_vsel(tstsetups_prj_cvvs)
   args_prj_cvvs <- unlist_cust(args_prj_cvvs)
 
-  # Use suppressWarnings() because of occasional pwrssUpdate() warnings:
-  prjs_cvvs <- suppressWarnings(lapply(
-    args_prj_cvvs,
-    function(args_prj_cvvs_i) {
-      do.call(project, c(
-        list(object = cvvss[[args_prj_cvvs_i$tstsetup_vsel]]),
-        excl_nonargs(args_prj_cvvs_i)
-      ))
-    }
-  ))
+  prjs_cvvs <- lapply(args_prj_cvvs, function(args_prj_cvvs_i) {
+    do.call(project, c(
+      list(object = cvvss[[args_prj_cvvs_i$tstsetup_vsel]]),
+      excl_nonargs(args_prj_cvvs_i)
+    ))
+  })
 }
 
 ## Prediction -------------------------------------------------------------
diff --git a/tests/testthat/test_div_minimizer.R b/tests/testthat/test_div_minimizer.R
index e118f3652..478f72083 100644
--- a/tests/testthat/test_div_minimizer.R
+++ b/tests/testthat/test_div_minimizer.R
@@ -163,7 +163,12 @@ test_that("divmin_augdat() works", {
         "length > 1"
       )
     } else if (fam_crr == "categ" && mod_crr == "glmm") {
-      warn_expected <- warn_mclogit
+      warn_expected <- if (packageVersion("mclogit") >= "0.9.6") {
+        "Inner iterations did not coverge"
+      } else {
+        paste0("^step size truncated due to possible divergence$|",
+               "^Algorithm stopped due to false convergence$")
+      }
     } else {
       warn_expected <- NA
     }
diff --git a/tests/testthat/test_parallel.R b/tests/testthat/test_parallel.R
index 870520d7a..7ea40a6d7 100644
--- a/tests/testthat/test_parallel.R
+++ b/tests/testthat/test_parallel.R
@@ -65,8 +65,8 @@ test_that("cv_varsel() in parallel gives the same results as sequentially", {
   tstsetups <- grep("\\.glm\\.", names(cvvss), value = TRUE)
   for (tstsetup in tstsetups) {
     args_cvvs_i <- args_cvvs[[tstsetup]]
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_repr <- suppressWarnings(do.call(cv_varsel, c(
       list(object = refmods[[args_cvvs_i$tstsetup_ref]],
            cvfits = if (identical(args_cvvs_i$cv_method, "kfold")) {
diff --git a/tests/testthat/test_proj_pred.R b/tests/testthat/test_proj_pred.R
index f8fef78b7..3fffb6cfc 100644
--- a/tests/testthat/test_proj_pred.R
+++ b/tests/testthat/test_proj_pred.R
@@ -913,13 +913,6 @@ test_that(paste(
     } else {
       ncats_nlats_expected_crr <- integer()
     }
-    if (args_prj[[tstsetup]]$prj_nm == "augdat" &&
-        args_prj[[tstsetup]]$fam_nm == "cumul" &&
-        !any(grepl("\\|", args_prj[[tstsetup]]$predictor_terms))) {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else {
-      warn_expected <- NA
-    }
     pl_args <- list(refmods[[args_prj[[tstsetup]]$tstsetup_ref]],
                     newdata = head(get_dat(tstsetup), 1),
                     weightsnew = wobs_crr,
@@ -931,12 +924,10 @@ test_that(paste(
     if (args_prj[[tstsetup]]$fam_nm == "categ" &&
         any(grepl("\\|", args_prj[[tstsetup]]$predictor_terms))) {
       pl_args <- c(pl_args, list(avoid.increase = TRUE))
-      warn_expected <- warn_mclogit
     }
-    expect_warning(
-      pl1 <- do.call(proj_linpred, pl_args),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    pl1 <- suppressWarnings(do.call(proj_linpred, pl_args))
     pl_tester(pl1,
               nprjdraws_expected = 1L,
               nobsv_expected = 1L,
@@ -1658,13 +1649,6 @@ test_that(paste(
     } else {
       offs_crr <- NULL
     }
-    if (args_prj[[tstsetup]]$prj_nm == "augdat" &&
-        args_prj[[tstsetup]]$fam_nm == "cumul" &&
-        !any(grepl("\\|", args_prj[[tstsetup]]$predictor_terms))) {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else {
-      warn_expected <- NA
-    }
     pp_args <- list(refmods[[args_prj[[tstsetup]]$tstsetup_ref]],
                     newdata = head(get_dat(tstsetup), 1),
                     weightsnew = wobs_crr,
@@ -1677,12 +1661,10 @@ test_that(paste(
     if (args_prj[[tstsetup]]$fam_nm == "categ" &&
         any(grepl("\\|", args_prj[[tstsetup]]$predictor_terms))) {
       pp_args <- c(pp_args, list(avoid.increase = TRUE))
-      warn_expected <- warn_mclogit
     }
-    expect_warning(
-      pp1 <- do.call(proj_predict, pp_args),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    pp1 <- suppressWarnings(do.call(proj_predict, pp_args))
     pp_tester(pp1,
               nprjdraws_out_expected = 1L,
               nobsv_expected = 1L,
diff --git a/tests/testthat/test_project.R b/tests/testthat/test_project.R
index 14a39d21f..1a0610670 100644
--- a/tests/testthat/test_project.R
+++ b/tests/testthat/test_project.R
@@ -347,22 +347,12 @@ test_that("non-clustered projection does not require a seed", {
     args_prj_i <- args_prj[[tstsetup]]
     p_orig <- prjs[[tstsetup]]
     rand_new1 <- runif(1) # Just to advance `.Random.seed[2]`.
-    if (args_prj_i$prj_nm == "augdat" && args_prj_i$fam_nm == "cumul" &&
-        !any(grepl("\\|", args_prj_i$predictor_terms))) {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_prj_i$avoid.increase) &&
-               any(grepl("\\|", args_prj_i$predictor_terms))) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      p_new <- do.call(project, c(
-        list(object = refmods[[args_prj_i$tstsetup_ref]]),
-        excl_nonargs(args_prj_i, nms_excl_add = "seed")
-      )),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    p_new <- suppressWarnings(do.call(project, c(
+      list(object = refmods[[args_prj_i$tstsetup_ref]]),
+      excl_nonargs(args_prj_i, nms_excl_add = "seed")
+    )))
     if (args_prj_i$mod_nm %in% c("glmm", "gamm") &&
         any(grepl("\\|", args_prj_i$predictor_terms))) {
       if (getOption("projpred.mlvl_pred_new", FALSE)) {
diff --git a/tests/testthat/test_varsel.R b/tests/testthat/test_varsel.R
index 2e4218140..c286bf922 100644
--- a/tests/testthat/test_varsel.R
+++ b/tests/testthat/test_varsel.R
@@ -135,20 +135,12 @@ test_that(paste(
       }
     }
     d_test_crr$y_oscale <- y_oscale_crr
-    if (prj_crr == "augdat" && fam_crr == "cumul") {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_vs_i$avoid.increase)) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      vs_repr <- do.call(varsel, c(
-        list(object = refmods[[tstsetup_ref]], d_test = d_test_crr),
-        excl_nonargs(args_vs_i)
-      )),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    vs_repr <- suppressWarnings(do.call(varsel, c(
+      list(object = refmods[[tstsetup_ref]], d_test = d_test_crr),
+      excl_nonargs(args_vs_i)
+    )))
     meth_exp_crr <- args_vs_i$method %||% "forward"
     vsel_tester(
       vs_repr,
@@ -263,20 +255,12 @@ test_that(paste(
       }
     }
     d_test_crr$y_oscale <- y_oscale_crr
-    if (prj_crr == "augdat" && fam_crr == "cumul") {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_vs_i$avoid.increase)) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      vs_indep <- do.call(varsel, c(
-        list(object = refmods[[tstsetup_ref]], d_test = d_test_crr),
-        excl_nonargs(args_vs_i)
-      )),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    vs_indep <- suppressWarnings(do.call(varsel, c(
+      list(object = refmods[[tstsetup_ref]], d_test = d_test_crr),
+      excl_nonargs(args_vs_i)
+    )))
     meth_exp_crr <- args_vs_i$method %||% "forward"
     vsel_tester(
       vs_indep,
@@ -309,28 +293,22 @@ test_that(paste(
       # varsel() at the place where the new group-level effects are drawn (not
       # even `.seed = NA` with an appropriate preparation is possible).
 
-      if (!is.null(args_vs_i$avoid.increase)) {
-        warn_expected <- NA
-      }
       # For getting the correct seed in proj_linpred():
       set.seed(args_vs_i$seed)
       p_sel_dummy <- get_refdist(refmods[[tstsetup_ref]],
                                  nclusters = vs_indep$nprjdraws_search)
-      expect_warning(
-        pl_indep <- proj_linpred(
-          vs_indep,
-          newdata = dat_indep_crr,
-          offsetnew = d_test_crr$offset,
-          weightsnew = d_test_crr$weights,
-          transform = TRUE,
-          integrated = TRUE,
-          .seed = NA,
-          nterms = c(0L, seq_along(vs_indep$predictor_ranking)),
-          nclusters = args_vs_i$nclusters_pred,
-          seed = NA
-        ),
-        warn_expected
-      )
+      pl_indep <- suppressWarnings(proj_linpred(
+        vs_indep,
+        newdata = dat_indep_crr,
+        offsetnew = d_test_crr$offset,
+        weightsnew = d_test_crr$weights,
+        transform = TRUE,
+        integrated = TRUE,
+        .seed = NA,
+        nterms = c(0L, seq_along(vs_indep$predictor_ranking)),
+        nclusters = args_vs_i$nclusters_pred,
+        seed = NA
+      ))
       summ_sub_ch <- lapply(pl_indep, function(pl_indep_k) {
         names(pl_indep_k)[names(pl_indep_k) == "pred"] <- "mu"
         names(pl_indep_k)[names(pl_indep_k) == "lpd"] <- "lppd"
@@ -525,21 +503,12 @@ test_that("`refit_prj` works", {
   for (tstsetup in tstsetups) {
     args_vs_i <- args_vs[[tstsetup]]
     args_vs_i$refit_prj <- FALSE
-    if (args_vs_i$prj_nm == "augdat" && args_vs_i$fam_nm == "cumul") {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_vs_i$avoid.increase)) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      vs_reuse <- do.call(varsel, c(
-        list(object = refmods[[args_vs_i$tstsetup_ref]]),
-        excl_nonargs(args_vs_i)
-      )),
-      warn_expected,
-      info = tstsetup
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    vs_reuse <- suppressWarnings(do.call(varsel, c(
+      list(object = refmods[[args_vs_i$tstsetup_ref]]),
+      excl_nonargs(args_vs_i)
+    )))
     mod_crr <- args_vs_i$mod_nm
     fam_crr <- args_vs_i$fam_nm
     prj_crr <- args_vs_i$prj_nm
@@ -905,21 +874,13 @@ test_that("for forward search, `penalty` has no effect", {
   }
   for (tstsetup in tstsetups) {
     args_vs_i <- args_vs[[tstsetup]]
-    if (args_vs_i$prj_nm == "augdat" && args_vs_i$fam_nm == "cumul") {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (!is.null(args_vs_i$avoid.increase)) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      vs_penal <- do.call(varsel, c(
-        list(object = refmods[[args_vs_i$tstsetup_ref]],
-             penalty = penal_tst),
-        excl_nonargs(args_vs_i)
-      )),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    vs_penal <- suppressWarnings(do.call(varsel, c(
+      list(object = refmods[[args_vs_i$tstsetup_ref]],
+           penalty = penal_tst),
+      excl_nonargs(args_vs_i)
+    )))
     vs_penal$args_search["penalty"] <- list(NULL)
     expect_equal(vs_penal, vss[[tstsetup]], info = tstsetup)
   }
@@ -1168,21 +1129,12 @@ test_that("varsel.vsel() works for `vsel` objects from cv_varsel()", {
     }
     fam_crr <- args_cvvs[[tstsetup]]$fam_nm
     prj_crr <- args_cvvs[[tstsetup]]$prj_nm
-    if (refit_prj_crr && prj_crr == "augdat" && fam_crr == "cumul") {
-      warn_expected <- "non-integer #successes in a binomial glm!"
-    } else if (refit_prj_crr &&
-               !is.null(args_cvvs[[tstsetup]]$avoid.increase)) {
-      warn_expected <- warn_mclogit
-    } else {
-      warn_expected <- NA
-    }
-    expect_warning(
-      vs_eval <- varsel(
-        cvvss[[tstsetup]], refit_prj = refit_prj_crr,
-        nclusters_pred = nclusters_pred_crr, verbose = FALSE, seed = seed2_tst
-      ),
-      warn_expected
-    )
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    vs_eval <- suppressWarnings(varsel(
+      cvvss[[tstsetup]], refit_prj = refit_prj_crr,
+      nclusters_pred = nclusters_pred_crr, verbose = FALSE, seed = seed2_tst
+    ))
     tstsetup_ref <- args_cvvs[[tstsetup]]$tstsetup_ref
     meth_exp_crr <- args_cvvs[[tstsetup]]$method %||% "forward"
     vsel_tester(
@@ -1297,8 +1249,8 @@ test_that("`seed` works (and restores the RNG state afterwards)", {
     cvvs_orig <- cvvss[[tstsetup]]
     rand_orig <- runif(1) # Just to advance `.Random.seed[2]`.
     .Random.seed_repr1 <- .Random.seed
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_repr <- suppressWarnings(do.call(cv_varsel, c(
       list(object = refmods[[args_cvvs_i$tstsetup_ref]],
            cvfits = if (identical(args_cvvs_i$cv_method, "kfold")) {
@@ -1427,8 +1379,8 @@ test_that("invalid `nloo` fails", {
                              invert = TRUE)
   for (tstsetup in head(tstsetups_nonkfold, 1)) {
     args_cvvs_i <- args_cvvs[[tstsetup]]
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     expect_error(
       suppressWarnings(do.call(cv_varsel, c(
         list(object = refmods[[args_cvvs_i$tstsetup_ref]],
@@ -1453,8 +1405,8 @@ test_that(paste(
   )
   for (tstsetup in tstsetups) {
     args_cvvs_i <- args_cvvs[[tstsetup]]
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_nloo <- suppressWarnings(do.call(cv_varsel, c(
       list(object = refmods[[args_cvvs_i$tstsetup_ref]],
            nloo = nloo_tst),
@@ -1488,8 +1440,8 @@ test_that("setting `nloo` smaller than the number of observations works", {
     fam_crr <- args_cvvs_i$fam_nm
     prj_crr <- args_cvvs_i$prj_nm
     meth_exp_crr <- args_cvvs_i$method %||% "forward"
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_nloo <- suppressWarnings(do.call(cv_varsel, c(
       list(object = refmods[[args_cvvs_i$tstsetup_ref]],
            nloo = nloo_tst),
@@ -1555,8 +1507,8 @@ test_that("`validate_search` works", {
     fam_crr <- args_cvvs_i$fam_nm
     prj_crr <- args_cvvs_i$prj_nm
     meth_exp_crr <- args_cvvs_i$method %||% "forward"
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_valsearch <- suppressWarnings(do.call(cv_varsel, c(
       list(object = refmods[[args_cvvs_i$tstsetup_ref]],
            validate_search = FALSE,
@@ -1726,10 +1678,12 @@ test_that(paste(
     ))
 
     # Run cv_varsel():
-    cvvs_cvfits <- do.call(cv_varsel, c(
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
+    cvvs_cvfits <- suppressWarnings(do.call(cv_varsel, c(
       list(object = refmod_crr),
       excl_nonargs(args_cvvs_i, nms_excl_add = "K")
-    ))
+    )))
 
     # Checks:
     vsel_tester(
@@ -1947,8 +1901,8 @@ test_that(paste(
     refit_prj_crr <- !identical(args_cvvs[[tstsetup]]$validate_search, FALSE) ||
       identical(args_cvvs[[tstsetup]]$cv_method, "kfold")
     nclusters_pred_crr <- nclusters_pred_tst - if (refit_prj_crr) 1L else 0L
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_eval <- suppressWarnings(cv_varsel(
       cvvss[[tstsetup]], refit_prj = refit_prj_crr,
       nclusters_pred = nclusters_pred_crr, verbose = FALSE, seed = seed2_tst
@@ -2004,8 +1958,8 @@ test_that(paste(
       refit_prj_crr <- FALSE
       nclusters_pred_crr <- args_vs[[tstsetup]]$nclusters_pred
     }
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_eval <- suppressWarnings(cv_varsel(
       vss[[tstsetup]], validate_search = FALSE, refit_prj = refit_prj_crr,
       nclusters_pred = nclusters_pred_crr, verbose = FALSE, seed = seed2_tst
@@ -2069,8 +2023,8 @@ test_that(paste(
     } else {
       nclusters_pred_crr <- args_vs[[tstsetup]]$nclusters_pred
     }
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_eval <- suppressWarnings(cv_varsel(
       vss[[tstsetup]], cv_method = "kfold", cvfits = cvfitss[[tstsetup_ref]],
       validate_search = FALSE, nclusters_pred = nclusters_pred_crr,
@@ -2112,8 +2066,8 @@ test_that(paste(
     if (isFALSE(args_cvvs[[tstsetup]]$validate_search)) {
       next
     }
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cvvs_eval <- suppressWarnings(cv_varsel(
         cvvss[[tstsetup]], cv_method = "LOO", validate_search = FALSE,
@@ -2192,8 +2146,8 @@ test_that(paste(
       next
     }
     nclusters_pred_crr <- args_cvvs[[tstsetup]]$nclusters_pred - 1L
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cvvs_eval <- suppressWarnings(cv_varsel(
         cvvss[[tstsetup]], validate_search = FALSE,
@@ -2252,8 +2206,8 @@ test_that(paste(
       next
     }
     nclusters_pred_crr <- args_cvvs[[tstsetup]]$nclusters_pred - 1L
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cv_meth_crr <- "LOO"
       cvvs_eval <- suppressWarnings(cv_varsel(
@@ -2315,8 +2269,8 @@ test_that(paste(
       next
     }
     nclusters_pred_crr <- args_cvvs[[tstsetup]]$nclusters_pred - 1L
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cv_meth_crr <- "LOO"
       cvvs_eval <- suppressWarnings(cv_varsel(
@@ -2369,8 +2323,8 @@ test_that(paste(
     } else {
       nclusters_pred_crr <- args_vs[[tstsetup]]$nclusters_pred
     }
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_eval <- try(
       suppressWarnings(cv_varsel(
         vss[[tstsetup]], nclusters_pred = nclusters_pred_crr, verbose = FALSE,
@@ -2446,8 +2400,8 @@ test_that(paste(
     } else {
       nclusters_pred_crr <- args_vs[[tstsetup]]$nclusters_pred
     }
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_eval <- try(
       suppressWarnings(cv_varsel(
         vss[[tstsetup]], cv_method = "kfold", cvfits = cvfitss[[tstsetup_ref]],
@@ -2512,8 +2466,8 @@ test_that(paste(
       next
     }
     nclusters_pred_crr <- args_cvvs[[tstsetup]]$nclusters_pred - 1L
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cvvs_eval <- try(
         suppressWarnings(cv_varsel(
@@ -2614,8 +2568,8 @@ test_that(paste(
       next
     }
     nclusters_pred_crr <- args_cvvs[[tstsetup]]$nclusters_pred - 1L
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cvvs_eval <- try(
         suppressWarnings(cv_varsel(
@@ -2688,8 +2642,8 @@ test_that("cv_varsel.vsel(): `nloo` works for `vsel` objects from varsel()", {
       refit_prj_crr <- FALSE
       nclusters_pred_crr <- args_vs[[tstsetup]]$nclusters_pred
     }
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     cvvs_eval_valF <- suppressWarnings(cv_varsel(
       vss[[tstsetup]], nloo = nloo_tst, validate_search = FALSE,
       refit_prj = refit_prj_crr, nclusters_pred = nclusters_pred_crr,
@@ -2766,8 +2720,8 @@ test_that(paste(
     stopifnot(any(valsearches), any(!valsearches))
   }
   for (tstsetup in tstsetups) {
-    # Use suppressWarnings() because of occasional warnings concerning Pareto k
-    # diagnostics:
+    # Use suppressWarnings() because test_that() somehow redirects stderr() and
+    # so throws warnings that projpred wants to capture internally:
     if (identical(args_cvvs[[tstsetup]]$cv_method, "kfold")) {
       cvvs_eval_valF <- suppressWarnings(cv_varsel(
         cvvss[[tstsetup]], cv_method = "LOO", validate_search = FALSE,

From ef20193c01ec5aabdb8943242309819beabcee18 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 22 Nov 2023 11:59:13 +0100
Subject: [PATCH 42/46] Catch errors when calling `check_conv_s()` and throw a
 warning instead

(to avoid that such a minor issue as a defective convergence checker prevents
the code from running through).
---
 R/divergence_minimizers.R | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 3f2597189..8dd33a32c 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -967,7 +967,17 @@ warn_prj_drawwise <- function(mssgs_warns_capts, throw_warn = TRUE) {
 # argument `lengths_mssgs_warns` which must be of the same length as `outdmin`):
 check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
   if (!do_check) return()
-  is_conv <- unlist(lapply(outdmin, check_conv_s))
+  is_conv <- tryCatch(
+    unlist(lapply(outdmin, check_conv_s)),
+    error = function(e) {
+      warning("The draw-wise convergence checker errored with message \n```\n",
+              e, "```\nso the convergence of the current submodel fits cannot ",
+              "be checked. Please notify the package maintainer. Current ",
+              "submodel formula (right-hand side): ",
+              update(formula(outdmin[[1]]), NULL ~ .))
+      return(rep(TRUE, length(outdmin)))
+    }
+  )
   is_conv <- is_conv & (lengths_mssgs_warns == 0)
   not_conv <- sum(!is_conv)
   if (not_conv > 0) {

From 49e24e070f648e715e7b4f68a52208d4cb967ee9 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 22 Nov 2023 12:10:51 +0100
Subject: [PATCH 43/46] Fix the warning message from `warn_prj_drawwise()`.

---
 R/divergence_minimizers.R | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index 8dd33a32c..f6bbc493b 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -953,8 +953,9 @@ warn_prj_drawwise <- function(mssgs_warns_capts, throw_warn = TRUE) {
   mssgs_warns_capts_unq <- unique(unlist(mssgs_warns_capts))
   if (length(mssgs_warns_capts_unq) > 0) {
     warning(paste(
-      c(paste0("The following warnings have been thrown by the current ",
-               "submodel fitter (i.e., draw-wise divergence minimizer):"),
+      c(paste0("The following messages and/or warnings have been thrown by ",
+               "the current submodel fitter (i.e., the current draw-wise ",
+               "divergence minimizer):"),
         "---", mssgs_warns_capts_unq, "---"),
       collapse = "\n"
     ))

From 6fab7c56d06e2700afe757904346a0e39fbc68c5 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 22 Nov 2023 12:23:24 +0100
Subject: [PATCH 44/46] Docs: Mention global options
 `projpred.warn_prj_drawwise` and `projpred.check_conv`

(in the general package documentation).
---
 R/projpred-package.R    | 33 ++++++++++++++++++++++-----------
 man/projpred-package.Rd | 30 ++++++++++++++++++++----------
 2 files changed, 42 insertions(+), 21 deletions(-)

diff --git a/R/projpred-package.R b/R/projpred-package.R
index de885ea16..7154adf68 100644
--- a/R/projpred-package.R
+++ b/R/projpred-package.R
@@ -82,17 +82,28 @@
 #' * Submodel with multilevel and additive terms: [gamm4::gamm4()] (within
 #' \pkg{projpred}, the returned object inherits from class `gamm4`).
 #'
-#' # Verbosity
-#'
-#' Setting the global option `projpred.extra_verbose` to `TRUE` will print out
-#' which submodel \pkg{projpred} is currently projecting onto as well as (if
-#' `method = "forward"` and `verbose = TRUE` in [varsel()] or [cv_varsel()])
-#' which submodel has been selected at those steps of the forward search for
-#' which a percentage (of the maximum submodel size that the search is run up
-#' to) is printed. In general, however, we cannot recommend setting this global
-#' option to `TRUE` for [cv_varsel()] with `validate_search = TRUE` (simply due
-#' to the amount of information that will be printed, but also due to the
-#' progress bar which will not work anymore as intended).
+#' # Verbosity, messages, warnings, errors
+#'
+#' Setting global option `projpred.extra_verbose` to `TRUE` will print out which
+#' submodel \pkg{projpred} is currently projecting onto as well as (if `method =
+#' "forward"` and `verbose = TRUE` in [varsel()] or [cv_varsel()]) which
+#' submodel has been selected at those steps of the forward search for which a
+#' percentage (of the maximum submodel size that the search is run up to) is
+#' printed. In general, however, we cannot recommend setting this global option
+#' to `TRUE` for [cv_varsel()] with `validate_search = TRUE` (simply due to the
+#' amount of information that will be printed, but also due to the progress bar
+#' which will not work as intended anymore).
+#'
+#' By default, \pkg{projpred} catches messages and warnings from the draw-wise
+#' divergence minimizers and throws their unique collection after performing all
+#' draw-wise divergence minimizations (i.e., draw-wise projections). This can be
+#' deactivated by setting global option `projpred.warn_prj_drawwise` to `FALSE`.
+#'
+#' Furthermore, by default, \pkg{projpred} checks the convergence of the
+#' draw-wise divergence minimizers and throws a warning if any seem to have not
+#' converged. This warning is thrown after the warning message from global
+#' option `projpred.warn_prj_drawwise` (see above) and can be deactivated by
+#' setting global option `projpred.check_conv` to `FALSE`.
 #'
 #' # Parallelization
 #'
diff --git a/man/projpred-package.Rd b/man/projpred-package.Rd
index d378c3843..b4f0627fe 100644
--- a/man/projpred-package.Rd
+++ b/man/projpred-package.Rd
@@ -81,16 +81,26 @@ object inherits from class \code{gam}).
 }
 }
 
-\section{Verbosity}{
-Setting the global option \code{projpred.extra_verbose} to \code{TRUE} will print out
-which submodel \pkg{projpred} is currently projecting onto as well as (if
-\code{method = "forward"} and \code{verbose = TRUE} in \code{\link[=varsel]{varsel()}} or \code{\link[=cv_varsel]{cv_varsel()}})
-which submodel has been selected at those steps of the forward search for
-which a percentage (of the maximum submodel size that the search is run up
-to) is printed. In general, however, we cannot recommend setting this global
-option to \code{TRUE} for \code{\link[=cv_varsel]{cv_varsel()}} with \code{validate_search = TRUE} (simply due
-to the amount of information that will be printed, but also due to the
-progress bar which will not work anymore as intended).
+\section{Verbosity, messages, warnings, errors}{
+Setting global option \code{projpred.extra_verbose} to \code{TRUE} will print out which
+submodel \pkg{projpred} is currently projecting onto as well as (if \code{method = "forward"} and \code{verbose = TRUE} in \code{\link[=varsel]{varsel()}} or \code{\link[=cv_varsel]{cv_varsel()}}) which
+submodel has been selected at those steps of the forward search for which a
+percentage (of the maximum submodel size that the search is run up to) is
+printed. In general, however, we cannot recommend setting this global option
+to \code{TRUE} for \code{\link[=cv_varsel]{cv_varsel()}} with \code{validate_search = TRUE} (simply due to the
+amount of information that will be printed, but also due to the progress bar
+which will not work as intended anymore).
+
+By default, \pkg{projpred} catches messages and warnings from the draw-wise
+divergence minimizers and throws their unique collection after performing all
+draw-wise divergence minimizations (i.e., draw-wise projections). This can be
+deactivated by setting global option \code{projpred.warn_prj_drawwise} to \code{FALSE}.
+
+Furthermore, by default, \pkg{projpred} checks the convergence of the
+draw-wise divergence minimizers and throws a warning if any seem to have not
+converged. This warning is thrown after the warning message from global
+option \code{projpred.warn_prj_drawwise} (see above) and can be deactivated by
+setting global option \code{projpred.check_conv} to \code{FALSE}.
 }
 
 \section{Parallelization}{

From c6a3b5e893b62fe236539ea15dbdb4b77618dca6 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 22 Nov 2023 12:39:27 +0100
Subject: [PATCH 45/46] Add `NEWS.md` entries for the collection of draw-wise
 warnings and for the convergence checker.

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 6a9bdad47..572e1f164 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -11,6 +11,8 @@ If you read this from a place other than <https://mc-stan.org/projpred/news/inde
 * `print.vselsummary()` (and hence also `print.vsel()`) now prints the reference model's performance evaluation results as well (not just those of the submodels). Correspondingly, a new helper function `performances()` has been added which allows to access the reference model's (as well as the submodels') performance evaluation results. (GitHub: #471)
 * Argument `solution_terms` of `project()` has been deprecated. Please use the new argument `predictor_terms` instead. (GitHub: #472)
 * For expert users of the augmented-data projection only: Objects of class `augmat` or `augvec` do not need to have an attribute called `nobs_orig` anymore, but a new attribute called `ndiscrete`, giving the number of (possibly latent) response categories instead of the number of observations (see `` ?`augdat-internals` ``). This simplifies the subsetting of such objects. (GitHub: #473)
+* By default, **projpred** now catches messages and warnings from the draw-wise divergence minimizers and throws their unique collection after performing all draw-wise divergence minimizations (i.e., draw-wise projections). This can be deactivated by setting global option `projpred.warn_prj_drawwise` to `FALSE`. Previously, **projpred** suppressed such messages and warnings. (GitHub: #478)
+* By default, **projpred** now checks the convergence of the draw-wise divergence minimizers and throws a warning in case of potential convergence problems. This can be deactivated by setting global option `projpred.check_conv` to `FALSE`. (GitHub: #478)
 
 ## Minor changes
 

From ab6544ec13c48248a584b31b328666ec657da646 Mon Sep 17 00:00:00 2001
From: fweber144 <fweber144@protonmail.com>
Date: Wed, 22 Nov 2023 13:42:33 +0100
Subject: [PATCH 46/46] Formulate `check_conv()`'s warning more cautiously
 (because it is also

thrown if the draw-wise divergence minimizer threw only informational messages).
---
 R/divergence_minimizers.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/divergence_minimizers.R b/R/divergence_minimizers.R
index f6bbc493b..e9b7e3dd7 100644
--- a/R/divergence_minimizers.R
+++ b/R/divergence_minimizers.R
@@ -992,7 +992,7 @@ check_conv <- function(outdmin, lengths_mssgs_warns, do_check = TRUE) {
     cls <- paste0("c(", paste(paste0("\"", cls, "\""), collapse = ", "), ")")
     warning(
       not_conv, " out of ", length(is_conv), " submodel fits (there is one ",
-      "submodel fit per projected draw) seem to have not converged ",
+      "submodel fit per projected draw) might not have converged ",
       "(appropriately). It is recommended to inspect this in detail and (if ",
       "necessary) to adjust tuning parameters via `...` (the ellipsis of the ",
       "employed top-level function such as project(), varsel(), or ",