tests/testthat/test.subguide.R

In ggdist: Visualizations of Distributions and Uncertainty

# Tests for sub-guides
#
# Author: mjskay
###############################################################################

library(dplyr)
library(distributional)


# slabinterval ---------------------------------------------------------

test_that("slab subguide works with dodging", {
  skip_if_no_vdiffr()

  df = data.frame(
    x = c(dist_gamma(1:3,1:3), dist_normal(2:3,0.75)),
    group = c("a","a","a","b","b"),
    subgroup = c("d","e","f","d","e"),
    stringsAsFactors = FALSE
  )

  p = df %>%
    ggplot(aes(ydist = x, x = group, fill = subgroup)) +
    scale_y_continuous(expand = expansion(add = 1)) +
    scale_x_discrete(position = "top")

  vdiffr::expect_doppelganger("slab subguide with dodging and group normalization",
    p + stat_slabinterval(
      subguide = subguide_outside(title = "den", theme = theme_test(), position = "bottom"),
      position = "dodgejust",
      width = 0.9,
      scale = 0.8,
      normalize = "groups",
      n = 11
    ) +
      theme_test() +
      theme(plot.margin = margin(5.5, 5.5, 50, 5.5))
  )
})

test_that("slab subguide positioning works", {
  skip_if_no_vdiffr()

  df = data.frame(x = dist_normal(0,1))

  p = df %>%
    ggplot(aes(xdist = x)) +
    scale_x_continuous(expand = expansion(add = 1))

  p_vert = df %>%
    ggplot(aes(ydist = x)) +
    scale_y_continuous(expand = expansion(add = 1))

  sg = subguide_axis(title = "test", label_side = "inside", theme = theme_test())
  vdiffr::expect_doppelganger("slab subguide with inside labels",
    p +
      stat_slabinterval(aes(y = "1"), subguide = sg(position = 1), n = 5) +
      stat_slabinterval(aes(y = "0.5"), subguide = sg(position = 0.5), n = 5) +
      stat_slabinterval(aes(y = "0"), subguide = sg(position = 0), n = 5) +
      stat_slabinterval(aes(y = "left"), subguide = sg(position = "left"), n = 5) +
      stat_slabinterval(aes(y = "right"), subguide = sg(position = "right"), n = 5) +
      stat_slabinterval(aes(y = "right, just = 1"), subguide = sg(position = "right", just = 1), n = 5) +
      stat_slabinterval(
        aes(y = "inside, right"),
        subguide = subguide_inside(position = "right", title = "test", theme = theme_test()), n = 5
      ) +
      theme_test() +
      theme(plot.margin = margin(5.5,50,5.5,5.5))
  )

  vdiffr::expect_doppelganger("slab subguide with inside labels, vertical",
    p_vert +
      stat_slabinterval(aes(x = "1"), subguide = sg(position = 1), n = 5) +
      stat_slabinterval(aes(x = "0.5"), subguide = sg(position = 0.5), n = 5) +
      stat_slabinterval(aes(x = "0"), subguide = sg(position = 0), n = 5) +
      stat_slabinterval(aes(x = "bottom"), subguide = sg(position = "bottom"), n = 5) +
      stat_slabinterval(aes(x = "top"), subguide = sg(position = "top"), n = 5) +
      stat_slabinterval(aes(x = "top, just = 1"), subguide = sg(position = "top", just = 1), n = 5) +
      stat_slabinterval(
        aes(x = "inside, top"),
        subguide = subguide_inside(position = "top", title = "test", theme = theme_test()), n = 5
      ) +
      theme_test() +
      theme(plot.margin = margin(50,5.5,5.5,5.5))
  )

  sg = subguide_axis(title = "test", label_side = "outside", theme = theme_test())
  vdiffr::expect_doppelganger("slab subguide with outside labels",
    p +
      stat_slabinterval(aes(y = "1"), subguide = sg(position = 1), n = 5) +
      stat_slabinterval(aes(y = "0.5"), subguide = sg(position = 0.5), n = 5) +
      stat_slabinterval(aes(y = "0"), subguide = sg(position = 0), n = 5) +
      stat_slabinterval(aes(y = "left"), subguide = sg(position = "left"), n = 5) +
      stat_slabinterval(aes(y = "right"), subguide = sg(position = "right"), n = 5) +
      stat_slabinterval(aes(y = "right, just = 1"), subguide = sg(position = "right", just = 1), n = 5) +
      stat_slabinterval(
        aes(y = "outside, right"),
        subguide = subguide_outside(position = "right", title = "test", theme = theme_test()), n = 5
      ) +
      theme_test() +
      theme(plot.margin = margin(5.5,50,5.5,5.5))
  )

  vdiffr::expect_doppelganger("slab subguide with outside labels, vert",
    p_vert +
      stat_slabinterval(aes(x = "1"), subguide = sg(position = 1), n = 5) +
      stat_slabinterval(aes(x = "0.5"), subguide = sg(position = 0.5), n = 5) +
      stat_slabinterval(aes(x = "0"), subguide = sg(position = 0), n = 5) +
      stat_slabinterval(aes(x = "bottom"), subguide = sg(position = "bottom"), n = 5) +
      stat_slabinterval(aes(x = "top"), subguide = sg(position = "top"), n = 5) +
      stat_slabinterval(aes(x = "top, just = 1"), subguide = sg(position = "top", just = 1), n = 5) +
      stat_slabinterval(
        aes(x = "outside, top"),
        subguide = subguide_outside(position = "top", title = "test", theme = theme_test()), n = 5
      ) +
      theme_test() +
      theme(plot.margin = margin(50,5.5,5.5,5.5))
  )
})

test_that("slab subguide works with side and justification", {
  skip_if_no_vdiffr()

  df = data.frame(x = dist_normal(0,1))

  p = df %>%
    ggplot(aes(xdist = x)) +
    scale_x_continuous(expand = expansion(add = 1))

  sg = subguide_axis(title = "test", theme = theme_test())
  vdiffr::expect_doppelganger("slab subguide with side",
    p +
      stat_slabinterval(aes(y = "1 bottom"), subguide = sg, side = "bottom", n = 5) +
      stat_slabinterval(aes(y = "2 both"), subguide = sg, side = "both", n = 5) +
      stat_slabinterval(aes(y = "3 top"), subguide = sg, side = "top", n = 5)
  )

  p = df %>%
    ggplot(aes(ydist = x)) +
    scale_y_continuous(expand = expansion(add = 1))

  vdiffr::expect_doppelganger("slab subguide with side vertical",
    p +
      stat_slabinterval(aes(x = "1 left, just 0.5"), subguide = sg, side = "left", justification = 0.5, n = 5) +
      stat_slabinterval(aes(x = "2 both, just 0"), subguide = sg, side = "both", justification = 0, n = 5) +
      stat_slabinterval(aes(x = "3 right"), subguide = sg, side = "right", n = 5)
  )
})

test_that("incompatible slab subguides are detected", {
  df = data.frame(
    x = dist_normal(1:2, 1:2)
  )

  p = ggplot(df) +
    stat_slab(aes(xdist = x), normalize = "groups", subguide = "axis")

  expect_error(layer_grob(p), class = "ggdist_incompatible_subguides")
})


# dots ---------------------------------------------------------

test_that("dots subguide works with dodging", {
  skip_if_no_vdiffr()

  df = tibble(
    x = dist_gamma(1:3, 1:3),
    group = c("a", "a", "b"),
    subgroup = c("d", "e", "d")
  )

  p = df %>%
    ggplot(aes(xdist = x, y = group, fill = subgroup)) +
    scale_x_continuous(expand = expansion(add = 0.25))

  vdiffr::expect_doppelganger("dots subguide with dodging",
    p + stat_dotsinterval(
      subguide = subguide_count(label_side = "outside", title = "num", theme = theme_test()),
      position = "dodgejust",
      slab_color = NA,
      height = 0.9,
      scale = 0.8,
      quantiles = 50
    )
  )
})

test_that("dots subguide works with side and justification", {
  skip_if_no_vdiffr()

  df = data.frame(x = dist_exponential(1))

  p = df %>%
    ggplot(aes(xdist = x)) +
    scale_x_continuous(expand = expansion(add = 0.3))

  sg = subguide_count(title = "num", label_side = "left", theme = theme_test())
  vdiffr::expect_doppelganger("dots subguide with side",
    p +
      stat_dotsinterval(aes(y = "1 bottom"), subguide = sg, side = "bottom", quantiles = 50, stackratio = 1.25) +
      stat_dotsinterval(aes(y = "2 both"), subguide = sg, side = "both", quantiles = 50, stackratio = 1.25) +
      stat_dotsinterval(aes(y = "3 top"), subguide = sg, side = "top", quantiles = 50, stackratio = 1.25)
  )

  p = df %>%
    ggplot(aes(ydist = x)) +
    scale_y_continuous(expand = expansion(add = 0.5))

  sg = subguide_integer(title = "num", label_side = "left", theme = theme_test())
  vdiffr::expect_doppelganger("dots subguide with side vertical",
    p +
      stat_dotsinterval(
        aes(x = "1 left, just 0.5"), subguide = sg, side = "left",
        quantiles = 10, justification = 0.5, stackratio = 0.75
      ) +
      stat_dotsinterval(
        aes(x = "2 both, just 0"), subguide = sg, side = "both",
        quantiles = 10, justification = 0, stackratio = 0.75
      ) +
      stat_dotsinterval(
        aes(x = "3 right"), subguide = sg, side = "right",
        quantiles = 10, stackratio = 0.75
      )
  )
})


# subguide_integer --------------------------------------------------------

test_that("integer subguide corner cases work", {
  df = data.frame(x = c(1, 2), t = c(0, 0.5))

  sg = subguide_integer(theme = theme_test())

  vdiffr::expect_doppelganger("integer subguide with small range",
    df %>%
      ggplot(aes(x = x, thickness = t, y = 0)) +
      geom_slab(subguide = sg, color = "black")
  )


  df = data.frame(x = c(1, 2), t = c(0, 0))

  vdiffr::expect_doppelganger("integer subguide with zero range",
    df %>%
      ggplot(aes(x = x, thickness = t, y = 0)) +
      geom_slab(subguide = sg, color = "black")
  )
})


# subguide_none -----------------------------------------------------------

test_that("subguide_none works", {
  expect_identical(subguide_none(), zeroGrob())
})


# invalid side/position/orientation/etc -----------------------------------------------

test_that("invalid position detected", {
  expect_error(
    subguide_axis(0, position = "abc", orientation = "horizontal"),
    "Unknown position"
  )
  expect_error(
    subguide_axis(0, position = "abc", orientation = "vertical"),
    "Unknown position"
  )
})

test_that("invalid orientation detected", {
  expect_error(
    subguide_axis(0, orientation = "abc"),
    "Unknown orientation"
  )
})

test_that("invalid side detected", {
  expect_error(
    subguide_axis(0, label_side = "abc", orientation = "horizontal"),
    "Unknown side"
  )
  expect_error(
    subguide_axis(0, label_side = "abc", orientation = "vertical"),
    "Unknown side"
  )
})