tests/testthat/test-regions.R

# -- helpers -------------------------------------------------------------------

square_wkt <- function(xmin, ymin, xmax, ymax) {
  sprintf(
    "POLYGON ((%s %s, %s %s, %s %s, %s %s, %s %s))",
    xmin, ymin, xmax, ymin, xmax, ymax, xmin, ymax, xmin, ymin
  )
}

# -- a5_polygon_to_cells: return type ------------------------------------------

test_that("a5_polygon_to_cells returns one covering", {
  poly <- wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5))
  covering <- a5_polygon_to_cells(poly, resolution = 10)
  expect_s3_class(covering, "a5_covering")
  expect_length(covering, 1L)
  expect_identical(a5_covering_resolution(covering), 10L)
  expect_true(a5_is_valid(covering))
  cells <- a5_uncompact(covering)
  expect_gt(length(cells), 0L)
  expect_true(all(a5_get_resolution(cells) == 10L))
  expect_false(anyDuplicated(cells) > 0)
})

test_that("a5_polygon_to_cells uses centre-point containment (centre cell is inside)", {
  poly <- wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5))
  cells <- a5_polygon_to_cells(poly, resolution = 10)
  centre <- a5_lonlat_to_cell(-3.0, 56.0, resolution = 10)
  expanded <- a5_uncompact(cells, resolution = 10)
  expect_true(format(centre) %in% format(expanded))
})

# -- input shapes --------------------------------------------------------------

test_that("a5_polygon_to_cells accepts a matrix shortcut", {
  m <- cbind(c(-3.5, -2.5, -2.5, -3.5), c(55.5, 55.5, 56.5, 56.5))
  cells_m <- a5_polygon_to_cells(m, resolution = 10)
  cells_w <- a5_polygon_to_cells(
    wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5)),
    resolution = 10
  )
  expect_identical(cells_m, cells_w)
})

test_that("a5_polygon_to_cells accepts a data.frame shortcut", {
  df <- data.frame(
    lon = c(-3.5, -2.5, -2.5, -3.5),
    lat = c(55.5, 55.5, 56.5, 56.5)
  )
  cells_df <- a5_polygon_to_cells(df, resolution = 10)
  cells_w <- a5_polygon_to_cells(
    wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5)),
    resolution = 10
  )
  expect_identical(cells_df, cells_w)
})

test_that("a5_polygon_to_cells accepts wk::rct", {
  rect_cells <- a5_polygon_to_cells(wk::rct(-3.5, 55.5, -2.5, 56.5),
                                    resolution = 10)
  wkt_cells <- a5_polygon_to_cells(
    wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5)),
    resolution = 10
  )
  expect_identical(rect_cells, wkt_cells)
})

test_that("a5_polygon_to_cells accepts a terra SpatVector", {
  skip_if_not_installed("terra")
  sv <- terra::vect(square_wkt(-3.5, 55.5, -2.5, 56.5))
  cells_terra <- a5_polygon_to_cells(sv, resolution = 10)
  cells_w <- a5_polygon_to_cells(
    wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5)),
    resolution = 10
  )
  expect_identical(cells_terra, cells_w)
})

test_that("a5_polygon_to_cells handles a multi-polygon SpatVector", {
  skip_if_not_installed("terra")
  sv <- terra::vect(c(
    square_wkt(-3.5, 55.5, -2.5, 56.5),
    square_wkt(1, 1, 2, 2)
  ))
  cells_terra <- a5_polygon_to_cells(sv, resolution = 8)
  cells_w <- a5_polygon_to_cells(
    wk::wkt(c(
      square_wkt(-3.5, 55.5, -2.5, 56.5),
      square_wkt(1, 1, 2, 2)
    )),
    resolution = 8
  )
  expect_identical(cells_terra, cells_w)
})

test_that("a5_line_string_to_cells accepts a terra SpatVector", {
  skip_if_not_installed("terra")
  sv <- terra::vect("LINESTRING (2.35 48.86, -0.13 51.51)")
  cells_terra <- a5_line_string_to_cells(sv, resolution = 5)
  cells_w <- a5_line_string_to_cells(
    wk::wkt("LINESTRING (2.35 48.86, -0.13 51.51)"),
    resolution = 5
  )
  expect_identical(format(cells_terra), format(cells_w))
})

test_that("a5_polygon_to_cells accepts an sfc polygon", {
  skip_if_not_installed("sf")
  sfc <- sf::st_sfc(
    sf::st_polygon(list(matrix(
      c(-3.5, 55.5, -2.5, 55.5, -2.5, 56.5, -3.5, 56.5, -3.5, 55.5),
      ncol = 2, byrow = TRUE
    ))),
    crs = 4326
  )
  cells_sf <- a5_polygon_to_cells(sfc, resolution = 10)
  cells_w <- a5_polygon_to_cells(
    wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5)),
    resolution = 10
  )
  expect_identical(cells_sf, cells_w)
})

# -- multi-feature: handled natively ------------------------------------------

test_that("MULTIPOLYGON returns the union of cells across parts", {
  mp <- wk::wkt(
    "MULTIPOLYGON (((-3.5 55.5, -2.5 55.5, -2.5 56.5, -3.5 56.5, -3.5 55.5)),
                   ((1 1, 2 1, 2 2, 1 2, 1 1)))"
  )
  union_cells <- a5_polygon_to_cells(mp, resolution = 8)
  part1 <- a5_polygon_to_cells(
    wk::wkt(square_wkt(-3.5, 55.5, -2.5, 56.5)),
    resolution = 8
  )
  part2 <- a5_polygon_to_cells(
    wk::wkt(square_wkt(1, 1, 2, 2)),
    resolution = 8
  )
  u1 <- a5_uncompact(part1, resolution = 8)
  u2 <- a5_uncompact(part2, resolution = 8)
  uu <- a5_uncompact(union_cells, resolution = 8)
  expect_setequal(format(uu), c(format(u1), format(u2)))
})

test_that("sfc of multiple polygons gives one covering per feature", {
  skip_if_not_installed("sf")
  sfc <- sf::st_sfc(
    sf::st_polygon(list(matrix(
      c(-3.5, 55.5, -2.5, 55.5, -2.5, 56.5, -3.5, 56.5, -3.5, 55.5),
      ncol = 2, byrow = TRUE
    ))),
    sf::st_polygon(list(matrix(
      c(1, 1, 2, 1, 2, 2, 1, 2, 1, 1),
      ncol = 2, byrow = TRUE
    ))),
    crs = 4326
  )
  coverings <- a5_polygon_to_cells(sfc, resolution = 8)
  expect_s3_class(coverings, "a5_covering")
  expect_length(coverings, 2L)
  expect_identical(coverings[1], a5_polygon_to_cells(sfc[1], resolution = 8))
  expect_identical(coverings[2], a5_polygon_to_cells(sfc[2], resolution = 8))

  # an sf data frame gets a column
  df <- sf::st_sf(id = 1:2, geometry = sfc)
  df$cells <- a5_polygon_to_cells(df, resolution = 8)
  expect_identical(df$cells, coverings)
})

test_that("each feature keeps its own covering, with NA and empty geometries", {
  polys <- wk::wkt(c(
    square_wkt(-3.5, 55.5, -2.5, 56.5),
    NA,
    "POLYGON EMPTY",
    "MULTIPOLYGON (((0 0, 2 0, 2 2, 0 2, 0 0)), ((5 5, 7 5, 7 7, 5 7, 5 5)))",
    square_wkt(1, 1, 2, 2)
  ))
  out <- a5_polygon_to_cells(polys, resolution = 8)
  expect_length(out, 5L)
  expect_identical(is.na(out), c(FALSE, TRUE, FALSE, FALSE, FALSE))
  expect_identical(lengths(a5_uncompact(out, simplify = FALSE))[3], 0L)
  expect_identical(a5_covering_resolution(out[3]), 8L)
  for (i in c(1L, 4L, 5L)) {
    expect_identical(out[i], a5_polygon_to_cells(polys[i], resolution = 8))
  }
})

# -- holes are properly subtracted --------------------------------------------

test_that("polygon-with-hole subtracts hole cells from the outer", {
  outer <- wk::wkt(square_wkt(0, 0, 4, 4))
  with_hole <- wk::wkt(
    "POLYGON ((0 0, 4 0, 4 4, 0 4, 0 0), (1 1, 2 1, 2 2, 1 2, 1 1))"
  )
  hole <- wk::wkt(square_wkt(1, 1, 2, 2))

  outer_u <- a5_uncompact(a5_polygon_to_cells(outer, resolution = 6),
                          resolution = 6)
  hole_u  <- a5_uncompact(a5_polygon_to_cells(hole, resolution = 6),
                          resolution = 6)
  result_u <- a5_uncompact(a5_polygon_to_cells(with_hole, resolution = 6),
                           resolution = 6)

  # Expected: outer cells minus hole cells.
  expected <- setdiff(format(outer_u), format(hole_u))
  expect_setequal(format(result_u), expected)
})

test_that("hole that lies wholly inside the outer leaves a real gap", {
  # The hole is centred inside the outer; some cells fall fully inside it.
  with_hole <- wk::wkt(
    "POLYGON ((0 0, 8 0, 8 8, 0 8, 0 0), (3 3, 5 3, 5 5, 3 5, 3 3))"
  )
  hole_alone <- wk::wkt(square_wkt(3, 3, 5, 5))

  result_u <- a5_uncompact(a5_polygon_to_cells(with_hole, resolution = 6),
                           resolution = 6)
  hole_u <- a5_uncompact(a5_polygon_to_cells(hole_alone, resolution = 6),
                         resolution = 6)
  # No cell from the hole should appear in the result.
  expect_true(length(intersect(format(result_u), format(hole_u))) == 0L)
})

test_that("polygon with two holes subtracts both", {
  # Outer 0..8 with two disjoint holes.
  outer  <- wk::wkt(square_wkt(0, 0, 8, 8))
  hole_a <- wk::wkt(square_wkt(1, 1, 3, 3))
  hole_b <- wk::wkt(square_wkt(5, 5, 7, 7))
  with_holes <- wk::wkt(
    "POLYGON ((0 0, 8 0, 8 8, 0 8, 0 0),
              (1 1, 3 1, 3 3, 1 3, 1 1),
              (5 5, 7 5, 7 7, 5 7, 5 5))"
  )

  outer_u  <- a5_uncompact(a5_polygon_to_cells(outer,  resolution = 6), 6)
  hole_a_u <- a5_uncompact(a5_polygon_to_cells(hole_a, resolution = 6), 6)
  hole_b_u <- a5_uncompact(a5_polygon_to_cells(hole_b, resolution = 6), 6)
  result_u <- a5_uncompact(a5_polygon_to_cells(with_holes, resolution = 6), 6)

  expected <- setdiff(format(outer_u),
                      c(format(hole_a_u), format(hole_b_u)))
  expect_setequal(format(result_u), expected)
})

test_that("MULTIPOLYGON where one part has a hole subtracts only that hole", {
  # First part: outer 0..8 with a hole 3..5. Second part: simple 10..12 square.
  outer1 <- wk::wkt(square_wkt(0, 0, 8, 8))
  hole1  <- wk::wkt(square_wkt(3, 3, 5, 5))
  part2  <- wk::wkt(square_wkt(10, 10, 12, 12))
  mp <- wk::wkt(
    "MULTIPOLYGON (((0 0, 8 0, 8 8, 0 8, 0 0), (3 3, 5 3, 5 5, 3 5, 3 3)),
                   ((10 10, 12 10, 12 12, 10 12, 10 10)))"
  )

  outer1_u <- a5_uncompact(a5_polygon_to_cells(outer1, resolution = 6), 6)
  hole1_u  <- a5_uncompact(a5_polygon_to_cells(hole1,  resolution = 6), 6)
  part2_u  <- a5_uncompact(a5_polygon_to_cells(part2,  resolution = 6), 6)
  result_u <- a5_uncompact(a5_polygon_to_cells(mp, resolution = 6), 6)

  expected <- c(setdiff(format(outer1_u), format(hole1_u)),
                format(part2_u))
  expect_setequal(format(result_u), expected)
})

test_that("MULTIPOLYGON with holes in every part subtracts each independently", {
  outer1 <- wk::wkt(square_wkt(0, 0, 8, 8))
  hole1  <- wk::wkt(square_wkt(3, 3, 5, 5))
  outer2 <- wk::wkt(square_wkt(10, 0, 18, 8))
  hole2  <- wk::wkt(square_wkt(13, 3, 15, 5))
  mp <- wk::wkt(
    "MULTIPOLYGON (((0 0, 8 0, 8 8, 0 8, 0 0), (3 3, 5 3, 5 5, 3 5, 3 3)),
                   ((10 0, 18 0, 18 8, 10 8, 10 0), (13 3, 15 3, 15 5, 13 5, 13 3)))"
  )

  outer1_u <- a5_uncompact(a5_polygon_to_cells(outer1, resolution = 6), 6)
  hole1_u  <- a5_uncompact(a5_polygon_to_cells(hole1,  resolution = 6), 6)
  outer2_u <- a5_uncompact(a5_polygon_to_cells(outer2, resolution = 6), 6)
  hole2_u  <- a5_uncompact(a5_polygon_to_cells(hole2,  resolution = 6), 6)
  result_u <- a5_uncompact(a5_polygon_to_cells(mp, resolution = 6), 6)

  expected <- c(setdiff(format(outer1_u), format(hole1_u)),
                setdiff(format(outer2_u), format(hole2_u)))
  expect_setequal(format(result_u), expected)
})

test_that("sf MULTIPOLYGON with a hole subtracts the hole", {
  skip_if_not_installed("sf")
  outer_ring <- matrix(c(0, 0, 8, 0, 8, 8, 0, 8, 0, 0), ncol = 2, byrow = TRUE)
  hole_ring  <- matrix(c(3, 3, 5, 3, 5, 5, 3, 5, 3, 3), ncol = 2, byrow = TRUE)
  poly <- sf::st_polygon(list(outer_ring, hole_ring))
  sfc <- sf::st_sfc(poly, crs = 4326)

  outer <- wk::wkt(square_wkt(0, 0, 8, 8))
  hole  <- wk::wkt(square_wkt(3, 3, 5, 5))
  outer_u <- a5_uncompact(a5_polygon_to_cells(outer, resolution = 6), 6)
  hole_u  <- a5_uncompact(a5_polygon_to_cells(hole,  resolution = 6), 6)
  result_u <- a5_uncompact(a5_polygon_to_cells(sfc, resolution = 6), 6)

  expected <- setdiff(format(outer_u), format(hole_u))
  expect_setequal(format(result_u), expected)
})

# -- a5_line_string_to_cells ----------------------------------------------------

test_that("a5_line_string_to_cells returns ordered cells along the path", {
  line <- wk::wkt("LINESTRING (2.35 48.86, -0.13 51.51)")
  cells <- a5_line_string_to_cells(line, resolution = 5)
  expect_s3_class(cells, "a5_cell")
  expect_true(length(cells) >= 2)
  start <- a5_lonlat_to_cell(2.35, 48.86, resolution = 5)
  end   <- a5_lonlat_to_cell(-0.13, 51.51, resolution = 5)
  expect_true(format(start) %in% format(cells))
  expect_true(format(end) %in% format(cells))
  expect_equal(length(cells), length(unique(format(cells))))
})

test_that("a5_line_string_to_cells matrix and data.frame shortcuts match wk input", {
  pts <- rbind(c(2.35, 48.86), c(-0.13, 51.51))
  c_w <- a5_line_string_to_cells(wk::wkt("LINESTRING (2.35 48.86, -0.13 51.51)"),
                                resolution = 5)
  c_m <- a5_line_string_to_cells(pts, resolution = 5)
  c_d <- a5_line_string_to_cells(data.frame(lon = pts[, 1], lat = pts[, 2]),
                                resolution = 5)
  expect_identical(format(c_m), format(c_w))
  expect_identical(format(c_d), format(c_w))
})

test_that("MULTILINESTRING parts join into one deduplicated path", {
  ml <- wk::wkt(
    "MULTILINESTRING ((2.35 48.86, -0.13 51.51),
                      (-0.13 51.51, 4.83 45.76))"
  )
  cells <- a5_line_string_to_cells(ml, resolution = 5)
  expect_s3_class(cells, "a5_cell")
  expect_equal(length(cells), length(unique(format(cells))))
  paris  <- a5_lonlat_to_cell(2.35, 48.86, resolution = 5)
  london <- a5_lonlat_to_cell(-0.13, 51.51, resolution = 5)
  lyon   <- a5_lonlat_to_cell(4.83, 45.76, resolution = 5)
  expect_true(all(c(format(paris), format(london), format(lyon)) %in%
                  format(cells)))
})

test_that("a5_line_string_to_cells handles an antimeridian-crossing path", {
  line <- wk::wkt("LINESTRING (170 0, -170 0)")
  cells <- a5_line_string_to_cells(line, resolution = 5)
  centres <- a5_cell_to_lonlat(cells)
  lons <- wk::wk_coords(centres)$x
  expect_true(any(lons > 160))
  expect_true(any(lons < -160))
})

# -- threading invariance ------------------------------------------------------

test_that("polygon/linestring results are identical with threads > 1", {
  prev <- a5_threads()
  on.exit(a5_threads(prev), add = TRUE)

  mp <- wk::wkt(
    "MULTIPOLYGON (((-3.5 55.5, -2.5 55.5, -2.5 56.5, -3.5 56.5, -3.5 55.5)),
                   ((1 1, 2 1, 2 2, 1 2, 1 1)))"
  )
  ml <- wk::wkt(
    "MULTILINESTRING ((2.35 48.86, -0.13 51.51),
                      (-0.13 51.51, 4.83 45.76))"
  )

  lines <- wk::wkt(c(as.character(ml), "LINESTRING (2.35 48.86, 13.4 52.52)"))

  a5_threads(1)
  p1 <- a5_polygon_to_cells(mp, resolution = 8)
  l1 <- a5_line_string_to_cells(ml, resolution = 5)
  f1 <- a5_line_string_to_cells(lines, resolution = 5, simplify = FALSE)

  a5_threads(2)
  p2 <- a5_polygon_to_cells(mp, resolution = 8)
  l2 <- a5_line_string_to_cells(ml, resolution = 5)
  f2 <- a5_line_string_to_cells(lines, resolution = 5, simplify = FALSE)

  expect_identical(p1, p2)
  expect_identical(l1, l2)
  expect_identical(f1, f2)
})

# -- empty-result behaviour ---------------------------------------------------

test_that("polygon smaller than a single cell gives an empty covering", {
  # A res-14 cell's pentagon is several orders of magnitude smaller than
  # any res-8 cell, so no res-8 centre can lie inside it.
  tiny <- a5_cell_to_boundary(a5_lonlat_to_cell(10, 50, resolution = 14))
  out <- a5_polygon_to_cells(tiny, resolution = 8)
  expect_s3_class(out, "a5_covering")
  expect_length(out, 1L)
  expect_false(is.na(out))
  expect_length(a5_uncompact(out), 0L)
  expect_identical(a5_covering_resolution(out), 8L)
})

# -- input validation: polygon -------------------------------------------------

test_that("polygon matrix and data.frame input must have vertices", {
  expect_error(
    a5_polygon_to_cells(matrix(numeric(), ncol = 2), resolution = 8),
    "no polygon rings"
  )
  expect_error(
    a5_polygon_to_cells(data.frame(lon = numeric(), lat = numeric()), resolution = 8),
    "no polygon rings"
  )
})

test_that("polygon matrix input must have exactly 2 columns", {
  expect_error(
    a5_polygon_to_cells(matrix(0, nrow = 4, ncol = 3), resolution = 8),
    "exactly 2 columns"
  )
  expect_error(
    a5_polygon_to_cells(matrix(0, nrow = 4, ncol = 1), resolution = 8),
    "exactly 2 columns"
  )
})

test_that("polygon matrix input must be numeric", {
  m <- matrix(c("a", "b", "c", "d", "e", "f"), ncol = 2)
  expect_error(
    a5_polygon_to_cells(m, resolution = 8),
    "must be numeric"
  )
})

test_that("polygon data.frame input must have lon and lat columns", {
  expect_error(
    a5_polygon_to_cells(data.frame(x = 1:3, y = 1:3), resolution = 8),
    "lon.*lat"
  )
  expect_error(
    a5_polygon_to_cells(data.frame(lon = 1:3), resolution = 8),
    "lon.*lat"
  )
})

test_that("rings with fewer than 3 distinct vertices are empty, as in the crate", {
  two <- a5_polygon_to_cells(matrix(c(0, 0, 1, 1), ncol = 2), resolution = 8)
  expect_identical(a5_uncompact(two), a5_cell(character()))
  closed <- wk::wkt("POLYGON ((0 0, 1 1, 0 0))")
  expect_identical(a5_uncompact(a5_polygon_to_cells(closed, 8)), a5_cell(character()))
  # a degenerate hole is ignored
  outer <- "(0 0, 2 0, 2 2, 0 2, 0 0)"
  with_hole <- wk::wkt(sprintf("POLYGON (%s, (1 1, 1.5 1.5, 1 1))", outer))
  expect_identical(
    a5_polygon_to_cells(with_hole, 8),
    a5_polygon_to_cells(wk::wkt(sprintf("POLYGON (%s)", outer)), 8)
  )
})

test_that("polygon NA coordinates error", {
  expect_error(
    a5_polygon_to_cells(
      data.frame(lon = c(0, 1, NA, 0), lat = c(0, 0, 1, 0)),
      resolution = 8
    ),
    "NA"
  )
  expect_error(
    a5_polygon_to_cells(
      matrix(c(0, 1, NA, 0, 0, 0, 1, 0), ncol = 2),
      resolution = 8
    ),
    "NA"
  )
})

test_that("polygon rejects wrong geometry types", {
  expect_error(
    a5_polygon_to_cells(wk::wkt("POINT (0 0)"), resolution = 8),
    "POLYGON"
  )
  expect_error(
    a5_polygon_to_cells(wk::wkt("LINESTRING (0 0, 1 1)"), resolution = 8),
    "POLYGON"
  )
})

test_that("an empty geometry gives an empty covering", {
  out <- a5_polygon_to_cells(wk::wkt("POLYGON EMPTY"), resolution = 8)
  expect_length(out, 1L)
  expect_false(is.na(out))
  expect_length(a5_uncompact(out), 0L)
})

test_that("an empty geometry vector gives an empty covering vector", {
  out <- a5_polygon_to_cells(wk::wkt(character()), resolution = 8)
  expect_s3_class(out, "a5_covering")
  expect_length(out, 0L)
})

test_that("polygon rejects non-geometry input", {
  # A plain list isn't wk-handleable.
  expect_error(
    a5_polygon_to_cells(list(a = 1, b = 2), resolution = 8),
    "Could not interpret"
  )
})

# -- input validation: linestring ---------------------------------------------

test_that("linestring matrix input must have exactly 2 columns", {
  expect_error(
    a5_line_string_to_cells(matrix(0, nrow = 4, ncol = 3), resolution = 8),
    "exactly 2 columns"
  )
})

test_that("linestring matrix input must be numeric", {
  m <- matrix(c("a", "b", "c", "d"), ncol = 2)
  expect_error(
    a5_line_string_to_cells(m, resolution = 8),
    "must be numeric"
  )
})

test_that("linestring data.frame input must have lon and lat columns", {
  expect_error(
    a5_line_string_to_cells(data.frame(x = 1:3, y = 1:3), resolution = 8),
    "lon.*lat"
  )
})

test_that("a single waypoint gives the cell containing it, as in the crate", {
  expect_identical(
    a5_line_string_to_cells(matrix(c(10, 20), ncol = 2), resolution = 8),
    a5_lonlat_to_cell(10, 20, resolution = 8)
  )
})

test_that("a5_linestring_to_cells() still works but warns", {
  line <- wk::wkt("LINESTRING (2.35 48.86, -0.13 51.51)")
  expect_warning(
    old <- a5_linestring_to_cells(line, resolution = 5),
    class = "a5R_warning_deprecated"
  )
  expect_identical(old, a5_line_string_to_cells(line, resolution = 5))
})

test_that("linestring NA coordinates error", {
  expect_error(
    a5_line_string_to_cells(
      data.frame(lon = c(0, NA, 1), lat = c(0, 0, 1)),
      resolution = 8
    ),
    "NA"
  )
  expect_error(
    a5_line_string_to_cells(
      matrix(c(0, NA, 1, 0, 0, 1), ncol = 2),
      resolution = 8
    ),
    "NA"
  )
})

test_that("linestring rejects wrong geometry types", {
  expect_error(
    a5_line_string_to_cells(wk::wkt("POINT (0 0)"), resolution = 8),
    "LINESTRING"
  )
  expect_error(
    a5_line_string_to_cells(
      wk::wkt(square_wkt(0, 0, 1, 1)),
      resolution = 8
    ),
    "LINESTRING"
  )
})

test_that("linestring empty and missing geometries contribute no cells", {
  expect_length(a5_line_string_to_cells(wk::wkt("LINESTRING EMPTY"), resolution = 8), 0L)
  expect_length(a5_line_string_to_cells(wk::wkt(character()), resolution = 8), 0L)
  lst <- a5_line_string_to_cells(
    wk::wkt(c("LINESTRING (2.35 48.86, -0.13 51.51)", NA, "LINESTRING EMPTY")),
    resolution = 5, simplify = FALSE
  )
  expect_identical(lengths(lst)[2:3], c(0L, 0L))
  expect_gt(lengths(lst)[1], 0L)
  expect_error(
    a5_line_string_to_cells(matrix(numeric(), ncol = 2), resolution = 8),
    "no linestrings"
  )
})

test_that("linestrings give one ordered path per feature", {
  lines <- wk::wkt(c(
    "LINESTRING (2.35 48.86, -0.13 51.51)",
    "LINESTRING (2.35 48.86, 4.83 45.76)",
    "MULTILINESTRING ((2.35 48.86, -0.13 51.51), (-0.13 51.51, 4.83 45.76))"
  ))
  paths <- a5_line_string_to_cells(lines, resolution = 5, simplify = FALSE)
  expect_s3_class(paths, "a5_cell_list")
  expect_length(paths, 3L)
  for (i in 1:3) {
    expect_identical(paths[[i]], a5_line_string_to_cells(lines[i], resolution = 5))
  }
  # flat form: the paths concatenated, so the shared Paris cell appears twice
  flat <- a5_line_string_to_cells(lines[1:2], resolution = 5)
  expect_identical(flat, vctrs::list_unchop(paths[1:2]))
  paris <- a5_lonlat_to_cell(2.35, 48.86, resolution = 5)
  expect_identical(sum(flat == paris), 2L)
  # within a feature, parts are joined in order and each cell kept once
  expect_false(anyDuplicated(paths[[3]]) > 0)
  expect_identical(paths[[3]][seq_along(paths[[1]])], paths[[1]])
  expect_error(a5_line_string_to_cells(lines, 5, simplify = NA), "TRUE")
})

test_that("linestring paths fill a list column of an sf data frame", {
  skip_if_not_installed("sf")
  df <- sf::st_sf(
    id = 1:2,
    geometry = sf::st_as_sfc(c(
      "LINESTRING (2.35 48.86, -0.13 51.51)",
      "LINESTRING (2.35 48.86, 4.83 45.76)"
    ), crs = 4326)
  )
  df$path <- a5_line_string_to_cells(df, resolution = 5, simplify = FALSE)
  expect_s3_class(df$path, "a5_cell_list")
  expect_identical(df$path[[2]], a5_line_string_to_cells(df[2, ], resolution = 5))
})

test_that("linestring rejects non-geometry input", {
  expect_error(
    a5_line_string_to_cells(list(a = 1, b = 2), resolution = 8),
    "Could not interpret"
  )
})

# -- input validation: shared ------------------------------------------------

test_that("resolution must be in 0..30", {
  poly <- wk::wkt(square_wkt(0, 0, 1, 1))
  line <- wk::wkt("LINESTRING (0 0, 1 1)")
  expect_error(a5_polygon_to_cells(poly, resolution = -1), "resolution")
  expect_error(a5_polygon_to_cells(poly, resolution = 31), "resolution")
  expect_error(a5_line_string_to_cells(line, resolution = -1), "resolution")
  expect_error(a5_line_string_to_cells(line, resolution = 31), "resolution")
})

test_that("resolution must be scalar", {
  poly <- wk::wkt(square_wkt(0, 0, 1, 1))
  line <- wk::wkt("LINESTRING (0 0, 1 1)")
  expect_error(a5_polygon_to_cells(poly, resolution = c(5, 6)), "size 1")
  expect_error(a5_line_string_to_cells(line, resolution = c(5, 6)), "size 1")
})

# -- containment ---------------------------------------------------------------

test_that("containment = 'overlapping' is a superset of the centre result", {
  poly <- wk::wkt(square_wkt(-3.3, 55.9, -3.1, 56.0))
  centre <- a5_uncompact(a5_polygon_to_cells(poly, 10), 10)
  overlap <- a5_uncompact(
    a5_polygon_to_cells(poly, 10, containment = "overlapping"), 10
  )
  expect_s3_class(overlap, "a5_cell")
  expect_true(length(overlap) > length(centre))
  expect_true(all(format(centre) %in% format(overlap)))
})

test_that("containment = 'overlapping' includes cells straddling the boundary", {
  poly <- wk::wkt(square_wkt(-3.3, 55.9, -3.1, 56.0))
  overlap <- a5_uncompact(
    a5_polygon_to_cells(poly, 12, containment = "overlapping"), 12
  )
  # Every polygon vertex lies on the boundary, so its cell must be present.
  corner_cells <- a5_lonlat_to_cell(
    c(-3.3, -3.1, -3.1, -3.3), c(55.9, 55.9, 56.0, 56.0), 12
  )
  expect_true(all(format(corner_cells) %in% format(overlap)))
})

test_that("containment = 'overlapping' still excludes hole interiors", {
  outer <- "(-3.4 55.8, -3.0 55.8, -3.0 56.1, -3.4 56.1, -3.4 55.8)"
  hole <- "(-3.25 55.9, -3.15 55.9, -3.15 56.0, -3.25 56.0, -3.25 55.9)"
  poly <- wk::wkt(sprintf("POLYGON (%s, %s)", outer, hole))
  overlap <- a5_uncompact(
    a5_polygon_to_cells(poly, 12, containment = "overlapping"), 12
  )
  hole_centre <- a5_lonlat_to_cell(-3.2, 55.95, 12)
  expect_false(format(hole_centre) %in% format(overlap))
  # but a cell on the hole edge is kept
  hole_edge <- a5_lonlat_to_cell(-3.25, 55.95, 12)
  expect_true(format(hole_edge) %in% format(overlap))
})

test_that("containment = 'overlapping' works for multi-part input", {
  skip_if_not_installed("sf")
  sq1 <- sf::st_polygon(list(rbind(
    c(-3.5, 55.5), c(-3.0, 55.5), c(-3.0, 56.0), c(-3.5, 56.0), c(-3.5, 55.5)
  )))
  sq2 <- sf::st_polygon(list(rbind(
    c(-2.5, 55.5), c(-2.0, 55.5), c(-2.0, 56.0), c(-2.5, 56.0), c(-2.5, 55.5)
  )))
  multi <- sf::st_sfc(sq1, sq2, crs = 4326)
  each <- unique(c(
    format(a5_uncompact(a5_polygon_to_cells(sf::st_sfc(sq1, crs = 4326), 10,
                                            containment = "overlapping"), 10)),
    format(a5_uncompact(a5_polygon_to_cells(sf::st_sfc(sq2, crs = 4326), 10,
                                            containment = "overlapping"), 10))
  ))
  both <- format(a5_uncompact(
    a5_polygon_to_cells(multi, 10, containment = "overlapping"), 10
  ))
  expect_setequal(both, each)
})

test_that("containment defaults to 'centre'", {
  poly <- wk::wkt(square_wkt(-3.3, 55.9, -3.1, 56.0))
  expect_identical(
    format(a5_polygon_to_cells(poly, 10, containment = "centre")),
    format(a5_polygon_to_cells(poly, 10))
  )
})

test_that("containment rejects invalid values", {
  poly <- wk::wkt(square_wkt(-3.3, 55.9, -3.1, 56.0))
  expect_error(
    a5_polygon_to_cells(poly, 10, containment = "bogus"),
    "containment"
  )
  expect_error(
    a5_polygon_to_cells(poly, 10, containment = 1),
    "containment"
  )
  expect_error(
    a5_polygon_to_cells(poly, 10, containment = c("centre", "centre")),
    "containment"
  )
})

test_that("a whole-globe rct gives every cell", {
  globe <- wk::rct(-180, -90, 180, 90)
  for (res in c(0L, 3L)) {
    expect_identical(a5_count(a5_polygon_to_cells(globe, res)), a5_get_num_cells(res))
    expect_identical(
      a5_count(a5_polygon_to_cells(globe, res, containment = "overlapping")),
      a5_get_num_cells(res)
    )
  }
})

test_that("a pole-to-pole rct keeps its edges on their meridians", {
  lune <- a5_polygon_to_cells(wk::rct(0, -90, 90, 90), 3)
  inner <- a5_polygon_to_cells(wk::rct(0, -89.99, 90, 89.99), 3)
  # a quarter of the globe, with cells of the near-pole box included
  expect_true(all(a5_contains(lune, a5_uncompact(inner))))
  expect_lt(abs(a5_count(lune) - a5_get_num_cells(3) / 4), 10)
})

test_that("ordinary rct boxes match their polygons", {
  boxes <- wk::rct(c(-60, 10), c(-30, 40), c(60, 20), c(30, 50))
  expect_identical(
    a5_polygon_to_cells(boxes, 5),
    a5_polygon_to_cells(wk::as_wkb(boxes), 5)
  )
})

test_that("rct results keep input order around whole-globe and NA boxes", {
  boxes <- wk::rct(
    c(-180, 0, NA, -180),
    c(-90, 0, NA, -90),
    c(180, 10, NA, 180),
    c(90, 10, NA, 90)
  )
  out <- a5_polygon_to_cells(boxes, 3)
  expect_length(out, 4L)
  expect_identical(a5_count(out[c(1, 4)]), rep(a5_get_num_cells(3), 2))
  expect_identical(out[2], a5_polygon_to_cells(boxes[2], 3))
  expect_identical(a5_count(out[3]), 0)
})

test_that("rct boxes 180 degrees wide or more are refused", {
  expect_error(a5_polygon_to_cells(wk::rct(-100, -60, 100, 60), 3), "200 degrees")
  expect_error(a5_polygon_to_cells(wk::rct(-180, -60, 180, 60), 3), "Split it")
})

test_that("projected input is rejected", {
  skip_if_not_installed("sf")
  poly <- sf::st_sfc(
    sf::st_polygon(list(cbind(c(0, 1e5, 1e5, 0, 0), c(0, 0, 1e5, 1e5, 0)))),
    crs = 3857
  )
  expect_error(a5_polygon_to_cells(poly, 4), "longitude/latitude coordinates")
  line <- sf::st_sfc(sf::st_linestring(cbind(c(0, 1e5), c(0, 1e5))), crs = 3857)
  expect_error(a5_line_string_to_cells(line, 4), "longitude/latitude coordinates")
  # no CRS: the coordinate range still catches it
  expect_error(a5_polygon_to_cells(sf::st_set_crs(poly, NA), 4), "outside the longitude/latitude range")
  expect_no_error(a5_polygon_to_cells(sf::st_transform(poly, 4326), 4))
})

test_that("coordinates outside the lon/lat range are rejected", {
  expect_error(
    a5_polygon_to_cells(wk::wkt("POLYGON ((0 0, 1 0, 1 95, 0 0))"), 4),
    "outside the longitude/latitude range"
  )
  expect_error(
    a5_line_string_to_cells(wk::wkt("LINESTRING (0 0, 400 0)"), 4),
    "outside the longitude/latitude range"
  )
})

test_that("containment accepts center as well as centre", {
  poly <- wk::wkt("POLYGON ((-3.3 55.9, -3.1 55.9, -3.1 56, -3.3 56, -3.3 55.9))")
  expect_identical(
    a5_polygon_to_cells(poly, 8, containment = "center"),
    a5_polygon_to_cells(poly, 8, containment = "centre")
  )
})

test_that("a ring that crosses itself is an error, not a flood", {
  bow <- "POLYGON ((8.30 47.40, 8.32 47.42, 8.32 47.40, 8.30 47.42, 8.30 47.40))"
  ok <- "POLYGON ((8.30 47.40, 8.32 47.40, 8.32 47.42, 8.30 47.42, 8.30 47.40))"
  for (containment in c("centre", "overlapping")) {
    expect_error(
      a5_polygon_to_cells(wk::wkt(bow), 14, containment = containment),
      "crosses itself", class = "a5R_error_geometry"
    )
  }
  # the message names the feature
  expect_error(a5_polygon_to_cells(wk::wkt(c(ok, ok, bow)), 10), "Feature 3")
  # a crossing hole is caught too
  holed <- "POLYGON ((8 47, 9 47, 9 48, 8 48, 8 47), (8.30 47.40, 8.32 47.42, 8.32 47.40, 8.30 47.42, 8.30 47.40))"
  expect_error(a5_polygon_to_cells(wk::wkt(holed), 10), class = "a5R_error_geometry")
  # touching and simple rings pass
  expect_no_error(a5_polygon_to_cells(wk::wkt(ok), 10))
  touch <- "POLYGON ((0 0, 2 0, 2 2, 1 1, 0 2, 0 0))"
  expect_no_error(a5_polygon_to_cells(wk::wkt(touch), 8))
  with(a5_threads(2), {
    expect_error(a5_polygon_to_cells(wk::wkt(c(ok, bow)), 10), "Feature 2")
  })
  # a union of two pentagons from DuckDB, valid for s2, with a zero-width
  # spike whose return vertex differs from its start in the last bits
  spike <- wk::wkt(readLines(test_path("fixtures", "spike-ring.wkt")))
  expect_no_error(a5_polygon_to_cells(spike, 10))
})

Try the a5R package in your browser

Any scripts or data that you put into this service are public.

a5R documentation built on Oct. 19, 2026, 5:08 p.m.