tests/testthat/test-handle-wkb.R

test_that("wkb_translate_wkt() works with missing values", {
  point <- as.raw(c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x24, 0x40))

  expect_identical(wkb_translate_wkt(list(NULL)), NA_character_)
  expect_identical(wkb_translate_wkt(list(point, NULL)), c("POINT (30 10)", NA))
  expect_identical(wkb_translate_wkt(list(NULL, point)), c(NA, "POINT (30 10)"))
})

test_that("wkb_translate_wkt() works with multiple endians", {

  point_be <- as.raw(c(0x00, 0x00, 0x00, 0x00, 0x01, 0x40, 0x3e,
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x24, 0x00, 0x00, 0x00,
                       0x00, 0x00, 0x00))

  point_le <- as.raw(c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
                       0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                       0x00, 0x24, 0x40))

  expect_identical(wkb_translate_wkt(list(point_be)), "POINT (30 10)")
  expect_identical(wkb_translate_wkt(list(point_le)), "POINT (30 10)")
  expect_error(
    wkb_translate_wkt(list(point_le[1:5])),
    "Unexpected end of buffer"
  )
})

test_that("wkb_translate_wkt() works with ND points and SRID", {

  point_xy <- as.raw(c(0x01, #
                       0x01, 0x00, 0x00, 0x00, # type
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, # x
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40)) # y

  point_z <- as.raw(c(0x01,
                      0x01, 0x00, 0x00, 0x80, # type
                      0x00, 0x00, 0x00, 0x00,  0x00, 0x00, 0x3e, 0x40, # x
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, # y
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40)) # z

  point_m <- as.raw(c(0x01,
                      0x01, 0x00, 0x00, 0x40, # type
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, # x
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, # y
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40)) # m

  point_zm <- as.raw(c(0x01,
                       0x01, 0x00, 0x00, 0xc0, # type
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, # x
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, # y
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, # z
                       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x3f)) # m

  point_s <- as.raw(c(0x01,
                      0x01, 0x00, 0x00, 0x20, # type
                      0xc7, 0x00, 0x00, 0x00, # srid
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, # x
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40)) # y

  point_zms <- as.raw(c(0x01,
                        0x01, 0x00, 0x00, 0xe0,
                        0xe6, 0x10, 0x00, 0x00,
                        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40,
                        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40,
                        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x28, 0x40,
                        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x2c, 0x40))



  expect_identical(wkb_translate_wkt(list(point_xy)), "POINT (30 10)")
  expect_identical(wkb_translate_wkt(list(point_z)), "POINT Z (30 10 2)")
  expect_identical(wkb_translate_wkt(list(point_m)), "POINT M (30 10 2)")
  expect_identical(wkb_translate_wkt(list(point_zm)), "POINT ZM (30 10 2 1)")
  expect_identical(wkb_translate_wkt(list(point_s)), "SRID=199;POINT (30 10)")
  expect_identical(wkb_translate_wkt(list(point_zms)), "SRID=4326;POINT ZM (30 10 12 14)")
})

test_that("wkb_translate_wkt() works simple geometries", {

  # POINT (30 10)
  point <- as.raw(c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x24, 0x40))

  # LINESTRING (30 10, 12 42)
  linestring <- as.raw(c(0x01, 0x02, 0x00, 0x00, 0x00, 0x02, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x28, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x45,
                         0x40))

  # POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10), (20 30, 35 35, 30 20, 20 30))
  polygon <- as.raw(c(0x01, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00,
                      0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x80, 0x41, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40,
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x46, 0x40, 0x00, 0x00, 0x00,
                      0x00, 0x00, 0x80, 0x46, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x2e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00,
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00,
                      0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x41,
                      0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x04, 0x00,
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00,
                      0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00,
                      0x00, 0x80, 0x41, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x41,
                      0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00,
                      0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40))

  expect_identical(wkb_translate_wkt(list(point)), "POINT (30 10)")
  expect_identical(
    wkb_translate_wkt(list(linestring)),
    "LINESTRING (30 10, 12 42)"
  )
  expect_identical(
    wkb_translate_wkt(list(polygon)),
    "POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10), (20 30, 35 35, 30 20, 20 30))"
  )
})

test_that("wkb_translate_wkt() works with multi geometries", {
  # MULTIPOINT ((10 40), (40 30), (20 20), (30 10))
  multipoint <- as.raw(c(0x01, 0x04, 0x00, 0x00, 0x00, 0x04, 0x00,
                         0x00, 0x00, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44,
                         0x40, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40,
                         0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x01,
                         0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40))

  # technically these could exist without the redundant parentheses, but
  # that's pretty inconsistent with how the other multi* geoms are
  # rendered
  expect_identical(
    wkb_translate_wkt(list(multipoint)),
    "MULTIPOINT ((10 40), (40 30), (20 20), (30 10))"
  )
})

test_that("wkb_translate_wkt() works with nested collections", {

  wkt <-
    "GEOMETRYCOLLECTION (
    POINT (40 10),
    LINESTRING (10 10, 20 20, 10 40),
    POLYGON ((40 40, 20 45, 45 30, 40 40)),
    GEOMETRYCOLLECTION (
      POINT (40 10),
      LINESTRING (10 10, 20 20, 10 40),
      POLYGON ((40 40, 20 45, 45 30, 40 40))
    ),
    GEOMETRYCOLLECTION EMPTY,
    POINT (30 10)
  )"

  collection <- as.raw(c(0x01, 0x07, 0x00, 0x00, 0x00, 0x06, 0x00,
                         0x00, 0x00, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24,
                         0x40, 0x01, 0x02, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x01, 0x03, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00,
                         0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x80, 0x46, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x46,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x01, 0x07, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00,
                         0x00, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40,
                         0x01, 0x02, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x44, 0x40, 0x01, 0x03, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00,
                         0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x80, 0x46, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x46, 0x40,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x44, 0x40, 0x01, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40))

  expect_identical(
    wkb_translate_wkt(list(collection)),
    paste0(
      "GEOMETRYCOLLECTION (POINT (40 10), LINESTRING (10 10, 20 20, 10 40), ",
      "POLYGON ((40 40, 20 45, 45 30, 40 40)), GEOMETRYCOLLECTION ",
      "(POINT (40 10), LINESTRING (10 10, 20 20, 10 40), ",
      "POLYGON ((40 40, 20 45, 45 30, 40 40))), ",
      "GEOMETRYCOLLECTION EMPTY, POINT (30 10))"
    )
  )
})


test_that("wkb_translate_wkb() works with missing values", {
  point <- as.raw(c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x24, 0x40))

  expect_identical(wkb_translate_wkb(list(NULL)), list(NULL))
  expect_identical(wkb_translate_wkb(list(point, NULL), endian = 1), list(point, NULL))
  expect_identical(wkb_translate_wkb(list(NULL, point), endian = 1), list(NULL, point))
})

test_that("wkb_translate_wkt() respects trim and rounding options", {
  # POINT (30 10)
  point <- as.raw(c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                    0x00, 0x24, 0x40))

  # POINT (30.3333333 10.3333333)
  point_repeating <- as.raw(c(0x01, 0x01, 0x00, 0x00, 0x00, 0x55, 0x55,
                              0x55, 0x55, 0x55, 0x55, 0x3e, 0x40, 0xab, 0xaa, 0xaa, 0xaa, 0xaa,
                              0xaa, 0x24, 0x40))

  expect_identical(
    wkb_translate_wkt(list(point), precision = 5, trim = TRUE),
    "POINT (30 10)"
  )
  expect_identical(
    wkb_translate_wkt(list(point), precision = 5, trim = FALSE),
    "POINT (30.00000 10.00000)"
  )
  expect_identical(
    wkb_translate_wkt(list(point_repeating), precision = 5, trim = TRUE),
    "POINT (30.333 10.333)"
  )
  expect_identical(
    wkb_translate_wkt(list(point_repeating), precision = 5, trim = FALSE),
    "POINT (30.33333 10.33333)"
  )
})

test_that("wkb writer only includes SRID for top-level geometry", {
  expect_length(wkt_translate_wkb("SRID=4326;MULTIPOINT (0 0, 1 1)")[[1]], 55)
})

test_that("wkb--wkb translation works for nested collections", {
  collection <- as.raw(c(0x01, 0x07, 0x00, 0x00, 0x00, 0x06, 0x00,
                         0x00, 0x00, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24,
                         0x40, 0x01, 0x02, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x01, 0x03, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00,
                         0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x80, 0x46, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x46,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x01, 0x07, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00,
                         0x00, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40,
                         0x01, 0x02, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x24, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x44, 0x40, 0x01, 0x03, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00,
                         0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44,
                         0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x44, 0x40, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x80, 0x46, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x46, 0x40,
                         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00,
                         0x00, 0x00, 0x00, 0x44, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x44, 0x40, 0x01, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                         0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x24, 0x40))

  expect_identical(wkb_translate_wkb(list(collection), endian  = 1), list(collection))
})

test_that("wkb_translate_* doesn't segfault on other inputs", {
  expect_error(wkb_translate_wkt("POINT (30 10)"), "can only be applied to a 'list'")
})

test_that("wkb reader can read 1000-3000 style WKB input", {
  # note that this is what sf outputs for Z, M, and ZM points even when EWKB
  # is TRUE
  wkb_xyz <- as.raw(c(0x01, 0xe9, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x00, 0x00, 0xf0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x40))

  wkb_xym <- as.raw(c(0x01, 0xd1, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x00, 0x00, 0xf0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                      0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x40))

  wkb_xyzm <- as.raw(c(0x01, 0xb9, 0x0b, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                       0x00, 0x00, 0xf0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
                       0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x40, 0x00, 0x00,
                       0x00, 0x00, 0x00, 0x00, 0x10, 0x40))

  expect_identical(wkb_translate_wkt(list(wkb_xyz)), "POINT Z (1 2 3)")
  expect_identical(wkb_translate_wkt(list(wkb_xym)), "POINT M (1 2 3)")
  expect_identical(wkb_translate_wkt(list(wkb_xyzm)), "POINT ZM (1 2 3 4)")
})

Try the wk package in your browser

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

wk documentation built on Oct. 22, 2023, 9:07 a.m.