ggh4x: Hacks for 'ggplot2'

base <- ggplot(iris, aes(Species, Sepal.Length)) +
  geom_point() +
  scale_y_sqrt()

# Grabbing scales
build <- ggplot_build(base)
scale_y <- build$layout$panel_params[[1]]$y # continuous
scale_x <- build$layout$panel_params[[1]]$x # discrete


# Construction ------------------------------------------------------------

test_that("constructor works", {
  guide <- guide_axis_manual(
    breaks = ~ .x, labels = ~ .x
  )
  expect_s3_class(guide, c("axis_manual", "axis_ggh4x", "guide", "axis"))

  expect_true(is.function(guide$breaks))
  expect_true(is.function(guide$labels))

})

# Correctness -------------------------------------------------------------

test_that("guide_axis_manual training is correct in continuous axes", {
  scale <- scale_y

  # Test default training, i.e. waivers
  guide <- guide_axis_manual()
  key <- guide_train(guide, scale)$key

  expect_equal(key$y, sqrt(c(5, 6, 7, 8)))
  expect_equal(key$.label, c("5", "6", "7", "8"))

  # Test manual breaks
  guide <- guide_axis_manual(breaks = c(5, 7))
  key <- guide_train(guide, scale)$key

  expect_equal(key$y, sqrt(c(5, 7)))
  expect_equal(key$.label, c("5", "7"))

  # Test manual labels
  guide <- guide_axis_manual(labels = LETTERS[1:4])
  key <- guide_train(guide, scale)$key

  expect_equal(key$y, sqrt(c(5, 6, 7, 8)))
  expect_equal(key$.label, LETTERS[1:4])

  # Test NULL breaks
  guide <- guide_axis_manual(breaks = NULL)
  key <- guide_train(guide, scale)$key

  expect_equal(nrow(key), 0)

  # Test NULL labels
  guide <- guide_axis_manual(labels = NULL)
  key <- guide_train(guide, scale)$key

  expect_equal(ncol(key), 2)

  # Test unit breaks
  guide <- guide_axis_manual(breaks = unit(c(0.45, 0.5, 0.55), "npc"),
                             labels = LETTERS[1:3])
  key <- guide_train(guide, scale)$key

  expect_s3_class(key$y, "unit")
  expect_equal(unclass(key$y), c(0.45, 0.5, 0.55), ignore_attr = TRUE)

  # Test function breaks and labels
  guide <- guide_axis_manual(breaks = mean,
                             labels = ~ .x^2)
  key <- guide_train(guide, scale)$key

  expect_equal(key$y, sqrt(6.1))
  expect_equal(key$.label, 6.1^2)

})

test_that("guide_axis_manual training is correct in continuous axes", {
  scale <- scale_x

  # Test basic functionality
  guide <- guide_axis_manual()
  key <- guide_train(guide, scale)$key

  expect_equal(unclass(key$x), c(1, 2, 3))
  expect_equal(key$.label, c("setosa", "versicolor", "virginica"))

  # Test manual breaks and labels
  guide <- guide_axis_manual(breaks = seq(0.5, 3.5, by = 1),
                             labels = LETTERS[1:4])
  key <- guide_train(guide, scale)$key

  expect_equal(unclass(key$x), c(0.5, 1.5, 2.5, 3.5))
  expect_equal(key$.label, LETTERS[1:4])

  # Test function breaks and labels
  guide <- guide_axis_manual(breaks = rev, labels = toupper)
  key <- guide_train(guide, scale)$key

  expect_equal(unclass(key$x), c(3, 2, 1))
  expect_equal(key$.label, c("VIRGINICA", "VERSICOLOR", "SETOSA"))

  # Test unit breaks
  guide <- guide_axis_manual(breaks = unit(0.5, "npc"), labels = "A")
  key <- guide_train(guide, scale)$key
  xx <<- key

  expect_equal(unclass(key$x), c(0.5), ignore_attr = TRUE)
  expect_s3_class(key$x, "unit")
})



test_that("guide_axis_manual can be placed at every position", {
  rlang::local_options(lifecycle_verbosity = "quiet")

  g <- guides(
    x = guide_axis_manual(label_colour = c("green", "red", "blue")),
    x.sec = guide_axis_manual(breaks = unit(c(0.1, 0.2), "npc"),
                              labels = c("A", "B")),
    y = guide_axis_manual(label_face = "bold"),
    y.sec = guide_axis_manual(breaks = c(5, 7),
                              labels = ~ .x ^ 2)
  )

  if (requireNamespace("vdiffr", quietly = TRUE)) {
    vdiffr::expect_doppelganger("Manual axis all sides", base + g + theme_test())
  }
})

# Warnings and errors -----------------------------------------------------

test_that("warnings and errors work", {
  guide <- guide_axis_manual(breaks = unit(0.5, "cm"))

  expect_snapshot_error(expect_snapshot_warning(
    guide_train(guide, scale_y)
  ))

  guide <- guide_axis_manual()
  guide$available_aes <- "z"

  expect_snapshot_warning(guide_train(guide, scale_x))
})