edinburgh <- a5_lonlat_to_cell(-3.19, 55.95, resolution = 12) glasgow <- a5_lonlat_to_cell(-4.25, 55.86, resolution = 12) caps <- a5_spherical_cap(c(edinburgh, glasgow), radius = 40000) a <- a5_uncompact(caps[1]) b <- a5_uncompact(caps[2]) test_that("set operations match the expanded cell sets", { expect_identical(a5_uncompact(a5_union(caps[1], caps[2])), vctrs::vec_sort(vctrs::vec_unique(c(a, b)))) expect_identical(a5_uncompact(a5_intersect(caps[1], caps[2])), a[vctrs::vec_in(a, b)]) expect_identical(a5_uncompact(a5_difference(caps[1], caps[2])), a[!vctrs::vec_in(a, b)]) expect_gt(length(a5_uncompact(a5_intersect(caps[1], caps[2]))), 0L) }) test_that("set operation results are compacted coverings", { u <- a5_union(caps[1], caps[2]) expect_s3_class(u, "a5_covering") expect_identical(u, a5_compact(c(a, b))) expect_true(a5_is_valid(u)) expect_identical(a5_covering_resolution(u), 12L) }) test_that("set operations recycle and propagate NA", { cell8 <- a5_lonlat_to_cell(c(0, 1, NA), c(0, 1, NA), resolution = 8) disks <- a5_grid_disk(cell8, k = 2) big <- a5_grid_disk(cell8[1], k = 6) out <- a5_intersect(disks, big) expect_length(out, 3L) expect_identical(out[1], disks[1]) expect_identical(is.na(out), c(FALSE, FALSE, TRUE)) expect_identical(a5_union(big, disks)[1], big) expect_error(a5_union(disks, c(disks, disks)), "recycle") }) test_that("a5_union(x) merges every covering, skipping NA", { x <- c(caps, a5_spherical_cap(a5_cell(NA), radius = 1)) expect_identical(a5_union(x), a5_union(caps[1], caps[2])) expect_identical(a5_union(caps[1]), caps[1]) expect_length(a5_uncompact(a5_union(a5_compact(a5_cell())[0])), 0L) }) test_that("combining coverings at different resolutions is an error", { disk8 <- a5_grid_disk(a5_lonlat_to_cell(-3.19, 55.95, resolution = 8), k = 1) expect_error(a5_union(caps[1], disk8), "resolution 12 with cells at resolution 8") expect_error(a5_intersect(caps, disk8), "element 1") expect_error(a5_overlaps(caps[1], disk8), "resolution") expect_error(a5_union(c(caps, disk8)), "resolution") }) test_that("an empty covering without a resolution is the empty set", { nothing <- a5_compact(a5_cell()) expect_identical(a5_union(nothing, caps[1]), caps[1]) expect_identical(a5_union(caps[1], nothing), caps[1]) expect_length(a5_uncompact(a5_intersect(caps[1], nothing)), 0L) expect_identical(a5_difference(caps[1], nothing), caps[1]) expect_false(a5_overlaps(caps[1], nothing)) expect_false(a5_contains(nothing, edinburgh)) }) test_that("contains is a point-in-covering test at the covering's resolution", { inside <- a[c(1, length(a))] outside <- b[!vctrs::vec_in(b, a)][1:2] expect_identical(a5_contains(caps[1], c(inside, outside, a5_cell(NA))), c(TRUE, TRUE, FALSE, FALSE, NA)) expect_identical(a5_contains(caps[1], a), rep(TRUE, length(a))) # row by row expect_identical(a5_contains(caps, c(edinburgh, edinburgh)), c(TRUE, FALSE)) expect_error(a5_contains(caps[1], a5_cell_to_parent(edinburgh)), "resolution 11") }) test_that("contains agrees with polygon point tests", { poly <- wk::wkt("POLYGON ((-3.4 55.85, -3 55.85, -3 56.05, -3.4 56.05, -3.4 55.85))") covering <- a5_polygon_to_cells(poly, resolution = 12) withr::with_seed(1, { lon <- stats::runif(500, -3.5, -2.9) lat <- stats::runif(500, 55.8, 56.1) }) pts <- a5_lonlat_to_cell(lon, lat, resolution = 12) expect_identical(a5_contains(covering, pts), vctrs::vec_in(pts, a5_uncompact(covering))) }) test_that("overlaps detects shared cells", { far <- a5_spherical_cap(a5_lonlat_to_cell(10, 10, resolution = 12), radius = 1000) expect_identical(a5_overlaps(caps, caps[1]), c(TRUE, TRUE)) expect_identical(a5_overlaps(caps, far), c(FALSE, FALSE)) expect_identical(a5_overlaps(caps[1], a5_grid_disk(a5_cell(NA), k = 1)), NA) }) test_that("count and area measure the cells a covering stands for", { expect_identical(a5_count(caps), c(length(a), length(b)) + 0) expect_equal(a5_area(caps, units = NULL), a5_count(caps) * a5_cell_area(12, units = NULL)) expect_s3_class(a5_area(caps), "units") expect_equal(as.numeric(a5_area(caps, "km^2")), a5_area(caps, NULL) / 1e6) expect_identical(a5_count(a5_grid_disk(a5_cell(NA), k = 1)), NA_real_) expect_identical(a5_count(a5_compact(a5_cell(), resolution = 5)), 0) # beyond 2^53: the whole globe at resolution 30 world30 <- a5_compact(a5_get_res0_cells(), resolution = 30) expect_equal(a5_count(world30), a5_get_num_cells(30)) expect_equal(as.numeric(a5_area(world30, "km^2")), 4 * pi * 6371.0072^2, tolerance = 1e-4) expect_error(a5_area(caps, units = "m"), "area unit") }) test_that("covering operations are identical with threads > 1", { skip_if(parallel::detectCores() < 2) old <- a5_threads() on.exit(a5_threads(old)) cells <- a5_lonlat_to_cell(seq(-10, 10, length.out = 50), 50, resolution = 10) disks <- a5_grid_disk(cells, k = 4) a5_threads(1L) single <- list(a5_union(disks, disks[1]), a5_contains(disks, cells), a5_overlaps(disks, disks[2])) a5_threads(2L) expect_identical( list(a5_union(disks, disks[1]), a5_contains(disks, cells), a5_overlaps(disks, disks[2])), single ) }) test_that("covering errors name the user's call, not the Rust wrapper", { disk8 <- a5_grid_disk(a5_lonlat_to_cell(-3.19, 55.95, resolution = 8), k = 1) calls <- list( a5_union = function() a5_union(caps[1], disk8), a5_contains = function() a5_contains(caps[1], a5_cell_to_parent(edinburgh)), a5_compact = function() a5_compact(a, resolution = 5), a5_uncompact = function() a5_uncompact(caps, resolution = 4) ) for (name in names(calls)) { err <- tryCatch(calls[[name]](), error = identity) expect_identical(deparse(err$call[[1]]), name) } })