Nothing
# -- 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))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.