tests/testthat/test-geos-binary-geometry.R

In geos: Open Source Geometry Engine ('GEOS') R API

test_that("pattern for erroring on mismatched CRS works", {
  expect_error(
    geos_intersection(
      as_geos_geometry("POINT (1 1)", crs = 1234),
      as_geos_geometry("POINT (1 1)", crs = 5678)
    ),
    "are not equal"
  )
})

test_that("pattern for propagating CRS works", {
  expect_identical(
    wk::wk_crs(
      geos_intersection(
        as_geos_geometry("POINT (1 1)", crs = 1234),
        as_geos_geometry("POINT (1 1)", crs = 1234)
      )
    ),
    1234
  )
})

test_that("binary operators work", {
  poly1 <- "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))"
  poly2 <- c(NA, "POLYGON ((5 5, 5 15, 15 15, 15 5, 5 5))")

  expect_identical(
    geos_area(geos_intersection(poly1, poly2)),
    c(NA, 25)
  )

  expect_identical(
    geos_area(geos_difference(poly1, poly2)),
    c(NA, 100 - 25)
  )

  expect_identical(
    geos_area(geos_sym_difference(poly1, poly2)),
    c(NA, 100 * 2 - 50)
  )

  expect_identical(
    geos_area(geos_union(poly1, poly2)),
    c(NA, 100 * 2 - 25)
  )

  collection <- "
    GEOMETRYCOLLECTION (
      POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0)),
      POLYGON ((5 5, 5 15, 15 15, 15 5, 5 5))
    )
  "

  expect_identical(
    geos_equals(
      geos_unary_union(c(NA, collection)),
      geos_union(poly1, poly2)
    ),
    c(NA, TRUE)
  )
})

test_that("binary_prec operators work", {
  poly1 <- "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))"
  poly2 <- c(NA, "POLYGON ((5 5, 5 15, 15 15, 15 5, 5 5))")

  if ((geos_version(runtime = TRUE) >= "3.9.1") && (geos_version(runtime = FALSE) >= "3.9.1")) {
    expect_identical(
      geos_area(geos_intersection_prec(poly1, poly2, grid_size = 0.1)),
      c(NA, 25)
    )

    expect_identical(
      geos_area(geos_difference_prec(poly1, poly2, grid_size = 0.1)),
      c(NA, 100 - 25)
    )

    expect_identical(
      geos_area(geos_sym_difference_prec(poly1, poly2, grid_size = 0.1)),
      c(NA, 100 * 2 - 50)
    )

    expect_identical(
      geos_area(geos_union_prec(poly1, poly2, grid_size = 0.1)),
      c(NA, 100 * 2 - 25)
    )

    collection <- "
      GEOMETRYCOLLECTION (
        POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0)),
        POLYGON ((5 5, 5 15, 15 15, 15 5, 5 5))
      )
    "

    expect_identical(
      geos_equals(
        geos_unary_union_prec(c(NA, collection), grid_size = 0.1),
        geos_union_prec(poly1, poly2, grid_size = 0.1)
      ),
      c(NA, TRUE)
    )
  } else if (geos_version(runtime = FALSE) >= "3.9.1") {
    expect_error(geos_intersection_prec(poly1, poly2, 1), "requires 'libgeos'")
    expect_error(geos_difference_prec(poly1, poly2, 1), "requires 'libgeos'")
    expect_error(geos_sym_difference_prec(poly1, poly2, 1), "requires 'libgeos'")
    expect_error(geos_union_prec(poly1, poly2, 1), "requires 'libgeos'")
  } else {
    expect_error(geos_intersection_prec(poly1, poly2, 1), "built against 'libgeos'")
    expect_error(geos_difference_prec(poly1, poly2, 1), "built against 'libgeos'")
    expect_error(geos_sym_difference_prec(poly1, poly2, 1), "built against 'libgeos'")
    expect_error(geos_union_prec(poly1, poly2, 1), "built against 'libgeos'")
  }
})

test_that("shared paths works", {
  expect_identical(
    geos_write_wkt(
      geos_shared_paths("LINESTRING (0 0, 1 1, 2 2)", c(NA, "LINESTRING (1 1, 2 2, 3 3)"))
    ),
    c(NA, "GEOMETRYCOLLECTION (MULTILINESTRING ((1 1, 2 2)), MULTILINESTRING EMPTY)")
  )

  expect_identical(
    geos_write_wkt(
      geos_shared_paths("LINESTRING (0 0, 1 1, 2 2)", c(NA, "LINESTRING (3 3, 2 2, 1 1)"))
    ),
    c(NA, "GEOMETRYCOLLECTION (MULTILINESTRING EMPTY, MULTILINESTRING ((1 1, 2 2)))")
  )

  expect_error(geos_shared_paths("POINT (0 0)", "LINESTRING EMPTY"), "Geometry is not lineal")
})

test_that("snap works", {
  poly1 <- "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))"
  line <- c(NA, "LINESTRING (11 0, 11 10)")

  expect_identical(
    geos_equals(
      geos_snap(poly1, line),
      poly1
    ),
    c(NA, TRUE)
  )

  expect_identical(
    geos_equals(
      geos_snap(poly1, line, tolerance = 2),
      "POLYGON ((0 0, 0 10, 11 10, 11 0, 0 0))"
    ),
    c(NA, TRUE)
  )
})


test_that("clearance line between works", {
  expect_identical(
    geos_write_wkt(
      geos_clearance_line_between(
        "POINT (5 5)",
        c(NA, "POINT (1 1)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))")
      )
    ),
    c(NA, "LINESTRING (5 5, 1 1)", "LINESTRING (5 5, 5 5)")
  )

  expect_true(
    geos_is_empty(
      geos_clearance_line_between("POINT (0 0)", "POINT EMPTY")
    )
  )

  expect_error(
    geos_clearance_line_between("POINT (nan inf)", "POINT (0 0)"),
    "Unknown error"
  )
})

test_that("clearance line between works with prepare = TRUE", {
  skip_if_not(geos_version() >= "3.9.1")

  expect_identical(
    geos_write_wkt(
      geos_clearance_line_between(
        "POINT (5 5)",
        c(NA, "POINT (1 1)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))"),
        prepare = TRUE
      )
    ),
    c(NA, "LINESTRING (5 5, 1 1)", "LINESTRING (5 5, 5 5)")
  )

  expect_true(
    geos_is_empty(
      geos_clearance_line_between("POINT (0 0)", "POINT EMPTY", prepare = TRUE)
    )
  )

  expect_error(
    geos_clearance_line_between("POINT (nan inf)", "POINT (0 0)", prepare = TRUE),
    "Unknown error"
  )
})

test_that("geos_largest_empty_circle() works", {
  skip_if_not(geos_version() >= "3.9.1")

  boundary <- wk::rct(0, 0, 10, 10)
  geom <- "POLYGON ((1 1, 0 10, 10 0, 1 1))"
  spec <- geos_largest_empty_circle_spec(geom, boundary, tolerance = 1e-4)
  expect_identical(geos_write_wkt(spec, precision = 4), "LINESTRING (10 10, 5 5)")

  crc <- geos_largest_empty_crc(geom, boundary, tolerance = 1e-4)
  expect_identical(unclass(crc)$r, geos_length(spec))
})