tests/testthat/test-make.R

In wk: Lightweight Well-Known Geometry Parsing

test_that("wk_linestring() works", {
  expect_identical(wk_linestring(wkt()), wkt("LINESTRING EMPTY", crs = wk_crs_inherit()))
  expect_identical(
    wk_linestring(wkt(NA_character_)),
    wkt("LINESTRING EMPTY")
  )
  expect_identical(
    wk_linestring(wkt("POINT EMPTY")),
    wkt("LINESTRING EMPTY")
  )

  expect_identical(
    wk_linestring(xy(1:4, 1), feature_id = 1L),
    as_wkb("LINESTRING (1 1, 2 1, 3 1, 4 1)")
  )
  expect_identical(
    wk_linestring(xy(1:4, 1), feature_id = c(1L, 1L, 2L, 2L)),
    as_wkb(c("LINESTRING (1 1, 2 1)", "LINESTRING (3 1, 4 1)"))
  )

  expect_identical(
    wk_linestring(wkt("POLYGON ((0 0, 0 1, 1 0, 0 0))")),
    wkt("LINESTRING (0 0, 0 1, 1 0, 0 0)")
  )

  expect_error(wk_linestring(new_wk_wkt("POINT ENTPY")), "EMPTY")
})

test_that("wk_linestring() propagates geodesic", {
  expect_identical(
    wk_linestring(xy(1:4, 1), geodesic = TRUE),
    as_wkb(wkt("LINESTRING (1 1, 2 1, 3 1, 4 1)", geodesic = TRUE))
  )

  expect_identical(
    wk_linestring(xy(1:4, 1), geodesic = FALSE),
    as_wkb(wkt("LINESTRING (1 1, 2 1, 3 1, 4 1)", geodesic = FALSE))
  )

  expect_identical(
    wk_linestring(wkt(c("POINT (1 1)", "POINT (2 1)"), geodesic = FALSE), geodesic = NULL),
    wkt("LINESTRING (1 1, 2 1)", geodesic = FALSE)
  )

  expect_identical(
    wk_linestring(wkt(c("POINT (1 1)", "POINT (2 1)"), geodesic = TRUE), geodesic = NULL),
    wkt("LINESTRING (1 1, 2 1)", geodesic = TRUE)
  )

  expect_identical(
    wk_linestring(wkt(c("POINT (1 1)", "POINT (2 1)")), geodesic = TRUE),
    wkt("LINESTRING (1 1, 2 1)", geodesic = TRUE)
  )

  expect_identical(
    wk_linestring(wkt(c("POINT (1 1)", "POINT (2 1)")), geodesic = FALSE),
    wkt("LINESTRING (1 1, 2 1)", geodesic = FALSE)
  )
})

test_that("wk_linestring() errors for inconsistent dimensions/srid", {
  expect_error(
    wk_linestring(wkt(c("POINT (0 1)", "POINT Z (1 2 3)"))),
    "Can't create linestring"
  )
  expect_error(
    wk_linestring(wkt(c("POINT (0 1)", "POINT M (1 2 3)"))),
    "Can't create linestring"
  )
  expect_error(
    wk_linestring(wkt(c("POINT (0 1)", "POINT ZM (1 2 3 4)"))),
    "Can't create linestring"
  )
  expect_error(
    wk_linestring(wkt(c("POINT (0 1)", "SRID=1234;POINT (1 2)"))),
    "Can't create linestring"
  )
})

test_that("wk_linestring_filter() errors for handlers that return WK_ABORT_FEATURE", {
  expect_error(
    wk_handle(wkt("POINT (0 1)"), wk_linestring_filter(wk_meta_handler())),
    "does not support WK_ABORT_FEATURE"
  )
})

test_that("wk_polygon() works", {
  expect_identical(wk_polygon(xy(double(), double())), as_wkb("POLYGON EMPTY", crs = wk_crs_inherit()))
  expect_identical(
    wk_polygon(xy(c(0, 10, 0), c(0, 0, 10))),
    as_wkb("POLYGON ((0 0, 10 0, 0 10, 0 0))")
  )
  expect_identical(
    wk_polygon(xy(c(0, 10, 0, 0), c(0, 0, 10, 0))),
    as_wkb("POLYGON ((0 0, 10 0, 0 10, 0 0))")
  )

  expect_identical(
    wk_polygon(
      xy(
        c(20, 10, 10, 30, 45, 30, 20, 20),
        c(35, 30, 10, 5, 20, 20, 15, 25)
      ),
      ring_id = c(1, 1, 1, 1, 1, 2, 2, 2)
    ),
    as_wkb("POLYGON ((20 35, 10 30, 10 10, 30 5, 45 20, 20 35), (30 20, 20 15, 20 25, 30 20))")
  )

  expect_identical(
    wk_polygon(
      xy(
        c(20, 10, 10, 30, 45, 30, 20, 20, 40, 20, 45),
        c(35, 30, 10, 5, 20, 20, 15, 25, 40, 45, 30)
      ),
      feature_id = c(rep(1, 8), rep(2, 3)),
      ring_id = c(1, 1, 1, 1, 1, 2, 2, 2, 1, 1, 1)
    ),
    as_wkb(
      c(
        "POLYGON ((20 35, 10 30, 10 10, 30 5, 45 20, 20 35), (30 20, 20 15, 20 25, 30 20))",
        "POLYGON ((40 40, 20 45, 45 30, 40 40))"
      )
    )
  )

  expect_identical(
    wk_polygon(
      xy(
        c(20, 10, 10, 30, 45, 30, 20, 20, 40, 20, 45),
        c(35, 30, 10, 5, 20, 20, 15, 25, 40, 45, 30)
      ),
      feature_id = c(rep(1, 8), rep(2, 3)),
      # new ring should be detected on new feature_id
      ring_id = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)
    ),
    as_wkb(
      c(
        "POLYGON ((20 35, 10 30, 10 10, 30 5, 45 20, 20 35), (30 20, 20 15, 20 25, 30 20))",
        "POLYGON ((40 40, 20 45, 45 30, 40 40))"
      )
    )
  )
})

test_that("wk_polygon() closes rings where appropriate", {
  rings_closed <- wkt(
    c(
      "LINESTRING (0 0, 1 0, 1 1, 0 1, 0 0)",
      "LINESTRING (0 0, 0 -1, -1 -1, -1 0, 0 0)",
      "LINESTRING (1 1, 2 1, 2 2, 1 2, 1 1)",
      "LINESTRING (2 2, 3 2, 3 3, 2 3, 2 2)"
    )
  )

  vertices_closed <- wk_vertices(rings_closed)
  expect_identical(
    wk_polygon(vertices_closed, rep(1:4, each = 5)),
    wkt(
      c(
        "POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0))",
        "POLYGON ((0 0, 0 -1, -1 -1, -1 0, 0 0))",
        "POLYGON ((1 1, 2 1, 2 2, 1 2, 1 1))",
        "POLYGON ((2 2, 3 2, 3 3, 2 3, 2 2))"
      )
    )
  )

  rings_open <- wkt(
    c(
      "LINESTRING (0 0, 1 0, 1 1, 0 1)",
      "LINESTRING (0 0, 0 -1, -1 -1, -1 0)",
      "LINESTRING (1 1, 2 1, 2 2, 1 2)",
      "LINESTRING (2 2, 3 2, 3 3, 2 3)"
    )
  )

  vertices_open <- wk_vertices(rings_open)
  expect_identical(
    wk_polygon(vertices_open, rep(1:4, each = 4)),
    wkt(
      c(
        "POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0))",
        "POLYGON ((0 0, 0 -1, -1 -1, -1 0, 0 0))",
        "POLYGON ((1 1, 2 1, 2 2, 1 2, 1 1))",
        "POLYGON ((2 2, 3 2, 3 3, 2 3, 2 2))"
      )
    )
  )
})

test_that("wk_polygon() propagates geodesic", {
  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))"), geodesic = TRUE),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = TRUE)
  )

  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))"), geodesic = FALSE),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = FALSE)
  )

  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = FALSE), geodesic = NULL),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = FALSE)
  )

  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = TRUE), geodesic = NULL),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = TRUE)
  )

  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = FALSE), geodesic = TRUE),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = TRUE)
  )

  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = TRUE), geodesic = FALSE),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))", geodesic = FALSE)
  )
})

test_that("wk_polygon() can use a POLYGON input", {
  expect_identical(
    wk_polygon(wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))")),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))")
  )
})

test_that("wk_polygon passes on errors", {
  expect_error(wk_polygon(new_wk_wkt("POLYGON ENTPY")), "ENTPY")
})

test_that("wk_polygon() treats NA as empty", {
  expect_identical(
    wk_polygon(wkt(c("POLYGON ((40 40, 20 45, 45 30, 40 40))", NA))),
    wkt("POLYGON ((40 40, 20 45, 45 30, 40 40))")
  )
})

test_that("wk_polygon() requires consistent dimensions within a feature", {
  expect_error(
    wk_polygon(wkt(c("POINT (0 1)", "POINT Z (1 2 3)"))),
    "Can't create polygon"
  )
})

test_that("wk_polygon_filter() errors for handlers that return WK_ABORT_FEATURE", {
  expect_error(
    wk_handle(wkt("POINT (0 1)"), wk_polygon_filter(wk_meta_handler())),
    "does not support WK_ABORT_FEATURE"
  )
})

test_that("wk_collection() works", {
  expect_identical(wk_collection(wkt()), wkt("GEOMETRYCOLLECTION EMPTY", crs = wk_crs_inherit()))
  expect_identical(
    wk_collection(wkt(NA_character_)),
    wkt("GEOMETRYCOLLECTION EMPTY")
  )
  expect_identical(
    wk_collection(wkt("POINT EMPTY")),
    wkt("GEOMETRYCOLLECTION (POINT EMPTY)")
  )
  expect_identical(
    wk_collection(xy(1:4, 1), feature_id = 1L),
    as_wkb("GEOMETRYCOLLECTION (POINT (1 1), POINT (2 1), POINT (3 1), POINT (4 1))")
  )
  expect_identical(
    wk_collection(xy(1:4, 1), feature_id = c(1L, 1L, 2L, 2L)),
    as_wkb(
      c("GEOMETRYCOLLECTION (POINT (1 1), POINT (2 1))",
        "GEOMETRYCOLLECTION (POINT (3 1), POINT (4 1))")
    )
  )

  expect_identical(
    wk_collection(wkt("POLYGON ((0 0, 0 1, 1 0, 0 0))")),
    wkt("GEOMETRYCOLLECTION (POLYGON ((0 0, 0 1, 1 0, 0 0)))")
  )

  expect_error(wk_collection(new_wk_wkt("POINT ENTPY")), "EMPTY")
})

test_that("wk_collection() propagates attributes", {
  expect_identical(
    wk_collection(
      wkt("LINESTRING ZM (0 0 0 0, 1 0 0 0)", crs = 1234, geodesic = TRUE),
      wk_geometry_type("multilinestring")
    ),
    wkt("MULTILINESTRING ZM ((0 0 0 0, 1 0 0 0))", crs = 1234, geodesic = TRUE)
  )
})

test_that("wk_collection_filter() errors for handlers that return WK_ABORT_FEATURE", {
  expect_error(
    wk_handle(wkt("POINT (0 1)"), wk_collection_filter(wk_meta_handler())),
    "does not support WK_ABORT_FEATURE"
  )
})

test_that("wk_collection() works with sfc", {
  skip_if_not_installed("sf")

  points_xy <- xy(1:64, 1:64)
  points_sfc <- wk_handle(
    points_xy,
    sfc_writer()
  )

  expect_identical(
    wk_collection(points_sfc, feature_id = rep(1:2, each = 32)),
    wk_handle(
      wk_collection(points_xy, feature_id = rep(1:2, each = 32)),
      sfc_writer()
    )
  )

  expect_identical(
    wk_collection(points_sfc, wk_geometry_type("multipoint")),
    wk_handle(
      wk_collection(points_xy, wk_geometry_type("multipoint")),
      sfc_writer()
    )
  )

  lines_wkb <- as_wkb(wkt(rep("LINESTRING (0 0, 1 1)", 32)))
  lines_sfc <- wk_handle(
    lines_wkb,
    sfc_writer()
  )

  expect_identical(
    wk_collection(lines_sfc, wk_geometry_type("multilinestring")),
    wk_handle(
      wk_collection(lines_wkb, wk_geometry_type("multilinestring")),
      sfc_writer()
    )
  )

  polygons_wkb <- as_wkb(wkt(rep("POLYGON ((0 0, 0 1, 1 0, 0 0))", 32)))
  polygons_sfc <- wk_handle(
    polygons_wkb,
    sfc_writer()
  )

  expect_identical(
    wk_collection(polygons_sfc, wk_geometry_type("multipolygon")),
    wk_handle(
      wk_collection(polygons_wkb, wk_geometry_type("multipolygon")),
      sfc_writer()
    )
  )

  geometries_wkb <- c(as_wkb(points_xy), lines_wkb, polygons_wkb)
  geometries_sfc <- wk_handle(geometries_wkb, sfc_writer())

  expect_identical(
    wk_collection(geometries_sfc),
    wk_handle(
      wk_collection(geometries_wkb),
      sfc_writer()
    )
  )

  # test case from gh #182
  multipoint_sfc <- sf::st_sfc(
    sf::st_multipoint(matrix(runif(10, -90, 90), ncol = 2))
  )

  expect_no_error(
    suppressMessages(
      capture_output(print(wk_collection(multipoint_sfc)))
    )
  )
})