test-trig_helpers.R
In geomtextpath: Curved Text in 'ggplot2'

test_that("before and after give sensible outputs", {

  x <- numeric()

  expect_equal(length(before(x)), 0)
  expect_equal(length(after(x)), 0)

  x <- 1:5
  expect_equal(before(x), c(1, 1:5))
  expect_equal(after(x), c(1:5, 5))
})

test_that("angle_from_xy gives correct results", {

  # Equilateral triangle
  t <- seq(pi, -pi, length.out = 4)
  x <- cos(t)
  y <- sin(t)

  # Correct angles (*not* -30, 90, 30 as one might expect)
  ang <- angle_from_xy(x, y, degrees = TRUE)
  expect_equal(ang, c(30, -90, 150))

  # Reverse path should gave same angles as forward path, but negative
  ang_test <- angle_from_xy(rev(x), rev(y), degrees = TRUE)
  expect_equal(ang_test, -ang)

  # Radian and degree mode give same angles
  ang_test <- angle_from_xy(x, y, degrees = FALSE)
  expect_equal(ang_test, ang / 180 * pi)

  # Normal should be 90 degrees offset
  ang_test <- angle_from_xy(x, y, norm = TRUE, degrees = TRUE)
  expect_equal(ang_test, ang + 90)

  # Should be able to handle length-2 vectors
  ang_test <- angle_from_xy(x[1:2], y[1:2], degrees = TRUE)
  expect_equal(ang_test, 30)

  x <- unit(c(0, 1), "in")
  y <- unit(c(0, 1), "in")
  expect_equal(angle_from_xy(x, y, degrees = TRUE), 45)
})

test_that("arclength_from_xy gives correct results", {

  # Vector mode
  lens   <- runif(50)
  angles <- runif(50, max = 2 * pi)

  x <- cumsum(lens * cos(angles))
  y <- cumsum(lens * sin(angles))

  arclen <- arclength_from_xy(x, y)
  expect_equal(arclen[50], sum(lens[2:50]))

  # Matrix mode
  x <- cbind(x[1:25], x[26:50])
  y <- cbind(y[1:25], y[26:50])

  arclen <- arclength_from_xy(x, y)
  expect_equal(arclen[25, ], c(sum(lens[2:25]), sum(lens[27:50])))

  x <- unit(c(0, 3), "npc")
  y <- unit(c(0, 4), "npc")

  expect_equal(arclength_from_xy(x, y), c(0, 5))

  expect_equal(arclength_from_xy(0, 0), 0)
  expect_equal(arclength_from_xy(0, NA), as.numeric(NA))
  expect_equal(arclength_from_xy(NA, 0), as.numeric(NA))

})

test_that("get_offset offsets correctly", {

  x <- c(1:5)
  y <- c(1, 2, 3, 2, 1)

  offset <- get_offset(x, y, d = 1:2 / sqrt(2))

  expect_equal(
    offset$x,
    cbind(c(0.5, 1.5, 3, 4.5, 5.5), c(0, 1, 3, 5, 6))
  )

  expect_equal(
    offset$y,
    cbind(c(1.5, 2.5, 4, 2.5, 1.5), c(2, 3, 5, 3, 2))
  )

  expect_equal(
    offset$arc_length,
    cbind(c(0, 2, 5, 8, 10), c(0, 2, 6, 10, 12)) / sqrt(2)
  )
})

test_that("We can measure curvature accurately", {

  # x and y describe a circle with radius 1:
  t <- seq(0, 360, length.out = 1000) * pi / 180
  x <- cos(t)
  y <- sin(t)

  curv_1 <- get_curvature(x, y)

  # the curvature should be the reciprocal of the radius
  radius_1 <- 1 / curv_1

  expect_true(
    all(abs(radius_1 - 1) < 0.001)
  )

  # Doubling the radius of the circle should half the curvature
  curv_2 <- get_curvature(2 * x, 2 * y)

  expect_true(
    all(abs((curv_1 / curv_2) - 2) < 0.001)
  )
})

test_that("We can roll our own means", {

  val <- c(4.25, 5.75, 5.75, 6, 5.5, 5.5, 5, 6, 5, 3.5, 4)
  expect_equal(val, safe_rollmean(c(3, 8, 9, 3, 4, 6, 9, 1, 8, 2, 3), k = 4))
  expect_equal(val, safe_rollmean(val, k = 1))
})


test_that("We can find the flattest point of a curve", {

  x <- 1:100
  y <- sin(seq(0, 2 * pi, len = 100))
  expect_equal(which.min_curvature(x, y), 1)
})


test_that("We can smooth a noisy path", {
  x <- seq(0, 2 * pi, len = 100)
  y <- sin(x) + 0.3 * sin(x * 20)
  id <- rep(1, 100)
  length <- arclength_from_xy(x, y)
  df <- data.frame(x = x, y = y, length = length, id = id)

  df$x <- grid::unit(x, "npc")
  df$y <- grid::unit(y, "npc")

  a <- smooth_noisy(df, 1)

  x1 <- as.numeric(a$x)
  y1 <- as.numeric(a$y)

  expect_true(has_corners(x, y))
  expect_false(has_corners(x1, y1))
})

test_that("We can get a 1-d quadratic Bezier", {

  expected <- (0:10 - 5)^2
  actual   <- quad_bezier(25, -25, 25, seq(0, 1, 0.1))
  expect_equal(actual, expected)
})

test_that("Corners are smoothed appropriately", {

  expected <- structure(list(x = c(0, 1, 4, 9, 16),
                             y = c(0, 7, 12, 15, 16),
                             line_x = c(0, 0, 0, 8, 16),
                             line_y = c(0, 8, 16, 16, 16),
                             line_length = c(0, 8, 16, 24, 32)),
                        class = "data.frame", row.names = c(NA, -5L))
  actual   <- corner_smoother(c(0, 0), c(0, 1), c(1, 1), p = 5)
  expect_equal(actual[-3], expected / 16)

  p1 <- p2 <- p3 <- c(0, 1)
  nms <- c("x", "y", "length", "line_x", "line_y", "line_length")

  expect <- matrix(rep(c(0, 1, 0, 0, 1, 0), each = 20), nrow = 20)
  expect <- setNames(as.data.frame(expect), nms)
  expect_equal(corner_smoother(p1, p2, p3), expect)

  df <- data.frame(x = rep(0, 11), y = 0:10, length = 0:10, line_x = 0,
                   line_y = 0:10, line_length = 0:10)

  expect_equal(corner_smoother(c(0, 0), c(0, 10), c(0, 10), 11), df)
  expect_equal(corner_smoother(c(0, 0), c(0, 0), c(0, 10), 11), df)
})

test_that("We can make a data frame of points between two given points", {

  actual <- linear_smooth(p1 = c(0, 0), p2 = c(0, 10), n = 11)

  df <- data.frame(x = rep(0, 11), y = 0:10, length = 0:10, line_x = 0,
                   line_y = 0:10, line_length = 0:10)

  expect_equal(actual, df)
})

test_that("We can get Bezier control points from segments and paths", {

  x <- 0
  y <- 0
  ang <- pi / 4
  len <- sqrt(2)
  radius <- 0.1
  d <-  sqrt(0.02) / 2

  expect <- matrix(rep(c(0, d, 0.5, 1 - d), 2), ncol = 2)

  expect_equal(segment_control_points(x, y, len, ang, radius), expect)

  expect_equal(segment_control_points(x, y, len, ang, 1),
               matrix(c(0, 1, 0, 1), 2) / 2)

  actual <- find_control_points(data.frame(x = 0:2, y = c(0, 1, 0)), 0.1)

  expect <- c(c(0, 0, d, 0.5, 1 - d, 1, 1 + d, 1.5, 2 - d, 2, 2),
              c(0, 0, d, 0.5, 1 - d, 1, 1 - d, 0.5, d, 0, 0))
  expect <- matrix(expect, ncol = 2)

  expect_equal(actual, expect)

  sc <- smooth_corners(data.frame(x = 0:2, y = c(0, 1, 0)), n = 3, radius = 0.1)

  vec <- c(0, d / 2, d, d, 0.5, 1 - d, 1 - d)
  x <-  c(vec, 1, 2 - rev(vec))
  y <- c(vec, 1 - d / 2, rev(vec))
  len <- cumsum(c(0, sqrt(diff(x)^2 + diff(y)^2)))
  line_len <- c(0, 0.05, 0.1, 0.1, sqrt(2) / 2, sqrt(2) - 0.1, sqrt(2) - 0.1,
                sqrt(2), sqrt(2) + 0.1, sqrt(2) + 0.1, sqrt(2) * 3 / 2,
                2 * sqrt(2) - 0.1, 2 * sqrt(2) - 0.1,
                2*sqrt(2) - 0.05, 2 * sqrt(2))
  df <- data.frame(x = x, y = y, length = len,
                   line_x = x, line_y = y, line_length = line_len,
                   segment = rep(1:5, each = 3))
  df$line_y[8] <- 1

  expect_equal(sc, df)
})

test_that("We can apply both smoothing types", {

  x <- unit((0:2) / 2, "npc")
  y <- unit(c(0, 1, 0), "npc")
  label <- "X"
  id <- c(1, 1, 1)

  png("Rplot_test.png", width = 7, height = 7, units = "in", res = 100)
  grob <- textpathGrob(label, x, y, id, text_smoothing = 50)
  grob <- makeContent(grob)
  x <- convertUnit(grob$children[[2]]$x, "npc", valueOnly = TRUE)
  y <- convertUnit(grob$children[[2]]$y, "npc", valueOnly = TRUE)
  dev.off()
  unlink("Rplot_test.png")

  expect_lt(abs(x - 0.5), 0.003)
  expect_lt(abs(y - 0.9852688), 0.004)
})