tests/testthat/test-arrow_shapes.R

In ggarrow: Arrows for 'ggplot2'

# Heads -------------------------------------------------------------------

test_that("arrow_head_wings displays as intended", {

  arrow <- grob_arrow(
    x = unit(c(0.2, 0.8), "npc"),
    y = unit(c(0, 0), "npc"),
    length_head = unit(10, "mm"), shaft_width = unit(2, "mm"),
    gp = gpar(fill = NA)
  )
  y <- 1 / 6

  offset <- c(20, 30, 90, 45, 135)
  inset  <- c(30, 60, 60, 90, 30)

  arrows <- lapply(seq_along(offset), function(i) {
    my_arrow <- arrow
    my_arrow$y <- unit(c(y, y) * i, "npc")
    my_arrow$arrow_head <- arrow_head_wings(
      offset = offset[i], inset = inset[i]
    )
    my_arrow
  })

  labs <- textGrob(
    y = unit(1:5 * y + 0.5 * y, "npc"),
    label = paste0("offset = ", offset, ", inset = ", inset)
  )

  lines <- segmentsGrob(
    x0 = unit(0.8, "npc") - unit(c(0, 10), "mm"),
    x1 = unit(0.8, "npc") - unit(c(0, 10), "mm"),
    gp = gpar(col = 2:3)
  )

  vdiffr::expect_doppelganger(
    "arrow_head_wings",
    function() {
      grid.newpage()
      grid.draw(lines)
      lapply(arrows, grid.draw)
      grid.draw(labs)
    }
  )
})

test_that("arrow_head_line displays as intended", {

  arrow <- grob_arrow(
    x = unit(c(0.2, 0.8), "npc"),
    y = unit(c(0, 0), "npc"),
    length_head = unit(10, "mm"), shaft_width = unit(2, "mm"),
    gp = gpar(fill = NA)
  )
  y <- 1 / 6

  angle <- c(30, 30, 90, 135, 30)
  linewidth <- unit(c(2, 1, 2, 2, 2), "mm")
  length <- unit(c(10, 10, 10, 10, 15), "mm")
  lineend <- c("butt", "butt", "round", "square", "parallel")

  arrows <- lapply(seq_along(angle), function(i) {
    my_arrow <- arrow
    my_arrow$y <- unit(c(y, y) * i, "npc")
    my_arrow$arrow_head <- arrow_head_line(
      angle = angle[i], lineend = lineend[i]
    )
    my_arrow$length_head <- length[i]
    my_arrow$shaft_width <- linewidth[i]
    my_arrow
  })

  labs <- textGrob(
    y = unit(1:5 * y + 0.5 * y, "npc"),
    label = paste0("angle = ", angle, ", width = ", linewidth, ", length = ",
                   length, ", lineend = ", lineend)
  )

  lines <- segmentsGrob(
    x0 = unit(0.8, "npc"),
    x1 = unit(0.8, "npc"),
    gp = gpar(col = 2)
  )

  vdiffr::expect_doppelganger(
    "arrow_head_line",
    function() {
      grid.newpage()
      grid.draw(lines)
      lapply(arrows, grid.draw)
      grid.draw(labs)
    }
  )
})

test_that("arrow_head_minimal displays as intended", {

  arrow <- grob_arrow(
    x = unit(c(0.2, 0.8), "npc"),
    y = unit(c(0, 0), "npc"),
    length_head = unit(10, "mm"), shaft_width = unit(2, "mm"),
    gp = gpar(fill = NA)
  )
  y <- 1 / 6

  angle <- c(45, 30, 90, 135, 5)
  width <- c(4, 2, 4, 4, 4)

  arrows <- lapply(seq_along(angle), function(i) {
    my_arrow <- arrow
    my_arrow$y <- unit(c(y, y) * i, "npc")
    my_arrow$arrow_head <- arrow_head_minimal(angle = angle[i])
    my_arrow$shaft_width <- unit(width[i], "mm")
    my_arrow
  })

  labs <- textGrob(
    y = unit(1:5 * y + 0.5 * y, "npc"),
    label = paste0("angle = ", angle, ", width = ", width)
  )

  lines <- segmentsGrob(
    x0 = unit(0.8, "npc"),
    x1 = unit(0.8, "npc"),
    gp = gpar(col = 2)
  )

  vdiffr::expect_doppelganger(
    "arrow_head_minimal",
    function() {
      grid.newpage()
      grid.draw(lines)
      lapply(arrows, grid.draw)
      grid.draw(labs)
    }
  )
})

# Fins --------------------------------------------------------------------

test_that("arrow_fins_feather displays as intended", {

  arrow <- grob_arrow(
    x = unit(c(0.2, 0.8), "npc"),
    y = unit(c(0, 0), "npc"),
    arrow_head = NULL,
    length_fins = unit(10, "mm"),
    shaft_width = unit(2, "mm"),
    gp = gpar(fill = NA)
  )
  y <- 1 / 6

  indent  <- c(0.3, 0, 0.3, 0.3, -0.3)
  outdent <- c(0.3, 0.3, 0, 0.3, -0.3)
  height  <- c(0.5, 0.5, 0.5, 1, 0.5)

  arrows <- lapply(seq_along(indent), function(i) {
    my_arrow <- arrow
    my_arrow$y <- unit(c(y, y) * i, "npc")
    my_arrow$arrow_fins <- arrow_fins_feather(
      indent = indent[i], outdent = outdent[i], height = height[i]
    )
    my_arrow$name <- paste0(my_arrow$name, i)
    my_arrow
  })

  labs <- textGrob(
    y = unit(1:5 * y + 0.5 * y, "npc"),
    label = paste0("indent = ", indent, ", outdent = ", outdent, ", height = ",
                   height)
  )

  lines <- segmentsGrob(
    x0 = unit(0.2, "npc") + unit(c(0, 10), "mm"),
    x1 = unit(0.2, "npc") + unit(c(0, 10), "mm"),
    gp = gpar(col = 2:3)
  )

  vdiffr::expect_doppelganger(
    "arrow_fins_feather",
    function() {
      grid.newpage()
      grid.draw(lines)
      lapply(arrows, grid.draw)
      grid.draw(labs)
    }
  )
})

test_that("arrow_fins_line displays as intended", {

  arrow <- grob_arrow(
    x = unit(c(0.2, 0.8), "npc"),
    y = unit(c(0, 0), "npc"),
    arrow_head = NULL,
    length_fins = unit(10, "mm"),
    shaft_width = unit(2, "mm"),
    gp = gpar(fill = NA)
  )
  y <- 1 / 6

  angle  <- c(30, 30, 90, 135, 30)
  width  <- c(2, 1, 2, 2, 2)
  length <- c(10, 10, 10, 10, 15)
  lineend <- c("butt", "butt", "round", "square", "parallel")

  arrows <- lapply(seq_along(angle), function(i) {
    my_arrow <- arrow
    my_arrow$y <- unit(c(y, y) * i, "npc")
    my_arrow$arrow_fins <- arrow_fins_line(
      angle = angle[i], lineend = lineend[i]
    )
    my_arrow$shaft_width <- unit(width[i], "mm")
    my_arrow$length_fins <- unit(length[i], "mm")
    my_arrow$name <- paste0(my_arrow$name, i)
    my_arrow
  })

  labs <- textGrob(
    y = unit(1:5 * y + 0.5 * y, "npc"),
    label = paste0("angle = ", angle, ", width = ", width, ", length = ",
                   length, ", lineend = ", lineend)
  )

  lines <- segmentsGrob(
    x0 = unit(0.2, "npc"),
    x1 = unit(0.2, "npc"),
    gp = gpar(col = 2)
  )

  vdiffr::expect_doppelganger(
    "arrow_fins_line",
    function() {
      grid.newpage()
      grid.draw(lines)
      lapply(arrows, grid.draw)
      grid.draw(labs)
    }
  )
})