test-aesthetics.R
In bayesplot: Plotting for Bayesian Models

library(bayesplot)
context("Aesthetics")


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

prepare_colors_for_test <- function(scheme) {
  setNames(
    bayesplot:::master_color_list[[scheme]],
    bayesplot:::scheme_level_names()
  )
}

test_that("getting and setting the color scheme works", {
  color_scheme_set("red")
  expect_equivalent(color_scheme_get(), prepare_colors_for_test("red"))
  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_named(color_scheme_get(), scheme_level_names())
  }

  expect_output(print(color_scheme_get("mix-blue-green")),
                "mix-blue-green")
  expect_gg(plot(color_scheme_get("mix-blue-green")))

  color_scheme_set("blue")
  expect_equivalent(color_scheme_get("teal"), prepare_colors_for_test("teal"))

  # error if not character
  expect_error(color_scheme_set(7), "'scheme' should be a character vector of length 1 or 6")
})

test_that("color_scheme_get with i argument works", {
  a <- color_scheme_get("green", i = 1)
  expect_equal(length(a), 1)
  expect_named(a, "light")

  b <- color_scheme_get("purple", i = c(2, 4, 5))
  expect_equal(length(b), 3)
  expect_named(b, c("light_highlight", "mid_highlight", "dark"))

  expect_error(
    color_scheme_get(i = 1:7),
    "all(i %in% seq_along(scheme)) is not TRUE",
    fixed = TRUE
  )
  expect_error(
    color_scheme_get(i = c(1, 3, 3)),
    "length(unique(i)) == length(i) is not TRUE",
    fixed = TRUE
  )

  # if is character it should behave the same as internal 'get_color'
  expect_identical(color_scheme_get(i = c("l", "dh")), get_color(c("l", "dh")))
})

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

  color_scheme_set("mix-blue-gray")
  expect_equivalent(color_scheme_get(), mixed_scheme("blue", "gray"))

  expect_error(color_scheme_set("mix-green-reds"), "should be one of")
  expect_error(color_scheme_set("mix-greens-red"), "should be one of")
})

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"))
  color_scheme_set("brewer-Spectral")
  expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"))
  expect_error(color_scheme_set("brewer-FAKE"), "FAKE is not a valid palette")
})

orange_scheme_bad <-
  orange_scheme_ok <-
  c("not_a_color1",
    "#ffcc80",
    "#ffad33",
    "#e68a00",
    "#995c00",
    "not_a_color2")
orange_scheme_ok[c(1, 6)] <- c("#ffebcc", "#663d00")

test_that("color_scheme_set throws correct errors for custom schemes ", {
  expect_error(color_scheme_set(orange_scheme_bad),
               "not found: not_a_color1, not_a_color2")
  expect_error(color_scheme_set(c("red", "blue")),
               "should be a character vector of length 1 or 6")
  expect_error(prepare_custom_colors(c("red", "blue")),
               "Custom color schemes must contain exactly 6 colors")
})

test_that("mixed_scheme internal function doesn't error", {
  x <- mixed_scheme("green", "red")
  expect_equal(length(x), 6)
  expect_true(all(sapply(x, is.character)))
})

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)

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

test_that("get_color returns correct color values", {
  scheme <- color_scheme_set("green")
  levs <- scheme_level_names()

  ans <- unlist(prepare_colors_for_test("green")[levs], use.names = FALSE)
  expect_identical(get_color(levs), ans)
  for (lev in levs)
    expect_identical(get_color(lev), scheme[[lev]], info = lev)
})

test_that("color_scheme_view returns correct ggplot object", {
  color_scheme_set("red")

  a <- color_scheme_view()
  b <- color_scheme_view("green")
  expect_gg(a)
  expect_gg(b)
  expect_identical(a$plot_env$x, color_scheme_get())
  expect_identical(b$plot_env$x, color_scheme_get("green"))
})

test_that("color_scheme_view returns gtable if length(scheme) >= 1", {
  expect_gtable(color_scheme_view(c("red", "gray")))
  expect_gtable(color_scheme_view(c("red", "gray", "blue")))
})



# ggplot themes ------------------------------------------------------------

default <- theme_default()
minimal <- ggplot2::theme_minimal()
dark <- ggplot2::theme_dark()

test_that("theme_default creates ggplot theme", {
  expect_type(default, "list")
  expect_s3_class(default, "theme")

  thm2 <- theme_default(base_size = 13)
  expect_type(thm2, "list")
  expect_s3_class(thm2, "theme")
  expect_equal(thm2[["text"]][["size"]], 13)
})

test_that("bayesplot_theme_set warns of missing theme elements", {
  dark2 <- ggplot2::theme_dark()
  dark2$line <- NULL
  expect_warning(
    bayesplot_theme_set(dark2),
    "New theme missing the following elements: line"
  )
  bayesplot_theme_set()
})

test_that("bayesplot_theme_set/get work", {
  bayesplot_theme_set()
  expect_identical(bayesplot_theme_get(), default)
  expect_identical(bayesplot_theme_set(), default)

  old <- bayesplot_theme_set(minimal)
  expect_identical(old, default)
  expect_identical(bayesplot_theme_get(), minimal)
})

test_that("bayesplot_theme_update/replace work", {
  bayesplot_theme_set(minimal)
  old <- bayesplot_theme_update(axis.text.x = ggplot2::element_text(color = "red"))
  expect_identical(old, minimal)

  thm <- bayesplot_theme_get()
  expect_identical(thm, minimal + xaxis_text(color = "red"))
  expect_equal(thm$axis.text.x$colour, "red")
  expect_null(thm$axis.text.x$size)

  bayesplot_theme_update(axis.text.x = ggplot2::element_text(size = 13))
  thm <- bayesplot_theme_get()
  expect_equal(thm$axis.text.x$colour, "red")
  expect_equal(thm$axis.text.x$size, 13)

  old <- bayesplot_theme_replace(axis.text.x = ggplot2::element_text(color = "green"))
  expect_identical(old, thm)
  thm <- bayesplot_theme_get()
  expect_equal(thm$axis.text.x$colour, "green")
  expect_null(thm$axis.text.x$size)
})

test_that("ggplot2::theme_set overrides bayesplot theme", {
  ggplot2::theme_set(dark)
  bayesplot_theme_set()
  expect_identical(ggplot2::theme_get(), dark)
  expect_identical(bayesplot_theme_get(), default)

  ggplot2::theme_set(minimal)
  expect_identical(bayesplot_theme_get(), minimal)
})

bayesplot_theme_set(bayesplot::theme_default())
color_scheme_set()



# Visual tests ------------------------------------------------------------

test_that("color_scheme_view renders correctly", {
  testthat::skip_on_cran()
  testthat::skip_if_not_installed("vdiffr")

  color_scheme_set()
  p_default <- color_scheme_view()
  vdiffr::expect_doppelganger("color_scheme_view (default)", p_default)

  p_red <- color_scheme_view("red")
  vdiffr::expect_doppelganger("color_scheme_view (scheme specified)", p_red)

  p_mix <- color_scheme_view("mix-red-blue")
  vdiffr::expect_doppelganger("color_scheme_view (mixed scheme)", p_mix)

  p_brewer <- color_scheme_view("brewer-Spectral")
  vdiffr::expect_doppelganger("color_scheme_view (brewer palette)", p_brewer)

  color_scheme_set()
})

bayesplot_theme_set(bayesplot::theme_default())
color_scheme_set()