Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
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 .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -14,5 +14,6 @@ images/*
book/*
docs/*
Rplots.pdf
.vscode/*
^\.github$
^release-prep\.R$
3 changes: 3 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -13,3 +13,6 @@ revdep/*
CRAN-RELEASE
CRAN-SUBMISSION
release-prep.R

# vscode/positron/etc settings
.vscode/*
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -56,9 +56,10 @@ Suggests:
scales,
shinystan (>= 2.3.0),
survival,
testthat (>= 2.0.0),
testthat (>= 3.0.0),
vdiffr (>= 1.0.2)
RoxygenNote: 7.3.3
VignetteBuilder: knitr
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
Config/testthat/edition: 3
24 changes: 10 additions & 14 deletions tests/testthat/test-aesthetics.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,3 @@
library(bayesplot)
context("Aesthetics")


# color scheme stuff ------------------------------------------------------

prepare_colors_for_test <- function(scheme) {
Expand All @@ -13,13 +9,13 @@ prepare_colors_for_test <- function(scheme) {

test_that("getting and setting the color scheme works", {
color_scheme_set("red")
expect_equivalent(color_scheme_get(), prepare_colors_for_test("red"))
expect_equal(color_scheme_get(), prepare_colors_for_test("red"), ignore_attr = TRUE)
expect_named(prepare_colors_for_test("blue"), scheme_level_names())
expect_named(color_scheme_get(), scheme_level_names())
for (clr in names(master_color_list)) {
color_scheme_set(clr)
expect_equivalent(color_scheme_get(), prepare_colors_for_test(clr),
info = clr)
expect_equal(color_scheme_get(), prepare_colors_for_test(clr),
info = clr, ignore_attr = TRUE)
expect_named(color_scheme_get(), scheme_level_names())
}

Expand All @@ -28,7 +24,7 @@ test_that("getting and setting the color scheme works", {
expect_gg(plot(color_scheme_get("mix-blue-green")))

color_scheme_set("blue")
expect_equivalent(color_scheme_get("teal"), prepare_colors_for_test("teal"))
expect_equal(color_scheme_get("teal"), prepare_colors_for_test("teal"), ignore_attr = TRUE)

# error if not character
expect_error(color_scheme_set(7), "'scheme' should be a character vector of length 1 or 6")
Expand Down Expand Up @@ -60,10 +56,10 @@ test_that("color_scheme_get with i argument works", {

test_that("setting mixed scheme works", {
color_scheme_set("mix-gray-blue")
expect_equivalent(color_scheme_get(), mixed_scheme("gray", "blue"))
expect_equal(color_scheme_get(), mixed_scheme("gray", "blue"), ignore_attr = TRUE)

color_scheme_set("mix-blue-gray")
expect_equivalent(color_scheme_get(), mixed_scheme("blue", "gray"))
expect_equal(color_scheme_get(), mixed_scheme("blue", "gray"), ignore_attr = TRUE)

expect_error(color_scheme_set("mix-green-reds"), "should be one of")
expect_error(color_scheme_set("mix-greens-red"), "should be one of")
Expand All @@ -72,9 +68,9 @@ test_that("setting mixed scheme works", {
test_that("setting brewer scheme works", {
skip_if_not_installed("RColorBrewer")
color_scheme_set("brewer-Blues")
expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Blues"))
expect_equal(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Blues"), ignore_attr = TRUE)
color_scheme_set("brewer-Spectral")
expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"))
expect_equal(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"), ignore_attr = TRUE)
expect_error(color_scheme_set("brewer-FAKE"), "FAKE is not a valid palette")
})

Expand Down Expand Up @@ -106,11 +102,11 @@ test_that("mixed_scheme internal function doesn't error", {
test_that("custom color schemes work", {
color_scheme_set(orange_scheme_ok)
expect_named(color_scheme_get())
expect_equivalent(unlist(color_scheme_get()), orange_scheme_ok)
expect_equal(unlist(color_scheme_get()), orange_scheme_ok, ignore_attr = TRUE)

random_scheme <- colors()[sample(length(colors()), 6)]
color_scheme_set(random_scheme)
expect_equivalent(unlist(color_scheme_get()), random_scheme)
expect_equal(unlist(color_scheme_get()), random_scheme, ignore_attr = TRUE)
})

test_that("get_color returns correct color values", {
Expand Down
4 changes: 0 additions & 4 deletions tests/testthat/test-available_ppc.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,3 @@
library(bayesplot)
context("available_mcmc and available_ppc")


test_that("available_mcmc works", {
a <- available_mcmc()
expect_s3_class(a, "bayesplot_function_list")
Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-bayesplot_grid.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("bayesplot_grid")

skip_if_not_installed("gridExtra")

y <- example_y_data()
Expand Down
31 changes: 15 additions & 16 deletions tests/testthat/test-convenience-functions.R
Original file line number Diff line number Diff line change
@@ -1,42 +1,39 @@
library(bayesplot)
library(ggplot2)
context("Convenience functions (for ggplot objects)")


# abline_01, vline_ and hline_ ------------------------------------------
test_that("abline_01 returns the correct object", {
a <- abline_01(color = "green", linetype = 2)
b <- geom_abline(intercept = 0, slope = 1, color = "green", linetype = 2, na.rm = TRUE)
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)
})
test_that("vline_* and hline_* return correct objects", {
a <- vline_0(color = "red")
b <- geom_vline(xintercept = 0, color = "red", na.rm = TRUE)
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)

a <- hline_0(linewidth = 2, linetype = 3)
b <- geom_hline(yintercept = 0, linewidth = 2, linetype = 3, na.rm = TRUE)
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)

a <- vline_at(c(3,4), na.rm = FALSE)
b <- geom_vline(xintercept = c(3,4))
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)

a <- hline_at(c(3,4), na.rm = FALSE)
b <- geom_hline(yintercept = c(3,4))
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)
})
test_that("vline_at with 'fun' works", {
x <- example_mcmc_draws(chains = 1)
a <- vline_at(x, colMeans)
b <- geom_vline(xintercept = colMeans(x), na.rm = TRUE)
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)
})
test_that("calc_v (internal function) works", {
a <- 1:4
Expand Down Expand Up @@ -99,20 +96,21 @@ test_that("facet_bg returns correct theme object", {
test_that("legend_none returns correct theme object", {
none <- legend_none()
expect_s3_class(none, "theme")
expect_equivalent(none, list(legend.position = "none"))
expect_equal(none$legend.position, "none", ignore_attr = TRUE)
expect_false(attr(none, "complete"))
})
test_that("legend_move returns correct theme object", {
left <- legend_move("left")
expect_s3_class(left, "theme")
expect_equivalent(left, list(legend.position = "left"))
expect_equal(left$legend.position, "left", ignore_attr = TRUE)
expect_false(attr(left, "complete"))

pos <- legend_move(c(0.25, 0.5))
expect_s3_class(pos, "theme")
expect_equivalent(
expect_equal(
pos$legend.position.inside %||% pos$legend.position,
c(0.25, 0.5)
c(0.25, 0.5),
ignore_attr = TRUE
)
expect_false(attr(pos, "complete"))
})
Expand All @@ -133,9 +131,10 @@ test_that("xaxis_text returns correct theme object", {
})
test_that("yaxis_text returns correct theme object", {
expect_identical(yaxis_text(FALSE), theme(axis.text.y = element_blank()))
expect_equivalent(
expect_equal(
yaxis_text(face = "bold", angle = 30),
theme(axis.text.y = element_text(face = "bold", angle = 30))
theme(axis.text.y = element_text(face = "bold", angle = 30)),
ignore_attr = TRUE
)
})
test_that("facet_text returns correct theme object", {
Expand Down Expand Up @@ -185,7 +184,7 @@ test_that("overlay_function returns the correct object", {
a <- overlay_function(fun = "dnorm")
b <- stat_function(fun = "dnorm", inherit.aes = FALSE)
a$constructor <- b$constructor <- NULL
expect_equal(a, b, check.environment = FALSE)
expect_equal(a, b, ignore_function_env = TRUE)
})


Expand Down
5 changes: 1 addition & 4 deletions tests/testthat/test-example-draws.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("Example draws")

test_that("example_mcmc_draws throws correct errors", {
expect_error(example_mcmc_draws(chains = 5), "chains <= 4")
expect_error(example_mcmc_draws(chains = 0), "chains >= 1")
Expand All @@ -26,7 +23,7 @@ test_that("example ppc data works", {

yrep <- example_yrep_draws()
expect_type(yrep, "double")
expect_is(yrep, "matrix")
expect_true(is.matrix(yrep))
expect_equal(ncol(yrep), length(y))

group <- example_group_data()
Expand Down
9 changes: 3 additions & 6 deletions tests/testthat/test-extractors.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("Extractors")

if (requireNamespace("rstanarm", quietly = TRUE)) {
ITER <- 1000
CHAINS <- 3
Expand Down Expand Up @@ -84,7 +81,7 @@ test_that("neff_ratio.stanreg returns correct structure", {
ratio <- neff_ratio(fit)
expect_named(ratio)
ans <- summary(fit)[1:length(ratio), "n_eff"] / (floor(ITER / 2) * CHAINS)
expect_equal(ratio, ans, tol = 0.001)
expect_equal(ratio, ans, tolerance = 0.001)
})

test_that("rhat.stanfit returns correct structure", {
Expand All @@ -107,12 +104,12 @@ test_that("neff_ratio.stanreg returns correct structure", {
ratio <- neff_ratio(fit$stanfit)
expect_named(ratio)
ans <- summary(fit)[, "n_eff"] / denom
expect_equal(ratio, ans, tol = 0.001)
expect_equal(ratio, ans, tolerance = 0.001)

ratio2 <- neff_ratio(fit$stanfit, pars = c("wt", "sigma"))
expect_named(ratio2)
ans2 <- summary(fit, pars = c("wt", "sigma"))[, "n_eff"] / denom
expect_equal(ratio2, ans2, tol = 0.001)
expect_equal(ratio2, ans2, tolerance = 0.001)
})

test_that("cmdstanr methods work", {
Expand Down
17 changes: 10 additions & 7 deletions tests/testthat/test-helpers-mcmc.R
Original file line number Diff line number Diff line change
@@ -1,10 +1,5 @@
library(bayesplot)
context("MCMC: misc. functions")

source(test_path("data-for-mcmc-tests.R"))



# melt_mcmc ----------------------------------------------------------------
test_that("melt_mcmc does not convert integer parameter names to integers #162", {
mat2 <- mat[, 1:2]
Expand Down Expand Up @@ -303,7 +298,11 @@ test_that("diagnostic_factor.rhat works", {
high = 1.2, high = 1.7))

r <- diagnostic_factor(unname(rhats))
expect_equivalent(r, as.factor(names(rhats)))
expect_equal(
r,
factor(names(rhats), levels = c("low", "ok", "high")),
ignore_attr = TRUE
)
expect_identical(levels(r), c("low", "ok", "high"))
})
test_that("diagnostic_factor.neff_ratio works", {
Expand All @@ -312,7 +311,11 @@ test_that("diagnostic_factor.neff_ratio works", {
high = 0.51, high = 0.99, high = 1))

r <- diagnostic_factor(unname(ratios))
expect_equivalent(r, as.factor(names(ratios)))
expect_equal(
r,
factor(names(ratios), levels = c("low", "ok", "high")),
ignore_attr = TRUE
)
expect_identical(levels(r), c("low", "ok", "high"))
})

3 changes: 0 additions & 3 deletions tests/testthat/test-helpers-ppc.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("PPC: misc. functions")

source(test_path("data-for-ppc-tests.R"))
source(test_path("data-for-mcmc-tests.R"))

Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-helpers-shared.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("Shared: misc. functions")

# suggested packages ------------------------------------------------------
test_that("suggested_package throws correct errors", {
expect_error(suggested_package("NOPACKAGE"),
Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-mcmc-combo.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("MCMC: combo")

source(test_path("data-for-mcmc-tests.R"))

test_that("mcmc_combo returns a gtable object", {
Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-mcmc-diagnostics.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("MCMC: diagnostics")

source(test_path("data-for-mcmc-tests.R"))

test_that("rhat and neff plots return a ggplot object", {
Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-mcmc-distributions.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("MCMC: distributions")

source(test_path("data-for-mcmc-tests.R"))

get_palette <- function(ggplot, n) {
Expand Down
12 changes: 4 additions & 8 deletions tests/testthat/test-mcmc-intervals.R
Original file line number Diff line number Diff line change
@@ -1,17 +1,13 @@
library(bayesplot)
context("MCMC: intervals")

source(test_path("data-for-mcmc-tests.R"))


test_that("mcmc_intervals_data computes quantiles", {
xs <- melt_mcmc(merge_chains(prepare_mcmc_array(arr, pars = "beta[1]")))
d <- mcmc_intervals_data(arr, pars = "beta[1]",
prob = .3, prob_outer = .5)

qs <- unlist(d[, c("ll", "l", "m", "h", "hh")])
by_hand <- quantile(xs$Value, c(.25, .35, .5, .65, .75))
expect_equivalent(qs, by_hand)
expect_equal(qs, by_hand, ignore_attr = TRUE)

expect_equal(d$parameter, factor("beta[1]"))
expect_equal(d$outer_width, .5)
Expand All @@ -30,7 +26,7 @@ test_that("mcmc_intervals_data computes point estimates", {
d <- mcmc_intervals_data(arr, pars = "beta[2]",
prob = .3, prob_outer = .5, point_est = "mean")

expect_equivalent(d$m, mean(xs$Value))
expect_equal(d$m, mean(xs$Value), ignore_attr = TRUE)
expect_equal(d$parameter, factor("beta[2]"))
expect_equal(d$point_est, "mean")

Expand Down Expand Up @@ -134,8 +130,8 @@ test_that("mcmc_areas_data computes density", {
densities <- lapply(raw_values, do_dens, 1, 1024)

for (name in names(by_parameter)) {
expect_equivalent(by_parameter[[name]][["density"]],
densities[[name]][["y"]])
expect_equal(by_parameter[[name]][["density"]],
densities[[name]][["y"]], ignore_attr = TRUE)
}
})

Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-mcmc-nuts.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("MCMC: nuts")

if (requireNamespace("rstanarm", quietly = TRUE)) {
ITER <- 1000
CHAINS <- 3
Expand Down
3 changes: 0 additions & 3 deletions tests/testthat/test-mcmc-recover.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
library(bayesplot)
context("MCMC: recover")

set.seed(123)
draws <- matrix(rnorm(4 * 1000), nrow = 1000)
colnames(draws) <- c("alpha", "beta[1]", "beta[2]", "sigma")
Expand Down
Loading