Skip to content

Adapt the tests to lme4 2.1-0 #577

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
avehtari wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Adapt the tests to lme4 2.1-0 #577

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
52055f6
Adapt the tests to lme4 2.1-0
avehtari Oct 24, 2026
37e98a1
Add the PR number to the NEWS entry
avehtari Oct 24, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,8 @@ If you read this from a place other than <https://mc-stan.org/projpred/news/inde

## Bug fixes and maintenance

* Tests: Adapt to version 2.1-0 of package lme4. (GitHub: #577)


# projpred 2.11.0

Expand Down
19 changes: 10 additions & 9 deletions tests/testthat/helpers/testers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand All @@ -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)
}
Expand Down
28 changes: 16 additions & 12 deletions tests/testthat/test_augdat.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand All @@ -229,19 +241,15 @@ 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]],
allow_nonconst_wdraws_prj = cl_used_gt1)
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)
}
})

Expand Down Expand Up @@ -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)
Expand All @@ -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)
}
})

Expand Down
Loading