Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
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
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# bayesplot (development version)

* Added dedicated unit tests for `param_range()`, `param_glue()`, and `tidyselect_parameters()` tidy parameter selection helpers.
* Use `rlang::warn()` and `rlang::inform()` for selected PPC user messages instead of base `warning()` and `message()`.
* Standardize input validation errors in `ppc_km_overlay()` and interpolation helpers to use `rlang::abort()` for consistent error handling.
* Fix assignment-in-call bug in `mcmc_rank_ecdf()` (#).
Expand Down
132 changes: 132 additions & 0 deletions tests/testthat/test-tidy-params.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,132 @@
source(test_path("data-for-mcmc-tests.R"))

# param_range --------------------------------------------------------------

test_that("param_range selects correct parameters by index", {
all_pars <- c("alpha", "beta[1]", "beta[2]", "beta[3]", "sigma")
result <- param_range("beta", c(1, 3), vars = all_pars)
expect_equal(result, c(2L, 4L))
})

test_that("param_range returns empty integer when no matches", {
all_pars <- c("alpha", "gamma[1]", "gamma[2]")
result <- param_range("beta", 1:3, vars = all_pars)
expect_identical(result, integer(0))
})

test_that("param_range handles single index", {
all_pars <- c("alpha", "beta[1]", "beta[2]", "sigma")
result <- param_range("beta", 2, vars = all_pars)
expect_equal(result, 3L)
})

test_that("param_range drops non-matching indices silently", {
all_pars <- c("alpha", "beta[1]", "beta[3]")
# beta[2] does not exist, should be silently dropped
result <- param_range("beta", 1:3, vars = all_pars)
expect_equal(result, c(2L, 3L))
})

test_that("param_range errors when vars is not NULL or character", {
expect_error(
param_range("beta", 1:3, vars = list("a", "b")),
"'vars' must be NULL or a character vector."
)
expect_error(
param_range("beta", 1:3, vars = 1:5),
"'vars' must be NULL or a character vector."
)
})

# param_glue ---------------------------------------------------------------

test_that("param_glue selects correct parameters with one expression", {
all_pars <- c("alpha[1]", "alpha[2]", "alpha[3]", "sigma")
result <- param_glue("alpha[{i}]", i = c(1, 3), vars = all_pars)
expect_equal(result, c(1L, 3L))
})

test_that("param_glue selects correct parameters with multiple expressions", {
all_pars <- c(
"b[X:1]", "b[X:2]", "b[Y:1]", "b[Y:2]", "sigma"
)
result <- param_glue("b[{var}:{lev}]", var = c("X", "Y"), lev = c(1, 2),
vars = all_pars)
expect_equal(result, c(1L, 3L, 2L, 4L))
})

test_that("param_glue returns empty integer when no matches", {
all_pars <- c("alpha", "sigma")
result <- param_glue("beta[{i}]", i = 1:3, vars = all_pars)
expect_identical(result, integer(0))
})

test_that("param_glue drops non-matching names silently", {
all_pars <- c("b[X:1]", "b[Y:2]", "sigma")
# b[X:2] and b[Y:1] don't exist
result <- param_glue("b[{var}:{lev}]", var = c("X", "Y"), lev = c(1, 2),
vars = all_pars)
expect_equal(result, c(1L, 2L))
})

test_that("param_glue errors when vars is not NULL or character", {
expect_error(
param_glue("alpha[{i}]", i = 1:3, vars = list("a")),
"'vars' must be NULL or a character vector."
)
expect_error(
param_glue("alpha[{i}]", i = 1:3, vars = 42),
"'vars' must be NULL or a character vector."
)
})

# tidyselect_parameters ----------------------------------------------------

test_that("tidyselect_parameters selects by name", {
all_pars <- c("alpha", "beta[1]", "beta[2]", "sigma")
selected <- tidyselect_parameters(all_pars, vars(alpha, sigma))
expect_equal(selected, c("alpha", "sigma"))
})

test_that("tidyselect_parameters works with tidyselect helpers", {
all_pars <- c("alpha", "beta[1]", "beta[2]", "sigma")
selected <- tidyselect_parameters(all_pars, vars(starts_with("beta")))
expect_equal(selected, c("beta[1]", "beta[2]"))
})

test_that("tidyselect_parameters works with negation", {
all_pars <- c("alpha", "beta[1]", "beta[2]", "sigma")
selected <- tidyselect_parameters(all_pars, vars(-alpha))
expect_equal(selected, c("beta[1]", "beta[2]", "sigma"))
})

test_that("tidyselect_parameters errors when nothing matches", {
all_pars <- c("alpha", "beta[1]", "sigma")
expect_error(
tidyselect_parameters(all_pars, vars(starts_with("zzz"))),
"No parameters were found matching those names."
)
})

test_that("tidyselect_parameters works with contains()", {
all_pars <- c("b[(Intercept) X:1]", "b[(Intercept) X:2]", "sigma")
selected <- tidyselect_parameters(all_pars, vars(contains("Intercept")))
expect_equal(selected, c("b[(Intercept) X:1]", "b[(Intercept) X:2]"))
})

# Integration with vars() --------------------------------------------------

test_that("param_range works inside vars() via prepare_mcmc_array", {
result <- prepare_mcmc_array(mat, pars = vars(param_range("beta", 1:2)))
pars <- dimnames(result)[[3]]
expect_equal(pars, c("beta[1]", "beta[2]"))
})

test_that("param_glue works inside vars() via prepare_mcmc_array", {
result <- prepare_mcmc_array(
mat,
pars = vars(param_glue("b[(Intercept) x:{i}]", i = c(1, 3)))
)
pars <- dimnames(result)[[3]]
expect_equal(pars, c("b[(Intercept) x:1]", "b[(Intercept) x:3]"))
})
Loading