From 53fc5672462741a66950356e7667abac0245148a Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 08:47:13 +1000 Subject: [PATCH 01/18] add vec_equal support for wkb vectors --- R/pkg-vctrs.R | 4 ++++ R/zzz.R | 3 +++ src/init.c | 2 ++ src/vctr.c | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 65 insertions(+) diff --git a/R/pkg-vctrs.R b/R/pkg-vctrs.R index b41048e5..bafa4ffb 100644 --- a/R/pkg-vctrs.R +++ b/R/pkg-vctrs.R @@ -13,6 +13,10 @@ vec_proxy.wk_wkb <- function(x, ...) { unclass(x) } +vec_proxy_equal.wk_wkb <- function(x, ...) { + .Call(wk_c_wkb_to_hex, x) +} + vec_restore.wk_wkb <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) geodesic_out <- attr(to, "geodesic", exact = TRUE) %||% attr(x, "geodesic", exact = TRUE) diff --git a/R/zzz.R b/R/zzz.R index 1093f9cb..08d2c127 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -30,6 +30,9 @@ s3_register("sf::st_bbox", "wk_grd") s3_register("sf::st_crs", "wk_grd") s3_register("sf::st_crs<-", "wk_grd") + + # wkb vec_proxy_equal + s3_register("vctrs::vec_proxy_equal", "wk_wkb") } .onUnload <- function (libpath) { diff --git a/src/init.c b/src/init.c index 3c6ddbc1..ca49861d 100644 --- a/src/init.c +++ b/src/init.c @@ -31,6 +31,7 @@ SEXP wk_c_trans_set_new(SEXP xy, SEXP use_z, SEXP use_m); SEXP wk_c_trans_filter_new(SEXP handler_xptr, SEXP trans_xptr); SEXP wk_c_wkb_is_na(SEXP geom); SEXP wk_c_wkb_is_raw_or_null(SEXP geom); +SEXP wk_c_wkb_to_hex(SEXP geom); SEXP wk_c_vertex_filter_new(SEXP handler_xptr, SEXP add_details); SEXP wk_c_handler_void_new(void); SEXP wk_c_handler_addr(SEXP xptr); @@ -66,6 +67,7 @@ static const R_CallMethodDef CallEntries[] = { {"wk_c_trans_filter_new", (DL_FUNC) &wk_c_trans_filter_new, 2}, {"wk_c_wkb_is_na", (DL_FUNC) &wk_c_wkb_is_na, 1}, {"wk_c_wkb_is_raw_or_null", (DL_FUNC) &wk_c_wkb_is_raw_or_null, 1}, + {"wk_c_wkb_to_hex", (DL_FUNC) &wk_c_wkb_to_hex, 1}, {"wk_c_vertex_filter_new", (DL_FUNC) &wk_c_vertex_filter_new, 2}, {"wk_c_handler_void_new", (DL_FUNC) &wk_c_handler_void_new, 0}, {"wk_c_handler_addr", (DL_FUNC) &wk_c_handler_addr, 1}, diff --git a/src/vctr.c b/src/vctr.c index 6ae9deb1..1d079bad 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -2,6 +2,8 @@ #include #include +#define MAX(a, b) (((a) > (b)) ? (a) : (b)) + SEXP wk_c_wkb_is_na(SEXP geom) { R_xlen_t size = Rf_xlength(geom); SEXP result = PROTECT(Rf_allocVector(LGLSXP, size)); @@ -28,3 +30,57 @@ SEXP wk_c_wkb_is_raw_or_null(SEXP geom) { UNPROTECT(1); return result; } + +static R_xlen_t wk_max_length(const SEXP geom) { + const R_xlen_t size = Rf_xlength(geom); + R_xlen_t max = 0; + + for (R_xlen_t i = 0; i < size; ++i) { + max = MAX(max, Rf_xlength(VECTOR_ELT(geom, i))); + } + + return max; +} + +static void wk_bin_to_hex(char* restrict dst, const unsigned char* restrict src, const R_xlen_t n) { + static const char hex[16] = "0123456789abcdef"; + + for (R_xlen_t i = 0; i < n; ++i) { + const unsigned char byte = src[i]; + dst[2 * i] = hex[(byte >> 4) & 0xf]; + dst[2 * i + 1] = hex[byte & 0xf]; + } + + dst[2 * n] = '\0'; +} + +SEXP wk_c_wkb_to_hex(const SEXP geom) { + const R_xlen_t size = Rf_xlength(geom); + SEXP result = PROTECT(Rf_allocVector(STRSXP, size)); + + const R_xlen_t buf_size = wk_max_length(geom) * 2 + 1; + char* buf = malloc(buf_size * 2 + 1); + + if (buf == NULL) { + Rf_error("Failed to alloc buffer"); // # nocov + } + + for (R_xlen_t i = 0; i < size; ++i) { + if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); + + const SEXP item = VECTOR_ELT(geom, i); + const R_xlen_t item_len = Rf_xlength(item); + + if (item_len == 0) { + SET_STRING_ELT(result, i, NA_STRING); + continue; + } + + wk_bin_to_hex(buf, RAW_RO(item), item_len); + SET_STRING_ELT(result, i, Rf_mkChar(buf)); + } + + free(buf); + UNPROTECT(1); + return result; +} From 091dbadeaf33aecd8261e2715f9837fa3563e926 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 09:08:38 +1000 Subject: [PATCH 02/18] test vec_proxy_compare wkb --- tests/testthat/test-wkb.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index 80c447e6..b2463754 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -108,3 +108,17 @@ test_that("examples as wkb roundtrip", { ) } }) + +test_that("vec_equal(wkb) works", { + x <- as_wkb(wkt(c("POINT (1 1)", "POINT (2 2)", "POINT (3 3)"))) + raw_x <- c( + "0101000000000000000000f03f000000000000f03f", + "010100000000000000000000400000000000000040", + "010100000000000000000008400000000000000840" + ) + + expect_equal(vec_proxy_equal.wk_wkb(x), raw_x) + expect_equal(vctrs::vec_equal(x, x), c(TRUE, TRUE, TRUE)) + expect_equal(vctrs::vec_equal(x[1], x[2]), FALSE) + testthat::expect_no_error(dplyr::group_by(data.frame(x), x)) +}) From f21c3670ff6b2e09f37e683a98f461863e3bbad7 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 09:16:04 +1000 Subject: [PATCH 03/18] rm unnecessary namespace qualifier --- tests/testthat/test-wkb.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index b2463754..8c4a2b42 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -120,5 +120,5 @@ test_that("vec_equal(wkb) works", { expect_equal(vec_proxy_equal.wk_wkb(x), raw_x) expect_equal(vctrs::vec_equal(x, x), c(TRUE, TRUE, TRUE)) expect_equal(vctrs::vec_equal(x[1], x[2]), FALSE) - testthat::expect_no_error(dplyr::group_by(data.frame(x), x)) + expect_no_error(dplyr::group_by(data.frame(x), x)) }) From 1f2d0326e9f5c5fc5bb7f1d6fb78cfe5c66b7e58 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 09:25:11 +1000 Subject: [PATCH 04/18] add @anthonynorth as ctb --- DESCRIPTION | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 67f18b15..d299e238 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: wk Title: Lightweight Well-Known Geometry Parsing Version: 0.7.3.9000 -Authors@R: +Authors@R: c( person(given = "Dewey", family = "Dunnington", @@ -12,23 +12,27 @@ Authors@R: family = "Pebesma", role = c("aut"), email = "edzer.pebesma@uni-muenster.de", - comment = c(ORCID = "0000-0001-8049-7069")) + comment = c(ORCID = "0000-0001-8049-7069")), + person(given = "Anthony", + family = "North", + email = "anthony.jl.north@gmail.com", + role = c("ctb")) ) Maintainer: Dewey Dunnington Description: Provides a minimal R and C++ API for parsing well-known binary and well-known text representation of - geometries to and from R-native formats. + geometries to and from R-native formats. Well-known binary is compact and fast to parse; well-known text is human-readable and is useful for writing tests. These formats are - useful in R only if the information they contain can be - accessed in R, for which high-performance functions + useful in R only if the information they contain can be + accessed in R, for which high-performance functions are provided here. License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 -Suggests: +Suggests: testthat (>= 3.0.0), vctrs (>= 0.3.0), sf, @@ -37,6 +41,6 @@ Suggests: URL: https://paleolimbot.github.io/wk/, https://github.com/paleolimbot/wk BugReports: https://github.com/paleolimbot/wk/issues Config/testthat/edition: 3 -Depends: +Depends: R (>= 2.10) LazyData: true From f5c755c388df722dc99a9d207077218f0ca68cb6 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 09:33:19 +1000 Subject: [PATCH 05/18] add dplyr to suggests --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d299e238..30c712e9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,8 @@ Suggests: vctrs (>= 0.3.0), sf, tibble, - readr + readr, + dplyr URL: https://paleolimbot.github.io/wk/, https://github.com/paleolimbot/wk BugReports: https://github.com/paleolimbot/wk/issues Config/testthat/edition: 3 From 8547ade47ae09c773dd3cbf642c175a4a5d231a0 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 10:43:39 +1000 Subject: [PATCH 06/18] bugfix: overalloc hexstring buffer --- src/vctr.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vctr.c b/src/vctr.c index 1d079bad..6bc168fc 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -59,7 +59,7 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { SEXP result = PROTECT(Rf_allocVector(STRSXP, size)); const R_xlen_t buf_size = wk_max_length(geom) * 2 + 1; - char* buf = malloc(buf_size * 2 + 1); + char* buf = malloc(buf_size); if (buf == NULL) { Rf_error("Failed to alloc buffer"); // # nocov From a1d25488435fbb92c6aa4d06b6b1826a7a712c7c Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 14:45:49 +1000 Subject: [PATCH 07/18] remove dplyr check --- DESCRIPTION | 3 +-- tests/testthat/test-wkb.R | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 30c712e9..d299e238 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,8 +37,7 @@ Suggests: vctrs (>= 0.3.0), sf, tibble, - readr, - dplyr + readr URL: https://paleolimbot.github.io/wk/, https://github.com/paleolimbot/wk BugReports: https://github.com/paleolimbot/wk/issues Config/testthat/edition: 3 diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index 8c4a2b42..b30eda65 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -120,5 +120,4 @@ test_that("vec_equal(wkb) works", { expect_equal(vec_proxy_equal.wk_wkb(x), raw_x) expect_equal(vctrs::vec_equal(x, x), c(TRUE, TRUE, TRUE)) expect_equal(vctrs::vec_equal(x[1], x[2]), FALSE) - expect_no_error(dplyr::group_by(data.frame(x), x)) }) From 88d1cb976337d3d0c5e9dddb601c90c1e4b52a66 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 14:47:20 +1000 Subject: [PATCH 08/18] fix style inconsistencies --- src/vctr.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/vctr.c b/src/vctr.c index 6bc168fc..30604ee2 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -45,7 +45,7 @@ static R_xlen_t wk_max_length(const SEXP geom) { static void wk_bin_to_hex(char* restrict dst, const unsigned char* restrict src, const R_xlen_t n) { static const char hex[16] = "0123456789abcdef"; - for (R_xlen_t i = 0; i < n; ++i) { + for (R_xlen_t i = 0; i < n; i++) { const unsigned char byte = src[i]; dst[2 * i] = hex[(byte >> 4) & 0xf]; dst[2 * i + 1] = hex[byte & 0xf]; @@ -65,7 +65,7 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { Rf_error("Failed to alloc buffer"); // # nocov } - for (R_xlen_t i = 0; i < size; ++i) { + for (R_xlen_t i = 0; i < size; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); const SEXP item = VECTOR_ELT(geom, i); @@ -76,7 +76,7 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { continue; } - wk_bin_to_hex(buf, RAW_RO(item), item_len); + wk_bin_to_hex(buf, RAW(item), item_len); SET_STRING_ELT(result, i, Rf_mkChar(buf)); } From fa736098554a13119f6c8b4382955862e1ad3f0a Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 14:54:45 +1000 Subject: [PATCH 09/18] fix potential leak --- src/vctr.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/vctr.c b/src/vctr.c index 30604ee2..8005fed3 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -59,7 +59,8 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { SEXP result = PROTECT(Rf_allocVector(STRSXP, size)); const R_xlen_t buf_size = wk_max_length(geom) * 2 + 1; - char* buf = malloc(buf_size); + SEXP buf_shelter = PROTECT(Rf_allocVector(RAWSXP, buf_size)); + char* buf = (char*)RAW(buf_shelter); if (buf == NULL) { Rf_error("Failed to alloc buffer"); // # nocov @@ -80,7 +81,6 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { SET_STRING_ELT(result, i, Rf_mkChar(buf)); } - free(buf); - UNPROTECT(1); + UNPROTECT(2); return result; } From 32161bc4699ae7653dc797785984d9f766b63dc9 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 15:22:25 +1000 Subject: [PATCH 10/18] test wkb to hex little and big endian --- tests/testthat/test-wkb.R | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index b30eda65..5b6750d0 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -110,14 +110,29 @@ test_that("examples as wkb roundtrip", { }) test_that("vec_equal(wkb) works", { - x <- as_wkb(wkt(c("POINT (1 1)", "POINT (2 2)", "POINT (3 3)"))) - raw_x <- c( + points <- wkt(c("POINT (1 1)", "POINT (2 2)", "POINT (3 3)")) + + # little endian + wkb_little <- wk_handle(points, wkb_writer(endian = 1)) + hex_little <- c( "0101000000000000000000f03f000000000000f03f", "010100000000000000000000400000000000000040", "010100000000000000000008400000000000000840" ) - expect_equal(vec_proxy_equal.wk_wkb(x), raw_x) - expect_equal(vctrs::vec_equal(x, x), c(TRUE, TRUE, TRUE)) - expect_equal(vctrs::vec_equal(x[1], x[2]), FALSE) + expect_equal(vctrs::vec_proxy_equal(wkb_little), hex_little) + expect_equal(vctrs::vec_equal(wkb_little, wkb_little), c(TRUE, TRUE, TRUE)) + expect_equal(vctrs::vec_equal(wkb_little[1], wkb_little[2]), FALSE) + + # big endian + wkb_big <- wk_handle(points, wkb_writer(endian = 0)) + hex_big <- c( + "00000000013ff00000000000003ff0000000000000", + "000000000140000000000000004000000000000000", + "000000000140080000000000004008000000000000" + ) + + expect_equal(vctrs::vec_proxy_equal(wkb_big), hex_big) + expect_equal(vctrs::vec_equal(wkb_big, wkb_big), c(TRUE, TRUE, TRUE)) + expect_equal(vctrs::vec_equal(wkb_big[1], wkb_big[2]), FALSE) }) From 965332022da7b4ee85656fba23f62cf613c59037 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Mon, 10 Jul 2023 16:19:13 +1000 Subject: [PATCH 11/18] remove restrict --- src/vctr.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vctr.c b/src/vctr.c index 8005fed3..6520c78c 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -42,7 +42,7 @@ static R_xlen_t wk_max_length(const SEXP geom) { return max; } -static void wk_bin_to_hex(char* restrict dst, const unsigned char* restrict src, const R_xlen_t n) { +static void wk_bin_to_hex(char* dst, const unsigned char* src, const R_xlen_t n) { static const char hex[16] = "0123456789abcdef"; for (R_xlen_t i = 0; i < n; i++) { From dc374e4cf4b29a6ac0edfc6870f12932d4ee2eff Mon Sep 17 00:00:00 2001 From: Anthony North Date: Tue, 11 Jul 2023 12:49:00 +1000 Subject: [PATCH 12/18] Explicit NULL check Co-authored-by: Dewey Dunnington --- src/vctr.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/vctr.c b/src/vctr.c index 6520c78c..d907bb21 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -72,7 +72,7 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { const SEXP item = VECTOR_ELT(geom, i); const R_xlen_t item_len = Rf_xlength(item); - if (item_len == 0) { + if (item == R_NilValue) { SET_STRING_ELT(result, i, NA_STRING); continue; } From d200a5af58f6d4c56d564a0a82630706e3b1d3c3 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Tue, 11 Jul 2023 14:13:47 +1000 Subject: [PATCH 13/18] remove redundant alloc check Co-authored-by: Dewey Dunnington --- src/vctr.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/vctr.c b/src/vctr.c index d907bb21..e74cfaf0 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -62,10 +62,6 @@ SEXP wk_c_wkb_to_hex(const SEXP geom) { SEXP buf_shelter = PROTECT(Rf_allocVector(RAWSXP, buf_size)); char* buf = (char*)RAW(buf_shelter); - if (buf == NULL) { - Rf_error("Failed to alloc buffer"); // # nocov - } - for (R_xlen_t i = 0; i < size; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); From 82b6ca298ece1803b8da032e1d3dd9af356eb672 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Tue, 11 Jul 2023 14:22:12 +1000 Subject: [PATCH 14/18] test wkb_c_wkb_to_hex Co-authored-by: Dewey Dunnington --- tests/testthat/test-wkb.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index 5b6750d0..b0cd8bd1 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -109,6 +109,21 @@ test_that("examples as wkb roundtrip", { } }) +test_that("wk_c_wkb_to_hex works", { + list_of_raw <- list(as.raw(0:255), raw(0), NULL) + expect_identical( + .Call(wk_c_wkb_to_hex, list_of_raw), + c(paste(sprintf("%02x", 0:255), collapse = ""), "", NA_character_) + ) + + expect_error(.Call(wk_c_wkb_to_hex, list(list()))) + expect_error(.Call(wk_c_wkb_to_hex, list(logical()))) + expect_error(.Call(wk_c_wkb_to_hex, list(integer()))) + expect_error(.Call(wk_c_wkb_to_hex, list(double()))) + expect_error(.Call(wk_c_wkb_to_hex, list(complex()))) + expect_error(.Call(wk_c_wkb_to_hex, list(character()))) +}) + test_that("vec_equal(wkb) works", { points <- wkt(c("POINT (1 1)", "POINT (2 2)", "POINT (3 3)")) From 816174ce932847281a0507701b601ff45854d163 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Tue, 11 Jul 2023 14:29:44 +1000 Subject: [PATCH 15/18] style fixes --- src/vctr.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/vctr.c b/src/vctr.c index e74cfaf0..a7daa895 100644 --- a/src/vctr.c +++ b/src/vctr.c @@ -35,7 +35,7 @@ static R_xlen_t wk_max_length(const SEXP geom) { const R_xlen_t size = Rf_xlength(geom); R_xlen_t max = 0; - for (R_xlen_t i = 0; i < size; ++i) { + for (R_xlen_t i = 0; i < size; i++) { max = MAX(max, Rf_xlength(VECTOR_ELT(geom, i))); } @@ -46,9 +46,9 @@ static void wk_bin_to_hex(char* dst, const unsigned char* src, const R_xlen_t n) static const char hex[16] = "0123456789abcdef"; for (R_xlen_t i = 0; i < n; i++) { - const unsigned char byte = src[i]; - dst[2 * i] = hex[(byte >> 4) & 0xf]; - dst[2 * i + 1] = hex[byte & 0xf]; + const unsigned char byte = src[i]; + dst[2 * i] = hex[(byte >> 4) & 0xf]; + dst[2 * i + 1] = hex[byte & 0xf]; } dst[2 * n] = '\0'; From 8c3be738c7a9b41b36fc6856fb72252ee418135b Mon Sep 17 00:00:00 2001 From: Anthony North Date: Wed, 12 Jul 2023 10:31:08 +1000 Subject: [PATCH 16/18] remove unnecessary expect_error tests Co-authored-by: Dewey Dunnington --- tests/testthat/test-wkb.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index b0cd8bd1..c030510d 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -116,12 +116,6 @@ test_that("wk_c_wkb_to_hex works", { c(paste(sprintf("%02x", 0:255), collapse = ""), "", NA_character_) ) - expect_error(.Call(wk_c_wkb_to_hex, list(list()))) - expect_error(.Call(wk_c_wkb_to_hex, list(logical()))) - expect_error(.Call(wk_c_wkb_to_hex, list(integer()))) - expect_error(.Call(wk_c_wkb_to_hex, list(double()))) - expect_error(.Call(wk_c_wkb_to_hex, list(complex()))) - expect_error(.Call(wk_c_wkb_to_hex, list(character()))) }) test_that("vec_equal(wkb) works", { From ca5387146bc7f5d340dcd6778bf636ab22522e88 Mon Sep 17 00:00:00 2001 From: Anthony North Date: Wed, 12 Jul 2023 11:11:11 +1000 Subject: [PATCH 17/18] export wkb_to_hex --- R/pkg-vctrs.R | 2 +- R/wkb.R | 16 ++++++++++++++++ tests/testthat/test-wkb.R | 25 +++++++++++++++++++++++++ 3 files changed, 42 insertions(+), 1 deletion(-) diff --git a/R/pkg-vctrs.R b/R/pkg-vctrs.R index bafa4ffb..1cc1564c 100644 --- a/R/pkg-vctrs.R +++ b/R/pkg-vctrs.R @@ -14,7 +14,7 @@ vec_proxy.wk_wkb <- function(x, ...) { } vec_proxy_equal.wk_wkb <- function(x, ...) { - .Call(wk_c_wkb_to_hex, x) + wkb_to_hex(x) } vec_restore.wk_wkb <- function(x, to, ...) { diff --git a/R/wkb.R b/R/wkb.R index 18d366e5..aaceaa89 100644 --- a/R/wkb.R +++ b/R/wkb.R @@ -148,3 +148,19 @@ format.wk_wkb <- function(x, ...) { as.character.wk_wkb <- function(x, ...) { format(x, ...) } + + +#' Convert well-known binary to hex +#' +#' @param x A [wkb()] vector +#' +#' @return A hex encoded [wkb()] vector +#' @export +#' +#' @examples +#' x <- as_wkb(xyz(1:5, 6:10, 11:15)) +#' wkb_to_hex(x) +#' +wkb_to_hex <- function(x) { + .Call(wk_c_wkb_to_hex, as_wkb(x)) +} diff --git a/tests/testthat/test-wkb.R b/tests/testthat/test-wkb.R index c030510d..778dd41f 100644 --- a/tests/testthat/test-wkb.R +++ b/tests/testthat/test-wkb.R @@ -115,7 +115,32 @@ test_that("wk_c_wkb_to_hex works", { .Call(wk_c_wkb_to_hex, list_of_raw), c(paste(sprintf("%02x", 0:255), collapse = ""), "", NA_character_) ) +}) + +test_that("wkb_to_hex works", { + features <- wkt(c("POINT (0 0)", "LINESTRING (1 1, 2 2)", "POLYGON EMPTY", NA)) + + # little endian + wkb_little <- wk_handle(features, wkb_writer(endian = 1)) + hex_little <- c( + "010100000000000000000000000000000000000000", + "010200000002000000000000000000f03f000000000000f03f00000000000000400000000000000040", + "010300000000000000", + NA_character_ + ) + + expect_equal(wkb_to_hex(wkb_little), hex_little) + + # big endian + wkb_big <- wk_handle(features, wkb_writer(endian = 0)) + hex_big <- c( + "000000000100000000000000000000000000000000", + "0000000002000000023ff00000000000003ff000000000000040000000000000004000000000000000", + "000000000300000000", + NA_character_ + ) + expect_equal(wkb_to_hex(wkb_big), hex_big) }) test_that("vec_equal(wkb) works", { From dcc6721478e81636ba71505a290aacc3f8a6e6bc Mon Sep 17 00:00:00 2001 From: Dewey Dunnington Date: Sat, 15 Jul 2023 11:51:33 -0300 Subject: [PATCH 18/18] rebuild documentation --- NAMESPACE | 1 + man/wk-package.Rd | 5 +++++ man/wkb_to_hex.Rd | 22 ++++++++++++++++++++++ 3 files changed, 28 insertions(+) create mode 100644 man/wkb_to_hex.Rd diff --git a/NAMESPACE b/NAMESPACE index 4460f599..dc4b9829 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -465,6 +465,7 @@ export(wk_void) export(wk_void_handler) export(wk_writer) export(wkb) +export(wkb_to_hex) export(wkb_translate_wkb) export(wkb_translate_wkt) export(wkb_writer) diff --git a/man/wk-package.Rd b/man/wk-package.Rd index d70bebb6..7ff96e7a 100644 --- a/man/wk-package.Rd +++ b/man/wk-package.Rd @@ -25,5 +25,10 @@ Authors: \item Edzer Pebesma \email{edzer.pebesma@uni-muenster.de} (\href{https://orcid.org/0000-0001-8049-7069}{ORCID}) } +Other contributors: +\itemize{ + \item Anthony North \email{anthony.jl.north@gmail.com} [contributor] +} + } \keyword{internal} diff --git a/man/wkb_to_hex.Rd b/man/wkb_to_hex.Rd new file mode 100644 index 00000000..11272f6f --- /dev/null +++ b/man/wkb_to_hex.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wkb.R +\name{wkb_to_hex} +\alias{wkb_to_hex} +\title{Convert well-known binary to hex} +\usage{ +wkb_to_hex(x) +} +\arguments{ +\item{x}{A \code{\link[=wkb]{wkb()}} vector} +} +\value{ +A hex encoded \code{\link[=wkb]{wkb()}} vector +} +\description{ +Convert well-known binary to hex +} +\examples{ +x <- as_wkb(xyz(1:5, 6:10, 11:15)) +wkb_to_hex(x) + +}