From 52055f67447bd9cbb50777905bec0ec81dee206f Mon Sep 17 00:00:00 2001 From: Aki Vehtari Date: Sat, 24 Oct 2026 17:03:09 +0300 Subject: [PATCH 1/2] Adapt the tests to lme4 2.1-0 --- NEWS.md | 2 ++ tests/testthat/helpers/testers.R | 19 ++++++++++--------- tests/testthat/test_augdat.R | 28 ++++++++++++++++------------ 3 files changed, 28 insertions(+), 21 deletions(-) diff --git a/NEWS.md b/NEWS.md index 94ffe21cd..59c9ad9e0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,8 @@ If you read this from a place other than ) + # projpred 2.11.0 diff --git a/tests/testthat/helpers/testers.R b/tests/testthat/helpers/testers.R index 5c82c55be..c804d74dd 100644 --- a/tests/testthat/helpers/testers.R +++ b/tests/testthat/helpers/testers.R @@ -2189,13 +2189,20 @@ vsel_tester <- function( # predictor_ranking expect_type(vs$predictor_ranking, "character") expect_length(vs$predictor_ranking, prd_trms_len_expected) + # The search terms include the linear term of each smooth term (e.g., `s.1` + # for `s(s.1)`): + trms_universe_split_lin <- c( + trms_universe_split, + sub("^s\\((.*)\\)$", "\\1", + grep("^s\\(.*\\)$", trms_universe_split, value = TRUE)) + ) rk_fulldata <- vs$predictor_ranking for (rk_fulldata_plus in grep("\\+", rk_fulldata, value = TRUE)) { rk_fulldata <- setdiff(rk_fulldata, rk_fulldata_plus) rk_fulldata <- c(rk_fulldata, labels(terms(as.formula(paste(". ~", rk_fulldata_plus))))) } - expect_true(all(rk_fulldata %in% trms_universe_split), info = info_str) + expect_true(all(rk_fulldata %in% trms_universe_split_lin), info = info_str) # predictor_ranking_cv if (with_cv && isTRUE(vs$validate_search)) { @@ -2215,14 +2222,8 @@ vsel_tester <- function( rk_cv <- setdiff(rk_cv, rk_cv_plus) rk_cv <- c(rk_cv, labels(terms(as.formula(paste(". ~", rk_cv_plus))))) } - expect_true( - all(rk_cv %in% - c(trms_universe_split, - sub("^s\\((.*)\\)$", "\\1", - grep("^s\\(.*\\)$", trms_universe_split, value = TRUE)), - NA_character_)), - info = info_str - ) + expect_true(all(rk_cv %in% c(trms_universe_split_lin, NA_character_)), + info = info_str) } else { expect_null(vs$predictor_ranking_cv, info = info_str) } diff --git a/tests/testthat/test_augdat.R b/tests/testthat/test_augdat.R index 35dcbc8ba..1cc3ce707 100644 --- a/tests/testthat/test_augdat.R +++ b/tests/testthat/test_augdat.R @@ -219,6 +219,18 @@ test_that(paste( ## Projection ------------------------------------------------------------- +# Whether the submodel of a projection setup has group-level terms. The +# comparisons of traditional and augmented-data projection below skip such +# submodels: lme4::glmer() computes the objective for the group-level parameters +# with binomial()$aic, which rounds non-integer responses (traditional +# projection) and non-integer weights (augmented-data projection), so the two +# projections fit different objectives. glmer() rounds with `nAGQ = 1` in all +# lme4 versions, and since lme4 2.1-0 also with `nAGQ > 1` (the `nAGQ = 30` of +# these projections in setup.R). +has_group_terms_prj <- function(args_prj_i) { + any(grepl("\\|", args_prj_i$predictor_terms)) +} + test_that(paste( "augmented-data and traditional projection give similar results (in case of", "the `brnll` family and the default `regul` for submodels fitted by", @@ -229,6 +241,7 @@ test_that(paste( for (tstsetup in tstsetups) { tstsetup_trad <- sub("\\.augdat\\.", ".trad_compare.", tstsetup) if (!tstsetup_trad %in% names(prjs)) next + if (has_group_terms_prj(args_prj[[tstsetup]])) next cl_used_gt1 <- ndr_ncl_dtls(args_prj[[tstsetup]])$clust_used_gt1 prjmat <- as.matrix(prjs[[tstsetup]], @@ -236,12 +249,7 @@ test_that(paste( prjmat_trad <- as.matrix(prjs[[tstsetup_trad]], allow_nonconst_wdraws_prj = cl_used_gt1) - tol_coefs <- ifelse( - args_prj[[tstsetup]]$mod_nm == "glmm" && - any(grepl("^\\(.*\\)$", args_prj[[tstsetup]]$predictor_terms)), - 1e-3, 1e-5 - ) - expect_equal(prjmat, prjmat_trad, tolerance = tol_coefs, info = tstsetup) + expect_equal(prjmat, prjmat_trad, tolerance = 1e-5, info = tstsetup) } }) @@ -288,6 +296,7 @@ test_that(paste( for (tstsetup in tstsetups) { tstsetup_trad <- sub("\\.augdat\\.", ".trad_compare.", tstsetup) if (!tstsetup_trad %in% names(pls)) next + if (has_group_terms_prj(args_prj[[tstsetup]])) next pl <- pls[[tstsetup]] expect_length(dim(pl$pred), 3) @@ -300,12 +309,7 @@ test_that(paste( dimnames(pl$lpd) <- list(NULL, as.character(seq_len(ncol(pl$lpd)))) pl_trad <- pls[[tstsetup_trad]] - tol_lpreds <- ifelse( - args_prj[[tstsetup]]$mod_nm == "glmm" && - any(grepl("^\\(.*\\)$", args_prj[[tstsetup]]$predictor_terms)), - 1e-4, 1e-5 - ) - expect_equal(pl, pl_trad, tolerance = tol_lpreds, info = tstsetup) + expect_equal(pl, pl_trad, tolerance = 1e-5, info = tstsetup) } }) From 37e98a16ed69117d1691ee7ec6a34e69a40891ea Mon Sep 17 00:00:00 2001 From: Aki Vehtari Date: Sat, 24 Oct 2026 18:50:40 +0300 Subject: [PATCH 2/2] Add the PR number to the NEWS entry --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 59c9ad9e0..a7a5c38d6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,7 +11,7 @@ If you read this from a place other than ) +* Tests: Adapt to version 2.1-0 of package lme4. (GitHub: #577) # projpred 2.11.0