tests/testthat/test-shared-boundary.R

test_that("adjacent rectangles: vertical shared edge", {
  skip_if_not_installed("geos")
  polys <- geos::as_geos_geometry(c(
    "POLYGON ((0 0, 5 0, 5 10, 0 10, 0 0))",
    "POLYGON ((5 0, 10 0, 10 10, 5 10, 5 0))"))
  r <- burn(polys, extent = c(0,10,0,10), dimension = c(20L,20L))
  expect_complementary(r, label = "vert on-grid")

  # Boundary between grid lines
  r2 <- burn(polys, extent = c(0,10,0,10), dimension = c(12L,12L))
  expect_complementary(r2, label = "vert off-grid")
})

test_that("adjacent rectangles: horizontal shared edge", {
  skip_if_not_installed("geos")
  polys <- geos::as_geos_geometry(c(
    "POLYGON ((0 0, 10 0, 10 5, 0 5, 0 0))",
    "POLYGON ((0 5, 10 5, 10 10, 0 10, 0 5))"))
  r <- burn(polys, extent = c(0,10,0,10), dimension = c(15L,15L))
  expect_complementary(r, label = "horiz")
})

test_that("four quadrants", {
  skip_if_not_installed("geos")
  polys <- geos::as_geos_geometry(c(
    "POLYGON ((0 0, 5 0, 5 5, 0 5, 0 0))",
    "POLYGON ((5 0, 10 0, 10 5, 5 5, 5 0))",
    "POLYGON ((0 5, 5 5, 5 10, 0 10, 0 5))",
    "POLYGON ((5 5, 10 5, 10 10, 5 10, 5 5))"))
  r <- burn(polys, extent = c(0,10,0,10), dimension = c(16L,16L))
  expect_complementary(r, label = "quadrants")
})

test_that("diagonal shared edge", {
  skip_if_not_installed("geos")
  polys <- geos::as_geos_geometry(c(
    "POLYGON ((0 0, 10 0, 10 10, 0 0))",
    "POLYGON ((0 0, 10 10, 0 10, 0 0))"))
  r <- burn(polys, extent = c(0,10,0,10), dimension = c(20L,20L))
  expect_complementary(r, label = "diagonal 20x20")

  r2 <- burn(polys, extent = c(0,10,0,10), dimension = c(100L,100L))
  expect_complementary(r2, label = "diagonal 100x100")
})

test_that("irregular tiling: L-shape + complement", {
  skip_if_not_installed("geos")
  polys <- geos::as_geos_geometry(c(
    "POLYGON ((0 0, 6 0, 6 4, 4 4, 4 10, 0 10, 0 0))",
    "POLYGON ((6 0, 10 0, 10 10, 4 10, 4 4, 6 4, 6 0))"))
  r <- burn(polys, extent = c(0,10,0,10), dimension = c(20L,20L))
  expect_complementary(r, label = "irregular")
})

test_that("donut filled with inner polygon", {
  skip_if_not_installed("geos")
  polys <- geos::as_geos_geometry(c(
    "POLYGON ((1 1, 9 1, 9 9, 1 9, 1 1), (3 3, 7 3, 7 7, 3 7, 3 3))",
    "POLYGON ((3 3, 7 3, 7 7, 3 7, 3 3))"))
  r <- burn(polys, extent = c(0,10,0,10), dimension = c(20L,20L))
  expect_complementary(r, label = "donut filled")
})

test_that("NC counties: no cell exceeds 1.0", {
  nc <- readRDS(test_path("nc10.rds"))
  nc_geom <- wk::wkb(nc$wkb)
  ext <- nc$ext10
  r <- burn(nc_geom, extent = ext, dimension = c(500L, 200L))

  total <- materialise_chunk(r)
  expect_lte(max(total), 1.0 + 1e-5)
})

Try the controlledburn package in your browser

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

controlledburn documentation built on Oct. 28, 2026, 5:12 p.m.