tests/testthat/test-s2-cell-union.R

In s2: Spherical Geometry Operators Using the S2 Geometry Library

test_that("s2_cell_union() class works", {
  expect_s3_class(s2_cell_union(), "s2_cell_union")
  expect_s3_class(s2_cell_union(), "wk_vctr")

  x <- s2_cell_union()
  expect_identical(as_s2_cell_union(x), x)
  expect_output(expect_identical(str(x), x), "s2_cell_union")
  expect_output(expect_identical(print(x), x), "s2_cell_union")
  expect_identical(unlist(x), s2_cell())

  expect_identical(is.na(new_s2_cell_union(list(NULL))), TRUE)
})

test_that("s2_cell_union can be roundtripped through character", {
  expect_identical(
    as_s2_cell_union(c("3442c;345d5", NA)),
    s2_cell_union(list(s2_cell(c("3442c", "345d5")), NULL))
  )

  expect_identical(
    as.character(s2_cell_union(list(c("3442c", "345d5"), NULL))),
    c("3442c;345d5", NA)
  )
})

test_that("as_s2_cell_union() for s2_cell() works", {
  expect_identical(
    as_s2_cell_union(s2_cell(c("4b59a0cd83b5de49", NA))),
    s2_cell_union(list(s2_cell("4b59a0cd83b5de49"), NULL))
  )
})

test_that("as_s2_geography() for s2_cell_union works", {
  union <- as_s2_cell_union(s2_cell(c("4b59a0cd83b5de49", NA)))
  geog <- as_s2_geography(union)
  expect_identical(
    s2_intersects(geog, s2_lnglat(c(-64, NA), c(45, NA))),
    c(TRUE, NA)
  )
  expect_identical(s2_dimension(geog), c(2L, NA))
})

test_that("s2_cell_union_normalize() works", {
  cell <- s2_cell_parent(as_s2_cell("4b59a0cd83b5de49"), 10)
  children <- s2_cell_union(list(s2_cell_child(cell, 0:3)))
  expect_identical(
    s2_cell_union_normalize(children),
    as_s2_cell_union(cell)
  )

  expect_identical(
    s2_cell_union_normalize(new_s2_cell_union(list(NULL))),
    new_s2_cell_union(list(NULL))
  )
})

test_that("s2_cell_union_contains() works", {
  cell_na <- s2_cell_union(list(NULL))
  cell <- s2_cell_parent(as_s2_cell("4b59a0cd83b5de49"), 10)
  children <- as_s2_cell_union(s2_cell_child(cell, 0:3))

  expect_identical(
    s2_cell_union_contains(cell, c(children, cell_na)),
    c(rep(TRUE, 4), NA)
  )

  expect_identical(
    s2_cell_union_contains(cell_na, children),
    rep(NA, 4)
  )

  expect_identical(
    s2_cell_union_contains(c(children, cell_na), cell),
    c(rep(FALSE, 4), NA)
  )

  expect_identical(
    s2_cell_union_contains(children, cell_na),
    rep(NA, 4)
  )

  expect_error(
    s2_cell_union_contains(children, c(s2_cell_union(cell), cell_na)),
    "Can't recycle vectors"
  )
})

test_that("s2_cell_union_contains() works for cell y", {
  cell_na <- s2_cell(NA)
  cell <- s2_cell_parent(as_s2_cell("4b59a0cd83b5de49"), 10)
  children <- s2_cell_child(cell, 0:3)

  expect_identical(
    s2_cell_union_contains(cell, c(children, cell_na)),
    c(rep(TRUE, 4), NA)
  )

  expect_identical(
    s2_cell_union_contains(cell_na, children),
    rep(NA, 4)
  )

  expect_identical(
    s2_cell_union_contains(c(children, cell_na), cell),
    c(rep(FALSE, 4), NA)
  )

  expect_identical(
    s2_cell_union_contains(children, cell_na),
    rep(NA, 4)
  )

  expect_error(
    s2_cell_union_contains(children, c(children, cell_na)),
    "Incompatible lengths"
  )
})

test_that("s2_cell_union_intersects() works", {
  cell_na <- s2_cell_union(list(NULL))
  cell <- s2_cell_parent(as_s2_cell("4b59a0cd83b5de49"), 10)
  children <- as_s2_cell_union(s2_cell_child(cell, 0:3))

  expect_identical(
    s2_cell_union_intersects(cell, c(children, cell_na)),
    c(rep(TRUE, 4), NA)
  )

  expect_identical(
    s2_cell_union_intersects(cell_na, children),
    rep(NA, 4)
  )

  expect_identical(
    s2_cell_union_intersects(c(children, cell_na), cell),
    c(rep(TRUE, 4), NA)
  )

  expect_identical(
    s2_cell_union_intersects(children, cell_na),
    rep(NA, 4)
  )

  expect_error(
    s2_cell_union_intersects(children, c(s2_cell_union(cell), cell_na)),
    "Can't recycle vectors"
  )
})

test_that("s2_cell_union_intersection|difference|union() works", {
  cell <- s2_cell_parent(as_s2_cell("4b59a0cd83b5de49"), 10)
  children <- as_s2_cell_union(s2_cell_child(cell, 0:3))

  expect_identical(
    s2_cell_union_intersection(cell, children[1]),
    children[1]
  )

  expect_identical(
    s2_cell_union_difference(cell, children[1]),
    s2_cell_union(list(unlist(children[2:4])))
  )

  expect_identical(
    s2_cell_union_union(
      s2_cell_union(list(unlist(children[1:2]))),
      s2_cell_union(list(unlist(children[3:4])))
    ),
    s2_cell_union(cell)
  )
})

test_that("s2_covering_cell_ids() works", {
  expect_length(unlist(s2_covering_cell_ids(s2_data_countries("France"))), 8)
  expect_length(
    unlist(s2_covering_cell_ids(s2_data_countries("France"), max_cells = 4)),
    4
  )
  expect_length(
    unlist(s2_covering_cell_ids(s2_data_countries("France"), interior = TRUE)),
    8
  )
  expect_identical(s2_covering_cell_ids(NA_character_), new_s2_cell_union(list(NULL)))
})

test_that("s2_covering_cell_ids_agg() works", {
  geog <- s2_data_countries(c("France", "Germany"))
  coverings <- s2_covering_cell_ids(geog)
  coverings_agg <- s2_covering_cell_ids_agg(geog)
  expect_length(unlist(coverings_agg), 8)

  coverings_interior_agg <- s2_covering_cell_ids_agg(geog, interior = TRUE)
  expect_length(unlist(coverings_interior_agg), 8)

  expect_identical(
    s2_covering_cell_ids_agg(NA_character_, na.rm = FALSE),
    new_s2_cell_union(list(NULL))
  )
  expect_identical(
    s2_covering_cell_ids_agg(character(), radius = NA_real_),
    new_s2_cell_union(list(NULL))
  )
  expect_identical(
    s2_covering_cell_ids_agg(NA_character_, na.rm = TRUE),
    new_s2_cell_union(list(s2_cell()))
  )
})