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)
})
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)
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)
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)
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)
})
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)
})
test_that("calc_v (internal function) works", {
a <- 1:4
expect_identical(calc_v(a, "mean"), 2.5)
expect_identical(calc_v(a, median), 2.5)
expect_equal(calc_v(c(a, NA), mean), NA_real_)
expect_identical(calc_v(c(a, NA), min, list(na.rm = TRUE)), 1L)
expect_error(calc_v(fun = "mean"), "'v' can't be missing")
})
# lbub --------------------------------------------------------------------
test_that("lbub works", {
f1 <- lbub(p = 0.5)
f2 <- lbub(p = 0.5, med = FALSE)
expect_type(f1, "closure")
expect_type(f2, "closure")
expect_identical(
f1(1:50),
setNames(c(13.25, 25.5, 37.75), c("25%", "50%", "75%"))
)
expect_identical(
f2(1:50),
setNames(c(13.25, 37.75), c("25%", "75%"))
)
})
# plot and facet backgrounds ----------------------------------------------
test_that("grid_lines returns correct theme object", {
thm <- theme_default() + grid_lines(size = 1.5, color = "purple")
expect_equal(thm$panel.grid.major, element_line(linewidth = 1.5, color = "purple"))
expect_equal(thm$panel.grid.minor, element_line(linewidth = 0.75, color = "purple"))
})
test_that("panel_bg returns correct theme object", {
bg1 <- panel_bg()
bg2 <- panel_bg(fill = "blue", linetype = 2)
expect_identical(bg1, theme(panel.background = element_rect()))
expect_identical(bg2, theme(panel.background = element_rect(fill = "blue", linetype = 2)))
expect_identical(panel_bg(on = FALSE), theme(panel.background = element_blank()))
})
test_that("plot_bg returns correct theme object", {
bg1 <- plot_bg()
bg2 <- plot_bg(fill = "blue", linetype = 2)
expect_identical(bg1, theme(plot.background = element_rect()))
expect_identical(bg2, theme(plot.background = element_rect(fill = "blue", linetype = 2)))
expect_identical(plot_bg(on = FALSE), theme(plot.background = element_blank()))
})
test_that("facet_bg returns correct theme object", {
bg1 <- facet_bg()
bg2 <- facet_bg(fill = "blue", linetype = 2)
expect_identical(bg1, theme(strip.background = element_rect()))
expect_identical(bg2, theme(strip.background = element_rect(fill = "blue", linetype = 2)))
expect_identical(facet_bg(on = FALSE), theme(strip.background = element_blank()))
})
# legend position and text ------------------------------------------------
test_that("legend_none returns correct theme object", {
none <- legend_none()
expect_s3_class(none, "theme")
expect_equivalent(none, list(legend.position = "none"))
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_false(attr(left, "complete"))
pos <- legend_move(c(0.25, 0.5))
expect_s3_class(pos, "theme")
expect_equivalent(
pos$legend.position.inside %||% pos$legend.position,
c(0.25, 0.5)
)
expect_false(attr(pos, "complete"))
})
test_that("legend_text returns correct theme object", {
expect_equal(
legend_text(size = 16, color = "purple"),
theme(legend.text = element_text(color = "purple", size = 16))
)
})
# axis and facet text --------------------------------------------------
test_that("xaxis_text returns correct theme object", {
expect_identical(xaxis_text(FALSE), theme(axis.text.x = element_blank()))
expect_equal(
xaxis_text(face = "bold", angle = 30),
theme(axis.text.x = element_text(face = "bold", angle = 30))
)
})
test_that("yaxis_text returns correct theme object", {
expect_identical(yaxis_text(FALSE), theme(axis.text.y = element_blank()))
expect_equivalent(
yaxis_text(face = "bold", angle = 30),
theme(axis.text.y = element_text(face = "bold", angle = 30))
)
})
test_that("facet_text returns correct theme object", {
expect_identical(facet_text(FALSE), theme(strip.text = element_blank()))
expect_equal(
facet_text(size = 12, color = "blue"),
theme(strip.text = element_text(color = "blue", size = 12))
)
})
# axis titles -------------------------------------------------------------
test_that("xaxis_title returns correct theme object", {
expect_identical(xaxis_title(FALSE), xlab(NULL))
expect_equal(
xaxis_title(face = "bold", angle = 30),
theme(axis.title.x = element_text(face = "bold", angle = 30))
)
})
test_that("yaxis_title returns correct theme object", {
expect_identical(yaxis_title(FALSE), ylab(NULL))
expect_equal(
yaxis_title(face = "bold", angle = 30),
theme(axis.title.y = element_text(face = "bold", angle = 30))
)
})
# tick marks --------------------------------------------------
test_that("xaxis_ticks returns correct theme object", {
expect_identical(xaxis_ticks(FALSE), theme(axis.ticks.x = element_blank()))
expect_equal(
xaxis_ticks(linewidth = 0.5, color = "red"),
theme(axis.ticks.x = element_line(linewidth = 0.5, color = "red"))
)
})
test_that("yaxis_ticks returns correct theme object", {
expect_identical(yaxis_ticks(FALSE), theme(axis.ticks.y = element_blank()))
expect_equal(
yaxis_ticks(linewidth = 0.5, color = "red"),
theme(axis.ticks.y = element_line(linewidth = 0.5, color = "red"))
)
})
# overlay functions -------------------------------------------------------
test_that("overlay_function returns the correct object", {
expect_error(overlay_function(), 'argument "fun" is missing')
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)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.