tests/testthat/test-gizmo-stepcap.R

In legendry: Extended Legends and Axes for 'ggplot2'

test_that("gizmo_stepcap trains correctly with even.steps = FALSE", {

  na_value <- "#FF0000" # red
  make_scale <- function(limits = NULL, train) {
    scale <- scale_colour_viridis_c(limits = limits, na.value = na_value)
    scale$train(train)
    scale
  }

  guide <- gizmo_stepcap(key = key_bins(even.steps = FALSE, show.limits = TRUE))

  scale  <- make_scale(train = c(10, 30))
  params <- guide$train(guide$params, scale, "colour")

  # Test all key columns
  expect_equal(params$limits, c(10, 30))
  expect_equal(dim(params$key), c(5, 5))
  expect_equal(params$key$colour[c(1,4,5)], c("#452F73", "#B0DA45", NA))
  expect_equal(params$key$min, c(10, 15, 20, 25, NA))
  expect_equal(params$key$max, c(15, 20, 25, 30, NA))
  expect_equal(params$key$.label, c("10", 15, 20, 25, 30))
  expect_equal(params$key$.value, c(10, 15, 20, 25, 30))

  # Upper out of bounds
  scale  <- make_scale(c(10, 30), c(10, 40))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$limits, c(10, 30.02))
  expect_equal(dim(params$key), c(5, 5)) # still 5 because last row was empty
  expect_equal(params$key$colour[c(1,4,5)], c("#452F73", "#B0DA45", na_value))
  expect_equal(params$key$max, c(15, 20, 25, 30, Inf))

  # Lower out of bounds
  scale  <- make_scale(c(10, 30), c(0, 30))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$limits, c(9.98, 30))
  expect_equal(dim(params$key), c(6, 5)) # row insertion
  expect_equal(params$key$colour[c(1,2,5,6)], c(na_value, "#452F73", "#B0DA45", NA))
  expect_equal(params$key$min, c(-Inf, 10, 15, 20, 25, NA))

  # Both out of bounds
  scale <- make_scale(c(10, 30), c(0, 40))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$limits, c(9.98, 30.02))
  expect_equal(dim(params$key), c(6, 5)) # lower row insertion
  expect_equal(params$key$colour[c(1,2,5,6)], c(na_value, "#452F73", "#B0DA45", na_value))
  expect_equal(params$key$min, c(-Inf, 10, 15, 20, 25, 30))
  expect_equal(params$key$max, c(10, 15, 20, 25, 30, Inf))

})

test_that("gizmo_stepcap trains correctly with even.steps = TRUE", {

  na_value <- "#FF0000" # red
  colours  <- c("#440154", "#21908C", "#FDE725")
  breaks   <- c(15, 20)

  make_scale <- function(limits = NULL, train) {
    scale <- scale_colour_viridis_b(
      limits = limits, na.value = na_value, breaks = breaks,
      oob = oob_censor
    )
    scale$train(train)
    scale
  }

  guide <- gizmo_stepcap(key = key_bins(even.steps = TRUE))

  scale  <- make_scale(train = c(10, 40))
  params <- guide$train(guide$params, scale, "colour")

  # Test all key columns
  expect_equal(params$limits, c(10, 40))
  expect_equal(dim(params$key), c(4, 5))
  expect_equal(params$key$colour, c(colours, NA))
  expect_equal(params$key$min, c(10, 20, 30, NA))
  expect_equal(params$key$max, c(20, 30, 40, NA))
  expect_equal(params$key$.label, c(NA, "15", 20, NA))
  expect_equal(params$key$.value, c(NA, 20, 30, NA))

  # Upper out of bounds
  scale  <- make_scale(limits = c(10, 40), c(10, 50))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$limits, c(10, 40.03))
  expect_equal(dim(params$key), c(4, 5)) # still 4 because last row was empty
  expect_equal(params$key$colour, c(colours, na_value))
  expect_equal(params$key$max, c(20, 30, 40, Inf))

  # Lower out of bounds
  scale <- make_scale(limits = c(10, 40), train = c(0, 40))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$limits, c(9.97, 40))
  expect_equal(dim(params$key), c(5, 5)) # row insertion
  expect_equal(params$key$colour, c(na_value, colours, NA))
  expect_equal(params$key$min, c(-Inf, 10, 20, 30, NA))

  # Both out of bounds
  scale <- make_scale(limits = c(10, 40), train = c(0, 50))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$limits, c(9.97, 40.03))
  expect_equal(dim(params$key), c(5, 5)) # lower row insertion
  expect_equal(params$key$colour, c(na_value, colours, na_value))
  expect_equal(params$key$min, c(-Inf, 10, 20, 30, 40))
  expect_equal(params$key$max, c(10, 20, 30, 40, Inf))

})

test_that("gizmo_stepcap can use show.limits correctly", {


  make_scale <- function(limits = NULL, breaks) {
    scale <- scale_colour_viridis_b(
      limits = limits, breaks = breaks, oob = oob_censor
    )
    scale$train(limits)
    scale
  }
  scale <- make_scale(c(10, 30), breaks = c(15, 20))

  # For even steps = FALSE
  guide <- gizmo_stepcap(key = key_bins(even.steps = FALSE, show.limits = FALSE))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$key$.label, c(NA, "15", 20, NA))
  expect_equal(params$key$.value, c(NA, 15, 20, NA))

  guide <- gizmo_stepcap(key = key_bins(even.steps = FALSE, show.limits = TRUE))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$key$.label, c(10, "15", 20, 30))
  expect_equal(params$key$.value, c(10, 15, 20, 30))

  scale <- make_scale(c(10, 40), breaks = c(15, 20))

  # For even steps = TRUE
  guide <- gizmo_stepcap(key = key_bins(even.steps = TRUE, show.limits = FALSE))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$key$.value, c(NA, 20, 30, NA))
  expect_equal(params$key$.label, c(NA, "15", 20, NA))

  guide <- gizmo_stepcap(key = key_bins(even.steps = TRUE, show.limits = TRUE))
  params <- guide$train(guide$params, scale, "colour")

  expect_equal(params$key$.value, c(10, 20, 30, 40))
  expect_equal(params$key$.label, c("10", 15, 20, 40))
})