tests/testthat/test-scale_arrow.R

In ggarrow: Arrows for 'ggplot2'

test_that("continuous arrow scales throw correct errors", {

  f <- "text"
  expect_error(
    scale_arrow_head_continuous(generator = f),
    "must be a"
  )
  f <- function() "text"
  expect_error(
    scale_arrow_fins_continuous(generator = f),
    "must have arguments"
  )
  f <- function(a, b) a + b
  expect_error(
    scale_arrow_mid_continuous(generator = f, map_arg = "x"),
    "must be an argument"
  )
  expect_warning(
    scale_arrow_head_continuous(
      generator = f, map_arg = "a", other_args = list(foo = "bar")
    ),
    "has unknown arguments"
  )
  expect_error(
    scale_arrow_head_continuous(range = c(-Inf, NA)),
    "must be a finite numeric vector"
  )
})

test_that("scale_resect_continuous gives right scale types", {
  sc <- scale_resect_continuous()
  expect_s3_class(sc, "ScaleContinuousIdentity")

  sc <- scale_resect_continuous(range = c(0, 10))
  expect_false(inherits(sc, "ScaleContinuousIdentity"))
})

test_that("scale_resect_discrete gives right scale types", {

  # Can't leave empty
  expect_error(scale_resect_discrete(), "neither")
  # Or set both
  expect_error(scale_resect_discrete(values = 1, range = c(0, 1)), "both")
  # Can't set negative range
  expect_error(
    scale_resect_discrete(range = c(-10, -1)),
    "number larger than or equal to 0"
  )
})

test_that("arrow_pal works as intended", {
  # Can find functions in ggarrow
  expect_equal(
    arrow_pal("head_wings"),
    list(arrow_head_wings())
  )

  # Cannot find non existing functions
  expect_error(
    arrow_pal("foobar"),
    "Cannot find function"
  )

  on.exit(env_unbind(global_env(), "arrow_foobar"), add = TRUE)

  # Can find functions in global environment
  env_bind(global_env(), arrow_foobar = function() matrix(1:4, ncol = 2))
  expect_equal(
    arrow_pal("foobar"),
    list(matrix(1:4, ncol = 2))
  )

  env_bind(global_env(), arrow_foobar = function() array(1:24, 2:4))
  expect_error(
    arrow_pal("foobar"),
    "not a matrix"
  )

  env_bind(global_env(), arrow_foobar = function() matrix(1:2, ncol = 1))
  expect_error(
    arrow_pal("foobar"),
    "does not have dimension"
  )

  env_bind(
    global_env(),
    arrow_foobar = function() matrix(LETTERS[1:4], ncol = 2)
  )
  expect_error(
    arrow_pal("foobar"),
    "does not have the type"
  )
})

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

df <- data.frame(
  x = c(0, 1, 0, 1, 0, 1),
  y = c(1, 1, 2, 2, 3, 3),
  group = c("A", "A", "B", "B", "C", "C")
)

test_that("discrete arrow_head scales work", {
  p <- ggplot(df, aes(x, y, colour = group)) +
    geom_arrow(
      aes(arrow_head = group),
      length_head = unit(1, "cm"),
      linewidth = 3
    ) +
    scale_arrow_head_discrete(
      values = list("fins_feather", NULL, arrow_head_wings())
    )

  vdiffr::expect_doppelganger("discrete arrow_head scale", p)
})

test_that("discrete arrow_fins scales work", {

  p <- ggplot(df, aes(x, y, colour = group)) +
    geom_arrow(
      aes(arrow_fins = group),
      length_fins = unit(1, "cm"),
      linewidth = 3, arrow_head = NULL
    ) +
    scale_arrow_fins_discrete(
      values = list("head_wings", NULL, arrow_fins_feather())
    )

  vdiffr::expect_doppelganger("discrete arrow_fins scale", p)
})

test_that("discrete arrow_mid scales work", {

  p <- ggplot(df, aes(x, y, colour = group)) +
    geom_arrow(
      aes(arrow_mid = group),
      length_mid = unit(1, "cm"),
      linewidth = 3, arrow_head = NULL
    ) +
    scale_arrow_mid_discrete(
      values = list("head_wings", NULL, arrow_head_line())
    )

  vdiffr::expect_doppelganger("discrete arrow_mid scale", p)
})

test_that("continuous arrow_head scales work", {
  p <- ggplot(df, aes(x, y, colour = group)) +
    geom_arrow(
      aes(arrow_head = y),
      length_head = unit(1, "cm"),
      linewidth = 3
    ) +
    scale_arrow_head_continuous(
      generator = arrow_head_line, map_arg = "angle",
      range = c(30, 60)
    )

  vdiffr::expect_doppelganger("continuous arrow_head scale", p)
})

test_that("continuous arrow_fins scales work", {

  p <- ggplot(df, aes(x, y, colour = group)) +
    geom_arrow(
      aes(arrow_fins = y),
      length_fins = unit(1, "cm"),
      linewidth = 3, arrow_head = NULL
    ) +
    scale_arrow_fins_continuous(
      generator = arrow_fins_line, map_arg = "angle",
      range = c(30, 60)
    )

  vdiffr::expect_doppelganger("continuous arrow_fins scale", p)
})

test_that("continuous arrow_mid scales work", {

  p <- ggplot(df, aes(x, y, colour = group)) +
    geom_arrow(
      aes(arrow_mid = y),
      length_mid = unit(1, "cm"),
      linewidth = 3, arrow_head = NULL
    ) +
    scale_arrow_mid_continuous(
      generator = arrow_fins_feather, map_arg = "height",
      range = c(0.3, 0.9)
    )

  vdiffr::expect_doppelganger("continuous arrow_mid scale", p)
})

test_that("resect scales work", {

  df <- data.frame(
    x = rep(c(0, 1), 4), y = rep(1:4, each = 2),
    group_num  = rep(c(0, 5, 15, 30), each = 2),
    group_char = rep(LETTERS[1:4], each = 2)
  )

  p <- ggplot(df, aes(x, y, group = group_num)) +
    geom_vline(xintercept = c(0, 1), colour = "red")


  vdiffr::expect_doppelganger(
    "identity scale_resect_continuous",
    p + geom_arrow(aes(resect_head = group_num)) +
      scale_resect_continuous()
  )

  vdiffr::expect_doppelganger(
    "continous scale_resect_continuous",
    p + geom_arrow(aes(resect_head = group_num)) +
      scale_resect_continuous(range = c(10, 20))
  )

  vdiffr::expect_doppelganger(
    "ordinal scale_resect_discrete",
    p + geom_arrow(aes(resect_head = group_char)) +
      scale_resect_discrete(range = c(0, 10))
  )

  vdiffr::expect_doppelganger(
    "manual scale_resect_discrete",
    p + geom_arrow(aes(resect_head = group_char)) +
      scale_resect_discrete(values = c(0, 10, 0, 20))
  )
})