tests/testthat/test-bezier.R

In gforge/Gmisc: Descriptive Statistics, Transition Plots, and More

library(testthat)

context("Bézier functions")

test_that("Basic funcitonality", {
  df <- data.frame(x = c(1, 2, 4, 5),
                   y = c(5, 2, 3, 1))
  arrow <- getBezierAdj4Arrw(x = df$x,
                             y = df$y,
                             length_out = 10,
                             arrow_length = .1)
  expect_equal(length(arrow$x), 10)
  expect_equal(length(arrow$y), 10)
  expect_false(all(attr(arrow, "spline_ctrl")$x == df$x),
               info = "The spline should be adjusted according to the arrow length")
  expect_false(all(attr(arrow, "spline_ctrl")$y == df$y),
               info = "The spline should be adjusted according to the arrow length")
  arrow <- getBezierAdj4Arrw(x = df$x,
                             y = df$y,
                             length_out = 10,
                             arrow_length = 0)
  expect_equal(length(arrow$x), 10)
  expect_equal(length(arrow$y), 10)
  expect_true(all(attr(arrow, "spline_ctrl")$x == df$x),
              info = "The spline should be adjusted according to the arrow length")
  expect_true(all(attr(arrow, "spline_ctrl")$y == df$y),
              info = "The spline should be adjusted according to the arrow length")

})

test_that("Check helpers", {
  expect_error(validateAndConvertVectorInputs(1:3, unit(1:3, "npc"), x_origo = 0, y_origo = 0))
  expect_error(validateAndConvertVectorInputs(1:3, 1:3, x_origo = 1))
  expect_error(validateAndConvertVectorInputs(1:3, 1:3, x_origo = 1, y_origo = unit(1, "npc")))

})

test_that("Check vertical lines",{
  structure(list(x = c(68.0508333333333, 68.0508333333333, 68.0508333333334,
                       68.0508333333333, 68.0508333333333, 68.0508333333333,
                       68.0508333333334, 68.0508333333333, 68.0508333333333,
                       68.0508333333333),
                 y = c(13.7230555555556, 13.7569206164501, 13.8576907109782,
                       14.0242092679277, 14.2554021625002, 14.5502479980992,
                       14.9077508947427, 15.326915529896, 15.8067242521733,
                       16.346116150104)),
            .Names = c("x", "y")) -> test

  out <- calculateLinesAndArrow(test$x, test$y, offset = 5)
  expect_true(all(abs(out$right$x - out$right$x[1]) <= .Machine$double.eps * 1e3))
  expect_true(all(abs(out$left$x - out$left$x[1]) <= .Machine$double.eps * 1e3))
  expect_equivalent(10, out$right$x[1] - out$left$x[1], tolerance = .Machine$double.eps * 1e3)

  out <- calculateLinesAndArrow(test$x, rev(test$y), offset = 3)
  # There is some kind of floating error that causes an offset in the
  # value 10^-14 for a few values
  expect_true(all(abs(out$right$x - out$right$x[1]) <= .Machine$double.eps*1e3))
  expect_true(all(abs(out$left$x - out$left$x[1]) <= .Machine$double.eps*1e3))
  expect_true(6 + (out$right$x[1] - out$left$x[1]) <= .Machine$double.eps)
})


test_that("Horizontal_lines",{
  structure(list(x = c(204.1525, 204.0243, 203.6438, 203.0167,
                       202.1486, 201.0447, 199.7103, 198.1507, 196.3712, 194.3776, 192.1755,
                       189.7712, 187.1712, 184.3824, 181.4123, 178.2687, 174.9601, 171.4954,
                       167.8839, 164.1358, 160.2614, 156.2717, 152.1782, 147.9927, 143.7274,
                       139.3949, 135.008, 130.5799, 126.1237, 121.6528, 117.1804, 112.7201,
                       108.2848, 103.8878, 99.5418, 95.2593, 91.0526, 86.9334, 82.9131,
                       79.0026, 75.2124, 71.5522, 68.0316, 64.6594, 61.4438, 58.3927,
                       55.5135, 52.813, 50.2976, 47.9734, 45.8461, 43.9211, 42.2038,
                       40.6991, 39.4121, 38.348, 37.5422),
                 y = c(96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614, 96.0614,
                       96.0614, 96.0614, 96.0614, 96.0614, 96.0614)),
            .Names = c("x", "y")) -> test

  out <- calculateLinesAndArrow(test$x, test$y, offset = 3)
  # There is some kind of floating error that causes an offset in the
  # value 10^-14 for a few values
  expect_true(all(abs(out$right$y - out$right$y[1]) <= .Machine$double.eps*1e3))
  expect_true(all(abs(out$left$y - out$left$y[1]) <= .Machine$double.eps*1e3))
  expect_true(6 - (out$right$y[1] - out$left$y[1]) <= .Machine$double.eps)

  out <- calculateLinesAndArrow(rev(test$x), test$y, offset = 3)
  # There is some kind of floating error that causes an offset in the
  # value 10^-14 for a few values
  expect_true(all(abs(out$right$y - out$right$y[1]) <= .Machine$double.eps*1e3))
  expect_true(all(abs(out$left$y - out$left$y[1]) <= .Machine$double.eps*1e3))
  expect_true(6 + (out$right$y[1] - out$left$y[1]) <= .Machine$double.eps)
})