tests/testthat/test-isolines.R

In isoband: Generate Isolines and Isobands from Regularly Spaced Elevation Grids

test_that("line segments get merged", {
  # two connected line segments get merged
  z <- matrix(c(0, 0, 1, 1, 1, 1), ncol = 3, nrow = 2, byrow = TRUE)
  out <- isolines(x = 1:3, y = 2:1, z, levels = 0.5)
  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 * c(1, 2, 2.5) + c(1.5, 1.5, 2.0)
  )
  expect_equal(out[[1]]$id, rep(1, 3))

  # two unconnected line segments don't get merged
  z <- matrix(c(0, 1, 0, 0, 1, 1), ncol = 3, nrow = 2, byrow = TRUE)
  out <- isolines(x = 1:3, y = 2:1, z, levels = 0.5)
  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 * c(2.5, 3.0, 1.5, 1.5) + c(2.0, 1.5, 2.0, 1.0)
  )
  expect_setequal(out[[1]]$id, c(1:2))
  expect_equal(length(out[[1]]$id), 4)

  # two separate lines get merged in second row
  z <- matrix(c(0, 1, 0, 0, 1, 0, 0, 0, 0), ncol = 3, nrow = 3, byrow = TRUE)
  out <- isolines(x = 1:3, y = 3:1, z, levels = 0.5)
  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 * c(2.5, 2.5, 2.0, 1.5, 1.5) + c(3.0, 2.0, 1.5, 2.0, 3.0)
  )
  expect_equal(out[[1]]$id, rep(1, 5))

  # circle gets closed
  z <- matrix(c(0, 0, 0, 0, 1, 0, 0, 0, 0), ncol = 3, nrow = 3, byrow = TRUE)
  out <- isolines(x = 1:3, y = 3:1, z, levels = 0.5)
  # circle is closed
  expect_equal(out[[1]]$x[1], out[[1]]$x[5])
  expect_equal(out[[1]]$y[1], out[[1]]$y[5])
  # coords are correct
  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 * c(2.5, 2.0, 1.5, 2.0, 2.5) + c(2.0, 2.5, 2.0, 1.5, 2.0)
  )
  expect_equal(out[[1]]$id, rep(1, 5))
})

test_that("NAs are handled correctly", {
  z <- matrix(c(NA, 0, 0, 0, 1, 1, 0, 1, 1), ncol = 3, nrow = 3, byrow = TRUE)
  out <- isolines(x = 1:3, y = 3:1, z, levels = 0.5)
  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 * c(1.5, 1.5, 2.0, 3.0) + c(2.0, 1.0, 2.5, 2.5)
  )
  expect_setequal(out[[1]]$id, c(1:2))
  expect_equal(length(out[[1]]$id), 4)
})


test_that("All elementary segments are calculated correctly", {
  # a matrix that requires all elementary segments for isolines
  z <- matrix(
    c(
      0,
      0,
      0,
      1,
      1,
      0,
      1,
      1,
      0,
      0,
      0,
      1,
      1,
      0,
      1,
      1,
      0,
      1,
      1,
      0,
      1,
      1,
      0,
      0,
      1,
      1,
      0,
      0,
      0,
      1,
      1,
      0,
      1,
      0,
      1,
      1,
      0,
      0,
      0,
      1
    ),
    ncol = 8,
    nrow = 5,
    byrow = TRUE
  )
  out <- isolines(x = 1:8, y = 5:1, z, levels = 0.5)

  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 *
      c(
        7.5,
        7.0,
        6.0,
        5.5,
        5.0,
        4.5,
        4.0,
        3.5,
        3.0,
        2.5,
        3.0,
        4.0,
        4.5,
        2.5,
        2.0,
        1.5,
        8.0,
        7.0,
        6.5,
        7.0,
        7.5,
        8.0,
        6.5,
        6.5,
        6.0,
        5.5,
        5.5,
        3.5,
        3.5,
        3.0,
        2.0,
        1.5,
        1.0
      ) +
      c(
        1.0,
        1.5,
        1.5,
        2.0,
        2.5,
        3.0,
        3.5,
        3.0,
        2.5,
        2.0,
        1.5,
        1.5,
        1.0,
        1.0,
        1.5,
        1.0,
        3.5,
        3.5,
        3.0,
        2.5,
        2.0,
        1.5,
        5.0,
        4.0,
        3.5,
        4.0,
        5.0,
        5.0,
        4.0,
        3.5,
        3.5,
        3.0,
        2.5
      )
  )
  expect_setequal(out[[1]]$id, c(1:5))
  expect_equal(length(out[[1]]$id), 33)
})


test_that("Saddles", {
  # a matrix that contains all saddles (there are only two)
  z <- matrix(c(0, 1, 0, 1, 0, 1), ncol = 3, nrow = 2, byrow = TRUE)

  out <- isolines(x = 1:3, y = 2:1, z, levels = 0.5)

  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 *
      c(2.5, 3.0, 2.5, 2.0, 1.5, 1.5, 1.0) +
      c(2.0, 1.5, 1.0, 1.5, 1.0, 2.0, 1.5)
  )
  expect_setequal(out[[1]]$id, c(1:3))
  expect_equal(length(out[[1]]$id), 7)

  out <- isolines(x = 1:3, y = 2:1, z, levels = 0.6)

  expect_setequal(
    10000 * out[[1]]$x + out[[1]]$y,
    10000 *
      c(1.6, 2.0, 2.4, 3.0, 2.6, 1.0, 1.4) +
      c(2.0, 1.6, 2.0, 1.4, 1.0, 1.4, 1.0)
  )
  expect_setequal(out[[1]]$id, c(1:3))
  expect_equal(length(out[[1]]$id), 7)
})