tests/testthat/test-segments.R

In rcrisp: Automate the Delineation of Urban River Spaces

river <- sf::st_sfc(sf::st_linestring(cbind(c(-6, 6), c(0, 0))))

test_that("Splitting the corridor works with a complex river geometry", {
  river_multilinestring <- sf::st_sfc(c(
    sf::st_linestring(cbind(c(-4, 6), c(0, 0))),
    sf::st_linestring(cbind(c(-6, -4), c(1, 0))),
    sf::st_linestring(cbind(c(-6, -4), c(-1, 0)))
  ))
  corridor <- sf::st_sfc(sf::st_polygon(list(cbind(c(-5, 5, 5, -5, -5),
                                                   c(1, 1, -1, -1, 1)))))
  edges <- get_corridor_edges(corridor, river_multilinestring)
  expect_length(edges, 2)
})

test_that("If the corridor cannot be split in two edges, an error is raised", {
  corridor <- sf::st_sfc(sf::st_polygon(list(cbind(c(-5, 5, 5, -5, -5),
                                                   c(2, 2, 1, 1, 2)))))
  expect_error(get_corridor_edges(corridor, river),
               "Cannot identify corridor edges")
})

test_that("Candidate segments boundaries are properly grouped and filtered", {
  e1 <- sf::st_linestring(cbind(c(-3, -3), c(-1, 1)))  # group 1 <--
  e2 <- sf::st_linestring(cbind(c(-3.1, -2.9), c(-1, 1)))  # group 1
  e3 <- sf::st_linestring(cbind(c(-2, -1.8), c(-1, 1)))  # group 2
  e4 <- sf::st_linestring(cbind(c(-2, -2), c(-1, 1)))  # group 2 <--
  e5 <- sf::st_linestring(cbind(c(-0.5, 0.5), c(-1, 1)))  # group 3 <--
  e6 <- sf::st_linestring(cbind(c(0.5, -0.5), c(-1, 1)))  # group 3
  e7 <- sf::st_linestring(cbind(c(1, 1), c(-1, 1)))  #  group 4 <--
  crossings <- sf::st_sfc(e1, e2, e3, e4, e5, e6, e7)
  expected <- sf::st_sfc(e1, e4, e5, e7)
  actual <- filter_clusters(crossings, river, eps = 0.2)
  expect_setequal(expected, actual)
})

test_that("Intersecting segment boundaries are correctly discarded", {
  e1 <- sf::st_linestring(cbind(c(-2, -1), c(1, -1)))
  e2 <- sf::st_linestring(cbind(c(1, 2), c(1, -1)))
  e3 <- sf::st_linestring(cbind(c(2, -2), c(1, -1)))
  e4 <- sf::st_linestring(cbind(c(3, 1), c(1, -1)))
  lines <- sf::st_sfc(e1, e2, e3, e4)
  corridor <- sf::st_polygon(list(cbind(c(-2, -2, 3, 3, -2),
                                        c(-1, 1, 1, -1, -1))))
  actual <- select_nonintersecting_lines(lines, corridor)
  expected <- sf::st_sfc(e1, e2)
  expect_setequal(actual, expected)
})

test_that("The longest intersecting segment boundaries are discarded first", {
  e1 <- sf::st_linestring(cbind(c(-2, -1), c(1, -1)))
  e2 <- sf::st_linestring(cbind(c(1, 2), c(1, -1)))
  e3 <- sf::st_linestring(cbind(c(0, -2), c(1, -1)))
  e4 <- sf::st_linestring(cbind(c(3, 1), c(1, -1)))
  lines <- sf::st_sfc(e1, e2, e3, e4)
  corridor <- sf::st_polygon(list(cbind(c(-2, -2, 3, 3, -2),
                                        c(-1, 1, 1, -1, -1))))
  actual <- select_nonintersecting_lines(lines, corridor)
  expected <- sf::st_sfc(e1, e2)
  expect_setequal(actual, expected)
})

test_that("Segment boundaries can intersect on the corridor edge", {
  e1 <- sf::st_linestring(cbind(c(-2, -1), c(1, -1)))
  e2 <- sf::st_linestring(cbind(c(1, 2), c(1, -1)))
  e3 <- sf::st_linestring(cbind(c(1, -1), c(1, -1)))
  lines <- sf::st_sfc(e1, e2, e3)
  corridor <- sf::st_polygon(list(cbind(c(-2, -2, 3, 3, -2),
                                        c(-1, 1, 1, -1, -1))))
  actual <- select_nonintersecting_lines(lines, corridor)
  expected <- sf::st_sfc(e1, e2, e3)
  expect_setequal(actual, expected)
})

test_that("The first segment boundary is discarded when length is equal", {
  e1 <- sf::st_linestring(cbind(c(-2, -1), c(1, -1)))
  e2 <- sf::st_linestring(cbind(c(1, 2), c(1, -1)))
  e3 <- sf::st_linestring(cbind(c(-1, -2), c(1, -1)))
  e4 <- sf::st_linestring(cbind(c(2, 1), c(1, -1)))
  lines <- sf::st_sfc(e1, e2, e3, e4)
  corridor <- sf::st_polygon(list(cbind(c(-2, -2, 3, 3, -2),
                                        c(-1, 1, 1, -1, -1))))
  actual <- select_nonintersecting_lines(lines, corridor)
  expected <- sf::st_sfc(e3, e4)
  expect_setequal(actual, expected)
})