wk/0000755000176200001440000000000014164574002010676 5ustar liggesuserswk/NAMESPACE0000644000176200001440000002537614164565761012146 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",wk_rcrd) S3method("[",wk_rcrd) S3method("[",wk_vctr) S3method("[<-",wk_crc) S3method("[<-",wk_rct) S3method("[<-",wk_wkb) S3method("[<-",wk_wkt) S3method("[<-",wk_xy) S3method("[[",wk_rcrd) S3method("[[",wk_vctr) S3method("[[<-",wk_rcrd) S3method("[[<-",wk_vctr) S3method("names<-",wk_rcrd) S3method(as.character,wk_rcrd) S3method(as.character,wk_wkb) S3method(as.character,wk_wkt) S3method(as.data.frame,wk_rcrd) S3method(as.data.frame,wk_vctr) S3method(as.matrix,wk_rcrd) S3method(as.matrix,wk_trans_affine) S3method(as_crc,data.frame) S3method(as_crc,matrix) S3method(as_crc,wk_crc) S3method(as_rct,bbox) S3method(as_rct,data.frame) S3method(as_rct,matrix) S3method(as_rct,wk_rct) S3method(as_wk_trans,wk_trans) S3method(as_wkb,WKB) S3method(as_wkb,blob) S3method(as_wkb,character) S3method(as_wkb,default) S3method(as_wkb,sf) S3method(as_wkb,sfc) S3method(as_wkb,sfg) S3method(as_wkb,wk_wkb) S3method(as_wkt,character) S3method(as_wkt,default) S3method(as_wkt,sf) S3method(as_wkt,wk_wkt) S3method(as_xy,data.frame) S3method(as_xy,default) S3method(as_xy,matrix) S3method(as_xy,sf) S3method(as_xy,sfc) S3method(as_xy,wk_xy) S3method(c,wk_rcrd) S3method(c,wk_vctr) S3method(format,wk_crc) S3method(format,wk_crs_inherit) S3method(format,wk_rcrd) S3method(format,wk_rct) S3method(format,wk_trans_affine) S3method(format,wk_wkb) S3method(format,wk_wkt) S3method(format,wk_xy) S3method(format,wk_xym) S3method(format,wk_xyz) S3method(format,wk_xyzm) S3method(is.na,wk_rcrd) S3method(is.na,wk_wkb) S3method(length,wk_rcrd) S3method(names,wk_rcrd) S3method(plot,wk_crc) S3method(plot,wk_rct) S3method(plot,wk_wkb) S3method(plot,wk_wkt) S3method(plot,wk_xy) S3method(print,wk_crs_inherit) S3method(print,wk_handler) S3method(print,wk_rcrd) S3method(print,wk_trans_affine) S3method(print,wk_vctr) S3method(rep,wk_rcrd) S3method(rep,wk_vctr) S3method(rep_len,wk_rcrd) S3method(rep_len,wk_vctr) S3method(str,wk_rcrd) S3method(str,wk_vctr) S3method(vec_cast.wk_crc,default) S3method(vec_cast.wk_rct,default) S3method(vec_cast.wk_wkb,default) S3method(vec_cast.wk_wkb,wk_crc) S3method(vec_cast.wk_wkb,wk_rct) S3method(vec_cast.wk_wkb,wk_wkb) S3method(vec_cast.wk_wkb,wk_wkt) S3method(vec_cast.wk_wkb,wk_xy) S3method(vec_cast.wk_wkb,wk_xym) S3method(vec_cast.wk_wkb,wk_xyz) S3method(vec_cast.wk_wkb,wk_xyzm) S3method(vec_cast.wk_wkt,default) S3method(vec_cast.wk_wkt,wk_crc) S3method(vec_cast.wk_wkt,wk_rct) S3method(vec_cast.wk_wkt,wk_wkb) S3method(vec_cast.wk_wkt,wk_wkt) S3method(vec_cast.wk_wkt,wk_xy) S3method(vec_cast.wk_wkt,wk_xym) S3method(vec_cast.wk_wkt,wk_xyz) S3method(vec_cast.wk_wkt,wk_xyzm) S3method(vec_cast.wk_xy,default) S3method(vec_cast.wk_xy,wk_wkb) S3method(vec_cast.wk_xy,wk_wkt) S3method(vec_cast.wk_xy,wk_xy) S3method(vec_cast.wk_xy,wk_xym) S3method(vec_cast.wk_xy,wk_xyz) S3method(vec_cast.wk_xy,wk_xyzm) S3method(vec_cast.wk_xym,default) S3method(vec_cast.wk_xym,wk_wkb) S3method(vec_cast.wk_xym,wk_wkt) S3method(vec_cast.wk_xym,wk_xy) S3method(vec_cast.wk_xym,wk_xym) S3method(vec_cast.wk_xym,wk_xyz) S3method(vec_cast.wk_xym,wk_xyzm) S3method(vec_cast.wk_xyz,default) S3method(vec_cast.wk_xyz,wk_wkb) S3method(vec_cast.wk_xyz,wk_wkt) S3method(vec_cast.wk_xyz,wk_xy) S3method(vec_cast.wk_xyz,wk_xym) S3method(vec_cast.wk_xyz,wk_xyz) S3method(vec_cast.wk_xyz,wk_xyzm) S3method(vec_cast.wk_xyzm,default) S3method(vec_cast.wk_xyzm,wk_wkb) S3method(vec_cast.wk_xyzm,wk_wkt) S3method(vec_cast.wk_xyzm,wk_xy) S3method(vec_cast.wk_xyzm,wk_xym) S3method(vec_cast.wk_xyzm,wk_xyz) S3method(vec_cast.wk_xyzm,wk_xyzm) S3method(vec_ptype2.wk_crc,wk_crc) S3method(vec_ptype2.wk_crc,wk_wkb) S3method(vec_ptype2.wk_crc,wk_wkt) S3method(vec_ptype2.wk_crc,wk_xy) S3method(vec_ptype2.wk_crc,wk_xym) S3method(vec_ptype2.wk_crc,wk_xyz) S3method(vec_ptype2.wk_crc,wk_xyzm) S3method(vec_ptype2.wk_rct,wk_crc) S3method(vec_ptype2.wk_rct,wk_rct) S3method(vec_ptype2.wk_rct,wk_wkb) S3method(vec_ptype2.wk_rct,wk_wkt) S3method(vec_ptype2.wk_rct,wk_xy) S3method(vec_ptype2.wk_rct,wk_xym) S3method(vec_ptype2.wk_rct,wk_xyz) S3method(vec_ptype2.wk_rct,wk_xyzm) S3method(vec_ptype2.wk_wkb,default) S3method(vec_ptype2.wk_wkb,wk_crc) S3method(vec_ptype2.wk_wkb,wk_rct) S3method(vec_ptype2.wk_wkb,wk_wkb) S3method(vec_ptype2.wk_wkb,wk_wkt) S3method(vec_ptype2.wk_wkb,wk_xy) S3method(vec_ptype2.wk_wkb,wk_xym) S3method(vec_ptype2.wk_wkb,wk_xyz) S3method(vec_ptype2.wk_wkb,wk_xyzm) S3method(vec_ptype2.wk_wkt,default) S3method(vec_ptype2.wk_wkt,wk_crc) S3method(vec_ptype2.wk_wkt,wk_rct) S3method(vec_ptype2.wk_wkt,wk_wkb) S3method(vec_ptype2.wk_wkt,wk_wkt) S3method(vec_ptype2.wk_wkt,wk_xy) S3method(vec_ptype2.wk_wkt,wk_xym) S3method(vec_ptype2.wk_wkt,wk_xyz) S3method(vec_ptype2.wk_wkt,wk_xyzm) S3method(vec_ptype2.wk_xy,wk_crc) S3method(vec_ptype2.wk_xy,wk_rct) S3method(vec_ptype2.wk_xy,wk_wkb) S3method(vec_ptype2.wk_xy,wk_wkt) S3method(vec_ptype2.wk_xy,wk_xy) S3method(vec_ptype2.wk_xy,wk_xym) S3method(vec_ptype2.wk_xy,wk_xyz) S3method(vec_ptype2.wk_xy,wk_xyzm) S3method(vec_ptype2.wk_xym,wk_crc) S3method(vec_ptype2.wk_xym,wk_rct) S3method(vec_ptype2.wk_xym,wk_wkb) S3method(vec_ptype2.wk_xym,wk_wkt) S3method(vec_ptype2.wk_xym,wk_xy) S3method(vec_ptype2.wk_xym,wk_xym) S3method(vec_ptype2.wk_xym,wk_xyz) S3method(vec_ptype2.wk_xym,wk_xyzm) S3method(vec_ptype2.wk_xyz,wk_crc) S3method(vec_ptype2.wk_xyz,wk_rct) S3method(vec_ptype2.wk_xyz,wk_wkb) S3method(vec_ptype2.wk_xyz,wk_wkt) S3method(vec_ptype2.wk_xyz,wk_xy) S3method(vec_ptype2.wk_xyz,wk_xym) S3method(vec_ptype2.wk_xyz,wk_xyz) S3method(vec_ptype2.wk_xyz,wk_xyzm) S3method(vec_ptype2.wk_xyzm,wk_crc) S3method(vec_ptype2.wk_xyzm,wk_rct) S3method(vec_ptype2.wk_xyzm,wk_wkb) S3method(vec_ptype2.wk_xyzm,wk_wkt) S3method(vec_ptype2.wk_xyzm,wk_xy) S3method(vec_ptype2.wk_xyzm,wk_xym) S3method(vec_ptype2.wk_xyzm,wk_xyz) S3method(vec_ptype2.wk_xyzm,wk_xyzm) S3method(wk_bbox,default) S3method(wk_count,default) S3method(wk_crs,data.frame) S3method(wk_crs,sf) S3method(wk_crs,sfc) S3method(wk_crs,sfg) S3method(wk_crs,wk_rcrd) S3method(wk_crs,wk_vctr) S3method(wk_crs_equal_generic,crs) S3method(wk_crs_equal_generic,default) S3method(wk_crs_equal_generic,double) S3method(wk_crs_equal_generic,integer) S3method(wk_crs_proj_definition,"NULL") S3method(wk_crs_proj_definition,character) S3method(wk_crs_proj_definition,crs) S3method(wk_crs_proj_definition,double) S3method(wk_crs_proj_definition,integer) S3method(wk_envelope,default) S3method(wk_envelope,wk_crc) S3method(wk_envelope,wk_rct) S3method(wk_envelope,wk_xy) S3method(wk_handle,bbox) S3method(wk_handle,data.frame) S3method(wk_handle,sf) S3method(wk_handle,sfc) S3method(wk_handle,sfg) S3method(wk_handle,wk_crc) S3method(wk_handle,wk_rct) S3method(wk_handle,wk_wkb) S3method(wk_handle,wk_wkt) S3method(wk_handle,wk_xy) S3method(wk_handle_slice,data.frame) S3method(wk_handle_slice,default) S3method(wk_is_geodesic,data.frame) S3method(wk_is_geodesic,default) S3method(wk_is_geodesic,wk_wkb) S3method(wk_is_geodesic,wk_wkt) S3method(wk_meta,default) S3method(wk_plot,default) S3method(wk_restore,data.frame) S3method(wk_restore,default) S3method(wk_restore,sf) S3method(wk_restore,tbl_df) S3method(wk_set_crs,data.frame) S3method(wk_set_crs,sf) S3method(wk_set_crs,sfc) S3method(wk_set_crs,wk_rcrd) S3method(wk_set_crs,wk_vctr) S3method(wk_set_geodesic,data.frame) S3method(wk_set_geodesic,default) S3method(wk_set_geodesic,wk_wkb) S3method(wk_set_geodesic,wk_wkt) S3method(wk_trans_inverse,wk_trans_affine) S3method(wk_translate,data.frame) S3method(wk_translate,default) S3method(wk_translate,sf) S3method(wk_translate,sfc) S3method(wk_translate,tbl_df) S3method(wk_vector_meta,default) S3method(wk_writer,data.frame) S3method(wk_writer,default) S3method(wk_writer,sf) S3method(wk_writer,sfc) S3method(wk_writer,wk_wkb) S3method(wk_writer,wk_wkt) S3method(wk_writer,wk_xy) export("wk_crs<-") export("wk_is_geodesic<-") export(as_crc) export(as_rct) export(as_wk_handler) export(as_wk_trans) export(as_wkb) export(as_wkt) export(as_xy) export(crc) export(handle_wkt_without_vector_size) export(is_handleable) export(is_wk_handler) export(is_wk_wkb) export(is_wk_wkt) export(new_wk_crc) export(new_wk_handler) export(new_wk_rct) export(new_wk_trans) export(new_wk_wkb) export(new_wk_wkt) export(new_wk_xy) export(new_wk_xym) export(new_wk_xyz) export(new_wk_xyzm) export(parse_wkb) export(parse_wkt) export(rct) export(sfc_writer) export(validate_wk_wkb) export(validate_wk_wkt) export(validate_wk_xy) export(validate_wk_xym) export(validate_wk_xyz) export(validate_wk_xyzm) export(vec_cast.wk_crc) export(vec_cast.wk_rct) export(vec_cast.wk_wkb) export(vec_cast.wk_wkt) export(vec_cast.wk_xy) export(vec_cast.wk_xym) export(vec_cast.wk_xyz) export(vec_cast.wk_xyzm) export(vec_ptype2.wk_crc) export(vec_ptype2.wk_rct) export(vec_ptype2.wk_wkb) export(vec_ptype2.wk_wkt) export(vec_ptype2.wk_xy) export(vec_ptype2.wk_xym) export(vec_ptype2.wk_xyz) export(vec_ptype2.wk_xyzm) export(wk_affine_compose) export(wk_affine_fit) export(wk_affine_identity) export(wk_affine_invert) export(wk_affine_rescale) export(wk_affine_rotate) export(wk_affine_scale) export(wk_affine_translate) export(wk_bbox) export(wk_bbox_handler) export(wk_chunk_map_feature) export(wk_chunk_strategy_coordinates) export(wk_chunk_strategy_feature) export(wk_chunk_strategy_single) export(wk_collection) export(wk_collection_filter) export(wk_coords) export(wk_count) export(wk_count_handler) export(wk_crs) export(wk_crs_auto) export(wk_crs_auto_value) export(wk_crs_equal) export(wk_crs_equal_generic) export(wk_crs_inherit) export(wk_crs_longlat) export(wk_crs_output) export(wk_crs_proj_definition) export(wk_debug) export(wk_debug_filter) export(wk_drop_m) export(wk_drop_z) export(wk_envelope) export(wk_envelope_handler) export(wk_flatten) export(wk_flatten_filter) export(wk_format) export(wk_geodesic_inherit) export(wk_geometry_type) export(wk_geometry_type_label) export(wk_handle) export(wk_handle_slice) export(wk_identity) export(wk_identity_filter) export(wk_is_geodesic) export(wk_is_geodesic_output) export(wk_linestring) export(wk_linestring_filter) export(wk_meta) export(wk_meta_handler) export(wk_platform_endian) export(wk_plot) export(wk_polygon) export(wk_polygon_filter) export(wk_problems) export(wk_problems_handler) export(wk_restore) export(wk_set_crs) export(wk_set_geodesic) export(wk_set_m) export(wk_set_z) export(wk_trans_affine) export(wk_trans_inverse) export(wk_trans_set) export(wk_transform) export(wk_transform_filter) export(wk_translate) export(wk_vector_meta) export(wk_vector_meta_handler) export(wk_vertex_filter) export(wk_vertices) export(wk_void) export(wk_void_handler) export(wk_writer) export(wkb) export(wkb_translate_wkb) export(wkb_translate_wkt) export(wkb_writer) export(wkt) export(wkt_format_handler) export(wkt_translate_wkb) export(wkt_translate_wkt) export(wkt_writer) export(xy) export(xy_dims) export(xy_writer) export(xym) export(xyz) export(xyzm) importFrom(graphics,plot) useDynLib(wk, .registration = TRUE) wk/LICENSE0000644000176200001440000000005614106220314011672 0ustar liggesusersYEAR: 2020 COPYRIGHT HOLDER: Dewey Dunnington wk/README.md0000644000176200001440000001014214163210274012150 0ustar liggesusers # wk [![R build status](https://github.com/paleolimbot/wk/workflows/R-CMD-check/badge.svg)](https://github.com/paleolimbot/wk/actions) [![Codecov test coverage](https://codecov.io/gh/paleolimbot/wk/branch/master/graph/badge.svg)](https://app.codecov.io/gh/paleolimbot/wk?branch=master) The goal of wk is to provide lightweight R, C, and C++ infrastructure for a distributed ecosystem of packages that operate on collections of coordinates. First, wk provides vector classes for points, circles, rectangles, well-known text (WKT), and well-known binary (WKB). Second, wk provides a C API and set of S3 generics for event-based iteration over vectors of geometries. ## Installation You can install the released version of wk from [CRAN](https://cran.r-project.org/) with: ``` r install.packages("wk") ``` You can install the development version from [GitHub](https://github.com/) with: ``` r # install.packages("remotes") remotes::install_github("paleolimbot/wk") ``` If you can load the package, you’re good to go! ``` r library(wk) ``` ## Vector classes Use `wkt()` to mark a character vector as containing well-known text, or `wkb()` to mark a vector as well-known binary. Use `xy()`, `xyz()`, `xym()`, and `xyzm()` to create vectors of points, and `rct()` to create vectors of rectangles. These classes have full [vctrs](https://vctrs.r-lib.org) support and `plot()`/`format()` methods to make them as frictionless as possible working in R and RStudio. ``` r wkt("POINT (30 10)") #> #> [1] POINT (30 10) as_wkb(wkt("POINT (30 10)")) #> #> [1] xy(1, 2) #> #> [1] (1 2) rct(1, 2, 3, 4) #> #> [1] [1 2 3 4] crc(0, 0, 1) #> #> [1] [0 0, r = 1] ``` ## Generics The wk package is made up of readers, handlers, and filters. Readers parse the various formats supported by the wk package, handlers calculate values based on information from the readers (e.g., translating a vector of geometries into another format), and filters transform information from the readers (e.g., transforming coordinates) on the fly. The `wk_handle()` and `wk_translate()` generics power operations for many geometry vector formats without having to explicitly support each one. ## C API The distributed nature of the wk framework is powered by a [\~100-line header](https://github.com/paleolimbot/wk/blob/master/inst/include/wk-v1.h) describing the types of information that parsers typically encounter when reading geometries and the order in which that information is typically organized. Detailed information is available in the [C and C++ API article](https://paleolimbot.github.io/wk/articles/articles/programming.html). ``` r wk_debug( as_wkt("LINESTRING (1 1, 2 2, 3 3)"), wkt_format_handler(max_coords = 2) ) #> initialize (dirty = 0 -> 1) #> vector_start: [1] <0x16dd25e18> => WK_CONTINUE #> feature_start (1): <0x16dd25e18> => WK_CONTINUE #> geometry_start (): LINESTRING[UNKNOWN] <0x16dd25d20> => WK_CONTINUE #> coord (1): <0x16dd25d20> (1.000000 1.000000) => WK_CONTINUE #> coord (2): <0x16dd25d20> (2.000000 2.000000) => WK_ABORT_FEATURE #> vector_end: <0x16dd25e18> #> deinitialize #> [1] "LINESTRING (1 1, 2 2..." ``` ## sf support The wk package implements a reader and writer for sfc objects so you can use them wherever you’d use an `xy()`, `rct()`, `crc()`, `wkb()`, or `wkt()`: ``` r wk_debug( sf::st_sfc(sf::st_linestring(rbind(c(1, 1), c(2, 2), c(3, 3)))), wkt_format_handler(max_coords = 2) ) #> initialize (dirty = 0 -> 1) #> vector_start: LINESTRING B[1] <0x16dd28df0> => WK_CONTINUE #> feature_start (1): <0x16dd28df0> => WK_CONTINUE #> geometry_start (): LINESTRING[3] <0x16dd28d50> => WK_CONTINUE #> coord (1): <0x16dd28d50> (1.000000 1.000000) => WK_CONTINUE #> coord (2): <0x16dd28d50> (2.000000 2.000000) => WK_ABORT_FEATURE #> vector_end: <0x16dd28df0> #> deinitialize #> [1] "LINESTRING (1 1, 2 2..." ``` ## Lightweight The wk package has zero dependencies and compiles in \~10 seconds. wk/man/0000755000176200001440000000000014163210157011446 5ustar liggesuserswk/man/wk_problems.Rd0000644000176200001440000000203714106220314014254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/problems.R \name{wk_problems} \alias{wk_problems} \alias{wk_problems_handler} \title{Validate well-known binary and well-known text} \usage{ wk_problems(handleable, ...) wk_problems_handler() } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ A character vector of parsing errors. \code{NA} signifies that there was no parsing error. } \description{ The problems handler returns a character vector of parse errors and can be used to validate input of any type for which \code{\link[=wk_handle]{wk_handle()}} is defined. } \examples{ wk_problems(new_wk_wkt(c("POINT EMTPY", "POINT (20 30)"))) wk_handle( new_wk_wkt(c("POINT EMTPY", "POINT (20 30)")), wk_problems_handler() ) } wk/man/wk_is_geodesic.Rd0000644000176200001440000000135514163210157014717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wk-crs.R \name{wk_is_geodesic} \alias{wk_is_geodesic} \alias{wk_set_geodesic} \alias{wk_is_geodesic<-} \alias{wk_geodesic_inherit} \title{Set and get vector geodesic edge interpolation} \usage{ wk_is_geodesic(x) wk_set_geodesic(x, geodesic) wk_is_geodesic(x) <- value wk_geodesic_inherit() } \arguments{ \item{x}{An R object that contains edges} \item{geodesic, value}{\code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise.} } \value{ \code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise. } \description{ Set and get vector geodesic edge interpolation } wk/man/wk_chunk_strategy_single.Rd0000644000176200001440000000272214145575672017054 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/chunk.R \name{wk_chunk_strategy_single} \alias{wk_chunk_strategy_single} \alias{wk_chunk_strategy_feature} \alias{wk_chunk_strategy_coordinates} \title{Chunking strategies} \usage{ wk_chunk_strategy_single() wk_chunk_strategy_feature(n_chunks = NULL, chunk_size = NULL) wk_chunk_strategy_coordinates(n_chunks = NULL, chunk_size = NULL, reduce = "*") } \arguments{ \item{n_chunks, chunk_size}{Exactly one of the number of chunks or the chunk size. For \code{\link[=wk_chunk_strategy_feature]{wk_chunk_strategy_feature()}} the chunk size refers to the number of features; for \code{\link[=wk_chunk_strategy_coordinates]{wk_chunk_strategy_coordinates()}} this refers to the number of coordinates as calculated from multiple handleables using \code{reduce}.} \item{reduce}{For \code{\link[=wk_chunk_strategy_coordinates]{wk_chunk_strategy_coordinates()}} this refers to the function used with \code{\link[=Reduce]{Reduce()}} to combine coordinate counts from more than one handleable.} } \value{ A function that returns a \code{data.frame} with columns \code{from} and \code{to} when called with a \code{handleable} and the feature count. } \description{ Chunking strategies } \examples{ feat <- c(as_wkt(xy(1:4, 1:4)), wkt("LINESTRING (1 1, 2 2)")) wk_chunk_strategy_single()(list(feat), 5) wk_chunk_strategy_feature(chunk_size = 2)(list(feat), 5) wk_chunk_strategy_coordinates(chunk_size = 2)(list(feat), 5) } wk/man/new_wk_crc.Rd0000644000176200001440000000062214106220314014047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/crc.R \name{new_wk_crc} \alias{new_wk_crc} \title{S3 details for crc objects} \usage{ new_wk_crc(x = list(x = double(), y = double(), r = double()), crs = NULL) } \arguments{ \item{x}{A \code{\link[=crc]{crc()}}} \item{crs}{A value to be propagated as the CRS for this vector.} } \description{ S3 details for crc objects } wk/man/wk-package.Rd0000644000176200001440000000214414145575672013770 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wk-package.R \docType{package} \name{wk-package} \alias{wk} \alias{wk-package} \title{wk: Lightweight Well-Known Geometry Parsing} \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. Well-known binary is compact and fast to parse; well-known text is human-readable and is useful for writing tests. These formats are only useful in R if the information they contain can be accessed in R, for which high-performance functions are provided here. } \seealso{ Useful links: \itemize{ \item \url{https://paleolimbot.github.io/wk/} \item \url{https://github.com/paleolimbot/wk} \item Report bugs at \url{https://github.com/paleolimbot/wk/issues} } } \author{ \strong{Maintainer}: Dewey Dunnington \email{dewey@fishandwhistle.net} (\href{https://orcid.org/0000-0002-9415-4582}{ORCID}) Authors: \itemize{ \item Edzer Pebesma \email{edzer.pebesma@uni-muenster.de} (\href{https://orcid.org/0000-0001-8049-7069}{ORCID}) } } \keyword{internal} wk/man/wk_transform.Rd0000644000176200001440000000151614106220314014445 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/transform.R \name{wk_transform} \alias{wk_transform} \alias{wk_transform_filter} \title{Apply coordinate transformations} \usage{ wk_transform(handleable, trans, ...) wk_transform_filter(handler, trans) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{trans}{An external pointer to a wk_trans object} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} } \description{ Apply coordinate transformations } \examples{ wk_transform(xy(0, 0), wk_affine_translate(2, 3)) } wk/man/wk_crs_inherit.Rd0000644000176200001440000000227414153402075014755 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wk-crs.R \name{wk_crs_inherit} \alias{wk_crs_inherit} \alias{wk_crs_longlat} \alias{wk_crs_auto} \alias{wk_crs_auto_value} \title{Special CRS values} \usage{ wk_crs_inherit() wk_crs_longlat(crs = NULL) wk_crs_auto() wk_crs_auto_value(x, crs) } \arguments{ \item{crs}{A value for the coordinate reference system supplied by the user.} \item{x}{A raw input to a construuctor whose length and crs attributte is used to determine the default CRS returned by \code{\link[=wk_crs_auto]{wk_crs_auto()}}.} } \description{ The CRS handling in the wk package requires two sentinel CRS values. The first, \code{\link[=wk_crs_inherit]{wk_crs_inherit()}}, signals that the vector should inherit a CRS of another vector if combined. This is useful for empty, \code{NULL}, and/or zero-length geometries. The second, \code{\link[=wk_crs_auto]{wk_crs_auto()}}, is used as the default argument of \code{crs} for constructors so that zero-length geometries are assigned a CRS of \code{wk_crs_inherit()} by default. } \examples{ wk_crs_auto_value(list(), wk_crs_auto()) wk_crs_auto_value(list(), 1234) wk_crs_auto_value(list(NULL), wk_crs_auto()) } wk/man/wk_vertices.Rd0000644000176200001440000000327314106220314014260 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vertex-filter.R \name{wk_vertices} \alias{wk_vertices} \alias{wk_coords} \alias{wk_vertex_filter} \title{Extract vertices} \usage{ wk_vertices(handleable, ...) wk_coords(handleable, ...) wk_vertex_filter(handler, add_details = FALSE) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{add_details}{Use \code{TRUE} to add a "wk_details" attribute, which contains columns \code{feature_id}, \code{part_id}, and \code{ring_id}.} } \value{ \itemize{ \item \code{wk_vertices()} extracts vertices and returns the in the same format as the handler \item \code{wk_coords()} returns a data frame with columns columns \code{feature_id} (the index of the feature from whence it came), \code{part_id} (an arbitrary integer identifying the point, line, or polygon from whence it came), \code{ring_id} (an arbitrary integer identifying individual rings within polygons), and one column per coordinate (\code{x}, \code{y}, and/or \code{z} and/or \code{m}). } } \description{ These functions provide ways to extract individual coordinate values. Whereas \code{wk_vertices()} returns a vector of coordinates as in the same format as the input, \code{wk_coords()} returns a data frame with coordinates as columns. } \examples{ wk_vertices(wkt("LINESTRING (0 0, 1 1)")) wk_coords(wkt("LINESTRING (0 0, 1 1)")) } wk/man/wk_bbox.Rd0000644000176200001440000000222014161345517013373 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bbox.R \name{wk_bbox} \alias{wk_bbox} \alias{wk_envelope} \alias{wk_bbox.default} \alias{wk_envelope.default} \alias{wk_envelope.wk_rct} \alias{wk_envelope.wk_crc} \alias{wk_envelope.wk_xy} \alias{wk_bbox_handler} \alias{wk_envelope_handler} \title{2D bounding rectangles} \usage{ wk_bbox(handleable, ...) wk_envelope(handleable, ...) \method{wk_bbox}{default}(handleable, ...) \method{wk_envelope}{default}(handleable, ...) \method{wk_envelope}{wk_rct}(handleable, ...) \method{wk_envelope}{wk_crc}(handleable, ...) \method{wk_envelope}{wk_xy}(handleable, ...) wk_bbox_handler() wk_envelope_handler() } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ A \code{\link[=rct]{rct()}} of length 1. } \description{ 2D bounding rectangles } \examples{ wk_bbox(wkt("LINESTRING (1 2, 3 5)")) } wk/man/wk_trans_affine.Rd0000644000176200001440000000240614106220314015070 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/affine.R \name{wk_trans_affine} \alias{wk_trans_affine} \alias{wk_affine_identity} \alias{wk_affine_rotate} \alias{wk_affine_scale} \alias{wk_affine_translate} \alias{wk_affine_fit} \alias{wk_affine_rescale} \alias{wk_affine_compose} \alias{wk_affine_invert} \title{Affine transformer} \usage{ wk_trans_affine(trans_matrix) wk_affine_identity() wk_affine_rotate(rotation_deg) wk_affine_scale(scale_x = 1, scale_y = 1) wk_affine_translate(dx = 0, dy = 0) wk_affine_fit(src, dst) wk_affine_rescale(rct_in, rct_out) wk_affine_compose(...) wk_affine_invert(x) } \arguments{ \item{trans_matrix}{A 3x3 transformation matrix} \item{rotation_deg}{A rotation to apply in degrees counterclockwise.} \item{scale_x, scale_y}{Scale factor to apply in the x and y directions, respectively} \item{dx, dy}{Coordinate offsets in the x and y direction} \item{src, dst}{Point vectors of control points used to estimate the affine mapping (using \code{\link[base:qr]{base::qr.solve()}}).} \item{rct_in, rct_out}{The input and output bounds} \item{...}{Zero or more transforms in the order they should be applied.} \item{x}{A \code{\link[=wk_trans_affine]{wk_trans_affine()}}} } \description{ Affine transformer } wk/man/crc.Rd0000644000176200001440000000136314106220314012500 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/crc.R \name{crc} \alias{crc} \alias{as_crc} \alias{as_crc.wk_crc} \alias{as_crc.matrix} \alias{as_crc.data.frame} \title{2D Circle Vectors} \usage{ crc(x = double(), y = double(), r = double(), crs = wk_crs_auto()) as_crc(x, ...) \method{as_crc}{wk_crc}(x, ...) \method{as_crc}{matrix}(x, ..., crs = NULL) \method{as_crc}{data.frame}(x, ..., crs = NULL) } \arguments{ \item{x, y}{Coordinates of the center} \item{r}{Circle radius} \item{crs}{A value to be propagated as the CRS for this vector.} \item{...}{Extra arguments passed to \code{as_crc()}.} } \value{ A vector along the recycled length of bounds. } \description{ 2D Circle Vectors } \examples{ crc(1, 2, 3) } wk/man/wk_trans_inverse.Rd0000644000176200001440000000132214106220314015307 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/transform.R \name{wk_trans_inverse} \alias{wk_trans_inverse} \alias{as_wk_trans} \alias{as_wk_trans.wk_trans} \alias{new_wk_trans} \title{Generic transform class} \usage{ wk_trans_inverse(trans, ...) as_wk_trans(x, ...) \method{as_wk_trans}{wk_trans}(x, ...) new_wk_trans(trans_ptr, subclass = character()) } \arguments{ \item{trans}{An external pointer to a wk_trans object} \item{...}{Passed to S3 methods} \item{x}{An object to be converted to a transform.} \item{trans_ptr}{An external pointer to a wk_trans_t transform struct.} \item{subclass}{An optional subclass to apply to the pointer} } \description{ Generic transform class } wk/man/wk_crs.Rd0000644000176200001440000000164514153402075013234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wk-crs.R \name{wk_crs} \alias{wk_crs} \alias{wk_crs.wk_vctr} \alias{wk_crs.wk_rcrd} \alias{wk_crs<-} \alias{wk_set_crs} \alias{wk_crs_output} \alias{wk_is_geodesic_output} \title{Set and get vector CRS} \usage{ wk_crs(x) \method{wk_crs}{wk_vctr}(x) \method{wk_crs}{wk_rcrd}(x) wk_crs(x) <- value wk_set_crs(x, crs) wk_crs_output(...) wk_is_geodesic_output(...) } \arguments{ \item{x, ...}{Objects whose "crs" attribute is used to carry a CRS.} \item{crs, value}{An object that can be interpreted as a CRS} } \description{ The wk package doesn't operate on CRS objects, but does propagate them through subsetting and concatenation. A CRS object can be any R object, and x can be any object whose 'crs' attribute carries a CRS. These functions are S3 generics to keep them from being used on objects that do not use this system of CRS propagation. } wk/man/wkt.Rd0000644000176200001440000000173714161345517012561 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wkt.R \name{wkt} \alias{wkt} \alias{parse_wkt} \alias{as_wkt} \alias{as_wkt.default} \alias{as_wkt.character} \alias{as_wkt.wk_wkt} \title{Mark character vectors as well-known text} \usage{ wkt(x = character(), crs = wk_crs_auto(), geodesic = FALSE) parse_wkt(x, crs = wk_crs_auto(), geodesic = FALSE) as_wkt(x, ...) \method{as_wkt}{default}(x, ...) \method{as_wkt}{character}(x, ..., crs = NULL, geodesic = FALSE) \method{as_wkt}{wk_wkt}(x, ...) } \arguments{ \item{x}{A \code{\link[=character]{character()}} vector containing well-known text.} \item{crs}{A value to be propagated as the CRS for this vector.} \item{geodesic}{\code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise.} \item{...}{Unused} } \value{ A \code{\link[=new_wk_wkt]{new_wk_wkt()}} } \description{ Mark character vectors as well-known text } \examples{ wkt("POINT (20 10)") } wk/man/xy.Rd0000644000176200001440000000226114106220314012367 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/xyzm.R \name{xy} \alias{xy} \alias{xyz} \alias{xym} \alias{xyzm} \alias{xy_dims} \alias{as_xy} \alias{as_xy.default} \alias{as_xy.wk_xy} \alias{as_xy.matrix} \alias{as_xy.data.frame} \title{Efficient point vectors} \usage{ xy(x = double(), y = double(), crs = wk_crs_auto()) xyz(x = double(), y = double(), z = double(), crs = wk_crs_auto()) xym(x = double(), y = double(), m = double(), crs = wk_crs_auto()) xyzm( x = double(), y = double(), z = double(), m = double(), crs = wk_crs_auto() ) xy_dims(x) as_xy(x, ...) \method{as_xy}{default}(x, ..., dims = NULL) \method{as_xy}{wk_xy}(x, ..., dims = NULL) \method{as_xy}{matrix}(x, ..., crs = NULL) \method{as_xy}{data.frame}(x, ..., dims = NULL, crs = NULL) } \arguments{ \item{x, y, z, m}{Coordinate values.} \item{crs}{A value to be propagated as the CRS for this vector.} \item{...}{Passed to methods.} \item{dims}{A set containing one or more of \code{c("x", "y", "z", "m")}.} } \value{ A vector of coordinate values. } \description{ Efficient point vectors } \examples{ xy(1:5, 1:5) xyz(1:5, 1:5, 10) xym(1:5, 1:5, 10) xyzm(1:5, 1:5, 10, 12) } wk/man/wk_void.Rd0000644000176200001440000000176714106220314013403 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/void.R \name{wk_void} \alias{wk_void} \alias{wk_void_handler} \title{Do nothing} \usage{ wk_void(handleable, ...) wk_void_handler() } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ \code{NULL} } \description{ This handler does nothing and returns \code{NULL}. It is useful for benchmarking readers and handlers and when using filters that have side-effects (e.g., \code{\link[=wk_debug]{wk_debug()}}). Note that this handler stops on the first parse error; to see a list of parse errors see the \code{\link[=wk_problems]{wk_problems()}} handler. } \examples{ wk_void(wkt("POINT (1 4)")) wk_handle(wkt("POINT (1 4)"), wk_void_handler()) } wk/man/wk_linestring.Rd0000644000176200001440000000360714163110540014615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make.R \name{wk_linestring} \alias{wk_linestring} \alias{wk_polygon} \alias{wk_collection} \alias{wk_linestring_filter} \alias{wk_polygon_filter} \alias{wk_collection_filter} \title{Create lines, polygons, and collections} \usage{ wk_linestring(handleable, feature_id = 1L, ..., geodesic = NULL) wk_polygon(handleable, feature_id = 1L, ring_id = 1L, ..., geodesic = NULL) wk_collection( handleable, geometry_type = wk_geometry_type("geometrycollection"), feature_id = 1L, ... ) wk_linestring_filter(handler, feature_id = 1L) wk_polygon_filter(handler, feature_id = 1L, ring_id = 1L) wk_collection_filter( handler, geometry_type = wk_geometry_type("geometrycollection"), feature_id = 1L ) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{feature_id}{An identifier where changes in sequential values indicate a new feature. This is recycled silently as needed.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{geodesic}{Use \code{TRUE} or \code{FALSE} to explicitly force the geodesic-ness of the output.} \item{ring_id}{An identifier where changes in sequential values indicate a new ring. Rings are automatically closed. This is recycled silently as needed.} \item{geometry_type}{The collection type to create.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} } \value{ An object of the same class as \code{handleable} with whose coordinates have been assembled into the given type. } \description{ Create lines, polygons, and collections } \examples{ wk_linestring(xy(c(1, 1), c(2, 3))) wk_polygon(xy(c(0, 1, 0), c(0, 0, 1))) wk_collection(xy(c(1, 1), c(2, 3))) } wk/man/wk_count.Rd0000644000176200001440000000246314106220314013564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/count.R \name{wk_count} \alias{wk_count} \alias{wk_count.default} \alias{wk_count_handler} \title{Count geometry components} \usage{ wk_count(handleable, ...) \method{wk_count}{default}(handleable, ...) wk_count_handler() } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ A data.frame with one row for every feature encountered and columns: \itemize{ \item \code{n_geom}: The number of geometries encountered, including the root geometry. Will be zero for a null feature. \item \code{n_ring}: The number of rings encountered. Will be zero for a null feature. \item \code{n_coord}: The number of coordinates encountered. Will be zero for a null feature. } } \description{ Counts the number of geometries, rings, and coordinates found within each feature. As opposed to \code{\link[=wk_meta]{wk_meta()}}, this handler will iterate over the entire geometry. } \examples{ wk_count(as_wkt("LINESTRING (0 0, 1 1)")) wk_count(as_wkb("LINESTRING (0 0, 1 1)")) } wk/man/new_wk_rct.Rd0000644000176200001440000000066214163110540014076 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rct.R \name{new_wk_rct} \alias{new_wk_rct} \title{S3 details for rct objects} \usage{ new_wk_rct( x = list(xmin = double(), ymin = double(), xmax = double(), ymax = double()), crs = NULL ) } \arguments{ \item{x}{A \code{\link[=rct]{rct()}}} \item{crs}{A value to be propagated as the CRS for this vector.} } \description{ S3 details for rct objects } wk/man/wk_debug.Rd0000644000176200001440000000153514106220314013521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/debug.R \name{wk_debug} \alias{wk_debug} \alias{wk_debug_filter} \title{Debug filters and handlers} \usage{ wk_debug(handleable, handler = wk_void_handler(), ...) wk_debug_filter(handler = wk_void_handler()) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ The result of the \code{handler}. } \description{ Debug filters and handlers } \examples{ wk_debug(wkt("POINT (1 1)")) wk_handle(wkt("POINT (1 1)"), wk_debug_filter()) } wk/man/wk_chunk_map_feature.Rd0000644000176200001440000000475414145575672016150 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/chunk.R \name{wk_chunk_map_feature} \alias{wk_chunk_map_feature} \title{Operate on handleables by chunk} \usage{ wk_chunk_map_feature( handleables, fun, vector_args = NULL, args = NULL, input_handler_factory = wk_writer, output_template = NULL, strategy = wk_chunk_strategy_feature(chunk_size = 10000) ) } \arguments{ \item{handleables}{A single handleable or a \code{list()} of handleables recycleable along a common length.} \item{fun}{A function called like \code{fun(!!! transformed_handleables, !!! vector_args, !!! args)} for each chunk. For \code{\link[=wk_chunk_map_feature]{wk_chunk_map_feature()}} this must be length-stable (i.e., return a value whose size is the recycled length of handleables and vector_args for that chunk).} \item{vector_args}{Vectorized arguments to \code{fun}.} \item{args}{Non-vectorized arguments to \code{fun}.} \item{input_handler_factory}{A function of \code{handleable} applied to handleable inputs. The default, \code{\link[=wk_writer]{wk_writer()}}, will result in \code{fun} getting called with a clone of the handleables for each chunk. Another useful pattern is to return a single type of handler so that all \code{handleables} have a common type.} \item{output_template}{A vector whose subset-assign method will get called for every chunk or \code{NULL} to ignore the output of \code{fun}.} \item{strategy}{A function of \code{handleables} and \code{n_features} such as that returned by \code{\link[=wk_chunk_strategy_feature]{wk_chunk_strategy_feature()}}.} } \value{ \code{output_template} of the recycled common length of \code{handleables} and \code{vector_args} filled with values generated by \code{fun}. } \description{ It is often impractical, inefficient, or impossible to perform an operation on a vector of geometries with all the geometries loaded into memory at the same time. These functions generalize the pattern of split-apply-combine to one or more handlers recycled along a common length. These functions are designed for developers rather than users and should be considered experimental. } \examples{ # apply a transformation or calculate a value using the data frame version # of the geometries (but without resolving all of them at once) wk_chunk_map_feature( wk_linestring(xy(1:10, 1:10), rep(1:5, each = 2)), function(features) { coords <- wk_coords(features) vapply(split(coords, coords$feature_id), nrow, integer(1)) }, output_template = integer() ) } wk/man/wk_crs_proj_definition.Rd0000644000176200001440000000323314153402075016471 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wk-crs.R \name{wk_crs_proj_definition} \alias{wk_crs_proj_definition} \alias{wk_crs_proj_definition.NULL} \alias{wk_crs_proj_definition.character} \alias{wk_crs_proj_definition.double} \alias{wk_crs_proj_definition.integer} \title{CRS object generic methods} \usage{ wk_crs_proj_definition(crs, proj_version = NULL, verbose = FALSE) \method{wk_crs_proj_definition}{`NULL`}(crs, proj_version = NULL, verbose = FALSE) \method{wk_crs_proj_definition}{character}(crs, proj_version = NULL, verbose = FALSE) \method{wk_crs_proj_definition}{double}(crs, proj_version = NULL, verbose = FALSE) \method{wk_crs_proj_definition}{integer}(crs, proj_version = NULL, verbose = FALSE) } \arguments{ \item{crs}{An arbitrary R object} \item{proj_version}{A \code{\link[=package_version]{package_version()}} of the PROJ version, or \code{NULL} if the PROJ version is unknown.} \item{verbose}{Use \code{TRUE} to request a more verbose version of the PROJ definition (e.g., WKT2). The default of \code{FALSE} should return the most compact version that completely describes the CRS. An authority:code string (e.g., "OGC:CRS84") is the recommended way to represent a CRS when \code{verbose} is \code{FALSE}, if possible, falling back to the most recent version of WKT2.} } \value{ \itemize{ \item \code{wk_crs_proj_definition()} Returns a string used to represent the CRS in PROJ. For recent PROJ version you'll want to return WKT2; however you should check \code{proj_version} if you want this to work with older versions of PROJ. } } \description{ CRS object generic methods } \examples{ wk_crs_proj_definition("EPSG:4326") } wk/man/wk_writer.Rd0000644000176200001440000000425514155244415013765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pkg-sf.R, R/sfc-writer.R, R/wkb-writer.R, % R/wkt-writer.R, R/writer.R, R/xy-writer.R \name{wk_writer.sfc} \alias{wk_writer.sfc} \alias{wk_writer.sf} \alias{sfc_writer} \alias{wkb_writer} \alias{wkt_writer} \alias{wk_writer} \alias{wk_writer.default} \alias{wk_writer.wk_wkt} \alias{wk_writer.wk_wkb} \alias{wk_writer.wk_xy} \alias{xy_writer} \title{Write geometry vectors} \usage{ \method{wk_writer}{sfc}(handleable, ...) \method{wk_writer}{sf}(handleable, ...) sfc_writer() wkb_writer(buffer_size = 2048L, endian = NA_integer_) wkt_writer(precision = 16L, trim = TRUE) wk_writer(handleable, ..., generic = FALSE) \method{wk_writer}{default}(handleable, ...) \method{wk_writer}{wk_wkt}(handleable, ..., precision = 16, trim = TRUE) \method{wk_writer}{wk_wkb}(handleable, ...) \method{wk_writer}{wk_xy}(handleable, ..., generic = FALSE) xy_writer() } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the writer constructor.} \item{buffer_size}{Control the initial buffer size used when writing WKB.} \item{endian}{Use 1 for little endian, 0 for big endian, or NA for system endian.} \item{precision}{If \code{trim} is \code{TRUE}, the total number of significant digits to keep for each result or the number of digits after the decimal place otherwise.} \item{trim}{Use \code{FALSE} to keep trailing zeroes after the decimal place.} \item{generic}{Use \code{TRUE} to obtain a writer that can write all geometry types.} } \value{ A \link[=wk_handle]{wk_handler}. } \description{ When writing transformation functions, it is often useful to know which handler should be used to create a (potentially modified) version of an object. Some transformers (e.g., \code{\link[=wk_vertices]{wk_vertices()}}) modify the geometry type of an object, in which case a generic writer is needed. This defaults to \code{\link[=wkb_writer]{wkb_writer()}} because it is fast and can handle all geometry types. } wk/man/wk_crs_equal.Rd0000644000176200001440000000154214106220314014407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wk-crs.R \name{wk_crs_equal} \alias{wk_crs_equal} \alias{wk_crs_equal_generic} \title{Compare CRS objects} \usage{ wk_crs_equal(x, y) wk_crs_equal_generic(x, y, ...) } \arguments{ \item{x, y}{Objects stored in the \code{crs} attribute of a vector.} \item{...}{Unused} } \value{ \code{TRUE} if \code{x} and \code{y} can be considered equal, \code{FALSE} otherwise. } \description{ The \code{\link[=wk_crs_equal]{wk_crs_equal()}} function uses special S3 dispatch on \code{\link[=wk_crs_equal_generic]{wk_crs_equal_generic()}} to evaluate whether or not two CRS values can be considered equal. When implementing \code{\link[=wk_crs_equal_generic]{wk_crs_equal_generic()}}, every attempt should be made to make \code{wk_crs_equal(x, y)} and \code{wk_crs_equal(y, x)} return identically. } wk/man/vctrs-methods.Rd0000644000176200001440000000227314155244415014550 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pkg-vctrs.R \name{vctrs-methods} \alias{vctrs-methods} \alias{vec_cast.wk_wkb} \alias{vec_ptype2.wk_wkb} \alias{vec_cast.wk_wkt} \alias{vec_ptype2.wk_wkt} \alias{vec_cast.wk_xy} \alias{vec_ptype2.wk_xy} \alias{vec_cast.wk_xyz} \alias{vec_ptype2.wk_xyz} \alias{vec_cast.wk_xym} \alias{vec_ptype2.wk_xym} \alias{vec_cast.wk_xyzm} \alias{vec_ptype2.wk_xyzm} \alias{vec_cast.wk_rct} \alias{vec_ptype2.wk_rct} \alias{vec_cast.wk_crc} \alias{vec_ptype2.wk_crc} \title{Vctrs methods} \usage{ vec_cast.wk_wkb(x, to, ...) vec_ptype2.wk_wkb(x, y, ...) vec_cast.wk_wkt(x, to, ...) vec_ptype2.wk_wkt(x, y, ...) vec_cast.wk_xy(x, to, ...) vec_ptype2.wk_xy(x, y, ...) vec_cast.wk_xyz(x, to, ...) vec_ptype2.wk_xyz(x, y, ...) vec_cast.wk_xym(x, to, ...) vec_ptype2.wk_xym(x, y, ...) vec_cast.wk_xyzm(x, to, ...) vec_ptype2.wk_xyzm(x, y, ...) vec_cast.wk_rct(x, to, ...) vec_ptype2.wk_rct(x, y, ...) vec_cast.wk_crc(x, to, ...) vec_ptype2.wk_crc(x, y, ...) } \arguments{ \item{x, y, to, ...}{See \code{\link[vctrs:vec_cast]{vctrs::vec_cast()}} and \code{\link[vctrs:vec_ptype2]{vctrs::vec_ptype2()}}.} } \description{ Vctrs methods } wk/man/wk_format.Rd0000644000176200001440000000307714106220314013726 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/format.R \name{wk_format} \alias{wk_format} \alias{wkt_format_handler} \title{Format well-known geometry for printing} \usage{ wk_format(handleable, precision = 7, trim = TRUE, max_coords = 6, ...) wkt_format_handler(precision = 7, trim = TRUE, max_coords = 6) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{precision}{If \code{trim} is \code{TRUE}, the total number of significant digits to keep for each result or the number of digits after the decimal place otherwise.} \item{trim}{Use \code{FALSE} to keep trailing zeroes after the decimal place.} \item{max_coords}{The maximum number of coordinates to include in the output.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ A character vector of abbreviated well-known text. } \description{ Provides an abbreviated version of the well-known text representation of a geometry. This returns a constant number of coordinates for each geometry, so is safe to use for geometry vectors with many (potentially large) features. Parse errors are passed on to the format string and do not cause this handler to error. } \examples{ wk_format(wkt("MULTIPOLYGON (((0 0, 10 0, 0 10, 0 0)))")) wk_format(new_wk_wkt("POINT ENTPY")) wk_handle( wkt("MULTIPOLYGON (((0 0, 10 0, 0 10, 0 0)))"), wkt_format_handler() ) } wk/man/wk_identity.Rd0000644000176200001440000000173514106220314014266 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/filter.R \name{wk_identity} \alias{wk_identity} \alias{wk_identity_filter} \alias{wk_restore} \alias{wk_restore.default} \title{Copy a geometry vector} \usage{ wk_identity(handleable, ...) wk_identity_filter(handler) wk_restore(handleable, result, ...) \method{wk_restore}{default}(handleable, result, ...) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{result}{The result of a filter operation intended to be a transformation.} } \value{ A copy of \code{handleable}. } \description{ Copy a geometry vector } \examples{ wk_identity(wkt("POINT (1 2)")) } wk/man/new_wk_xy.Rd0000644000176200001440000000155114106220314013742 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/xyzm.R \name{new_wk_xy} \alias{new_wk_xy} \alias{new_wk_xyz} \alias{new_wk_xym} \alias{new_wk_xyzm} \alias{validate_wk_xy} \alias{validate_wk_xyz} \alias{validate_wk_xym} \alias{validate_wk_xyzm} \title{S3 details for xy objects} \usage{ new_wk_xy(x = list(x = double(), y = double()), crs = NULL) new_wk_xyz(x = list(x = double(), y = double(), z = double()), crs = NULL) new_wk_xym(x = list(x = double(), y = double(), m = double()), crs = NULL) new_wk_xyzm( x = list(x = double(), y = double(), z = double(), m = double()), crs = NULL ) validate_wk_xy(x) validate_wk_xyz(x) validate_wk_xym(x) validate_wk_xyzm(x) } \arguments{ \item{x}{A \code{\link[=xy]{xy()}} object.} \item{crs}{A value to be propagated as the CRS for this vector.} } \description{ S3 details for xy objects } wk/man/wk_set_z.Rd0000644000176200001440000000272714106220314013563 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/set.R \name{wk_set_z} \alias{wk_set_z} \alias{wk_set_m} \alias{wk_drop_z} \alias{wk_drop_m} \alias{wk_trans_set} \title{Set coordinate values} \usage{ wk_set_z(handleable, z, ...) wk_set_m(handleable, m, ...) wk_drop_z(handleable, ...) wk_drop_m(handleable, ...) wk_trans_set(value, use_z = NA, use_m = NA) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{z, m}{A vector of Z or M values applied feature-wise and recycled along \code{handleable}. Use \code{NA} to keep the existing value of a given feature.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{value}{An \code{\link[=xy]{xy()}}, \code{\link[=xyz]{xyz()}}, \code{\link[=xym]{xym()}}, or \code{\link[=xyzm]{xyzm()}} of coordinates used to replace values in the input. Use \code{NA} to keep the existing value.} \item{use_z, use_m}{Used to declare the output type. Use \code{TRUE} to ensure the output has that dimension, \code{FALSE} to ensure it does not, and \code{NA} to leave the dimension unchanged.} } \description{ Set coordinate values } \examples{ wk_set_z(wkt("POINT (0 1)"), 2) wk_set_m(wkt("POINT (0 1)"), 2) wk_drop_z(wkt("POINT ZM (0 1 2 3)")) wk_drop_m(wkt("POINT ZM (0 1 2 3)")) } wk/man/handle_wkt_without_vector_size.Rd0000644000176200001440000000136214160220603020250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handle-wkt.R \name{handle_wkt_without_vector_size} \alias{handle_wkt_without_vector_size} \title{Test handlers for handling of unknown size vectors} \usage{ handle_wkt_without_vector_size(handleable, handler) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} } \description{ Test handlers for handling of unknown size vectors } \examples{ handle_wkt_without_vector_size(wkt(), wk_vector_meta_handler()) } wk/man/wk_flatten.Rd0000644000176200001440000000235614106220314014072 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flatten.R \name{wk_flatten} \alias{wk_flatten} \alias{wk_flatten_filter} \title{Extract simple geometries} \usage{ wk_flatten(handleable, ..., max_depth = 1) wk_flatten_filter(handler, max_depth = 1L, add_details = FALSE) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{max_depth}{The maximum (outer) depth to remove.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{add_details}{Use \code{TRUE} to add a "wk_details" attribute, which contains columns \code{feature_id}, \code{part_id}, and \code{ring_id}.} } \value{ \code{handleable} transformed such that collections have been expanded and only simple geometries (point, linestring, polygon) remain. } \description{ Extract simple geometries } \examples{ wk_flatten(wkt("MULTIPOINT (1 1, 2 2, 3 3)")) wk_flatten( wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))"), max_depth = 2 ) } wk/man/deprecated.Rd0000644000176200001440000000202614163201750014034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprecated.R \name{wkb_translate_wkt} \alias{wkb_translate_wkt} \alias{wkb_translate_wkb} \alias{wkt_translate_wkt} \alias{wkt_translate_wkb} \title{Deprecated functions} \usage{ wkb_translate_wkt(wkb, ..., precision = 16, trim = TRUE) wkb_translate_wkb(wkb, ..., endian = NA_integer_) wkt_translate_wkt(wkt, ..., precision = 16, trim = TRUE) wkt_translate_wkb(wkt, ..., endian = NA_integer_) } \arguments{ \item{wkb}{A \code{list()} of \code{\link[=raw]{raw()}} vectors, such as that returned by \code{sf::st_as_binary()}.} \item{...}{Used to keep backward compatibility with previous versions of these functions.} \item{precision}{The rounding precision to use when writing (number of decimal places).} \item{trim}{Trim unnecessary zeroes in the output?} \item{endian}{Force the endian of the resulting WKB.} \item{wkt}{A character vector containing well-known text.} } \description{ These functions are deprecated and will be removed in a future version. } wk/man/new_wk_wkb.Rd0000644000176200001440000000112014153402075014065 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wkb.R \name{new_wk_wkb} \alias{new_wk_wkb} \alias{validate_wk_wkb} \alias{is_wk_wkb} \title{S3 Details for wk_wkb} \usage{ new_wk_wkb(x = list(), crs = NULL, geodesic = NULL) validate_wk_wkb(x) is_wk_wkb(x) } \arguments{ \item{x}{A (possibly) \code{\link[=wkb]{wkb()}} vector} \item{crs}{A value to be propagated as the CRS for this vector.} \item{geodesic}{\code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise.} } \description{ S3 Details for wk_wkb } wk/man/wk_translate.Rd0000644000176200001440000000143114155244415014437 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pkg-sf.R, R/translate.R \name{wk_translate.sfc} \alias{wk_translate.sfc} \alias{wk_translate} \alias{wk_translate.default} \title{Translate geometry vectors} \usage{ \method{wk_translate}{sfc}(handleable, to, ...) wk_translate(handleable, to, ...) \method{wk_translate}{default}(handleable, to, ...) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{to}{A prototype object.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \description{ Translate geometry vectors } wk/man/wk_handle.Rd0000644000176200001440000000551614156165566013717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handle-crc.R, R/handle-rct.R, R/handle-sfc.R, % R/handle-wkb.R, R/handle-wkt.R, R/handle-xy.R, R/handler.R, R/pkg-sf.R \name{wk_handle.wk_crc} \alias{wk_handle.wk_crc} \alias{wk_handle.wk_rct} \alias{wk_handle.sfc} \alias{wk_handle.wk_wkb} \alias{wk_handle.wk_wkt} \alias{wk_handle.wk_xy} \alias{wk_handle} \alias{is_handleable} \alias{new_wk_handler} \alias{is_wk_handler} \alias{as_wk_handler} \alias{wk_handle.sfg} \alias{wk_handle.sf} \alias{wk_handle.bbox} \title{Read geometry vectors} \usage{ \method{wk_handle}{wk_crc}( handleable, handler, ..., n_segments = getOption("wk.crc_n_segments", NULL), resolution = getOption("wk.crc_resolution", NULL) ) \method{wk_handle}{wk_rct}(handleable, handler, ...) \method{wk_handle}{sfc}(handleable, handler, ...) \method{wk_handle}{wk_wkb}(handleable, handler, ...) \method{wk_handle}{wk_wkt}(handleable, handler, ...) \method{wk_handle}{wk_xy}(handleable, handler, ...) wk_handle(handleable, handler, ...) is_handleable(handleable) new_wk_handler(handler_ptr, subclass = character()) is_wk_handler(handler) as_wk_handler(handler, ...) \method{wk_handle}{sfg}(handleable, handler, ...) \method{wk_handle}{sf}(handleable, handler, ...) \method{wk_handle}{bbox}(handleable, handler, ...) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{n_segments, resolution}{The number of segments to use when approximating a circle. The default uses \code{getOption("wk.crc_n_segments")} so that this value can be set for implicit conversions (e.g., \code{as_wkb()}). Alternatively, set the minimum distance between points on the circle (used to estimate \code{n_segments}). The default is obtained using \code{getOption("wk.crc_resolution")}.} \item{handler_ptr}{An external pointer to a newly created WK handler} \item{subclass}{The handler subclass} } \value{ A WK handler. } \description{ The handler is the basic building block of the wk package. In particular, the \code{\link[=wk_handle]{wk_handle()}} generic allows operations written as handlers to "just work" with many different input types. The wk package provides the \code{\link[=wk_void]{wk_void()}} handler, the \code{\link[=wk_format]{wk_format()}} handler, the \code{\link[=wk_debug]{wk_debug()}} handler, the \code{\link[=wk_problems]{wk_problems()}} handler, and \code{\link[=wk_writer]{wk_writer()}}s for \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, and \code{\link[sf:sfc]{sf::st_sfc()}}) vectors. } wk/man/wkb.Rd0000644000176200001440000000230014161345517012522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wkb.R \name{wkb} \alias{wkb} \alias{parse_wkb} \alias{wk_platform_endian} \alias{as_wkb} \alias{as_wkb.default} \alias{as_wkb.character} \alias{as_wkb.wk_wkb} \alias{as_wkb.blob} \alias{as_wkb.WKB} \title{Mark lists of raw vectors as well-known binary} \usage{ wkb(x = list(), crs = wk_crs_auto(), geodesic = FALSE) parse_wkb(x, crs = wk_crs_auto(), geodesic = FALSE) wk_platform_endian() as_wkb(x, ...) \method{as_wkb}{default}(x, ...) \method{as_wkb}{character}(x, ..., crs = NULL, geodesic = FALSE) \method{as_wkb}{wk_wkb}(x, ...) \method{as_wkb}{blob}(x, ..., crs = NULL, geodesic = FALSE) \method{as_wkb}{WKB}(x, ..., crs = NULL, geodesic = FALSE) } \arguments{ \item{x}{A \code{\link[=list]{list()}} of \code{\link[=raw]{raw()}} vectors or \code{NULL}.} \item{crs}{A value to be propagated as the CRS for this vector.} \item{geodesic}{\code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise.} \item{...}{Unused} } \value{ A \code{\link[=new_wk_wkb]{new_wk_wkb()}} } \description{ Mark lists of raw vectors as well-known binary } \examples{ as_wkb("POINT (20 10)") } wk/man/rct.Rd0000644000176200001440000000153014163110540012517 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rct.R \name{rct} \alias{rct} \alias{as_rct} \alias{as_rct.wk_rct} \alias{as_rct.matrix} \alias{as_rct.data.frame} \title{2D rectangle vectors} \usage{ rct( xmin = double(), ymin = double(), xmax = double(), ymax = double(), crs = wk_crs_auto() ) as_rct(x, ...) \method{as_rct}{wk_rct}(x, ...) \method{as_rct}{matrix}(x, ..., crs = NULL) \method{as_rct}{data.frame}(x, ..., crs = NULL) } \arguments{ \item{xmin, ymin, xmax, ymax}{Rectangle bounds.} \item{crs}{A value to be propagated as the CRS for this vector.} \item{x}{An object to be converted to a \code{\link[=rct]{rct()}}.} \item{...}{Extra arguments passed to \code{as_rct()}.} } \value{ A vector along the recycled length of bounds. } \description{ 2D rectangle vectors } \examples{ rct(1, 2, 3, 4) } wk/man/wk_handle.data.frame.Rd0000644000176200001440000000410014163110540015660 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class-data-frame.R, R/pkg-sf.R \name{wk_handle.data.frame} \alias{wk_handle.data.frame} \alias{wk_writer.data.frame} \alias{wk_crs.data.frame} \alias{wk_set_crs.data.frame} \alias{wk_is_geodesic.data.frame} \alias{wk_set_geodesic.data.frame} \alias{wk_restore.data.frame} \alias{wk_restore.tbl_df} \alias{wk_translate.data.frame} \alias{wk_translate.tbl_df} \alias{wk_translate.sf} \alias{wk_restore.sf} \title{Use data.frame with wk} \usage{ \method{wk_handle}{data.frame}(handleable, handler, ...) \method{wk_writer}{data.frame}(handleable, ...) \method{wk_crs}{data.frame}(x) \method{wk_set_crs}{data.frame}(x, crs) \method{wk_is_geodesic}{data.frame}(x) \method{wk_set_geodesic}{data.frame}(x, geodesic) \method{wk_restore}{data.frame}(handleable, result, ...) \method{wk_restore}{tbl_df}(handleable, result, ...) \method{wk_translate}{data.frame}(handleable, to, ...) \method{wk_translate}{tbl_df}(handleable, to, ...) \method{wk_translate}{sf}(handleable, to, ...) \method{wk_restore}{sf}(handleable, result, ...) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{x}{Objects whose "crs" attribute is used to carry a CRS.} \item{crs}{An object that can be interpreted as a CRS} \item{geodesic}{\code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise.} \item{result}{The result of a filter operation intended to be a transformation.} \item{to}{A prototype object.} } \description{ Use data.frame with wk } \examples{ wk_handle(data.frame(a = wkt("POINT (0 1)")), wkb_writer()) wk_translate(wkt("POINT (0 1)"), data.frame(col_name = wkb())) wk_translate(data.frame(a = wkt("POINT (0 1)")), data.frame(wkb())) } wk/man/wk_meta.Rd0000644000176200001440000000537214106220314013364 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/meta.R \name{wk_meta} \alias{wk_meta} \alias{wk_meta.default} \alias{wk_vector_meta} \alias{wk_vector_meta.default} \alias{wk_meta_handler} \alias{wk_vector_meta_handler} \alias{wk_geometry_type_label} \alias{wk_geometry_type} \title{Extract feature-level meta} \usage{ wk_meta(handleable, ...) \method{wk_meta}{default}(handleable, ...) wk_vector_meta(handleable, ...) \method{wk_vector_meta}{default}(handleable, ...) wk_meta_handler() wk_vector_meta_handler() wk_geometry_type_label(geometry_type) wk_geometry_type(geometry_type_label) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} \item{geometry_type}{An integer code for the geometry type. These integers follow the WKB specification (e.g., 1 for point, 7 for geometrycollection).} \item{geometry_type_label}{A character vector of (lowercase) geometry type labels as would be found in WKT (e.g., point, geometrycollection).} } \value{ A data.frame with columns: \itemize{ \item \code{geometry_type}: An integer identifying the geometry type. A value of 0 indicates that the types of geometry in the vector are not known without parsing the entire vector. \item \code{size}: For points and linestrings, the number of coordinates; for polygons, the number of rings; for collections, the number of child geometries. A value of zero indicates an EMPTY geometry. A value of \code{NA} means this value is unknown without parsing the entire geometry. \item \code{has_z}: \code{TRUE} if coordinates contain a Z value. A value of \code{NA} means this value is unknown without parsing the entire vector. \item \code{has_m}: \code{TRUE} if coordinates contain an M value. A value of \code{NA} means this value is unknown without parsing the entire vector. \item \code{srid}: An integer identifying a CRS or NA if this value was not provided. \item \code{precision}: A grid size or 0.0 if a grid size was not provided. Note that coordinate values may not have been rounded; the grid size only refers to the level of detail with which they should be interpreted. } } \description{ These functions return the non-coordinate information of a geometry and/or vector. They do not parse an entire geometry/vector and are intended to be very fast even for large vectors. } \examples{ wk_vector_meta(as_wkt("LINESTRING (0 0, 1 1)")) wk_meta(as_wkt("LINESTRING (0 0, 1 1)")) wk_meta(as_wkb("LINESTRING (0 0, 1 1)")) wk_geometry_type_label(1:7) wk_geometry_type(c("point", "geometrycollection")) } wk/man/wk_handle_slice.Rd0000644000176200001440000000254514145575672015076 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class-data-frame.R, R/handle-slice.R \name{wk_handle_slice.data.frame} \alias{wk_handle_slice.data.frame} \alias{wk_handle_slice} \alias{wk_handle_slice.default} \title{Handle specific regions of objects} \usage{ \method{wk_handle_slice}{data.frame}(handleable, handler, from = NULL, to = NULL, ...) wk_handle_slice( handleable, handler = wk_writer(handleable), from = NULL, to = NULL, ... ) \method{wk_handle_slice}{default}( handleable, handler = wk_writer(handleable), from = NULL, to = NULL, ... ) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{handler}{A \link[=wk_handle]{wk_handler} object.} \item{from}{1-based index of the feature to start from} \item{to}{1-based index of the feature to end at} \item{...}{Passed to the \code{\link[=wk_handle]{wk_handle()}} method.} } \value{ A subset of \code{handleable} } \description{ Handle specific regions of objects } \examples{ wk_handle_slice(xy(1:5, 1:5), wkt_writer(), from = 3, to = 5) wk_handle_slice( data.frame(let = letters[1:5], geom = xy(1:5, 1:5)), wkt_writer(), from = 3, to = 5 ) } wk/man/new_wk_wkt.Rd0000644000176200001440000000112514153402075014114 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wkt.R \name{new_wk_wkt} \alias{new_wk_wkt} \alias{is_wk_wkt} \alias{validate_wk_wkt} \title{S3 Details for wk_wkt} \usage{ new_wk_wkt(x = character(), crs = NULL, geodesic = NULL) is_wk_wkt(x) validate_wk_wkt(x) } \arguments{ \item{x}{A (possibly) \code{\link[=wkt]{wkt()}} vector} \item{crs}{A value to be propagated as the CRS for this vector.} \item{geodesic}{\code{TRUE} if edges must be interpolated as geodesics when coordinates are spherical, \code{FALSE} otherwise.} } \description{ S3 Details for wk_wkt } wk/man/wk_plot.Rd0000644000176200001440000000435614163210157013424 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{wk_plot} \alias{wk_plot} \alias{wk_plot.default} \alias{plot.wk_wkt} \alias{plot.wk_wkb} \alias{plot.wk_xy} \alias{plot.wk_rct} \alias{plot.wk_crc} \title{Plot well-known geometry vectors} \usage{ wk_plot( handleable, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE ) \method{wk_plot}{default}( handleable, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE ) \method{plot}{wk_wkt}( x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE ) \method{plot}{wk_wkb}( x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE ) \method{plot}{wk_xy}(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", add = FALSE) \method{plot}{wk_rct}(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", add = FALSE) \method{plot}{wk_crc}(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", add = FALSE) } \arguments{ \item{handleable}{A geometry vector (e.g., \code{\link[=wkb]{wkb()}}, \code{\link[=wkt]{wkt()}}, \code{\link[=xy]{xy()}}, \code{\link[=rct]{rct()}}, or \code{\link[sf:sfc]{sf::st_sfc()}}) for which \code{\link[=wk_handle]{wk_handle()}} is defined.} \item{...}{Passed to plotting functions for features: \code{\link[graphics:points]{graphics::points()}} for point and multipoint geometries, \code{\link[graphics:lines]{graphics::lines()}} for linestring and multilinestring geometries, and \code{\link[graphics:polypath]{graphics::polypath()}} for polygon and multipolygon geometries.} \item{asp, xlab, ylab}{Passed to \code{\link[graphics:plot.default]{graphics::plot()}}} \item{bbox}{The limits of the plot as a \code{\link[=rct]{rct()}} or compatible object} \item{rule}{The rule to use for filling polygons (see \code{\link[graphics:polypath]{graphics::polypath()}})} \item{add}{Should a new plot be created, or should \code{handleable} be added to the existing plot?} \item{x}{A \code{\link[=wkb]{wkb()}} or \code{\link[=wkt]{wkt()}}} } \value{ The input, invisibly. } \description{ Plot well-known geometry vectors } \examples{ plot(as_wkt("LINESTRING (0 0, 1 1)")) plot(as_wkb("LINESTRING (0 0, 1 1)")) } wk/DESCRIPTION0000644000176200001440000000310114164574002012377 0ustar liggesusersPackage: wk Title: Lightweight Well-Known Geometry Parsing Version: 0.6.0 Authors@R: c( person(given = "Dewey", family = "Dunnington", role = c("aut", "cre"), email = "dewey@fishandwhistle.net", comment = c(ORCID = "0000-0002-9415-4582")), person(given = "Edzer", family = "Pebesma", role = c("aut"), email = "edzer.pebesma@uni-muenster.de", comment = c(ORCID = "0000-0001-8049-7069")) ) 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. Well-known binary is compact and fast to parse; well-known text is human-readable and is useful for writing tests. These formats are only useful in R 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 RoxygenNote: 7.1.2 SystemRequirements: C++11 Suggests: testthat (>= 3.0.0), vctrs (>= 0.3.0), sf, tibble, readr URL: https://paleolimbot.github.io/wk/, https://github.com/paleolimbot/wk BugReports: https://github.com/paleolimbot/wk/issues Config/testthat/edition: 3 NeedsCompilation: yes Packaged: 2022-01-03 12:29:10 UTC; deweydunnington Author: Dewey Dunnington [aut, cre] (), Edzer Pebesma [aut] () Repository: CRAN Date/Publication: 2022-01-03 13:20:02 UTC wk/tests/0000755000176200001440000000000014106220314012026 5ustar liggesuserswk/tests/testthat/0000755000176200001440000000000014164574002013700 5ustar liggesuserswk/tests/testthat/test-bbox.R0000644000176200001440000000514114163110540015723 0ustar liggesusers test_that("wk_bbox() works", { expect_identical( wk_bbox(wkt("LINESTRING (1 2, 3 4)")), rct(1, 2, 3, 4) ) expect_identical( wk_bbox(wkt(crs = NULL)), rct(Inf, Inf, -Inf, -Inf) ) expect_identical( wk_bbox(wkt(crs = 1234)), rct(Inf, Inf, -Inf, -Inf, crs = 1234) ) }) test_that("wk_bbox() works when vector has cached bbox", { skip_if_not_installed("sf") sf_linestring <- sf::st_sfc(sf::st_linestring(rbind(c(1, 2), c(3, 4)))) expect_identical( wk_bbox(sf_linestring), rct(1, 2, 3, 4, crs = sf::NA_crs_) ) }) test_that("wk_bbox() works when geometry has cached bbox", { expect_identical(wk_bbox(xy(1:3, 2:4)), rct(1, 2, 3, 4)) expect_identical(wk_bbox(crc(2, 3, r = 1)), rct(1, 2, 3, 4)) expect_identical(wk_bbox(rct(1, 2, 3, 4)), rct(1, 2, 3, 4)) }) test_that("wk_envelope() works", { expect_identical( wk_envelope(wkt("LINESTRING (1 2, 3 4)")), rct(1, 2, 3, 4) ) expect_identical( wk_envelope(wkt(NA_character_)), rct(NA_real_, NA_real_, NA_real_, NA_real_) ) expect_identical( wk_envelope(wkt(crs = NULL)), rct(crs = NULL) ) expect_identical( wk_envelope(wkt(crs = 1234)), rct(crs = 1234) ) }) test_that("wk_envelope() works when geometry has cached bbox", { expect_identical( wk_handle(crc(2, 3, r = 1), wk_envelope_handler()), rct(1, 2, 3, 4) ) expect_identical( wk_handle(rct(1, 2, 3, 4), wk_envelope_handler()), rct(1, 2, 3, 4) ) }) test_that("wk_envelope() works when vector size is unknown", { expect_identical( handle_wkt_without_vector_size( wkt("POINT (0 1)"), wk_envelope_handler() ), rct(0, 1, 0, 1) ) expect_identical( handle_wkt_without_vector_size( wkt(rep("POINT (0 1)", 1025)), wk_envelope_handler() ), rep(rct(0, 1, 0, 1), 1025) ) }) test_that("wk_envelope() optimization works for xy()", { expect_identical( wk_envelope(xy(1, 2, crs = 1234)), rct(1, 2, 1, 2, crs = 1234) ) }) test_that("wk_envelope() optimization works for rct()", { expect_identical( wk_envelope(rct(1, 2, 3, 4, crs = 1234)), rct(1, 2, 3, 4, crs = 1234) ) }) test_that("wk_envelope() optimization works for crc()", { expect_identical( wk_envelope(crc(2, 3, r = 1, crs = 1234)), rct(1, 2, 3, 4, crs = 1234) ) }) test_that("wk_bbox() and wk_envelope() fail for geodesic objects", { expect_error( wk_bbox(wkt("LINESTRING (0 1)", geodesic = TRUE)), "Can't compute bbox for geodesic object" ) expect_error( wk_envelope(wkt("LINESTRING (0 1)", geodesic = TRUE)), "Can't compute envelope for geodesic object" ) }) wk/tests/testthat/test-vertex-filter.R0000644000176200001440000000712714106220314017575 0ustar liggesusers test_that("wk_vertices() works", { expect_identical( wk_vertices(wkt(c("POINT (0 0)", "POINT (1 1)", NA))), wkt(c("POINT (0 0)", "POINT (1 1)", NA)) ) expect_identical( wk_vertices(wkt(c("LINESTRING (0 0, 1 1)", NA))), wkt(c("POINT (0 0)", "POINT (1 1)", NA)) ) expect_error(wk_vertices(new_wk_wkt("POINT ENTPY")), "ENTPY") # we need this one to trigger a realloc on the details list xy_copy <- wk_handle( as_wkt(xy(1:1025, 1)), wk_vertex_filter(xy_writer(), add_details = TRUE) ) expect_identical( attr(xy_copy, "wk_details"), list(feature_id = 1:1025, part_id = 1:1025, ring_id = rep(0L, 1025)) ) attr(xy_copy, "wk_details") <- NULL expect_identical(xy_copy, xy(1:1025, 1)) }) test_that("wk_vertices() works for data.frame", { expect_identical( wk_vertices(data.frame(geom = wkt(c("POINT (0 0)", "POINT (1 1)")))), data.frame(geom = wkt(c("POINT (0 0)", "POINT (1 1)"))) ) }) test_that("wk_coords() works", { # point expect_identical( wk_coords(wkt("POINT (30 10)")), data.frame( feature_id = 1L, part_id = 1L, ring_id = 0L, x = 30, y = 10 ) ) # point zm expect_identical( wk_coords(wkt("POINT ZM (30 10 1 2)")), data.frame( feature_id = 1L, part_id = 1L, ring_id = 0L, x = 30, y = 10, z = 1, m = 2 ) ) # linestring expect_identical( wk_coords(wkt("LINESTRING (30 10, 20 11)")), data.frame( feature_id = c(1L, 1L), part_id = c(1L, 1L), ring_id = c(0L, 0L), x = c(30, 20), y = c(10, 11) ) ) # polygon expect_identical( wk_coords(wkt("POLYGON ((30 10, 20 11, 0 0, 30 10))")), data.frame( feature_id = c(1L, 1L, 1L, 1L), part_id = c(1L, 1L, 1L, 1L), ring_id = c(1L, 1L, 1L, 1L), x = c(30, 20, 0, 30), y = c(10, 11, 0, 10) ) ) # multipoint expect_identical( wk_coords(wkt("MULTIPOINT ((30 10), (20 11))")), data.frame( feature_id = c(1L, 1L), part_id = c(2L, 3L), ring_id = c(0L, 0L), x = c(30, 20), y = c(10, 11) ) ) # collection # point expect_identical( wk_coords(wkt("GEOMETRYCOLLECTION (POINT (30 10))")), data.frame( feature_id = 1L, part_id = 2L, ring_id = 0L, x = 30, y = 10 ) ) }) test_that("wk_vertices() communicates correct size and type", { expect_identical( wk_handle(wkt("POINT (0 0)"), wk_vertex_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = NA_real_, has_z = NA, has_m = NA) ) skip_if_not_installed("sf") # need sf because these objects carry vector-level types expect_identical( wk_handle(sf::st_as_sfc("POINT (0 0)"), wk_vertex_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = 1, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("MULTIPOINT EMPTY"), wk_vertex_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("MULTILINESTRING EMPTY"), wk_vertex_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("MULTIPOLYGON EMPTY"), wk_vertex_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("GEOMETRYCOLLECTION EMPTY"), wk_vertex_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) }) wk/tests/testthat/test-handle-wkb.R0000644000176200001440000004125714106220314017013 0ustar liggesusers 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)") }) wk/tests/testthat/test-pkg-vctrs.R0000644000176200001440000002610314163110540016712 0ustar liggesusers test_that("wk classes are vctrs", { expect_true(vctrs::vec_is(wkt())) expect_true(vctrs::vec_is(wkb())) expect_true(vctrs::vec_is(xy())) expect_true(vctrs::vec_is(xyz())) expect_true(vctrs::vec_is(xym())) expect_true(vctrs::vec_is(xyzm())) expect_true(vctrs::vec_is(rct())) expect_true(vctrs::vec_is(crc())) }) test_that("wk classes can be proxied and restored", { expect_identical(vctrs::vec_restore(vctrs::vec_proxy(wkt()), wkt()), wkt()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(wkb()), wkb()), wkb()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(xy()), xy()), xy()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(xyz()), xyz()), xyz()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(xym()), xym()), xym()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(xyzm()), xyzm()), xyzm()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(rct()), rct()), rct()) expect_identical(vctrs::vec_restore(vctrs::vec_proxy(crc()), crc()), crc()) }) test_that("vctrs wkb implementation works", { expect_true(vctrs::vec_is(wkb())) expect_identical(vctrs::vec_size(wkb()), 0L) expect_identical(vctrs::vec_cast(wkt(), wkb()), wkb()) expect_identical(vctrs::vec_cast(wkb(), wkb()), wkb()) expect_identical(vctrs::vec_cast(xy(), wkb()), wkb()) expect_identical(vctrs::vec_cast(xyz(), wkb()), wkb()) expect_identical(vctrs::vec_cast(xym(), wkb()), wkb()) expect_identical(vctrs::vec_cast(xyzm(), wkb()), wkb()) expect_identical(vctrs::vec_cast(rct(), wkb()), wkb()) expect_identical(vctrs::vec_proxy(wkb(crs = NULL)), list()) expect_identical(vctrs::vec_restore(list(), wkb()), wkb()) expect_identical(vctrs::vec_c(wkb(), wkb()), wkb()) expect_identical(vctrs::vec_c(wkb(), wkt()), wkt()) expect_identical(vctrs::vec_c(wkb(), xy()), wkb()) expect_identical(vctrs::vec_c(wkb(), xyz()), wkb()) expect_identical(vctrs::vec_c(wkb(), xym()), wkb()) expect_identical(vctrs::vec_c(wkb(), xyzm()), wkb()) expect_identical(vctrs::vec_c(wkb(), rct()), wkb()) expect_identical(vctrs::vec_c(wkb(), crc()), wkb()) }) test_that("vctrs wkt implementation works", { expect_true(vctrs::vec_is(wkt())) expect_identical(vctrs::vec_size(wkt()), 0L) expect_identical(vctrs::vec_cast(wkt(), wkt()), wkt()) expect_identical(vctrs::vec_cast(wkb(), wkt()), wkt()) expect_identical(vctrs::vec_cast(xy(), wkt()), wkt()) expect_identical(vctrs::vec_cast(xyz(), wkt()), wkt()) expect_identical(vctrs::vec_cast(xym(), wkt()), wkt()) expect_identical(vctrs::vec_cast(xyzm(), wkt()), wkt()) expect_identical(vctrs::vec_cast(rct(), wkt()), wkt()) expect_identical(vctrs::vec_proxy(wkt(crs = NULL)), character()) expect_identical(vctrs::vec_restore(character(), wkt()), wkt()) expect_identical(vctrs::vec_c(wkt(), wkt()), wkt()) expect_identical(vctrs::vec_c(wkt(), wkb()), wkt()) expect_identical(vctrs::vec_c(wkt(), xy()), wkt()) expect_identical(vctrs::vec_c(wkt(), xyz()), wkt()) expect_identical(vctrs::vec_c(wkt(), xym()), wkt()) expect_identical(vctrs::vec_c(wkt(), xyzm()), wkt()) expect_identical(vctrs::vec_c(wkt(), rct()), wkt()) expect_identical(vctrs::vec_c(wkt(), crc()), wkt()) }) test_that("vctrs xy implementation works", { expect_true(vctrs::vec_is(xy())) expect_identical(vctrs::vec_size(xy()), 0L) expect_identical(vctrs::vec_cast(wkt(), xy()), xy()) expect_identical(vctrs::vec_cast(wkb(), xy()), xy()) expect_identical(vctrs::vec_cast(xy(), xy()), xy()) expect_identical(vctrs::vec_cast(xyz(), xy()), xy()) expect_identical(vctrs::vec_cast(xym(), xy()), xy()) expect_identical(vctrs::vec_cast(xyzm(), xy()), xy()) expect_error(vctrs::vec_cast(rct(), xy()), class = "vctrs_error_incompatible_type") expect_identical(vctrs::vec_proxy(xy(crs = NULL)), data.frame(x = double(), y = double())) expect_identical(vctrs::vec_restore(data.frame(x = double(), y = double()), xy()), xy()) expect_identical(vctrs::vec_c(xy(), wkt()), wkt()) expect_identical(vctrs::vec_c(xy(), wkb()), wkb()) expect_identical(vctrs::vec_c(xy(), xy()), xy()) expect_identical(vctrs::vec_c(xy(), xyz()), xyz()) expect_identical(vctrs::vec_c(xy(), xym()), xym()) expect_identical(vctrs::vec_c(xy(), xyzm()), xyzm()) expect_identical(vctrs::vec_c(xy(), rct()), wkb()) expect_identical(vctrs::vec_c(xy(), crc()), wkb()) }) test_that("vctrs xyz implementation works", { expect_true(vctrs::vec_is(xyz())) expect_identical(vctrs::vec_size(xyz()), 0L) expect_identical(vctrs::vec_cast(wkt(), xyz()), xyz()) expect_identical(vctrs::vec_cast(wkb(), xyz()), xyz()) expect_identical(vctrs::vec_cast(xy(), xyz()), xyz()) expect_identical(vctrs::vec_cast(xyz(), xyz()), xyz()) expect_identical(vctrs::vec_cast(xym(), xyz()), xyz()) expect_identical(vctrs::vec_cast(xyzm(), xyz()), xyz()) expect_error(vctrs::vec_cast(rct(), xyz()), class = "vctrs_error_incompatible_type") expect_identical(vctrs::vec_proxy(xyz(crs = NULL)), data.frame(x = double(), y = double(), z = double())) expect_identical(vctrs::vec_restore(data.frame(x = double(), y = double(), z = double()), xyz()), xyz()) expect_identical(vctrs::vec_c(xyz(), wkt()), wkt()) expect_identical(vctrs::vec_c(xyz(), wkb()), wkb()) expect_identical(vctrs::vec_c(xyz(), xy()), xyz()) expect_identical(vctrs::vec_c(xyz(), xyz()), xyz()) expect_identical(vctrs::vec_c(xyz(), xym()), xyzm()) expect_identical(vctrs::vec_c(xyz(), xyzm()), xyzm()) expect_identical(vctrs::vec_c(xyz(), rct()), wkb()) expect_identical(vctrs::vec_c(xyz(), crc()), wkb()) }) test_that("vctrs xym implementation works", { expect_true(vctrs::vec_is(xym())) expect_identical(vctrs::vec_size(xym()), 0L) expect_identical(vctrs::vec_cast(wkt(), xym()), xym()) expect_identical(vctrs::vec_cast(wkb(), xym()), xym()) expect_identical(vctrs::vec_cast(xy(), xym()), xym()) expect_identical(vctrs::vec_cast(xyz(), xym()), xym()) expect_identical(vctrs::vec_cast(xym(), xym()), xym()) expect_identical(vctrs::vec_cast(xyzm(), xym()), xym()) expect_error(vctrs::vec_cast(rct(), xym()), class = "vctrs_error_incompatible_type") expect_identical(vctrs::vec_proxy(xym(crs = NULL)), data.frame(x = double(), y = double(), m = double())) expect_identical(vctrs::vec_restore(data.frame(x = double(), y = double(), m = double()), xym()), xym()) expect_identical(vctrs::vec_c(xym(), wkt()), wkt()) expect_identical(vctrs::vec_c(xym(), wkb()), wkb()) expect_identical(vctrs::vec_c(xym(), xy()), xym()) expect_identical(vctrs::vec_c(xym(), xyz()), xyzm()) expect_identical(vctrs::vec_c(xym(), xym()), xym()) expect_identical(vctrs::vec_c(xym(), xyzm()), xyzm()) expect_identical(vctrs::vec_c(xym(), rct()), wkb()) expect_identical(vctrs::vec_c(xym(), crc()), wkb()) }) test_that("vctrs xyzm implementation works", { expect_true(vctrs::vec_is(xyzm())) expect_identical(vctrs::vec_size(xyzm()), 0L) expect_identical(vctrs::vec_cast(wkt(), xyzm()), xyzm()) expect_identical(vctrs::vec_cast(wkb(), xyzm()), xyzm()) expect_identical(vctrs::vec_cast(xy(), xyzm()), xyzm()) expect_identical(vctrs::vec_cast(xyz(), xyzm()), xyzm()) expect_identical(vctrs::vec_cast(xym(), xyzm()), xyzm()) expect_identical(vctrs::vec_cast(xyzm(), xyzm()), xyzm()) expect_error(vctrs::vec_cast(rct(), xyzm()), class = "vctrs_error_incompatible_type") expect_identical(vctrs::vec_proxy(xyzm(crs = NULL)), data.frame(x = double(), y = double(), z = double(), m = double())) expect_identical(vctrs::vec_restore(data.frame(x = double(), y = double(), z = double(), m = double()), xyzm()), xyzm()) expect_identical(vctrs::vec_c(xyzm(), wkt()), wkt()) expect_identical(vctrs::vec_c(xyzm(), wkb()), wkb()) expect_identical(vctrs::vec_c(xyzm(), xy()), xyzm()) expect_identical(vctrs::vec_c(xyzm(), xyz()), xyzm()) expect_identical(vctrs::vec_c(xyzm(), xym()), xyzm()) expect_identical(vctrs::vec_c(xyzm(), xyzm()), xyzm()) expect_identical(vctrs::vec_c(xyzm(), rct()), wkb()) expect_identical(vctrs::vec_c(xyzm(), crc()), wkb()) }) test_that("vctrs rct implementation works", { expect_true(vctrs::vec_is(rct())) expect_identical(vctrs::vec_size(rct()), 0L) expect_identical(vctrs::vec_cast(rct(), rct()), rct()) expect_identical( vctrs::vec_proxy(rct(crs = NULL)), data.frame(xmin = double(), ymin = double(), xmax = double(), ymax = double()) ) expect_identical( vctrs::vec_restore(data.frame(xmin = double(), ymin = double(), xmax = double(), ymax = double()), rct()), rct() ) expect_identical(vctrs::vec_c(rct(), wkb()), wkb()) expect_identical(vctrs::vec_c(rct(), wkt()), wkt()) expect_identical(vctrs::vec_c(rct(), xy()), wkb()) expect_identical(vctrs::vec_c(rct(), xyz()), wkb()) expect_identical(vctrs::vec_c(rct(), xym()), wkb()) expect_identical(vctrs::vec_c(rct(), xyzm()), wkb()) expect_identical(vctrs::vec_c(rct(), rct()), rct()) expect_identical(vctrs::vec_c(rct(), crc()), wkb()) }) test_that("vctrs crc implementation works", { expect_true(vctrs::vec_is(crc())) expect_identical(vctrs::vec_size(crc()), 0L) expect_identical(vctrs::vec_cast(crc(), crc()), crc()) expect_identical(vctrs::vec_cast(crc(), wkb()), wkb()) expect_identical(vctrs::vec_cast(crc(), wkt()), wkt()) expect_identical( vctrs::vec_proxy(crc(crs = NULL)), data.frame(x = double(), y = double(), r = double()) ) expect_identical( vctrs::vec_restore(data.frame(x = double(), y = double(), r = double()), crc()), crc() ) expect_identical(vctrs::vec_c(crc(), wkb()), wkb()) expect_identical(vctrs::vec_c(crc(), wkt()), wkt()) expect_identical(vctrs::vec_c(crc(), xy()), wkb()) expect_identical(vctrs::vec_c(crc(), xyz()), wkb()) expect_identical(vctrs::vec_c(crc(), xym()), wkb()) expect_identical(vctrs::vec_c(crc(), xyzm()), wkb()) expect_identical(vctrs::vec_c(crc(), crc()), crc()) }) test_that("vec_c() propagates the crs attribute", { for (constructor in list(wkb, wkt, xy, xyz, xym, xyzm, rct, crc)) { expect_identical( vctrs::vec_c(!!constructor(crs = 1234), !!constructor(crs = 1234)), !!constructor(crs = 1234) ) expect_identical( vctrs::vec_c(!!constructor(crs = 1234), !!constructor()), !!constructor(crs = 1234) ) expect_error( vctrs::vec_c(!!constructor(crs = 1234), !!constructor(crs = NULL)), "are not equal" ) } }) test_that("vec_c() propagates the geodesic attribute", { for (constructor in list(wkb, wkt)) { expect_identical( vctrs::vec_c(!!constructor(geodesic = TRUE), !!constructor(geodesic = TRUE)), !!constructor(geodesic = TRUE) ) expect_identical( vctrs::vec_c(!!constructor(), !!constructor()), !!constructor() ) expect_error( vctrs::vec_c(!!constructor(geodesic = TRUE), !!constructor(crs = NULL)), "have differing" ) } }) test_that("vec_c() propagates the geodesic attribute through points", { for (constructor in list(wkb, wkt)) { for (constructor2 in list(xy, xyz, xym, xyzm)) { expect_identical( vctrs::vec_c(!!constructor(geodesic = TRUE), !!constructor2()), !!constructor(geodesic = TRUE) ) expect_identical( vctrs::vec_c(!!constructor2(), !!constructor(geodesic = TRUE)), !!constructor(geodesic = TRUE) ) } } }) wk/tests/testthat/test-chunk.R0000644000176200001440000001025314161345517016115 0ustar liggesusers test_that("chunk map feature works", { expect_null(wk_chunk_map_feature(xy(1:5, 1:5), identity)) expect_null(wk_chunk_map_feature(xy(), identity)) expect_identical( wk_chunk_map_feature( wk_linestring(xy(1:10, 1:10), c(1, 1, 2, 2, 2, 3, 3, 4, 4, 4)), function(features) { coords <- wk_coords(features) vapply(split(coords, coords$feature_id), nrow, integer(1)) }, output_template = integer() ), c(2L, 3L, 2L, 3L) ) # check with list(handleable) vs just handleable expect_identical( wk_chunk_map_feature(xy(1:5, 1:5), identity, output_template = xy()), wk_chunk_map_feature(list(xy(1:5, 1:5)), identity, output_template = xy()) ) # invalid inputs expect_error(wk_chunk_map_feature(NULL), "must be a list") expect_error(wk_chunk_map_feature(list(NULL)), "must be objects with a") expect_error( wk_chunk_map_feature(list(xy(1:2, 1:2), xy(1:3, 1:3)), identity), "must be recycleable to a common length" ) expect_error(wk_chunk_map_feature(xy(1:5, 1:5), "not a function"), "is not TRUE") expect_error( wk_chunk_map_feature(xy(1:5, 1:5), identity, vector_args = "bad arg"), "is not TRUE" ) expect_error( wk_chunk_map_feature(xy(1:5, 1:5), identity, input_handler_factory = "bad arg"), "is not TRUE" ) expect_error( wk_chunk_map_feature(xy(1:5, 1:5), identity, strategy = "bad arg"), "is not TRUE" ) }) test_that("chunk map feature works with vectorized and non-vectorized args", { skip_if_not(packageVersion("base") >= "3.6") wk_chunk_map_feature( xy(1, 1), fun = function(x, l, y) { expect_identical(l, letters[1:5]) expect_identical(y, "zippity") }, vector_args = data.frame(l = letters[1:5], stringsAsFactors = FALSE), args = list(y = "zippity"), strategy = wk_chunk_strategy_single() ) wk_chunk_map_feature( xy(1:3, 1:3), fun = function(x, l, y) { expect_identical(l, letters[1]) expect_identical(y, "zippity") }, vector_args = data.frame(l = letters[1], stringsAsFactors = FALSE), args = list(y = "zippity"), strategy = wk_chunk_strategy_single() ) }) test_that("chunk map feature doesn't expand handleables more than necessary", { wk_chunk_map_feature( xy(1, 1), fun = function(x) { expect_identical(x, xy(1, 1)) }, strategy = wk_chunk_strategy_single() ) }) test_that("single chunk strategy works", { feat <- c(as_wkt(xy(1:4, 1:4)), wkt("LINESTRING (1 1, 2 2)")) expect_identical( wk_chunk_strategy_single()(list(feat), 5), data.frame(from = 1, to = 5) ) }) test_that("chunk by feature strategy works", { feat <- c(as_wkt(xy(1:4, 1:4)), wkt("LINESTRING (1 1, 2 2)")) expect_identical( wk_chunk_strategy_feature(chunk_size = 2)(list(feat), 5), data.frame(from = c(1, 3, 5), to = c(2, 4, 5)) ) }) test_that("chunk by coordinates strategy works", { n_coord <- c(1, 5, 1, 5, 1) xs <- unlist(lapply(n_coord, seq_len)) ys <- unlist(lapply(n_coord, seq_len)) id <- vctrs::vec_rep_each(seq_along(n_coord), n_coord) feat <- wk_linestring(xy(xs, ys), feature_id = id) expect_identical( wk_chunk_strategy_coordinates(chunk_size = 6)(list(feat), length(n_coord)), data.frame(from = c(1L, 3L, 5L), to = c(2L, 4L, 5L)) ) # for points there's a shortcut for calculating the chunks expect_identical( wk_chunk_strategy_coordinates(chunk_size = 2)(list(xy(1:6, 1:6)), 6), data.frame(from = c(1, 3, 5), to = c(2, 4, 6)) ) }) test_that("chunk_info() works", { expect_identical( chunk_info(5, chunk_size = 2), list(n_chunks = 3, chunk_size = 2) ) expect_identical( chunk_info(5, chunk_size = 5), list(n_chunks = 1, chunk_size = 5) ) expect_identical( chunk_info(0, chunk_size = 5), list(n_chunks = 0, chunk_size = 5) ) expect_identical( chunk_info(5, n_chunks = 3), list(n_chunks = 3, chunk_size = 2) ) expect_identical( chunk_info(5, n_chunks = 1), list(n_chunks = 1, chunk_size = 5) ) expect_identical( chunk_info(0, n_chunks = 5), list(n_chunks = 0L, chunk_size = 1L) ) expect_error(chunk_info(1), "exactly one") expect_error(chunk_info(1, chunk_size = 1, n_chunks = 1), "exactly one") }) wk/tests/testthat/test-flatten.R0000644000176200001440000000733314106220314016431 0ustar liggesusers test_that("wk_flatten() works", { expect_identical( wk_flatten(wkt(c("MULTIPOINT (0 0, 1 1)", NA))), wkt(c("POINT (0 0)", "POINT (1 1)", NA)) ) expect_identical( wk_flatten(wkt(c("POINT (0 0)", "POINT (1 1)", NA))), wkt(c("POINT (0 0)", "POINT (1 1)", NA)) ) expect_error(wk_flatten(new_wk_wkt("POINT ENTPY")), "ENTPY") # we need this one to trigger a realloc on the details list xy_copy <- wk_handle( wkt(c(paste0("MULTIPOINT (", paste(1:1025, 1, collapse = ", ") , ")"), "POINT (0 0)")), wk_flatten_filter(xy_writer(), add_details = TRUE) ) expect_identical( attr(xy_copy, "wk_details"), list(feature_id = c(rep(1L, 1025), 2L)) ) attr(xy_copy, "wk_details") <- NULL expect_identical(xy_copy, c(xy(1:1025, 1), xy(0, 0))) }) test_that("wk_flatten() works for polygons", { expect_identical( wk_flatten(wkt("POLYGON ((0 0, 0 1, 1 0, 0 0))")), wkt("POLYGON ((0 0, 0 1, 1 0, 0 0))") ) }) test_that("wk_flatten() works for data.frame", { expect_equal( wk_flatten(data.frame(geom = wkt(c("MULTIPOINT (0 0, 1 1)")))), data.frame(geom = wkt(c("POINT (0 0)", "POINT (1 1)"))), ignore_attr = TRUE ) }) test_that("wk_flatten() communicates correct size and type", { expect_identical( wk_handle(wkt("POINT (0 0)"), wk_flatten_filter(wk_vector_meta_handler())), list(geometry_type = 0L, size = NA_real_, has_z = NA, has_m = NA) ) skip_if_not_installed("sf") # need sf because these objects carry vector-level types expect_identical( wk_handle(sf::st_as_sfc("POINT (0 0)"), wk_flatten_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = 1, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("MULTIPOINT EMPTY"), wk_flatten_filter(wk_vector_meta_handler())), list(geometry_type = 1L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("MULTILINESTRING EMPTY"), wk_flatten_filter(wk_vector_meta_handler())), list(geometry_type = 2L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("MULTIPOLYGON EMPTY"), wk_flatten_filter(wk_vector_meta_handler())), list(geometry_type = 3L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) expect_identical( wk_handle(sf::st_as_sfc("GEOMETRYCOLLECTION EMPTY"), wk_flatten_filter(wk_vector_meta_handler())), list(geometry_type = 0L, size = NA_real_, has_z = FALSE, has_m = FALSE) ) }) test_that("wk_flatten() works for nested collections", { expect_identical( wk_flatten( wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))"), max_depth = 3 ), wkt("POINT (0 1)") ) expect_identical( wk_flatten( wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))"), max_depth = 2 ), wkt("GEOMETRYCOLLECTION (POINT (0 1))") ) expect_identical( wk_flatten( wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))"), max_depth = 1 ), wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1)))") ) expect_identical( wk_flatten( wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))"), max_depth = 0 ), wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))") ) expect_identical( wk_handle( wkt("GEOMETRYCOLLECTION(MULTIPOINT (30 10, 10 10), LINESTRING (0 0, 1 1), GEOMETRYCOLLECTION EMPTY)"), wk_flatten_filter(wkt_writer(), max_depth = 2, add_details = TRUE) ), structure( c("POINT (30 10)", "POINT (10 10)", "LINESTRING (0 0, 1 1)"), class = c("wk_wkt", "wk_vctr"), wk_details = list(feature_id = c(1L, 1L, 1L)) ) ) }) wk/tests/testthat/test-handler.R0000644000176200001440000000121514145575672016431 0ustar liggesusers test_that("wk_handler class works", { expect_true(is_wk_handler(wk_void_handler())) handler <- wk_void_handler() expect_identical(as_wk_handler(handler), handler) expect_output(print(wk_void_handler()), "wk_void_handler") expect_s3_class(as_wk_handler(wk_void_handler), "wk_void_handler") }) test_that("is_handleable works", { expect_true(is_handleable(xy())) expect_false(is_handleable(1:5)) }) test_that("as_handler() works", { handler <- wk_void_handler() expect_identical(as_wk_handler(handler), handler) expect_identical(as_wk_handler(function() handler), handler) expect_error(as_wk_handler(3), "must be a wk handler") }) wk/tests/testthat/test-xy-writer.R0000644000176200001440000000210214106220314016733 0ustar liggesusers test_that("xy_writer() works", { empties <- wkt( c("POINT EMPTY", "LINESTRING EMPTY", "POLYGON EMPTY", "MULTIPOINT EMPTY", "MULTILINESTRING EMPTY", "MULTIPOLYGON EMPTY", "GEOMETRYCOLLECTION EMPTY" ) ) expect_identical( wk_handle(empties, xy_writer()), rep(xy(NA, NA), length(empties)) ) expect_identical( wk_handle(wkt("POINT (0 1)"), xy_writer()), xy(0, 1) ) expect_identical( wk_handle(wkt("MULTIPOINT ((0 1))"), xy_writer()), xy(0, 1) ) expect_identical( wk_handle(wkt("GEOMETRYCOLLECTION (MULTIPOINT ((0 1)))"), xy_writer()), xy(0, 1) ) expect_error( wk_handle(wkt("LINESTRING (0 1, 1 2)"), xy_writer()), "Can't convert geometry" ) expect_error( wk_handle(wkt("MULTIPOINT (0 1, 1 2)"), xy_writer()), "contains more than one coordinate" ) }) test_that("xy_writer() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( handle_wkt_without_vector_size(long_xy, xy_writer()), wk_handle(long_xy, xy_writer()) ) }) wk/tests/testthat/test-count.R0000644000176200001440000000075714106220314016127 0ustar liggesusers test_that("wk_count() works", { expect_identical( wk_count(wkt(c("POINT (1 2)", "POLYGON ((0 0, 0 1, 1 1, 0 0))", NA))), data.frame( n_geom = c(1L, 1L, 0L), n_ring = c(0L, 1L, 0L), n_coord = c(1, 4L, 0) ) ) }) test_that("wk_count() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( new_data_frame(handle_wkt_without_vector_size(long_xy, wk_count_handler())), wk_count(long_xy) ) }) wk/tests/testthat/test-handle-rct.R0000644000176200001440000000060114106220314017004 0ustar liggesusers test_that("wk_handle.wk_rct() works", { expect_identical( wk_handle(rct(c(1, NA, Inf, 0), c(2, NA, 0, Inf), c(3, NA, 1, 1), c(4, NA, 1, 1)), wkt_writer()), wkt(c("POLYGON ((1 2, 3 2, 3 4, 1 4, 1 2))", "POLYGON EMPTY", "POLYGON EMPTY", "POLYGON EMPTY")) ) # check invalid data expect_error(wk_handle.wk_rct("not a rct", wk_void_handler()), "does not inherit from") }) wk/tests/testthat/test-wk-rcrd.R0000644000176200001440000000541014163110540016341 0ustar liggesusers test_that("wk_rcrd works", { xy_rcrd <- structure(list(x = as.numeric(1:3), y = c(2, 2, 2)), class = "wk_rcrd") expect_identical(length(xy_rcrd), 3L) expect_identical( xy_rcrd[2], structure(list(x = 2, y = 2), class = "wk_rcrd") ) expect_identical(xy_rcrd[[2]], xy_rcrd[2]) expect_error(xy_rcrd$x, "is not meaningful") expect_identical(names(xy_rcrd), NULL) expect_identical(is.na(xy_rcrd), c(FALSE, FALSE, FALSE)) expect_identical(is.na(xy_rcrd[NA_integer_]), TRUE) expect_identical(is.na(xy_rcrd[integer(0)]), logical(0)) expect_identical(expect_output(print(xy_rcrd), "wk_rcrd"), xy_rcrd) expect_output(print(xy_rcrd[integer(0)]), "wk_rcrd") expect_output(expect_identical(str(xy_rcrd), xy_rcrd), "wk_rcrd") expect_output(expect_identical(str(xy_rcrd[integer(0)]), xy_rcrd[integer(0)]), "wk_rcrd\\[0\\]") expect_output(print(wk_set_crs(xy_rcrd, 1234)), "CRS=EPSG:1234") expect_length(format(xy_rcrd), 2) expect_length(as.character(xy_rcrd), 2) old_opt <- options(max.print = 1000) expect_output( print(structure(list(x = 1:1001), class = "wk_rcrd")), "Reached max.print" ) options(old_opt) xy_rcrd2 <- xy_rcrd names(xy_rcrd2) <- NULL expect_identical(xy_rcrd2, xy_rcrd) expect_error(names(xy_rcrd) <- "not null", "must be NULL") expect_identical(validate_wk_rcrd(xy_rcrd), xy_rcrd) expect_identical( rep(xy_rcrd, 2), structure(list(x = as.numeric(c(1:3, 1:3)), y = rep(2, 6)), class = "wk_rcrd") ) expect_identical( rep(xy_rcrd, 2), c(xy_rcrd, xy_rcrd) ) expect_error(c(xy_rcrd, 2), "Can't combine") expect_identical( as.matrix(xy_rcrd), matrix(c(1, 2, 3, 2, 2, 2), ncol = 2, dimnames = list(NULL, c("x", "y"))) ) expect_identical( as.data.frame(xy_rcrd), data.frame(x = c(1, 2, 3), y = c(2, 2, 2)) ) expect_identical( data.frame(col_name = xy_rcrd), new_data_frame(list(col_name = xy_rcrd)) ) }) test_that("geodesic gets printed for geodesic rcrd objects", { x_geod <- new_wk_rcrd( list(x = double()), template = structure(list(), class = c("some_wk_rcrd", "wk_rcrd")) ) s3_register("wk::wk_is_geodesic", "some_wk_rcrd", function(x) TRUE) expect_output(print(x_geod), "geodesic some_wk_rcrd") }) test_that("rep_len() works for wk_rcrd", { skip_if_not(packageVersion("base") >= "3.6") xy_rcrd <- structure(list(x = as.numeric(1:3), y = c(2, 2, 2)), class = "wk_rcrd") expect_identical( rep_len(xy_rcrd, 6), structure(list(x = as.numeric(c(1:3, 1:3)), y = rep(2, 6)), class = "wk_rcrd") ) }) test_that("c() for wk_rcrd handles crs attributes", { expect_identical( wk_crs(c(xy(0, 1, crs = wk_crs_inherit()), xy(0, 1, crs = 1234))), 1234 ) expect_error( wk_crs(c(xy(0, 1), xy(0, 1, crs = 1234))), "are not equal" ) }) wk/tests/testthat/test-meta.R0000644000176200001440000000445414106220314015723 0ustar liggesusers test_that("wk_meta() works", { expect_identical( wk_meta(wkt(c("POINT (1 2)", NA))), data.frame( geometry_type = c(1L, NA_integer_), size = c(NA_integer_, NA_integer_), has_z = c(FALSE, NA), has_m = c(FALSE, NA), srid = c(NA_integer_, NA_integer_), precision = c(0, NA_integer_) ) ) expect_identical( wk_meta(as_wkb(c("POINT (1 2)", NA))), data.frame( geometry_type = c(1L, NA_integer_), size = c(1L, NA_integer_), has_z = c(FALSE, NA), has_m = c(FALSE, NA), srid = c(NA_integer_, NA_integer_), precision = c(0, NA_integer_) ) ) expect_identical( wk_meta(as_wkb(c("SRID=1234;POINT (1 2)", NA))), data.frame( geometry_type = c(1L, NA_integer_), size = c(1L, NA_integer_), has_z = c(FALSE, NA), has_m = c(FALSE, NA), srid = c(1234L, NA_integer_), precision = c(0, NA_integer_) ) ) }) test_that("wk_vector_meta() works", { expect_identical( wk_vector_meta(wkt(c("POINT (1 2)", NA))), data.frame( geometry_type = 0L, size = 2, has_z = NA, has_m = NA ) ) # only sf reader has vector meta with embedded dimensions skip_if_not_installed("sf") expect_identical( wk_vector_meta(sf::st_as_sfc("POINT (30 10)")), data.frame( geometry_type = 1L, size = 1, has_z = FALSE, has_m = FALSE ) ) expect_identical( wk_vector_meta(sf::st_as_sfc("POINT M (30 10 12)")), data.frame( geometry_type = 1L, size = 1, has_z = FALSE, has_m = TRUE ) ) expect_identical( wk_vector_meta(sf::st_as_sfc("POINT Z (30 10 12)")), data.frame( geometry_type = 1L, size = 1, has_z = TRUE, has_m = FALSE ) ) }) test_that("wk_meta() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( new_data_frame(handle_wkt_without_vector_size(long_xy, wk_meta_handler())), wk_meta(long_xy) ) }) test_that("geometry type converters work", { types_str <- c( "point", "linestring", "polygon", "multipoint", "multilinestring", "multipolygon", "geometrycollection" ) expect_identical(wk_geometry_type(types_str), 1:7) expect_identical(wk_geometry_type_label(7:1), rev(types_str)) }) wk/tests/testthat/test-pkg-sf.R0000644000176200001440000002122214155244415016170 0ustar liggesusers test_that("sf CRS objects can be compared", { skip_if_not_installed("sf") expect_true(wk_crs_equal(sf::st_crs(4326), 4326)) expect_true(wk_crs_equal(sf::st_crs(4326), 4326L)) expect_true(wk_crs_equal(sf::st_crs(NA), NULL)) expect_true(wk_crs_equal(NULL, sf::st_crs(NA))) }) test_that("wk_crs_proj_definition() works for sf crs objects", { skip_if_not_installed("sf") expect_identical(wk_crs_proj_definition(sf::NA_crs_), NA_character_) epsg4326 <- 'GEOGCS["WGS 84",DATUM["WGS_1984",SPHEROID["WGS 84",6378137,298.257223563]],PRIMEM["Greenwich",0],UNIT["degree",0.0174532925199433,AUTHORITY["EPSG","9122"]],AXIS["Latitude",NORTH],AXIS["Longitude",EAST],AUTHORITY["EPSG","4326"]]' expect_identical(wk_crs_proj_definition(sf::st_crs(epsg4326)), "EPSG:4326") expect_identical(wk_crs_proj_definition(sf::st_crs(4326)), "EPSG:4326") expect_match(wk_crs_proj_definition(sf::st_crs(4326), verbose = TRUE), "^GEOGCS") expect_identical(wk_crs_proj_definition("OGC:CRS84"), "OGC:CRS84") expect_identical( wk_crs_proj_definition(sf::st_crs("+proj=merc +lat_ts=56.5 +type=crs")), "+proj=merc +lat_ts=56.5 +type=crs" ) }) test_that("wk_crs/set_crs works on sf/sfc", { skip_if_not_installed("sf") sf <- sf::st_as_sf(data.frame(geometry = sf::st_as_sfc("POINT (1 2)"))) expect_identical(wk_crs(sf), sf::st_crs(sf)) expect_identical(sf::st_crs(wk_set_crs(sf, 4326)), sf::st_crs(4326)) sfc <- sf::st_as_sfc("POINT (1 2)") expect_identical(wk_crs(sfc), sf::st_crs(sfc)) expect_identical(sf::st_crs(wk_set_crs(sfc, 4326)), sf::st_crs(4326)) }) test_that("conversion from sf to wkt works", { skip_if_not_installed("sf") sfc <- sf::st_sfc(sf::st_point(), sf::st_point(c(0, 1)), crs = 4326) expect_s3_class(as_wkt(sfc), "wk_wkt") expect_identical( as.character(as_wkt(sfc)), c("POINT EMPTY", "POINT (0 1)") ) expect_identical(wk_crs(as_wkt(sfc)), sf::st_crs(sfc)) sf <- sf::st_as_sf(new_data_frame(list(geometry = sfc))) expect_identical( as.character(as_wkt(sf)), c("POINT EMPTY", "POINT (0 1)") ) expect_identical(wk_crs(as_wkt(sf)), sf::st_crs(sf)) }) test_that("conversion from sf to wkb works", { skip_if_not_installed("sf") sfc <- sf::st_sfc(sf::st_point(), sf::st_point(c(0, 1)), crs = 4326) expect_s3_class(as_wkb(sfc), "wk_wkb") expect_identical( as.character(as_wkt(as_wkb(sfc))), c("POINT (nan nan)", "POINT (0 1)") ) expect_identical(wk_crs(as_wkb(sfc)), sf::st_crs(sfc)) sfg <- sf::st_point(c(0, 1)) expect_s3_class(as_wkb(sfg), "wk_wkb") expect_identical( as.character(as_wkt(as_wkb(sfg))), "POINT (0 1)" ) sf <- sf::st_as_sf(new_data_frame(list(geometry = sfc))) expect_identical( as.character(as_wkt(as_wkb(sf))), c("POINT (nan nan)", "POINT (0 1)") ) expect_identical(wk_crs(as_wkb(sf)), sf::st_crs(sf)) }) test_that("conversion from sf to xy works", { skip_if_not_installed("sf") sfc <- sf::st_sfc(sf::st_point(), sf::st_point(c(0, 1))) expect_s3_class(as_xy(sfc), "wk_xy") expect_identical(as_xy(sfc), xy(c(NA, 0), c(NA, 1))) sf <- sf::st_as_sf(new_data_frame(list(geometry = sfc))) expect_identical(as_xy(sf), xy(c(NA, 0), c(NA, 1))) expect_identical(as_xy(sf::st_sfc()), xy(crs = NULL)) expect_identical(as_xy(sf::st_sfc(sf::st_linestring())), xy(NA, NA, crs = sf::NA_crs_)) # check all dimensions expect_identical(as_xy(sf::st_sfc(sf::st_point(c(1, 2, 3, 4), dim = "XYZM"))), xyzm(1, 2, 3, 4)) expect_identical(as_xy(sf::st_sfc(sf::st_point(c(1, 2, 3), dim = "XYZ"))), xyz(1, 2, 3)) expect_identical(as_xy(sf::st_sfc(sf::st_point(c(1, 2, 3), dim = "XYM"))), xym(1, 2, 3)) expect_identical(as_xy(sf::st_sfc(sf::st_point(c(1, 2)))), xy(1, 2)) }) test_that("conversion from bbox to rct works", { skip_if_not_installed("sf") sfc <- sf::st_sfc(sf::st_point(c(2, 3)), sf::st_point(c(0, 1))) expect_identical(as_rct(sf::st_bbox(sfc)), rct(0, 1, 2, 3)) }) test_that("conversion to sf works", { skip_if_not_installed("sf") sfc <- sf::st_sfc(sf::st_point(), sf::st_point(c(0, 1)), crs = 4326) sf <- sf::st_as_sf(new_data_frame(list(geometry = sfc))) wkb <- as_wkb(c("POINT EMPTY", "POINT (0 1)"), crs = 4326) wkt <- as_wkt(c("POINT EMPTY", "POINT (0 1)"), crs = 4326) expect_equal(sf::st_as_sf(wkb), sf) expect_equal(sf::st_as_sfc(wkb), sfc) expect_equal(sf::st_as_sf(wkt), sf) expect_equal(sf::st_as_sfc(wkt), sfc) # xy expect_equal(sf::st_as_sf(xy(c(NA, 0), c(NA, 1), crs = 4326)), sf) expect_equal(sf::st_as_sfc(xy(c(NA, 0), c(NA, 1), crs = 4326)), sfc) # xy with all !is.na() uses faster sf conversion with coords expect_equal(sf::st_as_sf(xy(0, 1, crs = 4326)), sf[-1, , drop = FALSE]) expect_equal(sf::st_as_sfc(xy(0, 1, crs = 4326)), sfc[-1]) # rct can only generate rectangles expect_equal( sf::st_as_sfc(rct(1, 2, 3, 4, crs = 4326)), sf::st_as_sfc(sf::st_bbox(c(xmin = 1, ymin = 2, xmax = 3, ymax = 4), crs = 4326)) ) expect_equal( sf::st_as_sf(rct(1, 2, 3, 4, crs = 4326)), sf::st_as_sf( data.frame( geometry = sf::st_as_sfc( sf::st_bbox(c(xmin = 1, ymin = 2, xmax = 3, ymax = 4), crs = 4326) ) ) ) ) # crc only generates circles expect_equal( as_rct(sf::st_bbox(sf::st_as_sfc(crc(1, 2, 3)))), rct(-2, -1, 4, 5) ) expect_equal( as_rct(sf::st_bbox(sf::st_as_sf(crc(1, 2, 3)))), rct(-2, -1, 4, 5) ) }) test_that("wk_handle.sfg works", { skip_if_not_installed("sf") expect_identical( wk_handle(wkt("POINT (1 2)"), wkb_writer()), wk_handle(sf::st_point(c(1, 2)), wkb_writer()) ) }) test_that("wk_handle.bbox works", { skip_if_not_installed("sf") expect_identical( wk_handle(sf::st_bbox(sf::st_linestring(rbind(c(0, 1), c(2, 3)))), wkb_writer()), wk_handle(rct(0, 1, 2, 3), wkb_writer()) ) }) test_that("wk_translate.sfc() works", { skip_if_not_installed("sf") expect_identical( wk_translate(wkt("POINT (1 2)", crs = 4326), sf::st_sfc(crs = 4326)), sf::st_sfc(sf::st_point(c(1, 2)), crs = 4326) ) }) test_that("wk_translate() works for sf", { skip_if_not_installed("sf") expect_identical( wk_translate( sf::st_as_sf(data.frame(geometry = sf::st_as_sfc("POINT (1 2)"))), sf::st_as_sf(data.frame(a = sf::st_sfc())) ), sf::st_as_sf(data.frame(geometry = sf::st_as_sfc("POINT (1 2)"))) ) expect_identical( wk_translate( data.frame(a = 1, geometry = wkt("POINT (1 2)")), sf::st_as_sf(data.frame(a = sf::st_sfc())) ), sf::st_as_sf(data.frame(a = 1, geometery = sf::st_as_sfc("POINT (1 2)"))) ) expect_identical( wk_translate(as_wkb("POINT (1 2)"), sf::st_as_sf(data.frame(a = sf::st_sfc()))), sf::st_as_sf(data.frame(a = sf::st_as_sfc("POINT (1 2)"))) ) expect_identical( wk_translate( as_wkb("POINT (1 2)", crs = 4326), sf::st_as_sf(data.frame(a = sf::st_sfc(crs = 4326))) ), sf::st_as_sf(data.frame(a = sf::st_as_sfc("POINT (1 2)", crs = 4326))) ) }) test_that("wk_restore() works for sf", { skip_if_not_installed("sf") expect_identical( wk_identity(sf::st_as_sf(data.frame(a = sf::st_as_sfc("POINT (1 2)")))), sf::st_as_sf(data.frame(a = sf::st_as_sfc("POINT (1 2)"))) ) expect_identical( wk_identity(sf::st_as_sf(data.frame(a = sf::st_as_sfc("POINT (1 2)", crs = 4326)))), sf::st_as_sf(data.frame(a = sf::st_as_sfc("POINT (1 2)", crs = 4326))) ) expect_identical( wk_restore( sf::st_as_sf(data.frame(geometry = sf::st_as_sfc("POINT (1 2)"))), sf::st_as_sfc(c("POINT (3 4)", "POINT (5 6)")) ), sf::st_as_sf(data.frame(geometry = sf::st_as_sfc(c("POINT (3 4)", "POINT (5 6)")))) ) expect_error( wk_restore( sf::st_as_sf(data.frame(geometry = sf::st_as_sfc(rep("POINT (1 2)", 3)))), sf::st_as_sfc(c("POINT (3 4)", "POINT (5 6)")) ), "Can't assign" ) }) test_that("st_geometry() methods are defined for wk objects", { skip_if_not_installed("sf") expect_identical(sf::st_geometry(wkb()), sf::st_as_sfc(wkb())) expect_identical(sf::st_geometry(wkt()), sf::st_as_sfc(wkt())) expect_identical(sf::st_geometry(xy()), sf::st_as_sfc(xy())) expect_identical(sf::st_geometry(rct()), sf::st_as_sfc(rct())) expect_identical(sf::st_geometry(crc()), sf::st_as_sfc(crc())) }) test_that("st_bbox() methods are defined for wk objects", { skip_if_not_installed("sf") sf_obj <- sf::st_as_sfc("LINESTRING (0 1, 2 3)", crs = 32620) bbox_obj <- sf::st_bbox(sf_obj) expect_identical(sf::st_bbox(as_wkb(sf_obj)), bbox_obj) expect_identical(sf::st_bbox(as_wkt(sf_obj)), bbox_obj) expect_identical(sf::st_bbox(as_xy(wk_vertices(sf_obj))), bbox_obj) expect_identical(sf::st_bbox(rct(0, 1, 2, 3, crs = 32620)), bbox_obj) expect_identical(sf::st_bbox(crc(1, 2, 1, crs = 32620)), bbox_obj) }) wk/tests/testthat/test-debug.R0000644000176200001440000000656714161345517016110 0ustar liggesusers test_that("debug handlers print messages from the wkt handler", { wkt_good <- as_wkt( c( NA, "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ) expect_output( wk_handle(wkt_good, wk_debug_filter()), "null_feature.*?POINT.*?LINESTRING.*?POLYGON.*?MULTIPOINT.*?MULTILINESTRING.*?MULTIPOLYGON.*?GEOMETRYCOLLECTION.*?POINT.*?LINESTRING" ) wkt_bad <- new_wk_wkt("NOT WKT") expect_error( expect_output( wk_handle(wkt_bad, wk_debug_filter()), "Expected geometry type or 'SRID='" ), "Expected geometry type or 'SRID='" ) }) test_that("debug handlers print messages from the wkb handler", { wkb_good <- as_wkb( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ) expect_output( wk_handle(wkb_good, wk_debug_filter()), "POINT.*?LINESTRING.*?POLYGON.*?MULTIPOINT.*?MULTILINESTRING.*?MULTIPOLYGON.*?GEOMETRYCOLLECTION.*?POINT.*?LINESTRING" ) wkb_bad <- unclass(wkb_good[1]) wkb_bad[[1]][2:3] <- as.raw(0xff) expect_error( expect_output( wk_handle(new_wk_wkb(wkb_bad), wk_debug_filter()), "Unrecognized geometry type code" ) ) }) test_that("vector attributes are printed by wk_debug()", { skip_if_not_installed("sf") # sfc is currently the only handler that has vector types, dims, and WK_ABORT expect_output(wk_debug(sf::st_sfc(sf::st_point())), "POINT B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_linestring())), "LINESTRING B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_polygon())), "POLYGON B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_multipoint())), "MULTIPOINT B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_multilinestring())), "MULTILINESTRING B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_multipolygon())), "MULTIPOLYGON B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_geometrycollection())), "GEOMETRYCOLLECTION B\\[1\\]") expect_output(wk_debug(sf::st_sfc(sf::st_point(c(1, 2, 3, 4)))), "POINT ZMB.*?POINT ZM") expect_output(wk_debug(sf::st_sfc()), "\\[EMPTY\\]") obj <- sf::st_sfc(sf::st_point(c( 1 / 3, 1 / 3))) sf::st_precision(obj) <- 0.01 expect_output(wk_debug(obj), "POINT P\\[1\\]") sf::st_precision(obj) <- 1L expect_output(wk_debug(obj), "POINT P\\[1\\]") attr(obj, "precision") <- NULL expect_output(wk_debug(obj), "POINT\\[1\\]") expect_output(wk_debug(sf::st_as_sfc("POINT (1 2)"), wk_bbox_handler()), "WK_ABORT") }) test_that("wk_debug() prints error information", { expect_output( wk_debug(new_wk_wkt("NOT WKT"), wk_problems_handler()), "=> WK_ABORT_FEATURE" ) }) test_that("wk_debug() runs the debug handler", { expect_identical( expect_output( wk_debug(wkt("POINT (1 2)"), handler = wkb_writer()), "POINT" ), as_wkb("POINT (1 2)") ) }) test_that("wk_debug() works for a vector of indeterminate length", { expect_output( handle_wkt_without_vector_size(wkt(), wk_debug_filter()), "\\[UNKNOWN\\]" ) }) wk/tests/testthat/test-wkt.R0000644000176200001440000000614214163110540015600 0ustar liggesusers test_that("wkt class works", { x <- wkt("POINT (40 10)") expect_s3_class(x, "wk_wkt") expect_s3_class(x, "wk_vctr") expect_true(is_wk_wkt(x)) expect_output(print(x), "wk_wkt") expect_identical(as.character(x), unclass(x)) expect_s3_class(wkt(NA), "wk_wkt") expect_error(new_wk_wkt(structure(character(), thing = "stuff")), "must be a character") expect_error(new_wk_wkt(list()), "must be a character") expect_error(wkt("NOPE"), "Encountered 1 parse problem") expect_error(wkt(rep("NOPE", 10)), "Encountered 10 parse problems") expect_error(validate_wk_wkt(list()), "must be of type character") # See #123...validate_wk_wkt() is used in CRAN s2 on a raw character vector # expect_error(validate_wk_wkt(""), "must inherit from") expect_s3_class(x[1], "wk_wkt") expect_identical(x[[1]], x[1]) expect_s3_class(c(x, x), "wk_wkt") expect_identical(rep(x, 2), c(x, x)) expect_identical(rep(wkt(), 1), wkt()) expect_length(c(x, x), 2) x[1] <- as_wkb("POINT (11 12)") expect_identical(x[1], wkt("POINT (11 12)")) skip_if_not(packageVersion("base") >= "3.6") expect_identical(rep_len(x, 2), c(x, x)) }) test_that("wkt() and parse_wkt() strip attributes", { text <- structure("POINT (40 10)", some_attr = "value") expect_identical(wkt(text), wkt("POINT (40 10)")) expect_identical(parse_wkt(text), wkt("POINT (40 10)")) }) test_that("as_wkt() works", { x <- wkt("POINT (40 10)") expect_identical(as_wkt(x), x) expect_identical(as_wkt("POINT (43 44)"), wkt("POINT (43 44)")) expect_identical(as_wkt(wkb(wkt_translate_wkb("POINT (99 100)"))), wkt("POINT (99 100)")) }) test_that("parse_wkt() works", { x <- "POINT (40 10)" expect_silent(parsed <- parse_wkt(x)) expect_false(is.na(parsed)) expect_null(attr(parsed, "problems")) x <- "POINT ENTPY" expect_warning(parsed <- parse_wkt(x), "Encountered 1 parse problem") expect_true(is.na(parsed)) expect_s3_class(attr(parsed, "problems"), "data.frame") expect_identical(nrow(attr(parsed, "problems")), 1L) }) test_that("wkt() propagates CRS", { x <- wkt("POINT (1 2)") wk_crs(x) <- 1234 expect_identical(wk_crs(x[1]), 1234) expect_identical(wk_crs(c(x, x)), 1234) expect_identical(wk_crs(rep(x, 2)), 1234) expect_error(x[1] <- wkt(x, crs = NULL), "are not equal") x[1] <- wkt(x, crs = 1234L) expect_identical(wk_crs(x), 1234) }) test_that("wkt() propagates geodesic", { x <- wkt("POINT (1 2)", geodesic = TRUE) expect_true(wk_is_geodesic(x)) expect_true(wk_is_geodesic(x[1])) expect_true(wk_is_geodesic(c(x, x))) expect_true(wk_is_geodesic(rep(x, 2))) expect_error(x[1] <- wk_set_geodesic(x, FALSE), "objects have differing values") x[1] <- wk_set_geodesic(x, TRUE) expect_true(wk_is_geodesic(x)) }) test_that("as_wkt() propagates CRS", { x <- as_wkt("POINT (1 2)", crs = 1234) expect_identical(wk_crs(x), 1234) expect_identical(wk_crs(as_wkt(as_wkb(wkt("POINT (1 2)", crs = 1234)))), 1234) }) test_that("as_wkt() propagates geodesic", { x <- as_wkt("POINT (1 2)", geodesic = TRUE) expect_true(wk_is_geodesic(x)) expect_true(wk_is_geodesic(as_wkt(as_wkb(wkt("POINT (1 2)", geodesic = TRUE))))) }) wk/tests/testthat/test-problems.R0000644000176200001440000000457714163200202016623 0ustar liggesusers test_that("wk_problems() reports parsing errors for wkb", { 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(wk_problems(new_wk_wkb(list(point))), NA_character_) expect_match(wk_problems(new_wk_wkb(list(point[1:5]))), "Unexpected end of buffer") point_bad_type <- point point_bad_type[2:3] <- as.raw(0xff) expect_match(wk_problems(new_wk_wkb(list(point_bad_type))), "Unrecognized geometry type code") }) test_that("wk_problems() reports parsing errors for wkt", { expect_identical(wk_problems(new_wk_wkt("POINT (30 10)")), NA_character_) expect_match(wk_problems(new_wk_wkt("sss")), "Expected geometry type or") }) test_that("validating handlers return a character vector of problems", { wkb_good <- wk_handle( new_wk_wkt( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ), wkb_writer(endian = 1L) ) expect_identical( wk_handle(wkb_good, wk_problems_handler()), rep(NA_character_, length(wkb_good)) ) wkb_bad <- unclass(wkb_good) wkb_bad[[1]][3:4] <- as.raw(0xff) problems <- wk_handle(new_wk_wkb(wkb_bad), wk_problems_handler()) expect_match(problems[1], "^Unrecognized geometry type code") expect_identical(problems[-1], c(rep(NA_character_, length(wkb_good) - 1))) }) test_that("validating handlers return a character vector of problems for WKT", { wkt_good <- as_wkt( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ) expect_identical( wk_handle(wkt_good, wk_problems_handler()), rep(NA_character_, length(wkt_good)) ) wkt_bad <- unclass(wkt_good) wkt_bad[1] <- "NOT WKT" expect_identical( wk_handle(new_wk_wkt(wkt_bad), wk_problems_handler()), c("Expected geometry type or 'SRID=' but found 'NOT' at byte 0", rep(NA_character_, length(wkt_good) - 1)) ) }) wk/tests/testthat/test-set.R0000644000176200001440000000276614106220314015574 0ustar liggesusers test_that("wk_set_(z|m)() works", { expect_identical(wk_set_z(wkt("POINT (0 1)"), 2), wkt("POINT Z (0 1 2)")) expect_identical(wk_set_m(wkt("POINT (0 1)"), 2), wkt("POINT M (0 1 2)")) expect_identical(wk_set_z(wkt("POINT M (0 1 3)"), 2), wkt("POINT ZM (0 1 2 3)")) expect_identical(wk_set_m(wkt("POINT Z (0 1 3)"), 2), wkt("POINT ZM (0 1 3 2)")) expect_identical(wk_set_z(wkt("POINT ZM (0 1 2 3)"), 7), wkt("POINT ZM (0 1 7 3)")) expect_identical(wk_set_m(wkt("POINT ZM (0 1 2 3)"), 7), wkt("POINT ZM (0 1 2 7)")) }) test_that("wk_drop_(z|m) works", { expect_identical(wk_drop_z(wkt("POINT ZM (0 1 2 3)")), wkt("POINT M (0 1 3)")) expect_identical(wk_drop_m(wkt("POINT ZM (0 1 2 3)")), wkt("POINT Z (0 1 2)")) }) test_that("wk_trans_set() is vectorized", { expect_identical( wk_handle( rep(wkt("POINT Z (0 0 0)"), 4), wk_transform_filter(wkt_writer(), wk_trans_set(xyz(NA, NA, c(1, 2)), use_z = TRUE)) ), rep(wkt(c("POINT Z (0 0 1)", "POINT Z (0 0 2)")), 2) ) }) test_that("wk_trans_set() can set ZM values at the same time", { expect_identical( wk_handle( wkt("POINT (0 0)"), wk_transform_filter( wkt_writer(), wk_trans_set(xyzm(NA, NA, 1, 2), use_z = TRUE, use_m = TRUE) ) ), wkt("POINT ZM (0 0 1 2)") ) }) test_that("wk_trans_set() can set XY values", { expect_identical( wk_handle( wkt("POINT Z (0 0 0)"), wk_transform_filter(wkt_writer(), wk_trans_set(xy(1, 2))) ), wkt("POINT Z (1 2 0)") ) }) wk/tests/testthat/test-handle-sfc.R0000644000176200001440000001012514106220314016771 0ustar liggesusers test_that("wk_handle.sfc() works", { skip_if_not_installed("sf") expect_identical( wk_handle( sf::st_sfc( sf::st_point(), sf::st_linestring(), sf::st_polygon(), sf::st_multipoint(), sf::st_multilinestring(), sf::st_multipolygon(), sf::st_geometrycollection() ), wkt_writer() ), wkt( c("POINT EMPTY", "LINESTRING EMPTY", "POLYGON EMPTY", "MULTIPOINT EMPTY", "MULTILINESTRING EMPTY", "MULTIPOLYGON EMPTY", "GEOMETRYCOLLECTION EMPTY" ) ) ) expect_identical( wk_handle(sf::st_sfc(sf::st_point(c(1, 2))), wkt_writer()), wkt("POINT (1 2)") ) expect_identical( wk_handle(sf::st_sfc(sf::st_point(c(1, 2, 3))), wkt_writer()), wkt("POINT Z (1 2 3)") ) expect_identical( wk_handle(sf::st_sfc(sf::st_point(c(1, 2, 4), "XYM")), wkt_writer()), wkt("POINT M (1 2 4)") ) expect_identical( wk_handle(sf::st_sfc(sf::st_point(c(1, 2, 3, 4))), wkt_writer()), wkt("POINT ZM (1 2 3 4)") ) expect_identical( wk_handle(sf::st_sfc(sf::st_linestring(rbind(c(1, 2), c(2, 3)))), wkt_writer()), wkt("LINESTRING (1 2, 2 3)") ) expect_identical( wk_handle(sf::st_sfc(sf::st_polygon(list(rbind(c(0, 0), c(1, 0), c(0, 1), c(0, 0))))), wkt_writer()), wkt("POLYGON ((0 0, 1 0, 0 1, 0 0))") ) expect_identical( wk_handle(sf::st_sfc(sf::st_multipoint(rbind(c(1, 2), c(2, 3)))), wkt_writer()), wkt("MULTIPOINT ((1 2), (2 3))") ) expect_identical( wk_handle(sf::st_sfc(sf::st_multilinestring(list(rbind(c(1, 2), c(2, 3))))), wkt_writer()), wkt("MULTILINESTRING ((1 2, 2 3))") ) expect_identical( wk_handle( sf::st_sfc(sf::st_multipolygon(list(list(rbind(c(0, 0), c(1, 0), c(0, 1), c(0, 0)))))), wkt_writer() ), wkt("MULTIPOLYGON (((0 0, 1 0, 0 1, 0 0)))") ) expect_identical( wk_handle(sf::st_sfc(sf::st_geometrycollection(list(sf::st_point(c(1, 2))))), wkt_writer()), wkt("GEOMETRYCOLLECTION (POINT (1 2))") ) }) test_that("wk_handle.sfc() generates same WKB as st_as_binary", { skip_if_not_installed("sf") nc_multipolygon <- sf::read_sf(system.file("shape/nc.shp", package = "sf"))$geometry nc_multilines <- sf::st_boundary(nc_multipolygon) nc_multipoints <- sf::st_cast(nc_multilines, "MULTIPOINT") nc_polygon <- sf::st_cast(nc_multipolygon, "POLYGON") nc_lines <- sf::st_cast(nc_multilines, "LINESTRING") nc_points <- sf::st_cast(nc_lines, "POINT") nc_collection <- sf::st_sfc(sf::st_geometrycollection(nc_multipolygon)) expect_identical( unclass(as_xy(sf::st_coordinates(nc_points))), unclass(wk_handle(nc_points, xy_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_points)), unclass(wk_handle(nc_points, wkb_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_lines)), unclass(wk_handle(nc_lines, wkb_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_polygon)), unclass(wk_handle(nc_polygon, wkb_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_multipoints)), unclass(wk_handle(nc_multipoints, wkb_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_multilines)), unclass(wk_handle(nc_multilines, wkb_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_multipolygon)), unclass(wk_handle(nc_multipolygon, wkb_writer())) ) expect_identical( unclass(sf::st_as_binary(nc_collection)), unclass(wk_handle(nc_collection, wkb_writer())) ) }) test_that("wk_handle.sfc() handles malformed input", { skip_if_not_installed("sf") bad_sfc <- unclass(sf::st_sfc(sf::st_point(c(1, 2)))) class(bad_sfc[[1]]) <- "sfg" expect_error( wk_handle.sfc(bad_sfc, wk_void_handler()), "Can't guess dimensions from class of 'sfg'" ) class(bad_sfc[[1]]) <- c("sfg", "XY") expect_error( wk_handle.sfc(bad_sfc, wk_void_handler()), "Unsupported sfg type" ) class(bad_sfc[[1]]) <- c("not_an_sfg", "XY") expect_error( wk_handle.sfc(bad_sfc, wk_void_handler()), "must inherit from 'sfg'" ) bad_sfc[1] <- list(NULL) expect_identical(wk_handle.sfc(bad_sfc, wkt_writer()), wkt(NA)) }) wk/tests/testthat/test-void.R0000644000176200001440000000366014161345517015752 0ustar liggesusers test_that("void handler can be created", { expect_s3_class(wk_void_handler(), "wk_void_handler") expect_s3_class(wk_void_handler(), "wk_handler") }) test_that("wk_void() does nothing", { expect_null(wk_void(wkt("POINT (1 2)"))) }) test_that("void handlers do nothing", { wkb_good <- wk_handle( new_wk_wkt( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ), wkb_writer(endian = 1L) ) expect_null(wk_handle(wkb_good, wk_void_handler())) wkb_bad <- unclass(wkb_good[1]) wkb_bad[[1]][3:4] <- as.raw(0xff) expect_error(wk_handle(new_wk_wkb(wkb_bad), wk_void_handler()), "Unrecognized geometry type code") }) test_that("void handlers cannot be re-used", { handler <- wk_void_handler() expect_null(wk_handle(as_wkb("POINT (1 1)"), handler)) expect_error(wk_handle(as_wkb("POINT (1 1)"), handler), "Can't re-use this wk_handler") }) test_that("void handlers do nothing when passed to the wkt handler", { wkt_good <- as_wkt( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ) expect_null(wk_handle(wkt_good, wk_void_handler())) wkt_bad <- new_wk_wkt("NOT WKT") expect_error(wk_handle(wkt_bad, wk_void_handler()), "Expected geometry type or 'SRID='") }) test_that("void handlers cannot be re-used when called from C++", { handler <- wk_void_handler() expect_null(wk_handle(as_wkt("POINT (1 1)"), handler)) expect_error(wk_handle(as_wkt("POINT (1 1)"), handler), "Can't re-use this wk_handler") }) wk/tests/testthat/test-filter.R0000644000176200001440000000042714106220314016256 0ustar liggesusers test_that("wk_identity() works", { diverse_wkt <- wkt( c( NA, "POINT EMPTY", "POINT (1 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))" ) ) expect_identical(wk_identity(diverse_wkt), diverse_wkt) expect_error(wk_identity(new_wk_wkt("NOT WKT")), "Expected") }) wk/tests/testthat/test-wk-vctr.R0000644000176200001440000000541714161345517016410 0ustar liggesusers test_that("wk_vctr class works", { x <- structure(1:5, class = "wk_vctr") expect_s3_class(x, "wk_vctr") expect_s3_class(x[1:2], "wk_vctr") expect_identical( c(x, x), structure(c(1:5, 1:5), class = "wk_vctr") ) expect_output(print(x), "wk_vctr") expect_output(print(stats::setNames(x, as.character(1:5))), "wk_vctr") expect_output(print(x[0]), "wk_vctr") expect_output(print(wk_set_crs(x, 1234)), "CRS=EPSG:1234") expect_output(expect_identical(str(x), x), "wk_vctr") expect_output(expect_identical(str(x[0]), x[0]), "wk_vctr\\[0\\]") old_opt <- options(max.print = 1000) expect_output( print(structure(1:1001, class = "wk_vctr")), "Reached max.print" ) options(old_opt) x[[3]] <- 13L expect_identical(unclass(x), c(1L, 2L, 13L, 4L, 5L)) expect_identical( data.frame(col_name = x), new_data_frame(list(col_name = x)) ) expect_error(as.data.frame(x), "cannot coerce") }) test_that("geodesic gets printed for geodesic objects", { x_geod <- wkt("POINT EMPTY", geodesic = TRUE) expect_output(print(x_geod), "geodesic wk_wkt") }) test_that("rep() works for list wk_vctrs", { expect_identical( rep(structure(list(NULL), class = "wk_vctr"), 3), structure(list(NULL, NULL, NULL), class = "wk_vctr") ) expect_identical( rep(structure(list(), class = "wk_vctr"), 3), structure(list(), class = "wk_vctr") ) }) test_that("rep() works for chr wk_vctrs", { expect_identical( rep(structure(NA_character_, class = "wk_vctr"), 3), structure(rep(NA_character_, 3), class = "wk_vctr") ) expect_identical( rep(structure(character(), class = "wk_vctr"), 3), structure(character(), class = "wk_vctr") ) }) test_that("rep_len() works for wk_vctr objects", { skip_if_not(packageVersion("base") >= "3.6") expect_identical( rep_len(structure(list(NULL), class = "wk_vctr"), 3), structure(list(NULL, NULL, NULL), class = "wk_vctr") ) expect_identical( rep_len(structure(list(), class = "wk_vctr"), 3), structure(list(NULL, NULL, NULL), class = "wk_vctr") ) expect_identical( rep_len(structure(NA_character_, class = "wk_vctr"), 3), structure(rep(NA_character_, 3), class = "wk_vctr") ) expect_identical( rep_len(structure(character(), class = "wk_vctr"), 3), structure(rep(NA_character_, 3), class = "wk_vctr") ) }) test_that("c() for wk_vctr handles crs attributes", { expect_identical( wk_crs(c(wkt("POINT (0 1)", crs = wk_crs_inherit()), wkt("POINT (0 2)", crs = 1234))), 1234 ) expect_error( wk_crs(c(wkt("POINT (0 1)"), wkt("POINT (0 2)", crs = 1234))), "are not equal" ) }) test_that("wk_vctr objects with different subclasses can't be combined", { expect_error( c(as_wkt("POINT EMPTY"), as_wkb("POINT EMPTY")), "Can't combine" ) }) wk/tests/testthat/test-translate.R0000644000176200001440000000151114161345517016777 0ustar liggesusers test_that("wk_translate.wkt works", { expect_identical( wk_translate(as_wkb("POINT (1 2)"), wkt()), wkt("POINT (1 2)") ) }) test_that("wkt writing is vectorized", { expect_identical( wkt_translate_wkt(c("POINT (20 20)", "POINT (30 30)")), c("POINT (20 20)", "POINT (30 30)") ) }) test_that("wkb writing is vectorized", { expect_identical( wkt_translate_wkb(c("POINT (20 20)", "POINT (30 30)"), endian = 1L), list( as.raw( c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x34, 0x40 ) ), as.raw( c(0x01, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, 0x40 ) ) ) ) }) wk/tests/testthat/test-affine.R0000644000176200001440000000760214125354157016241 0ustar liggesusers test_that("wk_trans_affine() works", { expect_s3_class(wk_affine_identity(), "wk_trans_affine") expect_output(print(wk_affine_identity()), "wk_trans_affine") expect_equal(format(as.matrix(wk_affine_identity())), format(wk_affine_identity())) }) test_that("wk_trans_affine() errors for invalid matrix", { expect_error(wk_trans_affine(5), "must be a 3x3 matrix") }) test_that("wk_affine_translate() works", { coords <- matrix(c(0, 0, 1, 1, 2, 2, 3, 3), nrow = 2) expect_equal( as.matrix(wk_affine_translate(2, 3)) %*% rbind(coords, 1), rbind(matrix(c(2, 3, 3, 4, 4, 5, 5, 6), nrow = 2), 1) ) }) test_that("wk_affine_rotate() works", { coords <- matrix(c(0, 0, 1, 1, 2, 2, 3, 3), nrow = 2) expect_equal( as.matrix(wk_affine_rotate(45)) %*% rbind(coords, 1), rbind(matrix(c(0, 0, 0, sqrt(2), 0, 2 * sqrt(2), 0, 3 * sqrt(2)), nrow = 2), 1) ) }) test_that("wk_affine_scale() works", { coords <- matrix(c(0, 0, 1, 1, 2, 2, 3, 3), nrow = 2) expect_equal( as.matrix(wk_affine_scale(2, 3)) %*% rbind(coords, 1), rbind(matrix(c(0, 0, 2, 3, 4, 6, 6, 9), nrow = 2), 1) ) }) test_that("wk_affine_rescale() works", { coords <- matrix(c(0, 0, 1, 1, 2, 2, 3, 3), nrow = 2) # make sure we pick an example where the rescale + translate order matters expect_equal( as.matrix(wk_affine_rescale(rct(1, 1, 2, 2), rct(12, 12, 13, 14))) %*% rbind(coords, 1), rbind(matrix(c(11, 11, 12, 13, 13, 15, 14, 17), nrow = 2), 1) ) }) test_that("wk_affine_fit() works", { src <- xy(c(0, 1, 0), c(0, 0, 1)) dst <- xy(c(0, 2, 0), c(0, 0, 3)) expect_equal( as.matrix(wk_affine_fit(src, dst)), as.matrix(wk_affine_scale(2, 3)) ) expect_equal( wk_transform(src, wk_affine_fit(src, dst)), dst ) }) test_that("wk_affine_compose() works", { expect_identical( as.matrix(wk_affine_compose()), as.matrix(wk_affine_identity()) ) comp <- wk_affine_compose( wk_affine_translate(1, 2), wk_affine_translate(3, 4) ) expect_s3_class(comp, "wk_trans_affine") expect_identical(as.matrix(comp), as.matrix(wk_affine_translate(4, 6))) comp <- wk_affine_compose( wk_affine_rotate(12), wk_affine_rotate(13) ) expect_equal(as.matrix(comp), as.matrix(wk_affine_rotate(25))) }) test_that("wk_affine_compose() can combine translation and rotation", { comp <- wk_affine_compose( wk_affine_translate(1, 0), wk_affine_rotate(90) ) comp_inverse <- wk_affine_compose( wk_affine_rotate(-90), wk_affine_translate(-1, 0) ) expect_equal( as.matrix(wk_affine_invert(comp_inverse)), as.matrix(comp) ) # check with actual coordinates coords <- matrix(c(0, 0, 1, 1, 2, 2, 3, 3), nrow = 2) coords1 <- as.matrix(wk_affine_translate(1, 0)) %*% rbind(coords, 1) coords2 <- as.matrix(wk_affine_rotate(90)) %*% coords1 # the first point will be wrong if the order was backward expect_equal( as.matrix(comp) %*% rbind(coords, 1)[, 1], matrix(c(0, 1, 1), ncol = 1) ) expect_equal( as.matrix(comp) %*% rbind(coords, 1), coords2 ) expect_equal( as.matrix(comp_inverse) %*% coords2, rbind(coords, 1) ) }) test_that("wk_affine_inverse() works", { expect_equal( as.matrix(wk_affine_compose(wk_affine_rotate(12), wk_affine_translate(1, 2))), as.matrix( wk_affine_invert( wk_affine_compose(wk_affine_translate(-1, -2), wk_affine_rotate(-12)) ) ) ) expect_equal( as.matrix(wk_affine_invert(wk_affine_translate(1, 2))), as.matrix(wk_trans_inverse(wk_affine_translate(1, 2))) ) }) test_that("wk_transform() works with an affine transformer", { expect_equal( wk_transform( xy(0:3, 0:3), wk_affine_identity() ), xy(0:3, 0:3) ) expect_equal( wk_transform( xy(0:3, 0:3), wk_affine_compose( wk_affine_translate(1, 0), wk_affine_rotate(90) ) ), c(xy(0, 1), xy(-1, 2), xy(-2, 3), xy(-3, 4)) ) }) wk/tests/testthat/test-class-data-frame.R0000644000176200001440000000634514163110540020104 0ustar liggesusers test_that("wk_handle() works for data.frame", { expect_error(wk_handle(data.frame(a = 1)), "must have at least one") expect_identical( wk_handle(data.frame(a = wkt("POINT (0 1)")), wkb_writer()), wk_handle(wkt("POINT (0 1)"), wkb_writer()) ) }) test_that("wk_writer() works for data.frame", { expect_s3_class(wk_writer(data.frame(wkt())), "wk_wkt_writer") expect_error(wk_writer(data.frame(a = 1)), "must have at least one") }) test_that("wk_restore() works for data.frame", { expect_identical( wk_identity(data.frame(a = wkt("POINT (1 2)"))), data.frame(a = wkt("POINT (1 2)")) ) expect_identical( wk_restore(data.frame(a = wkt("POINT (1 2)")), wkt(c("POINT (1 2)", "POINT (3 4)"))), data.frame(a = wkt(c("POINT (1 2)", "POINT (3 4)")), row.names = c("1", "1.1")) ) expect_error( wk_restore(data.frame(a = wkt(rep(NA, 3))), wkt(c("POINT (1 2)", "POINT (3 4)"))), "Can't assign" ) expect_identical( wk_identity(data.frame(a = wkt("POINT (1 2)", crs = 1234))), data.frame(a = wkt("POINT (1 2)", crs = 1234)) ) }) test_that("wk_restore() works for tibble", { expect_identical( wk_identity(tibble::tibble(a = wkt("POINT (1 2)"))), tibble::tibble(a = wkt("POINT (1 2)")) ) expect_identical( wk_identity(tibble::tibble(a = wkt("POINT (1 2)", crs = 1234))), tibble::tibble(a = wkt("POINT (1 2)", crs = 1234)) ) }) test_that("wk_translate() works for data.frame", { expect_identical( wk_translate(as_wkb("POINT (1 2)"), data.frame(a = wkt())), data.frame(a = wkt("POINT (1 2)")) ) expect_identical( wk_translate( tibble::tibble(a = as_wkb("POINT (1 2)")), data.frame(a = wkt()) ), data.frame(a = wkt("POINT (1 2)")) ) expect_identical( wk_translate( data.frame(a = as_wkb("POINT (1 2)")), data.frame(a = wkt()) ), data.frame(a = wkt("POINT (1 2)")) ) }) test_that("wk_translate() works for tibble::tibble()", { expect_identical( wk_translate(as_wkb("POINT (1 2)"), tibble::tibble(a = wkt())), tibble::tibble(a = wkt("POINT (1 2)")) ) expect_identical( wk_translate( tibble::tibble(a = as_wkb("POINT (1 2)")), tibble::tibble(a = wkt()) ), tibble::tibble(a = wkt("POINT (1 2)")) ) expect_identical( wk_translate( data.frame(a = as_wkb("POINT (1 2)")), tibble::tibble(a = wkt()) ), tibble::tibble(a = wkt("POINT (1 2)")) ) }) test_that("wk_handle_slice() works for data.frame", { expect_identical( wk_handle_slice(data.frame(geom = xy(1:5, 1:5)), xy_writer(), 3, 6), xy(3:5, 3:5) ) expect_identical( wk_handle_slice(data.frame(geom = xy(1:5, 1:5)), xy_writer(), 0, 2), xy(1:2, 1:2) ) expect_identical( wk_handle_slice(data.frame(geom = xy(1:5, 1:5)), xy_writer(), 5, 4), xy(crs = NULL) ) }) test_that("wk_crs() and wk_set_crs() work for data.frame", { df <- data.frame(a = wkt("POINT (1 2)", crs = 1234)) expect_identical(wk_crs(df), 1234) expect_identical(wk_crs(wk_set_crs(df, 5678)), 5678) }) test_that("wk_is_geodesic() and wk_set_geodesic() work for data.frame", { df <- data.frame(a = wkt("POINT (1 2)", geodesic = FALSE)) expect_false(wk_is_geodesic(df)) expect_true(wk_is_geodesic(wk_set_geodesic(df, TRUE))) }) wk/tests/testthat/test-handle-slice.R0000644000176200001440000000051214145575672017343 0ustar liggesusers test_that("wk_handle_slice() works", { expect_identical( wk_handle_slice(xy(1:5, 1:5), xy_writer(), 3, 6), xy(3:5, 3:5) ) expect_identical( wk_handle_slice(xy(1:5, 1:5), xy_writer(), 0, 2), xy(1:2, 1:2) ) expect_identical( wk_handle_slice(xy(1:5, 1:5), xy_writer(), 5, 4), xy(crs = NULL) ) }) wk/tests/testthat/test-crc.R0000644000176200001440000000310314106220314015532 0ustar liggesusers test_that("crc class works", { expect_s3_class(crc(), "wk_crc") expect_output(print(crc(1, 2, 3)), "\\[1 2, r = 3\\]") expect_identical(as_crc(crc(1, 2, 3)), crc(1, 2, 3)) expect_identical( as_crc(as.matrix(data.frame(x = 1, y = 2, r = 3))), crc(1, 2, 3) ) expect_identical( as_crc(data.frame(x = 1, y = 2, r = 3)), crc(1, 2, 3) ) expect_identical( as_crc(matrix(1:3, nrow = 1)), crc(1, 2, 3) ) }) test_that("coercion to and from wk* classes works", { expect_s3_class(as_wkt(crc(0, 0, 1)), "wk_wkt") expect_s3_class(as_wkb(crc(0, 0, 1)), "wk_wkb") expect_identical( wk_handle(crc(1, 2, 3), wkt_writer(precision = 2), n_segments = 4), wkt("POLYGON ((4 2, 1 5, -2 2, 1 -1, 4 2))") ) expect_identical( as_wkb(wk_handle(crc(1, 2, 3), wkt_writer(precision = 2), n_segments = 4)), as_wkb("POLYGON ((4 2, 1 5, -2 2, 1 -1, 4 2))") ) # check options for circle resolution + as_wkb/t() prev_opt <- options(wk.crc_n_segments = 4) expect_length( unclass(as_wkb(crc(1, 2, 3)))[[1]], 1 + 4 + 4 + 4 + 5 * 8 * 2 ) options(prev_opt) }) test_that("subset-assign works for crc", { x <- crc(1:2, 2:3, 3:4) x[1] <- crc(NA, NA, NA) expect_identical(x, c(crc(NA, NA, NA), crc(2, 3, 4))) }) test_that("crc() propagates CRS", { x <- crc(1, 2, 3) wk_crs(x) <- 1234 expect_identical(wk_crs(x[1]), 1234) expect_identical(wk_crs(c(x, x)), 1234) expect_identical(wk_crs(rep(x, 2)), 1234) expect_error(x[1] <- wk_set_crs(x, NULL), "are not equal") x[1] <- wk_set_crs(x, 1234L) expect_identical(wk_crs(x), 1234) }) wk/tests/testthat/test-handle-xy.R0000644000176200001440000000152414106220314016661 0ustar liggesusers test_that("wk_handle.wk_xy() works", { expect_identical( wk_handle(xy(c(NA, 2, 3, NA), c(NA, NA, 4, 5)), wkt_writer()), wkt(c("POINT EMPTY", "POINT (2 nan)", "POINT (3 4)", "POINT (nan 5)")) ) expect_identical( wk_handle(xyz(c(NA, 2, 3, NA), c(NA, NA, 4, 5), c(NA, NA, NA, NA)), wkt_writer()), wkt(c("POINT EMPTY", "POINT Z (2 nan nan)", "POINT Z (3 4 nan)", "POINT Z (nan 5 nan)")) ) expect_identical( wk_handle(xym(c(NA, 2, 3, NA), c(NA, NA, 4, 5), c(NA, NA, NA, NA)), wkt_writer()), wkt(c("POINT EMPTY", "POINT M (2 nan nan)", "POINT M (3 4 nan)", "POINT M (nan 5 nan)")) ) expect_identical( wk_handle(xyzm(c(NA, 2, 3, NA), c(NA, NA, 4, 5), c(NA, NA, NA, NA), c(NA, rep(1, 3))), wkt_writer()), wkt(c("POINT EMPTY", "POINT ZM (2 nan nan 1)", "POINT ZM (3 4 nan 1)", "POINT ZM (nan 5 nan 1)")) ) }) wk/tests/testthat/test-handle-wkt.R0000644000176200001440000003361214161345517017047 0ustar liggesusers test_that("basic translation works on non-empty 2D geoms", { expect_identical( wkt_translate_wkt("POINT (30 10)"), "POINT (30 10)" ) expect_identical( wkt_translate_wkt("LINESTRING (30 10, 0 0)"), "LINESTRING (30 10, 0 0)" ) expect_identical( wkt_translate_wkt("POLYGON ((30 10, 0 0, 10 10, 30 10))"), "POLYGON ((30 10, 0 0, 10 10, 30 10))" ) expect_identical( wkt_translate_wkt("POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10), (20 30, 35 35, 30 20, 20 30))"), "POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10), (20 30, 35 35, 30 20, 20 30))" ) expect_identical( wkt_translate_wkt("MULTIPOINT (30 10, 0 0, 10 10)"), "MULTIPOINT ((30 10), (0 0), (10 10))" ) expect_identical( wkt_translate_wkt("MULTIPOINT ((30 10), (0 0), (10 10))"), "MULTIPOINT ((30 10), (0 0), (10 10))" ) expect_identical( wkt_translate_wkt("MULTILINESTRING ((30 10, 0 0), (20 20, 0 0))"), "MULTILINESTRING ((30 10, 0 0), (20 20, 0 0))" ) expect_identical( wkt_translate_wkt("MULTIPOLYGON (((30 10, 0 0, 10 10, 30 10)), ((30 10, 0 0, 10 10, 30 10)))"), "MULTIPOLYGON (((30 10, 0 0, 10 10, 30 10)), ((30 10, 0 0, 10 10, 30 10)))" ) expect_identical( wkt_translate_wkt( "GEOMETRYCOLLECTION (POINT (30 10), GEOMETRYCOLLECTION (POINT (12 6)), LINESTRING (1 2, 3 4))" ), "GEOMETRYCOLLECTION (POINT (30 10), GEOMETRYCOLLECTION (POINT (12 6)), LINESTRING (1 2, 3 4))" ) }) test_that("basic translation works on empty geoms", { expect_identical( wkt_translate_wkt("POINT EMPTY"), "POINT EMPTY" ) expect_identical( wkt_translate_wkt("LINESTRING EMPTY"), "LINESTRING EMPTY" ) expect_identical( wkt_translate_wkt("POLYGON EMPTY"), "POLYGON EMPTY" ) expect_identical( wkt_translate_wkt("MULTIPOINT EMPTY"), "MULTIPOINT EMPTY" ) expect_identical( wkt_translate_wkt("MULTILINESTRING EMPTY"), "MULTILINESTRING EMPTY" ) expect_identical( wkt_translate_wkt("MULTIPOLYGON EMPTY"), "MULTIPOLYGON EMPTY" ) expect_identical( wkt_translate_wkt( "GEOMETRYCOLLECTION EMPTY" ), "GEOMETRYCOLLECTION EMPTY" ) }) test_that("mutli* geometries can contain empties", { expect_identical( wkt_translate_wkt("MULTIPOINT (EMPTY)"), "MULTIPOINT (EMPTY)" ) expect_identical( wkt_translate_wkt("MULTIPOINT (1 1, EMPTY)"), "MULTIPOINT ((1 1), EMPTY)" ) expect_identical( wkt_translate_wkt("MULTIPOINT ((1 1), EMPTY)"), "MULTIPOINT ((1 1), EMPTY)" ) expect_identical( wkt_translate_wkt("MULTILINESTRING (EMPTY)"), "MULTILINESTRING (EMPTY)" ) expect_identical( wkt_translate_wkt("MULTILINESTRING ((1 1, 2 4), EMPTY)"), "MULTILINESTRING ((1 1, 2 4), EMPTY)" ) expect_identical( wkt_translate_wkt("MULTIPOLYGON (((1 1, 2 4, 3 6)), EMPTY)"), "MULTIPOLYGON (((1 1, 2 4, 3 6)), EMPTY)" ) expect_identical( wkt_translate_wkt("MULTIPOLYGON (EMPTY)"), "MULTIPOLYGON (EMPTY)" ) }) test_that("Z, ZM, and M prefixes are parsed", { expect_identical( wkt_translate_wkt("POINT (30 10)"), "POINT (30 10)" ) expect_identical( wkt_translate_wkt("POINT Z (30 10 1)"), "POINT Z (30 10 1)" ) expect_identical( wkt_translate_wkt("POINT M (30 10 1)"), "POINT M (30 10 1)" ) expect_identical( wkt_translate_wkt("POINT ZM (30 10 0 1)"), "POINT ZM (30 10 0 1)" ) }) test_that("SRID prefixes are parsed", { expect_identical( wkt_translate_wkt("SRID=218;POINT (30 10)"), "SRID=218;POINT (30 10)" ) }) test_that("correctly formatted ZM geomteries are translated identically", { expect_identical( wkt_translate_wkt("POINT ZM (30 10 0 1)"), "POINT ZM (30 10 0 1)" ) expect_identical( wkt_translate_wkt("LINESTRING ZM (30 10 0 1, 0 0 2 3)"), "LINESTRING ZM (30 10 0 1, 0 0 2 3)" ) expect_identical( wkt_translate_wkt("POLYGON ZM ((30 10 2 1, 0 0 9 10, 10 10 10 8, 30 10 3 8))"), "POLYGON ZM ((30 10 2 1, 0 0 9 10, 10 10 10 8, 30 10 3 8))" ) expect_identical( wkt_translate_wkt("MULTIPOINT ZM (30 10 32 1, 0 0 2 8, 10 10 1 99)"), "MULTIPOINT ZM ((30 10 32 1), (0 0 2 8), (10 10 1 99))" ) expect_identical( wkt_translate_wkt("MULTIPOINT ZM ((30 10 32 1), (0 0 2 8), (10 10 1 99))"), "MULTIPOINT ZM ((30 10 32 1), (0 0 2 8), (10 10 1 99))" ) expect_identical( wkt_translate_wkt("MULTILINESTRING ZM ((30 10 2 1, 0 0 2 8), (20 20 1 1, 0 0 2 2))"), "MULTILINESTRING ZM ((30 10 2 1, 0 0 2 8), (20 20 1 1, 0 0 2 2))" ) expect_identical( wkt_translate_wkt("MULTIPOLYGON ZM (((30 10 1 3, 0 0 9 1, 10 10 5 9, 30 10 1 2)))"), "MULTIPOLYGON ZM (((30 10 1 3, 0 0 9 1, 10 10 5 9, 30 10 1 2)))" ) expect_identical( wkt_translate_wkt("GEOMETRYCOLLECTION (POINT ZM (30 10 1 2))"), "GEOMETRYCOLLECTION (POINT ZM (30 10 1 2))" ) }) test_that("wkt_translate_wkb() works on NA", { expect_identical(wkt_translate_wkb(NA_character_), list(NULL)) }) test_that("wkt_translate_wkb() works on empty points", { expect_identical( wkb_translate_wkt(wkt_translate_wkb("POINT EMPTY")), "POINT (nan nan)" ) }) test_that("wkt_translate_wkb() 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(wkt_translate_wkb("POINT (30 10)", endian = 1L), list(point)) expect_identical( wkt_translate_wkb("LINESTRING (30 10, 12 42)", endian = 1L), list(linestring) ) expect_identical( wkt_translate_wkb( "POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10), (20 30, 35 35, 30 20, 20 30))", endian = 1L ), list(polygon) ) }) test_that("wkt_translate_wkb() 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)) expect_identical( wkt_translate_wkb("MULTIPOINT ((10 40), (40 30), (20 20), (30 10))", endian = 1L), list(multipoint) ) }) test_that("wkt_translate_wkb() 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(wkt_translate_wkb(wkt, endian = 1L), list(collection)) }) test_that("wkt_translate_* has reasonable error messages", { # one or more of these expectations fail on CRAN MacOS for R 3.6.2 # I can't replicate the check failure using a fresh install # of R 3.6.2 on MacOS Mojave, but as all of these functions # are intended to error anyway, I am skipping this check on # CRAN for that platform (with the danger that the errors # that are given are less informative than intended). is_macos <- Sys.info()["sysname"] == "Darwin" is_old_rel <- packageVersion("base") < "4.0.0" is_cran <- !identical(Sys.getenv("NOT_CRAN"), "true") skip_if(is_macos && is_old_rel && is_cran) # close enough to inf to trigger the parse check expect_error(wkt_translate_wkt("MULTIPOINT (iambic 3)"), "^Expected") expect_error(wkt_translate_wkt(""), "^Expected") expect_error(wkt_translate_wkt("SRID=fish;POINT (30 10)"), "^Expected") expect_error(wkt_translate_wkt("SRID="), "^Expected") expect_error(wkt_translate_wkt("POINT (fish fish)"), "^Expected") expect_error(wkt_translate_wkt("POINT ("), "^Expected") expect_error(wkt_translate_wkt("POINT (3"), "^Expected") expect_error(wkt_translate_wkt("POINT"), "^Expected") expect_error(wkt_translate_wkt("POINT "), "^Expected") expect_error(wkt_translate_wkt("POINT (30 10="), "^Expected") expect_error(wkt_translate_wkt("POINT (30 10)P"), "^Expected") expect_error(wkt_translate_wkt("LINESTRING (30 10, 0 0="), "^Expected") expect_error(wkt_translate_wkt("LINESTRING (30A"), "^Expected") expect_error(wkt_translate_wkt("LINESTRING (30,"), "^Expected") expect_error(wkt_translate_wkt("LINESTRING (30"), "^Expected") expect_error(wkt_translate_wkt("SRID=30A"), "^Expected") expect_error(wkt_translate_wkt("SRID"), "^Expected") expect_error( wkt_translate_wkt(strrep("a", 4096)), "Expected a value with fewer than 4096 character" ) }) test_that("wkt_translate_* can handle non-finite values", { expect_identical(wkt_translate_wkt("MULTIPOINT (nan nan)"), "MULTIPOINT ((nan nan))") }) test_that("wkt_translate_* doesn't segfault on other inputs", { expect_error(wkt_translate_wkt(as_wkb("POINT (30 10)")), "must be a character vector") }) wk/tests/testthat/test-format.R0000644000176200001440000000331714163200166016270 0ustar liggesusers test_that("format() works for wkt", { expect_identical( wk_format(wkt("LINESTRING (0 1, 2 3, 4 5, 6 7, 8 9)"), max_coords = 3), "LINESTRING (0 1, 2 3, 4 5..." ) expect_identical( wk_format(wkt("LINESTRING (0 1, 2 3, 4 5, 6 7, 8 9)"), max_coords = 10), "LINESTRING (0 1, 2 3, 4 5, 6 7, 8 9)" ) expect_identical(wk_format(wkt(NA_character_)), "") }) test_that("format() works for wkb", { expect_identical( wk_format(as_wkb("LINESTRING (0 1, 2 3, 4 5, 6 7, 8 9)"), max_coords = 3), "LINESTRING (0 1, 2 3, 4 5..." ) expect_identical( wk_format(as_wkb("LINESTRING (0 1, 2 3, 4 5, 6 7, 8 9)"), max_coords = 10), "LINESTRING (0 1, 2 3, 4 5, 6 7, 8 9)" ) expect_identical(wk_format(wkb(list(NULL))), "") }) test_that("format() handles errors", { bad_wkb <- unclass(wk_handle(new_wk_wkt("POINT (30 10)"), wkb_writer(endian = 1L))) bad_wkb[[1]][3:4] <- as.raw(0xff) expect_match(wk_format(new_wk_wkb(bad_wkb)), "!!!") expect_match(wk_format(new_wk_wkt("POINT ENTPY")), "!!!") }) test_that("format handlers return abbreviated WKT", { expect_identical( wk_handle( new_wk_wkt(c(NA, "LINESTRING (0 1, 1 2)", "LINESTRING (0 1, 2 3, 4 5)", "NOT WKT")), wkt_format_handler(max_coords = 3) ), c( "", "LINESTRING (0 1, 1 2)", "LINESTRING (0 1, 2 3, 4 5...", "!!! Expected geometry type or 'SRID=' but found 'NOT' at byte 0" ) ) }) test_that("wkt_format_handler() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( handle_wkt_without_vector_size(long_xy, wkt_format_handler()), wk_handle(long_xy, wkt_format_handler()) ) }) wk/tests/testthat/test-wkb-writer.R0000644000176200001440000000732214161345517017105 0ustar liggesusers test_that("wkb_writer() works", { wkb_good <- wk_handle( new_wk_wkt( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ), wkb_writer(endian = 1L) ) expect_identical( wk_handle(wkb_good, wkb_writer(endian = 1L)), wkb_good ) wkb_bad <- unclass(wkb_good[1]) wkb_bad[[1]][3:4] <- as.raw(0xff) expect_error(wk_handle(new_wk_wkb(wkb_bad), wkb_writer()), "Unrecognized geometry type code") }) test_that("wkb_writer() can generate swapped endian", { wkb_system <- wk_handle(wkt("LINESTRING (1 2, 3 4)"), wkb_writer(endian = NA)) wkb_le <- wk_handle(wkt("LINESTRING (1 2, 3 4)"), wkb_writer(endian = 1)) wkb_be <- wk_handle(wkt("LINESTRING (1 2, 3 4)"), wkb_writer(endian = 0)) expect_identical(as_wkt(wkb_system), wkt("LINESTRING (1 2, 3 4)")) expect_identical(as_wkt(wkb_le), wkt("LINESTRING (1 2, 3 4)")) expect_identical(as_wkt(wkb_be), wkt("LINESTRING (1 2, 3 4)")) expect_false(identical(wkb_be, wkb_le)) expect_identical( wkb_be, # dput(geos::geos_write_wkb("LINESTRING (1 2, 3 4)", endian = 0)) structure( list( as.raw( c(0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x02, 0x3f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ) ) ), class = c("wk_wkb", "wk_vctr") ) ) expect_identical( wkb_le, # dput(geos::geos_write_wkb("LINESTRING (1 2, 3 4)", endian = 1)) structure( list( as.raw( c(0x01, 0x02, 0x00, 0x00, 0x00, 0x02, 0x00, 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 ) ) ), class = c("wk_wkb", "wk_vctr") ) ) }) test_that("wkb_writer() reallocates its buffer as needed", { expect_identical( wk_handle(wkt("POINT (1 2)"), wkb_writer(buffer_size = 0)), wk_handle(wkt("POINT (1 2)"), wkb_writer(buffer_size = 1024)) ) }) test_that("wkb_writer() works with streaming input", { wkb_good <- as_wkb( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ) expect_identical( wk_handle(as_wkt(wkb_good), wkb_writer()), wkb_good ) }) test_that("wkb_writer() errors when the recursion limit is too high", { make_really_recursive_geom <- function(n) { wkt(paste0( c(rep("GEOMETRYCOLLECTION (", n), "POLYGON ((0 1))", rep(")", n)), collapse = "" )) } # errors in geometry_start expect_error( wk_handle(make_really_recursive_geom(31), wkb_writer()), "Can't write WKB with maximum" ) # errors in ring_start expect_error( wk_handle(make_really_recursive_geom(32), wkb_writer()), "Can't write WKB with maximum" ) }) test_that("wkb_writer() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( handle_wkt_without_vector_size(long_xy, wkb_writer()), wk_handle(long_xy, wkb_writer()) ) }) wk/tests/testthat/test-sfc-writer.R0000644000176200001440000003040314106220314017053 0ustar liggesusers test_that("sfc_writer() works with fixed-length input", { skip_if_not_installed("sf") # zero-length expect_identical(wk_handle(wkb(), sfc_writer()), sf::st_sfc()) # empties (equal because of NaN/NA difference for POINT) expect_equal( wk_handle( as_wkb( c("POINT EMPTY", "LINESTRING EMPTY", "POLYGON EMPTY", "MULTIPOINT EMPTY", "MULTILINESTRING EMPTY", "MULTIPOLYGON EMPTY", "GEOMETRYCOLLECTION EMPTY" ) ), sfc_writer() ), sf::st_sfc( sf::st_point(), sf::st_linestring(), sf::st_polygon(), sf::st_multipoint(), sf::st_multilinestring(), sf::st_multipolygon(), sf::st_geometrycollection() ) ) # subtely different for WKT, since a point will fire zero coordinates # whereas for WKB it will fire (NaN, NaN) expect_equal( wk_handle( as_wkt( c("POINT EMPTY", "LINESTRING EMPTY", "POLYGON EMPTY", "MULTIPOINT EMPTY", "MULTILINESTRING EMPTY", "MULTIPOLYGON EMPTY", "GEOMETRYCOLLECTION EMPTY" ) ), sfc_writer() ), sf::st_sfc( sf::st_point(), sf::st_linestring(), sf::st_polygon(), sf::st_multipoint(), sf::st_multilinestring(), sf::st_multipolygon(), sf::st_geometrycollection() ) ) expect_identical( wk_handle(as_wkb("POINT (1 1)"), sfc_writer()), sf::st_sfc(sf::st_point(c(1, 1))) ) expect_identical( wk_handle(as_wkb("LINESTRING (1 2, 3 4)"), sfc_writer()), sf::st_sfc(sf::st_linestring(rbind(c(1, 2), c(3, 4)))) ) expect_identical( wk_handle(as_wkb("POLYGON ((0 0, 0 1, 1 0, 0 0))"), sfc_writer()), sf::st_sfc(sf::st_polygon(list(rbind(c(0, 0), c(0, 1), c(1, 0), c(0, 0))))) ) expect_identical( wk_handle(as_wkb("MULTIPOINT ((1 2), (3 4))"), sfc_writer()), sf::st_sfc(sf::st_multipoint(rbind(c(1, 2), c(3, 4)))) ) expect_identical( wk_handle(as_wkb("MULTILINESTRING ((1 1, 2 2), (2 2, 3 4))"), sfc_writer()), sf::st_sfc( sf::st_multilinestring( list(rbind(c(1, 1), c(2, 2)), rbind(c(2, 2), c(3, 4))) ) ) ) expect_identical( wk_handle( as_wkb("MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -2, -1 0, 0 0)))"), sfc_writer() ), sf::st_sfc( sf::st_multipolygon( list( list(rbind(c(0, 0), c(0, 1), c(1, 0), c(0, 0))), list(rbind(c(0, 0), c(0, -2), c(-1, 0), c(0, 0))) ) ) ) ) expect_identical( wk_handle(as_wkb("GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))"), sfc_writer()), sf::st_sfc( sf::st_geometrycollection( list( sf::st_point(c(1, 1)), sf::st_linestring(rbind(c(1, 1), c(2, 2))) ) ) ) ) }) test_that("nested points are treated the same as top-level points", { skip_if_not_installed("sf") non_empty_nested <- as_wkt(c("GEOMETRYCOLLECTION (POINT (1 2))", "POINT EMPTY")) empty_nested <- as_wkt(c("GEOMETRYCOLLECTION (POINT EMPTY)", "POINT (1 2)")) expect_identical( sf::st_bbox(wk_handle(non_empty_nested, sfc_writer())), sf::st_bbox(wk_handle(empty_nested, sfc_writer())), ) }) test_that("sfc_writer() turns NULLs into EMPTY", { expect_identical( wk_handle(wkb(list(NULL)), sfc_writer()), wk_handle(wkt("GEOMETRYCOLLECTION EMPTY"), sfc_writer()) ) all_types <- as_wkb( c("POINT EMPTY", "LINESTRING EMPTY", "POLYGON EMPTY", "MULTIPOINT EMPTY", "MULTILINESTRING EMPTY", "MULTIPOLYGON EMPTY", "GEOMETRYCOLLECTION EMPTY" ) ) for (i in seq_along(all_types)) { expect_equal( wk_handle(c(all_types[i], wkb(list(NULL))), sfc_writer()), wk_handle(c(all_types[i], all_types[i]), sfc_writer()) ) } expect_identical( wk_handle(c(all_types[1:2], wkb(list(NULL))), sfc_writer()), wk_handle(c(all_types[1:2], as_wkb("GEOMETRYCOLLECTION EMPTY")), sfc_writer()) ) all_types_non_empty <- as_wkb( c( "POINT (1 2)", "LINESTRING (1 2, 3 4)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 2), (3 4))", "MULTILINESTRING ((1 2, 3 4))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -2, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 2))" ) ) types <- c( "POINT", "LINESTRING", "POLYGON", "MULTIPOINT", "MULTILINESTRING", "MULTIPOLYGON", "GEOMETRYCOLLECTION" ) for (i in seq_along(all_types)) { vec <- wk_handle(c(all_types_non_empty[i], wkb(list(NULL))), sfc_writer()) expect_equal(vec[[2]], wk_handle(all_types[i], sfc_writer())[[1]]) expect_s3_class(vec, paste0("sfc_", types[i])) } # check at least one Z, M, and ZM geometry zm_types <- as_wkb( c("POINT ZM (1 2 3 4)", "POINT Z (1 2 3)", "POINT M (1 2 3)") ) zm_types_empty <- as_wkb( c("POINT ZM EMPTY", "POINT Z EMPTY", "POINT M EMPTY") ) for (i in seq_along(all_types)) { expect_equal( wk_handle(c(zm_types[i], wkb(list(NULL))), sfc_writer()), wk_handle(c(zm_types[i], zm_types_empty[i]), sfc_writer()) ) } }) test_that("sfc_writer() reproduces all basic geometry types for WKB input", { skip_if_not_installed("sf") nc <- sf::read_sf(system.file("shape/nc.shp", package = "sf")) nc_multipolygon <- sf::st_set_crs(nc$geometry, NA) nc_multilines <- sf::st_boundary(nc_multipolygon) nc_multipoints <- sf::st_cast(nc_multilines, "MULTIPOINT") nc_polygon <- sf::st_cast(nc_multipolygon, "POLYGON") nc_lines <- sf::st_cast(nc_multilines, "LINESTRING") nc_points <- sf::st_cast(nc_lines, "POINT") collection_list <- nc_multipolygon attributes(collection_list) <- NULL nc_collection <- sf::st_sfc(sf::st_geometrycollection(collection_list)) attr(nc_multipoints, "ids") <- NULL attr(nc_polygon, "ids") <- NULL attr(nc_lines, "ids") <- NULL attr(nc_points, "ids") <- NULL expect_identical( wk_handle(as_wkb(nc_multipolygon), sfc_writer()), nc_multipolygon ) expect_identical( wk_handle(as_wkb(nc_multilines), sfc_writer()), nc_multilines ) expect_identical( wk_handle(as_wkb(nc_multipoints), sfc_writer()), nc_multipoints ) expect_identical( wk_handle(as_wkb(nc_polygon), sfc_writer()), nc_polygon ) expect_identical( wk_handle(as_wkb(nc_lines), sfc_writer()), nc_lines ) expect_identical( wk_handle(as_wkb(nc_points), sfc_writer()), nc_points ) expect_identical( wk_handle(as_wkb(nc_collection), sfc_writer()), nc_collection ) }) test_that("sfc_writer() reproduces all basic geometry types for WKT input", { skip_if_not_installed("sf") nc <- sf::read_sf(system.file("shape/nc.shp", package = "sf")) nc_multipolygon <- sf::st_set_crs(nc$geometry, NA) nc_multilines <- sf::st_boundary(nc_multipolygon) nc_multipoints <- sf::st_cast(nc_multilines, "MULTIPOINT") nc_polygon <- sf::st_cast(nc_multipolygon, "POLYGON") nc_lines <- sf::st_cast(nc_multilines, "LINESTRING") nc_points <- sf::st_cast(nc_lines, "POINT") collection_list <- nc_multipolygon attributes(collection_list) <- NULL nc_collection <- sf::st_sfc(sf::st_geometrycollection(collection_list)) attr(nc_multipoints, "ids") <- NULL attr(nc_polygon, "ids") <- NULL attr(nc_lines, "ids") <- NULL attr(nc_points, "ids") <- NULL expect_equal( wk_handle(as_wkt(nc_multipolygon), sfc_writer()), nc_multipolygon ) expect_equal( wk_handle(as_wkt(nc_multilines), sfc_writer()), nc_multilines ) expect_equal( wk_handle(as_wkt(nc_multipoints), sfc_writer()), nc_multipoints ) expect_equal( wk_handle(as_wkt(nc_polygon), sfc_writer()), nc_polygon ) expect_equal( wk_handle(as_wkt(nc_lines), sfc_writer()), nc_lines ) expect_equal( wk_handle(as_wkt(nc_points), sfc_writer()), nc_points ) expect_equal( wk_handle(as_wkt(nc_collection), sfc_writer()), nc_collection ) }) test_that("sfc writer works with ZM dimensions", { skip_if_not_installed("sf") expect_identical( wk_handle(wkt(c("POINT ZM (1 2 3 4)", "POINT ZM EMPTY")), sfc_writer()), sf::st_sfc(sf::st_point(c(1, 2, 3, 4)), sf::st_point(rep(NA_real_, 4), dim = "XYZM")) ) expect_identical( wk_handle(wkt(c("POINT Z (1 2 3)", "POINT Z EMPTY")), sfc_writer()), sf::st_sfc(sf::st_point(c(1, 2, 3)), sf::st_point(rep(NA_real_, 3), dim = "XYZ")) ) expect_identical( wk_handle(wkt(c("POINT M (1 2 3)", "POINT M EMPTY")), sfc_writer()), sf::st_sfc(sf::st_point(c(1, 2, 3), dim = "XYM"), sf::st_point(rep(NA_real_, 3), dim = "XYM")) ) expect_identical( wk_handle(wkt(c("LINESTRING ZM (1 2 3 4, 5 6 7 8)", "LINESTRING ZM EMPTY")), sfc_writer()), sf::st_sfc( sf::st_linestring(rbind(c(1, 2, 3, 4), c(5, 6, 7, 8))), sf::st_linestring(matrix(double(), ncol = 4), dim = "XYZM") ) ) expect_identical( wk_handle(wkt(c("LINESTRING Z (1 2 3, 5 6 7)", "LINESTRING Z EMPTY")), sfc_writer()), sf::st_sfc( sf::st_linestring(rbind(c(1, 2, 3), c(5, 6, 7)), dim = "XYZ"), sf::st_linestring(matrix(double(), ncol = 3), dim = "XYZ") ) ) expect_identical( wk_handle(wkt(c("LINESTRING M (1 2 3, 5 6 7)", "LINESTRING M EMPTY")), sfc_writer()), sf::st_sfc( sf::st_linestring(rbind(c(1, 2, 3), c(5, 6, 7)), dim = "XYM"), sf::st_linestring(matrix(double(), ncol = 3), dim = "XYM") ) ) }) test_that("nested geometries have their dimensions checked", { skip_if_not_installed("sf") expect_identical( wk_handle(wkt("GEOMETRYCOLLECTION Z (POINT Z (1 2 3))"), sfc_writer()), sf::st_sfc(sf::st_geometrycollection(list(sf::st_point(c(1, 2, 3), dim = "XYZ")), dims = "XYZ")) ) expect_identical( wk_handle(wkt("GEOMETRYCOLLECTION Z (LINESTRING Z (1 2 3, 4 5 6))"), sfc_writer()), sf::st_sfc( sf::st_geometrycollection( list(sf::st_linestring(rbind(c(1, 2, 3), c(4, 5, 6)), dim = "XYZ")), dims = "XYZ" ) ) ) # note that this is stricter than sf::st_sfc(), which either drops the missing dimension # on the GEOMETRYCOLLECTION (when creating from R) or assigns 0 to the missing dimension # (when creating from WKT) expect_error( wk_handle(wkt("GEOMETRYCOLLECTION Z (POINT (1 1))"), sfc_writer()), "incompatible dimensions" ) expect_error( wk_handle(wkt("GEOMETRYCOLLECTION Z (POINT (1 1))"), sfc_writer()), "incompatible dimensions" ) }) test_that("nested empties result in NA ranges", { skip_if_not_installed("sf") expect_identical( sf::st_bbox(wk_handle(wkt("GEOMETRYCOLLECTION ZM (POINT EMPTY)"), sfc_writer())), sf::st_bbox(sf::st_as_sfc("POINT ZM EMPTY")) ) expect_identical( sf::st_z_range(wk_handle(wkt("GEOMETRYCOLLECTION ZM (POINT EMPTY)"), sfc_writer())), sf::st_z_range(sf::st_as_sfc("POINT ZM EMPTY")) ) expect_identical( sf::st_m_range(wk_handle(wkt("GEOMETRYCOLLECTION ZM (POINT EMPTY)"), sfc_writer())), sf::st_m_range(sf::st_as_sfc("POINT ZM EMPTY")) ) }) test_that("sfc_writer() errors when the recursion limit is too high", { make_really_recursive_geom <- function(n) { wkt(paste0( c(rep("GEOMETRYCOLLECTION (", n), "POLYGON ((0 1))", rep(")", n)), collapse = "" )) } # errors in geometry_start expect_error( wk_handle(make_really_recursive_geom(32), sfc_writer()), "Invalid recursion depth" ) }) test_that("the polygon container is reallocated according to variable-length input", { # because polygons with many holes are hard to generate in test data, this particular # piece of code, which is similar to that that allows variable-length input to # generate MULTI/COLLECTION geoms, is not fired make_really_holy_polygon <- function(n) { wkt(paste0( "POLYGON (", paste0(rep("(0 0, 0 1, 1 0, 0 0)", n), collapse = ", "), ")" )) } expect_s3_class( wk_handle(make_really_holy_polygon(1), sfc_writer()), "sfc_POLYGON" ) expect_s3_class( # default length is 32, so this should cause one realloc wk_handle(make_really_holy_polygon(40), sfc_writer()), "sfc_POLYGON" ) }) test_that("sfc_writer() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( handle_wkt_without_vector_size(long_xy, sfc_writer()), wk_handle(long_xy, sfc_writer()) ) }) test_that("sfc_writer() propagates precision", { skip_if_not_installed("sf") sfc_prec <- sf::st_sfc(sf::st_point(c(1/3, 1/3))) sf::st_precision(sfc_prec) <- 0.01 expect_identical(sf::st_precision(wk_handle(sfc_prec, sfc_writer())), 0.01) }) wk/tests/testthat/Rplots.pdf0000644000176200001440000004405414163207167015671 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20211229214213) /ModDate (D:20211229214213) /Title (R Graphics Output) /Producer (R 4.1.2) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 414 /Filter /FlateDecode >> stream xN0 y 0cN^ $X% &>.IoC'Vn9^t{qz)Gp0\ԠWXbD)'ʽ~^dMYN8*e,kg`Wֺ` ft ʝߓOYٵ۽ś ֖@n! =iҳ9$}3 .rEVHK8#7٭L1EH-q*nR?}5ˍ7MWG?9я!KRD1E3y&p>WUDC2=0vhP cGc)j=:aV!oVy<$LΝUyxmKs_N#endstream endobj 9 0 obj << /Type /Page /Parent 3 0 R /Contents 10 0 R /Resources 4 0 R >> endobj 10 0 obj << /Length 418 /Filter /FlateDecode >> stream xTN0 +|NHJBL;] *&mb%50,ana CH `$a5 掐~nt6t@Y:%A!`Gg#r6XxoM5o;l+/6?l~X v/ȯ5a ipF:~ŧլ ^TM}%ЮxtmBOjzFhvDe=6XxC,|# z~O*1EH-qI5G)}{ܸIy"?> endobj 12 0 obj << /Length 450 /Filter /FlateDecode >> stream xTMo0 WƊ2%ۀEO"hd9hIɂ xz|#-`[85hbt;~>/17d5zc‹!Xɵ5ૉl(th[Za坼6wʟ)*0jBio?; ȡ8;[is_=SN9Q{jwޞ]gy`9OXy'WXyMM}cc $#õ];A_Uya3<ݯEB4-qsps_g@rE[>bqzL)c6"U9 NNI:9TkfVd]u2 f.іMԮd1|LhK%;EӒ-ʫ/նS/k)endstream endobj 13 0 obj << /Type /Page /Parent 3 0 R /Contents 14 0 R /Resources 4 0 R >> endobj 14 0 obj << /Length 336 /Filter /FlateDecode >> stream xSN0+\k+@Ri$BTz'vC8g/a{~ #: &E Շt?l6Ơ\G= 0g>YI`?ݠmX̼m'yl'r2?RÉYzYfi2kG-FQoa1I=?_m#5]y/m\9 N[#7y_>Oz[y|O[_V_|St¤c0dݠ܊wrǡ1/WŲiZz7;!/ΝS%eJ}endstream endobj 15 0 obj << /Type /Page /Parent 3 0 R /Contents 16 0 R /Resources 4 0 R >> endobj 16 0 obj << /Length 411 /Filter /FlateDecode >> stream xAK1sԃdv6{mQAP.xOUb ڃM*.}6k` ޡ E@Hep-a lww9X\܄_>#Xx2W6Ŧ6 <(U䁒:䂓,]2Opg-“qPG|OO_Ov[mC hvW t ڜﮛS7fvS1ԭǻwԨ6ڷ'Toqe<L*dd[y#޹آ=dN9($ Of>~(QLB*>RBFULQT؍JvVkڅ9GU0ĐK,KNNk8cjSWY*dmф(w6endstream endobj 17 0 obj << /Type /Page /Parent 3 0 R /Contents 18 0 R /Resources 4 0 R >> endobj 18 0 obj << /Length 411 /Filter /FlateDecode >> stream xAK1sԃdv6{mQAP.xOUb ڃM*.}6k` ޡ E@Hep-a lww9X\܄_>#Xx2W6Ŧ6 <(U䁒:䂓,]2Opg-“qPG|OO_Ov[mC hvW t ڜﮛS7fvS1ԭǻwԨ6ڷ'Toqe<L*dd[y#޹آ=dN9($ Of>~(QLB*>RBFULQT؍JvVkڅ9GU0ĐK,KNNk8cjSWY*dmф(w6endstream endobj 19 0 obj << /Type /Page /Parent 3 0 R /Contents 20 0 R /Resources 4 0 R >> endobj 20 0 obj << /Length 501 /Filter /FlateDecode >> stream xU1+ꨂJu΢‚:  :ߤIC0ͼ奚l@p(BOy9۽hFo`!K<>QPpqŸA/{%+8Rxwb†#_`7W~79s·'s\]  y7k4ƭW3;[zd_vxZݺFյ%1䜜4(|`/hXPeiyB+<^aÏ.hXy9 +mc!`tUSr^r&щT_Nr.Pu\+U?䥉("8 |LwmMvĚ}E%\]M`vo.TĀI}2&qu*:̳Gʧc-h^{]F:Z΃3Zֽ׺T}0ksԭm[:[)q0endstream endobj 21 0 obj << /Type /Page /Parent 3 0 R /Contents 22 0 R /Resources 4 0 R >> endobj 22 0 obj << /Length 529 /Filter /FlateDecode >> stream xTMo1WL=޽J DzZPD+㏄5]7o{ Ë -C LɁO9|x w[cZ {{Y),|7 ed#[.(FtdGZa|F^aiuv/3gs8w@(%)Otoz y[c_{W;iHMOW`ծ.9 d 3? ;yG^a5acwCKN0E \;?'sQggUu0,⪗Bf9 AVSfyZ9{*N`pfHg1X] pNuu-SєmյTT<3m/- qvBQeq)'ڊ\Y(Ӵv5ض6r+uv;BgȮٓlX:lV9ϋ7nfE?bVxkH+*ޚ[yKcݹÍ Pa$endstream endobj 23 0 obj << /Type /Page /Parent 3 0 R /Contents 24 0 R /Resources 4 0 R >> endobj 24 0 obj << /Length 404 /Filter /FlateDecode >> stream xAK1sԃdv6{mQAP.xOUb ڃM*.} /oCpkx7MVu(B-k gm|vwsX,Ek-M6i“! \NPlZa|oBѸJI,E'9❋-Ac2O4nь8$Bc1*)$ZkTΤJݨtjwᣰZ+U.9Jǀ'<bYvt,_{QʝϮ\0_&0+endstream endobj 25 0 obj << /Type /Page /Parent 3 0 R /Contents 26 0 R /Resources 4 0 R >> endobj 26 0 obj << /Length 404 /Filter /FlateDecode >> stream xAK1sԃdv6{mQAP.xOUb ڃM*.} /oCpkx7MVu(B-k gm|vwsX,Ek-M6i“! \NPlZa|oBѸJI,E'9❋-Ac2O4nь8$Bc1*)$ZkTΤJݨtjwᣰZ+U.9Jǀ'<bYvt,_{QʝϮ\0_&0+endstream endobj 27 0 obj << /Type /Page /Parent 3 0 R /Contents 28 0 R /Resources 4 0 R >> endobj 28 0 obj << /Length 651 /Filter /FlateDecode >> stream xUM1 ϯd|+@Z J*v>dRUμTfX&'(ޔTU|q]*Wž=D|q*>lUSh/-PaY|?znNՙngzV\L*PJ5J[bW%8 &|s1X3}m H0G1#7闂h&,H6:ɠjyGt%=*̫/n|s-Ԥژ^a$YR|.!y.h^++_k2-#6&q4ϭ8kmo1H"?>Z[gl^;$ѓGڵG> endobj 30 0 obj << /Length 363 /Filter /FlateDecode >> stream xMK1sԃdk *Rl7dt)K+gߝɛlf@7(BxBϰi_R Qk y1}O ,+E Ƃs5 E~r9Q YYn,<9tWɃ_N ~ܨ8 )P;&ڬP_CRfwlñ/mD jnSj%<'%ZFÄSR gY8Kų,܈yv:^uWMz>`pCI}VwvƸb0wvO{Ӕě6tR4t3&??w*/pį&/ endstream endobj 31 0 obj << /Type /Page /Parent 3 0 R /Contents 32 0 R /Resources 4 0 R >> endobj 32 0 obj << /Length 6831 /Filter /FlateDecode >> stream x\ˮ-qdmMrj# `  I` `}. Rf\UuG<~|_c?Kѣ?g}Q_{?OO{,'ß~o?~9~͵ l+ڳWՂ-|+>y~AԒG,[∿u*Nbz-}z-]O}{?\{ۭ߼mbO< )Ÿo߼g71yA-Yߔoj_tcTш/z]Fp^-_Wm\qzeP] Sx"+׷qwz0xocϭn=/fcx_~2~l* p*BGՌUS~Z)p~XK<="q}0#q{^8\}~xKwzyh%}xdO~z98&0\au?-S5SZ}IbXƧ Wc j55S+x{38MO2q~p~c|m6?8?a۴ ոyH^rTƟ `w>RQ[Q#ԺWYscS[Fawbw޴^`߅'$Aobqߓ^)Xۋ-,L/o V.e$}H/w "B[|RpS0ZFGӾoPF~&yKŀ>5|_Kڸ=hy'E:3=̢01UIU5y~AK^0|]WYҐ\
    Z-}oO`WkO|(ڗswz|ຈ?!m5ɐ_ƐMÞp=Smٿkn>?l\O:x"S_[:.wG}o:6,pΖr~*6QŸ~Ib|_(uĴGp~6?'~<ܟx?];e?O=zCX)8|XxE7B:ɾE}I,yLAB1#ŜH5@R?;H{Qp%PT_xq?/Զq}X4}P4$"Y>i6_AC ,1A/='z'YU<)/wbko'păX׼yPTڌKK_8,bwe`7xG^& ~.76AA?̏kGx1fQA~7祿N1܈trKdĔ50-]G?I>*aW}q?5B6JD= *Σ(@]dn\_B~j{hv]?J,, E l7ep|+⥫V"M */{ Q7u3~ĦbM!%ăX$ CtƎW~OE8 [I7? ЏBG%}I>=7P|>$LߐS dE([̗%6۞FBbx#Tf&1gRhr~8-c2c'C'e|!P?gi>!|Uj3?J 3o 3k^aE=tiye~1ou4u3!wH#,c.~`TZ~/{"#% \ϡ>;Ŝst t`wߔb/}Kcy?itl_'fh' FGCZ2?Z"V+5hُĐ4VA2lsgQIVX?I y~"XV fH|:HERG[g>T5?p(Sc$i R@3H~*=h?4u%ZL1 8`ٗi|o~y  y/8 ^N~?X=H|fZ p'}BaϚ`]:O( 5P盎l]G`B+eQd_OVcw= n~"y(OA3xĊ?Wc"?P<AA G8Y<@;h 7EDhKb<6ٳ$Q3!OqC6sF|Yg?\[ʇYXae2&{d9"!v/_nol-' ʁ{q̬ "& LDn辷cTYUTk`UPdI&6aV|n jd"*'ӼLo]lr":k v(b6@8; T܊E]0DVoO`loXX?+`M^;9nOd.8R ՛pPSC1C 웍7qζVvU0tqCd|ӏq}z1EkUZ>?] CeoN7֥#an;zP@mBzޠ xXBKDEb˪~[qP/jE4 [%RlgΊ um~=} )qJ=};)yyS8r)5EЁ/D__.A7 z@y6yͻh'x~;A`?͸"Tޯeq u▌kΫ(U:Nɸtx ݠ(.G8Qq;Oq=%O B;o<]yɃ:%H|-q$pރuӇ)N*w1f^W2C)c_do7"Wx9HW*/VܬOy-q乗Z/ΛKWg3/6/Pj~go{ XɳxVLG-oϺk`0y`ɃxlW Y!^XqxxxL6q(uΫPLPgib6mml [nnU#9Cvؐ=ߩF4{tOo9r/z%ap muv [~;FI},"ipe):~ՑjBXvxV:bU,[.`}:nI#v)RZu"rloV/"O:Iø*2.TG1b_u4P;y St(r:kq mvd@zԱME7}-;ݱMW:u#QG:Σ>v0ر̩ÞV xLzB@߯8X }9 ȴ{N<dCsb֣ "x j"L'&螁e4YĀ&><k"L:vWY% 3gBgBe2'D uk'^h큷&j~?,!6qOgfo= @O{JA <4! #W &Ĝ3$&25Dxᡉ/MDPTOT3a5''Fgq:$<£kb] < 'HxhD}&Hx=FCv,!ęD& 5C_S1D]Lw{'Xg0Mx?:t g3ȉAd4C8QHIS&~5,y#up3?&j'*Apq"\OlhgbL}&lv31na7w ˷'k=ԚW=Q^=u&bOW3gb|&Q7gt&Q <gb'~=Q™g=:DzV J/4w8(|@FUI> ݍ!L/¨ R_}҇^q! _l1bCD/>"bĸ>ʼn1_?}|F>endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R 9 0 R 11 0 R 13 0 R 15 0 R 17 0 R 19 0 R 21 0 R 23 0 R 25 0 R 27 0 R 29 0 R 31 0 R ] /Count 13 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 33 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 34 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 33 0 R >> endobj xref 0 35 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000014334 00000 n 0000014501 00000 n 0000014613 00000 n 0000014646 00000 n 0000000212 00000 n 0000000292 00000 n 0000000777 00000 n 0000000858 00000 n 0000001348 00000 n 0000001430 00000 n 0000001952 00000 n 0000002034 00000 n 0000002442 00000 n 0000002524 00000 n 0000003007 00000 n 0000003089 00000 n 0000003572 00000 n 0000003654 00000 n 0000004227 00000 n 0000004309 00000 n 0000004910 00000 n 0000004992 00000 n 0000005468 00000 n 0000005550 00000 n 0000006026 00000 n 0000006108 00000 n 0000006831 00000 n 0000006913 00000 n 0000007348 00000 n 0000007430 00000 n 0000017341 00000 n 0000017599 00000 n trailer << /Size 35 /Info 1 0 R /Root 2 0 R >> startxref 17697 %%EOF wk/tests/testthat/test-plot.R0000644000176200001440000000327514163210157015762 0ustar liggesusers test_that("wk_plot() works for zero-length vectors", { wk_plot(wkt("POINT (0 1)")) expect_identical(wk_plot(wkt(), add = TRUE), wkt()) }) test_that("wk_plot() works for all points", { x <- wkt("POINT (0 1)") expect_identical(wk_plot(x), x) }) test_that("wk_plot() works for all point/multipoints", { x <- wkt("MULTIPOINT (0 1, 2 2)") expect_identical(wk_plot(x), x) }) test_that("wk_plot() works for all linestrings", { x <- wkt("LINESTRING (0 1, 2 2)") expect_identical(wk_plot(x), x) }) test_that("wk_plot() works for all polygons", { x <- wkt("POLYGON ((0 0, 0 1, 1 0, 0 0))") expect_identical(wk_plot(x), x) }) test_that("wk_plot() works for all collections", { x <- wkt("GEOMETRYCOLLECTION(POLYGON ((0 0, 0 1, 1 0, 0 0)))") expect_identical(wk_plot(x), x) }) test_that("wk_plot() recycles args for each feature", { x <- wkt( c("GEOMETRYCOLLECTION(POLYGON ((0 0, 0 1, 1 0, 0 0)), POINT (1 0.4))", "LINESTRING (0 0, 1 1)" ) ) expect_identical(wk_plot(x, col = c("blue", "red"), lty = 1), x) x <- wkt(c("MULTIPOINT (0 1, 2 2)", "POINT (1 0.4)")) expect_identical(wk_plot(x, col = c("blue", "red"), pch = 16), x) }) test_that("wk_plot() errors for geodesic objects", { expect_error(wk_plot(wkt(geodesic = TRUE)), "can't plot geodesic objects") }) test_that("plot methods work", { x <- "LINESTRING (0 0, 1 1)" expect_identical(plot(as_wkt(x)), as_wkt(x)) expect_identical(plot(as_wkb(x)), as_wkb(x)) }) test_that("xy and rect plot methods work", { expect_identical(plot(xy(1:5, 1:5)), xy(1:5, 1:5)) expect_identical(plot(rct(1, 2, 3, 4)), rct(1, 2, 3, 4)) }) test_that("crc plot method works", { expect_identical(plot(crc(1, 2, 3)), crc(1, 2, 3)) }) wk/tests/testthat/test-writer.R0000644000176200001440000000073714106220314016311 0ustar liggesusers test_that("the wk_writer() generic resolves correct handler", { expect_s3_class(wk_writer(wkt()), "wk_wkt_writer") expect_s3_class(wk_writer(wkb()), "wk_wkb_writer") expect_s3_class(wk_writer(xy()), "wk_xy_writer") expect_s3_class(wk_writer(xy(), generic = TRUE), "wk_wkb_writer") expect_s3_class(wk_writer(rct()), "wk_wkb_writer") expect_s3_class(wk_writer(crc()), "wk_wkb_writer") expect_s3_class(wk_writer(structure(list(), class = "sfc")), "wk_sfc_writer") }) wk/tests/testthat/test-wk-crs.R0000644000176200001440000001153214163210157016205 0ustar liggesusers test_that("crs setting and getting works on wk_vctr", { x <- new_wk_wkt() expect_null(wk_crs(x)) x <- wk_set_crs(x, 4326) expect_identical(wk_crs(x), 4326) wk_crs(x) <- 26920 expect_identical(wk_crs(x), 26920) }) test_that("crs setting and getting works on wk_rcrd", { x <- new_wk_xy() expect_null(wk_crs(x)) x <- wk_set_crs(x, 4326) expect_identical(wk_crs(x), 4326) wk_crs(x) <- 26920 expect_identical(wk_crs(x), 26920) }) test_that("geodesic getting and setting works for wkb", { x <- new_wk_wkb() expect_false(wk_is_geodesic(x)) x <- wk_set_geodesic(x, TRUE) expect_true(wk_is_geodesic(x)) wk_is_geodesic(x) <- FALSE expect_false(wk_is_geodesic(x)) expect_null(attr(x, "geodesic")) wk_is_geodesic(x) <- wk_geodesic_inherit() expect_identical(wk_is_geodesic(x), NA) expect_error(wk_set_geodesic(x, "fish"), "must be TRUE, FALSE, or NA") }) test_that("geodesic getting and setting works for wkt", { x <- new_wk_wkt() expect_false(wk_is_geodesic(x)) x <- wk_set_geodesic(x, TRUE) expect_true(wk_is_geodesic(x)) wk_is_geodesic(x) <- FALSE expect_false(wk_is_geodesic(x)) expect_null(attr(x, "geodesic")) wk_is_geodesic(x) <- wk_geodesic_inherit() expect_identical(wk_is_geodesic(x), NA) expect_error(wk_set_geodesic(x, "fish"), "must be TRUE, FALSE, or NA") }) test_that("geodesic setting gives a warning when this isn't supported", { expect_warning(wk_set_geodesic(xy(), TRUE), "for object of class 'wk_xy'") }) test_that("wk_geodesic_output() works", { expect_identical( wk_is_geodesic_output(wkt(geodesic = FALSE), wkt(geodesic = FALSE)), FALSE ) expect_identical( wk_is_geodesic_output(wkt(geodesic = TRUE), wkt(geodesic = TRUE)), TRUE ) expect_identical( wk_is_geodesic_output(wkt(geodesic = wk_geodesic_inherit()), wkt(geodesic = FALSE)), FALSE ) expect_identical( wk_is_geodesic_output(wkt(geodesic = FALSE), wkt(geodesic = wk_geodesic_inherit())), FALSE ) expect_error( wk_is_geodesic_output(wkt(geodesic = TRUE), wkt(geodesic = FALSE)), "differing values" ) expect_error( wk_is_geodesic_output(wkt(geodesic = FALSE), wkt(geodesic = TRUE)), "differing values" ) }) test_that("crs comparison works", { expect_true(wk_crs_equal(NULL, NULL)) expect_false(wk_crs_equal(NULL, "something")) expect_false(wk_crs_equal("something", NULL)) expect_true(wk_crs_equal("something", "something")) expect_false(wk_crs_equal("something", "something_else")) expect_true(wk_crs_equal(1234, 1234L)) expect_true(wk_crs_equal(1234L, 1234)) expect_false(wk_crs_equal(NULL, 1234)) }) test_that("crs output computing works", { x <- wkt("POINT (0 0)", crs = NULL) expect_identical(wk_crs_output(x, x), NULL) expect_identical(wk_crs_output(x, wk_set_crs(x, wk_crs_inherit())), NULL) expect_identical(wk_crs_output(wk_set_crs(x, wk_crs_inherit()), x), NULL) expect_identical( wk_crs_output(wk_set_crs(x, wk_crs_inherit()), wk_set_crs(x, wk_crs_inherit())), wk_crs_inherit() ) expect_identical(wk_crs_output(wk_set_crs(x, 1), wkt()), 1) expect_identical(wk_crs_output(wkt(), wk_set_crs(x, 1)), 1) expect_error(wk_crs_output(wk_set_crs(x, 1), wk_set_crs(x, 2)), "are not equal") }) test_that("crs_proj_definition() works", { expect_identical(wk_crs_proj_definition(NULL), NA_character_) expect_identical(wk_crs_proj_definition(1234), "EPSG:1234") expect_identical(wk_crs_proj_definition(NA_real_), NA_character_) expect_identical(wk_crs_proj_definition(1234L), "EPSG:1234") expect_identical(wk_crs_proj_definition(NA_integer_), NA_character_) expect_identical(wk_crs_proj_definition("EPSG:1234"), "EPSG:1234") expect_identical(wk_crs_proj_definition(NA_character_), NA_character_) }) test_that("wk_crs_longlat() works for common datums", { expect_identical(wk_crs_longlat(), "OGC:CRS84") expect_identical(wk_crs_longlat(wk_crs_inherit()), "OGC:CRS84") expect_identical(wk_crs_longlat("OGC:CRS84"), "OGC:CRS84") expect_identical(wk_crs_longlat("EPSG:4326"), "OGC:CRS84") expect_identical(wk_crs_longlat("WGS84"), "OGC:CRS84") expect_identical(wk_crs_longlat("OGC:CRS83"), "OGC:CRS83") expect_identical(wk_crs_longlat("EPSG:4269"), "OGC:CRS83") expect_identical(wk_crs_longlat("NAD83"), "OGC:CRS83") expect_identical(wk_crs_longlat("OGC:CRS27"), "OGC:CRS27") expect_identical(wk_crs_longlat("EPSG:4267"), "OGC:CRS27") expect_identical(wk_crs_longlat("NAD27"), "OGC:CRS27") expect_identical(wk_crs_longlat(), "OGC:CRS84") expect_identical(wk_crs_longlat(), "OGC:CRS84") expect_identical(wk_crs_longlat(), "OGC:CRS84") expect_identical(wk_crs_longlat(), "OGC:CRS84") expect_error(wk_crs_longlat("not a crs"), "Can't guess authority-compliant") }) test_that("wk_crs_inherit() prints as expected", { expect_match(format(wk_crs_inherit()), "wk_crs_inherit") expect_output(print(wk_crs_inherit()), "wk_crs_inherit") }) wk/tests/testthat/test-utils.R0000644000176200001440000000107314145575672016156 0ustar liggesusers test_that("recycle_common works", { expect_identical(recycle_common(1, 2), list(1, 2)) expect_identical(recycle_common(1, b = 2), list(1, b = 2)) expect_identical(recycle_common(1, 2:4), list(c(1, 1, 1), c(2L, 3L, 4L))) expect_identical(recycle_common(numeric(0), 2), list(numeric(0), numeric(0))) expect_error(recycle_common(numeric(0), 2:4), "Incompatible lengths") }) test_that("is_vector_class works", { expect_true(is_vector_class(1:5)) expect_true(is_vector_class(xy(1:5, 1:5))) expect_false(is_vector_class(structure(list(), class = "fish"))) }) wk/tests/testthat/test-wkt-writer.R0000644000176200001440000000163214106220314017107 0ustar liggesusers test_that("wkt_writer() works", { wkt_good <- as_wkt( c( "POINT (1 1)", "LINESTRING (1 1, 2 2)", "POLYGON ((0 0, 0 1, 1 0, 0 0))", "MULTIPOINT ((1 1))", "MULTILINESTRING ((1 1, 2 2), (2 2, 3 3))", "MULTIPOLYGON (((0 0, 0 1, 1 0, 0 0)), ((0 0, 0 -1, -1 0, 0 0)))", "GEOMETRYCOLLECTION (POINT (1 1), LINESTRING (1 1, 2 2))" ) ) expect_identical( wk_handle(wkt_good, wkt_writer()), wkt_good ) expect_error(wk_handle(new_wk_wkt("NOT WKT"), wkt_writer()), "Expected geometry type or 'SRID") expect_identical( wk_handle(new_wk_wkt("POINT (1 1)"), wkt_writer(precision = 1, trim = FALSE)), wkt("POINT (1.0 1.0)") ) }) test_that("wkt_writer() works for a vector of indeterminate length", { long_xy <- as_wkt(xy(runif(2048), runif(2048))) expect_identical( handle_wkt_without_vector_size(long_xy, wkt_writer()), wk_handle(long_xy, wkt_writer()) ) }) wk/tests/testthat/test-handle-crc.R0000644000176200001440000000321514106220314016767 0ustar liggesusers test_that("wk_handle.wk_crc() works", { expect_identical( wk_handle(crc(1, 2, 3), wkt_writer(precision = 2), n_segments = 4), wkt("POLYGON ((4 2, 1 5, -2 2, 1 -1, 4 2))") ) crc_wkb <- wk_handle(crc(1, 2, 3), wkb_writer(), n_segments = 50L) # endian + type + size + ring size + 51 coords expect_length(unclass(crc_wkb)[[1]], 1 + 4 + 4 + 4 + 51 * 8 * 2) # check vectorization of n_segments crc_wkb2 <- wk_handle(crc(1:5, 2, 3), wkb_writer(), n_segments = 50:54) crc_wkb2_lengths <- vapply(unclass(crc_wkb2), length, integer(1)) expect_equal(crc_wkb2_lengths, 1 + 4 + 4 + 4 + ((51:55) * 8 * 2)) # check emptiness of NA circle expect_identical(as_wkt(crc(NA, NA, NA)), wkt("POLYGON EMPTY")) # check options for circle resolution prev_opt <- options(wk.crc_n_segments = 4) expect_identical( wk_handle(crc(1, 2, 3), wkt_writer(precision = 2)), wkt("POLYGON ((4 2, 1 5, -2 2, 1 -1, 4 2))") ) options(prev_opt) prev_opt <- options(wk.crc_resolution = 100) expect_identical( wk_handle(crc(1, 2, 3), wkt_writer(precision = 2)), wkt("POLYGON ((4 2, 1 5, -2 2, 1 -1, 4 2))") ) options(prev_opt) # check invalid options expect_identical( wk_handle(crc(1, 2, 3), wkt_writer(), n_segments = 0), wk_handle(crc(1, 2, 3), wkt_writer(), n_segments = 4) ) expect_identical( wk_handle(crc(1, 2, 3), wkt_writer(), n_segments = NA), wk_handle(crc(1, 2, 3), wkt_writer(), n_segments = 4) ) expect_error(wk_handle(crc(1, 2, 3), wkt_writer(), n_segments = double()), "must be length 1") # check invalid data expect_error(wk_handle.wk_crc("not a crc", wk_void_handler()), "does not inherit from") }) wk/tests/testthat/test-wkb.R0000644000176200001440000000636214163110540015562 0ustar liggesusers test_that("wkb class works", { x <- wkb(wkt_translate_wkb("POINT (40 10)", endian = 1)) expect_s3_class(x, "wk_wkb") expect_true(is_wk_wkb(x)) expect_s3_class(x, "wk_vctr") expect_output(print(x), "wk_wkb") expect_match(as.character(x), "POINT") expect_s3_class(wkb(list(NULL)), "wk_wkb") expect_true(is.na(wkb(list(NULL)))) expect_error(new_wk_wkb(structure(list(), thing = "stuff")), "must be a list") expect_error(new_wk_wkb("char!"), "must be a list") expect_error(wkb(list("not raw()")), "must be raw") expect_error(wkb(list(raw())), "Encountered 1 parse problem") expect_error(wkb(rep(list(raw()), 10)), "Encountered 10 parse problems") expect_error(validate_wk_wkb("char!"), "must be of type list") # See #123 and revert in dev wk after CRAN release # expect_error(validate_wk_wkb(list()), "must inherit from") expect_s3_class(x[1], "wk_wkb") expect_identical(x[[1]], x[1]) expect_s3_class(c(x, x), "wk_wkb") expect_identical(rep(x, 2), c(x, x)) expect_identical(rep(wkb(), 3), wkb()) expect_length(c(x, x), 2) x[1] <- "POINT (11 12)" expect_identical(as_wkt(x[1]), wkt("POINT (11 12)")) skip_if_not(packageVersion("base") >= "3.6") expect_identical(rep_len(x, 2), c(x, x)) }) test_that("as_wkb() works", { x <- wkb(wkt_translate_wkb("POINT (40 10)")) expect_identical(as_wkb(x), x) expect_identical(as_wkb("POINT (40 10)"), x) expect_identical(as_wkb(wkt("POINT (40 10)")), x) # blob and WKB methods expect_identical( as_wkb(structure(wkt_translate_wkb("POINT (11 12)"), class = "blob")), as_wkb("POINT (11 12)") ) expect_identical( as_wkb(structure(wkt_translate_wkb("POINT (11 12)"), class = "WKB")), as_wkb("POINT (11 12)") ) }) test_that("parse_wkb() works", { x <- wkt_translate_wkb("POINT (40 10)", endian = 1) expect_silent(parsed <- parse_wkb(x)) expect_false(is.na(parsed)) expect_null(attr(parsed, "problems")) x[[1]][2:3] <- as.raw(0xff) expect_warning(parsed <- parse_wkb(x), "Encountered 1 parse problem") expect_true(is.na(parsed)) expect_s3_class(attr(parsed, "problems"), "data.frame") expect_identical(nrow(attr(parsed, "problems")), 1L) }) test_that("wkb() propagates CRS", { x <- as_wkb("POINT (1 2)") wk_crs(x) <- 1234 expect_identical(wk_crs(x[1]), 1234) expect_identical(wk_crs(c(x, x)), 1234) expect_identical(wk_crs(rep(x, 2)), 1234) expect_error(x[1] <- wkb(x, crs = NULL), "are not equal") x[1] <- wkb(x, crs = 1234L) expect_identical(wk_crs(x), 1234) }) test_that("wkb() propagates geodesic", { x <- wkb(as_wkb("POINT (1 2)"), geodesic = TRUE) expect_true(wk_is_geodesic(x)) expect_true(wk_is_geodesic(x[1])) expect_true(wk_is_geodesic(c(x, x))) expect_true(wk_is_geodesic(rep(x, 2))) expect_error(x[1] <- wk_set_geodesic(x, FALSE), "objects have differing values") x[1] <- wk_set_geodesic(x, TRUE) expect_true(wk_is_geodesic(x)) }) test_that("as_wkb() propagates CRS", { x <- as_wkb("POINT (1 2)", crs = 1234) expect_identical(wk_crs(x), 1234) expect_identical(wk_crs(as_wkb(wkt("POINT (1 2)", crs = 1234))), 1234) }) test_that("as_wkb() propagates geodesic", { x <- as_wkb("POINT (1 2)", geodesic = TRUE) expect_true(wk_is_geodesic(x)) expect_true(wk_is_geodesic(as_wkb(wkt("POINT (1 2)", geodesic = TRUE)))) }) wk/tests/testthat/test-pkg-readr.R0000644000176200001440000000114614161345517016662 0ustar liggesusers test_that("readr support for writing columns works", { skip_if_not_installed("readr") x_vctr <- as_wkb(c("POINT (1 2)", "POINT Z (3 4 5)", NA)) expect_identical( readr::output_column(x_vctr), c("POINT (1 2)", "POINT Z (3 4 5)", NA) ) expect_identical( readr::output_column(xy(c(1, 3, NA), c(2, 4, NA))), c("POINT (1 2)", "POINT (3 4)", NA) ) tf <- tempfile() readr::write_csv(data.frame(x_vctr = x_vctr), tf) expect_identical( as.data.frame(readr::read_csv(tf, show_col_types = FALSE)), data.frame(x_vctr = c("POINT (1 2)", "POINT Z (3 4 5)", NA)) ) unlink(tf) }) wk/tests/testthat/test-xyzm.R0000644000176200001440000001750614163175253016024 0ustar liggesusers test_that("wk_xy class works", { expect_s3_class(xy(), "wk_xy") expect_output(print(xy(1, 2)), "\\(1 2\\)") expect_identical(xy_dims(xy()), c("x", "y")) expect_identical(as_xy(xy()), xy()) expect_identical(as_xy(xy(), dims = NULL), xy()) expect_identical(as_xy(xy(), dims = c("x", "y")), xy()) expect_identical(as_xy(xy(), dims = c("x", "y", "z")), xyz()) expect_identical(as_xy(xy(), dims = c("x", "y", "m")), xym()) expect_identical(as_xy(xy(), dims = c("x", "y", "z", "m")), xyzm()) expect_identical(as_xy(xy(1, 2), dims = NULL), xy(1, 2)) expect_identical(as_xy(xy(1, 2), dims = c("x", "y")), xy(1, 2)) expect_identical(as_xy(xy(1, 2), dims = c("x", "y", "z")), xyz(1, 2, NA)) expect_identical(as_xy(xy(1, 2), dims = c("x", "y", "m")), xym(1, 2, NA)) expect_identical(as_xy(xy(1, 2), dims = c("x", "y", "z", "m")), xyzm(1, 2, NA, NA)) }) test_that("wk_xyz class works", { expect_s3_class(xyz(), "wk_xyz") expect_s3_class(xyz(), "wk_xy") expect_output(print(xyz(1, 2, 3)), "Z \\(1 2 3\\)") expect_identical(xy_dims(xyz()), c("x", "y", "z")) expect_identical(as_xy(xyz()), xyz()) expect_identical(as_xy(xyz(), dims = NULL), xyz()) expect_identical(as_xy(xyz(), dims = c("x", "y")), xy()) expect_identical(as_xy(xyz(), dims = c("x", "y", "z")), xyz()) expect_identical(as_xy(xyz(), dims = c("x", "y", "m")), xym()) expect_identical(as_xy(xyz(), dims = c("x", "y", "z", "m")), xyzm()) expect_identical(as_xy(xyz(1, 2, 3), dims = NULL), xyz(1, 2, 3)) expect_identical(as_xy(xyz(1, 2, 3), dims = c("x", "y")), xy(1, 2)) expect_identical(as_xy(xyz(1, 2, 3), dims = c("x", "y", "z")), xyz(1, 2, 3)) expect_identical(as_xy(xyz(1, 2, 3), dims = c("x", "y", "m")), xym(1, 2, NA)) expect_identical(as_xy(xyz(1, 2, 3), dims = c("x", "y", "z", "m")), xyzm(1, 2, 3, NA)) }) test_that("wk_xym class works", { expect_s3_class(xym(), "wk_xym") expect_s3_class(xym(), "wk_xy") expect_output(print(xym(1, 2, 3)), "M \\(1 2 3\\)") expect_identical(xy_dims(xym()), c("x", "y", "m")) expect_identical(as_xy(xym()), xym()) expect_identical(as_xy(xym(), dims = NULL), xym()) expect_identical(as_xy(xym(), dims = c("x", "y")), xy()) expect_identical(as_xy(xym(), dims = c("x", "y", "z")), xyz()) expect_identical(as_xy(xym(), dims = c("x", "y", "m")), xym()) expect_identical(as_xy(xym(), dims = c("x", "y", "z", "m")), xyzm()) expect_identical(as_xy(xym(1, 2, 3), dims = NULL), xym(1, 2, 3)) expect_identical(as_xy(xym(1, 2, 3), dims = c("x", "y")), xy(1, 2)) expect_identical(as_xy(xym(1, 2, 3), dims = c("x", "y", "z")), xyz(1, 2, NA)) expect_identical(as_xy(xym(1, 2, 3), dims = c("x", "y", "m")), xym(1, 2, 3)) expect_identical(as_xy(xym(1, 2, 3), dims = c("x", "y", "z", "m")), xyzm(1, 2, NA, 3)) }) test_that("wk_xyzm class works", { expect_s3_class(xyzm(), "wk_xyzm") expect_s3_class(xyzm(), "wk_xyz") expect_s3_class(xyzm(), "wk_xym") expect_s3_class(xyzm(), "wk_xy") expect_output(print(xyzm(1, 2, 3, 4)), "ZM \\(1 2 3 4\\)") expect_identical(xy_dims(xyzm()), c("x", "y", "z", "m")) expect_identical(as_xy(xyzm()), xyzm()) expect_identical(as_xy(xyzm(), dims = NULL), xyzm()) expect_identical(as_xy(xyzm(), dims = c("x", "y")), xy()) expect_identical(as_xy(xyzm(), dims = c("x", "y", "z")), xyz()) expect_identical(as_xy(xyzm(), dims = c("x", "y", "m")), xym()) expect_identical(as_xy(xyzm(), dims = c("x", "y", "z", "m")), xyzm()) expect_identical(as_xy(xyzm(1, 2, 3, 4), dims = NULL), xyzm(1, 2, 3, 4)) expect_identical(as_xy(xyzm(1, 2, 3, 4), dims = c("x", "y")), xy(1, 2)) expect_identical(as_xy(xyzm(1, 2, 3, 4), dims = c("x", "y", "z")), xyz(1, 2, 3)) expect_identical(as_xy(xyzm(1, 2, 3, 4), dims = c("x", "y", "m")), xym(1, 2, 4)) expect_identical(as_xy(xyzm(1, 2, 3, 4), dims = c("x", "y", "z", "m")), xyzm(1, 2, 3, 4)) }) test_that("wk_xy* are vctrs", { expect_true(vctrs::vec_is(xy())) expect_true(vctrs::vec_is(xyz())) expect_true(vctrs::vec_is(xym())) expect_true(vctrs::vec_is(xyzm())) }) test_that("wk_xy* vectors can be constructed from matrices/data.frames", { expect_identical(as_xy(data.frame(x = 1, y = 2, z = 3, m = 4), dims = NULL), xyzm(1, 2, 3, 4)) expect_identical(as_xy(data.frame(x = 1, y = 2, z = 3, m = 4), dims = c("x", "y")), xy(1, 2)) expect_identical(as_xy(data.frame(x = 1, y = 2, z = 3, m = 4), dims = c("x", "y", "z")), xyz(1, 2, 3)) expect_identical(as_xy(data.frame(x = 1, y = 2, z = 3, m = 4), dims = c("x", "y", "m")), xym(1, 2, 4)) expect_identical(as_xy(data.frame(x = 1, y = 2, z = 3, m = 4), dims = c("x", "y", "z", "m")), xyzm(1, 2, 3, 4)) expect_identical(as_xy(data.frame(x = 1, y = 2), dims = NULL), xy(1, 2)) expect_identical(as_xy(data.frame(x = 1, y = 2), dims = c("x", "y")), xy(1, 2)) expect_identical(as_xy(data.frame(x = 1, y = 2), dims = c("x", "y", "z")), xyz(1, 2, NA)) expect_identical(as_xy(data.frame(x = 1, y = 2), dims = c("x", "y", "m")), xym(1, 2, NA)) expect_identical(as_xy(data.frame(x = 1, y = 2), dims = c("x", "y", "z", "m")), xyzm(1, 2, NA, NA)) expect_error(as_xy(data.frame(x = 1, y = 2), dims = "L"), "Unknown dims") expect_identical( as_xy(as.matrix(data.frame(x = 1, y = 2, z = 3, m = 4))), xyzm(1, 2, 3, 4) ) expect_identical( as_xy(matrix(1:2, nrow = 1)), xy(1, 2) ) expect_identical( as_xy(matrix(1:3, nrow = 1)), xyz(1, 2, 3) ) expect_identical( as_xy(matrix(1:4, nrow = 1)), xyzm(1, 2, 3, 4) ) expect_identical( as_xy(matrix(1:2, nrow = 1, dimnames = list(NULL, c("x", "y")))), xy(1, 2) ) expect_identical( as_xy(matrix(1:3, nrow = 1, dimnames = list(NULL, c("x", "y", "m")))), xym(1, 2, 3) ) expect_error(as_xy(matrix(1:10, nrow = 1)), "Can't guess dimensions") weird_matrix <- matrix(1:9, ncol = 3) colnames(weird_matrix) <- c("tim", "suzie", "bill") expect_error(as_xy(weird_matrix), "Can't guess dimensions") colnames(weird_matrix) <- c("x", "y", "bill") expect_identical(as_xy(weird_matrix), xy(1:3, 4:6)) }) test_that("wk_xy* vectors can be created from data.frames with handleable columns", { expect_identical( as_xy(data.frame(geom = xy(1, 2, crs = 1234))), xy(1, 2, crs = 1234) ) expect_error( as_xy(data.frame(geom = xy(1, 2)), crs = 1234), "missing\\(crs\\) is not TRUE" ) expect_identical( as_xy(data.frame(geom = xy(1, 2, crs = 1234)), dims = c("x", "y", "z")), xyz(1, 2, NA, crs = 1234) ) }) test_that("coercion to wk* vectors works", { expect_identical(as_wkt(xy(1, 2)), wkt("POINT (1 2)")) expect_identical(as_wkb(xy(1, 2)), as_wkb("POINT (1 2)")) }) test_that("coercion from wk* vectors works", { expect_identical(as_xy(wkt("POINT (1 2)")), xy(1, 2)) expect_identical(as_xy(wkt("POINT Z (1 2 3)")), xyz(1, 2, 3)) expect_identical(as_xy(wkt("POINT M (1 2 4)")), xym(1, 2, 4)) expect_identical(as_xy(wkt("POINT ZM (1 2 3 4)")), xyzm(1, 2, 3, 4)) expect_identical(as_xy(wkt("POINT (1 2)"), dims = c("x", "y", "z", "m")), xyzm(1, 2, NA, NA)) expect_identical(as_xy(as_wkb("POINT (1 2)")), xy(1, 2)) expect_error(as_xy(wkt("POINT (1 2)"), dims = "L"), "Unknown dims") }) test_that("subset-assign works for wk_xy", { x <- xyzm(1:2, 2, 3, 4) x[2] <- xy(10, 20) expect_identical(x[2], xyzm(10, 20, NA, NA)) x[2:3] <- xy(11:12, 21:22) expect_identical(x[2:3], xyzm(11:12, 21:22, NA, NA)) x[[2]] <- xy(11, 21) expect_identical(x[2], xyzm(11, 21, NA, NA)) }) test_that("xy() propagates CRS", { x <- xy(1, 2) wk_crs(x) <- 1234 expect_identical(wk_crs(x[1]), 1234) expect_identical(wk_crs(c(x, x)), 1234) expect_identical(wk_crs(rep(x, 2)), 1234) expect_error(x[1] <- wk_set_crs(x, NULL), "are not equal") x[1] <- wk_set_crs(x, 1234L) expect_identical(wk_crs(x), 1234) }) test_that("as_xy() works for geodesic objects", { expect_identical(as_xy(wkt("POINT (0 1)", geodesic = TRUE)), xy(0, 1)) expect_identical(as_xy(as_wkb(wkt("POINT (0 1)", geodesic = TRUE))), xy(0, 1)) }) wk/tests/testthat/test-rct.R0000644000176200001440000000236214163110540015563 0ustar liggesusers test_that("rct class works", { expect_s3_class(rct(), "wk_rct") expect_output(print(rct(1, 2, 3, 4)), "\\[1 2 3 4\\]") expect_identical(as_rct(rct(1, 2, 3, 4)), rct(1, 2, 3, 4)) expect_identical( as_rct(as.matrix(data.frame(xmin = 1, ymin = 2, xmax = 3, ymax = 4))), rct(1, 2, 3, 4) ) expect_identical( as_rct(data.frame(xmin = 1, ymin = 2, xmax = 3, ymax = 4)), rct(1, 2, 3, 4) ) expect_identical( as_rct(matrix(1:4, nrow = 1)), rct(1, 2, 3, 4) ) }) test_that("coercion to and from wk* classes works", { expect_identical( as_wkt(rct(1, 2, 3, 4)), wkt("POLYGON ((1 2, 3 2, 3 4, 1 4, 1 2))") ) expect_identical( as_wkb(rct(1, 2, 3, 4)), as_wkb("POLYGON ((1 2, 3 2, 3 4, 1 4, 1 2))") ) }) test_that("subset-assign works for rct", { x <- rct(1:2, 2:3, 3:4, 4:5) x[1] <- rct(NA, NA, NA, NA) expect_identical(x, c(rct(NA, NA, NA, NA), rct(2, 3, 4, 5))) }) test_that("rct() propagates CRS", { x <- rct(1, 2, 3, 4) wk_crs(x) <- 1234 expect_identical(wk_crs(x[1]), 1234) expect_identical(wk_crs(c(x, x)), 1234) expect_identical(wk_crs(rep(x, 2)), 1234) expect_error(x[1] <- wk_set_crs(x, NULL), "are not equal") x[1] <- wk_set_crs(x, 1234L) expect_identical(wk_crs(x), 1234) }) wk/tests/testthat/test-make.R0000644000176200001440000001626414163110540015716 0ustar liggesusers 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() 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_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" ) }) wk/tests/testthat/test-transform.R0000644000176200001440000000204614106220314017003 0ustar liggesusers test_that("wk_transform() works", { geoms <- wkt( c( "POLYGON ((0 0, 0 1, 1 0, 0 0))", "POINT (0 0)", "POINT Z (0 0 0)", "POINT M (0 0 0)", "POINT ZM (0 0 0 0)", NA ) ) expect_identical( wk_transform(geoms, wk_affine_translate(1, 2)), wkt( c( "POLYGON ((1 2, 1 3, 2 2, 1 2))", "POINT (1 2)", "POINT Z (1 2 0)", "POINT M (1 2 0)", "POINT ZM (1 2 0 0)", NA ) ) ) # check error propagation expect_error(wk_transform(new_wk_wkt("POINT ENTPY"), wk_affine_identity()), "ENTPY") }) test_that("wk_transform_filter() errors when the recursion limit is too high", { make_really_recursive_geom <- function(n) { wkt(paste0( c(rep("GEOMETRYCOLLECTION (", n), "POINT (0 1)", rep(")", n)), collapse = "" )) } # errors in geometry_start expect_error( wk_handle( make_really_recursive_geom(32), wk_transform_filter(wk_void_handler(), wk_affine_identity()) ), "Too many recursive levels" ) }) wk/tests/testthat.R0000644000176200001440000000006014106220314014005 0ustar liggesuserslibrary(testthat) library(wk) test_check("wk") wk/src/0000755000176200001440000000000014164566026011474 5ustar liggesuserswk/src/problems-handler.c0000644000176200001440000000720614106220314015062 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include typedef struct { SEXP problems; R_xlen_t feat_id; } wk_problems_handler_t; int wk_problems_handler_vector_start(const wk_vector_meta_t* meta, void* handler_data) { wk_problems_handler_t* data = (wk_problems_handler_t*) handler_data; if (data->problems != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } R_xlen_t n_features; if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { n_features = 1024; } else { n_features = meta->size; } data->problems = PROTECT(Rf_allocVector(STRSXP, n_features)); R_PreserveObject(data->problems); UNPROTECT(1); data->feat_id = 0; return WK_CONTINUE; } int wk_problems_handler_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { wk_problems_handler_t* data = (wk_problems_handler_t*) handler_data; if (feat_id >= Rf_xlength(data->problems)) { SEXP new_result = PROTECT(Rf_allocVector(STRSXP, Rf_xlength(data->problems) * 2 + 1)); for (R_xlen_t i = 0; i < Rf_xlength(data->problems); i++) { SET_STRING_ELT(new_result, i, STRING_ELT(data->problems, i)); } R_ReleaseObject(data->problems); data->problems = new_result; R_PreserveObject(data->problems); UNPROTECT(1); } SET_STRING_ELT(data->problems, data->feat_id, NA_STRING); data->feat_id++; return WK_CONTINUE; } int wk_problems_handler_error(const char* message, void* handler_data) { wk_problems_handler_t* data = (wk_problems_handler_t*) handler_data; SET_STRING_ELT(data->problems, data->feat_id - 1, Rf_mkCharCE(message, CE_UTF8)); return WK_ABORT_FEATURE; } SEXP wk_problems_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { wk_problems_handler_t* data = (wk_problems_handler_t*) handler_data; if (data->feat_id != Rf_xlength(data->problems)) { SEXP new_result = PROTECT(Rf_allocVector(STRSXP, data->feat_id)); for (R_xlen_t i = 0; i < Rf_xlength(new_result); i++) { SET_STRING_ELT(new_result, i, STRING_ELT(data->problems, i)); } R_ReleaseObject(data->problems); data->problems = R_NilValue; UNPROTECT(1); return new_result; } else { return data->problems; } } void wk_problems_handler_deinitialize(void* handler_data) { wk_problems_handler_t* data = (wk_problems_handler_t*) handler_data; if (data->problems != R_NilValue) { R_ReleaseObject(data->problems); data->problems = R_NilValue; } } void wk_problems_handler_finalize(void* handler_data) { wk_problems_handler_t* data = (wk_problems_handler_t*) handler_data; if (data != NULL) { free(data); } } SEXP wk_c_problems_handler_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &wk_problems_handler_vector_start; handler->vector_end = &wk_problems_handler_vector_end; handler->feature_start = &wk_problems_handler_feature_start; handler->error = &wk_problems_handler_error; handler->deinitialize = &wk_problems_handler_deinitialize; handler->finalizer = &wk_problems_handler_finalize; wk_problems_handler_t* data = (wk_problems_handler_t*) malloc(sizeof(wk_problems_handler_t)); if (data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } data->feat_id = 0; data->problems = R_NilValue; SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); handler->handler_data = data; return xptr; } wk/src/handle-crc.c0000644000176200001440000001137714151152004013630 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include "altrep.h" #include #define REAL_NA(val) (ISNA(val) || ISNAN(val)) #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result != WK_CONTINUE) return result #define HANDLE_CONTINUE_OR_BREAK(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) continue; else if (result == WK_ABORT) break int wk_crc_handle_single(wk_handler_t* handler, const wk_meta_t* meta, double x, double y, double r, double segs_per_circle) { int result; double coord[4]; double angle; for (int i = 0; i < segs_per_circle; i++) { angle = i / segs_per_circle * PI * 2.0; coord[0] = x + r * cos(angle); coord[1] = y + r * sin(angle); HANDLE_OR_RETURN(handler->coord(meta, coord, i, handler->handler_data)); } // re-export the first coordinate (i = 0) identically // to ensure that the loops are closed with no floating-point error angle = 0 / segs_per_circle * PI * 2.0; coord[0] = x + r * cos(angle); coord[1] = y + r * sin(angle); HANDLE_OR_RETURN(handler->coord(meta, coord, segs_per_circle, handler->handler_data)); return WK_CONTINUE; } SEXP wk_read_crc(SEXP data_coords, wk_handler_t* handler) { SEXP data = VECTOR_ELT(data_coords, 0); int* segs_per_circle = INTEGER(VECTOR_ELT(data_coords, 1)); int segs_per_circle_len = Rf_length(VECTOR_ELT(data_coords, 1)); if (!Rf_inherits(data, "wk_crc")) { Rf_error("Object does not inherit from 'wk_crc'"); } R_xlen_t n_features = Rf_xlength(VECTOR_ELT(data, 0)); double* data_ptr[3]; R_xlen_t data_ptr_i = 0; #ifdef HAS_ALTREP SEXP altrep_buffer = PROTECT(Rf_allocVector(REALSXP, ALTREP_CHUNK_SIZE * 4)); for (int j = 0; j < 3; j++) { data_ptr[j] = REAL(altrep_buffer) + (ALTREP_CHUNK_SIZE * j); } #else for (int j = 0; j < 3; j++) { data_ptr[j] = REAL(VECTOR_ELT(data, j)); } #endif wk_vector_meta_t vector_meta; WK_VECTOR_META_RESET(vector_meta, WK_POLYGON); vector_meta.size = n_features; if (handler->vector_start(&vector_meta, handler->handler_data) == WK_CONTINUE) { int result, n_segs; double cx, cy, radius; wk_meta_t meta; WK_META_RESET(meta, WK_POLYGON); meta.flags = vector_meta.flags | WK_FLAG_HAS_BOUNDS; for (R_xlen_t i = 0; i < n_features; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); HANDLE_CONTINUE_OR_BREAK(handler->feature_start(&vector_meta, i, handler->handler_data)); #ifdef HAS_ALTREP data_ptr_i = i % ALTREP_CHUNK_SIZE; if (data_ptr_i == 0) { for (int j = 0; j < 3; j++) { REAL_GET_REGION(VECTOR_ELT(data, j), i, ALTREP_CHUNK_SIZE, data_ptr[j]); } } #else data_ptr_i = i; #endif cx = data_ptr[0][i]; cy = data_ptr[1][i]; radius = data_ptr[2][i]; n_segs = segs_per_circle[i % segs_per_circle_len]; int circle_empty = REAL_NA(cx) || REAL_NA(cy) || REAL_NA(radius); if (circle_empty) { meta.size = 0; } else { meta.size = 1; } meta.bounds_min[0] = cx - radius; meta.bounds_min[1] = cy - radius; meta.bounds_max[0] = cx + radius; meta.bounds_max[1] = cy + radius; HANDLE_CONTINUE_OR_BREAK(handler->geometry_start(&meta, WK_PART_ID_NONE, handler->handler_data)); if (!circle_empty) { HANDLE_CONTINUE_OR_BREAK(handler->ring_start(&meta, n_segs + 1, 0, handler->handler_data)); HANDLE_CONTINUE_OR_BREAK(wk_crc_handle_single(handler, &meta, cx, cy, radius, n_segs)); HANDLE_CONTINUE_OR_BREAK(handler->ring_end(&meta, n_segs + 1, 0, handler->handler_data)); } HANDLE_CONTINUE_OR_BREAK(handler->geometry_end(&meta, WK_PART_ID_NONE, handler->handler_data)); if (handler->feature_end(&vector_meta, i, handler->handler_data) == WK_ABORT) { break; } } } #ifdef HAS_ALTREP UNPROTECT(1); #endif SEXP result = PROTECT(handler->vector_end(&vector_meta, handler->handler_data)); UNPROTECT(1); return result; } SEXP wk_c_read_crc(SEXP data, SEXP handler_xptr, SEXP n_segs) { SEXP data_coords = PROTECT(Rf_allocVector(VECSXP, 2)); SET_VECTOR_ELT(data_coords, 0, data); SET_VECTOR_ELT(data_coords, 1, n_segs); SEXP result = PROTECT(wk_handler_run_xptr(&wk_read_crc, data_coords, handler_xptr)); UNPROTECT(2); return result; } wk/src/trans-set.c0000644000176200001440000000345114106220314013542 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #include typedef struct { double* xyzm[4]; R_xlen_t n; } wk_trans_set_t; int wk_trans_set_trans(R_xlen_t feature_id, const double* xyzm_in, double* xyzm_out, void* trans_data) { wk_trans_set_t* data = (wk_trans_set_t*) trans_data; R_xlen_t set_id = feature_id % data->n; double set; for (int i = 0; i < 4; i++) { set = data->xyzm[i][set_id]; if (ISNA(set)) { xyzm_out[i] = xyzm_in[i]; } else { xyzm_out[i] = set; } } return WK_CONTINUE; } void wk_trans_set_finalize(void* trans_data) { free(trans_data); } SEXP wk_c_trans_set_new(SEXP xy, SEXP use_z, SEXP use_m) { if (Rf_xlength(xy) != 4 || TYPEOF(xy) != VECSXP) { Rf_error("`xy` must be an xyzm() object"); // # nocov } // prepare data for C struct / validate args int use_z_int = LOGICAL(use_z)[0]; int use_m_int = LOGICAL(use_m)[0]; R_xlen_t n = Rf_xlength(VECTOR_ELT(xy, 0)); double* xyzm[4]; for (int i = 0; i < 4; i++) { xyzm[i] = REAL(VECTOR_ELT(xy, i)); } // create the wk_trans object wk_trans_t* trans = wk_trans_create(); trans->trans = &wk_trans_set_trans; trans->finalizer = &wk_trans_set_finalize; wk_trans_set_t* data = (wk_trans_set_t*) malloc(sizeof(wk_trans_set_t)); if (data == NULL) { free(trans); // # nocov Rf_error("Failed to alloc wk_trans_set_t"); // # nocov } trans->use_z = use_z_int; trans->use_m = use_m_int; memcpy(data->xyzm, xyzm, 4 * sizeof(void*)); data->n = n; trans->trans_data = data; // keep the xy as a tag because we need the pointers to stay valid return wk_trans_create_xptr(trans, xy, R_NilValue); } wk/src/xy-writer.c0000644000176200001440000002066314106220314013600 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #include typedef struct { SEXP result; // caching the underlying pointers results in a slight speedup double* result_ptr[4]; R_xlen_t result_size; R_xlen_t feat_id; int has_coord; uint32_t flags; } xy_writer_t; static inline SEXP xy_writer_alloc_result(R_xlen_t size) { const char* names[] = {"x", "y", "z", "m", ""}; SEXP result = PROTECT(Rf_mkNamed(VECSXP, names)); SET_VECTOR_ELT(result, 0, Rf_allocVector(REALSXP, size)); SET_VECTOR_ELT(result, 1, Rf_allocVector(REALSXP, size)); SET_VECTOR_ELT(result, 2, Rf_allocVector(REALSXP, size)); SET_VECTOR_ELT(result, 3, Rf_allocVector(REALSXP, size)); UNPROTECT(1); return result; } static inline SEXP xy_writer_realloc_result(SEXP result, R_xlen_t new_size) { SEXP new_result = PROTECT(xy_writer_alloc_result(new_size)); R_xlen_t size_cpy; if (Rf_xlength(VECTOR_ELT(result, 0)) < new_size) { size_cpy = Rf_xlength(VECTOR_ELT(result, 0)); } else { size_cpy = new_size; } for (int i = 0; i < 4; i ++) { memcpy( REAL(VECTOR_ELT(new_result, i)), REAL(VECTOR_ELT(result, i)), sizeof(double) * size_cpy ); } UNPROTECT(1); return new_result; } static inline void xy_writer_append_empty(xy_writer_t* writer) { if (writer->feat_id >= writer->result_size) { SEXP new_result = PROTECT(xy_writer_realloc_result(writer->result, writer->result_size * 2 + 1)); R_ReleaseObject(writer->result); writer->result = new_result; R_PreserveObject(writer->result); UNPROTECT(1); writer->result_size = writer->result_size * 2 + 1; for (int i = 0; i < 4; i++) { writer->result_ptr[i] = REAL(VECTOR_ELT(writer->result, i)); } } for (int i = 0; i < 4; i++) { writer->result_ptr[i][writer->feat_id] = NA_REAL; } writer->feat_id++; } int xy_writer_vector_start(const wk_vector_meta_t* meta, void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; if (data->result != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { data->result = PROTECT(xy_writer_alloc_result(1024)); data->result_size = 1024; } else { data->result = PROTECT(xy_writer_alloc_result(meta->size)); data->result_size = meta->size; } R_PreserveObject(data->result); UNPROTECT(1); for (int i = 0; i < 4; i++) { data->result_ptr[i] = REAL(VECTOR_ELT(data->result, i)); } data->feat_id = 0; return WK_CONTINUE; } int xy_writer_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; data->has_coord = 0; xy_writer_append_empty(data); return WK_CONTINUE; } int xy_writer_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; // EMPTY and any set of features that (could) contain a single point work with this // handler! (error otherwise) if (meta->size != 0 && meta->geometry_type != WK_POINT && meta->geometry_type != WK_MULTIPOINT && meta->geometry_type != WK_GEOMETRYCOLLECTION) { Rf_error( "[%d] Can't convert geometry with type '%d' to coordinate", data->feat_id + 1, meta->geometry_type ); } // keep track of zm flags to possibly trim output data->flags |= meta->flags; return WK_CONTINUE; } int xy_writer_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; if (data->has_coord) { Rf_error("[%d] Feature contains more than one coordinate.", data->feat_id); } else { data->has_coord = 1; } data->result_ptr[0][data->feat_id - 1] = coord[0]; data->result_ptr[1][data->feat_id - 1] = coord[1]; if ((meta->flags & WK_FLAG_HAS_Z) && (meta->flags & WK_FLAG_HAS_M)) { data->result_ptr[2][data->feat_id - 1] = coord[2]; data->result_ptr[3][data->feat_id - 1] = coord[3]; } else if(meta->flags & WK_FLAG_HAS_Z) { data->result_ptr[2][data->feat_id - 1] = coord[2]; } else if(meta->flags & WK_FLAG_HAS_M) { data->result_ptr[3][data->feat_id - 1] = coord[2]; } return WK_CONTINUE; } SEXP xy_writer_vector_end(const wk_vector_meta_t* meta, void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; R_xlen_t final_size = data->feat_id; if (final_size != data->result_size) { SEXP new_result = PROTECT(xy_writer_realloc_result(data->result, final_size)); R_ReleaseObject(data->result); data->result = new_result; R_PreserveObject(data->result); UNPROTECT(1); } if ((data->flags & WK_FLAG_HAS_Z) && (data->flags & WK_FLAG_HAS_M)) { SEXP xy_class = PROTECT(Rf_allocVector(STRSXP, 5)); SET_STRING_ELT(xy_class, 0, Rf_mkChar("wk_xyzm")); SET_STRING_ELT(xy_class, 1, Rf_mkChar("wk_xyz")); SET_STRING_ELT(xy_class, 2, Rf_mkChar("wk_xym")); SET_STRING_ELT(xy_class, 3, Rf_mkChar("wk_xy")); SET_STRING_ELT(xy_class, 4, Rf_mkChar("wk_rcrd")); Rf_setAttrib(data->result, R_ClassSymbol, xy_class); UNPROTECT(1); return data->result; } else if(data->flags & WK_FLAG_HAS_Z) { const char* xyz_names[] = {"x", "y", "z", ""}; SEXP xyz = PROTECT(Rf_mkNamed(VECSXP, xyz_names)); for (int i = 0; i < 3; i++) { SET_VECTOR_ELT(xyz, i, VECTOR_ELT(data->result, i)); } SEXP xy_class = PROTECT(Rf_allocVector(STRSXP, 3)); SET_STRING_ELT(xy_class, 0, Rf_mkChar("wk_xyz")); SET_STRING_ELT(xy_class, 1, Rf_mkChar("wk_xy")); SET_STRING_ELT(xy_class, 2, Rf_mkChar("wk_rcrd")); Rf_setAttrib(xyz, R_ClassSymbol, xy_class); UNPROTECT(2); return xyz; } else if(data->flags & WK_FLAG_HAS_M) { const char* xym_names[] = {"x", "y", "m", ""}; SEXP xym = PROTECT(Rf_mkNamed(VECSXP, xym_names)); SET_VECTOR_ELT(xym, 0, VECTOR_ELT(data->result, 0)); SET_VECTOR_ELT(xym, 1, VECTOR_ELT(data->result, 1)); SET_VECTOR_ELT(xym, 2, VECTOR_ELT(data->result, 3)); SEXP xy_class = PROTECT(Rf_allocVector(STRSXP, 3)); SET_STRING_ELT(xy_class, 0, Rf_mkChar("wk_xym")); SET_STRING_ELT(xy_class, 1, Rf_mkChar("wk_xy")); SET_STRING_ELT(xy_class, 2, Rf_mkChar("wk_rcrd")); Rf_setAttrib(xym, R_ClassSymbol, xy_class); UNPROTECT(2); return xym; } else { const char* xy_names[] = {"x", "y", ""}; SEXP xy = PROTECT(Rf_mkNamed(VECSXP, xy_names)); for (int i = 0; i < 2; i++) { SET_VECTOR_ELT(xy, i, VECTOR_ELT(data->result, i)); } SEXP xy_class = PROTECT(Rf_allocVector(STRSXP, 2)); SET_STRING_ELT(xy_class, 0, Rf_mkChar("wk_xy")); SET_STRING_ELT(xy_class, 1, Rf_mkChar("wk_rcrd")); Rf_setAttrib(xy, R_ClassSymbol, xy_class); UNPROTECT(2); return xy; } } void xy_writer_deinitialize(void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; if (data->result != R_NilValue) { R_ReleaseObject(data->result); data->result = R_NilValue; } } void xy_writer_finalize(void* handler_data) { xy_writer_t* data = (xy_writer_t*) handler_data; if (data != NULL) { free(data); } } SEXP wk_c_xy_writer_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &xy_writer_vector_start; handler->feature_start = &xy_writer_feature_start; handler->geometry_start = &xy_writer_geometry_start; handler->coord = &xy_writer_coord; handler->vector_end = &xy_writer_vector_end; handler->deinitialize = &xy_writer_deinitialize; handler->finalizer = &xy_writer_finalize; xy_writer_t* data = (xy_writer_t*) malloc(sizeof(xy_writer_t)); if (data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } data->feat_id = 0; data->has_coord = 0; data->result = R_NilValue; data->flags = 0; handler->handler_data = data; SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); return xptr; } wk/src/void-handler.c0000644000176200001440000000075414106220314014201 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" SEXP wk_c_handler_void_new() { return wk_handler_create_xptr(wk_handler_create(), R_NilValue, R_NilValue); } SEXP wk_c_handler_addr(SEXP xptr) { SEXP buffer = PROTECT(Rf_allocVector(RAWSXP, 256)); sprintf((char*) RAW(buffer), "%p", (void*) R_ExternalPtrAddr(xptr)); SEXP out = PROTECT(Rf_allocVector(STRSXP, 1)); SET_STRING_ELT(out, 0, Rf_mkChar((char*) RAW(buffer))); UNPROTECT(2); return out; } wk/src/handle-rct.c0000644000176200001440000001010714151152004013637 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include "altrep.h" #define REAL_NA(val) (ISNA(val) || ISNAN(val)) #define HANDLE_CONTINUE_OR_BREAK(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) continue; else if (result == WK_ABORT) break SEXP wk_read_rct(SEXP data, wk_handler_t* handler) { if (!Rf_inherits(data, "wk_rct")) { Rf_error("Object does not inherit from 'wk_rct'"); } R_xlen_t n_features = Rf_xlength(VECTOR_ELT(data, 0)); double* data_ptr[4]; R_xlen_t data_ptr_i = 0; #ifdef HAS_ALTREP SEXP altrep_buffer = PROTECT(Rf_allocVector(REALSXP, ALTREP_CHUNK_SIZE * 4)); for (int j = 0; j < 4; j++) { data_ptr[j] = REAL(altrep_buffer) + (ALTREP_CHUNK_SIZE * j); } #else for (int j = 0; j < 4; j++) { data_ptr[j] = REAL(VECTOR_ELT(data, j)); } #endif wk_vector_meta_t vector_meta; WK_VECTOR_META_RESET(vector_meta, WK_POLYGON); vector_meta.size = n_features; if (handler->vector_start(&vector_meta, handler->handler_data) == WK_CONTINUE) { int result; double xmin, ymin, xmax, ymax; double coord[4]; wk_meta_t meta; WK_META_RESET(meta, WK_POLYGON); meta.flags = vector_meta.flags | WK_FLAG_HAS_BOUNDS; for (R_xlen_t i = 0; i < n_features; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); HANDLE_CONTINUE_OR_BREAK(handler->feature_start(&vector_meta, i, handler->handler_data)); #ifdef HAS_ALTREP data_ptr_i = i % ALTREP_CHUNK_SIZE; if (data_ptr_i == 0) { for (int j = 0; j < 4; j++) { REAL_GET_REGION(VECTOR_ELT(data, j), i, ALTREP_CHUNK_SIZE, data_ptr[j]); } } #else data_ptr_i = i; #endif xmin = data_ptr[0][data_ptr_i]; ymin = data_ptr[1][data_ptr_i]; xmax = data_ptr[2][data_ptr_i]; ymax = data_ptr[3][data_ptr_i]; int rect_na = REAL_NA(xmin) && REAL_NA(ymin) && REAL_NA(xmax) && REAL_NA(ymax); int rect_empty = rect_na || ((xmax - xmin) == R_NegInf) || ((ymax - ymin) == R_NegInf); if (rect_empty) { meta.size = 0; } else { meta.size = 1; } meta.bounds_min[0] = xmin; meta.bounds_min[1] = ymin; meta.bounds_max[0] = xmax; meta.bounds_max[1] = ymax; HANDLE_CONTINUE_OR_BREAK(handler->geometry_start(&meta, WK_PART_ID_NONE, handler->handler_data)); if (!rect_empty) { HANDLE_CONTINUE_OR_BREAK(handler->ring_start(&meta, 5, 0, handler->handler_data)); coord[0] = xmin; coord[1] = ymin; HANDLE_CONTINUE_OR_BREAK(handler->coord(&meta, coord, 0, handler->handler_data)); coord[0] = xmax; coord[1] = ymin; HANDLE_CONTINUE_OR_BREAK(handler->coord(&meta, coord, 1, handler->handler_data)); coord[0] = xmax; coord[1] = ymax; HANDLE_CONTINUE_OR_BREAK(handler->coord(&meta, coord, 2, handler->handler_data)); coord[0] = xmin; coord[1] = ymax; HANDLE_CONTINUE_OR_BREAK(handler->coord(&meta, coord, 3, handler->handler_data)); coord[0] = xmin; coord[1] = ymin; HANDLE_CONTINUE_OR_BREAK(handler->coord(&meta, coord, 4, handler->handler_data)); HANDLE_CONTINUE_OR_BREAK(handler->ring_end(&meta, 5, 0, handler->handler_data)); } HANDLE_CONTINUE_OR_BREAK(handler->geometry_end(&meta, WK_PART_ID_NONE, handler->handler_data)); if (handler->feature_end(&vector_meta, i, handler->handler_data) == WK_ABORT) { break; } } } #ifdef HAS_ALTREP UNPROTECT(1); #endif SEXP result = PROTECT(handler->vector_end(&vector_meta, handler->handler_data)); UNPROTECT(1); return result; } SEXP wk_c_read_rct(SEXP data, SEXP handlerXptr) { return wk_handler_run_xptr(&wk_read_rct, data, handlerXptr); } wk/src/handle-wkt.cpp0000644000176200001440000003104314160220603014217 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #define FASTFLOAT_ASSERT(x) { if (!(x)) Rf_error("fastfloat assert failed"); } #include "internal/buffered-reader.hpp" #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result != WK_CONTINUE) return result #define HANDLE_CONTINUE_OR_BREAK(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) continue; else if (result == WK_ABORT) break // The BufferedWKTParser is the BufferedParser subclass with methods specific // to well-known text. It doesn't know about any particular output format. template class BufferedWKTParser: public BufferedParser { public: BufferedWKTParser() { this->setSeparators(" \r\n\t,();="); } void assertGeometryMeta(wk_meta_t* meta) { std::string geometry_type = this->assertWord(); if (geometry_type == "SRID") { this->assert_('='); meta->srid = this->assertInteger(); this->assert_(';'); geometry_type = this->assertWord(); } meta->geometry_type = this->geometry_typeFromString(geometry_type); if (this->is('Z')) { this->assert_('Z'); meta->flags |= WK_FLAG_HAS_Z; } if (this->is('M')) { this->assert_('M'); meta->flags |= WK_FLAG_HAS_M; } if (this->isEMPTY()) { meta->size = 0; } } int geometry_typeFromString(std::string geometry_type) { if (geometry_type == "POINT") { return WK_POINT; } else if(geometry_type == "LINESTRING") { return WK_LINESTRING; } else if(geometry_type == "POLYGON") { return WK_POLYGON; } else if(geometry_type == "MULTIPOINT") { return WK_MULTIPOINT; } else if(geometry_type == "MULTILINESTRING") { return WK_MULTILINESTRING; } else if(geometry_type == "MULTIPOLYGON") { return WK_MULTIPOLYGON; } else if(geometry_type == "GEOMETRYCOLLECTION") { return WK_GEOMETRYCOLLECTION; } else { this->errorBefore("geometry type or 'SRID='", geometry_type); } } bool isEMPTY() { return this->peekUntilSep() == "EMPTY"; } bool assertEMPTYOrOpen() { if (this->isLetter()) { std::string word = this->assertWord(); if (word != "EMPTY") { this->errorBefore("'(' or 'EMPTY'", word); } return true; } else if (this->is('(')) { this->assert_('('); return false; } else { this->error("'(' or 'EMPTY'"); } } }; // The BufferedWKTReader knows about wk_handler_t and does all the "driving". The // entry point is readFeature(), which does not throw (but may longjmp). // The BufferedWKTReader is carefully designed to (1) avoid any virtual method calls // (via templating) and (2) to avoid using any C++ objects with non-trivial destructors. // The non-trivial destructors bit is important because handler methods can and do longjmp // when used in R. The object itself does not have a non-trivial destructor and it's expected // that the scope in which it is declared uses the proper unwind-protection such that the // object and its members are deleted. template class BufferedWKTReader { public: BufferedWKTReader(handler_t* handler): handler(handler) { memset(this->error_message, 0, sizeof(this->error_message)); } int readFeature(wk_vector_meta_t* meta, int64_t feat_id, SourceType* source) { try { int result; HANDLE_OR_RETURN(this->handler->feature_start(meta, feat_id, this->handler->handler_data)); if (source == nullptr) { HANDLE_OR_RETURN(this->handler->null_feature(this->handler->handler_data)); } else { s.setSource(source); HANDLE_OR_RETURN(this->readGeometryWithType(WK_PART_ID_NONE)); s.assertFinished(); } return this->handler->feature_end(meta, feat_id, this->handler->handler_data); } catch (std::exception& e) { // can't call a handler method that longjmps here because `e` must be deleted memset(this->error_message, 0, sizeof(this->error_message)); strncpy(this->error_message, e.what(), sizeof(this->error_message) - 1); } return this->handler->error(this->error_message, this->handler->handler_data); } protected: int readGeometryWithType(uint32_t part_id) { wk_meta_t meta; WK_META_RESET(meta, WK_GEOMETRY); s.assertGeometryMeta(&meta); int result; HANDLE_OR_RETURN(this->handler->geometry_start(&meta, part_id, this->handler->handler_data)); switch (meta.geometry_type) { case WK_POINT: HANDLE_OR_RETURN(this->readPoint(&meta)); break; case WK_LINESTRING: HANDLE_OR_RETURN(this->readLineString(&meta)); break; case WK_POLYGON: HANDLE_OR_RETURN(this->readPolygon(&meta)); break; case WK_MULTIPOINT: HANDLE_OR_RETURN(this->readMultiPoint(&meta)); break; case WK_MULTILINESTRING: HANDLE_OR_RETURN(this->readMultiLineString(&meta)); break; case WK_MULTIPOLYGON: HANDLE_OR_RETURN(this->readMultiPolygon(&meta)); break; case WK_GEOMETRYCOLLECTION: HANDLE_OR_RETURN(this->readGeometryCollection(&meta)); break; default: throw std::runtime_error("Unknown geometry type"); // # nocov } return this->handler->geometry_end(&meta, part_id, this->handler->handler_data); } int readPoint(const wk_meta_t* meta) { if (!s.assertEMPTYOrOpen()) { int result; HANDLE_OR_RETURN(this->readPointCoordinate(meta)); s.assert_(')'); } return WK_CONTINUE; } int readLineString(const wk_meta_t* meta) { return this->readCoordinates(meta); } int readPolygon(const wk_meta_t* meta) { return this->readLinearRings(meta); } int readMultiPoint(const wk_meta_t* meta) { if (s.assertEMPTYOrOpen()) { return WK_CONTINUE; } wk_meta_t childMeta; WK_META_RESET(childMeta, WK_POINT); uint32_t part_id = 0; int result; if (s.isNumber()) { // (0 0, 1 1) do { this->readChildMeta(meta, &childMeta); HANDLE_OR_RETURN(this->handler->geometry_start(&childMeta, part_id, this->handler->handler_data)); if (s.isEMPTY()) { s.assertWord(); } else { HANDLE_OR_RETURN(this->readPointCoordinate(&childMeta)); } HANDLE_OR_RETURN(this->handler->geometry_end(&childMeta, part_id, this->handler->handler_data)); part_id++; } while (s.assertOneOf(",)") != ')'); } else { // ((0 0), (1 1)) do { this->readChildMeta(meta, &childMeta); HANDLE_OR_RETURN(this->handler->geometry_start(&childMeta, part_id, this->handler->handler_data)); HANDLE_OR_RETURN(this->readPoint(&childMeta)); HANDLE_OR_RETURN(this->handler->geometry_end(&childMeta, part_id, this->handler->handler_data)); part_id++; } while (s.assertOneOf(",)") != ')'); } return WK_CONTINUE; } int readMultiLineString(const wk_meta_t* meta) { if (s.assertEMPTYOrOpen()) { return WK_CONTINUE; } wk_meta_t childMeta; WK_META_RESET(childMeta, WK_LINESTRING); uint32_t part_id = 0; int result; do { this->readChildMeta(meta, &childMeta); HANDLE_OR_RETURN(this->handler->geometry_start(&childMeta, part_id, this->handler->handler_data)); HANDLE_OR_RETURN(this->readLineString(&childMeta)); HANDLE_OR_RETURN(this->handler->geometry_end(&childMeta, part_id, this->handler->handler_data)); part_id++; } while (s.assertOneOf(",)") != ')'); return WK_CONTINUE; } uint32_t readMultiPolygon(const wk_meta_t* meta) { if (s.assertEMPTYOrOpen()) { return WK_CONTINUE; } wk_meta_t childMeta; WK_META_RESET(childMeta, WK_POLYGON); uint32_t part_id = 0; int result; do { this->readChildMeta(meta, &childMeta); HANDLE_OR_RETURN(this->handler->geometry_start(&childMeta, part_id, this->handler->handler_data)); HANDLE_OR_RETURN(this->readPolygon(&childMeta)); HANDLE_OR_RETURN(this->handler->geometry_end(&childMeta, part_id, this->handler->handler_data)); part_id++; } while (s.assertOneOf(",)") != ')'); return WK_CONTINUE; } int readGeometryCollection(const wk_meta_t* meta) { if (s.assertEMPTYOrOpen()) { return WK_CONTINUE; } uint32_t part_id = 0; int result; do { HANDLE_OR_RETURN(this->readGeometryWithType(part_id)); part_id++; } while (s.assertOneOf(",)") != ')'); return WK_CONTINUE; } uint32_t readLinearRings(const wk_meta_t* meta) { if (s.assertEMPTYOrOpen()) { return WK_CONTINUE; } uint32_t ring_id = 0; int result; do { HANDLE_OR_RETURN(this->handler->ring_start(meta, WK_SIZE_UNKNOWN, ring_id, this->handler->handler_data)); HANDLE_OR_RETURN(this->readCoordinates(meta)); HANDLE_OR_RETURN(this->handler->ring_end(meta, WK_SIZE_UNKNOWN, ring_id, this->handler->handler_data)); ring_id++; } while (s.assertOneOf(",)") != ')'); return WK_CONTINUE; } // Point coordinates are special in that there can only be one // coordinate (and reading more than one might cause errors since // writers are unlikely to expect a point geometry with many coordinates). // This assumes that `s` has already been checked for EMPTY or an opener // since this is different for POINT (...) and MULTIPOINT (.., ...) int readPointCoordinate(const wk_meta_t* meta) { double coord[4]; int result; int coordSize = 2; if (meta->flags & WK_FLAG_HAS_Z) coordSize++; if (meta->flags & WK_FLAG_HAS_M) coordSize++; this->readCoordinate(coord, coordSize); HANDLE_OR_RETURN(handler->coord(meta, coord, 0, this->handler->handler_data)); return WK_CONTINUE; } int readCoordinates(const wk_meta_t* meta) { double coord[4]; int coordSize = 2; if (meta->flags & WK_FLAG_HAS_Z) coordSize++; if (meta->flags & WK_FLAG_HAS_M) coordSize++; if (s.assertEMPTYOrOpen()) { return WK_CONTINUE; } uint32_t coord_id = 0; int result; do { this->readCoordinate(coord, coordSize); HANDLE_OR_RETURN(handler->coord(meta, coord, coord_id, this->handler->handler_data)); coord_id++; } while (s.assertOneOf(",)") != ')'); return WK_CONTINUE; } void readCoordinate(double* coord, int coordSize) { coord[0] = s.assertNumber(); for (int i = 1; i < coordSize; i++) { s.assertWhitespace(); coord[i] = s.assertNumber(); } } void readChildMeta(const wk_meta_t* parent, wk_meta_t* childMeta) { childMeta->flags = parent->flags; childMeta->srid = parent->srid; if (s.isEMPTY()) { childMeta->size = 0; } else { childMeta->size = WK_SIZE_UNKNOWN; } } private: handler_t* handler; BufferedWKTParser s; char error_message[8096]; }; template void finalize_cpp_xptr(SEXP xptr) { T* ptr = (T*) R_ExternalPtrAddr(xptr); if (ptr != nullptr) { delete ptr; } } SEXP wkt_read_wkt(SEXP data, wk_handler_t* handler) { SEXP wkt_sexp = VECTOR_ELT(data, 0); SEXP reveal_size_sexp = VECTOR_ELT(data, 1); int reveal_size = LOGICAL(reveal_size_sexp)[0]; if (TYPEOF(wkt_sexp) != STRSXP) { Rf_error("Input to wkt handler must be a character vector"); } R_xlen_t n_features = Rf_xlength(wkt_sexp); wk_vector_meta_t global_meta; WK_VECTOR_META_RESET(global_meta, WK_GEOMETRY); global_meta.flags |= WK_FLAG_DIMS_UNKNOWN; if (reveal_size) { global_meta.size = n_features; } // These are C++ objects but they are trivially destructible // (so longjmp in this stack is OK). SimpleBufferSource source; BufferedWKTReader reader(handler); int result = handler->vector_start(&global_meta, handler->handler_data); if (result != WK_ABORT) { R_xlen_t n_features = Rf_xlength(wkt_sexp); SEXP item; int result; for (R_xlen_t i = 0; i < n_features; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); item = STRING_ELT(wkt_sexp, i); if (item == NA_STRING) { HANDLE_CONTINUE_OR_BREAK(reader.readFeature(&global_meta, i, nullptr)); } else { const char* chars = CHAR(item); source.set_buffer(chars, strlen(chars)); HANDLE_CONTINUE_OR_BREAK(reader.readFeature(&global_meta, i, &source)); } if (result == WK_ABORT) { break; } } } return handler->vector_end(&global_meta, handler->handler_data); } extern "C" SEXP wk_c_read_wkt(SEXP data, SEXP handler_xptr) { return wk_handler_run_xptr(&wkt_read_wkt, data, handler_xptr); } wk/src/internal/0000755000176200001440000000000014160220603013270 5ustar liggesuserswk/src/internal/fast_float/0000755000176200001440000000000014160220603015412 5ustar liggesuserswk/src/internal/fast_float/fast_float.h0000644000176200001440000032207314160220603017714 0ustar liggesusers// fast_float by Daniel Lemire // fast_float by João Paulo Magalhaes // // with contributions from Eugene Golushkov // with contributions from Maksim Kita // with contributions from Marcin Wojdyr // with contributions from Neal Richardson // with contributions from Tim Paine // with contributions from Fabio Pellacini // // Licensed under the Apache License, Version 2.0, or the // MIT License at your option. This file may not be copied, // modified, or distributed except according to those terms. // // MIT License Notice // // MIT License // // Copyright (c) 2021 The fast_float authors // // Permission is hereby granted, free of charge, to any // person obtaining a copy of this software and associated // documentation files (the "Software"), to deal in the // Software without restriction, including without // limitation the rights to use, copy, modify, merge, // publish, distribute, sublicense, and/or sell copies of // the Software, and to permit persons to whom the Software // is furnished to do so, subject to the following // conditions: // // The above copyright notice and this permission notice // shall be included in all copies or substantial portions // of the Software. // // THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF // ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED // TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A // PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT // SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY // CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION // OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR // IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER // DEALINGS IN THE SOFTWARE. // // Apache License (Version 2.0) Notice // // Copyright 2021 The fast_float authors // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // // http://www.apache.org/licenses/LICENSE-2.0 // // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // #ifndef FASTFLOAT_FAST_FLOAT_H #define FASTFLOAT_FAST_FLOAT_H #include namespace fast_float { enum chars_format { scientific = 1<<0, fixed = 1<<2, hex = 1<<3, general = fixed | scientific }; struct from_chars_result { const char *ptr; std::errc ec; }; struct parse_options { constexpr explicit parse_options(chars_format fmt = chars_format::general, char dot = '.') : format(fmt), decimal_point(dot) {} /** Which number formats are accepted */ chars_format format; /** The character used as decimal point */ char decimal_point; }; /** * This function parses the character sequence [first,last) for a number. It parses floating-point numbers expecting * a locale-indepent format equivalent to what is used by std::strtod in the default ("C") locale. * The resulting floating-point value is the closest floating-point values (using either float or double), * using the "round to even" convention for values that would otherwise fall right in-between two values. * That is, we provide exact parsing according to the IEEE standard. * * Given a successful parse, the pointer (`ptr`) in the returned value is set to point right after the * parsed number, and the `value` referenced is set to the parsed value. In case of error, the returned * `ec` contains a representative error, otherwise the default (`std::errc()`) value is stored. * * The implementation does not throw and does not allocate memory (e.g., with `new` or `malloc`). * * Like the C++17 standard, the `fast_float::from_chars` functions take an optional last argument of * the type `fast_float::chars_format`. It is a bitset value: we check whether * `fmt & fast_float::chars_format::fixed` and `fmt & fast_float::chars_format::scientific` are set * to determine whether we allowe the fixed point and scientific notation respectively. * The default is `fast_float::chars_format::general` which allows both `fixed` and `scientific`. */ template from_chars_result from_chars(const char *first, const char *last, T &value, chars_format fmt = chars_format::general) noexcept; /** * Like from_chars, but accepts an `options` argument to govern number parsing. */ template from_chars_result from_chars_advanced(const char *first, const char *last, T &value, parse_options options) noexcept; } #endif // FASTFLOAT_FAST_FLOAT_H #ifndef FASTFLOAT_FLOAT_COMMON_H #define FASTFLOAT_FLOAT_COMMON_H #include #include #include #include #include #if (defined(__x86_64) || defined(__x86_64__) || defined(_M_X64) \ || defined(__amd64) || defined(__aarch64__) || defined(_M_ARM64) \ || defined(__MINGW64__) \ || defined(__s390x__) \ || (defined(__ppc64__) || defined(__PPC64__) || defined(__ppc64le__) || defined(__PPC64LE__)) \ || defined(__EMSCRIPTEN__)) #define FASTFLOAT_64BIT #elif (defined(__i386) || defined(__i386__) || defined(_M_IX86) \ || defined(__arm__) || defined(_M_ARM) \ || defined(__MINGW32__)) #define FASTFLOAT_32BIT #else // Need to check incrementally, since SIZE_MAX is a size_t, avoid overflow. // We can never tell the register width, but the SIZE_MAX is a good approximation. // UINTPTR_MAX and INTPTR_MAX are optional, so avoid them for max portability. #if SIZE_MAX == 0xffff #error Unknown platform (16-bit, unsupported) #elif SIZE_MAX == 0xffffffff #define FASTFLOAT_32BIT #elif SIZE_MAX == 0xffffffffffffffff #define FASTFLOAT_64BIT #else #error Unknown platform (not 32-bit, not 64-bit?) #endif #endif #if ((defined(_WIN32) || defined(_WIN64)) && !defined(__clang__)) #include #endif #if defined(_MSC_VER) && !defined(__clang__) #define FASTFLOAT_VISUAL_STUDIO 1 #endif #ifdef _WIN32 #define FASTFLOAT_IS_BIG_ENDIAN 0 #else #if defined(__APPLE__) || defined(__FreeBSD__) #include #elif defined(sun) || defined(__sun) #include #else #include #endif # #ifndef __BYTE_ORDER__ // safe choice #define FASTFLOAT_IS_BIG_ENDIAN 0 #endif # #ifndef __ORDER_LITTLE_ENDIAN__ // safe choice #define FASTFLOAT_IS_BIG_ENDIAN 0 #endif # #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ #define FASTFLOAT_IS_BIG_ENDIAN 0 #else #define FASTFLOAT_IS_BIG_ENDIAN 1 #endif #endif #ifdef FASTFLOAT_VISUAL_STUDIO #define fastfloat_really_inline __forceinline #else #define fastfloat_really_inline inline __attribute__((always_inline)) #endif #ifndef FASTFLOAT_ASSERT #define FASTFLOAT_ASSERT(x) { if (!(x)) abort(); } #endif #ifndef FASTFLOAT_DEBUG_ASSERT #include #define FASTFLOAT_DEBUG_ASSERT(x) assert(x) #endif // rust style `try!()` macro, or `?` operator #define FASTFLOAT_TRY(x) { if (!(x)) return false; } namespace fast_float { // Compares two ASCII strings in a case insensitive manner. inline bool fastfloat_strncasecmp(const char *input1, const char *input2, size_t length) { char running_diff{0}; for (size_t i = 0; i < length; i++) { running_diff |= (input1[i] ^ input2[i]); } return (running_diff == 0) || (running_diff == 32); } #ifndef FLT_EVAL_METHOD #error "FLT_EVAL_METHOD should be defined, please include cfloat." #endif // a pointer and a length to a contiguous block of memory template struct span { const T* ptr; size_t length; span(const T* _ptr, size_t _length) : ptr(_ptr), length(_length) {} span() : ptr(nullptr), length(0) {} constexpr size_t len() const noexcept { return length; } const T& operator[](size_t index) const noexcept { FASTFLOAT_DEBUG_ASSERT(index < length); return ptr[index]; } }; struct value128 { uint64_t low; uint64_t high; value128(uint64_t _low, uint64_t _high) : low(_low), high(_high) {} value128() : low(0), high(0) {} }; /* result might be undefined when input_num is zero */ fastfloat_really_inline int leading_zeroes(uint64_t input_num) { assert(input_num > 0); #ifdef FASTFLOAT_VISUAL_STUDIO #if defined(_M_X64) || defined(_M_ARM64) unsigned long leading_zero = 0; // Search the mask data from most significant bit (MSB) // to least significant bit (LSB) for a set bit (1). _BitScanReverse64(&leading_zero, input_num); return (int)(63 - leading_zero); #else int last_bit = 0; if(input_num & uint64_t(0xffffffff00000000)) input_num >>= 32, last_bit |= 32; if(input_num & uint64_t( 0xffff0000)) input_num >>= 16, last_bit |= 16; if(input_num & uint64_t( 0xff00)) input_num >>= 8, last_bit |= 8; if(input_num & uint64_t( 0xf0)) input_num >>= 4, last_bit |= 4; if(input_num & uint64_t( 0xc)) input_num >>= 2, last_bit |= 2; if(input_num & uint64_t( 0x2)) input_num >>= 1, last_bit |= 1; return 63 - last_bit; #endif #else return __builtin_clzll(input_num); #endif } #ifdef FASTFLOAT_32BIT // slow emulation routine for 32-bit fastfloat_really_inline uint64_t emulu(uint32_t x, uint32_t y) { return x * (uint64_t)y; } // slow emulation routine for 32-bit #if !defined(__MINGW64__) fastfloat_really_inline uint64_t _umul128(uint64_t ab, uint64_t cd, uint64_t *hi) { uint64_t ad = emulu((uint32_t)(ab >> 32), (uint32_t)cd); uint64_t bd = emulu((uint32_t)ab, (uint32_t)cd); uint64_t adbc = ad + emulu((uint32_t)ab, (uint32_t)(cd >> 32)); uint64_t adbc_carry = !!(adbc < ad); uint64_t lo = bd + (adbc << 32); *hi = emulu((uint32_t)(ab >> 32), (uint32_t)(cd >> 32)) + (adbc >> 32) + (adbc_carry << 32) + !!(lo < bd); return lo; } #endif // !__MINGW64__ #endif // FASTFLOAT_32BIT // compute 64-bit a*b fastfloat_really_inline value128 full_multiplication(uint64_t a, uint64_t b) { value128 answer; #ifdef _M_ARM64 // ARM64 has native support for 64-bit multiplications, no need to emulate answer.high = __umulh(a, b); answer.low = a * b; #elif defined(FASTFLOAT_32BIT) || (defined(_WIN64) && !defined(__clang__)) answer.low = _umul128(a, b, &answer.high); // _umul128 not available on ARM64 #elif defined(FASTFLOAT_64BIT) __uint128_t r = ((__uint128_t)a) * b; answer.low = uint64_t(r); answer.high = uint64_t(r >> 64); #else #error Not implemented #endif return answer; } struct adjusted_mantissa { uint64_t mantissa{0}; int32_t power2{0}; // a negative value indicates an invalid result adjusted_mantissa() = default; bool operator==(const adjusted_mantissa &o) const { return mantissa == o.mantissa && power2 == o.power2; } bool operator!=(const adjusted_mantissa &o) const { return mantissa != o.mantissa || power2 != o.power2; } }; // Bias so we can get the real exponent with an invalid adjusted_mantissa. constexpr static int32_t invalid_am_bias = -0x8000; constexpr static double powers_of_ten_double[] = { 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20, 1e21, 1e22}; constexpr static float powers_of_ten_float[] = {1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9, 1e10}; template struct binary_format { using equiv_uint = typename std::conditional::type; static inline constexpr int mantissa_explicit_bits(); static inline constexpr int minimum_exponent(); static inline constexpr int infinite_power(); static inline constexpr int sign_index(); static inline constexpr int min_exponent_fast_path(); static inline constexpr int max_exponent_fast_path(); static inline constexpr int max_exponent_round_to_even(); static inline constexpr int min_exponent_round_to_even(); static inline constexpr uint64_t max_mantissa_fast_path(); static inline constexpr int largest_power_of_ten(); static inline constexpr int smallest_power_of_ten(); static inline constexpr T exact_power_of_ten(int64_t power); static inline constexpr size_t max_digits(); static inline constexpr equiv_uint exponent_mask(); static inline constexpr equiv_uint mantissa_mask(); static inline constexpr equiv_uint hidden_bit_mask(); }; template <> inline constexpr int binary_format::mantissa_explicit_bits() { return 52; } template <> inline constexpr int binary_format::mantissa_explicit_bits() { return 23; } template <> inline constexpr int binary_format::max_exponent_round_to_even() { return 23; } template <> inline constexpr int binary_format::max_exponent_round_to_even() { return 10; } template <> inline constexpr int binary_format::min_exponent_round_to_even() { return -4; } template <> inline constexpr int binary_format::min_exponent_round_to_even() { return -17; } template <> inline constexpr int binary_format::minimum_exponent() { return -1023; } template <> inline constexpr int binary_format::minimum_exponent() { return -127; } template <> inline constexpr int binary_format::infinite_power() { return 0x7FF; } template <> inline constexpr int binary_format::infinite_power() { return 0xFF; } template <> inline constexpr int binary_format::sign_index() { return 63; } template <> inline constexpr int binary_format::sign_index() { return 31; } template <> inline constexpr int binary_format::min_exponent_fast_path() { #if (FLT_EVAL_METHOD != 1) && (FLT_EVAL_METHOD != 0) return 0; #else return -22; #endif } template <> inline constexpr int binary_format::min_exponent_fast_path() { #if (FLT_EVAL_METHOD != 1) && (FLT_EVAL_METHOD != 0) return 0; #else return -10; #endif } template <> inline constexpr int binary_format::max_exponent_fast_path() { return 22; } template <> inline constexpr int binary_format::max_exponent_fast_path() { return 10; } template <> inline constexpr uint64_t binary_format::max_mantissa_fast_path() { return uint64_t(2) << mantissa_explicit_bits(); } template <> inline constexpr uint64_t binary_format::max_mantissa_fast_path() { return uint64_t(2) << mantissa_explicit_bits(); } template <> inline constexpr double binary_format::exact_power_of_ten(int64_t power) { return powers_of_ten_double[power]; } template <> inline constexpr float binary_format::exact_power_of_ten(int64_t power) { return powers_of_ten_float[power]; } template <> inline constexpr int binary_format::largest_power_of_ten() { return 308; } template <> inline constexpr int binary_format::largest_power_of_ten() { return 38; } template <> inline constexpr int binary_format::smallest_power_of_ten() { return -342; } template <> inline constexpr int binary_format::smallest_power_of_ten() { return -65; } template <> inline constexpr size_t binary_format::max_digits() { return 769; } template <> inline constexpr size_t binary_format::max_digits() { return 114; } template <> inline constexpr binary_format::equiv_uint binary_format::exponent_mask() { return 0x7F800000; } template <> inline constexpr binary_format::equiv_uint binary_format::exponent_mask() { return 0x7FF0000000000000; } template <> inline constexpr binary_format::equiv_uint binary_format::mantissa_mask() { return 0x007FFFFF; } template <> inline constexpr binary_format::equiv_uint binary_format::mantissa_mask() { return 0x000FFFFFFFFFFFFF; } template <> inline constexpr binary_format::equiv_uint binary_format::hidden_bit_mask() { return 0x00800000; } template <> inline constexpr binary_format::equiv_uint binary_format::hidden_bit_mask() { return 0x0010000000000000; } template fastfloat_really_inline void to_float(bool negative, adjusted_mantissa am, T &value) { uint64_t word = am.mantissa; word |= uint64_t(am.power2) << binary_format::mantissa_explicit_bits(); word = negative ? word | (uint64_t(1) << binary_format::sign_index()) : word; #if FASTFLOAT_IS_BIG_ENDIAN == 1 if (std::is_same::value) { ::memcpy(&value, (char *)&word + 4, sizeof(T)); // extract value at offset 4-7 if float on big-endian } else { ::memcpy(&value, &word, sizeof(T)); } #else // For little-endian systems: ::memcpy(&value, &word, sizeof(T)); #endif } } // namespace fast_float #endif #ifndef FASTFLOAT_ASCII_NUMBER_H #define FASTFLOAT_ASCII_NUMBER_H #include #include #include #include namespace fast_float { // Next function can be micro-optimized, but compilers are entirely // able to optimize it well. fastfloat_really_inline bool is_integer(char c) noexcept { return c >= '0' && c <= '9'; } fastfloat_really_inline uint64_t byteswap(uint64_t val) { return (val & 0xFF00000000000000) >> 56 | (val & 0x00FF000000000000) >> 40 | (val & 0x0000FF0000000000) >> 24 | (val & 0x000000FF00000000) >> 8 | (val & 0x00000000FF000000) << 8 | (val & 0x0000000000FF0000) << 24 | (val & 0x000000000000FF00) << 40 | (val & 0x00000000000000FF) << 56; } fastfloat_really_inline uint64_t read_u64(const char *chars) { uint64_t val; ::memcpy(&val, chars, sizeof(uint64_t)); #if FASTFLOAT_IS_BIG_ENDIAN == 1 // Need to read as-if the number was in little-endian order. val = byteswap(val); #endif return val; } fastfloat_really_inline void write_u64(uint8_t *chars, uint64_t val) { #if FASTFLOAT_IS_BIG_ENDIAN == 1 // Need to read as-if the number was in little-endian order. val = byteswap(val); #endif ::memcpy(chars, &val, sizeof(uint64_t)); } // credit @aqrit fastfloat_really_inline uint32_t parse_eight_digits_unrolled(uint64_t val) { const uint64_t mask = 0x000000FF000000FF; const uint64_t mul1 = 0x000F424000000064; // 100 + (1000000ULL << 32) const uint64_t mul2 = 0x0000271000000001; // 1 + (10000ULL << 32) val -= 0x3030303030303030; val = (val * 10) + (val >> 8); // val = (val * 2561) >> 8; val = (((val & mask) * mul1) + (((val >> 16) & mask) * mul2)) >> 32; return uint32_t(val); } fastfloat_really_inline uint32_t parse_eight_digits_unrolled(const char *chars) noexcept { return parse_eight_digits_unrolled(read_u64(chars)); } // credit @aqrit fastfloat_really_inline bool is_made_of_eight_digits_fast(uint64_t val) noexcept { return !((((val + 0x4646464646464646) | (val - 0x3030303030303030)) & 0x8080808080808080)); } fastfloat_really_inline bool is_made_of_eight_digits_fast(const char *chars) noexcept { return is_made_of_eight_digits_fast(read_u64(chars)); } typedef span byte_span; struct parsed_number_string { int64_t exponent{0}; uint64_t mantissa{0}; const char *lastmatch{nullptr}; bool negative{false}; bool valid{false}; bool too_many_digits{false}; // contains the range of the significant digits byte_span integer{}; // non-nullable byte_span fraction{}; // nullable }; // Assuming that you use no more than 19 digits, this will // parse an ASCII string. fastfloat_really_inline parsed_number_string parse_number_string(const char *p, const char *pend, parse_options options) noexcept { const chars_format fmt = options.format; const char decimal_point = options.decimal_point; parsed_number_string answer; answer.valid = false; answer.too_many_digits = false; answer.negative = (*p == '-'); if (*p == '-') { // C++17 20.19.3.(7.1) explicitly forbids '+' sign here ++p; if (p == pend) { return answer; } if (!is_integer(*p) && (*p != decimal_point)) { // a sign must be followed by an integer or the dot return answer; } } const char *const start_digits = p; uint64_t i = 0; // an unsigned int avoids signed overflows (which are bad) while ((std::distance(p, pend) >= 8) && is_made_of_eight_digits_fast(p)) { i = i * 100000000 + parse_eight_digits_unrolled(p); // in rare cases, this will overflow, but that's ok p += 8; } while ((p != pend) && is_integer(*p)) { // a multiplication by 10 is cheaper than an arbitrary integer // multiplication i = 10 * i + uint64_t(*p - '0'); // might overflow, we will handle the overflow later ++p; } const char *const end_of_integer_part = p; int64_t digit_count = int64_t(end_of_integer_part - start_digits); answer.integer = byte_span(start_digits, size_t(digit_count)); int64_t exponent = 0; if ((p != pend) && (*p == decimal_point)) { ++p; const char* before = p; // can occur at most twice without overflowing, but let it occur more, since // for integers with many digits, digit parsing is the primary bottleneck. while ((std::distance(p, pend) >= 8) && is_made_of_eight_digits_fast(p)) { i = i * 100000000 + parse_eight_digits_unrolled(p); // in rare cases, this will overflow, but that's ok p += 8; } while ((p != pend) && is_integer(*p)) { uint8_t digit = uint8_t(*p - '0'); ++p; i = i * 10 + digit; // in rare cases, this will overflow, but that's ok } exponent = before - p; answer.fraction = byte_span(before, size_t(p - before)); digit_count -= exponent; } // we must have encountered at least one integer! if (digit_count == 0) { return answer; } int64_t exp_number = 0; // explicit exponential part if ((fmt & chars_format::scientific) && (p != pend) && (('e' == *p) || ('E' == *p))) { const char * location_of_e = p; ++p; bool neg_exp = false; if ((p != pend) && ('-' == *p)) { neg_exp = true; ++p; } else if ((p != pend) && ('+' == *p)) { // '+' on exponent is allowed by C++17 20.19.3.(7.1) ++p; } if ((p == pend) || !is_integer(*p)) { if(!(fmt & chars_format::fixed)) { // We are in error. return answer; } // Otherwise, we will be ignoring the 'e'. p = location_of_e; } else { while ((p != pend) && is_integer(*p)) { uint8_t digit = uint8_t(*p - '0'); if (exp_number < 0x10000000) { exp_number = 10 * exp_number + digit; } ++p; } if(neg_exp) { exp_number = - exp_number; } exponent += exp_number; } } else { // If it scientific and not fixed, we have to bail out. if((fmt & chars_format::scientific) && !(fmt & chars_format::fixed)) { return answer; } } answer.lastmatch = p; answer.valid = true; // If we frequently had to deal with long strings of digits, // we could extend our code by using a 128-bit integer instead // of a 64-bit integer. However, this is uncommon. // // We can deal with up to 19 digits. if (digit_count > 19) { // this is uncommon // It is possible that the integer had an overflow. // We have to handle the case where we have 0.0000somenumber. // We need to be mindful of the case where we only have zeroes... // E.g., 0.000000000...000. const char *start = start_digits; while ((start != pend) && (*start == '0' || *start == decimal_point)) { if(*start == '0') { digit_count --; } start++; } if (digit_count > 19) { answer.too_many_digits = true; // Let us start again, this time, avoiding overflows. // We don't need to check if is_integer, since we use the // pre-tokenized spans from above. i = 0; p = answer.integer.ptr; const char* int_end = p + answer.integer.len(); const uint64_t minimal_nineteen_digit_integer{1000000000000000000}; while((i < minimal_nineteen_digit_integer) && (p != int_end)) { i = i * 10 + uint64_t(*p - '0'); ++p; } if (i >= minimal_nineteen_digit_integer) { // We have a big integers exponent = end_of_integer_part - p + exp_number; } else { // We have a value with a fractional component. p = answer.fraction.ptr; const char* frac_end = p + answer.fraction.len(); while((i < minimal_nineteen_digit_integer) && (p != frac_end)) { i = i * 10 + uint64_t(*p - '0'); ++p; } exponent = answer.fraction.ptr - p + exp_number; } // We have now corrected both exponent and i, to a truncated value } } answer.exponent = exponent; answer.mantissa = i; return answer; } } // namespace fast_float #endif #ifndef FASTFLOAT_FAST_TABLE_H #define FASTFLOAT_FAST_TABLE_H #include namespace fast_float { /** * When mapping numbers from decimal to binary, * we go from w * 10^q to m * 2^p but we have * 10^q = 5^q * 2^q, so effectively * we are trying to match * w * 2^q * 5^q to m * 2^p. Thus the powers of two * are not a concern since they can be represented * exactly using the binary notation, only the powers of five * affect the binary significand. */ /** * The smallest non-zero float (binary64) is 2^−1074. * We take as input numbers of the form w x 10^q where w < 2^64. * We have that w * 10^-343 < 2^(64-344) 5^-343 < 2^-1076. * However, we have that * (2^64-1) * 10^-342 = (2^64-1) * 2^-342 * 5^-342 > 2^−1074. * Thus it is possible for a number of the form w * 10^-342 where * w is a 64-bit value to be a non-zero floating-point number. ********* * Any number of form w * 10^309 where w>= 1 is going to be * infinite in binary64 so we never need to worry about powers * of 5 greater than 308. */ template struct powers_template { constexpr static int smallest_power_of_five = binary_format::smallest_power_of_ten(); constexpr static int largest_power_of_five = binary_format::largest_power_of_ten(); constexpr static int number_of_entries = 2 * (largest_power_of_five - smallest_power_of_five + 1); // Powers of five from 5^-342 all the way to 5^308 rounded toward one. static const uint64_t power_of_five_128[number_of_entries]; }; template const uint64_t powers_template::power_of_five_128[number_of_entries] = { 0xeef453d6923bd65a,0x113faa2906a13b3f, 0x9558b4661b6565f8,0x4ac7ca59a424c507, 0xbaaee17fa23ebf76,0x5d79bcf00d2df649, 0xe95a99df8ace6f53,0xf4d82c2c107973dc, 0x91d8a02bb6c10594,0x79071b9b8a4be869, 0xb64ec836a47146f9,0x9748e2826cdee284, 0xe3e27a444d8d98b7,0xfd1b1b2308169b25, 0x8e6d8c6ab0787f72,0xfe30f0f5e50e20f7, 0xb208ef855c969f4f,0xbdbd2d335e51a935, 0xde8b2b66b3bc4723,0xad2c788035e61382, 0x8b16fb203055ac76,0x4c3bcb5021afcc31, 0xaddcb9e83c6b1793,0xdf4abe242a1bbf3d, 0xd953e8624b85dd78,0xd71d6dad34a2af0d, 0x87d4713d6f33aa6b,0x8672648c40e5ad68, 0xa9c98d8ccb009506,0x680efdaf511f18c2, 0xd43bf0effdc0ba48,0x212bd1b2566def2, 0x84a57695fe98746d,0x14bb630f7604b57, 0xa5ced43b7e3e9188,0x419ea3bd35385e2d, 0xcf42894a5dce35ea,0x52064cac828675b9, 0x818995ce7aa0e1b2,0x7343efebd1940993, 0xa1ebfb4219491a1f,0x1014ebe6c5f90bf8, 0xca66fa129f9b60a6,0xd41a26e077774ef6, 0xfd00b897478238d0,0x8920b098955522b4, 0x9e20735e8cb16382,0x55b46e5f5d5535b0, 0xc5a890362fddbc62,0xeb2189f734aa831d, 0xf712b443bbd52b7b,0xa5e9ec7501d523e4, 0x9a6bb0aa55653b2d,0x47b233c92125366e, 0xc1069cd4eabe89f8,0x999ec0bb696e840a, 0xf148440a256e2c76,0xc00670ea43ca250d, 0x96cd2a865764dbca,0x380406926a5e5728, 0xbc807527ed3e12bc,0xc605083704f5ecf2, 0xeba09271e88d976b,0xf7864a44c633682e, 0x93445b8731587ea3,0x7ab3ee6afbe0211d, 0xb8157268fdae9e4c,0x5960ea05bad82964, 0xe61acf033d1a45df,0x6fb92487298e33bd, 0x8fd0c16206306bab,0xa5d3b6d479f8e056, 0xb3c4f1ba87bc8696,0x8f48a4899877186c, 0xe0b62e2929aba83c,0x331acdabfe94de87, 0x8c71dcd9ba0b4925,0x9ff0c08b7f1d0b14, 0xaf8e5410288e1b6f,0x7ecf0ae5ee44dd9, 0xdb71e91432b1a24a,0xc9e82cd9f69d6150, 0x892731ac9faf056e,0xbe311c083a225cd2, 0xab70fe17c79ac6ca,0x6dbd630a48aaf406, 0xd64d3d9db981787d,0x92cbbccdad5b108, 0x85f0468293f0eb4e,0x25bbf56008c58ea5, 0xa76c582338ed2621,0xaf2af2b80af6f24e, 0xd1476e2c07286faa,0x1af5af660db4aee1, 0x82cca4db847945ca,0x50d98d9fc890ed4d, 0xa37fce126597973c,0xe50ff107bab528a0, 0xcc5fc196fefd7d0c,0x1e53ed49a96272c8, 0xff77b1fcbebcdc4f,0x25e8e89c13bb0f7a, 0x9faacf3df73609b1,0x77b191618c54e9ac, 0xc795830d75038c1d,0xd59df5b9ef6a2417, 0xf97ae3d0d2446f25,0x4b0573286b44ad1d, 0x9becce62836ac577,0x4ee367f9430aec32, 0xc2e801fb244576d5,0x229c41f793cda73f, 0xf3a20279ed56d48a,0x6b43527578c1110f, 0x9845418c345644d6,0x830a13896b78aaa9, 0xbe5691ef416bd60c,0x23cc986bc656d553, 0xedec366b11c6cb8f,0x2cbfbe86b7ec8aa8, 0x94b3a202eb1c3f39,0x7bf7d71432f3d6a9, 0xb9e08a83a5e34f07,0xdaf5ccd93fb0cc53, 0xe858ad248f5c22c9,0xd1b3400f8f9cff68, 0x91376c36d99995be,0x23100809b9c21fa1, 0xb58547448ffffb2d,0xabd40a0c2832a78a, 0xe2e69915b3fff9f9,0x16c90c8f323f516c, 0x8dd01fad907ffc3b,0xae3da7d97f6792e3, 0xb1442798f49ffb4a,0x99cd11cfdf41779c, 0xdd95317f31c7fa1d,0x40405643d711d583, 0x8a7d3eef7f1cfc52,0x482835ea666b2572, 0xad1c8eab5ee43b66,0xda3243650005eecf, 0xd863b256369d4a40,0x90bed43e40076a82, 0x873e4f75e2224e68,0x5a7744a6e804a291, 0xa90de3535aaae202,0x711515d0a205cb36, 0xd3515c2831559a83,0xd5a5b44ca873e03, 0x8412d9991ed58091,0xe858790afe9486c2, 0xa5178fff668ae0b6,0x626e974dbe39a872, 0xce5d73ff402d98e3,0xfb0a3d212dc8128f, 0x80fa687f881c7f8e,0x7ce66634bc9d0b99, 0xa139029f6a239f72,0x1c1fffc1ebc44e80, 0xc987434744ac874e,0xa327ffb266b56220, 0xfbe9141915d7a922,0x4bf1ff9f0062baa8, 0x9d71ac8fada6c9b5,0x6f773fc3603db4a9, 0xc4ce17b399107c22,0xcb550fb4384d21d3, 0xf6019da07f549b2b,0x7e2a53a146606a48, 0x99c102844f94e0fb,0x2eda7444cbfc426d, 0xc0314325637a1939,0xfa911155fefb5308, 0xf03d93eebc589f88,0x793555ab7eba27ca, 0x96267c7535b763b5,0x4bc1558b2f3458de, 0xbbb01b9283253ca2,0x9eb1aaedfb016f16, 0xea9c227723ee8bcb,0x465e15a979c1cadc, 0x92a1958a7675175f,0xbfacd89ec191ec9, 0xb749faed14125d36,0xcef980ec671f667b, 0xe51c79a85916f484,0x82b7e12780e7401a, 0x8f31cc0937ae58d2,0xd1b2ecb8b0908810, 0xb2fe3f0b8599ef07,0x861fa7e6dcb4aa15, 0xdfbdcece67006ac9,0x67a791e093e1d49a, 0x8bd6a141006042bd,0xe0c8bb2c5c6d24e0, 0xaecc49914078536d,0x58fae9f773886e18, 0xda7f5bf590966848,0xaf39a475506a899e, 0x888f99797a5e012d,0x6d8406c952429603, 0xaab37fd7d8f58178,0xc8e5087ba6d33b83, 0xd5605fcdcf32e1d6,0xfb1e4a9a90880a64, 0x855c3be0a17fcd26,0x5cf2eea09a55067f, 0xa6b34ad8c9dfc06f,0xf42faa48c0ea481e, 0xd0601d8efc57b08b,0xf13b94daf124da26, 0x823c12795db6ce57,0x76c53d08d6b70858, 0xa2cb1717b52481ed,0x54768c4b0c64ca6e, 0xcb7ddcdda26da268,0xa9942f5dcf7dfd09, 0xfe5d54150b090b02,0xd3f93b35435d7c4c, 0x9efa548d26e5a6e1,0xc47bc5014a1a6daf, 0xc6b8e9b0709f109a,0x359ab6419ca1091b, 0xf867241c8cc6d4c0,0xc30163d203c94b62, 0x9b407691d7fc44f8,0x79e0de63425dcf1d, 0xc21094364dfb5636,0x985915fc12f542e4, 0xf294b943e17a2bc4,0x3e6f5b7b17b2939d, 0x979cf3ca6cec5b5a,0xa705992ceecf9c42, 0xbd8430bd08277231,0x50c6ff782a838353, 0xece53cec4a314ebd,0xa4f8bf5635246428, 0x940f4613ae5ed136,0x871b7795e136be99, 0xb913179899f68584,0x28e2557b59846e3f, 0xe757dd7ec07426e5,0x331aeada2fe589cf, 0x9096ea6f3848984f,0x3ff0d2c85def7621, 0xb4bca50b065abe63,0xfed077a756b53a9, 0xe1ebce4dc7f16dfb,0xd3e8495912c62894, 0x8d3360f09cf6e4bd,0x64712dd7abbbd95c, 0xb080392cc4349dec,0xbd8d794d96aacfb3, 0xdca04777f541c567,0xecf0d7a0fc5583a0, 0x89e42caaf9491b60,0xf41686c49db57244, 0xac5d37d5b79b6239,0x311c2875c522ced5, 0xd77485cb25823ac7,0x7d633293366b828b, 0x86a8d39ef77164bc,0xae5dff9c02033197, 0xa8530886b54dbdeb,0xd9f57f830283fdfc, 0xd267caa862a12d66,0xd072df63c324fd7b, 0x8380dea93da4bc60,0x4247cb9e59f71e6d, 0xa46116538d0deb78,0x52d9be85f074e608, 0xcd795be870516656,0x67902e276c921f8b, 0x806bd9714632dff6,0xba1cd8a3db53b6, 0xa086cfcd97bf97f3,0x80e8a40eccd228a4, 0xc8a883c0fdaf7df0,0x6122cd128006b2cd, 0xfad2a4b13d1b5d6c,0x796b805720085f81, 0x9cc3a6eec6311a63,0xcbe3303674053bb0, 0xc3f490aa77bd60fc,0xbedbfc4411068a9c, 0xf4f1b4d515acb93b,0xee92fb5515482d44, 0x991711052d8bf3c5,0x751bdd152d4d1c4a, 0xbf5cd54678eef0b6,0xd262d45a78a0635d, 0xef340a98172aace4,0x86fb897116c87c34, 0x9580869f0e7aac0e,0xd45d35e6ae3d4da0, 0xbae0a846d2195712,0x8974836059cca109, 0xe998d258869facd7,0x2bd1a438703fc94b, 0x91ff83775423cc06,0x7b6306a34627ddcf, 0xb67f6455292cbf08,0x1a3bc84c17b1d542, 0xe41f3d6a7377eeca,0x20caba5f1d9e4a93, 0x8e938662882af53e,0x547eb47b7282ee9c, 0xb23867fb2a35b28d,0xe99e619a4f23aa43, 0xdec681f9f4c31f31,0x6405fa00e2ec94d4, 0x8b3c113c38f9f37e,0xde83bc408dd3dd04, 0xae0b158b4738705e,0x9624ab50b148d445, 0xd98ddaee19068c76,0x3badd624dd9b0957, 0x87f8a8d4cfa417c9,0xe54ca5d70a80e5d6, 0xa9f6d30a038d1dbc,0x5e9fcf4ccd211f4c, 0xd47487cc8470652b,0x7647c3200069671f, 0x84c8d4dfd2c63f3b,0x29ecd9f40041e073, 0xa5fb0a17c777cf09,0xf468107100525890, 0xcf79cc9db955c2cc,0x7182148d4066eeb4, 0x81ac1fe293d599bf,0xc6f14cd848405530, 0xa21727db38cb002f,0xb8ada00e5a506a7c, 0xca9cf1d206fdc03b,0xa6d90811f0e4851c, 0xfd442e4688bd304a,0x908f4a166d1da663, 0x9e4a9cec15763e2e,0x9a598e4e043287fe, 0xc5dd44271ad3cdba,0x40eff1e1853f29fd, 0xf7549530e188c128,0xd12bee59e68ef47c, 0x9a94dd3e8cf578b9,0x82bb74f8301958ce, 0xc13a148e3032d6e7,0xe36a52363c1faf01, 0xf18899b1bc3f8ca1,0xdc44e6c3cb279ac1, 0x96f5600f15a7b7e5,0x29ab103a5ef8c0b9, 0xbcb2b812db11a5de,0x7415d448f6b6f0e7, 0xebdf661791d60f56,0x111b495b3464ad21, 0x936b9fcebb25c995,0xcab10dd900beec34, 0xb84687c269ef3bfb,0x3d5d514f40eea742, 0xe65829b3046b0afa,0xcb4a5a3112a5112, 0x8ff71a0fe2c2e6dc,0x47f0e785eaba72ab, 0xb3f4e093db73a093,0x59ed216765690f56, 0xe0f218b8d25088b8,0x306869c13ec3532c, 0x8c974f7383725573,0x1e414218c73a13fb, 0xafbd2350644eeacf,0xe5d1929ef90898fa, 0xdbac6c247d62a583,0xdf45f746b74abf39, 0x894bc396ce5da772,0x6b8bba8c328eb783, 0xab9eb47c81f5114f,0x66ea92f3f326564, 0xd686619ba27255a2,0xc80a537b0efefebd, 0x8613fd0145877585,0xbd06742ce95f5f36, 0xa798fc4196e952e7,0x2c48113823b73704, 0xd17f3b51fca3a7a0,0xf75a15862ca504c5, 0x82ef85133de648c4,0x9a984d73dbe722fb, 0xa3ab66580d5fdaf5,0xc13e60d0d2e0ebba, 0xcc963fee10b7d1b3,0x318df905079926a8, 0xffbbcfe994e5c61f,0xfdf17746497f7052, 0x9fd561f1fd0f9bd3,0xfeb6ea8bedefa633, 0xc7caba6e7c5382c8,0xfe64a52ee96b8fc0, 0xf9bd690a1b68637b,0x3dfdce7aa3c673b0, 0x9c1661a651213e2d,0x6bea10ca65c084e, 0xc31bfa0fe5698db8,0x486e494fcff30a62, 0xf3e2f893dec3f126,0x5a89dba3c3efccfa, 0x986ddb5c6b3a76b7,0xf89629465a75e01c, 0xbe89523386091465,0xf6bbb397f1135823, 0xee2ba6c0678b597f,0x746aa07ded582e2c, 0x94db483840b717ef,0xa8c2a44eb4571cdc, 0xba121a4650e4ddeb,0x92f34d62616ce413, 0xe896a0d7e51e1566,0x77b020baf9c81d17, 0x915e2486ef32cd60,0xace1474dc1d122e, 0xb5b5ada8aaff80b8,0xd819992132456ba, 0xe3231912d5bf60e6,0x10e1fff697ed6c69, 0x8df5efabc5979c8f,0xca8d3ffa1ef463c1, 0xb1736b96b6fd83b3,0xbd308ff8a6b17cb2, 0xddd0467c64bce4a0,0xac7cb3f6d05ddbde, 0x8aa22c0dbef60ee4,0x6bcdf07a423aa96b, 0xad4ab7112eb3929d,0x86c16c98d2c953c6, 0xd89d64d57a607744,0xe871c7bf077ba8b7, 0x87625f056c7c4a8b,0x11471cd764ad4972, 0xa93af6c6c79b5d2d,0xd598e40d3dd89bcf, 0xd389b47879823479,0x4aff1d108d4ec2c3, 0x843610cb4bf160cb,0xcedf722a585139ba, 0xa54394fe1eedb8fe,0xc2974eb4ee658828, 0xce947a3da6a9273e,0x733d226229feea32, 0x811ccc668829b887,0x806357d5a3f525f, 0xa163ff802a3426a8,0xca07c2dcb0cf26f7, 0xc9bcff6034c13052,0xfc89b393dd02f0b5, 0xfc2c3f3841f17c67,0xbbac2078d443ace2, 0x9d9ba7832936edc0,0xd54b944b84aa4c0d, 0xc5029163f384a931,0xa9e795e65d4df11, 0xf64335bcf065d37d,0x4d4617b5ff4a16d5, 0x99ea0196163fa42e,0x504bced1bf8e4e45, 0xc06481fb9bcf8d39,0xe45ec2862f71e1d6, 0xf07da27a82c37088,0x5d767327bb4e5a4c, 0x964e858c91ba2655,0x3a6a07f8d510f86f, 0xbbe226efb628afea,0x890489f70a55368b, 0xeadab0aba3b2dbe5,0x2b45ac74ccea842e, 0x92c8ae6b464fc96f,0x3b0b8bc90012929d, 0xb77ada0617e3bbcb,0x9ce6ebb40173744, 0xe55990879ddcaabd,0xcc420a6a101d0515, 0x8f57fa54c2a9eab6,0x9fa946824a12232d, 0xb32df8e9f3546564,0x47939822dc96abf9, 0xdff9772470297ebd,0x59787e2b93bc56f7, 0x8bfbea76c619ef36,0x57eb4edb3c55b65a, 0xaefae51477a06b03,0xede622920b6b23f1, 0xdab99e59958885c4,0xe95fab368e45eced, 0x88b402f7fd75539b,0x11dbcb0218ebb414, 0xaae103b5fcd2a881,0xd652bdc29f26a119, 0xd59944a37c0752a2,0x4be76d3346f0495f, 0x857fcae62d8493a5,0x6f70a4400c562ddb, 0xa6dfbd9fb8e5b88e,0xcb4ccd500f6bb952, 0xd097ad07a71f26b2,0x7e2000a41346a7a7, 0x825ecc24c873782f,0x8ed400668c0c28c8, 0xa2f67f2dfa90563b,0x728900802f0f32fa, 0xcbb41ef979346bca,0x4f2b40a03ad2ffb9, 0xfea126b7d78186bc,0xe2f610c84987bfa8, 0x9f24b832e6b0f436,0xdd9ca7d2df4d7c9, 0xc6ede63fa05d3143,0x91503d1c79720dbb, 0xf8a95fcf88747d94,0x75a44c6397ce912a, 0x9b69dbe1b548ce7c,0xc986afbe3ee11aba, 0xc24452da229b021b,0xfbe85badce996168, 0xf2d56790ab41c2a2,0xfae27299423fb9c3, 0x97c560ba6b0919a5,0xdccd879fc967d41a, 0xbdb6b8e905cb600f,0x5400e987bbc1c920, 0xed246723473e3813,0x290123e9aab23b68, 0x9436c0760c86e30b,0xf9a0b6720aaf6521, 0xb94470938fa89bce,0xf808e40e8d5b3e69, 0xe7958cb87392c2c2,0xb60b1d1230b20e04, 0x90bd77f3483bb9b9,0xb1c6f22b5e6f48c2, 0xb4ecd5f01a4aa828,0x1e38aeb6360b1af3, 0xe2280b6c20dd5232,0x25c6da63c38de1b0, 0x8d590723948a535f,0x579c487e5a38ad0e, 0xb0af48ec79ace837,0x2d835a9df0c6d851, 0xdcdb1b2798182244,0xf8e431456cf88e65, 0x8a08f0f8bf0f156b,0x1b8e9ecb641b58ff, 0xac8b2d36eed2dac5,0xe272467e3d222f3f, 0xd7adf884aa879177,0x5b0ed81dcc6abb0f, 0x86ccbb52ea94baea,0x98e947129fc2b4e9, 0xa87fea27a539e9a5,0x3f2398d747b36224, 0xd29fe4b18e88640e,0x8eec7f0d19a03aad, 0x83a3eeeef9153e89,0x1953cf68300424ac, 0xa48ceaaab75a8e2b,0x5fa8c3423c052dd7, 0xcdb02555653131b6,0x3792f412cb06794d, 0x808e17555f3ebf11,0xe2bbd88bbee40bd0, 0xa0b19d2ab70e6ed6,0x5b6aceaeae9d0ec4, 0xc8de047564d20a8b,0xf245825a5a445275, 0xfb158592be068d2e,0xeed6e2f0f0d56712, 0x9ced737bb6c4183d,0x55464dd69685606b, 0xc428d05aa4751e4c,0xaa97e14c3c26b886, 0xf53304714d9265df,0xd53dd99f4b3066a8, 0x993fe2c6d07b7fab,0xe546a8038efe4029, 0xbf8fdb78849a5f96,0xde98520472bdd033, 0xef73d256a5c0f77c,0x963e66858f6d4440, 0x95a8637627989aad,0xdde7001379a44aa8, 0xbb127c53b17ec159,0x5560c018580d5d52, 0xe9d71b689dde71af,0xaab8f01e6e10b4a6, 0x9226712162ab070d,0xcab3961304ca70e8, 0xb6b00d69bb55c8d1,0x3d607b97c5fd0d22, 0xe45c10c42a2b3b05,0x8cb89a7db77c506a, 0x8eb98a7a9a5b04e3,0x77f3608e92adb242, 0xb267ed1940f1c61c,0x55f038b237591ed3, 0xdf01e85f912e37a3,0x6b6c46dec52f6688, 0x8b61313bbabce2c6,0x2323ac4b3b3da015, 0xae397d8aa96c1b77,0xabec975e0a0d081a, 0xd9c7dced53c72255,0x96e7bd358c904a21, 0x881cea14545c7575,0x7e50d64177da2e54, 0xaa242499697392d2,0xdde50bd1d5d0b9e9, 0xd4ad2dbfc3d07787,0x955e4ec64b44e864, 0x84ec3c97da624ab4,0xbd5af13bef0b113e, 0xa6274bbdd0fadd61,0xecb1ad8aeacdd58e, 0xcfb11ead453994ba,0x67de18eda5814af2, 0x81ceb32c4b43fcf4,0x80eacf948770ced7, 0xa2425ff75e14fc31,0xa1258379a94d028d, 0xcad2f7f5359a3b3e,0x96ee45813a04330, 0xfd87b5f28300ca0d,0x8bca9d6e188853fc, 0x9e74d1b791e07e48,0x775ea264cf55347e, 0xc612062576589dda,0x95364afe032a819e, 0xf79687aed3eec551,0x3a83ddbd83f52205, 0x9abe14cd44753b52,0xc4926a9672793543, 0xc16d9a0095928a27,0x75b7053c0f178294, 0xf1c90080baf72cb1,0x5324c68b12dd6339, 0x971da05074da7bee,0xd3f6fc16ebca5e04, 0xbce5086492111aea,0x88f4bb1ca6bcf585, 0xec1e4a7db69561a5,0x2b31e9e3d06c32e6, 0x9392ee8e921d5d07,0x3aff322e62439fd0, 0xb877aa3236a4b449,0x9befeb9fad487c3, 0xe69594bec44de15b,0x4c2ebe687989a9b4, 0x901d7cf73ab0acd9,0xf9d37014bf60a11, 0xb424dc35095cd80f,0x538484c19ef38c95, 0xe12e13424bb40e13,0x2865a5f206b06fba, 0x8cbccc096f5088cb,0xf93f87b7442e45d4, 0xafebff0bcb24aafe,0xf78f69a51539d749, 0xdbe6fecebdedd5be,0xb573440e5a884d1c, 0x89705f4136b4a597,0x31680a88f8953031, 0xabcc77118461cefc,0xfdc20d2b36ba7c3e, 0xd6bf94d5e57a42bc,0x3d32907604691b4d, 0x8637bd05af6c69b5,0xa63f9a49c2c1b110, 0xa7c5ac471b478423,0xfcf80dc33721d54, 0xd1b71758e219652b,0xd3c36113404ea4a9, 0x83126e978d4fdf3b,0x645a1cac083126ea, 0xa3d70a3d70a3d70a,0x3d70a3d70a3d70a4, 0xcccccccccccccccc,0xcccccccccccccccd, 0x8000000000000000,0x0, 0xa000000000000000,0x0, 0xc800000000000000,0x0, 0xfa00000000000000,0x0, 0x9c40000000000000,0x0, 0xc350000000000000,0x0, 0xf424000000000000,0x0, 0x9896800000000000,0x0, 0xbebc200000000000,0x0, 0xee6b280000000000,0x0, 0x9502f90000000000,0x0, 0xba43b74000000000,0x0, 0xe8d4a51000000000,0x0, 0x9184e72a00000000,0x0, 0xb5e620f480000000,0x0, 0xe35fa931a0000000,0x0, 0x8e1bc9bf04000000,0x0, 0xb1a2bc2ec5000000,0x0, 0xde0b6b3a76400000,0x0, 0x8ac7230489e80000,0x0, 0xad78ebc5ac620000,0x0, 0xd8d726b7177a8000,0x0, 0x878678326eac9000,0x0, 0xa968163f0a57b400,0x0, 0xd3c21bcecceda100,0x0, 0x84595161401484a0,0x0, 0xa56fa5b99019a5c8,0x0, 0xcecb8f27f4200f3a,0x0, 0x813f3978f8940984,0x4000000000000000, 0xa18f07d736b90be5,0x5000000000000000, 0xc9f2c9cd04674ede,0xa400000000000000, 0xfc6f7c4045812296,0x4d00000000000000, 0x9dc5ada82b70b59d,0xf020000000000000, 0xc5371912364ce305,0x6c28000000000000, 0xf684df56c3e01bc6,0xc732000000000000, 0x9a130b963a6c115c,0x3c7f400000000000, 0xc097ce7bc90715b3,0x4b9f100000000000, 0xf0bdc21abb48db20,0x1e86d40000000000, 0x96769950b50d88f4,0x1314448000000000, 0xbc143fa4e250eb31,0x17d955a000000000, 0xeb194f8e1ae525fd,0x5dcfab0800000000, 0x92efd1b8d0cf37be,0x5aa1cae500000000, 0xb7abc627050305ad,0xf14a3d9e40000000, 0xe596b7b0c643c719,0x6d9ccd05d0000000, 0x8f7e32ce7bea5c6f,0xe4820023a2000000, 0xb35dbf821ae4f38b,0xdda2802c8a800000, 0xe0352f62a19e306e,0xd50b2037ad200000, 0x8c213d9da502de45,0x4526f422cc340000, 0xaf298d050e4395d6,0x9670b12b7f410000, 0xdaf3f04651d47b4c,0x3c0cdd765f114000, 0x88d8762bf324cd0f,0xa5880a69fb6ac800, 0xab0e93b6efee0053,0x8eea0d047a457a00, 0xd5d238a4abe98068,0x72a4904598d6d880, 0x85a36366eb71f041,0x47a6da2b7f864750, 0xa70c3c40a64e6c51,0x999090b65f67d924, 0xd0cf4b50cfe20765,0xfff4b4e3f741cf6d, 0x82818f1281ed449f,0xbff8f10e7a8921a4, 0xa321f2d7226895c7,0xaff72d52192b6a0d, 0xcbea6f8ceb02bb39,0x9bf4f8a69f764490, 0xfee50b7025c36a08,0x2f236d04753d5b4, 0x9f4f2726179a2245,0x1d762422c946590, 0xc722f0ef9d80aad6,0x424d3ad2b7b97ef5, 0xf8ebad2b84e0d58b,0xd2e0898765a7deb2, 0x9b934c3b330c8577,0x63cc55f49f88eb2f, 0xc2781f49ffcfa6d5,0x3cbf6b71c76b25fb, 0xf316271c7fc3908a,0x8bef464e3945ef7a, 0x97edd871cfda3a56,0x97758bf0e3cbb5ac, 0xbde94e8e43d0c8ec,0x3d52eeed1cbea317, 0xed63a231d4c4fb27,0x4ca7aaa863ee4bdd, 0x945e455f24fb1cf8,0x8fe8caa93e74ef6a, 0xb975d6b6ee39e436,0xb3e2fd538e122b44, 0xe7d34c64a9c85d44,0x60dbbca87196b616, 0x90e40fbeea1d3a4a,0xbc8955e946fe31cd, 0xb51d13aea4a488dd,0x6babab6398bdbe41, 0xe264589a4dcdab14,0xc696963c7eed2dd1, 0x8d7eb76070a08aec,0xfc1e1de5cf543ca2, 0xb0de65388cc8ada8,0x3b25a55f43294bcb, 0xdd15fe86affad912,0x49ef0eb713f39ebe, 0x8a2dbf142dfcc7ab,0x6e3569326c784337, 0xacb92ed9397bf996,0x49c2c37f07965404, 0xd7e77a8f87daf7fb,0xdc33745ec97be906, 0x86f0ac99b4e8dafd,0x69a028bb3ded71a3, 0xa8acd7c0222311bc,0xc40832ea0d68ce0c, 0xd2d80db02aabd62b,0xf50a3fa490c30190, 0x83c7088e1aab65db,0x792667c6da79e0fa, 0xa4b8cab1a1563f52,0x577001b891185938, 0xcde6fd5e09abcf26,0xed4c0226b55e6f86, 0x80b05e5ac60b6178,0x544f8158315b05b4, 0xa0dc75f1778e39d6,0x696361ae3db1c721, 0xc913936dd571c84c,0x3bc3a19cd1e38e9, 0xfb5878494ace3a5f,0x4ab48a04065c723, 0x9d174b2dcec0e47b,0x62eb0d64283f9c76, 0xc45d1df942711d9a,0x3ba5d0bd324f8394, 0xf5746577930d6500,0xca8f44ec7ee36479, 0x9968bf6abbe85f20,0x7e998b13cf4e1ecb, 0xbfc2ef456ae276e8,0x9e3fedd8c321a67e, 0xefb3ab16c59b14a2,0xc5cfe94ef3ea101e, 0x95d04aee3b80ece5,0xbba1f1d158724a12, 0xbb445da9ca61281f,0x2a8a6e45ae8edc97, 0xea1575143cf97226,0xf52d09d71a3293bd, 0x924d692ca61be758,0x593c2626705f9c56, 0xb6e0c377cfa2e12e,0x6f8b2fb00c77836c, 0xe498f455c38b997a,0xb6dfb9c0f956447, 0x8edf98b59a373fec,0x4724bd4189bd5eac, 0xb2977ee300c50fe7,0x58edec91ec2cb657, 0xdf3d5e9bc0f653e1,0x2f2967b66737e3ed, 0x8b865b215899f46c,0xbd79e0d20082ee74, 0xae67f1e9aec07187,0xecd8590680a3aa11, 0xda01ee641a708de9,0xe80e6f4820cc9495, 0x884134fe908658b2,0x3109058d147fdcdd, 0xaa51823e34a7eede,0xbd4b46f0599fd415, 0xd4e5e2cdc1d1ea96,0x6c9e18ac7007c91a, 0x850fadc09923329e,0x3e2cf6bc604ddb0, 0xa6539930bf6bff45,0x84db8346b786151c, 0xcfe87f7cef46ff16,0xe612641865679a63, 0x81f14fae158c5f6e,0x4fcb7e8f3f60c07e, 0xa26da3999aef7749,0xe3be5e330f38f09d, 0xcb090c8001ab551c,0x5cadf5bfd3072cc5, 0xfdcb4fa002162a63,0x73d9732fc7c8f7f6, 0x9e9f11c4014dda7e,0x2867e7fddcdd9afa, 0xc646d63501a1511d,0xb281e1fd541501b8, 0xf7d88bc24209a565,0x1f225a7ca91a4226, 0x9ae757596946075f,0x3375788de9b06958, 0xc1a12d2fc3978937,0x52d6b1641c83ae, 0xf209787bb47d6b84,0xc0678c5dbd23a49a, 0x9745eb4d50ce6332,0xf840b7ba963646e0, 0xbd176620a501fbff,0xb650e5a93bc3d898, 0xec5d3fa8ce427aff,0xa3e51f138ab4cebe, 0x93ba47c980e98cdf,0xc66f336c36b10137, 0xb8a8d9bbe123f017,0xb80b0047445d4184, 0xe6d3102ad96cec1d,0xa60dc059157491e5, 0x9043ea1ac7e41392,0x87c89837ad68db2f, 0xb454e4a179dd1877,0x29babe4598c311fb, 0xe16a1dc9d8545e94,0xf4296dd6fef3d67a, 0x8ce2529e2734bb1d,0x1899e4a65f58660c, 0xb01ae745b101e9e4,0x5ec05dcff72e7f8f, 0xdc21a1171d42645d,0x76707543f4fa1f73, 0x899504ae72497eba,0x6a06494a791c53a8, 0xabfa45da0edbde69,0x487db9d17636892, 0xd6f8d7509292d603,0x45a9d2845d3c42b6, 0x865b86925b9bc5c2,0xb8a2392ba45a9b2, 0xa7f26836f282b732,0x8e6cac7768d7141e, 0xd1ef0244af2364ff,0x3207d795430cd926, 0x8335616aed761f1f,0x7f44e6bd49e807b8, 0xa402b9c5a8d3a6e7,0x5f16206c9c6209a6, 0xcd036837130890a1,0x36dba887c37a8c0f, 0x802221226be55a64,0xc2494954da2c9789, 0xa02aa96b06deb0fd,0xf2db9baa10b7bd6c, 0xc83553c5c8965d3d,0x6f92829494e5acc7, 0xfa42a8b73abbf48c,0xcb772339ba1f17f9, 0x9c69a97284b578d7,0xff2a760414536efb, 0xc38413cf25e2d70d,0xfef5138519684aba, 0xf46518c2ef5b8cd1,0x7eb258665fc25d69, 0x98bf2f79d5993802,0xef2f773ffbd97a61, 0xbeeefb584aff8603,0xaafb550ffacfd8fa, 0xeeaaba2e5dbf6784,0x95ba2a53f983cf38, 0x952ab45cfa97a0b2,0xdd945a747bf26183, 0xba756174393d88df,0x94f971119aeef9e4, 0xe912b9d1478ceb17,0x7a37cd5601aab85d, 0x91abb422ccb812ee,0xac62e055c10ab33a, 0xb616a12b7fe617aa,0x577b986b314d6009, 0xe39c49765fdf9d94,0xed5a7e85fda0b80b, 0x8e41ade9fbebc27d,0x14588f13be847307, 0xb1d219647ae6b31c,0x596eb2d8ae258fc8, 0xde469fbd99a05fe3,0x6fca5f8ed9aef3bb, 0x8aec23d680043bee,0x25de7bb9480d5854, 0xada72ccc20054ae9,0xaf561aa79a10ae6a, 0xd910f7ff28069da4,0x1b2ba1518094da04, 0x87aa9aff79042286,0x90fb44d2f05d0842, 0xa99541bf57452b28,0x353a1607ac744a53, 0xd3fa922f2d1675f2,0x42889b8997915ce8, 0x847c9b5d7c2e09b7,0x69956135febada11, 0xa59bc234db398c25,0x43fab9837e699095, 0xcf02b2c21207ef2e,0x94f967e45e03f4bb, 0x8161afb94b44f57d,0x1d1be0eebac278f5, 0xa1ba1ba79e1632dc,0x6462d92a69731732, 0xca28a291859bbf93,0x7d7b8f7503cfdcfe, 0xfcb2cb35e702af78,0x5cda735244c3d43e, 0x9defbf01b061adab,0x3a0888136afa64a7, 0xc56baec21c7a1916,0x88aaa1845b8fdd0, 0xf6c69a72a3989f5b,0x8aad549e57273d45, 0x9a3c2087a63f6399,0x36ac54e2f678864b, 0xc0cb28a98fcf3c7f,0x84576a1bb416a7dd, 0xf0fdf2d3f3c30b9f,0x656d44a2a11c51d5, 0x969eb7c47859e743,0x9f644ae5a4b1b325, 0xbc4665b596706114,0x873d5d9f0dde1fee, 0xeb57ff22fc0c7959,0xa90cb506d155a7ea, 0x9316ff75dd87cbd8,0x9a7f12442d588f2, 0xb7dcbf5354e9bece,0xc11ed6d538aeb2f, 0xe5d3ef282a242e81,0x8f1668c8a86da5fa, 0x8fa475791a569d10,0xf96e017d694487bc, 0xb38d92d760ec4455,0x37c981dcc395a9ac, 0xe070f78d3927556a,0x85bbe253f47b1417, 0x8c469ab843b89562,0x93956d7478ccec8e, 0xaf58416654a6babb,0x387ac8d1970027b2, 0xdb2e51bfe9d0696a,0x6997b05fcc0319e, 0x88fcf317f22241e2,0x441fece3bdf81f03, 0xab3c2fddeeaad25a,0xd527e81cad7626c3, 0xd60b3bd56a5586f1,0x8a71e223d8d3b074, 0x85c7056562757456,0xf6872d5667844e49, 0xa738c6bebb12d16c,0xb428f8ac016561db, 0xd106f86e69d785c7,0xe13336d701beba52, 0x82a45b450226b39c,0xecc0024661173473, 0xa34d721642b06084,0x27f002d7f95d0190, 0xcc20ce9bd35c78a5,0x31ec038df7b441f4, 0xff290242c83396ce,0x7e67047175a15271, 0x9f79a169bd203e41,0xf0062c6e984d386, 0xc75809c42c684dd1,0x52c07b78a3e60868, 0xf92e0c3537826145,0xa7709a56ccdf8a82, 0x9bbcc7a142b17ccb,0x88a66076400bb691, 0xc2abf989935ddbfe,0x6acff893d00ea435, 0xf356f7ebf83552fe,0x583f6b8c4124d43, 0x98165af37b2153de,0xc3727a337a8b704a, 0xbe1bf1b059e9a8d6,0x744f18c0592e4c5c, 0xeda2ee1c7064130c,0x1162def06f79df73, 0x9485d4d1c63e8be7,0x8addcb5645ac2ba8, 0xb9a74a0637ce2ee1,0x6d953e2bd7173692, 0xe8111c87c5c1ba99,0xc8fa8db6ccdd0437, 0x910ab1d4db9914a0,0x1d9c9892400a22a2, 0xb54d5e4a127f59c8,0x2503beb6d00cab4b, 0xe2a0b5dc971f303a,0x2e44ae64840fd61d, 0x8da471a9de737e24,0x5ceaecfed289e5d2, 0xb10d8e1456105dad,0x7425a83e872c5f47, 0xdd50f1996b947518,0xd12f124e28f77719, 0x8a5296ffe33cc92f,0x82bd6b70d99aaa6f, 0xace73cbfdc0bfb7b,0x636cc64d1001550b, 0xd8210befd30efa5a,0x3c47f7e05401aa4e, 0x8714a775e3e95c78,0x65acfaec34810a71, 0xa8d9d1535ce3b396,0x7f1839a741a14d0d, 0xd31045a8341ca07c,0x1ede48111209a050, 0x83ea2b892091e44d,0x934aed0aab460432, 0xa4e4b66b68b65d60,0xf81da84d5617853f, 0xce1de40642e3f4b9,0x36251260ab9d668e, 0x80d2ae83e9ce78f3,0xc1d72b7c6b426019, 0xa1075a24e4421730,0xb24cf65b8612f81f, 0xc94930ae1d529cfc,0xdee033f26797b627, 0xfb9b7cd9a4a7443c,0x169840ef017da3b1, 0x9d412e0806e88aa5,0x8e1f289560ee864e, 0xc491798a08a2ad4e,0xf1a6f2bab92a27e2, 0xf5b5d7ec8acb58a2,0xae10af696774b1db, 0x9991a6f3d6bf1765,0xacca6da1e0a8ef29, 0xbff610b0cc6edd3f,0x17fd090a58d32af3, 0xeff394dcff8a948e,0xddfc4b4cef07f5b0, 0x95f83d0a1fb69cd9,0x4abdaf101564f98e, 0xbb764c4ca7a4440f,0x9d6d1ad41abe37f1, 0xea53df5fd18d5513,0x84c86189216dc5ed, 0x92746b9be2f8552c,0x32fd3cf5b4e49bb4, 0xb7118682dbb66a77,0x3fbc8c33221dc2a1, 0xe4d5e82392a40515,0xfabaf3feaa5334a, 0x8f05b1163ba6832d,0x29cb4d87f2a7400e, 0xb2c71d5bca9023f8,0x743e20e9ef511012, 0xdf78e4b2bd342cf6,0x914da9246b255416, 0x8bab8eefb6409c1a,0x1ad089b6c2f7548e, 0xae9672aba3d0c320,0xa184ac2473b529b1, 0xda3c0f568cc4f3e8,0xc9e5d72d90a2741e, 0x8865899617fb1871,0x7e2fa67c7a658892, 0xaa7eebfb9df9de8d,0xddbb901b98feeab7, 0xd51ea6fa85785631,0x552a74227f3ea565, 0x8533285c936b35de,0xd53a88958f87275f, 0xa67ff273b8460356,0x8a892abaf368f137, 0xd01fef10a657842c,0x2d2b7569b0432d85, 0x8213f56a67f6b29b,0x9c3b29620e29fc73, 0xa298f2c501f45f42,0x8349f3ba91b47b8f, 0xcb3f2f7642717713,0x241c70a936219a73, 0xfe0efb53d30dd4d7,0xed238cd383aa0110, 0x9ec95d1463e8a506,0xf4363804324a40aa, 0xc67bb4597ce2ce48,0xb143c6053edcd0d5, 0xf81aa16fdc1b81da,0xdd94b7868e94050a, 0x9b10a4e5e9913128,0xca7cf2b4191c8326, 0xc1d4ce1f63f57d72,0xfd1c2f611f63a3f0, 0xf24a01a73cf2dccf,0xbc633b39673c8cec, 0x976e41088617ca01,0xd5be0503e085d813, 0xbd49d14aa79dbc82,0x4b2d8644d8a74e18, 0xec9c459d51852ba2,0xddf8e7d60ed1219e, 0x93e1ab8252f33b45,0xcabb90e5c942b503, 0xb8da1662e7b00a17,0x3d6a751f3b936243, 0xe7109bfba19c0c9d,0xcc512670a783ad4, 0x906a617d450187e2,0x27fb2b80668b24c5, 0xb484f9dc9641e9da,0xb1f9f660802dedf6, 0xe1a63853bbd26451,0x5e7873f8a0396973, 0x8d07e33455637eb2,0xdb0b487b6423e1e8, 0xb049dc016abc5e5f,0x91ce1a9a3d2cda62, 0xdc5c5301c56b75f7,0x7641a140cc7810fb, 0x89b9b3e11b6329ba,0xa9e904c87fcb0a9d, 0xac2820d9623bf429,0x546345fa9fbdcd44, 0xd732290fbacaf133,0xa97c177947ad4095, 0x867f59a9d4bed6c0,0x49ed8eabcccc485d, 0xa81f301449ee8c70,0x5c68f256bfff5a74, 0xd226fc195c6a2f8c,0x73832eec6fff3111, 0x83585d8fd9c25db7,0xc831fd53c5ff7eab, 0xa42e74f3d032f525,0xba3e7ca8b77f5e55, 0xcd3a1230c43fb26f,0x28ce1bd2e55f35eb, 0x80444b5e7aa7cf85,0x7980d163cf5b81b3, 0xa0555e361951c366,0xd7e105bcc332621f, 0xc86ab5c39fa63440,0x8dd9472bf3fefaa7, 0xfa856334878fc150,0xb14f98f6f0feb951, 0x9c935e00d4b9d8d2,0x6ed1bf9a569f33d3, 0xc3b8358109e84f07,0xa862f80ec4700c8, 0xf4a642e14c6262c8,0xcd27bb612758c0fa, 0x98e7e9cccfbd7dbd,0x8038d51cb897789c, 0xbf21e44003acdd2c,0xe0470a63e6bd56c3, 0xeeea5d5004981478,0x1858ccfce06cac74, 0x95527a5202df0ccb,0xf37801e0c43ebc8, 0xbaa718e68396cffd,0xd30560258f54e6ba, 0xe950df20247c83fd,0x47c6b82ef32a2069, 0x91d28b7416cdd27e,0x4cdc331d57fa5441, 0xb6472e511c81471d,0xe0133fe4adf8e952, 0xe3d8f9e563a198e5,0x58180fddd97723a6, 0x8e679c2f5e44ff8f,0x570f09eaa7ea7648,}; using powers = powers_template<>; } #endif #ifndef FASTFLOAT_DECIMAL_TO_BINARY_H #define FASTFLOAT_DECIMAL_TO_BINARY_H #include #include #include #include #include #include namespace fast_float { // This will compute or rather approximate w * 5**q and return a pair of 64-bit words approximating // the result, with the "high" part corresponding to the most significant bits and the // low part corresponding to the least significant bits. // template fastfloat_really_inline value128 compute_product_approximation(int64_t q, uint64_t w) { const int index = 2 * int(q - powers::smallest_power_of_five); // For small values of q, e.g., q in [0,27], the answer is always exact because // The line value128 firstproduct = full_multiplication(w, power_of_five_128[index]); // gives the exact answer. value128 firstproduct = full_multiplication(w, powers::power_of_five_128[index]); static_assert((bit_precision >= 0) && (bit_precision <= 64), " precision should be in (0,64]"); constexpr uint64_t precision_mask = (bit_precision < 64) ? (uint64_t(0xFFFFFFFFFFFFFFFF) >> bit_precision) : uint64_t(0xFFFFFFFFFFFFFFFF); if((firstproduct.high & precision_mask) == precision_mask) { // could further guard with (lower + w < lower) // regarding the second product, we only need secondproduct.high, but our expectation is that the compiler will optimize this extra work away if needed. value128 secondproduct = full_multiplication(w, powers::power_of_five_128[index + 1]); firstproduct.low += secondproduct.high; if(secondproduct.high > firstproduct.low) { firstproduct.high++; } } return firstproduct; } namespace detail { /** * For q in (0,350), we have that * f = (((152170 + 65536) * q ) >> 16); * is equal to * floor(p) + q * where * p = log(5**q)/log(2) = q * log(5)/log(2) * * For negative values of q in (-400,0), we have that * f = (((152170 + 65536) * q ) >> 16); * is equal to * -ceil(p) + q * where * p = log(5**-q)/log(2) = -q * log(5)/log(2) */ constexpr fastfloat_really_inline int32_t power(int32_t q) noexcept { return (((152170 + 65536) * q) >> 16) + 63; } } // namespace detail // create an adjusted mantissa, biased by the invalid power2 // for significant digits already multiplied by 10 ** q. template fastfloat_really_inline adjusted_mantissa compute_error_scaled(int64_t q, uint64_t w, int lz) noexcept { int hilz = int(w >> 63) ^ 1; adjusted_mantissa answer; answer.mantissa = w << hilz; int bias = binary::mantissa_explicit_bits() - binary::minimum_exponent(); answer.power2 = int32_t(detail::power(int32_t(q)) + bias - hilz - lz - 62 + invalid_am_bias); return answer; } // w * 10 ** q, without rounding the representation up. // the power2 in the exponent will be adjusted by invalid_am_bias. template fastfloat_really_inline adjusted_mantissa compute_error(int64_t q, uint64_t w) noexcept { int lz = leading_zeroes(w); w <<= lz; value128 product = compute_product_approximation(q, w); return compute_error_scaled(q, product.high, lz); } // w * 10 ** q // The returned value should be a valid ieee64 number that simply need to be packed. // However, in some very rare cases, the computation will fail. In such cases, we // return an adjusted_mantissa with a negative power of 2: the caller should recompute // in such cases. template fastfloat_really_inline adjusted_mantissa compute_float(int64_t q, uint64_t w) noexcept { adjusted_mantissa answer; if ((w == 0) || (q < binary::smallest_power_of_ten())) { answer.power2 = 0; answer.mantissa = 0; // result should be zero return answer; } if (q > binary::largest_power_of_ten()) { // we want to get infinity: answer.power2 = binary::infinite_power(); answer.mantissa = 0; return answer; } // At this point in time q is in [powers::smallest_power_of_five, powers::largest_power_of_five]. // We want the most significant bit of i to be 1. Shift if needed. int lz = leading_zeroes(w); w <<= lz; // The required precision is binary::mantissa_explicit_bits() + 3 because // 1. We need the implicit bit // 2. We need an extra bit for rounding purposes // 3. We might lose a bit due to the "upperbit" routine (result too small, requiring a shift) value128 product = compute_product_approximation(q, w); if(product.low == 0xFFFFFFFFFFFFFFFF) { // could guard it further // In some very rare cases, this could happen, in which case we might need a more accurate // computation that what we can provide cheaply. This is very, very unlikely. // const bool inside_safe_exponent = (q >= -27) && (q <= 55); // always good because 5**q <2**128 when q>=0, // and otherwise, for q<0, we have 5**-q<2**64 and the 128-bit reciprocal allows for exact computation. if(!inside_safe_exponent) { return compute_error_scaled(q, product.high, lz); } } // The "compute_product_approximation" function can be slightly slower than a branchless approach: // value128 product = compute_product(q, w); // but in practice, we can win big with the compute_product_approximation if its additional branch // is easily predicted. Which is best is data specific. int upperbit = int(product.high >> 63); answer.mantissa = product.high >> (upperbit + 64 - binary::mantissa_explicit_bits() - 3); answer.power2 = int32_t(detail::power(int32_t(q)) + upperbit - lz - binary::minimum_exponent()); if (answer.power2 <= 0) { // we have a subnormal? // Here have that answer.power2 <= 0 so -answer.power2 >= 0 if(-answer.power2 + 1 >= 64) { // if we have more than 64 bits below the minimum exponent, you have a zero for sure. answer.power2 = 0; answer.mantissa = 0; // result should be zero return answer; } // next line is safe because -answer.power2 + 1 < 64 answer.mantissa >>= -answer.power2 + 1; // Thankfully, we can't have both "round-to-even" and subnormals because // "round-to-even" only occurs for powers close to 0. answer.mantissa += (answer.mantissa & 1); // round up answer.mantissa >>= 1; // There is a weird scenario where we don't have a subnormal but just. // Suppose we start with 2.2250738585072013e-308, we end up // with 0x3fffffffffffff x 2^-1023-53 which is technically subnormal // whereas 0x40000000000000 x 2^-1023-53 is normal. Now, we need to round // up 0x3fffffffffffff x 2^-1023-53 and once we do, we are no longer // subnormal, but we can only know this after rounding. // So we only declare a subnormal if we are smaller than the threshold. answer.power2 = (answer.mantissa < (uint64_t(1) << binary::mantissa_explicit_bits())) ? 0 : 1; return answer; } // usually, we round *up*, but if we fall right in between and and we have an // even basis, we need to round down // We are only concerned with the cases where 5**q fits in single 64-bit word. if ((product.low <= 1) && (q >= binary::min_exponent_round_to_even()) && (q <= binary::max_exponent_round_to_even()) && ((answer.mantissa & 3) == 1) ) { // we may fall between two floats! // To be in-between two floats we need that in doing // answer.mantissa = product.high >> (upperbit + 64 - binary::mantissa_explicit_bits() - 3); // ... we dropped out only zeroes. But if this happened, then we can go back!!! if((answer.mantissa << (upperbit + 64 - binary::mantissa_explicit_bits() - 3)) == product.high) { answer.mantissa &= ~uint64_t(1); // flip it so that we do not round up } } answer.mantissa += (answer.mantissa & 1); // round up answer.mantissa >>= 1; if (answer.mantissa >= (uint64_t(2) << binary::mantissa_explicit_bits())) { answer.mantissa = (uint64_t(1) << binary::mantissa_explicit_bits()); answer.power2++; // undo previous addition } answer.mantissa &= ~(uint64_t(1) << binary::mantissa_explicit_bits()); if (answer.power2 >= binary::infinite_power()) { // infinity answer.power2 = binary::infinite_power(); answer.mantissa = 0; } return answer; } } // namespace fast_float #endif #ifndef FASTFLOAT_BIGINT_H #define FASTFLOAT_BIGINT_H #include #include #include #include namespace fast_float { // the limb width: we want efficient multiplication of double the bits in // limb, or for 64-bit limbs, at least 64-bit multiplication where we can // extract the high and low parts efficiently. this is every 64-bit // architecture except for sparc, which emulates 128-bit multiplication. // we might have platforms where `CHAR_BIT` is not 8, so let's avoid // doing `8 * sizeof(limb)`. #if defined(FASTFLOAT_64BIT) && !defined(__sparc) #define FASTFLOAT_64BIT_LIMB typedef uint64_t limb; constexpr size_t limb_bits = 64; #else #define FASTFLOAT_32BIT_LIMB typedef uint32_t limb; constexpr size_t limb_bits = 32; #endif typedef span limb_span; // number of bits in a bigint. this needs to be at least the number // of bits required to store the largest bigint, which is // `log2(10**(digits + max_exp))`, or `log2(10**(767 + 342))`, or // ~3600 bits, so we round to 4000. constexpr size_t bigint_bits = 4000; constexpr size_t bigint_limbs = bigint_bits / limb_bits; // vector-like type that is allocated on the stack. the entire // buffer is pre-allocated, and only the length changes. template struct stackvec { limb data[size]; // we never need more than 150 limbs uint16_t length{0}; stackvec() = default; stackvec(const stackvec &) = delete; stackvec &operator=(const stackvec &) = delete; stackvec(stackvec &&) = delete; stackvec &operator=(stackvec &&other) = delete; // create stack vector from existing limb span. stackvec(limb_span s) { FASTFLOAT_ASSERT(try_extend(s)); } limb& operator[](size_t index) noexcept { FASTFLOAT_DEBUG_ASSERT(index < length); return data[index]; } const limb& operator[](size_t index) const noexcept { FASTFLOAT_DEBUG_ASSERT(index < length); return data[index]; } // index from the end of the container const limb& rindex(size_t index) const noexcept { FASTFLOAT_DEBUG_ASSERT(index < length); size_t rindex = length - index - 1; return data[rindex]; } // set the length, without bounds checking. void set_len(size_t len) noexcept { length = uint16_t(len); } constexpr size_t len() const noexcept { return length; } constexpr bool is_empty() const noexcept { return length == 0; } constexpr size_t capacity() const noexcept { return size; } // append item to vector, without bounds checking void push_unchecked(limb value) noexcept { data[length] = value; length++; } // append item to vector, returning if item was added bool try_push(limb value) noexcept { if (len() < capacity()) { push_unchecked(value); return true; } else { return false; } } // add items to the vector, from a span, without bounds checking void extend_unchecked(limb_span s) noexcept { limb* ptr = data + length; ::memcpy((void*)ptr, (const void*)s.ptr, sizeof(limb) * s.len()); set_len(len() + s.len()); } // try to add items to the vector, returning if items were added bool try_extend(limb_span s) noexcept { if (len() + s.len() <= capacity()) { extend_unchecked(s); return true; } else { return false; } } // resize the vector, without bounds checking // if the new size is longer than the vector, assign value to each // appended item. void resize_unchecked(size_t new_len, limb value) noexcept { if (new_len > len()) { size_t count = new_len - len(); limb* first = data + len(); limb* last = first + count; ::std::fill(first, last, value); set_len(new_len); } else { set_len(new_len); } } // try to resize the vector, returning if the vector was resized. bool try_resize(size_t new_len, limb value) noexcept { if (new_len > capacity()) { return false; } else { resize_unchecked(new_len, value); return true; } } // check if any limbs are non-zero after the given index. // this needs to be done in reverse order, since the index // is relative to the most significant limbs. bool nonzero(size_t index) const noexcept { while (index < len()) { if (rindex(index) != 0) { return true; } index++; } return false; } // normalize the big integer, so most-significant zero limbs are removed. void normalize() noexcept { while (len() > 0 && rindex(0) == 0) { length--; } } }; fastfloat_really_inline uint64_t empty_hi64(bool& truncated) noexcept { truncated = false; return 0; } fastfloat_really_inline uint64_t uint64_hi64(uint64_t r0, bool& truncated) noexcept { truncated = false; int shl = leading_zeroes(r0); return r0 << shl; } fastfloat_really_inline uint64_t uint64_hi64(uint64_t r0, uint64_t r1, bool& truncated) noexcept { int shl = leading_zeroes(r0); if (shl == 0) { truncated = r1 != 0; return r0; } else { int shr = 64 - shl; truncated = (r1 << shl) != 0; return (r0 << shl) | (r1 >> shr); } } fastfloat_really_inline uint64_t uint32_hi64(uint32_t r0, bool& truncated) noexcept { return uint64_hi64(r0, truncated); } fastfloat_really_inline uint64_t uint32_hi64(uint32_t r0, uint32_t r1, bool& truncated) noexcept { uint64_t x0 = r0; uint64_t x1 = r1; return uint64_hi64((x0 << 32) | x1, truncated); } fastfloat_really_inline uint64_t uint32_hi64(uint32_t r0, uint32_t r1, uint32_t r2, bool& truncated) noexcept { uint64_t x0 = r0; uint64_t x1 = r1; uint64_t x2 = r2; return uint64_hi64(x0, (x1 << 32) | x2, truncated); } // add two small integers, checking for overflow. // we want an efficient operation. for msvc, where // we don't have built-in intrinsics, this is still // pretty fast. fastfloat_really_inline limb scalar_add(limb x, limb y, bool& overflow) noexcept { limb z; // gcc and clang #if defined(__has_builtin) #if __has_builtin(__builtin_add_overflow) overflow = __builtin_add_overflow(x, y, &z); return z; #endif #endif // generic, this still optimizes correctly on MSVC. z = x + y; overflow = z < x; return z; } // multiply two small integers, getting both the high and low bits. fastfloat_really_inline limb scalar_mul(limb x, limb y, limb& carry) noexcept { #ifdef FASTFLOAT_64BIT_LIMB #if defined(__SIZEOF_INT128__) // GCC and clang both define it as an extension. __uint128_t z = __uint128_t(x) * __uint128_t(y) + __uint128_t(carry); carry = limb(z >> limb_bits); return limb(z); #else // fallback, no native 128-bit integer multiplication with carry. // on msvc, this optimizes identically, somehow. value128 z = full_multiplication(x, y); bool overflow; z.low = scalar_add(z.low, carry, overflow); z.high += uint64_t(overflow); // cannot overflow carry = z.high; return z.low; #endif #else uint64_t z = uint64_t(x) * uint64_t(y) + uint64_t(carry); carry = limb(z >> limb_bits); return limb(z); #endif } // add scalar value to bigint starting from offset. // used in grade school multiplication template inline bool small_add_from(stackvec& vec, limb y, size_t start) noexcept { size_t index = start; limb carry = y; bool overflow; while (carry != 0 && index < vec.len()) { vec[index] = scalar_add(vec[index], carry, overflow); carry = limb(overflow); index += 1; } if (carry != 0) { FASTFLOAT_TRY(vec.try_push(carry)); } return true; } // add scalar value to bigint. template fastfloat_really_inline bool small_add(stackvec& vec, limb y) noexcept { return small_add_from(vec, y, 0); } // multiply bigint by scalar value. template inline bool small_mul(stackvec& vec, limb y) noexcept { limb carry = 0; for (size_t index = 0; index < vec.len(); index++) { vec[index] = scalar_mul(vec[index], y, carry); } if (carry != 0) { FASTFLOAT_TRY(vec.try_push(carry)); } return true; } // add bigint to bigint starting from index. // used in grade school multiplication template bool large_add_from(stackvec& x, limb_span y, size_t start) noexcept { // the effective x buffer is from `xstart..x.len()`, so exit early // if we can't get that current range. if (x.len() < start || y.len() > x.len() - start) { FASTFLOAT_TRY(x.try_resize(y.len() + start, 0)); } bool carry = false; for (size_t index = 0; index < y.len(); index++) { limb xi = x[index + start]; limb yi = y[index]; bool c1 = false; bool c2 = false; xi = scalar_add(xi, yi, c1); if (carry) { xi = scalar_add(xi, 1, c2); } x[index + start] = xi; carry = c1 | c2; } // handle overflow if (carry) { FASTFLOAT_TRY(small_add_from(x, 1, y.len() + start)); } return true; } // add bigint to bigint. template fastfloat_really_inline bool large_add_from(stackvec& x, limb_span y) noexcept { return large_add_from(x, y, 0); } // grade-school multiplication algorithm template bool long_mul(stackvec& x, limb_span y) noexcept { limb_span xs = limb_span(x.data, x.len()); stackvec z(xs); limb_span zs = limb_span(z.data, z.len()); if (y.len() != 0) { limb y0 = y[0]; FASTFLOAT_TRY(small_mul(x, y0)); for (size_t index = 1; index < y.len(); index++) { limb yi = y[index]; stackvec zi; if (yi != 0) { // re-use the same buffer throughout zi.set_len(0); FASTFLOAT_TRY(zi.try_extend(zs)); FASTFLOAT_TRY(small_mul(zi, yi)); limb_span zis = limb_span(zi.data, zi.len()); FASTFLOAT_TRY(large_add_from(x, zis, index)); } } } x.normalize(); return true; } // grade-school multiplication algorithm template bool large_mul(stackvec& x, limb_span y) noexcept { if (y.len() == 1) { FASTFLOAT_TRY(small_mul(x, y[0])); } else { FASTFLOAT_TRY(long_mul(x, y)); } return true; } // big integer type. implements a small subset of big integer // arithmetic, using simple algorithms since asymptotically // faster algorithms are slower for a small number of limbs. // all operations assume the big-integer is normalized. struct bigint { // storage of the limbs, in little-endian order. stackvec vec; bigint(): vec() {} bigint(const bigint &) = delete; bigint &operator=(const bigint &) = delete; bigint(bigint &&) = delete; bigint &operator=(bigint &&other) = delete; bigint(uint64_t value): vec() { #ifdef FASTFLOAT_64BIT_LIMB vec.push_unchecked(value); #else vec.push_unchecked(uint32_t(value)); vec.push_unchecked(uint32_t(value >> 32)); #endif vec.normalize(); } // get the high 64 bits from the vector, and if bits were truncated. // this is to get the significant digits for the float. uint64_t hi64(bool& truncated) const noexcept { #ifdef FASTFLOAT_64BIT_LIMB if (vec.len() == 0) { return empty_hi64(truncated); } else if (vec.len() == 1) { return uint64_hi64(vec.rindex(0), truncated); } else { uint64_t result = uint64_hi64(vec.rindex(0), vec.rindex(1), truncated); truncated |= vec.nonzero(2); return result; } #else if (vec.len() == 0) { return empty_hi64(truncated); } else if (vec.len() == 1) { return uint32_hi64(vec.rindex(0), truncated); } else if (vec.len() == 2) { return uint32_hi64(vec.rindex(0), vec.rindex(1), truncated); } else { uint64_t result = uint32_hi64(vec.rindex(0), vec.rindex(1), vec.rindex(2), truncated); truncated |= vec.nonzero(3); return result; } #endif } // compare two big integers, returning the large value. // assumes both are normalized. if the return value is // negative, other is larger, if the return value is // positive, this is larger, otherwise they are equal. // the limbs are stored in little-endian order, so we // must compare the limbs in ever order. int compare(const bigint& other) const noexcept { if (vec.len() > other.vec.len()) { return 1; } else if (vec.len() < other.vec.len()) { return -1; } else { for (size_t index = vec.len(); index > 0; index--) { limb xi = vec[index - 1]; limb yi = other.vec[index - 1]; if (xi > yi) { return 1; } else if (xi < yi) { return -1; } } return 0; } } // shift left each limb n bits, carrying over to the new limb // returns true if we were able to shift all the digits. bool shl_bits(size_t n) noexcept { // Internally, for each item, we shift left by n, and add the previous // right shifted limb-bits. // For example, we transform (for u8) shifted left 2, to: // b10100100 b01000010 // b10 b10010001 b00001000 FASTFLOAT_DEBUG_ASSERT(n != 0); FASTFLOAT_DEBUG_ASSERT(n < sizeof(limb) * 8); size_t shl = n; size_t shr = limb_bits - shl; limb prev = 0; for (size_t index = 0; index < vec.len(); index++) { limb xi = vec[index]; vec[index] = (xi << shl) | (prev >> shr); prev = xi; } limb carry = prev >> shr; if (carry != 0) { return vec.try_push(carry); } return true; } // move the limbs left by `n` limbs. bool shl_limbs(size_t n) noexcept { FASTFLOAT_DEBUG_ASSERT(n != 0); if (n + vec.len() > vec.capacity()) { return false; } else if (!vec.is_empty()) { // move limbs limb* dst = vec.data + n; const limb* src = vec.data; ::memmove(dst, src, sizeof(limb) * vec.len()); // fill in empty limbs limb* first = vec.data; limb* last = first + n; ::std::fill(first, last, 0); vec.set_len(n + vec.len()); return true; } else { return true; } } // move the limbs left by `n` bits. bool shl(size_t n) noexcept { size_t rem = n % limb_bits; size_t div = n / limb_bits; if (rem != 0) { FASTFLOAT_TRY(shl_bits(rem)); } if (div != 0) { FASTFLOAT_TRY(shl_limbs(div)); } return true; } // get the number of leading zeros in the bigint. int ctlz() const noexcept { if (vec.is_empty()) { return 0; } else { #ifdef FASTFLOAT_64BIT_LIMB return leading_zeroes(vec.rindex(0)); #else // no use defining a specialized leading_zeroes for a 32-bit type. uint64_t r0 = vec.rindex(0); return leading_zeroes(r0 << 32); #endif } } // get the number of bits in the bigint. int bit_length() const noexcept { int lz = ctlz(); return int(limb_bits * vec.len()) - lz; } bool mul(limb y) noexcept { return small_mul(vec, y); } bool add(limb y) noexcept { return small_add(vec, y); } // multiply as if by 2 raised to a power. bool pow2(uint32_t exp) noexcept { return shl(exp); } // multiply as if by 5 raised to a power. bool pow5(uint32_t exp) noexcept { // multiply by a power of 5 static constexpr uint32_t large_step = 135; static constexpr uint64_t small_power_of_5[] = { 1UL, 5UL, 25UL, 125UL, 625UL, 3125UL, 15625UL, 78125UL, 390625UL, 1953125UL, 9765625UL, 48828125UL, 244140625UL, 1220703125UL, 6103515625UL, 30517578125UL, 152587890625UL, 762939453125UL, 3814697265625UL, 19073486328125UL, 95367431640625UL, 476837158203125UL, 2384185791015625UL, 11920928955078125UL, 59604644775390625UL, 298023223876953125UL, 1490116119384765625UL, 7450580596923828125UL, }; #ifdef FASTFLOAT_64BIT_LIMB constexpr static limb large_power_of_5[] = { 1414648277510068013UL, 9180637584431281687UL, 4539964771860779200UL, 10482974169319127550UL, 198276706040285095UL}; #else constexpr static limb large_power_of_5[] = { 4279965485U, 329373468U, 4020270615U, 2137533757U, 4287402176U, 1057042919U, 1071430142U, 2440757623U, 381945767U, 46164893U}; #endif size_t large_length = sizeof(large_power_of_5) / sizeof(limb); limb_span large = limb_span(large_power_of_5, large_length); while (exp >= large_step) { FASTFLOAT_TRY(large_mul(vec, large)); exp -= large_step; } #ifdef FASTFLOAT_64BIT_LIMB uint32_t small_step = 27; limb max_native = 7450580596923828125UL; #else uint32_t small_step = 13; limb max_native = 1220703125U; #endif while (exp >= small_step) { FASTFLOAT_TRY(small_mul(vec, max_native)); exp -= small_step; } if (exp != 0) { FASTFLOAT_TRY(small_mul(vec, limb(small_power_of_5[exp]))); } return true; } // multiply as if by 10 raised to a power. bool pow10(uint32_t exp) noexcept { FASTFLOAT_TRY(pow5(exp)); return pow2(exp); } }; } // namespace fast_float #endif #ifndef FASTFLOAT_ASCII_NUMBER_H #define FASTFLOAT_ASCII_NUMBER_H #include #include #include #include namespace fast_float { // Next function can be micro-optimized, but compilers are entirely // able to optimize it well. fastfloat_really_inline bool is_integer(char c) noexcept { return c >= '0' && c <= '9'; } fastfloat_really_inline uint64_t byteswap(uint64_t val) { return (val & 0xFF00000000000000) >> 56 | (val & 0x00FF000000000000) >> 40 | (val & 0x0000FF0000000000) >> 24 | (val & 0x000000FF00000000) >> 8 | (val & 0x00000000FF000000) << 8 | (val & 0x0000000000FF0000) << 24 | (val & 0x000000000000FF00) << 40 | (val & 0x00000000000000FF) << 56; } fastfloat_really_inline uint64_t read_u64(const char *chars) { uint64_t val; ::memcpy(&val, chars, sizeof(uint64_t)); #if FASTFLOAT_IS_BIG_ENDIAN == 1 // Need to read as-if the number was in little-endian order. val = byteswap(val); #endif return val; } fastfloat_really_inline void write_u64(uint8_t *chars, uint64_t val) { #if FASTFLOAT_IS_BIG_ENDIAN == 1 // Need to read as-if the number was in little-endian order. val = byteswap(val); #endif ::memcpy(chars, &val, sizeof(uint64_t)); } // credit @aqrit fastfloat_really_inline uint32_t parse_eight_digits_unrolled(uint64_t val) { const uint64_t mask = 0x000000FF000000FF; const uint64_t mul1 = 0x000F424000000064; // 100 + (1000000ULL << 32) const uint64_t mul2 = 0x0000271000000001; // 1 + (10000ULL << 32) val -= 0x3030303030303030; val = (val * 10) + (val >> 8); // val = (val * 2561) >> 8; val = (((val & mask) * mul1) + (((val >> 16) & mask) * mul2)) >> 32; return uint32_t(val); } fastfloat_really_inline uint32_t parse_eight_digits_unrolled(const char *chars) noexcept { return parse_eight_digits_unrolled(read_u64(chars)); } // credit @aqrit fastfloat_really_inline bool is_made_of_eight_digits_fast(uint64_t val) noexcept { return !((((val + 0x4646464646464646) | (val - 0x3030303030303030)) & 0x8080808080808080)); } fastfloat_really_inline bool is_made_of_eight_digits_fast(const char *chars) noexcept { return is_made_of_eight_digits_fast(read_u64(chars)); } typedef span byte_span; struct parsed_number_string { int64_t exponent{0}; uint64_t mantissa{0}; const char *lastmatch{nullptr}; bool negative{false}; bool valid{false}; bool too_many_digits{false}; // contains the range of the significant digits byte_span integer{}; // non-nullable byte_span fraction{}; // nullable }; // Assuming that you use no more than 19 digits, this will // parse an ASCII string. fastfloat_really_inline parsed_number_string parse_number_string(const char *p, const char *pend, parse_options options) noexcept { const chars_format fmt = options.format; const char decimal_point = options.decimal_point; parsed_number_string answer; answer.valid = false; answer.too_many_digits = false; answer.negative = (*p == '-'); if (*p == '-') { // C++17 20.19.3.(7.1) explicitly forbids '+' sign here ++p; if (p == pend) { return answer; } if (!is_integer(*p) && (*p != decimal_point)) { // a sign must be followed by an integer or the dot return answer; } } const char *const start_digits = p; uint64_t i = 0; // an unsigned int avoids signed overflows (which are bad) while ((std::distance(p, pend) >= 8) && is_made_of_eight_digits_fast(p)) { i = i * 100000000 + parse_eight_digits_unrolled(p); // in rare cases, this will overflow, but that's ok p += 8; } while ((p != pend) && is_integer(*p)) { // a multiplication by 10 is cheaper than an arbitrary integer // multiplication i = 10 * i + uint64_t(*p - '0'); // might overflow, we will handle the overflow later ++p; } const char *const end_of_integer_part = p; int64_t digit_count = int64_t(end_of_integer_part - start_digits); answer.integer = byte_span(start_digits, size_t(digit_count)); int64_t exponent = 0; if ((p != pend) && (*p == decimal_point)) { ++p; const char* before = p; // can occur at most twice without overflowing, but let it occur more, since // for integers with many digits, digit parsing is the primary bottleneck. while ((std::distance(p, pend) >= 8) && is_made_of_eight_digits_fast(p)) { i = i * 100000000 + parse_eight_digits_unrolled(p); // in rare cases, this will overflow, but that's ok p += 8; } while ((p != pend) && is_integer(*p)) { uint8_t digit = uint8_t(*p - '0'); ++p; i = i * 10 + digit; // in rare cases, this will overflow, but that's ok } exponent = before - p; answer.fraction = byte_span(before, size_t(p - before)); digit_count -= exponent; } // we must have encountered at least one integer! if (digit_count == 0) { return answer; } int64_t exp_number = 0; // explicit exponential part if ((fmt & chars_format::scientific) && (p != pend) && (('e' == *p) || ('E' == *p))) { const char * location_of_e = p; ++p; bool neg_exp = false; if ((p != pend) && ('-' == *p)) { neg_exp = true; ++p; } else if ((p != pend) && ('+' == *p)) { // '+' on exponent is allowed by C++17 20.19.3.(7.1) ++p; } if ((p == pend) || !is_integer(*p)) { if(!(fmt & chars_format::fixed)) { // We are in error. return answer; } // Otherwise, we will be ignoring the 'e'. p = location_of_e; } else { while ((p != pend) && is_integer(*p)) { uint8_t digit = uint8_t(*p - '0'); if (exp_number < 0x10000000) { exp_number = 10 * exp_number + digit; } ++p; } if(neg_exp) { exp_number = - exp_number; } exponent += exp_number; } } else { // If it scientific and not fixed, we have to bail out. if((fmt & chars_format::scientific) && !(fmt & chars_format::fixed)) { return answer; } } answer.lastmatch = p; answer.valid = true; // If we frequently had to deal with long strings of digits, // we could extend our code by using a 128-bit integer instead // of a 64-bit integer. However, this is uncommon. // // We can deal with up to 19 digits. if (digit_count > 19) { // this is uncommon // It is possible that the integer had an overflow. // We have to handle the case where we have 0.0000somenumber. // We need to be mindful of the case where we only have zeroes... // E.g., 0.000000000...000. const char *start = start_digits; while ((start != pend) && (*start == '0' || *start == decimal_point)) { if(*start == '0') { digit_count --; } start++; } if (digit_count > 19) { answer.too_many_digits = true; // Let us start again, this time, avoiding overflows. // We don't need to check if is_integer, since we use the // pre-tokenized spans from above. i = 0; p = answer.integer.ptr; const char* int_end = p + answer.integer.len(); const uint64_t minimal_nineteen_digit_integer{1000000000000000000}; while((i < minimal_nineteen_digit_integer) && (p != int_end)) { i = i * 10 + uint64_t(*p - '0'); ++p; } if (i >= minimal_nineteen_digit_integer) { // We have a big integers exponent = end_of_integer_part - p + exp_number; } else { // We have a value with a fractional component. p = answer.fraction.ptr; const char* frac_end = p + answer.fraction.len(); while((i < minimal_nineteen_digit_integer) && (p != frac_end)) { i = i * 10 + uint64_t(*p - '0'); ++p; } exponent = answer.fraction.ptr - p + exp_number; } // We have now corrected both exponent and i, to a truncated value } } answer.exponent = exponent; answer.mantissa = i; return answer; } } // namespace fast_float #endif #ifndef FASTFLOAT_DIGIT_COMPARISON_H #define FASTFLOAT_DIGIT_COMPARISON_H #include #include #include #include namespace fast_float { // 1e0 to 1e19 constexpr static uint64_t powers_of_ten_uint64[] = { 1UL, 10UL, 100UL, 1000UL, 10000UL, 100000UL, 1000000UL, 10000000UL, 100000000UL, 1000000000UL, 10000000000UL, 100000000000UL, 1000000000000UL, 10000000000000UL, 100000000000000UL, 1000000000000000UL, 10000000000000000UL, 100000000000000000UL, 1000000000000000000UL, 10000000000000000000UL}; // calculate the exponent, in scientific notation, of the number. // this algorithm is not even close to optimized, but it has no practical // effect on performance: in order to have a faster algorithm, we'd need // to slow down performance for faster algorithms, and this is still fast. fastfloat_really_inline int32_t scientific_exponent(parsed_number_string& num) noexcept { uint64_t mantissa = num.mantissa; int32_t exponent = int32_t(num.exponent); while (mantissa >= 10000) { mantissa /= 10000; exponent += 4; } while (mantissa >= 100) { mantissa /= 100; exponent += 2; } while (mantissa >= 10) { mantissa /= 10; exponent += 1; } return exponent; } // this converts a native floating-point number to an extended-precision float. template fastfloat_really_inline adjusted_mantissa to_extended(T value) noexcept { using equiv_uint = typename binary_format::equiv_uint; constexpr equiv_uint exponent_mask = binary_format::exponent_mask(); constexpr equiv_uint mantissa_mask = binary_format::mantissa_mask(); constexpr equiv_uint hidden_bit_mask = binary_format::hidden_bit_mask(); adjusted_mantissa am; int32_t bias = binary_format::mantissa_explicit_bits() - binary_format::minimum_exponent(); equiv_uint bits; ::memcpy(&bits, &value, sizeof(T)); if ((bits & exponent_mask) == 0) { // denormal am.power2 = 1 - bias; am.mantissa = bits & mantissa_mask; } else { // normal am.power2 = int32_t((bits & exponent_mask) >> binary_format::mantissa_explicit_bits()); am.power2 -= bias; am.mantissa = (bits & mantissa_mask) | hidden_bit_mask; } return am; } // get the extended precision value of the halfway point between b and b+u. // we are given a native float that represents b, so we need to adjust it // halfway between b and b+u. template fastfloat_really_inline adjusted_mantissa to_extended_halfway(T value) noexcept { adjusted_mantissa am = to_extended(value); am.mantissa <<= 1; am.mantissa += 1; am.power2 -= 1; return am; } // round an extended-precision float to the nearest machine float. template fastfloat_really_inline void round(adjusted_mantissa& am, callback cb) noexcept { int32_t mantissa_shift = 64 - binary_format::mantissa_explicit_bits() - 1; if (-am.power2 >= mantissa_shift) { // have a denormal float int32_t shift = -am.power2 + 1; cb(am, std::min(shift, 64)); // check for round-up: if rounding-nearest carried us to the hidden bit. am.power2 = (am.mantissa < (uint64_t(1) << binary_format::mantissa_explicit_bits())) ? 0 : 1; return; } // have a normal float, use the default shift. cb(am, mantissa_shift); // check for carry if (am.mantissa >= (uint64_t(2) << binary_format::mantissa_explicit_bits())) { am.mantissa = (uint64_t(1) << binary_format::mantissa_explicit_bits()); am.power2++; } // check for infinite: we could have carried to an infinite power am.mantissa &= ~(uint64_t(1) << binary_format::mantissa_explicit_bits()); if (am.power2 >= binary_format::infinite_power()) { am.power2 = binary_format::infinite_power(); am.mantissa = 0; } } template fastfloat_really_inline void round_nearest_tie_even(adjusted_mantissa& am, int32_t shift, callback cb) noexcept { uint64_t mask; uint64_t halfway; if (shift == 64) { mask = UINT64_MAX; } else { mask = (uint64_t(1) << shift) - 1; } if (shift == 0) { halfway = 0; } else { halfway = uint64_t(1) << (shift - 1); } uint64_t truncated_bits = am.mantissa & mask; uint64_t is_above = truncated_bits > halfway; uint64_t is_halfway = truncated_bits == halfway; // shift digits into position if (shift == 64) { am.mantissa = 0; } else { am.mantissa >>= shift; } am.power2 += shift; bool is_odd = (am.mantissa & 1) == 1; am.mantissa += uint64_t(cb(is_odd, is_halfway, is_above)); } fastfloat_really_inline void round_down(adjusted_mantissa& am, int32_t shift) noexcept { if (shift == 64) { am.mantissa = 0; } else { am.mantissa >>= shift; } am.power2 += shift; } fastfloat_really_inline void skip_zeros(const char*& first, const char* last) noexcept { uint64_t val; while (std::distance(first, last) >= 8) { ::memcpy(&val, first, sizeof(uint64_t)); if (val != 0x3030303030303030) { break; } first += 8; } while (first != last) { if (*first != '0') { break; } first++; } } // determine if any non-zero digits were truncated. // all characters must be valid digits. fastfloat_really_inline bool is_truncated(const char* first, const char* last) noexcept { // do 8-bit optimizations, can just compare to 8 literal 0s. uint64_t val; while (std::distance(first, last) >= 8) { ::memcpy(&val, first, sizeof(uint64_t)); if (val != 0x3030303030303030) { return true; } first += 8; } while (first != last) { if (*first != '0') { return true; } first++; } return false; } fastfloat_really_inline bool is_truncated(byte_span s) noexcept { return is_truncated(s.ptr, s.ptr + s.len()); } fastfloat_really_inline void parse_eight_digits(const char*& p, limb& value, size_t& counter, size_t& count) noexcept { value = value * 100000000 + parse_eight_digits_unrolled(p); p += 8; counter += 8; count += 8; } fastfloat_really_inline void parse_one_digit(const char*& p, limb& value, size_t& counter, size_t& count) noexcept { value = value * 10 + limb(*p - '0'); p++; counter++; count++; } fastfloat_really_inline void add_native(bigint& big, limb power, limb value) noexcept { big.mul(power); big.add(value); } fastfloat_really_inline void round_up_bigint(bigint& big, size_t& count) noexcept { // need to round-up the digits, but need to avoid rounding // ....9999 to ...10000, which could cause a false halfway point. add_native(big, 10, 1); count++; } // parse the significant digits into a big integer inline void parse_mantissa(bigint& result, parsed_number_string& num, size_t max_digits, size_t& digits) noexcept { // try to minimize the number of big integer and scalar multiplication. // therefore, try to parse 8 digits at a time, and multiply by the largest // scalar value (9 or 19 digits) for each step. size_t counter = 0; digits = 0; limb value = 0; #ifdef FASTFLOAT_64BIT_LIMB size_t step = 19; #else size_t step = 9; #endif // process all integer digits. const char* p = num.integer.ptr; const char* pend = p + num.integer.len(); skip_zeros(p, pend); // process all digits, in increments of step per loop while (p != pend) { while ((std::distance(p, pend) >= 8) && (step - counter >= 8) && (max_digits - digits >= 8)) { parse_eight_digits(p, value, counter, digits); } while (counter < step && p != pend && digits < max_digits) { parse_one_digit(p, value, counter, digits); } if (digits == max_digits) { // add the temporary value, then check if we've truncated any digits add_native(result, limb(powers_of_ten_uint64[counter]), value); bool truncated = is_truncated(p, pend); if (num.fraction.ptr != nullptr) { truncated |= is_truncated(num.fraction); } if (truncated) { round_up_bigint(result, digits); } return; } else { add_native(result, limb(powers_of_ten_uint64[counter]), value); counter = 0; value = 0; } } // add our fraction digits, if they're available. if (num.fraction.ptr != nullptr) { p = num.fraction.ptr; pend = p + num.fraction.len(); if (digits == 0) { skip_zeros(p, pend); } // process all digits, in increments of step per loop while (p != pend) { while ((std::distance(p, pend) >= 8) && (step - counter >= 8) && (max_digits - digits >= 8)) { parse_eight_digits(p, value, counter, digits); } while (counter < step && p != pend && digits < max_digits) { parse_one_digit(p, value, counter, digits); } if (digits == max_digits) { // add the temporary value, then check if we've truncated any digits add_native(result, limb(powers_of_ten_uint64[counter]), value); bool truncated = is_truncated(p, pend); if (truncated) { round_up_bigint(result, digits); } return; } else { add_native(result, limb(powers_of_ten_uint64[counter]), value); counter = 0; value = 0; } } } if (counter != 0) { add_native(result, limb(powers_of_ten_uint64[counter]), value); } } template inline adjusted_mantissa positive_digit_comp(bigint& bigmant, int32_t exponent) noexcept { FASTFLOAT_ASSERT(bigmant.pow10(uint32_t(exponent))); adjusted_mantissa answer; bool truncated; answer.mantissa = bigmant.hi64(truncated); int bias = binary_format::mantissa_explicit_bits() - binary_format::minimum_exponent(); answer.power2 = bigmant.bit_length() - 64 + bias; round(answer, [truncated](adjusted_mantissa& a, int32_t shift) { round_nearest_tie_even(a, shift, [truncated](bool is_odd, bool is_halfway, bool is_above) -> bool { return is_above || (is_halfway && truncated) || (is_odd && is_halfway); }); }); return answer; } // the scaling here is quite simple: we have, for the real digits `m * 10^e`, // and for the theoretical digits `n * 2^f`. Since `e` is always negative, // to scale them identically, we do `n * 2^f * 5^-f`, so we now have `m * 2^e`. // we then need to scale by `2^(f- e)`, and then the two significant digits // are of the same magnitude. template inline adjusted_mantissa negative_digit_comp(bigint& bigmant, adjusted_mantissa am, int32_t exponent) noexcept { bigint& real_digits = bigmant; int32_t real_exp = exponent; // get the value of `b`, rounded down, and get a bigint representation of b+h adjusted_mantissa am_b = am; // gcc7 buf: use a lambda to remove the noexcept qualifier bug with -Wnoexcept-type. round(am_b, [](adjusted_mantissa&a, int32_t shift) { round_down(a, shift); }); T b; to_float(false, am_b, b); adjusted_mantissa theor = to_extended_halfway(b); bigint theor_digits(theor.mantissa); int32_t theor_exp = theor.power2; // scale real digits and theor digits to be same power. int32_t pow2_exp = theor_exp - real_exp; uint32_t pow5_exp = uint32_t(-real_exp); if (pow5_exp != 0) { FASTFLOAT_ASSERT(theor_digits.pow5(pow5_exp)); } if (pow2_exp > 0) { FASTFLOAT_ASSERT(theor_digits.pow2(uint32_t(pow2_exp))); } else if (pow2_exp < 0) { FASTFLOAT_ASSERT(real_digits.pow2(uint32_t(-pow2_exp))); } // compare digits, and use it to director rounding int ord = real_digits.compare(theor_digits); adjusted_mantissa answer = am; round(answer, [ord](adjusted_mantissa& a, int32_t shift) { round_nearest_tie_even(a, shift, [ord](bool is_odd, bool _, bool __) -> bool { (void)_; // not needed, since we've done our comparison (void)__; // not needed, since we've done our comparison if (ord > 0) { return true; } else if (ord < 0) { return false; } else { return is_odd; } }); }); return answer; } // parse the significant digits as a big integer to unambiguously round the // the significant digits. here, we are trying to determine how to round // an extended float representation close to `b+h`, halfway between `b` // (the float rounded-down) and `b+u`, the next positive float. this // algorithm is always correct, and uses one of two approaches. when // the exponent is positive relative to the significant digits (such as // 1234), we create a big-integer representation, get the high 64-bits, // determine if any lower bits are truncated, and use that to direct // rounding. in case of a negative exponent relative to the significant // digits (such as 1.2345), we create a theoretical representation of // `b` as a big-integer type, scaled to the same binary exponent as // the actual digits. we then compare the big integer representations // of both, and use that to direct rounding. template inline adjusted_mantissa digit_comp(parsed_number_string& num, adjusted_mantissa am) noexcept { // remove the invalid exponent bias am.power2 -= invalid_am_bias; int32_t sci_exp = scientific_exponent(num); size_t max_digits = binary_format::max_digits(); size_t digits = 0; bigint bigmant; parse_mantissa(bigmant, num, max_digits, digits); // can't underflow, since digits is at most max_digits. int32_t exponent = sci_exp + 1 - int32_t(digits); if (exponent >= 0) { return positive_digit_comp(bigmant, exponent); } else { return negative_digit_comp(bigmant, am, exponent); } } } // namespace fast_float #endif #ifndef FASTFLOAT_PARSE_NUMBER_H #define FASTFLOAT_PARSE_NUMBER_H #include #include #include #include namespace fast_float { namespace detail { /** * Special case +inf, -inf, nan, infinity, -infinity. * The case comparisons could be made much faster given that we know that the * strings a null-free and fixed. **/ template from_chars_result parse_infnan(const char *first, const char *last, T &value) noexcept { from_chars_result answer; answer.ptr = first; answer.ec = std::errc(); // be optimistic bool minusSign = false; if (*first == '-') { // assume first < last, so dereference without checks; C++17 20.19.3.(7.1) explicitly forbids '+' here minusSign = true; ++first; } if (last - first >= 3) { if (fastfloat_strncasecmp(first, "nan", 3)) { answer.ptr = (first += 3); value = minusSign ? -std::numeric_limits::quiet_NaN() : std::numeric_limits::quiet_NaN(); // Check for possible nan(n-char-seq-opt), C++17 20.19.3.7, C11 7.20.1.3.3. At least MSVC produces nan(ind) and nan(snan). if(first != last && *first == '(') { for(const char* ptr = first + 1; ptr != last; ++ptr) { if (*ptr == ')') { answer.ptr = ptr + 1; // valid nan(n-char-seq-opt) break; } else if(!(('a' <= *ptr && *ptr <= 'z') || ('A' <= *ptr && *ptr <= 'Z') || ('0' <= *ptr && *ptr <= '9') || *ptr == '_')) break; // forbidden char, not nan(n-char-seq-opt) } } return answer; } if (fastfloat_strncasecmp(first, "inf", 3)) { if ((last - first >= 8) && fastfloat_strncasecmp(first + 3, "inity", 5)) { answer.ptr = first + 8; } else { answer.ptr = first + 3; } value = minusSign ? -std::numeric_limits::infinity() : std::numeric_limits::infinity(); return answer; } } answer.ec = std::errc::invalid_argument; return answer; } } // namespace detail template from_chars_result from_chars(const char *first, const char *last, T &value, chars_format fmt /*= chars_format::general*/) noexcept { return from_chars_advanced(first, last, value, parse_options{fmt}); } template from_chars_result from_chars_advanced(const char *first, const char *last, T &value, parse_options options) noexcept { static_assert (std::is_same::value || std::is_same::value, "only float and double are supported"); from_chars_result answer; if (first == last) { answer.ec = std::errc::invalid_argument; answer.ptr = first; return answer; } parsed_number_string pns = parse_number_string(first, last, options); if (!pns.valid) { return detail::parse_infnan(first, last, value); } answer.ec = std::errc(); // be optimistic answer.ptr = pns.lastmatch; // Next is Clinger's fast path. if (binary_format::min_exponent_fast_path() <= pns.exponent && pns.exponent <= binary_format::max_exponent_fast_path() && pns.mantissa <=binary_format::max_mantissa_fast_path() && !pns.too_many_digits) { value = T(pns.mantissa); if (pns.exponent < 0) { value = value / binary_format::exact_power_of_ten(-pns.exponent); } else { value = value * binary_format::exact_power_of_ten(pns.exponent); } if (pns.negative) { value = -value; } return answer; } adjusted_mantissa am = compute_float>(pns.exponent, pns.mantissa); if(pns.too_many_digits && am.power2 >= 0) { if(am != compute_float>(pns.exponent, pns.mantissa + 1)) { am = compute_error>(pns.exponent, pns.mantissa); } } // If we called compute_float>(pns.exponent, pns.mantissa) and we have an invalid power (am.power2 < 0), // then we need to go the long way around again. This is very uncommon. if(am.power2 < 0) { am = digit_comp(pns, am); } to_float(pns.negative, am, value); return answer; } } // namespace fast_float #endif wk/src/internal/buffered-reader.hpp0000644000176200001440000002575714160220603017043 0ustar liggesusers #ifndef WK_BUFFERED_READER_H_INCLUDED #define WK_BUFFERED_READER_H_INCLUDED #include "fast_float/fast_float.h" #include #include #include class BufferedParserException: public std::runtime_error { public: BufferedParserException(std::string expected, std::string found, std::string context): std::runtime_error(makeError(expected, found, context)), expected(expected), found(found), context(context) {} std::string expected; std::string found; std::string context; static std::string makeError(std::string expected, std::string found, std::string context = "") { std::stringstream stream; stream << "Expected " << expected << " but found " << found << context; return stream.str().c_str(); } }; // The SimpleBufferSource is a wrapper around an in-memory buffer of characters. // The BufferedParser classes below template along an object with a fill_buffer() // method with the same signature as this one. class SimpleBufferSource { public: SimpleBufferSource(): str(nullptr), size(0), offset(0) {} void set_buffer(const char* str, int64_t size) { this->str = str; this->size = size; this->offset = 0; } int64_t fill_buffer(char* buffer, int64_t max_size) { int64_t copy_size = std::min(this->size - this->offset, max_size); if (copy_size > 0) { memcpy(buffer, this->str + this->offset, copy_size); this->offset += copy_size; return copy_size; } else { return 0; } } private: const char* str; int64_t size; int64_t offset; }; // The BufferedParser class provides the basic helpers needed to parse simple // text formats like well-known text. It is not intended to be the pinnacle // of speed or elegance, but does a good job at providing reasonable error // messages and has the important feature that it does not need the text // that it's parsing to be fully in-memory. The intended usage is to subclass // the BufferedParser for a particular format. template class BufferedParser { public: BufferedParser(): length(0), offset(0), source_offset(0), whitespace(" \r\n\t"), sep(" \r\n\t"), source(nullptr) {} void setSource(SimpleBufferSource* source) { this->source = source; this->offset = 0; this->length = 0; this->source_offset = 0; } const char* setWhitespace(const char* whitespace) { const char* previous_whitespace = this->whitespace; this->whitespace = whitespace; return previous_whitespace; } const char* setSeparators(const char* separators) { const char* previous_sep = this->sep; this->sep = separators; return previous_sep; } int64_t charsLeftInBuffer() { return this->length - this->offset; } bool checkBuffer(int n_chars) { int64_t chars_to_keep = this->charsLeftInBuffer(); if ((chars_to_keep - n_chars) >= 0) { return true; } if (n_chars >= buffer_length) { std::stringstream stream; stream << "a value with fewer than " << buffer_length << " characters"; throw BufferedParserException(stream.str(), "a longer value", ""); } if (this->source == nullptr) { return false; } if (chars_to_keep > 0) { memmove(this->str, this->str + this->offset, chars_to_keep); } int64_t new_chars = this->source->fill_buffer(this->str + chars_to_keep, buffer_length - chars_to_keep); if (new_chars == 0) { this->source = nullptr; } this->source_offset += new_chars; this->offset = 0; this->length = chars_to_keep + new_chars; return n_chars <= this->length; } bool finished() { return !(this->checkBuffer(1)); } void advance() { if (this->checkBuffer(1)) { this->offset++; } } // Returns the character at the cursor and advances the cursor by one char readChar() { char out = this->peekChar(); this->advance(); return out; } // Returns the character currently ahead of the cursor without advancing the cursor (skips whitespace) char peekChar() { this->skipWhitespace(); if (this->checkBuffer(1)) { return this->str[this->offset]; } else { return '\0'; } } // Returns true if the next character is one of `chars` bool is(char c) { return c == this->peekChar(); } // Returns true if the next character is one of `chars` bool isOneOf(const char* chars) { return strchr(chars, this->peekChar()) != nullptr; } // Returns true if the next character is most likely to be a number bool isNumber() { // complicated by nan and inf if (this->isOneOf("-nNiI.")) { std::string text = this->peekUntilSep(); double out; auto result = fast_float::from_chars(text.data(), text.data() + text.size(), out); return result.ec == std::errc(); } else { return this->isOneOf("-0123456789"); } } // Returns true if the next character is a letter bool isLetter() { char found = this->peekChar(); return (found >= 'a' && found <= 'z') || (found >= 'A' && found <= 'Z'); } std::string assertWord() { std::string text = this->peekUntilSep(); if (!this->isLetter()) { this->error("a word", quote(text)); } this->offset += text.size(); return text; } // Returns the integer currently ahead of the cursor, // throwing an exception if whatever is ahead of the // cursor cannot be parsed into an integer long assertInteger() { std::string text = this->peekUntilSep(); try { long out = std::stol(text); this->offset += text.size(); return out; } catch (std::invalid_argument& e) { this->error("an integer", quote(text)); } } // Returns the double currently ahead of the cursor, // throwing an exception if whatever is ahead of the // cursor cannot be parsed into a double. This will // accept "inf", "-inf", and "nan". double assertNumber() { std::string text = this->peekUntilSep(); double out; auto result = fast_float::from_chars(text.data(), text.data() + text.size(), out); if (result.ec != std::errc()) { this->error("a number", quote(text)); } else { this->offset += text.size(); return out; } } // Asserts that the character at the cursor is whitespace, and // returns a std::string of whitespace characters, advancing the // cursor to the end of the whitespace. void assertWhitespace() { if (!this->checkBuffer(1)) { this->error("whitespace", "end of input"); } char found = this->str[this->offset]; if (strchr(this->whitespace, found) == nullptr) { this->error("whitespace", quote(found)); } this->skipWhitespace(); } void assert_(char c) { char found = this->peekChar(); if (found != c) { this->error(quote(c), quote(found)); } this->advance(); } // Asserts the that the character at the cursor is one of `chars` // and advances the cursor by one (throwing an exception otherwise). char assertOneOf(const char* chars) { char found = this->peekChar(); if ((strlen(chars) > 0) && this->finished()) { this->error(expectedFromChars(chars), "end of input"); } else if (strchr(chars, found) == nullptr) { this->error(expectedFromChars(chars), quote(this->peekUntilSep())); } this->advance(); return found; } // Asserts that the cursor is at the end of the input void assertFinished() { this->assert_('\0'); } // Returns the text between the cursor and the next separator, // which is defined to be whitespace or the following characters: =;,() // advancing the cursor. If we are at the end of the string, this will // return std::string("") std::string readUntilSep() { this->skipWhitespace(); int64_t wordLen = peekUntil(this->sep); bool finished = this->finished(); if (wordLen == 0 && !finished) { wordLen = 1; } std::string out(this->str + this->offset, wordLen); this->offset += wordLen; return out; } // Returns the text between the cursor and the next separator without advancing the cursor. std::string peekUntilSep() { this->skipWhitespace(); int64_t wordLen = peekUntil(this->sep); return std::string(this->str + this->offset, wordLen); } // Advances the cursor past any whitespace, returning the number of characters skipped. int64_t skipWhitespace() { return this->skipChars(this->whitespace); } // Skips all of the characters in `chars`, returning the number of characters skipped. int64_t skipChars(const char* chars) { int64_t n_skipped = 0; bool found = false; while (!found && !this->finished()) { while (this->charsLeftInBuffer() > 0) { if (strchr(chars, this->str[this->offset])) { this->offset++; n_skipped++; } else { found = true; break; } } } return n_skipped; } // Returns the number of characters until one of `chars` is encountered, // which may be 0. int64_t peekUntil(const char* chars) { if (this->finished()) { return 0; } int64_t n_chars = -1; bool found = false; while (!found && this->checkBuffer(n_chars + 2)) { while ((this->offset + n_chars + 1) < this->length) { n_chars++; if (strchr(chars, this->str[this->offset + n_chars])) { found = true; break; } } } if (!found && (this->offset + n_chars + 1) == this->length) { n_chars++; } return n_chars; } [[ noreturn ]] void errorBefore(std::string expected, std::string found) { throw BufferedParserException(expected, quote(found), this->errorContext(this->offset - found.size())); } [[noreturn]] void error(std::string expected, std::string found) { std::stringstream stream; stream << found; throw BufferedParserException(expected, stream.str(), this->errorContext(this->offset)); } [[noreturn]] void error(std::string expected) { throw BufferedParserException(expected, quote(this->peekUntilSep()), this->errorContext(this->offset)); } std::string errorContext(int64_t pos) { std::stringstream stream; stream << " at byte " << (this->source_offset - this->length + pos); return stream.str(); } private: char str[buffer_length]; int64_t length; int64_t offset; int64_t source_offset; const char* whitespace; const char* sep; SimpleBufferSource* source; static std::string expectedFromChars(const char* chars) { int64_t nChars = strlen(chars); std::stringstream stream; for (int64_t i = 0; i < nChars; i++) { if (i > 0) { stream << " or "; } stream << quote(chars[i]); } return stream.str(); } static std::string quote(std::string input) { if (input.size() == 0) { return "end of input"; } else { std::stringstream stream; stream << "'" << input << "'"; return stream.str(); } } static std::string quote(char input) { if (input == '\0') { return "end of input"; } else { std::stringstream stream; stream << "'" << input << "'"; return stream.str(); } } }; #endif wk/src/internal/wk-v1-handler.hpp0000644000176200001440000002006314160220603016362 0ustar liggesusers #ifndef WK_V1_HANDLER_HPP_INCLUDED #define WK_V1_HANDLER_HPP_INCLUDED #define R_NO_REMAP #include "wk-v1.h" #include #include // This is an internal C++ class for instances where it's easier to use // something in the C++ (>=11) standard library. It is safe to throw // exceptions in handler methods (which are caught and converted to // an Rf_error()); it is safe to longjmp from handler methods provided // that the method has been written in such a way that nothing is // stack-allocated that has a non-trivial destructor. As noted below, // you can get around this by declaring an object with a non-trivial // destructor as a member of the class, which always gets deleted // by the external pointer finalizer. class WKVoidHandler { public: WKVoidHandler() { memset(this->internal_error_message, 0, 8192); } virtual ~WKVoidHandler() {} // # nocov start virtual void initialize(int* dirty) { if (*dirty) { Rf_error("Can't re-use this wk_handler"); } *dirty = 1; } virtual int vector_start(const wk_vector_meta_t* meta) { return WK_CONTINUE; } virtual int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return WK_CONTINUE; } virtual int null_feature() { return WK_CONTINUE; } virtual int geometry_start(const wk_meta_t* meta, uint32_t part_id) { return WK_CONTINUE; } virtual int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id) { return WK_CONTINUE; } virtual int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id) { return WK_CONTINUE; } virtual int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id) { return WK_CONTINUE; } virtual int geometry_end(const wk_meta_t* meta, uint32_t part_id) { return WK_CONTINUE; } virtual int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return WK_CONTINUE; } virtual SEXP vector_end(const wk_vector_meta_t* meta) { return R_NilValue; } virtual void deinitialize() { } virtual int error(const char* message) { Rf_error("%s", message); } // # nocov end char internal_error_message[8192]; }; // The previous version of this macro also handled cpp11::unwind_exception // throws; however, in this simplified version, we just handle regular // exceptions and require that users consider the longjmp-y-ness of // their handler methods. Because handlers are always cleaned up via // deinitialize/finalize, C++ handlers can declare anything with a // non-trivial destructor as a handler class member rather than // a stack-allocated variable. #define WK_V1_HANDLER_BEGIN_CPP11 \ cpp_handler->internal_error_message[0] = '\0'; \ try { #define WK_V1_HANDLER_END_CPP11(_error_return) \ } catch (std::exception & e) { \ strncpy(cpp_handler->internal_error_message, e.what(), 8192 - 1); \ } catch (...) { \ strncpy(cpp_handler->internal_error_message, "C++ error (unknown cause)", 8192 - 1); \ } \ if (cpp_handler->internal_error_message[0] != '\0') { \ Rf_error("%s", cpp_handler->internal_error_message); \ } \ return _error_return; template class WKHandlerFactory { public: static wk_handler_t* create(HandlerType* handler_data) { wk_handler_t* handler = wk_handler_create(); handler->handler_data = handler_data; handler->initialize = &initialize; handler->vector_start = &vector_start; handler->vector_end = &vector_end; handler->feature_start = &feature_start; handler->null_feature = &null_feature; handler->feature_end = &feature_end; handler->geometry_start = &geometry_start; handler->geometry_end = &geometry_end; handler->ring_start = &ring_start; handler->ring_end = &ring_end; handler->coord = &coord; handler->error = &error; handler->deinitialize = &deinitialize; handler->finalizer = &finalizer; return handler; } static SEXP create_xptr(HandlerType* handler_data) { wk_handler_t* handler = create(handler_data); return wk_handler_create_xptr(handler, R_NilValue, R_NilValue); } private: static void finalizer(void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; if (cpp_handler != NULL) { delete cpp_handler; } } static void initialize(int* dirty, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->initialize(dirty); WK_V1_HANDLER_END_CPP11() // # nocov } static int vector_start(const wk_vector_meta_t* meta, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->vector_start(meta); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->feature_start(meta, feat_id); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int null_feature(void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->null_feature(); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int geometry_start(const wk_meta_t* meta, uint32_t partId, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->geometry_start(meta, partId); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ringId, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->ring_start(meta, size, ringId); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->coord(meta, coord, coord_id); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ringId, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->ring_end(meta, size, ringId); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int geometry_end(const wk_meta_t* meta, uint32_t partId, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->geometry_end(meta, partId); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->feature_end(meta, feat_id); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } static SEXP vector_end(const wk_vector_meta_t* meta, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->vector_end(meta); WK_V1_HANDLER_END_CPP11(R_NilValue) // # nocov } static void deinitialize(void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->deinitialize(); WK_V1_HANDLER_END_CPP11() // # nocov } static int error(const char* message, void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; WK_V1_HANDLER_BEGIN_CPP11 return cpp_handler->error(message); WK_V1_HANDLER_END_CPP11(WK_ABORT) // # nocov } }; #endif wk/src/count-handler.c0000644000176200001440000001260514106220314014366 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #include typedef struct { SEXP result; R_xlen_t result_size; R_xlen_t feat_id; int n_geom; int n_ring; R_xlen_t n_coord; } count_handler_t; SEXP count_handler_alloc_result(R_xlen_t size) { const char* names[] = {"n_geom", "n_ring", "n_coord", ""}; SEXP result = PROTECT(Rf_mkNamed(VECSXP, names)); SET_VECTOR_ELT(result, 0, Rf_allocVector(INTSXP, size)); SET_VECTOR_ELT(result, 1, Rf_allocVector(INTSXP, size)); SET_VECTOR_ELT(result, 2, Rf_allocVector(REALSXP, size)); UNPROTECT(1); return result; } SEXP count_handler_realloc_result(SEXP result, R_xlen_t new_size) { SEXP new_result = PROTECT(count_handler_alloc_result(new_size)); R_xlen_t size_cpy; if (Rf_xlength(VECTOR_ELT(result, 0)) < new_size) { size_cpy = Rf_xlength(VECTOR_ELT(result, 0)); } else { size_cpy = new_size; } memcpy(INTEGER(VECTOR_ELT(new_result, 0)), INTEGER(VECTOR_ELT(result, 0)), sizeof(int) * size_cpy); memcpy(INTEGER(VECTOR_ELT(new_result, 1)), INTEGER(VECTOR_ELT(result, 1)), sizeof(int) * size_cpy); memcpy(REAL(VECTOR_ELT(new_result, 2)), REAL(VECTOR_ELT(result, 2)), sizeof(double) * size_cpy); UNPROTECT(1); return new_result; } int count_handler_vector_start(const wk_vector_meta_t* meta, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; if (data->result != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { data->result = PROTECT(count_handler_alloc_result(1024)); data->result_size = 1024; } else { data->result = PROTECT(count_handler_alloc_result(meta->size)); data->result_size = meta->size; } R_PreserveObject(data->result); UNPROTECT(1); return WK_CONTINUE; } int count_handler_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; data->feat_id = feat_id; data->n_coord = 0; data->n_geom = 0; data->n_ring = 0; return WK_CONTINUE; } int count_handler_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; data->n_geom++; return WK_CONTINUE; } int count_handler_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; data->n_ring++; return WK_CONTINUE; } int count_handler_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; data->n_coord++; return WK_CONTINUE; } int count_handler_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; if (data->feat_id >= data->result_size) { SEXP new_result = PROTECT(count_handler_realloc_result(data->result, data->result_size * 2 + 1)); R_ReleaseObject(data->result); data->result = new_result; R_PreserveObject(data->result); UNPROTECT(1); data->result_size = data->result_size * 2 + 1; } INTEGER(VECTOR_ELT(data->result, 0))[data->feat_id] = data->n_geom; INTEGER(VECTOR_ELT(data->result, 1))[data->feat_id] = data->n_ring; REAL(VECTOR_ELT(data->result, 2))[data->feat_id] = data->n_coord; return WK_CONTINUE; } SEXP count_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; R_xlen_t final_size = data->feat_id + 1; if (data->result_size != final_size) { SEXP new_result = PROTECT(count_handler_realloc_result(data->result, final_size)); R_ReleaseObject(data->result); data->result = R_NilValue; UNPROTECT(1); return new_result; } else { return data->result; } } void count_handler_deinitialize(void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; if (data->result != R_NilValue) { R_ReleaseObject(data->result); data->result = R_NilValue; } } void count_handler_finalize(void* handler_data) { count_handler_t* data = (count_handler_t*) handler_data; if (data != NULL) { free(data); } } SEXP wk_c_count_handler_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &count_handler_vector_start; handler->feature_start = &count_handler_feature_start; handler->geometry_start = &count_handler_geometry_start; handler->ring_start = &count_handler_ring_start; handler->coord = &count_handler_coord; handler->feature_end = &count_handler_feature_end; handler->vector_end = &count_handler_vector_end; handler->deinitialize = &count_handler_deinitialize; handler->finalizer = &count_handler_finalize; count_handler_t* data = (count_handler_t*) malloc(sizeof(count_handler_t)); if (data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } data->feat_id = 0; data->result = R_NilValue; handler->handler_data = data; SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); return xptr; } wk/src/handle-wkb.c0000644000176200001440000002435114151152004013640 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include "altrep.h" #include #include #include #define WK_DEFAULT_ERROR_CODE 0 #define WK_NO_ERROR_CODE -1 // IS_BIG_ENDIAN, IS_LITTLE_ENDIAN, bswap_32(), bswap_64() #include "port.h" #define EWKB_Z_BIT 0x80000000 #define EWKB_M_BIT 0x40000000 #define EWKB_SRID_BIT 0x20000000 typedef struct { wk_handler_t* handler; R_xlen_t feat_id; SEXP buffer_sexp; R_xlen_t buffer_sexp_i; #ifdef HAS_ALTREP_RAW unsigned char buffer[ALTREP_CHUNK_SIZE]; #else unsigned char* buffer; #endif size_t size; size_t offset; char swap_endian; int error_code; char error_buf[1024]; } wkb_reader_t; int wkb_read_geometry(wkb_reader_t* reader, uint32_t part_id); int wkb_read_endian(wkb_reader_t* reader, unsigned char* value); int wkb_read_geometry_type(wkb_reader_t* reader, wk_meta_t* meta); int wkb_read_uint(wkb_reader_t* reader, uint32_t* value); int wkb_read_coordinates(wkb_reader_t* reader, const wk_meta_t* meta, uint32_t n_coords, int n_dim); void wkb_read_set_errorf(wkb_reader_t* reader, const char* error_buf, ...); static inline int wkb_read_check_buffer(wkb_reader_t* reader, R_xlen_t bytes) { R_xlen_t bytes_to_keep = reader->size - reader->offset; if ((bytes_to_keep - bytes) >= 0) { return WK_CONTINUE; } #ifdef HAS_ALTREP_RAW // with ALTREP, we try to refill the buffer // We can do this without a memmove() by just issuing slightly overlapping // RAW_GET_REGION() calls, but there are some cases where this might cause // an altrep implementation to seek backwards in a file which is slow. if (bytes_to_keep > 0) { memmove(reader->buffer, reader->buffer + reader->offset, bytes_to_keep); } R_xlen_t new_bytes = RAW_GET_REGION( reader->buffer_sexp, reader->buffer_sexp_i, ALTREP_CHUNK_SIZE - bytes_to_keep, reader->buffer + bytes_to_keep ); reader->offset = 0; reader->buffer_sexp_i += new_bytes; reader->size = bytes_to_keep + new_bytes; #else // without ALTREP, reader->size is the full length of the RAW() buffer, so we've // hit the end of it reader->size = 0; reader->buffer_sexp_i += reader->offset; #endif if (reader->size == 0) { wkb_read_set_errorf(reader, "Unexpected end of buffer at %d bytes", reader->buffer_sexp_i); return WK_ABORT_FEATURE; } return WK_CONTINUE; } #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result != WK_CONTINUE) return result #define HANDLE_CONTINUE_OR_BREAK(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) continue; else if (result == WK_ABORT) break int wkb_read_geometry(wkb_reader_t* reader, uint32_t part_id) { int result; unsigned char endian; HANDLE_OR_RETURN(wkb_read_endian(reader, &endian)); #ifdef IS_LITTLE_ENDIAN reader->swap_endian = endian != 1; #else reader->swap_endian = endian != 0; #endif wk_meta_t meta; WK_META_RESET(meta, WK_GEOMETRY); HANDLE_OR_RETURN(wkb_read_geometry_type(reader, &meta)); int n_dim = 2 + ((meta.flags & WK_FLAG_HAS_Z) != 0) + ((meta.flags & WK_FLAG_HAS_M) != 0); HANDLE_OR_RETURN(reader->handler->geometry_start(&meta, part_id, reader->handler->handler_data)); switch (meta.geometry_type) { case WK_POINT: case WK_LINESTRING: HANDLE_OR_RETURN(wkb_read_coordinates(reader, &meta, meta.size, n_dim)); break; case WK_POLYGON: for (uint32_t i = 0; i < meta.size; i++) { uint32_t n_coords; HANDLE_OR_RETURN(wkb_read_uint(reader, &n_coords)); HANDLE_OR_RETURN(reader->handler->ring_start(&meta, n_coords, i, reader->handler->handler_data)); HANDLE_OR_RETURN(wkb_read_coordinates(reader, &meta, n_coords, n_dim)); HANDLE_OR_RETURN(reader->handler->ring_end(&meta, n_coords, i, reader->handler->handler_data)); } break; case WK_MULTIPOINT: case WK_MULTILINESTRING: case WK_MULTIPOLYGON: case WK_GEOMETRYCOLLECTION: for (uint32_t i = 0; i < meta.size; i++) { HANDLE_OR_RETURN(wkb_read_geometry(reader, i)); } break; default: wkb_read_set_errorf(reader, "Unrecognized geometry type code '%d'", meta.geometry_type); return WK_ABORT_FEATURE; } return reader->handler->geometry_end(&meta, part_id, reader->handler->handler_data); } int wkb_read_endian(wkb_reader_t* reader, unsigned char* value) { int result; HANDLE_OR_RETURN(wkb_read_check_buffer(reader, sizeof(unsigned char))); memcpy(value, reader->buffer + reader->offset, sizeof(unsigned char)); reader->offset += sizeof(unsigned char); return WK_CONTINUE; } int wkb_read_uint(wkb_reader_t* reader, uint32_t* value) { int result; HANDLE_OR_RETURN(wkb_read_check_buffer(reader, sizeof(uint32_t))); if (reader->swap_endian) { uint32_t swappable; memcpy(&swappable, reader->buffer + reader->offset, sizeof(uint32_t)); reader->offset += sizeof(uint32_t); *value = bswap_32(swappable); } else { memcpy(value, reader->buffer + reader->offset, sizeof(uint32_t)); reader->offset += sizeof(uint32_t); } return WK_CONTINUE; } int wkb_read_geometry_type(wkb_reader_t* reader, wk_meta_t* meta) { int result; uint32_t geometry_type; HANDLE_OR_RETURN(wkb_read_uint(reader, &geometry_type)); if (geometry_type & EWKB_Z_BIT) { meta->flags |= WK_FLAG_HAS_Z; } if (geometry_type & EWKB_M_BIT) { meta->flags |= WK_FLAG_HAS_M; } if (geometry_type & EWKB_SRID_BIT) { HANDLE_OR_RETURN(wkb_read_uint(reader, &(meta->srid))); } geometry_type = geometry_type & 0x0000ffff; if (geometry_type >= 3000) { meta->geometry_type = geometry_type - 3000; meta->flags |= WK_FLAG_HAS_Z; meta->flags |= WK_FLAG_HAS_M; } else if (geometry_type >= 2000) { meta->geometry_type = geometry_type - 2000; meta->flags |= WK_FLAG_HAS_M; } else if (geometry_type >= 1000) { meta->geometry_type = geometry_type - 1000; meta->flags |= WK_FLAG_HAS_Z; } else { meta->geometry_type = geometry_type; } if (meta->geometry_type == WK_POINT) { meta->size = 1; } else { HANDLE_OR_RETURN(wkb_read_uint(reader, &(meta->size))); } return WK_CONTINUE; } int wkb_read_coordinates(wkb_reader_t* reader, const wk_meta_t* meta, uint32_t n_coords, int n_dim) { double coord[4]; int result; if (reader->swap_endian) { uint64_t swappable, swapped; for (uint32_t i = 0; i < n_coords; i++) { HANDLE_OR_RETURN(wkb_read_check_buffer(reader, sizeof(uint64_t) * n_dim)); for (int j = 0; j < n_dim; j++) { memcpy(&swappable, reader->buffer + reader->offset, sizeof(uint64_t)); reader->offset += sizeof(double); swapped = bswap_64(swappable); memcpy(coord + j, &swapped, sizeof(double)); } HANDLE_OR_RETURN(reader->handler->coord(meta, coord, i, reader->handler->handler_data)); } } else { // seems to be slightly faster than memcpy(coord, ..., coord_size) uint64_t swappable; for (uint32_t i = 0; i < n_coords; i++) { HANDLE_OR_RETURN(wkb_read_check_buffer(reader, sizeof(uint64_t) * n_dim)); for (int j = 0; j < n_dim; j++) { memcpy(&swappable, reader->buffer + reader->offset, sizeof(uint64_t)); reader->offset += sizeof(double); memcpy(coord + j, &swappable, sizeof(double)); } HANDLE_OR_RETURN(reader->handler->coord(meta, coord, i, reader->handler->handler_data)); } } return WK_CONTINUE; } void wkb_read_set_errorf(wkb_reader_t* reader, const char* error_buf, ...) { reader->error_code = WK_DEFAULT_ERROR_CODE; va_list args; va_start(args, error_buf); vsnprintf(reader->error_buf, 1024, error_buf, args); va_end(args); } SEXP wkb_read_wkb(SEXP data, wk_handler_t* handler) { R_xlen_t n_features = Rf_xlength(data); wk_vector_meta_t vector_meta; WK_VECTOR_META_RESET(vector_meta, WK_GEOMETRY); vector_meta.size = n_features; vector_meta.flags |= WK_FLAG_DIMS_UNKNOWN; if (handler->vector_start(&vector_meta, handler->handler_data) == WK_CONTINUE) { int result; SEXP item; wkb_reader_t reader; reader.handler = handler; memset(reader.error_buf, 0, 1024); for (R_xlen_t i = 0; i < n_features; i++) { // each feature could be huge, so check frequently if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); reader.feat_id = i; item = VECTOR_ELT(data, i); HANDLE_CONTINUE_OR_BREAK(handler->feature_start(&vector_meta, i, handler->handler_data)); if (item == R_NilValue) { HANDLE_CONTINUE_OR_BREAK(handler->null_feature(handler->handler_data)); } else { reader.buffer_sexp = item; reader.buffer_sexp_i = 0; reader.offset = 0; #ifdef HAS_ALTREP_RAW reader.size = 0; #else reader.size = Rf_xlength(item); reader.buffer = RAW(item); #endif reader.error_code = WK_NO_ERROR_CODE; reader.error_buf[0] = '\0'; result = wkb_read_geometry(&reader, WK_PART_ID_NONE); if (result == WK_ABORT_FEATURE && reader.error_code != WK_NO_ERROR_CODE) { result = handler->error(reader.error_buf, handler->handler_data); } if (result == WK_ABORT_FEATURE) { continue; } else if (result == WK_ABORT) { break; } } if (handler->feature_end(&vector_meta, i, handler->handler_data) == WK_ABORT) { break; } } } SEXP result = PROTECT(handler->vector_end(&vector_meta, handler->handler_data)); UNPROTECT(1); return result; } SEXP wk_c_read_wkb(SEXP data, SEXP handler_xptr) { return wk_handler_run_xptr(&wkb_read_wkb, data, handler_xptr); } wk/src/make-polygon-filter.c0000644000176200001440000002723514151152004015515 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" #include "altrep.h" #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) { \ Rf_error("wk_polygon_filter() does not support WK_ABORT_FEATURE"); \ } \ if (result != WK_CONTINUE) return result typedef struct { wk_handler_t* next; R_xlen_t feature_id; SEXP feature_id_sexp; SEXP ring_id_sexp; #ifndef HAS_ALTREP int* feature_id_spec; int* ring_id_spec; #endif R_xlen_t n_feature_id_spec; R_xlen_t n_ring_id_spec; int last_feature_id_spec; int last_ring_id_spec; int is_new_feature; int is_new_ring; R_xlen_t feature_id_out; R_xlen_t ring_id; uint32_t coord_id; double first_coord[4]; double last_coord[4]; int last_coord_size; wk_meta_t meta; wk_vector_meta_t vector_meta; } polygon_filter_t; static inline int wk_polygon_start(polygon_filter_t* polygon_filter) { int result; polygon_filter->feature_id_out++; HANDLE_OR_RETURN(polygon_filter->next->feature_start(&(polygon_filter->vector_meta), polygon_filter->feature_id_out, polygon_filter->next->handler_data)); HANDLE_OR_RETURN(polygon_filter->next->geometry_start(&(polygon_filter->meta), WK_PART_ID_NONE, polygon_filter->next->handler_data)); polygon_filter->ring_id = -1; return WK_CONTINUE; } static inline int wk_ring_start(polygon_filter_t* polygon_filter) { int result; // keep a copy of the first coordinate so that we can check for a closed loop memcpy(polygon_filter->first_coord, polygon_filter->last_coord, 4 * sizeof(double)); polygon_filter->ring_id++; HANDLE_OR_RETURN(polygon_filter->next->ring_start(&(polygon_filter->meta), WK_SIZE_UNKNOWN, polygon_filter->ring_id, polygon_filter->next->handler_data)); polygon_filter->coord_id = 0; return WK_CONTINUE; } static inline int wk_ring_end(polygon_filter_t* polygon_filter) { int result; // close the loop if necessary for (int i = 0; i < polygon_filter->last_coord_size; i++) { if (polygon_filter->last_coord[i] != polygon_filter->first_coord[i]) { HANDLE_OR_RETURN(polygon_filter->next->coord(&(polygon_filter->meta), polygon_filter->first_coord, polygon_filter->coord_id, polygon_filter->next->handler_data)); break; } } HANDLE_OR_RETURN(polygon_filter->next->ring_end(&(polygon_filter->meta), WK_SIZE_UNKNOWN, polygon_filter->ring_id, polygon_filter->next->handler_data)); return WK_CONTINUE; } static inline int wk_polygon_end(polygon_filter_t* polygon_filter) { int result; HANDLE_OR_RETURN(polygon_filter->next->geometry_end(&(polygon_filter->meta), WK_PART_ID_NONE, polygon_filter->next->handler_data)); HANDLE_OR_RETURN(polygon_filter->next->feature_end(&(polygon_filter->vector_meta), polygon_filter->feature_id_out, polygon_filter->next->handler_data)); return WK_CONTINUE; } void wk_polygon_filter_initialize(int* dirty, void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; *dirty = 1; polygon_filter->next->initialize(&polygon_filter->next->dirty, polygon_filter->next->handler_data); } int wk_polygon_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; polygon_filter->feature_id = -1; polygon_filter->feature_id_out = -1; memcpy(&(polygon_filter->vector_meta), meta, sizeof(wk_vector_meta_t)); polygon_filter->vector_meta.geometry_type = WK_POLYGON; polygon_filter->vector_meta.size = WK_VECTOR_SIZE_UNKNOWN; WK_META_RESET(polygon_filter->meta, WK_POLYGON); return polygon_filter->next->vector_start(&(polygon_filter->vector_meta), polygon_filter->next->handler_data); } int wk_polygon_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; polygon_filter->feature_id++; R_xlen_t spec_i = polygon_filter->feature_id % polygon_filter->n_feature_id_spec; #ifdef HAS_ALTREP int feature_id_spec = INTEGER_ELT(polygon_filter->feature_id_sexp, spec_i); #else int feature_id_spec = polygon_filter->feature_id_spec[spec_i]; #endif int feature_id_spec_changed = feature_id_spec != polygon_filter->last_feature_id_spec; polygon_filter->last_feature_id_spec = feature_id_spec; spec_i = polygon_filter->feature_id % polygon_filter->n_ring_id_spec; #ifdef HAS_ALTREP int ring_id_spec = INTEGER_ELT(polygon_filter->ring_id_sexp, spec_i); #else int ring_id_spec = polygon_filter->ring_id_spec[spec_i]; #endif int ring_id_spec_changed = ring_id_spec != polygon_filter->last_ring_id_spec; polygon_filter->last_ring_id_spec = ring_id_spec; polygon_filter->is_new_feature = feature_id_spec_changed || (polygon_filter->feature_id == 0); polygon_filter->is_new_ring = polygon_filter->is_new_feature || ring_id_spec_changed; return WK_CONTINUE; } int wk_polygon_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; int result; // We always need to keep a copy of the last coordinate because we // need to check for closed rings and the ring end method gets called // at the *next* coordinate where there's a new feature. polygon_filter->last_coord_size = 2 + ((meta->flags & WK_FLAG_HAS_Z) != 0) + ((meta->flags & WK_FLAG_HAS_M) != 0); memset(polygon_filter->last_coord, 0, 4 * sizeof(double)); memcpy(polygon_filter->last_coord, coord, polygon_filter->last_coord_size * sizeof(double)); // maybe need to close the ring before starting a new feature/ring if (polygon_filter->is_new_ring && polygon_filter->feature_id > 0) { HANDLE_OR_RETURN(wk_ring_end(polygon_filter)); } if (polygon_filter->is_new_feature) { if (polygon_filter->feature_id > 0) { HANDLE_OR_RETURN(wk_polygon_end(polygon_filter)); } polygon_filter->meta.flags = meta->flags; polygon_filter->meta.flags &= ~WK_FLAG_HAS_BOUNDS; polygon_filter->meta.precision = meta->precision; polygon_filter->meta.srid = meta->srid; HANDLE_OR_RETURN(wk_polygon_start(polygon_filter)); polygon_filter->is_new_feature = 0; } else { // check dimensions against current meta because handlers make the assumption // that all coordinates passed have the same dimension for a single geometry int diff_z = (polygon_filter->meta.flags & WK_FLAG_HAS_Z) ^ (meta->flags & WK_FLAG_HAS_Z); int diff_m = (polygon_filter->meta.flags & WK_FLAG_HAS_M) ^ (meta->flags & WK_FLAG_HAS_M); int diff_srid = polygon_filter->meta.srid != meta->srid; if (diff_z || diff_m || diff_srid) { Rf_error("Can't create polygon using geometries with differing dimensions or SRID"); } } if (polygon_filter->is_new_ring) { HANDLE_OR_RETURN(wk_ring_start(polygon_filter)); polygon_filter->is_new_ring = 0; } HANDLE_OR_RETURN(polygon_filter->next->coord(&(polygon_filter->meta), coord, polygon_filter->coord_id, polygon_filter->next->handler_data)); polygon_filter->coord_id++; return WK_CONTINUE; } SEXP wk_polygon_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; // if there weren't any features we need to start one int result = WK_CONTINUE; if (polygon_filter->feature_id_out == -1) { polygon_filter->meta.size = 0; result = wk_polygon_start(polygon_filter); } if (result != WK_ABORT) { if (polygon_filter->ring_id >= 0) { result = wk_ring_end(polygon_filter); } if (result != WK_ABORT) { wk_polygon_end(polygon_filter); } } return polygon_filter->next->vector_end(&(polygon_filter->vector_meta), polygon_filter->next->handler_data); } int wk_polygon_filter_feature_null(void* handler_data) { return WK_CONTINUE; } int wk_polygon_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { return WK_CONTINUE; } int wk_polygon_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { return WK_CONTINUE; } int wk_polygon_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { return WK_CONTINUE; } int wk_polygon_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { return WK_CONTINUE; } int wk_polygon_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { return WK_CONTINUE; } int wk_polygon_filter_error(const char* message, void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; int result; HANDLE_OR_RETURN(polygon_filter->next->error(message, polygon_filter->next->handler_data)); return WK_CONTINUE; } void wk_polygon_filter_deinitialize(void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; polygon_filter->next->deinitialize(polygon_filter->next->handler_data); } void wk_polygon_filter_finalize(void* handler_data) { polygon_filter_t* polygon_filter = (polygon_filter_t*) handler_data; if (polygon_filter != NULL) { free(polygon_filter); } } SEXP wk_c_polygon_filter_new(SEXP handler_xptr, SEXP feature_id, SEXP ring_id) { #ifndef HAS_ALTREP int* feature_id_spec = INTEGER(feature_id); int* ring_id_spec = INTEGER(ring_id); #endif wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_polygon_filter_initialize; handler->vector_start = &wk_polygon_filter_vector_start; handler->vector_end = &wk_polygon_filter_vector_end; handler->feature_start = &wk_polygon_filter_feature_start; handler->null_feature = &wk_polygon_filter_feature_null; handler->feature_end = &wk_polygon_filter_feature_end; handler->geometry_start = &wk_polygon_filter_geometry_start; handler->geometry_end = &wk_polygon_filter_geometry_end; handler->ring_start = &wk_polygon_filter_ring_start; handler->ring_end = &wk_polygon_filter_ring_end; handler->coord = &wk_polygon_filter_coord; handler->error = &wk_polygon_filter_error; handler->deinitialize = &wk_polygon_filter_deinitialize; handler->finalizer = &wk_polygon_filter_finalize; polygon_filter_t* polygon_filter = (polygon_filter_t*) malloc(sizeof(polygon_filter_t)); if (polygon_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } polygon_filter->next = (wk_handler_t*) R_ExternalPtrAddr(handler_xptr); if (polygon_filter->next->api_version != 1) { wk_handler_destroy(handler); // # nocov free(polygon_filter); // # nocov Rf_error("Can't run a wk_handler with api_version '%d'", polygon_filter->next->api_version); // # nocov } polygon_filter->coord_id = 0; polygon_filter->ring_id = 0; polygon_filter->feature_id = -1; polygon_filter->feature_id_out = 0; polygon_filter->feature_id_sexp = feature_id; polygon_filter->ring_id_sexp = ring_id; #ifndef HAS_ALTREP polygon_filter->feature_id_spec = feature_id_spec; polygon_filter->ring_id_spec = ring_id_spec; #endif polygon_filter->n_feature_id_spec = Rf_xlength(feature_id); polygon_filter->n_ring_id_spec = Rf_xlength(ring_id); polygon_filter->is_new_feature = 0; polygon_filter->is_new_ring = 0; polygon_filter->last_feature_id_spec = NA_INTEGER; polygon_filter->last_ring_id_spec = NA_INTEGER; handler->handler_data = polygon_filter; // We need the external pointer SEXP, the feature_id SEXP, // and the ring_id SEEXP to be valid for the lifetime of this object SEXP id_spec = PROTECT(Rf_allocVector(VECSXP, 2)); SET_VECTOR_ELT(id_spec, 0, feature_id); SET_VECTOR_ELT(id_spec, 1, ring_id); SEXP filter_xptr = PROTECT(wk_handler_create_xptr(handler, handler_xptr, id_spec)); UNPROTECT(2); return filter_xptr; } wk/src/init.c0000644000176200001440000001043014161345517012576 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" /* generated by data-raw/make_callentries.R */ extern SEXP wk_c_bbox_handler_new(); extern SEXP wk_c_envelope_handler_new(); extern SEXP wk_c_count_handler_new(); extern SEXP wk_c_debug_filter_new(SEXP handler_xptr); extern SEXP wk_c_flatten_filter_new(SEXP handler_xptr, SEXP max_depth, SEXP add_details); extern SEXP wk_c_read_crc(SEXP data, SEXP handler_xptr, SEXP n_segs); extern SEXP wk_c_read_rct(SEXP data, SEXP handlerXptr); extern SEXP wk_c_read_sfc_impl(SEXP data, wk_handler_t* handler); extern SEXP wk_c_read_sfc(SEXP data, SEXP handler_xptr); extern SEXP wk_c_read_wkb(SEXP data, SEXP handler_xptr); extern SEXP wk_c_read_wkt(SEXP data, SEXP handler_xptr); extern SEXP wk_c_read_xy(SEXP data, SEXP handlerXptr); extern SEXP wk_c_identity_filter_new(SEXP handler_xptr); extern SEXP wk_c_collection_filter_new(SEXP handler_xptr, SEXP geometry_type, SEXP feature_id); extern SEXP wk_c_linestring_filter_new(SEXP handler_xptr, SEXP feature_id); extern SEXP wk_c_polygon_filter_new(SEXP handler_xptr, SEXP feature_id, SEXP ring_id); extern SEXP wk_c_meta_handler_new(); extern SEXP wk_c_vector_meta_handler_new(); extern SEXP wk_c_problems_handler_new(); extern SEXP wk_c_sfc_writer_new(); extern SEXP wk_c_trans_affine_new(SEXP trans_matrix); extern SEXP wk_c_trans_affine_as_matrix(SEXP trans_xptr); extern SEXP wk_c_trans_set_new(SEXP xy, SEXP use_z, SEXP use_m); extern SEXP wk_c_trans_filter_new(SEXP handler_xptr, SEXP trans_xptr); extern SEXP wk_c_wkb_is_na(SEXP geom); extern SEXP wk_c_wkb_is_raw_or_null(SEXP geom); extern SEXP wk_c_vertex_filter_new(SEXP handler_xptr, SEXP add_details); extern SEXP wk_c_handler_void_new(); extern SEXP wk_c_handler_addr(SEXP xptr); extern SEXP wk_c_wkb_writer_new(SEXP buffer_size_sexp, SEXP endian_sexp); extern SEXP wk_c_wkt_writer(SEXP precision_sexp, SEXP trim_sexp); extern SEXP wk_c_wkt_formatter(SEXP precision_sexp, SEXP trim_sexp, SEXP max_coords_sexp); extern SEXP wk_c_xy_writer_new(); static const R_CallMethodDef CallEntries[] = { {"wk_c_bbox_handler_new", (DL_FUNC) &wk_c_bbox_handler_new, 0}, {"wk_c_envelope_handler_new", (DL_FUNC) &wk_c_envelope_handler_new, 0}, {"wk_c_count_handler_new", (DL_FUNC) &wk_c_count_handler_new, 0}, {"wk_c_debug_filter_new", (DL_FUNC) &wk_c_debug_filter_new, 1}, {"wk_c_flatten_filter_new", (DL_FUNC) &wk_c_flatten_filter_new, 3}, {"wk_c_read_crc", (DL_FUNC) &wk_c_read_crc, 3}, {"wk_c_read_rct", (DL_FUNC) &wk_c_read_rct, 2}, {"wk_c_read_sfc_impl", (DL_FUNC) &wk_c_read_sfc_impl, 2}, {"wk_c_read_sfc", (DL_FUNC) &wk_c_read_sfc, 2}, {"wk_c_read_wkb", (DL_FUNC) &wk_c_read_wkb, 2}, {"wk_c_read_wkt", (DL_FUNC) &wk_c_read_wkt, 2}, {"wk_c_read_xy", (DL_FUNC) &wk_c_read_xy, 2}, {"wk_c_identity_filter_new", (DL_FUNC) &wk_c_identity_filter_new, 1}, {"wk_c_collection_filter_new", (DL_FUNC) &wk_c_collection_filter_new, 3}, {"wk_c_linestring_filter_new", (DL_FUNC) &wk_c_linestring_filter_new, 2}, {"wk_c_polygon_filter_new", (DL_FUNC) &wk_c_polygon_filter_new, 3}, {"wk_c_meta_handler_new", (DL_FUNC) &wk_c_meta_handler_new, 0}, {"wk_c_vector_meta_handler_new", (DL_FUNC) &wk_c_vector_meta_handler_new, 0}, {"wk_c_problems_handler_new", (DL_FUNC) &wk_c_problems_handler_new, 0}, {"wk_c_sfc_writer_new", (DL_FUNC) &wk_c_sfc_writer_new, 0}, {"wk_c_trans_affine_new", (DL_FUNC) &wk_c_trans_affine_new, 1}, {"wk_c_trans_affine_as_matrix", (DL_FUNC) &wk_c_trans_affine_as_matrix, 1}, {"wk_c_trans_set_new", (DL_FUNC) &wk_c_trans_set_new, 3}, {"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_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}, {"wk_c_wkb_writer_new", (DL_FUNC) &wk_c_wkb_writer_new, 2}, {"wk_c_wkt_writer", (DL_FUNC) &wk_c_wkt_writer, 2}, {"wk_c_wkt_formatter", (DL_FUNC) &wk_c_wkt_formatter, 3}, {"wk_c_xy_writer_new", (DL_FUNC) &wk_c_xy_writer_new, 0}, {NULL, NULL, 0} }; /* end generated by data-raw/make_callentries.R */ void R_init_wk(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } wk/src/wkb-writer.c0000644000176200001440000003031014147554023013725 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #include // IS_BIG_ENDIAN, IS_LITTLE_ENDIAN, bswap_32(), bswap_64() #include "port.h" #define EWKB_Z_BIT 0x80000000 #define EWKB_M_BIT 0x40000000 #define EWKB_SRID_BIT 0x20000000 #define WKB_MAX_RECURSION_DEPTH 32 typedef struct { SEXP result; int swap_endian; unsigned char endian; unsigned char* buffer; size_t size; size_t offset; size_t current_size_offset[WKB_MAX_RECURSION_DEPTH + 3]; uint32_t current_size[WKB_MAX_RECURSION_DEPTH + 3]; size_t recursion_level; R_xlen_t feat_id; } wkb_writer_t; static inline unsigned char wkb_writer_platform_endian() { #ifdef IS_LITTLE_ENDIAN return 1; #else return 0; #endif } static inline uint32_t wkb_writer_encode_type(const wk_meta_t* meta, int recursion_level) { uint32_t out = meta->geometry_type; if (meta->flags & WK_FLAG_HAS_Z) out |= EWKB_Z_BIT; if (meta->flags & WK_FLAG_HAS_M) out |= EWKB_M_BIT; if (recursion_level == 0) { if (meta->srid != WK_SRID_NONE) out |= EWKB_SRID_BIT; } return out; } wkb_writer_t* wkb_writer_new(size_t buffer_size, unsigned char endian) { unsigned char* buffer = malloc(buffer_size); if (buffer == NULL) { return NULL; // # nocov } wkb_writer_t* writer = (wkb_writer_t*) malloc(sizeof(wkb_writer_t)); if (writer == NULL) { free(buffer); // # nocov return NULL; // # nocov } writer->endian = endian; #ifdef IS_LITTLE_ENDIAN writer->swap_endian = endian != 1; #else writer->swap_endian = endian != 0; #endif writer->result = R_NilValue; writer->buffer = buffer; writer->size = buffer_size; writer->offset = 0; writer->recursion_level = 0; writer->feat_id = 0; return writer; } static inline void wkb_writer_ensure_space(wkb_writer_t* writer, size_t item) { if ((writer->offset + item) >= writer->size) { unsigned char* new_buffer = realloc(writer->buffer, writer->size * 2); if (new_buffer == NULL) { Rf_error("Can't reallocate buffer of size %d", writer->size * 2); // # nocov } writer->buffer = new_buffer; writer->size = writer->size * 2; } } static inline void wkb_write_uchar(wkb_writer_t* writer, const unsigned char value) { wkb_writer_ensure_space(writer, sizeof(unsigned char)); memcpy(writer->buffer + writer->offset, &value, sizeof(unsigned char)); writer->offset += sizeof(unsigned char); } static inline void wkb_write_uint_offset(wkb_writer_t* writer, const uint32_t value, size_t offset) { if (writer->swap_endian) { uint32_t swapped = bswap_32(value); memcpy(writer->buffer + offset, &swapped, sizeof(uint32_t)); } else { memcpy(writer->buffer + offset, &value, sizeof(uint32_t)); } } static inline void wkb_write_uint(wkb_writer_t* writer, const uint32_t value) { wkb_writer_ensure_space(writer, sizeof(uint32_t)); if (writer->swap_endian) { uint32_t swapped = bswap_32(value); memcpy(writer->buffer + writer->offset, &swapped, sizeof(uint32_t)); } else { memcpy(writer->buffer + writer->offset, &value, sizeof(uint32_t)); } writer->offset += sizeof(uint32_t); } static inline void wkb_write_doubles(wkb_writer_t* writer, const double* value, uint32_t n) { wkb_writer_ensure_space(writer, sizeof(double) * n); if (writer->swap_endian) { uint64_t swappable, swapped; for (uint32_t i = 0; i < n; i++) { memcpy(&swappable, value + i, sizeof(double)); swapped = bswap_64(swappable); memcpy(writer->buffer + writer->offset, &swapped, sizeof(double)); writer->offset += sizeof(double); } } else { for (uint32_t i = 0; i < n; i++) { memcpy(writer->buffer + writer->offset, value + i, sizeof(double)); writer->offset += sizeof(double); } } } static inline void wkb_writer_result_append(wkb_writer_t* writer, SEXP value) { R_xlen_t current_size = Rf_xlength(writer->result); if (writer->feat_id >= current_size) { SEXP new_result = PROTECT(Rf_allocVector(VECSXP, current_size * 2 + 1)); for (R_xlen_t i = 0; i < current_size; i++) { SET_VECTOR_ELT(new_result, i, VECTOR_ELT(writer->result, i)); } R_ReleaseObject(writer->result); writer->result = new_result; R_PreserveObject(writer->result); UNPROTECT(1); } SET_VECTOR_ELT(writer->result, writer->feat_id, value); writer->feat_id++; } static inline void wkb_writer_result_finalize(wkb_writer_t* writer) { R_xlen_t current_size = Rf_xlength(writer->result); if (writer->feat_id != current_size) { SEXP new_result = PROTECT(Rf_allocVector(VECSXP, writer->feat_id)); for (R_xlen_t i = 0; i < writer->feat_id; i++) { SET_VECTOR_ELT(new_result, i, VECTOR_ELT(writer->result, i)); } R_ReleaseObject(writer->result); writer->result = new_result; R_PreserveObject(writer->result); UNPROTECT(1); } } int wkb_writer_vector_start(const wk_vector_meta_t* meta, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; if (writer->result != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { writer->result = PROTECT(Rf_allocVector(VECSXP, 1024)); } else { writer->result = PROTECT(Rf_allocVector(VECSXP, meta->size)); } R_PreserveObject(writer->result); UNPROTECT(1); writer->feat_id = 0; return WK_CONTINUE; } int wkb_writer_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; writer->offset = 0; writer->recursion_level = 0; return WK_CONTINUE; } int wkb_writer_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; if (writer->recursion_level > 0) { writer->current_size[writer->recursion_level - 1]++; } wkb_write_uchar(writer, writer->endian); wkb_write_uint(writer, wkb_writer_encode_type(meta, writer->recursion_level)); if (writer->recursion_level == 0 && (meta->srid != WK_SRID_NONE)) { wkb_write_uint(writer, meta->srid); } if (meta->geometry_type != WK_POINT) { if (writer->recursion_level >= WKB_MAX_RECURSION_DEPTH) { Rf_error( "Can't write WKB with maximum recursion depth greater than %d", WKB_MAX_RECURSION_DEPTH ); } // reserve space for the size and record where it is writer->current_size_offset[writer->recursion_level] = writer->offset; writer->current_size[writer->recursion_level] = 0; wkb_write_uint(writer, 0); } // handle empty point as nan nan here (coord() will not get called) if (meta->geometry_type == WK_POINT && meta->size == 0) { int coord_size = 2; if (meta->flags & WK_FLAG_HAS_Z) coord_size++; if (meta->flags & WK_FLAG_HAS_M) coord_size++; double empty_coord[4]; empty_coord[0] = NAN; empty_coord[1] = NAN; empty_coord[2] = NAN; empty_coord[3] = NAN; wkb_write_doubles(writer, empty_coord, coord_size); } writer->recursion_level++; return WK_CONTINUE; } int wkb_writer_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; writer->recursion_level--; if (meta->geometry_type != WK_POINT) { wkb_write_uint_offset( writer, writer->current_size[writer->recursion_level], writer->current_size_offset[writer->recursion_level] ); } return WK_CONTINUE; } int wkb_writer_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; writer->current_size[writer->recursion_level - 1]++; if (writer->recursion_level >= WKB_MAX_RECURSION_DEPTH) { Rf_error( "Can't write WKB with maximum recursion depth greater than %d", WKB_MAX_RECURSION_DEPTH ); } writer->current_size_offset[writer->recursion_level] = writer->offset; writer->current_size[writer->recursion_level] = 0; wkb_write_uint(writer, 0); writer->recursion_level++; return WK_CONTINUE; } int wkb_writer_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; writer->recursion_level--; wkb_write_uint_offset( writer, writer->current_size[writer->recursion_level], writer->current_size_offset[writer->recursion_level] ); return WK_CONTINUE; } int wkb_writer_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; writer->current_size[writer->recursion_level - 1]++; int n_dim = 2 + ((meta->flags & WK_FLAG_HAS_Z) != 0) + ((meta->flags & WK_FLAG_HAS_M) != 0); wkb_write_doubles(writer, coord, n_dim); return WK_CONTINUE; } int wkb_writer_feature_null(void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; wkb_writer_result_append(writer, R_NilValue); return WK_ABORT_FEATURE; } int wkb_writer_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; SEXP item = PROTECT(Rf_allocVector(RAWSXP, writer->offset)); memcpy(RAW(item), writer->buffer, writer->offset); wkb_writer_result_append(writer, item); UNPROTECT(1); return WK_CONTINUE; } SEXP wkb_writer_vector_end(const wk_vector_meta_t* meta, void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; wkb_writer_result_finalize(writer); SEXP wkb_class = PROTECT(Rf_allocVector(STRSXP, 2)); SET_STRING_ELT(wkb_class, 0, Rf_mkChar("wk_wkb")); SET_STRING_ELT(wkb_class, 1, Rf_mkChar("wk_vctr")); Rf_setAttrib(writer->result, R_ClassSymbol, wkb_class); UNPROTECT(1); return writer->result; } void wkb_writer_deinitialize(void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; if (writer->result != R_NilValue) { R_ReleaseObject(writer->result); writer->result = R_NilValue; } } void wkb_writer_finalize(void* handler_data) { wkb_writer_t* writer = (wkb_writer_t*) handler_data; if (writer != NULL) { free(writer->buffer); free(writer); } } SEXP wk_c_wkb_writer_new(SEXP buffer_size_sexp, SEXP endian_sexp) { int endian = INTEGER(endian_sexp)[0]; int buffer_size = INTEGER(buffer_size_sexp)[0]; if (endian == NA_INTEGER) { endian = wkb_writer_platform_endian(); } else if (endian) { endian = 1; } // If the initial buffer is too small, illegal reads can occur // and cause R to crash. The smallest value that doesn't cause a // crash is probably much less than 1024, but since this alloc // only happens once, we set the minimum size to 1024 here. if (buffer_size < 1024) { buffer_size = 1024; } wk_handler_t* handler = wk_handler_create(); handler->vector_start = &wkb_writer_vector_start; handler->feature_start = &wkb_writer_feature_start; handler->geometry_start = &wkb_writer_geometry_start; handler->ring_start = &wkb_writer_ring_start; handler->coord = &wkb_writer_coord; handler->ring_end = &wkb_writer_ring_end; handler->geometry_end = &wkb_writer_geometry_end; handler->null_feature = &wkb_writer_feature_null; handler->feature_end = &wkb_writer_feature_end; handler->vector_end = &wkb_writer_vector_end; handler->deinitialize = &wkb_writer_deinitialize; handler->finalizer = &wkb_writer_finalize; handler->handler_data = wkb_writer_new(buffer_size, endian); if (handler->handler_data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); return xptr; } wk/src/bbox-handler.c0000644000176200001440000002507114161345517014207 0ustar liggesusers #include #include #include #include "wk-v1.h" #define MIN(a, b) (((a) < (b)) ? (a) : (b)) #define MAX(a, b) (((a) > (b)) ? (a) : (b)) typedef struct { // used for bbox and envelope handlers double xmin, ymin, xmax, ymax; int use_geom_meta_bbox; // used for the envelope handler SEXP result; double* result_ptr[4]; R_xlen_t result_size; R_xlen_t feat_id; } wk_bbox_handler_data_t; static inline SEXP wk_bbox_handler_alloc_result(R_xlen_t size) { const char* names[] = {"xmin", "ymin", "xmax", "ymax", ""}; SEXP result = PROTECT(Rf_mkNamed(VECSXP, names)); SET_VECTOR_ELT(result, 0, Rf_allocVector(REALSXP, size)); SET_VECTOR_ELT(result, 1, Rf_allocVector(REALSXP, size)); SET_VECTOR_ELT(result, 2, Rf_allocVector(REALSXP, size)); SET_VECTOR_ELT(result, 3, Rf_allocVector(REALSXP, size)); UNPROTECT(1); return result; } static inline SEXP wk_bbox_handler_realloc_result(SEXP result, R_xlen_t new_size) { SEXP new_result = PROTECT(wk_bbox_handler_alloc_result(new_size)); R_xlen_t size_cpy; if (Rf_xlength(VECTOR_ELT(result, 0)) < new_size) { size_cpy = Rf_xlength(VECTOR_ELT(result, 0)); } else { size_cpy = new_size; } for (int i = 0; i < 4; i ++) { memcpy( REAL(VECTOR_ELT(new_result, i)), REAL(VECTOR_ELT(result, i)), sizeof(double) * size_cpy ); } UNPROTECT(1); return new_result; } static inline void wk_bbox_handler_append(wk_bbox_handler_data_t* writer, double xmin, double ymin, double xmax, double ymax) { if (writer->feat_id >= writer->result_size) { SEXP new_result = PROTECT(wk_bbox_handler_realloc_result(writer->result, writer->result_size * 2 + 1)); R_ReleaseObject(writer->result); writer->result = new_result; R_PreserveObject(writer->result); UNPROTECT(1); writer->result_size = writer->result_size * 2 + 1; for (int i = 0; i < 4; i++) { writer->result_ptr[i] = REAL(VECTOR_ELT(writer->result, i)); } } writer->result_ptr[0][writer->feat_id] = xmin; writer->result_ptr[1][writer->feat_id] = ymin; writer->result_ptr[2][writer->feat_id] = xmax; writer->result_ptr[3][writer->feat_id] = ymax; writer->feat_id++; } int wk_bbox_handler_vector_start(const wk_vector_meta_t* vector_meta, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; if (vector_meta->flags & WK_FLAG_HAS_BOUNDS) { data->xmin = vector_meta->bounds_min[0]; data->ymin = vector_meta->bounds_min[1]; data->xmax = vector_meta->bounds_max[0]; data->ymax = vector_meta->bounds_max[1]; return WK_ABORT; } else { return WK_CONTINUE; } } int wk_bbox_handler_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; data->use_geom_meta_bbox = 1; return WK_CONTINUE; } int wk_bbox_handler_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; if (data->use_geom_meta_bbox && (meta->flags & WK_FLAG_HAS_BOUNDS)) { data->xmin = MIN(meta->bounds_min[0], data->xmin); data->ymin = MIN(meta->bounds_min[1], data->ymin); data->xmax = MAX(meta->bounds_max[0], data->xmax); data->ymax = MAX(meta->bounds_max[1], data->ymax); return WK_ABORT_FEATURE; } else { data->use_geom_meta_bbox = 0; return WK_CONTINUE; } } int wk_bbox_handler_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; data->xmin = MIN(coord[0], data->xmin); data->ymin = MIN(coord[1], data->ymin); data->xmax = MAX(coord[0], data->xmax); data->ymax = MAX(coord[1], data->ymax); return WK_CONTINUE; } SEXP wk_bbox_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; const char* names[] = {"xmin", "ymin", "xmax", "ymax", ""}; SEXP output = PROTECT(Rf_mkNamed(VECSXP, names)); SET_VECTOR_ELT(output, 0, Rf_ScalarReal(data->xmin)); SET_VECTOR_ELT(output, 1, Rf_ScalarReal(data->ymin)); SET_VECTOR_ELT(output, 2, Rf_ScalarReal(data->xmax)); SET_VECTOR_ELT(output, 3, Rf_ScalarReal(data->ymax)); SEXP rct_class = PROTECT(Rf_allocVector(STRSXP, 2)); SET_STRING_ELT(rct_class, 0, Rf_mkChar("wk_rct")); SET_STRING_ELT(rct_class, 1, Rf_mkChar("wk_rcrd")); Rf_setAttrib(output, R_ClassSymbol, rct_class); UNPROTECT(1); UNPROTECT(1); return output; } void wk_bbox_handler_finalize(void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; free(data); } SEXP wk_c_bbox_handler_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &wk_bbox_handler_vector_start; handler->feature_start = &wk_bbox_handler_feature_start; handler->geometry_start = &wk_bbox_handler_geometry_start; handler->coord = &wk_bbox_handler_coord; handler->vector_end = &wk_bbox_handler_vector_end; handler->finalizer = &wk_bbox_handler_finalize; wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) malloc(sizeof(wk_bbox_handler_data_t)); if (data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } data->xmin = R_PosInf; data->ymin = R_PosInf; data->xmax = R_NegInf; data->ymax = R_NegInf; data->result_size = 0; data->feat_id = 0; data->use_geom_meta_bbox = 1; data->result = R_NilValue; for (int i = 0; i < 4; i++) { data->result_ptr[i] = NULL; } handler->handler_data = data; return wk_handler_create_xptr(handler, R_NilValue, R_NilValue); } int wk_envelope_handler_vector_start(const wk_vector_meta_t* meta, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; if (data->result != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { data->result = PROTECT(wk_bbox_handler_alloc_result(1024)); data->result_size = 1024; } else { data->result = PROTECT(wk_bbox_handler_alloc_result(meta->size)); data->result_size = meta->size; } R_PreserveObject(data->result); UNPROTECT(1); for (int i = 0; i < 4; i++) { data->result_ptr[i] = REAL(VECTOR_ELT(data->result, i)); } data->feat_id = 0; return WK_CONTINUE; } int wk_envelope_handler_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; data->xmin = R_PosInf; data->ymin = R_PosInf; data->xmax = R_NegInf; data->ymax = R_NegInf; data->use_geom_meta_bbox = 1; return WK_CONTINUE; } int wk_envelope_handler_feature_null(void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; data->xmin = NA_REAL; data->ymin = NA_REAL; data->xmax = NA_REAL; data->ymax = NA_REAL; return WK_CONTINUE; } int wk_envelope_handler_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; if (data->use_geom_meta_bbox && (meta->flags & WK_FLAG_HAS_BOUNDS)) { data->xmin = MIN(meta->bounds_min[0], data->xmin); data->ymin = MIN(meta->bounds_min[1], data->ymin); data->xmax = MAX(meta->bounds_max[0], data->xmax); data->ymax = MAX(meta->bounds_max[1], data->ymax); wk_bbox_handler_append(data, data->xmin, data->ymin, data->xmax, data->ymax); return WK_ABORT_FEATURE; } else { data->use_geom_meta_bbox = 0; return WK_CONTINUE; } } int wk_envelope_handler_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; wk_bbox_handler_append(data, data->xmin, data->ymin, data->xmax, data->ymax); return WK_CONTINUE; } SEXP wk_envelope_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; R_xlen_t final_size = data->feat_id; if (final_size != data->result_size) { SEXP new_result = PROTECT(wk_bbox_handler_realloc_result(data->result, final_size)); R_ReleaseObject(data->result); data->result = new_result; R_PreserveObject(data->result); UNPROTECT(1); } SEXP rct_class = PROTECT(Rf_allocVector(STRSXP, 2)); SET_STRING_ELT(rct_class, 0, Rf_mkChar("wk_rct")); SET_STRING_ELT(rct_class, 1, Rf_mkChar("wk_rcrd")); Rf_setAttrib(data->result, R_ClassSymbol, rct_class); UNPROTECT(1); return data->result; } void wk_envelope_handler_deinitialize(void* handler_data) { wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) handler_data; if (data->result != R_NilValue) { R_ReleaseObject(data->result); data->result = R_NilValue; } } SEXP wk_c_envelope_handler_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &wk_envelope_handler_vector_start; handler->feature_start = &wk_envelope_handler_feature_start; handler->null_feature = &wk_envelope_handler_feature_null; handler->geometry_start = &wk_envelope_handler_geometry_start; handler->coord = &wk_bbox_handler_coord; handler->feature_end = &wk_envelope_handler_feature_end; handler->vector_end = &wk_envelope_handler_vector_end; handler->finalizer = &wk_bbox_handler_finalize; handler->deinitialize = &wk_envelope_handler_deinitialize; wk_bbox_handler_data_t* data = (wk_bbox_handler_data_t*) malloc(sizeof(wk_bbox_handler_data_t)); if (data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } data->xmin = R_PosInf; data->ymin = R_PosInf; data->xmax = R_NegInf; data->ymax = R_NegInf; data->result_size = 0; data->feat_id = 0; data->use_geom_meta_bbox = 1; data->result = R_NilValue; for (int i = 0; i < 4; i++) { data->result_ptr[i] = NULL; } handler->handler_data = data; return wk_handler_create_xptr(handler, R_NilValue, R_NilValue); } wk/src/transform.c0000644000176200001440000002146614125354157013661 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" #include #define MAX_LEVELS 32 typedef struct { wk_handler_t* next; wk_trans_t* trans; wk_meta_t meta[MAX_LEVELS]; wk_vector_meta_t vector_meta; int recursive_level; R_xlen_t feature_id; double xyzm_in[4]; double xyzm_out[4]; double coord_out[4]; } trans_filter_t; void wk_trans_filter_initialize(int* dirty, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; *dirty = 1; trans_filter->next->initialize(&trans_filter->next->dirty, trans_filter->next->handler_data); } int wk_trans_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; memcpy(&(trans_filter->vector_meta), meta, sizeof(wk_vector_meta_t)); // bounds are no longer valid trans_filter->vector_meta.flags &= ~WK_FLAG_HAS_BOUNDS; // set the output dimensions NA_INTEGER means "leave alone" int dims_maybe_unknown = 0; if (trans_filter->trans->use_z == 1) { trans_filter->vector_meta.flags |= WK_FLAG_HAS_Z; } else if (trans_filter->trans->use_z == 0) { trans_filter->vector_meta.flags &= ~WK_FLAG_HAS_Z; } else { dims_maybe_unknown = 1; } if (trans_filter->trans->use_m == 1) { trans_filter->vector_meta.flags |= WK_FLAG_HAS_M; } else if (trans_filter->trans->use_m == 0) { trans_filter->vector_meta.flags &= ~WK_FLAG_HAS_M; } else { dims_maybe_unknown = 1; } if (!dims_maybe_unknown) { trans_filter->vector_meta.flags &= ~WK_FLAG_DIMS_UNKNOWN; } trans_filter->feature_id = -1; return trans_filter->next->vector_start(&(trans_filter->vector_meta), trans_filter->next->handler_data); } SEXP wk_trans_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; trans_filter->trans->vector_end(trans_filter->trans->trans_data); return trans_filter->next->vector_end(&(trans_filter->vector_meta), trans_filter->next->handler_data); } int wk_trans_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; trans_filter->recursive_level = -1; trans_filter->feature_id++; return trans_filter->next->feature_start(&(trans_filter->vector_meta), feat_id, trans_filter->next->handler_data); } int wk_trans_filter_feature_null(void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; return trans_filter->next->null_feature(trans_filter->next->handler_data); } int wk_trans_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; return trans_filter->next->feature_end(&(trans_filter->vector_meta), feat_id, trans_filter->next->handler_data); } int wk_trans_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; trans_filter->recursive_level++; if (trans_filter->recursive_level >= MAX_LEVELS) { Rf_error("Too many recursive levels for wk_transform_filter()"); } wk_meta_t* new_meta = trans_filter->meta + trans_filter->recursive_level; memcpy(new_meta, meta, sizeof(wk_meta_t)); new_meta->flags &= ~WK_FLAG_HAS_BOUNDS; if (trans_filter->trans->use_z == 1) { new_meta->flags |= WK_FLAG_HAS_Z; } else if (trans_filter->trans->use_z == 0) { new_meta->flags &= ~WK_FLAG_HAS_Z; } if (trans_filter->trans->use_m == 1) { new_meta->flags |= WK_FLAG_HAS_M; } else if (trans_filter->trans->use_m == 0) { new_meta->flags &= ~WK_FLAG_HAS_M; } return trans_filter->next->geometry_start(new_meta, part_id, trans_filter->next->handler_data); } int wk_trans_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; wk_meta_t* new_meta = trans_filter->meta + trans_filter->recursive_level; trans_filter->recursive_level--; return trans_filter->next->geometry_end(new_meta, part_id, trans_filter->next->handler_data); } int wk_trans_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; wk_meta_t* new_meta = trans_filter->meta + trans_filter->recursive_level; return trans_filter->next->ring_start(new_meta, size, ring_id, trans_filter->next->handler_data); } int wk_trans_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; wk_meta_t* new_meta = trans_filter->meta + trans_filter->recursive_level; return trans_filter->next->ring_end(new_meta, size, ring_id, trans_filter->next->handler_data); } int wk_trans_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; wk_meta_t* new_meta = trans_filter->meta + trans_filter->recursive_level; trans_filter->xyzm_in[0] = coord[0]; trans_filter->xyzm_in[1] = coord[1]; if (meta->flags & WK_FLAG_HAS_Z && meta->flags & WK_FLAG_HAS_M) { trans_filter->xyzm_in[2] = coord[2]; trans_filter->xyzm_in[3] = coord[3]; } else if (meta->flags & WK_FLAG_HAS_Z) { trans_filter->xyzm_in[2] = coord[2]; trans_filter->xyzm_in[3] = R_NaN; } else if (new_meta->flags & WK_FLAG_HAS_M) { trans_filter->xyzm_in[2] = R_NaN; trans_filter->xyzm_in[3] = coord[2]; } else { trans_filter->xyzm_in[2] = R_NaN; trans_filter->xyzm_in[3] = R_NaN; } int result = trans_filter->trans->trans( trans_filter->feature_id, trans_filter->xyzm_in, trans_filter->xyzm_out, trans_filter->trans->trans_data ); if (result != WK_CONTINUE) { return result; } trans_filter->coord_out[0] = trans_filter->xyzm_out[0]; trans_filter->coord_out[1] = trans_filter->xyzm_out[1]; if (new_meta->flags & WK_FLAG_HAS_Z && new_meta->flags & WK_FLAG_HAS_M) { trans_filter->coord_out[2] = trans_filter->xyzm_out[2]; trans_filter->coord_out[3] = trans_filter->xyzm_out[3]; } else if (new_meta->flags & WK_FLAG_HAS_Z) { trans_filter->coord_out[2] = trans_filter->xyzm_out[2]; } else if (new_meta->flags & WK_FLAG_HAS_M) { trans_filter->coord_out[2] = trans_filter->xyzm_out[3]; } return trans_filter->next->coord(new_meta, trans_filter->coord_out, coord_id, trans_filter->next->handler_data); } int wk_trans_filter_error(const char* message, void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; return trans_filter->next->error(message, trans_filter->next->handler_data); } void wk_trans_filter_deinitialize(void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; trans_filter->next->deinitialize(trans_filter->next->handler_data); } void wk_trans_filter_finalize(void* handler_data) { trans_filter_t* trans_filter = (trans_filter_t*) handler_data; if (trans_filter != NULL) { // finalizer for trans_filter->next is run by the externalptr finalizer // and should not be called here free(trans_filter); } } SEXP wk_c_trans_filter_new(SEXP handler_xptr, SEXP trans_xptr) { wk_trans_t* trans = (wk_trans_t*) R_ExternalPtrAddr(trans_xptr); wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_trans_filter_initialize; handler->vector_start = &wk_trans_filter_vector_start; handler->vector_end = &wk_trans_filter_vector_end; handler->feature_start = &wk_trans_filter_feature_start; handler->null_feature = &wk_trans_filter_feature_null; handler->feature_end = &wk_trans_filter_feature_end; handler->geometry_start = &wk_trans_filter_geometry_start; handler->geometry_end = &wk_trans_filter_geometry_end; handler->ring_start = &wk_trans_filter_ring_start; handler->ring_end = &wk_trans_filter_ring_end; handler->coord = &wk_trans_filter_coord; handler->error = &wk_trans_filter_error; handler->deinitialize = &wk_trans_filter_deinitialize; handler->finalizer = &wk_trans_filter_finalize; trans_filter_t* trans_filter = (trans_filter_t*) malloc(sizeof(trans_filter_t)); if (trans_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } trans_filter->next = R_ExternalPtrAddr(handler_xptr); if (trans_filter->next->api_version != 1) { Rf_error("Can't run a wk_handler with api_version '%d'", trans_filter->next->api_version); // # nocov } trans_filter->trans = trans; handler->handler_data = trans_filter; // include the external pointers as tags for this external pointer // which guarnatees that they will not be garbage collected until // this object is garbage collected return wk_handler_create_xptr(handler, handler_xptr, trans_xptr); } wk/src/make-collection-filter.c0000644000176200001440000002314014151152004016150 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" #include "altrep.h" #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) { \ Rf_error("wk_collection_filter() does not support WK_ABORT_FEATURE"); \ } \ if (result != WK_CONTINUE) return result typedef struct { wk_handler_t* next; int geometry_type_out; R_xlen_t feature_id; SEXP feature_id_sexp; #ifndef HAS_ALTREP int* feature_id_spec; #endif R_xlen_t n_feature_id_spec; int last_feature_id_spec; int is_new_feature; R_xlen_t feature_id_out; uint32_t part_id; wk_meta_t meta; wk_vector_meta_t vector_meta; } collection_filter_t; static inline int wk_collection_start(collection_filter_t* collection_filter) { int result; collection_filter->feature_id_out++; HANDLE_OR_RETURN(collection_filter->next->feature_start(&(collection_filter->vector_meta), collection_filter->feature_id_out, collection_filter->next->handler_data)); HANDLE_OR_RETURN(collection_filter->next->geometry_start(&(collection_filter->meta), WK_PART_ID_NONE, collection_filter->next->handler_data)); collection_filter->part_id = 0; return WK_CONTINUE; } static inline int wk_collection_end(collection_filter_t* collection_filter) { int result; HANDLE_OR_RETURN(collection_filter->next->geometry_end(&(collection_filter->meta), WK_PART_ID_NONE, collection_filter->next->handler_data)); HANDLE_OR_RETURN(collection_filter->next->feature_end(&(collection_filter->vector_meta), collection_filter->feature_id_out, collection_filter->next->handler_data)); return WK_CONTINUE; } void wk_collection_filter_initialize(int* dirty, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; *dirty = 1; collection_filter->next->initialize(&collection_filter->next->dirty, collection_filter->next->handler_data); } int wk_collection_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; collection_filter->feature_id = -1; collection_filter->feature_id_out = -1; memcpy(&(collection_filter->vector_meta), meta, sizeof(wk_vector_meta_t)); collection_filter->vector_meta.geometry_type = collection_filter->geometry_type_out; collection_filter->vector_meta.size = WK_VECTOR_SIZE_UNKNOWN; WK_META_RESET(collection_filter->meta, collection_filter->geometry_type_out); return collection_filter->next->vector_start(&(collection_filter->vector_meta), collection_filter->next->handler_data); } SEXP wk_collection_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; // if there weren't any features we need to start one int result = WK_CONTINUE; if (collection_filter->feature_id_out == -1) { collection_filter->meta.size = 0; result = wk_collection_start(collection_filter); } if (result != WK_ABORT) { wk_collection_end(collection_filter); } return collection_filter->next->vector_end(&(collection_filter->vector_meta), collection_filter->next->handler_data); } int wk_collection_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; collection_filter->feature_id++; R_xlen_t spec_i = collection_filter->feature_id % collection_filter->n_feature_id_spec; #ifdef HAS_ALTREP int feature_id_spec = INTEGER_ELT(collection_filter->feature_id_sexp, spec_i); #else int feature_id_spec = collection_filter->feature_id_spec[spec_i]; #endif int feature_id_spec_changed = feature_id_spec != collection_filter->last_feature_id_spec; collection_filter->last_feature_id_spec = feature_id_spec; collection_filter->is_new_feature = feature_id_spec_changed || (collection_filter->feature_id == 0); return WK_CONTINUE; } int wk_collection_filter_feature_null(void* handler_data) { return WK_CONTINUE; } int wk_collection_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { return WK_CONTINUE; } int wk_collection_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; int result; if (collection_filter->is_new_feature) { if (collection_filter->feature_id_out >= 0) { HANDLE_OR_RETURN(wk_collection_end(collection_filter)); } collection_filter->meta.flags = meta->flags; collection_filter->meta.flags &= ~WK_FLAG_HAS_BOUNDS; collection_filter->meta.precision = meta->precision; collection_filter->meta.srid = meta->srid; HANDLE_OR_RETURN(wk_collection_start(collection_filter)); collection_filter->is_new_feature = 0; } if (part_id == WK_PART_ID_NONE) { part_id = collection_filter->part_id; collection_filter->part_id++; } return collection_filter->next->geometry_start(meta, part_id, collection_filter->next->handler_data); } int wk_collection_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; if (part_id == WK_PART_ID_NONE) { part_id = collection_filter->part_id; } int result; HANDLE_OR_RETURN(collection_filter->next->geometry_end(meta, part_id, collection_filter->next->handler_data)); return WK_CONTINUE; } int wk_collection_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; int result; HANDLE_OR_RETURN(collection_filter->next->ring_start(meta, size, ring_id, collection_filter->next->handler_data)); return WK_CONTINUE; } int wk_collection_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; int result; HANDLE_OR_RETURN(collection_filter->next->ring_end(meta, size, ring_id, collection_filter->next->handler_data)); return WK_CONTINUE; } int wk_collection_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; int result; HANDLE_OR_RETURN(collection_filter->next->coord(meta, coord, coord_id, collection_filter->next->handler_data)); return WK_CONTINUE; } int wk_collection_filter_error(const char* message, void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; int result; HANDLE_OR_RETURN(collection_filter->next->error(message, collection_filter->next->handler_data)); return WK_CONTINUE; } void wk_collection_filter_deinitialize(void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; collection_filter->next->deinitialize(collection_filter->next->handler_data); } void wk_collection_filter_finalize(void* handler_data) { collection_filter_t* collection_filter = (collection_filter_t*) handler_data; if (collection_filter != NULL) { // finalizer for collection_filter->next is run by the externalptr finalizer // and should not be called here free(collection_filter); } } SEXP wk_c_collection_filter_new(SEXP handler_xptr, SEXP geometry_type, SEXP feature_id) { #ifndef HAS_ALTREP int* feature_id_spec = INTEGER(feature_id); #endif int geometry_type_int = INTEGER(geometry_type)[0]; wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_collection_filter_initialize; handler->vector_start = &wk_collection_filter_vector_start; handler->vector_end = &wk_collection_filter_vector_end; handler->feature_start = &wk_collection_filter_feature_start; handler->null_feature = &wk_collection_filter_feature_null; handler->feature_end = &wk_collection_filter_feature_end; handler->geometry_start = &wk_collection_filter_geometry_start; handler->geometry_end = &wk_collection_filter_geometry_end; handler->ring_start = &wk_collection_filter_ring_start; handler->ring_end = &wk_collection_filter_ring_end; handler->coord = &wk_collection_filter_coord; handler->error = &wk_collection_filter_error; handler->deinitialize = &wk_collection_filter_deinitialize; handler->finalizer = &wk_collection_filter_finalize; collection_filter_t* collection_filter = (collection_filter_t*) malloc(sizeof(collection_filter_t)); if (collection_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } collection_filter->next = (wk_handler_t*) R_ExternalPtrAddr(handler_xptr); if (collection_filter->next->api_version != 1) { wk_handler_destroy(handler); // # nocov free(collection_filter); // # nocov Rf_error("Can't run a wk_handler with api_version '%d'", collection_filter->next->api_version); // # nocov } collection_filter->geometry_type_out = geometry_type_int; collection_filter->part_id = 0; collection_filter->feature_id = -1; collection_filter->feature_id_out = 0; collection_filter->feature_id_sexp = feature_id; #ifndef HAS_ALTREP collection_filter->feature_id_spec = feature_id_spec; #endif collection_filter->n_feature_id_spec = Rf_xlength(feature_id); collection_filter->is_new_feature = 0; collection_filter->last_feature_id_spec = NA_INTEGER; handler->handler_data = collection_filter; // We need both the external pointer SEXP and the feature_id SEXP // to be valid for the lifetime of this object return wk_handler_create_xptr(handler, handler_xptr, feature_id); } wk/src/handle-xy.c0000644000176200001440000000632514151152004013516 0ustar liggesusers #define R_NO_REMAP #include #include #include "altrep.h" #include "wk-v1.h" #define HANDLE_CONTINUE_OR_BREAK(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) continue; else if (result == WK_ABORT) break SEXP wk_read_xy(SEXP data, wk_handler_t* handler) { R_xlen_t n_features = Rf_xlength(VECTOR_ELT(data, 0)); int coord_size = Rf_length(data); double* data_ptr[4]; R_xlen_t data_ptr_i = 0; #ifdef HAS_ALTREP SEXP altrep_buffer = PROTECT(Rf_allocVector(REALSXP, ALTREP_CHUNK_SIZE * 4)); for (int j = 0; j < coord_size; j++) { data_ptr[j] = REAL(altrep_buffer) + (ALTREP_CHUNK_SIZE * j); } #else for (int j = 0; j < coord_size; j++) { data_ptr[j] = REAL(VECTOR_ELT(data, j)); } #endif wk_vector_meta_t vector_meta; WK_VECTOR_META_RESET(vector_meta, WK_POINT); vector_meta.size = n_features; if (Rf_inherits(data, "wk_xyz") || Rf_inherits(data, "wk_xyzm")) { vector_meta.flags |= WK_FLAG_HAS_Z; } if (Rf_inherits(data, "wk_xym") || Rf_inherits(data, "wk_xyzm")) { vector_meta.flags |= WK_FLAG_HAS_M; } if (handler->vector_start(&vector_meta, handler->handler_data) == WK_CONTINUE) { int result; double coord[4]; wk_meta_t meta; WK_META_RESET(meta, WK_POINT); meta.flags = vector_meta.flags | WK_FLAG_HAS_BOUNDS; for (R_xlen_t i = 0; i < n_features; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); HANDLE_CONTINUE_OR_BREAK(handler->feature_start(&vector_meta, i, handler->handler_data)); #ifdef HAS_ALTREP data_ptr_i = i % ALTREP_CHUNK_SIZE; if (data_ptr_i == 0) { for (int j = 0; j < coord_size; j++) { REAL_GET_REGION(VECTOR_ELT(data, j), i, ALTREP_CHUNK_SIZE, data_ptr[j]); } } #else data_ptr_i = i; #endif int coord_empty = 1; for (int j = 0; j < coord_size; j++) { coord[j] = data_ptr[j][data_ptr_i]; meta.bounds_min[j] = data_ptr[j][data_ptr_i]; meta.bounds_max[j] = data_ptr[j][data_ptr_i]; if (!ISNAN(coord[j])) { coord_empty = 0; } } if (coord_empty) { meta.size = 0; } else { meta.size = 1; } HANDLE_CONTINUE_OR_BREAK(handler->geometry_start(&meta, WK_PART_ID_NONE, handler->handler_data)); if (!coord_empty) { HANDLE_CONTINUE_OR_BREAK(handler->coord(&meta, coord, 0, handler->handler_data)); } HANDLE_CONTINUE_OR_BREAK(handler->geometry_end(&meta, WK_PART_ID_NONE, handler->handler_data)); if (handler->feature_end(&vector_meta, i, handler->handler_data) == WK_ABORT) { break; } } } #ifdef HAS_ALTREP UNPROTECT(1); #endif SEXP result = PROTECT(handler->vector_end(&vector_meta, handler->handler_data)); UNPROTECT(1); return result; } SEXP wk_c_read_xy(SEXP data, SEXP handlerXptr) { return wk_handler_run_xptr(&wk_read_xy, data, handlerXptr); } wk/src/flatten-filter.c0000644000176200001440000002766114106220314014553 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" typedef struct { wk_handler_t* next; int recursion_depth; int recursion_depth_out; int recursion_depth_threshold; wk_vector_meta_t vector_meta; int feature_id; int feature_id_out; int add_details; SEXP details; int* details_ptr[1]; R_xlen_t details_size; } flatten_filter_t; #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) { \ Rf_error("wk_flatten_filter() does not support WK_ABORT_FEATURE"); \ } \ if (result != WK_CONTINUE) return result #define META_IS_COLLECTION(meta) \ ((meta->geometry_type == WK_GEOMETRY) || \ (meta->geometry_type == WK_MULTIPOINT) || \ (meta->geometry_type == WK_MULTILINESTRING) || \ (meta->geometry_type == WK_MULTIPOLYGON) || \ (meta->geometry_type == WK_GEOMETRYCOLLECTION)) static inline int wk_flatten_filter_keep(flatten_filter_t* flatten_filter, const wk_meta_t* meta) { int is_collection = META_IS_COLLECTION(meta); int recursion_level_above_threshold = flatten_filter->recursion_depth >= flatten_filter->recursion_depth_threshold; return !is_collection || recursion_level_above_threshold; } static inline void wk_flatten_filter_init_details(flatten_filter_t* flatten_filter, R_xlen_t initial_size) { if (!flatten_filter->add_details) { return; } if (initial_size == WK_VECTOR_SIZE_UNKNOWN) { initial_size = 1024; } flatten_filter->feature_id = -1; if (flatten_filter->details != R_NilValue) { R_ReleaseObject(flatten_filter->details); // # nocov } const char* names[] = {"feature_id", ""}; flatten_filter->details = PROTECT(Rf_mkNamed(VECSXP, names)); R_PreserveObject(flatten_filter->details); UNPROTECT(1); flatten_filter->details_size = initial_size; for (int i = 0; i < 1; i++) { SEXP item = PROTECT(Rf_allocVector(INTSXP, flatten_filter->details_size)); SET_VECTOR_ELT(flatten_filter->details, i, item); flatten_filter->details_ptr[i] = INTEGER(item); UNPROTECT(1); } } static inline void wk_flatten_filter_append_details(flatten_filter_t* flatten_filter) { if (flatten_filter->details == R_NilValue) { return; } if (flatten_filter->feature_id_out >= flatten_filter->details_size) { R_xlen_t new_size = flatten_filter->details_size * 2 + 1; for (int i = 0; i < 1; i++) { SEXP new_item = PROTECT(Rf_allocVector(INTSXP, new_size)); memcpy(INTEGER(new_item), INTEGER(VECTOR_ELT(flatten_filter->details, i)), flatten_filter->details_size * sizeof(int)); SET_VECTOR_ELT(flatten_filter->details, i, new_item); flatten_filter->details_ptr[i] = INTEGER(new_item); UNPROTECT(1); } flatten_filter->details_size = new_size; } flatten_filter->details_ptr[0][flatten_filter->feature_id_out] = flatten_filter->feature_id + 1; } static inline void wk_flatten_filter_finalize_details(flatten_filter_t* flatten_filter) { if (flatten_filter->details == R_NilValue) { return; } flatten_filter->feature_id_out++; if (flatten_filter->feature_id_out != flatten_filter->details_size) { for (int i = 0; i < 1; i++) { SEXP new_item = PROTECT(Rf_allocVector(INTSXP, flatten_filter->feature_id_out)); memcpy(INTEGER(new_item), INTEGER(VECTOR_ELT(flatten_filter->details, i)), flatten_filter->feature_id_out * sizeof(int)); SET_VECTOR_ELT(flatten_filter->details, i, new_item); UNPROTECT(1); } flatten_filter->details_size = flatten_filter->feature_id_out; } } void wk_flatten_filter_initialize(int* dirty, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; *dirty = 1; flatten_filter->next->initialize(&flatten_filter->next->dirty, flatten_filter->next->handler_data); } int wk_flatten_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; flatten_filter->feature_id_out = -1; flatten_filter->recursion_depth_out = 0; memcpy(&(flatten_filter->vector_meta), meta, sizeof(wk_vector_meta_t)); if (flatten_filter->recursion_depth_threshold > 0) { if (META_IS_COLLECTION(meta)) { flatten_filter->vector_meta.size = WK_VECTOR_SIZE_UNKNOWN; } if (meta->geometry_type == WK_MULTIPOINT) { flatten_filter->vector_meta.geometry_type = WK_POINT; } else if (meta->geometry_type == WK_MULTILINESTRING) { flatten_filter->vector_meta.geometry_type = WK_LINESTRING; } else if (meta->geometry_type == WK_MULTIPOLYGON) { flatten_filter->vector_meta.geometry_type = WK_POLYGON; } else if (meta->geometry_type == WK_GEOMETRYCOLLECTION) { flatten_filter->vector_meta.geometry_type = WK_GEOMETRY; } } wk_flatten_filter_init_details(flatten_filter, flatten_filter->vector_meta.size); return flatten_filter->next->vector_start(&(flatten_filter->vector_meta), flatten_filter->next->handler_data); } SEXP wk_flatten_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; SEXP result = PROTECT(flatten_filter->next->vector_end(&(flatten_filter->vector_meta), flatten_filter->next->handler_data)); if (result != R_NilValue) { wk_flatten_filter_finalize_details(flatten_filter); Rf_setAttrib(result, Rf_install("wk_details"), flatten_filter->details); } UNPROTECT(1); return result; } int wk_flatten_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; flatten_filter->feature_id++; flatten_filter->recursion_depth = 0; return WK_CONTINUE; } int wk_flatten_filter_feature_null(void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; int result; flatten_filter->feature_id_out++; wk_flatten_filter_append_details(flatten_filter); HANDLE_OR_RETURN(flatten_filter->next->feature_start(&(flatten_filter->vector_meta), flatten_filter->feature_id_out, flatten_filter->next->handler_data)); result = flatten_filter->next->null_feature(flatten_filter->next->handler_data); if (result != WK_CONTINUE) { return result; } return flatten_filter->next->feature_end(&(flatten_filter->vector_meta), flatten_filter->feature_id_out, flatten_filter->next->handler_data); } int wk_flatten_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { return WK_CONTINUE; } int wk_flatten_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; int result; int keep = wk_flatten_filter_keep(flatten_filter, meta); flatten_filter->recursion_depth++; flatten_filter->recursion_depth_out += keep; if (keep) { uint32_t part_id_out; if (flatten_filter->recursion_depth_out > 1) { part_id_out = part_id; } else { part_id_out = WK_PART_ID_NONE; flatten_filter->feature_id_out++; wk_flatten_filter_append_details(flatten_filter); HANDLE_OR_RETURN(flatten_filter->next->feature_start(&(flatten_filter->vector_meta), flatten_filter->feature_id_out, flatten_filter->next->handler_data)); } HANDLE_OR_RETURN(flatten_filter->next->geometry_start(meta, part_id_out, flatten_filter->next->handler_data)); } return WK_CONTINUE; } int wk_flatten_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; int result; flatten_filter->recursion_depth--; int keep = wk_flatten_filter_keep(flatten_filter, meta); flatten_filter->recursion_depth_out -= keep; if (keep) { uint32_t part_id_out = flatten_filter->recursion_depth_out > 0 ? part_id : WK_PART_ID_NONE; HANDLE_OR_RETURN(flatten_filter->next->geometry_end(meta, part_id_out, flatten_filter->next->handler_data)); if (flatten_filter->recursion_depth_out == 0) { HANDLE_OR_RETURN(flatten_filter->next->feature_end(&(flatten_filter->vector_meta), flatten_filter->feature_id_out, flatten_filter->next->handler_data)); } } return WK_CONTINUE; } int wk_flatten_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; return flatten_filter->next->ring_start(meta, size, ring_id, flatten_filter->next->handler_data); } int wk_flatten_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; return flatten_filter->next->ring_end(meta, size, ring_id, flatten_filter->next->handler_data); } int wk_flatten_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t feature_id_out, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; return flatten_filter->next->coord(meta, coord, feature_id_out, flatten_filter->next->handler_data); } int wk_flatten_filter_error(const char* message, void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; return flatten_filter->next->error(message, flatten_filter->next->handler_data); } void wk_flatten_filter_deinitialize(void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; if (flatten_filter->details != R_NilValue) { R_ReleaseObject(flatten_filter->details); flatten_filter->details = R_NilValue; } flatten_filter->next->deinitialize(flatten_filter->next->handler_data); } void wk_flatten_filter_finalize(void* handler_data) { flatten_filter_t* flatten_filter = (flatten_filter_t*) handler_data; if (flatten_filter != NULL) { // finalizer for flatten_filter->next is run by the externalptr finalizer // and should not be called here free(flatten_filter); } } SEXP wk_c_flatten_filter_new(SEXP handler_xptr, SEXP max_depth, SEXP add_details) { int max_depth_int = INTEGER(max_depth)[0]; int add_details_int = LOGICAL(add_details)[0]; wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_flatten_filter_initialize; handler->vector_start = &wk_flatten_filter_vector_start; handler->vector_end = &wk_flatten_filter_vector_end; handler->feature_start = &wk_flatten_filter_feature_start; handler->null_feature = &wk_flatten_filter_feature_null; handler->feature_end = &wk_flatten_filter_feature_end; handler->geometry_start = &wk_flatten_filter_geometry_start; handler->geometry_end = &wk_flatten_filter_geometry_end; handler->ring_start = &wk_flatten_filter_ring_start; handler->ring_end = &wk_flatten_filter_ring_end; handler->coord = &wk_flatten_filter_coord; handler->error = &wk_flatten_filter_error; handler->deinitialize = &wk_flatten_filter_deinitialize; handler->finalizer = &wk_flatten_filter_finalize; flatten_filter_t* flatten_filter = (flatten_filter_t*) malloc(sizeof(flatten_filter_t)); if (flatten_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } flatten_filter->next = R_ExternalPtrAddr(handler_xptr); if (flatten_filter->next->api_version != 1) { Rf_error("Can't run a wk_handler with api_version '%d'", flatten_filter->next->api_version); // # nocov } WK_VECTOR_META_RESET(flatten_filter->vector_meta, WK_GEOMETRY); flatten_filter->add_details = add_details_int; flatten_filter->recursion_depth_threshold = max_depth_int; flatten_filter->recursion_depth = 0; flatten_filter->recursion_depth_out = 0; flatten_filter->details = R_NilValue; flatten_filter->details_size = 0; flatten_filter->feature_id = 0; flatten_filter->feature_id_out = 0; handler->handler_data = flatten_filter; // include the external pointer as a tag for this external pointer // which guarnatees that it will not be garbage collected until // this object is garbage collected return wk_handler_create_xptr(handler, handler_xptr, R_NilValue); } wk/src/sfc-writer.c0000644000176200001440000007756114106220314013724 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #define SFC_FLAGS_NOT_YET_DEFINED UINT32_MAX #define SFC_GEOMETRY_TYPE_NOT_YET_DEFINED -1 #define SFC_MAX_RECURSION_DEPTH 32 #define SFC_WRITER_GEOM_LENGTH SFC_MAX_RECURSION_DEPTH + 2 #define SFC_INITIAL_SIZE_IF_UNKNOWN 32 #define MIN(a, b) (((a) < (b)) ? (a) : (b)) #define MAX(a, b) (((a) > (b)) ? (a) : (b)) typedef struct { // output vector list() SEXP sfc; // container list() geometries SEXP geom[SFC_WRITER_GEOM_LENGTH]; // keep track of recursion level and number of parts seen in a geometry size_t recursion_level; R_xlen_t part_id[SFC_WRITER_GEOM_LENGTH]; // the current coordinate sequence and information about // where we are in the coordinate sequence SEXP coord_seq; int coord_size; uint32_t coord_id; int coord_seq_rows; // attr(sfc, "bbox"): xmin, ymin, xmax, ymax double bbox[4]; // attr(sfc, "z_range"): zmin, zmax double z_range[2]; // attr(sfc, "m_range"): mmin, mmax double m_range[2]; // attr(sfc, "precision") double precision; // used to tell if all items are the same type for output class int geometry_type; // when all elements are empty, sfc holds the classes of these objects // so in addition to knowing the common geometry type, we need to know // all types that were encountered in the off chance that they are all empty // using a bitwise OR with (1 << (wk geometry type)) int all_geometry_types; // used to enforce requirement that all sub geometries to have the same dimensions uint32_t flags; // attr(sfc, "n_empty") R_xlen_t n_empty; // sfc views NULL as equivalent to EMPTY, but we can skip this replacement if // there were not any NULLs (almost 100% of the time) int any_null; // needed to access feat_id in geometry handlers R_xlen_t feat_id; } sfc_writer_t; sfc_writer_t* sfc_writer_new() { sfc_writer_t* writer = (sfc_writer_t*) malloc(sizeof(sfc_writer_t)); if (writer == NULL) { return NULL; // # nocov } writer->sfc = R_NilValue; for (int i = 0; i < SFC_WRITER_GEOM_LENGTH; i++) { writer->geom[i] = R_NilValue; writer->part_id[i] = 0; } writer->recursion_level = 0; writer->coord_seq = R_NilValue; writer->coord_id = -1; writer->coord_size = 2; writer->coord_seq_rows = -1; writer->bbox[0] = R_PosInf; writer->bbox[1] = R_PosInf; writer->bbox[2] = R_NegInf; writer->bbox[3] = R_NegInf; writer->z_range[0] = R_PosInf; writer->z_range[1] = R_NegInf; writer->m_range[0] = R_PosInf; writer->m_range[1] = R_NegInf; writer->precision = R_PosInf; writer->geometry_type = SFC_GEOMETRY_TYPE_NOT_YET_DEFINED; writer->all_geometry_types = 0; writer->flags = SFC_FLAGS_NOT_YET_DEFINED; writer->n_empty = 0; writer->any_null = 0; writer->feat_id = 0; return writer; } int sfc_writer_is_nesting_geometrycollection(sfc_writer_t* writer) { return (writer->recursion_level > 0) && Rf_inherits(writer->geom[writer->recursion_level - 1], "GEOMETRYCOLLECTION"); } int sfc_writer_is_nesting_multipoint(sfc_writer_t* writer) { return Rf_inherits(writer->coord_seq, "MULTIPOINT"); } static inline int sfc_double_all_na_or_nan(int n_values, const double* values) { for (int i = 0; i < n_values; i++) { if (!ISNA(values[i]) && !ISNAN(values[i])) { return 0; } } return 1; } // this is intended to replicate NA_crs_ SEXP sfc_na_crs() { const char* crs_names[] = {"input", "wkt", ""}; SEXP crs = PROTECT(Rf_mkNamed(VECSXP, crs_names)); SEXP crs_input = PROTECT(Rf_allocVector(STRSXP, 1)); SET_STRING_ELT(crs_input, 0, NA_STRING); SET_VECTOR_ELT(crs, 0, crs_input); UNPROTECT(1); SEXP crs_wkt = PROTECT(Rf_allocVector(STRSXP, 1)); SET_STRING_ELT(crs_wkt, 0, NA_STRING); SET_VECTOR_ELT(crs, 1, crs_wkt); UNPROTECT(1); Rf_setAttrib(crs, R_ClassSymbol, Rf_mkString("crs")); UNPROTECT(1); return crs; } SEXP sfc_writer_empty_sfg(int geometry_type, uint32_t flags) { SEXP result = R_NilValue; int coord_size; if ((flags & WK_FLAG_HAS_Z) && (flags & WK_FLAG_HAS_M)) { coord_size = 4; } else if ((flags & WK_FLAG_HAS_Z) || (flags & WK_FLAG_HAS_M)) { coord_size = 3; } else { coord_size = 2; } switch (geometry_type) { case WK_POINT: result = PROTECT(Rf_allocVector(REALSXP, coord_size)); for (int i = 0; i < coord_size; i++) { REAL(result)[i] = NA_REAL; } break; case WK_LINESTRING: result = PROTECT(Rf_allocMatrix(REALSXP, 0, coord_size)); break; case WK_POLYGON: result = PROTECT(Rf_allocVector(VECSXP, 0)); break; case WK_MULTIPOINT: result = PROTECT(Rf_allocMatrix(REALSXP, 0, coord_size)); break; case WK_MULTILINESTRING: result = PROTECT(Rf_allocVector(VECSXP, 0)); break; case WK_MULTIPOLYGON: result = PROTECT(Rf_allocVector(VECSXP, 0)); break; case WK_GEOMETRYCOLLECTION: result = PROTECT(Rf_allocVector(VECSXP, 0)); break; default: Rf_error("Can't generate empty 'sfg' for geometry type '%d'", geometry_type); // # nocov } UNPROTECT(1); return result; } void sfc_writer_maybe_add_class_to_sfg(sfc_writer_t* writer, SEXP item, const wk_meta_t* meta) { if (writer->recursion_level == 0 || sfc_writer_is_nesting_geometrycollection(writer)) { // in the form XY(ZM), GEOM_TYPE, sfg SEXP class = PROTECT(Rf_allocVector(STRSXP, 3)); SET_STRING_ELT(class, 2, Rf_mkChar("sfg")); if ((meta->flags & WK_FLAG_HAS_Z) && (meta->flags & WK_FLAG_HAS_M)) { SET_STRING_ELT(class, 0, Rf_mkChar("XYZM")); } else if (meta->flags & WK_FLAG_HAS_Z) { SET_STRING_ELT(class, 0, Rf_mkChar("XYZ")); } else if (meta->flags & WK_FLAG_HAS_M) { SET_STRING_ELT(class, 0, Rf_mkChar("XYM")); } else { SET_STRING_ELT(class, 0, Rf_mkChar("XY")); } switch (meta->geometry_type) { case WK_POINT: SET_STRING_ELT(class, 1, Rf_mkChar("POINT")); break; case WK_LINESTRING: SET_STRING_ELT(class, 1, Rf_mkChar("LINESTRING")); break; case WK_POLYGON: SET_STRING_ELT(class, 1, Rf_mkChar("POLYGON")); break; case WK_MULTIPOINT: SET_STRING_ELT(class, 1, Rf_mkChar("MULTIPOINT")); break; case WK_MULTILINESTRING: SET_STRING_ELT(class, 1, Rf_mkChar("MULTILINESTRING")); break; case WK_MULTIPOLYGON: SET_STRING_ELT(class, 1, Rf_mkChar("MULTIPOLYGON")); break; case WK_GEOMETRYCOLLECTION: SET_STRING_ELT(class, 1, Rf_mkChar("GEOMETRYCOLLECTION")); break; default: Rf_error("Can't generate class 'sfg' for geometry type '%d'", meta->geometry_type); // # nocov } Rf_setAttrib(item, R_ClassSymbol, class); UNPROTECT(1); } } void sfc_writer_update_dimensions(sfc_writer_t* writer, const wk_meta_t* meta, uint32_t size) { if (size > 0) { if (writer->flags == SFC_FLAGS_NOT_YET_DEFINED) { writer->flags = meta->flags; } else if (writer->flags != meta->flags) { Rf_error("Can't convert geometries with incompatible dimensions to 'sfc'"); } } } void sfc_writer_update_vector_attributes(sfc_writer_t* writer, const wk_meta_t* meta, uint32_t size) { // all geometry types specifically matters for when everything is EMPTY writer->all_geometry_types = writer->all_geometry_types | (1 << (meta->geometry_type - 1)); // these matter even for EMPTY if (writer->geometry_type == SFC_GEOMETRY_TYPE_NOT_YET_DEFINED) { writer->geometry_type = meta->geometry_type; } else if (writer->geometry_type != meta->geometry_type) { writer->geometry_type = WK_GEOMETRY; } // update empty count writer->n_empty += size == 0; // update dimensions sfc_writer_update_dimensions(writer, meta, size); // update precision writer->precision = MIN(writer->precision, meta->precision); } void sfc_writer_update_ranges(sfc_writer_t* writer, const wk_meta_t* meta, const double* coord) { writer->bbox[0] = MIN(writer->bbox[0], coord[0]); writer->bbox[1] = MIN(writer->bbox[1], coord[1]); writer->bbox[2] = MAX(writer->bbox[2], coord[0]); writer->bbox[3] = MAX(writer->bbox[3], coord[1]); if ((meta->flags & WK_FLAG_HAS_Z) && (meta->flags & WK_FLAG_HAS_M)) { writer->z_range[0] = MIN(writer->z_range[0], coord[2]); writer->z_range[1] = MAX(writer->z_range[1], coord[2]); writer->m_range[0] = MIN(writer->m_range[0], coord[3]); writer->m_range[1] = MAX(writer->m_range[1], coord[3]); } else if (meta->flags & WK_FLAG_HAS_Z) { writer->z_range[0] = MIN(writer->z_range[0], coord[2]); writer->z_range[1] = MAX(writer->z_range[1], coord[2]); } else if (meta->flags & WK_FLAG_HAS_M) { writer->m_range[0] = MIN(writer->m_range[0], coord[2]); writer->m_range[1] = MAX(writer->m_range[1], coord[2]); } } SEXP sfc_writer_alloc_coord_seq(uint32_t size_hint, int coord_size) { if (size_hint == WK_SIZE_UNKNOWN) { size_hint = SFC_INITIAL_SIZE_IF_UNKNOWN; } return Rf_allocMatrix(REALSXP, size_hint, coord_size); } SEXP sfc_writer_realloc_coord_seq(SEXP coord_seq, uint32_t new_size) { uint32_t current_size = Rf_nrows(coord_seq); int coord_size = Rf_ncols(coord_seq); SEXP new_coord_seq = PROTECT(Rf_allocMatrix(REALSXP, new_size, coord_size)); double* old_values = REAL(coord_seq); double* new_values = REAL(new_coord_seq); for (int j = 0; j < coord_size; j++) { memcpy( new_values + (j * new_size), old_values + (j * current_size), sizeof(double) * current_size ); } if (Rf_inherits(coord_seq, "sfg")) { SEXP class = PROTECT(Rf_getAttrib(coord_seq, R_ClassSymbol)); Rf_setAttrib(new_coord_seq, R_ClassSymbol, class); UNPROTECT(1); } UNPROTECT(1); return new_coord_seq; } SEXP sfc_writer_finalize_coord_seq(SEXP coord_seq, uint32_t final_size) { uint32_t current_size = Rf_nrows(coord_seq); int coord_size = Rf_ncols(coord_seq); SEXP new_coord_seq = PROTECT(Rf_allocMatrix(REALSXP, final_size, coord_size)); double* old_values = REAL(coord_seq); double* new_values = REAL(new_coord_seq); for (int j = 0; j < coord_size; j++) { memcpy( new_values + (j * final_size), old_values + (j * current_size), sizeof(double) * final_size ); } if (Rf_inherits(coord_seq, "sfg")) { SEXP class = PROTECT(Rf_getAttrib(coord_seq, R_ClassSymbol)); Rf_setAttrib(new_coord_seq, R_ClassSymbol, class); UNPROTECT(1); } UNPROTECT(1); return new_coord_seq; } SEXP sfc_writer_alloc_geom(uint32_t size_hint) { if (size_hint == WK_SIZE_UNKNOWN) { size_hint = SFC_INITIAL_SIZE_IF_UNKNOWN; } return Rf_allocVector(VECSXP, size_hint); } SEXP sfc_writer_realloc_geom(SEXP geom, R_xlen_t new_size) { R_xlen_t current_size = Rf_xlength(geom); SEXP new_geom = PROTECT(Rf_allocVector(VECSXP, new_size)); for (R_xlen_t i = 0; i < current_size; i++) { SET_VECTOR_ELT(new_geom, i, VECTOR_ELT(geom, i)); } if (Rf_inherits(geom, "sfg")) { SEXP class = PROTECT(Rf_getAttrib(geom, R_ClassSymbol)); Rf_setAttrib(new_geom, R_ClassSymbol, class); UNPROTECT(1); } UNPROTECT(1); return new_geom; } SEXP sfc_writer_finalize_geom(SEXP geom, R_xlen_t final_size) { SEXP new_geom = PROTECT(Rf_allocVector(VECSXP, final_size)); for (R_xlen_t i = 0; i < final_size; i++) { SET_VECTOR_ELT(new_geom, i, VECTOR_ELT(geom, i)); } if (Rf_inherits(geom, "sfg")) { SEXP class = PROTECT(Rf_getAttrib(geom, R_ClassSymbol)); Rf_setAttrib(new_geom, R_ClassSymbol, class); UNPROTECT(1); } UNPROTECT(1); return new_geom; } static inline void sfc_writer_sfc_append(sfc_writer_t* writer, SEXP value) { R_xlen_t current_size = Rf_xlength(writer->sfc); if (writer->feat_id >= current_size) { SEXP new_result = PROTECT(Rf_allocVector(VECSXP, current_size * 2 + 1)); for (R_xlen_t i = 0; i < current_size; i++) { SET_VECTOR_ELT(new_result, i, VECTOR_ELT(writer->sfc, i)); } R_ReleaseObject(writer->sfc); writer->sfc = new_result; R_PreserveObject(writer->sfc); UNPROTECT(1); } SET_VECTOR_ELT(writer->sfc, writer->feat_id, value); writer->feat_id++; } static inline void sfc_writer_sfc_finalize(sfc_writer_t* writer) { R_xlen_t current_size = Rf_xlength(writer->sfc); if (writer->feat_id != current_size) { SEXP new_result = PROTECT(Rf_allocVector(VECSXP, writer->feat_id)); for (R_xlen_t i = 0; i < writer->feat_id; i++) { SET_VECTOR_ELT(new_result, i, VECTOR_ELT(writer->sfc, i)); } R_ReleaseObject(writer->sfc); writer->sfc = new_result; R_PreserveObject(writer->sfc); UNPROTECT(1); } } int sfc_writer_vector_start(const wk_vector_meta_t* vector_meta, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; if (writer->sfc != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } if (vector_meta->size == WK_VECTOR_SIZE_UNKNOWN) { writer->sfc = PROTECT(Rf_allocVector(VECSXP, 1024)); } else { writer->sfc = PROTECT(Rf_allocVector(VECSXP, vector_meta->size)); } R_PreserveObject(writer->sfc); UNPROTECT(1); writer->feat_id = 0; return WK_CONTINUE; } int sfc_writer_feature_start(const wk_vector_meta_t* vector_meta, R_xlen_t feat_id, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; writer->recursion_level = 0; return WK_CONTINUE; } int sfc_writer_null_feature(void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; // sfc doesn't do NULLs and replaces them with GEOMETRYCOLLECTION EMPTY // however, as the dimensions have to align among features we asign a NULL here and fix // in vector_end() writer->any_null = 1; sfc_writer_sfc_append(writer, R_NilValue); return WK_ABORT_FEATURE; } int sfc_writer_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; // ignore start of POINT nested in MULTIPOINT if (sfc_writer_is_nesting_multipoint(writer)) { return WK_CONTINUE; } if ((meta->flags & WK_FLAG_HAS_Z) && (meta->flags & WK_FLAG_HAS_M)) { writer->coord_size = 4; } else if ((meta->flags & WK_FLAG_HAS_Z) || (meta->flags & WK_FLAG_HAS_M)) { writer->coord_size = 3; } else { writer->coord_size = 2; } // there isn't quite enough information here yet for points, which can // be considered empty if coordinates are NA if ((writer->recursion_level == 0) && (meta->geometry_type != WK_POINT)) { sfc_writer_update_vector_attributes(writer, meta, meta->size); } else if ((writer->recursion_level < 0) || (writer->recursion_level >= SFC_MAX_RECURSION_DEPTH)) { Rf_error("Invalid recursion depth whilst parsing 'sfg': %d", writer->recursion_level); } // if POINT, LINESTRING, or MULTIPOINT // replace coordinate sequence with a fresh one // otherwise, create a list() container and push it to the writer->geom[] stack switch (meta->geometry_type) { case WK_POINT: if (writer->coord_seq != R_NilValue) R_ReleaseObject(writer->coord_seq); writer->coord_seq = PROTECT(Rf_allocVector(REALSXP, writer->coord_size)); // empty point is NA, NA ... if (meta->size == 0) { for (int i = 0; i < writer->coord_size; i++) { REAL(writer->coord_seq)[i] = NA_REAL; } } sfc_writer_maybe_add_class_to_sfg(writer, writer->coord_seq, meta); R_PreserveObject(writer->coord_seq); UNPROTECT(1); writer->coord_id = 0; writer->coord_seq_rows = 1; break; case WK_LINESTRING: case WK_MULTIPOINT: if (writer->coord_seq != R_NilValue) R_ReleaseObject(writer->coord_seq); writer->coord_seq = PROTECT(sfc_writer_alloc_coord_seq(meta->size, writer->coord_size)); sfc_writer_maybe_add_class_to_sfg(writer, writer->coord_seq, meta); R_PreserveObject(writer->coord_seq); UNPROTECT(1); writer->coord_id = 0; writer->coord_seq_rows = Rf_nrows(writer->coord_seq); break; case WK_POLYGON: case WK_MULTILINESTRING: case WK_MULTIPOLYGON: case WK_GEOMETRYCOLLECTION: if (writer->geom[writer->recursion_level] != R_NilValue) { R_ReleaseObject(writer->geom[writer->recursion_level]); } writer->geom[writer->recursion_level] = PROTECT(sfc_writer_alloc_geom(meta->size)); sfc_writer_maybe_add_class_to_sfg(writer, writer->geom[writer->recursion_level], meta); R_PreserveObject(writer->geom[writer->recursion_level]); UNPROTECT(1); writer->part_id[writer->recursion_level] = 0; break; default: Rf_error("Can't convert geometry type '%d' to sfg", meta->geometry_type); // # nocov break; } writer->recursion_level++; return WK_CONTINUE; } int sfc_writer_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; if (writer->coord_seq != NULL) { R_ReleaseObject(writer->coord_seq); } writer->coord_seq = PROTECT(sfc_writer_alloc_coord_seq(size, writer->coord_size)); R_PreserveObject(writer->coord_seq); UNPROTECT(1); writer->coord_id = 0; writer->coord_seq_rows = Rf_nrows(writer->coord_seq); writer->recursion_level++; return WK_CONTINUE; } int sfc_writer_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; // This point might be EMPTY, in which case it will cause the ranges to be all NaN if ((meta->geometry_type != WK_POINT) || (!sfc_double_all_na_or_nan(writer->coord_size, coord))) { sfc_writer_update_ranges(writer, meta, coord); } // realloc the coordinate sequence if necessary if (writer->coord_id >= writer->coord_seq_rows) { SEXP new_coord_seq = PROTECT(sfc_writer_realloc_coord_seq(writer->coord_seq, writer->coord_id * 1.5 + 1)); R_ReleaseObject(writer->coord_seq); writer->coord_seq = new_coord_seq; R_PreserveObject(writer->coord_seq); UNPROTECT(1); writer->coord_seq_rows = Rf_nrows(writer->coord_seq); } double* current_values = REAL(writer->coord_seq); for (int i = 0; i < writer->coord_size; i++) { current_values[i * writer->coord_seq_rows + writer->coord_id] = coord[i]; } writer->coord_id++; return WK_CONTINUE; } int sfc_writer_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; writer->recursion_level--; SEXP geom; if (writer->coord_id < Rf_nrows(writer->coord_seq)) { geom = PROTECT(sfc_writer_finalize_coord_seq(writer->coord_seq, writer->coord_id)); } else { geom = PROTECT(writer->coord_seq); } R_ReleaseObject(writer->coord_seq); writer->coord_seq = R_NilValue; // may need to reallocate the container R_xlen_t container_len = Rf_xlength(writer->geom[writer->recursion_level - 1]); if (ring_id >= container_len) { SEXP new_geom = PROTECT( sfc_writer_realloc_geom( writer->geom[writer->recursion_level - 1], container_len * 1.5 + 1 ) ); R_ReleaseObject(writer->geom[writer->recursion_level - 1]); writer->geom[writer->recursion_level - 1] = new_geom; R_PreserveObject(writer->geom[writer->recursion_level - 1]); UNPROTECT(1); } SET_VECTOR_ELT(writer->geom[writer->recursion_level - 1], ring_id, geom); writer->part_id[writer->recursion_level - 1]++; UNPROTECT(1); return WK_CONTINUE; } int sfc_writer_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; // ignore end of POINT nested in MULTIPOINT if ((meta->geometry_type == WK_POINT) && sfc_writer_is_nesting_multipoint(writer)) { return WK_CONTINUE; } writer->recursion_level--; SEXP geom; switch(meta->geometry_type) { case WK_POINT: geom = PROTECT(writer->coord_seq); R_ReleaseObject(writer->coord_seq); writer->coord_seq = R_NilValue; break; case WK_LINESTRING: case WK_MULTIPOINT: if (writer->coord_id < Rf_nrows(writer->coord_seq)) { geom = PROTECT(sfc_writer_finalize_coord_seq(writer->coord_seq, writer->coord_id)); } else { geom = PROTECT(writer->coord_seq); } R_ReleaseObject(writer->coord_seq); writer->coord_seq = R_NilValue; break; case WK_POLYGON: case WK_MULTILINESTRING: case WK_MULTIPOLYGON: case WK_GEOMETRYCOLLECTION: if (writer->part_id[writer->recursion_level] < Rf_xlength(writer->geom[writer->recursion_level])) { geom = PROTECT( sfc_writer_finalize_geom( writer->geom[writer->recursion_level], writer->part_id[writer->recursion_level] ) ); } else { geom = PROTECT(writer->geom[writer->recursion_level]); } // R_ReleaseObject() is called on `geom` in finalize() or // when it is replaced in geometry_start() break; default: Rf_error("Can't convert geometry type '%d' to sfg", meta->geometry_type); // # nocov break; // # nocov } // Top-level geometries have their dimensions checked but nested must be as well if ((writer->recursion_level) > 0 && (meta->geometry_type == WK_POINT)) { int all_na = sfc_double_all_na_or_nan(writer->coord_size, REAL(geom)); sfc_writer_update_dimensions(writer, meta, meta->size && !all_na); } else if (writer->recursion_level > 0) { sfc_writer_update_dimensions(writer, meta, meta->size); } // if we're above a top-level geometry, this geometry needs to be added to the parent // otherwise, it needs to be added to sfc if (writer->recursion_level > 0) { // may need to reallocate the container R_xlen_t container_len = Rf_xlength(writer->geom[writer->recursion_level - 1]); if (part_id >= container_len) { SEXP new_geom = PROTECT( sfc_writer_realloc_geom( writer->geom[writer->recursion_level - 1], container_len * 1.5 + 1 ) ); R_ReleaseObject(writer->geom[writer->recursion_level - 1]); writer->geom[writer->recursion_level - 1] = new_geom; R_PreserveObject(writer->geom[writer->recursion_level - 1]); UNPROTECT(1); } SET_VECTOR_ELT(writer->geom[writer->recursion_level - 1], part_id, geom); writer->part_id[writer->recursion_level - 1]++; } else if (meta->geometry_type == WK_POINT) { // at the top level, we have to check again if all point coordinates are NA // because this is 'empty' for the purposes of sfc // We didn't update this earlier because we didn't know if the point was // empty yet or not! int all_na = sfc_double_all_na_or_nan(writer->coord_size, REAL(geom)); sfc_writer_update_vector_attributes(writer, meta, meta->size && !all_na); sfc_writer_sfc_append(writer, geom); } else { sfc_writer_sfc_append(writer, geom); } UNPROTECT(1); return WK_CONTINUE; } SEXP sfc_writer_vector_end(const wk_vector_meta_t* vector_meta, void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; sfc_writer_sfc_finalize(writer); // replace NULLs with EMPTY of an appropriate type if (writer->any_null) { wk_meta_t meta; if (writer->geometry_type == WK_GEOMETRY || writer->geometry_type == SFC_GEOMETRY_TYPE_NOT_YET_DEFINED) { WK_META_RESET(meta, WK_GEOMETRYCOLLECTION); // also update the type list for attr(sfc, "classes") writer->all_geometry_types = writer->all_geometry_types | (1 << (WK_GEOMETRYCOLLECTION - 1)); } else { WK_META_RESET(meta, writer->geometry_type); } if (writer->flags != SFC_FLAGS_NOT_YET_DEFINED) { meta.flags = writer->flags; } if (writer->geometry_type == SFC_GEOMETRY_TYPE_NOT_YET_DEFINED) { writer->geometry_type = WK_GEOMETRYCOLLECTION; } meta.size = 0; writer->recursion_level = 0; SEXP empty = PROTECT(sfc_writer_empty_sfg(meta.geometry_type, meta.flags)); sfc_writer_maybe_add_class_to_sfg(writer, empty, &meta); for (R_xlen_t i = 0; i < Rf_xlength(writer->sfc); i++) { if (VECTOR_ELT(writer->sfc, i) == R_NilValue) { writer->n_empty++; SET_VECTOR_ELT(writer->sfc, i, empty); } } UNPROTECT(1); } // attr(sfc, "precision") SEXP precision; if (writer->precision == R_PosInf) { precision = PROTECT(Rf_ScalarReal(0.0)); } else { precision = PROTECT(Rf_ScalarReal(writer->precision)); } Rf_setAttrib(writer->sfc, Rf_install("precision"), precision); UNPROTECT(1); // attr(sfc, "bbox") const char* bbox_names[] = {"xmin", "ymin", "xmax", "ymax", ""}; SEXP bbox = PROTECT(Rf_mkNamed(REALSXP, bbox_names)); Rf_setAttrib(bbox, R_ClassSymbol, Rf_mkString("bbox")); // the bounding box may or may not have a crs attribute // when all features are empty if (Rf_xlength(writer->sfc) == writer->n_empty) { SEXP na_crs = PROTECT(sfc_na_crs()); Rf_setAttrib(bbox, Rf_install("crs"), na_crs); UNPROTECT(1); } // if the bounding box was never updated, set it to NAs if (writer->bbox[0] == R_PosInf) { writer->bbox[0] = NA_REAL; writer->bbox[1] = NA_REAL; writer->bbox[2] = NA_REAL; writer->bbox[3] = NA_REAL; } memcpy(REAL(bbox), writer->bbox, sizeof(double) * 4); Rf_setAttrib(writer->sfc, Rf_install("bbox"), bbox); UNPROTECT(1); // attr(sfc, "z_range"), attr(sfc, "m_range") if (writer->flags == SFC_FLAGS_NOT_YET_DEFINED) { writer->flags = 0; } if (writer->flags & WK_FLAG_HAS_Z) { // if the z_range was never updated, set it to NAs if (writer->z_range[0] == R_PosInf) { writer->z_range[0] = NA_REAL; writer->z_range[1] = NA_REAL; } const char* z_range_names[] = {"zmin", "zmax", ""}; SEXP z_range = PROTECT(Rf_mkNamed(REALSXP, z_range_names)); Rf_setAttrib(z_range, R_ClassSymbol, Rf_mkString("z_range")); memcpy(REAL(z_range), writer->z_range, sizeof(double) * 2); Rf_setAttrib(writer->sfc, Rf_install("z_range"), z_range); UNPROTECT(1); } if (writer->flags & WK_FLAG_HAS_M) { // if the m_range was never updated, set it to NAs if (writer->m_range[0] == R_PosInf) { writer->m_range[0] = NA_REAL; writer->m_range[1] = NA_REAL; } const char* m_range_names[] = {"mmin", "mmax", ""}; SEXP m_range = PROTECT(Rf_mkNamed(REALSXP, m_range_names)); Rf_setAttrib(m_range, R_ClassSymbol, Rf_mkString("m_range")); memcpy(REAL(m_range), writer->m_range, sizeof(double) * 2); Rf_setAttrib(writer->sfc, Rf_install("m_range"), m_range); UNPROTECT(1); } // attr(sfc, "crs") // this should be handled in R; however, inserting a placeholder here // because the print() method for sfc will error otherwise SEXP na_crs = PROTECT(sfc_na_crs()); Rf_setAttrib(writer->sfc, Rf_install("crs"), na_crs); UNPROTECT(1); // attr(sfc, "n_empty") SEXP n_empty = PROTECT(Rf_ScalarInteger(writer->n_empty)); Rf_setAttrib(writer->sfc, Rf_install("n_empty"), n_empty); UNPROTECT(1); // class(sfc) SEXP class = PROTECT(Rf_allocVector(STRSXP, 2)); switch (writer->geometry_type) { case WK_POINT: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_POINT")); break; case WK_LINESTRING: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_LINESTRING")); break; case WK_POLYGON: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_POLYGON")); break; case WK_MULTIPOINT: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_MULTIPOINT")); break; case WK_MULTILINESTRING: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_MULTILINESTRING")); break; case WK_MULTIPOLYGON: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_MULTIPOLYGON")); break; case WK_GEOMETRYCOLLECTION: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_GEOMETRYCOLLECTION")); break; default: SET_STRING_ELT(class, 0, Rf_mkChar("sfc_GEOMETRY")); break; } SET_STRING_ELT(class, 1, Rf_mkChar("sfc")); Rf_setAttrib(writer->sfc, R_ClassSymbol, class); UNPROTECT(1); // attr(sfc, "classes") (only for all empty) if (Rf_xlength(writer->sfc) == writer->n_empty) { int n_geometry_types = 0; for (int i = 0; i < 7; i++) { if (1 & (writer->all_geometry_types >> i)) n_geometry_types++; } const char* type_names[] = { "POINT", "LINESTRING", "POLYGON", "MULTIPOINT", "MULTILINESTRING", "MULTIPOLYGON", "GEOMETRYCOLLECTION" }; SEXP classes = PROTECT(Rf_allocVector(STRSXP, n_geometry_types)); int classes_index = 0; for (int i = 0; i < 7; i++) { if (1 & (writer->all_geometry_types >> i)) { SET_STRING_ELT(classes, classes_index, Rf_mkChar(type_names[i])); classes_index++; } } Rf_setAttrib(writer->sfc, Rf_install("classes"), classes); UNPROTECT(1); } return writer->sfc; } void sfc_writer_deinitialize(void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; if (writer->sfc != R_NilValue) { R_ReleaseObject(writer->sfc); writer->sfc = R_NilValue; } for (int i = 0; i < (SFC_WRITER_GEOM_LENGTH); i++) { if (writer->geom[i] != R_NilValue) { R_ReleaseObject(writer->geom[i]); writer->geom[i] = R_NilValue; } } if (writer->coord_seq != R_NilValue) { R_ReleaseObject(writer->coord_seq); writer->coord_seq = R_NilValue; } } void sfc_writer_finalize(void* handler_data) { sfc_writer_t* writer = (sfc_writer_t*) handler_data; if (writer != NULL) { free(writer); } } SEXP wk_c_sfc_writer_new() { wk_handler_t* handler = wk_handler_create(); handler->finalizer = &sfc_writer_finalize; handler->vector_start = &sfc_writer_vector_start; handler->feature_start = &sfc_writer_feature_start; handler->null_feature = &sfc_writer_null_feature; handler->geometry_start = &sfc_writer_geometry_start; handler->ring_start = &sfc_writer_ring_start; handler->coord = &sfc_writer_coord; handler->ring_end = &sfc_writer_ring_end; handler->geometry_end = &sfc_writer_geometry_end; handler->vector_end = &sfc_writer_vector_end; handler->deinitialize = &sfc_writer_deinitialize; handler->handler_data = sfc_writer_new(); if (handler->handler_data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); return xptr; } wk/src/trans-affine.c0000644000176200001440000000324614106220314014201 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" #include int wk_trans_affine_trans(R_xlen_t feature_id, const double* xyzm_in, double* xyzm_out, void* trans_data) { double* t = (double*) trans_data; xyzm_out[0] = t[0] * xyzm_in[0] + t[2] * xyzm_in[1] + t[4]; xyzm_out[1] = t[1] * xyzm_in[0] + t[3] * xyzm_in[1] + t[5]; xyzm_out[2] = xyzm_in[2]; xyzm_out[3] = xyzm_in[3]; return WK_CONTINUE; } void wk_trans_affine_finalize(void* trans_data) { free(trans_data); } SEXP wk_c_trans_affine_new(SEXP trans_matrix) { if (!Rf_isMatrix(trans_matrix) || (Rf_nrows(trans_matrix) != 3) || (Rf_ncols(trans_matrix) != 3)) { Rf_error("`trans_matrix` must be a 3x3 matrix"); } // create the wk_trans object wk_trans_t* trans = wk_trans_create(); trans->trans = &wk_trans_affine_trans; trans->finalizer = &wk_trans_affine_finalize; // simplify the affine transform data to six numbers double* trans_matrix_ptr = REAL(trans_matrix); double* t = (double*) malloc(6 * sizeof(double)); if (t == NULL) { free(trans); // # nocov Rf_error("Failed to alloc double[6]"); // # nocov } t[0] = trans_matrix_ptr[0]; t[1] = trans_matrix_ptr[1]; t[2] = trans_matrix_ptr[3]; t[3] = trans_matrix_ptr[4]; t[4] = trans_matrix_ptr[6]; t[5] = trans_matrix_ptr[7]; // this *is* the only data we need trans->trans_data = t; // keep the trans matrix as a tag so that we can return it in as.matrix() return wk_trans_create_xptr(trans, trans_matrix, R_NilValue); } SEXP wk_c_trans_affine_as_matrix(SEXP trans_xptr) { return R_ExternalPtrTag(trans_xptr); } wk/src/handle-sfc.c0000644000176200001440000003120614106220314013625 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result != WK_CONTINUE) return result #define HANDLE_CONTINUE_OR_BREAK(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) continue; else if (result == WK_ABORT) break int wk_sfc_read_sfg(SEXP x, wk_handler_t* handler, uint32_t part_id, double precision); int wk_sfc_read_point(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); int wk_sfc_read_linestring(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); int wk_sfc_read_polygon(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); int wk_sfc_read_multipoint(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); int wk_sfc_read_multilinestring(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); int wk_sfc_read_multipolygon(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); int wk_sfc_read_geometrycollection(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id); void wk_update_meta_from_sfg(SEXP x, wk_meta_t* meta); void wk_update_vector_meta_from_sfc(SEXP x, wk_vector_meta_t* vector_meta); double wk_sfc_precision(SEXP x); SEXP wk_c_read_sfc_impl(SEXP data, wk_handler_t* handler) { R_xlen_t n_features = Rf_xlength(data); wk_vector_meta_t vector_meta; WK_VECTOR_META_RESET(vector_meta, WK_GEOMETRY); vector_meta.size = n_features; wk_update_vector_meta_from_sfc(data, &vector_meta); double precision = wk_sfc_precision(data); if (handler->vector_start(&vector_meta, handler->handler_data) != WK_ABORT) { int result; SEXP item; for (R_xlen_t i = 0; i < n_features; i++) { if (((i + 1) % 1000) == 0) R_CheckUserInterrupt(); HANDLE_CONTINUE_OR_BREAK(handler->feature_start(&vector_meta, i, handler->handler_data)); item = VECTOR_ELT(data, i); if (item == R_NilValue) { HANDLE_CONTINUE_OR_BREAK(handler->null_feature(handler->handler_data)); } else { HANDLE_CONTINUE_OR_BREAK(wk_sfc_read_sfg(item, handler, WK_PART_ID_NONE, precision)); } if (handler->feature_end(&vector_meta, i, handler->handler_data) == WK_ABORT) { break; } } } return handler->vector_end(&vector_meta, handler->handler_data); } SEXP wk_c_read_sfc(SEXP data, SEXP handler_xptr) { return wk_handler_run_xptr(&wk_c_read_sfc_impl, data, handler_xptr); } int wk_sfc_read_sfg(SEXP x, wk_handler_t* handler, uint32_t part_id, double precision) { wk_meta_t meta; WK_META_RESET(meta, WK_GEOMETRY); wk_update_meta_from_sfg(x, &meta); meta.precision = precision; if (Rf_inherits(x, "POINT")) { return wk_sfc_read_point(x, handler, &meta, part_id); } else if (Rf_inherits(x, "LINESTRING")) { return wk_sfc_read_linestring(x, handler, &meta, part_id); } else if (Rf_inherits(x, "POLYGON")) { return wk_sfc_read_polygon(x, handler, &meta, part_id); } else if (Rf_inherits(x, "MULTIPOINT")) { return wk_sfc_read_multipoint(x, handler, &meta, part_id); } else if (Rf_inherits(x, "MULTILINESTRING")) { return wk_sfc_read_multilinestring(x, handler, &meta, part_id); } else if (Rf_inherits(x, "MULTIPOLYGON")) { return wk_sfc_read_multipolygon(x, handler, &meta, part_id); } else if (Rf_inherits(x, "GEOMETRYCOLLECTION")) { return wk_sfc_read_geometrycollection(x, handler, &meta, part_id); } else if (Rf_inherits(x, "sfg")) { Rf_error("Unsupported sfg type"); } else { Rf_error("Element of sfc list must inherit from 'sfg'"); } // should never be reached return WK_ABORT; // # nocov } int wk_sfc_read_point(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_POINT; meta->size = 0; double* values = REAL(x); int coord_size = Rf_length(x); for (int i = 0; i < coord_size; i++) { if (!ISNA(values[i]) && !ISNAN(values[i])) { meta->size = 1; break; } } HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); if (meta->size) { double coord[4]; memcpy(coord, REAL(x), sizeof(double) * coord_size); HANDLE_OR_RETURN(handler->coord(meta, coord, 0, handler->handler_data)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } int wk_sfc_read_linestring(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_LINESTRING; meta->size = Rf_nrows(x); int coord_size = Rf_ncols(x); HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); double coord[4]; double* coords = REAL(x); for (uint32_t i = 0; i < meta->size; i++) { for (int j = 0; j < coord_size; j++) { coord[j] = coords[j * meta->size + i]; } HANDLE_OR_RETURN(handler->coord(meta, coord, i, handler->handler_data)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } int wk_sfc_read_polygon(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_POLYGON; meta->size = Rf_xlength(x); HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); SEXP ring; for (uint32_t ring_id = 0; ring_id < meta->size; ring_id++) { ring = VECTOR_ELT(x, ring_id); uint32_t ring_size = Rf_nrows(ring); int coord_size = Rf_ncols(ring); HANDLE_OR_RETURN(handler->ring_start(meta, meta->size, ring_id, handler->handler_data)); double coord[4]; double* coords = REAL(ring); for (uint32_t i = 0; i < ring_size; i++) { for (int j = 0; j < coord_size; j++) { coord[j] = coords[j * ring_size + i]; } HANDLE_OR_RETURN(handler->coord(meta, coord, i, handler->handler_data)); } HANDLE_OR_RETURN(handler->ring_end(meta, meta->size, ring_id, handler->handler_data)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } int wk_sfc_read_multipoint(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_MULTIPOINT; meta->size = Rf_nrows(x); int coord_size = Rf_ncols(x); wk_meta_t child_meta; WK_META_RESET(child_meta, WK_POINT); child_meta.size = 1; child_meta.flags = meta->flags; HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); double coord[4]; double* coords = REAL(x); for (uint32_t i = 0; i < meta->size; i++) { for (int j = 0; j < coord_size; j++) { coord[j] = coords[j * meta->size + i]; } HANDLE_OR_RETURN(handler->geometry_start(&child_meta, i, handler->handler_data)); HANDLE_OR_RETURN(handler->coord(&child_meta, coord, 0, handler->handler_data)); HANDLE_OR_RETURN(handler->geometry_end(&child_meta, i, handler->handler_data)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } int wk_sfc_read_multilinestring(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_MULTILINESTRING; wk_meta_t child_meta; WK_META_RESET(child_meta, WK_LINESTRING); child_meta.flags = meta->flags; meta->size = Rf_xlength(x); HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); for (uint32_t child_part_id = 0; child_part_id < meta->size; child_part_id++) { HANDLE_OR_RETURN(wk_sfc_read_linestring(VECTOR_ELT(x, child_part_id), handler, &child_meta, child_part_id)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } int wk_sfc_read_multipolygon(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_MULTIPOLYGON; wk_meta_t child_meta; WK_META_RESET(child_meta, WK_POLYGON); child_meta.flags = meta->flags; meta->size = Rf_xlength(x); HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); for (uint32_t child_part_id = 0; child_part_id < meta->size; child_part_id++) { HANDLE_OR_RETURN(wk_sfc_read_polygon(VECTOR_ELT(x, child_part_id), handler, &child_meta, child_part_id)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } int wk_sfc_read_geometrycollection(SEXP x, wk_handler_t* handler, wk_meta_t* meta, uint32_t part_id) { int result; meta->geometry_type = WK_GEOMETRYCOLLECTION; meta->size = Rf_xlength(x); HANDLE_OR_RETURN(handler->geometry_start(meta, part_id, handler->handler_data)); for (uint32_t child_part_id = 0; child_part_id < meta->size; child_part_id++) { HANDLE_OR_RETURN(wk_sfc_read_sfg(VECTOR_ELT(x, child_part_id), handler, child_part_id, meta->precision)); } HANDLE_OR_RETURN(handler->geometry_end(meta, part_id, handler->handler_data)); return WK_CONTINUE; } void wk_update_meta_from_sfg(SEXP x, wk_meta_t* meta) { if (Rf_inherits(x, "XY")) { // don't need to do anything here; default meta is xy } else if (Rf_inherits(x, "XYZ")) { meta->flags |= WK_FLAG_HAS_Z; } else if (Rf_inherits(x, "XYM")) { meta->flags |= WK_FLAG_HAS_M; } else if (Rf_inherits(x, "XYZM")) { meta->flags |= WK_FLAG_HAS_Z; meta->flags |= WK_FLAG_HAS_M; } else if (Rf_inherits(x, "sfg")) { Rf_error("Can't guess dimensions from class of 'sfg'"); } } void wk_update_vector_meta_from_sfc(SEXP x, wk_vector_meta_t* vector_meta) { // provide geometry type based on class if (Rf_inherits(x, "sfc_POINT")) { vector_meta->geometry_type = WK_POINT; } else if (Rf_inherits(x, "sfc_LINESTRING")) { vector_meta->geometry_type = WK_LINESTRING; } else if (Rf_inherits(x, "sfc_POLYGON")) { vector_meta->geometry_type = WK_POLYGON; } else if (Rf_inherits(x, "sfc_MULTIPOINT")) { vector_meta->geometry_type = WK_MULTIPOINT; } else if (Rf_inherits(x, "sfc_MULTILINESTRING")) { vector_meta->geometry_type = WK_MULTILINESTRING; } else if (Rf_inherits(x, "sfc_MULTIPOLYGON")) { vector_meta->geometry_type = WK_MULTIPOLYGON; } else if (Rf_inherits(x, "sfc_GEOMETRYCOLLECTION")) { vector_meta->geometry_type = WK_GEOMETRYCOLLECTION; } else { vector_meta->geometry_type = WK_GEOMETRY; } // if z or m coords are present, ranges are provided SEXP z_range = Rf_getAttrib(x, Rf_install("z_range")); if (z_range != R_NilValue) { vector_meta->flags |= WK_FLAG_HAS_Z; } SEXP m_range = Rf_getAttrib(x, Rf_install("m_range")); if (m_range != R_NilValue) { vector_meta->flags |= WK_FLAG_HAS_M; } // sfc objects come with a cached bbox // This appears to always be xmin, ymin, xmax, ymax // when attached to an sfc object SEXP bbox = Rf_getAttrib(x, Rf_install("bbox")); if ((Rf_xlength(x) > 0) && (bbox != R_NilValue)) { vector_meta->bounds_min[0] = REAL(bbox)[0]; vector_meta->bounds_min[1] = REAL(bbox)[1]; vector_meta->bounds_max[0] = REAL(bbox)[2]; vector_meta->bounds_max[1] = REAL(bbox)[3]; vector_meta->flags |= WK_FLAG_HAS_BOUNDS; } // Also include ZM values in the provided ranges if ((z_range != R_NilValue) && (m_range != R_NilValue)) { vector_meta->bounds_min[2] = REAL(z_range)[1]; vector_meta->bounds_max[2] = REAL(z_range)[2]; vector_meta->bounds_min[3] = REAL(m_range)[1]; vector_meta->bounds_max[3] = REAL(m_range)[2]; } else if (z_range != R_NilValue) { vector_meta->bounds_min[2] = REAL(z_range)[1]; vector_meta->bounds_max[2] = REAL(z_range)[2]; } else if (m_range != R_NilValue) { vector_meta->bounds_min[2] = REAL(m_range)[1]; vector_meta->bounds_max[2] = REAL(m_range)[2]; } } double wk_sfc_precision(SEXP x) { SEXP prec = Rf_getAttrib(x, Rf_install("precision")); if ((TYPEOF(prec) == INTSXP) && (Rf_length(prec) == 1)) { return INTEGER(prec)[0]; } else if ((TYPEOF(prec) == REALSXP) && (Rf_length(prec) == 1)) { return REAL(prec)[0]; } else { return WK_PRECISION_NONE; } } wk/src/Makevars0000644000176200001440000000006014106220314013143 0ustar liggesusersPKG_CPPFLAGS = -I../inst/include/ CXX_STD=CXX11 wk/src/debug-filter.c0000644000176200001440000002647214106220314014203 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" typedef struct { int level; wk_handler_t* next; } debug_filter_t; // this is not a pretty solution to the vector_meta*/meta* issue void wk_debug_filter_print_vector_meta(const wk_vector_meta_t* meta) { switch (meta->geometry_type) { case WK_POINT: Rprintf("POINT"); break; case WK_LINESTRING: Rprintf("LINESTRING"); break; case WK_POLYGON: Rprintf("POLYGON"); break; case WK_MULTIPOINT: Rprintf("MULTIPOINT"); break; case WK_MULTILINESTRING: Rprintf("MULTILINESTRING"); break; case WK_MULTIPOLYGON: Rprintf("MULTIPOLYGON"); break; case WK_GEOMETRYCOLLECTION: Rprintf("GEOMETRYCOLLECTION"); break; default: Rprintf("", meta->geometry_type); break; } if ((meta->flags & WK_FLAG_HAS_Z) || (meta->flags & WK_FLAG_HAS_M) || (meta->flags & WK_FLAG_HAS_BOUNDS)) { Rprintf(" "); } if (meta->flags & WK_FLAG_HAS_Z) Rprintf("Z"); if (meta->flags & WK_FLAG_HAS_M) Rprintf("M"); if (meta->flags & WK_FLAG_HAS_BOUNDS) Rprintf("B"); if (meta->size != WK_VECTOR_SIZE_UNKNOWN) { if (meta->size == 0) { Rprintf("[EMPTY]"); } else { Rprintf("[%d]", meta->size); } } else { Rprintf("[UNKNOWN]"); } Rprintf(" <%p>", (void*) meta); } void wk_debug_filter_print_meta(const wk_meta_t* meta) { switch (meta->geometry_type) { case WK_POINT: Rprintf("POINT"); break; case WK_LINESTRING: Rprintf("LINESTRING"); break; case WK_POLYGON: Rprintf("POLYGON"); break; case WK_MULTIPOINT: Rprintf("MULTIPOINT"); break; case WK_MULTILINESTRING: Rprintf("MULTILINESTRING"); break; case WK_MULTIPOLYGON: Rprintf("MULTIPOLYGON"); break; case WK_GEOMETRYCOLLECTION: Rprintf("GEOMETRYCOLLECTION"); break; default: Rprintf("", meta->geometry_type); break; } if ((meta->flags & WK_FLAG_HAS_Z) || (meta->flags & WK_FLAG_HAS_M) || (meta->srid != WK_SRID_NONE) || (meta->flags & WK_FLAG_HAS_BOUNDS) || (meta->precision != WK_PRECISION_NONE)) { Rprintf(" "); } if (meta->flags & WK_FLAG_HAS_Z) Rprintf("Z"); if (meta->flags & WK_FLAG_HAS_M) Rprintf("M"); if (meta->srid != WK_SRID_NONE) Rprintf("S"); if (meta->flags & WK_FLAG_HAS_BOUNDS) Rprintf("B"); if (meta->precision != WK_PRECISION_NONE) Rprintf("P"); if (meta->size != WK_SIZE_UNKNOWN) { if (meta->size == 0) { Rprintf("[EMPTY]"); } else { Rprintf("[%d]", meta->size); } } else { Rprintf("[UNKNOWN]"); } Rprintf(" <%p>", (void*) meta); } void wk_debug_filter_print_indent(debug_filter_t* debug_filter) { for (int i = 0; i < debug_filter->level; i++) { Rprintf(" "); } } void wk_debug_filter_reset(debug_filter_t* debug_filter, int value) { debug_filter->level = value; } void wk_debug_filter_indent(debug_filter_t* debug_filter) { debug_filter->level++; } void wk_debug_filter_dedent(debug_filter_t* debug_filter) { debug_filter->level--; } void wk_debug_filter_print_result(int result) { switch (result) { case WK_CONTINUE: Rprintf(" => WK_CONTINUE\n"); break; case WK_ABORT_FEATURE: Rprintf(" => WK_ABORT_FEATURE\n"); break; case WK_ABORT: Rprintf(" => WK_ABORT\n"); break; default: Rprintf(" => [uknown %d]\n", result); break; } } void wk_debug_filter_initialize(int* dirty, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; *dirty = 1; wk_debug_filter_reset(debug_filter, 0); Rprintf("initialize (dirty = %d ", debug_filter->next->dirty); debug_filter->next->initialize(&debug_filter->next->dirty, debug_filter->next->handler_data); Rprintf(" -> %d)\n", *dirty); } int wk_debug_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); Rprintf("vector_start: "); wk_debug_filter_print_vector_meta(meta); wk_debug_filter_indent(debug_filter); int result = debug_filter->next->vector_start(meta, debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } SEXP wk_debug_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_dedent(debug_filter); // indenting here is more confusing than helpful Rprintf("vector_end: <%p>\n", meta); return debug_filter->next->vector_end(meta, debug_filter->next->handler_data);; } int wk_debug_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); Rprintf("feature_start (%d): <%p> ", feat_id + 1, meta); int result = debug_filter->next->feature_start(meta, feat_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); wk_debug_filter_indent(debug_filter); return result; } int wk_debug_filter_feature_null(void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); Rprintf("null_feature "); int result = debug_filter->next->null_feature(debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } int wk_debug_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_dedent(debug_filter); wk_debug_filter_print_indent(debug_filter); Rprintf("feature_end (%d): <%p> ", feat_id + 1, meta); int result = debug_filter->next->feature_end(meta, feat_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } int wk_debug_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); if (part_id == WK_PART_ID_NONE) { Rprintf("geometry_start (): ", part_id + 1); } else { Rprintf("geometry_start (%d): ", part_id + 1); } wk_debug_filter_print_meta(meta); int result = debug_filter->next->geometry_start(meta, part_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); wk_debug_filter_indent(handler_data); return result; } int wk_debug_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_dedent(debug_filter); wk_debug_filter_print_indent(debug_filter); if (part_id == WK_PART_ID_NONE) { Rprintf("geometry_end () ", part_id + 1); } else { Rprintf("geometry_end (%d) ", part_id + 1); } int result = debug_filter->next->geometry_end(meta, part_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } int wk_debug_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); if (size != WK_SIZE_UNKNOWN) { Rprintf("ring_start[%d] (%d): <%p> ", size, ring_id + 1, meta); } else { Rprintf("ring_start (%d): <%p> ", ring_id + 1, meta); } wk_debug_filter_indent(debug_filter); int result = debug_filter->next->ring_start(meta, size, ring_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } int wk_debug_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_dedent(debug_filter); wk_debug_filter_print_indent(debug_filter); if (size != WK_SIZE_UNKNOWN) { Rprintf("ring_end[%d] (%d): <%p> ", size, ring_id + 1, meta); } else { Rprintf("ring_end (%d): <%p> ", ring_id + 1, meta); } int result = debug_filter->next->ring_end(meta, size, ring_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } int wk_debug_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); Rprintf("coord (%d): <%p> (%f %f", coord_id + 1, meta, coord[0], coord[1]); if (meta->flags & WK_FLAG_HAS_Z || meta->flags & WK_FLAG_HAS_M) Rprintf(" %f", coord[2]); if (meta->flags & WK_FLAG_HAS_Z && meta->flags & WK_FLAG_HAS_M) Rprintf(" %f", coord[3]); Rprintf(") "); int result = debug_filter->next->coord(meta, coord, coord_id, debug_filter->next->handler_data); wk_debug_filter_print_result(result); return result; } int wk_debug_filter_error(const char* message, void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; wk_debug_filter_print_indent(debug_filter); Rprintf("error: %s", message); int result = debug_filter->next->error(message, debug_filter->next->handler_data); wk_debug_filter_print_result(result); if (result == WK_ABORT_FEATURE) { wk_debug_filter_reset(debug_filter, 1); } else if (result == WK_ABORT) { wk_debug_filter_reset(debug_filter, 0); } return result; } void wk_debug_filter_deinitialize(void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; Rprintf("deinitialize"); debug_filter->next->deinitialize(debug_filter->next->handler_data); Rprintf("\n"); } void wk_debug_filter_finalize(void* handler_data) { debug_filter_t* debug_filter = (debug_filter_t*) handler_data; if (debug_filter != NULL) { // finalizer for debug_filter->next is run by the externalptr finalizer // and should not be called here free(debug_filter); } } SEXP wk_c_debug_filter_new(SEXP handler_xptr) { wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_debug_filter_initialize; handler->vector_start = &wk_debug_filter_vector_start; handler->vector_end = &wk_debug_filter_vector_end; handler->feature_start = &wk_debug_filter_feature_start; handler->null_feature = &wk_debug_filter_feature_null; handler->feature_end = &wk_debug_filter_feature_end; handler->geometry_start = &wk_debug_filter_geometry_start; handler->geometry_end = &wk_debug_filter_geometry_end; handler->ring_start = &wk_debug_filter_ring_start; handler->ring_end = &wk_debug_filter_ring_end; handler->coord = &wk_debug_filter_coord; handler->error = &wk_debug_filter_error; handler->deinitialize = &wk_debug_filter_deinitialize; handler->finalizer = &wk_debug_filter_finalize; debug_filter_t* debug_filter = (debug_filter_t*) malloc(sizeof(debug_filter_t)); if (debug_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } debug_filter->level = 0; debug_filter->next = R_ExternalPtrAddr(handler_xptr); if (debug_filter->next->api_version != 1) { Rf_error("Can't run a wk_handler with api_version '%d'", debug_filter->next->api_version); // # nocov } handler->handler_data = debug_filter; // include the external pointer as a tag for this external pointer // which guarnatees that it will not be garbage collected until // this object is garbage collected return wk_handler_create_xptr(handler, handler_xptr, R_NilValue); } wk/src/wkt-writer.cpp0000644000176200001440000001736714160220603014315 0ustar liggesusers #include "internal/wk-v1-handler.hpp" #include #include #include class WKTWriterHandler: public WKVoidHandler { public: SEXP result; std::stringstream out; std::string current_item; std::vector stack; R_xlen_t feat_id; WKTWriterHandler(int precision, bool trim) { this->result = R_NilValue; this->out.imbue(std::locale::classic()); this->out.precision(precision); if (trim) { this->out.unsetf(out.fixed); } else { this->out.setf(out.fixed); } } void resultInit(R_xlen_t size) { SEXP new_result = PROTECT(Rf_allocVector(STRSXP, size)); if (this->result != R_NilValue) { R_ReleaseObject(this->result); } this->result = new_result; R_PreserveObject(this->result); UNPROTECT(1); } void resultEnsureSize() { R_xlen_t current_size = Rf_xlength(this->result); if (this->feat_id >= current_size) { SEXP new_result = PROTECT(Rf_allocVector(STRSXP, current_size * 2 + 1)); for (R_xlen_t i = 0; i < current_size; i++) { SET_STRING_ELT(new_result, i, STRING_ELT(this->result, i)); } if (this->result != R_NilValue) { R_ReleaseObject(this->result); } this->result = new_result; R_PreserveObject(this->result); UNPROTECT(1); } } void resultFinalize() { R_xlen_t current_size = Rf_xlength(this->result); if (this->feat_id != current_size) { SEXP new_result = PROTECT(Rf_allocVector(STRSXP, this->feat_id)); for (R_xlen_t i = 0; i < this->feat_id; i++) { SET_STRING_ELT(new_result, i, STRING_ELT(this->result, i)); } if (this->result != R_NilValue) { R_ReleaseObject(this->result); } this->result = new_result; R_PreserveObject(this->result); UNPROTECT(1); } } void resultAppend(const std::string& item) { this->resultEnsureSize(); SET_STRING_ELT(this->result, this->feat_id, Rf_mkCharLen(item.data(), item.size())); this->feat_id++; } void resultAppendNull() { this->resultEnsureSize(); SET_STRING_ELT(this->result, this->feat_id, NA_STRING); this->feat_id++; } bool isNestingCollection() { return this->stack.size() > 0 && (this->stack[this->stack.size() - 1]->geometry_type == WK_GEOMETRYCOLLECTION); } int vector_start(const wk_vector_meta_t* meta) { this->feat_id = 0; if (meta->size != WK_VECTOR_SIZE_UNKNOWN) { this->resultInit(meta->size); } else { this->resultInit(1024); } return WK_CONTINUE; } virtual int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id) { out.str(""); this->stack.clear(); return WK_CONTINUE; } virtual int null_feature() { this->resultAppendNull(); return WK_ABORT_FEATURE; } int geometry_start(const wk_meta_t* meta, uint32_t part_id) { if ((part_id != 0) && (this->stack.size() > 0)) { out << ", "; } if ((meta->srid != WK_SRID_NONE) && (this->stack.size() == 0)) { out << "SRID=" << meta->srid << ";"; } if ((this->stack.size() == 0) || this->isNestingCollection()) { switch (meta->geometry_type) { case WK_POINT: out << "POINT "; break; case WK_LINESTRING: out << "LINESTRING "; break; case WK_POLYGON: out << "POLYGON "; break; case WK_MULTIPOINT: out << "MULTIPOINT "; break; case WK_MULTILINESTRING: out << "MULTILINESTRING "; break; case WK_MULTIPOLYGON: out << "MULTIPOLYGON "; break; case WK_GEOMETRYCOLLECTION: out << "GEOMETRYCOLLECTION "; break; default: std::stringstream err; err << "Can't write geometry type '" << meta->geometry_type << "' as WKT"; return this->error(err.str().c_str()); } if ((meta->size != 0) &&(meta->flags & WK_FLAG_HAS_Z) && (meta->flags & WK_FLAG_HAS_M)) { out << "ZM "; } else if ((meta->size != 0) && (meta->flags & WK_FLAG_HAS_Z)) { out << "Z "; } else if ((meta->size != 0) && (meta->flags & WK_FLAG_HAS_M)) { out << "M "; } } if (meta->size == 0) { out << "EMPTY"; } else { out << "("; } this->stack.push_back(meta); return WK_CONTINUE; } int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id) { if (ring_id > 0) { out << ", "; } out << "("; return WK_CONTINUE; } virtual int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id) { if (coord_id > 0) { out << ", "; } out << coord[0] << " " << coord[1]; if ((meta->flags & WK_FLAG_HAS_Z) && (meta->flags & WK_FLAG_HAS_M)) { out << " " << coord[2] << " " << coord[3]; } else if ((meta->flags & WK_FLAG_HAS_Z) || (meta->flags & WK_FLAG_HAS_M)) { out << " " << coord[2]; } return WK_CONTINUE; } int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id) { out << ")"; return WK_CONTINUE; } int geometry_end(const wk_meta_t* meta, uint32_t part_id) { this->stack.pop_back(); if (meta->size != 0) { out << ")"; } return WK_CONTINUE; } int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id) { current_item = this->out.str(); this->resultAppend(current_item); return WK_CONTINUE; } virtual SEXP vector_end(const wk_vector_meta_t* meta) { if (this->result != R_NilValue) { this->resultFinalize(); SEXP cls = PROTECT(Rf_allocVector(STRSXP, 2)); SET_STRING_ELT(cls, 0, Rf_mkChar("wk_wkt")); SET_STRING_ELT(cls, 1, Rf_mkChar("wk_vctr")); Rf_setAttrib(this->result, R_ClassSymbol, cls); UNPROTECT(1); } return this->result; } void deinitialize() { if (this->result != R_NilValue) { R_ReleaseObject(this->result); this->result = R_NilValue; } } }; class WKTFormatHandler: public WKTWriterHandler { public: WKTFormatHandler(int precision, bool trim, int max_coords): WKTWriterHandler(precision, trim), current_coords(0), max_coords(max_coords) {} int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id) { this->current_coords = 0; return WKTWriterHandler::feature_start(meta, feat_id); } int null_feature() { this->out << ""; return WK_CONTINUE; } int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id) { WKTWriterHandler::coord(meta, coord, coord_id); if (++this->current_coords >= this->max_coords) { this->out << "..."; this->current_item = this->out.str(); this->resultAppend(this->current_item); return WK_ABORT_FEATURE; } else { return WK_CONTINUE; } } int error(const char* message) { this->out << "!!! " << message; this->current_item = this->out.str(); this->resultAppend(this->current_item); return WK_ABORT_FEATURE; } SEXP vector_end(const wk_vector_meta_t* meta) { if (this->result != R_NilValue) { this->resultFinalize(); } return this->result; } private: int current_coords; int max_coords; }; extern "C" SEXP wk_c_wkt_writer(SEXP precision_sexp, SEXP trim_sexp) { int precision = INTEGER(precision_sexp)[0]; int trim = LOGICAL(trim_sexp)[0]; return WKHandlerFactory::create_xptr(new WKTWriterHandler(precision, trim)); } extern "C" SEXP wk_c_wkt_formatter(SEXP precision_sexp, SEXP trim_sexp, SEXP max_coords_sexp) { int precision = INTEGER(precision_sexp)[0]; int trim = LOGICAL(trim_sexp)[0]; int max_coords = INTEGER(max_coords_sexp)[0]; return WKHandlerFactory::create_xptr(new WKTFormatHandler(precision, trim, max_coords)); } wk/src/vctr.c0000644000176200001440000000131114160224271012577 0ustar liggesusers#define R_NO_REMAP #include #include SEXP wk_c_wkb_is_na(SEXP geom) { R_xlen_t size = Rf_xlength(geom); SEXP result = PROTECT(Rf_allocVector(LGLSXP, size)); int* pResult = LOGICAL(result); for (R_xlen_t i = 0; i < size; i++) { pResult[i] = VECTOR_ELT(geom, i) == R_NilValue; } UNPROTECT(1); return result; } SEXP wk_c_wkb_is_raw_or_null(SEXP geom) { R_xlen_t size = Rf_xlength(geom); SEXP result = PROTECT(Rf_allocVector(LGLSXP, size)); int* pResult = LOGICAL(result); int typeOf; for (R_xlen_t i = 0; i < size; i++) { typeOf = TYPEOF(VECTOR_ELT(geom, i)); pResult[i] = (typeOf == NILSXP) || (typeOf == RAWSXP); } UNPROTECT(1); return result; } wk/src/vertex-filter.c0000644000176200001440000002254014106220314014422 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result != WK_CONTINUE) return result typedef struct { wk_handler_t* next; wk_vector_meta_t vector_meta; wk_meta_t meta; int add_details; SEXP details; int* details_ptr[3]; R_xlen_t details_size; int feature_id; int part_id; int ring_id; R_xlen_t coord_id; } vertex_filter_t; static inline void wk_vertex_filter_init_details(vertex_filter_t* vertex_filter, R_xlen_t initial_size) { if (!vertex_filter->add_details) { return; } if (initial_size == WK_VECTOR_SIZE_UNKNOWN) { initial_size = 1024; } vertex_filter->feature_id = -1; vertex_filter->part_id = -1; vertex_filter->ring_id = -1; if (vertex_filter->details != R_NilValue) { R_ReleaseObject(vertex_filter->details); // # nocov } const char* names[] = {"feature_id", "part_id", "ring_id", ""}; vertex_filter->details = PROTECT(Rf_mkNamed(VECSXP, names)); R_PreserveObject(vertex_filter->details); UNPROTECT(1); vertex_filter->details_size = initial_size; for (int i = 0; i < 3; i++) { SEXP item = PROTECT(Rf_allocVector(INTSXP, vertex_filter->details_size)); SET_VECTOR_ELT(vertex_filter->details, i, item); vertex_filter->details_ptr[i] = INTEGER(item); UNPROTECT(1); } } static inline void wk_vertex_filter_append_details(vertex_filter_t* vertex_filter) { if (vertex_filter->details == R_NilValue) { return; } if (vertex_filter->coord_id >= vertex_filter->details_size) { R_xlen_t new_size = vertex_filter->details_size * 2 + 1; for (int i = 0; i < 3; i++) { SEXP new_item = PROTECT(Rf_allocVector(INTSXP, new_size)); memcpy(INTEGER(new_item), INTEGER(VECTOR_ELT(vertex_filter->details, i)), vertex_filter->details_size * sizeof(int)); SET_VECTOR_ELT(vertex_filter->details, i, new_item); vertex_filter->details_ptr[i] = INTEGER(new_item); UNPROTECT(1); } vertex_filter->details_size = new_size; } vertex_filter->details_ptr[0][vertex_filter->coord_id] = vertex_filter->feature_id + 1; vertex_filter->details_ptr[1][vertex_filter->coord_id] = vertex_filter->part_id + 1; vertex_filter->details_ptr[2][vertex_filter->coord_id] = vertex_filter->ring_id + 1; vertex_filter->coord_id++; } static inline void wk_vertex_filter_finalize_details(vertex_filter_t* vertex_filter) { if (vertex_filter->details == R_NilValue) { return; } if (vertex_filter->coord_id != vertex_filter->details_size) { for (int i = 0; i < 3; i++) { SEXP new_item = PROTECT(Rf_allocVector(INTSXP, vertex_filter->coord_id)); memcpy(INTEGER(new_item), INTEGER(VECTOR_ELT(vertex_filter->details, i)), vertex_filter->coord_id * sizeof(int)); SET_VECTOR_ELT(vertex_filter->details, i, new_item); UNPROTECT(1); } vertex_filter->details_size = vertex_filter->coord_id; } } void wk_vertex_filter_initialize(int* dirty, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; *dirty = 1; vertex_filter->next->initialize(&vertex_filter->next->dirty, vertex_filter->next->handler_data); } int wk_vertex_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; vertex_filter->coord_id = 0; memcpy(&(vertex_filter->vector_meta), meta, sizeof(wk_vector_meta_t)); if (meta->geometry_type != WK_POINT) { vertex_filter->vector_meta.size = WK_VECTOR_SIZE_UNKNOWN; } vertex_filter->vector_meta.geometry_type = WK_POINT; wk_vertex_filter_init_details(vertex_filter, vertex_filter->vector_meta.size); return vertex_filter->next->vector_start(&(vertex_filter->vector_meta), vertex_filter->next->handler_data); } int wk_vertex_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; vertex_filter->feature_id++; return WK_CONTINUE; } int wk_vertex_filter_feature_null(void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; return vertex_filter->next->null_feature(vertex_filter->next->handler_data); } int wk_vertex_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { return WK_CONTINUE; } int wk_vertex_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; vertex_filter->part_id++; memcpy(&(vertex_filter->meta), meta, sizeof(wk_meta_t)); vertex_filter->meta.geometry_type = WK_POINT; vertex_filter->meta.flags &= ~WK_FLAG_HAS_BOUNDS; vertex_filter->meta.size = WK_SIZE_UNKNOWN; return WK_CONTINUE; } int wk_vertex_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { return WK_CONTINUE; } int wk_vertex_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; vertex_filter->ring_id++; return WK_CONTINUE; } int wk_vertex_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { return WK_CONTINUE; } int wk_vertex_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; int result; wk_vertex_filter_append_details(vertex_filter); HANDLE_OR_RETURN(vertex_filter->next->feature_start(&(vertex_filter->vector_meta), vertex_filter->coord_id, vertex_filter->next->handler_data)); HANDLE_OR_RETURN(vertex_filter->next->geometry_start(&(vertex_filter->meta), WK_PART_ID_NONE, vertex_filter->next->handler_data)); HANDLE_OR_RETURN(vertex_filter->next->coord(&(vertex_filter->meta), coord, 0, vertex_filter->next->handler_data)); HANDLE_OR_RETURN(vertex_filter->next->geometry_end(&(vertex_filter->meta), WK_PART_ID_NONE, vertex_filter->next->handler_data)); HANDLE_OR_RETURN(vertex_filter->next->feature_end(&(vertex_filter->vector_meta), vertex_filter->coord_id, vertex_filter->next->handler_data)); return WK_CONTINUE; } SEXP wk_vertex_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; SEXP result = PROTECT(vertex_filter->next->vector_end(&(vertex_filter->vector_meta), vertex_filter->next->handler_data)); if (result != R_NilValue) { wk_vertex_filter_finalize_details(vertex_filter); Rf_setAttrib(result, Rf_install("wk_details"), vertex_filter->details); } UNPROTECT(1); return result; } int wk_vertex_filter_error(const char* message, void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; return vertex_filter->next->error(message, vertex_filter->next->handler_data); } void wk_vertex_filter_deinitialize(void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; if (vertex_filter->details != R_NilValue) { R_ReleaseObject(vertex_filter->details); vertex_filter->details = R_NilValue; } vertex_filter->next->deinitialize(vertex_filter->next->handler_data); } void wk_vertex_filter_finalize(void* handler_data) { vertex_filter_t* vertex_filter = (vertex_filter_t*) handler_data; if (vertex_filter != NULL) { // finalizer for vertex_filter->next is run by the externalptr finalizer // and should not be called here free(vertex_filter); } } SEXP wk_c_vertex_filter_new(SEXP handler_xptr, SEXP add_details) { wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_vertex_filter_initialize; handler->vector_start = &wk_vertex_filter_vector_start; handler->vector_end = &wk_vertex_filter_vector_end; handler->feature_start = &wk_vertex_filter_feature_start; handler->null_feature = &wk_vertex_filter_feature_null; handler->feature_end = &wk_vertex_filter_feature_end; handler->geometry_start = &wk_vertex_filter_geometry_start; handler->geometry_end = &wk_vertex_filter_geometry_end; handler->ring_start = &wk_vertex_filter_ring_start; handler->ring_end = &wk_vertex_filter_ring_end; handler->coord = &wk_vertex_filter_coord; handler->error = &wk_vertex_filter_error; handler->deinitialize = &wk_vertex_filter_deinitialize; handler->finalizer = &wk_vertex_filter_finalize; vertex_filter_t* vertex_filter = (vertex_filter_t*) malloc(sizeof(vertex_filter_t)); if (vertex_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } vertex_filter->next = R_ExternalPtrAddr(handler_xptr); if (vertex_filter->next->api_version != 1) { Rf_error("Can't run a wk_handler with api_version '%d'", vertex_filter->next->api_version); // # nocov } WK_VECTOR_META_RESET(vertex_filter->vector_meta, WK_GEOMETRY); vertex_filter->add_details = LOGICAL(add_details)[0]; vertex_filter->details = R_NilValue; vertex_filter->details_size = 0; vertex_filter->coord_id = 0; vertex_filter->feature_id = 0; vertex_filter->part_id = 0; vertex_filter->ring_id = 0; handler->handler_data = vertex_filter; // include the external pointer as a tag for this external pointer // which guarnatees that it will not be garbage collected until // this object is garbage collected return wk_handler_create_xptr(handler, handler_xptr, R_NilValue); } wk/src/make-linestring-filter.c0000644000176200001440000002205414151152004016176 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" #include "altrep.h" #define HANDLE_OR_RETURN(expr) \ result = expr; \ if (result == WK_ABORT_FEATURE) { \ Rf_error("wk_linestring_filter() does not support WK_ABORT_FEATURE"); \ } \ if (result != WK_CONTINUE) return result typedef struct { wk_handler_t* next; R_xlen_t feature_id; SEXP feature_id_sexp; #ifndef HAS_ALTREP int* feature_id_spec; #endif R_xlen_t n_feature_id_spec; int last_feature_id_spec; int is_new_feature; R_xlen_t feature_id_out; uint32_t coord_id; wk_meta_t meta; wk_vector_meta_t vector_meta; } linestring_filter_t; static inline int wk_linestring_start(linestring_filter_t* linestring_filter) { int result; linestring_filter->feature_id_out++; HANDLE_OR_RETURN(linestring_filter->next->feature_start(&(linestring_filter->vector_meta), linestring_filter->feature_id_out, linestring_filter->next->handler_data)); HANDLE_OR_RETURN(linestring_filter->next->geometry_start(&(linestring_filter->meta), WK_PART_ID_NONE, linestring_filter->next->handler_data)); linestring_filter->coord_id = 0; return WK_CONTINUE; } static inline int wk_linestring_end(linestring_filter_t* linestring_filter) { int result; HANDLE_OR_RETURN(linestring_filter->next->geometry_end(&(linestring_filter->meta), WK_PART_ID_NONE, linestring_filter->next->handler_data)); HANDLE_OR_RETURN(linestring_filter->next->feature_end(&(linestring_filter->vector_meta), linestring_filter->feature_id_out, linestring_filter->next->handler_data)); return WK_CONTINUE; } void wk_linestring_filter_initialize(int* dirty, void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; *dirty = 1; linestring_filter->next->initialize(&linestring_filter->next->dirty, linestring_filter->next->handler_data); } int wk_linestring_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; linestring_filter->feature_id = -1; linestring_filter->feature_id_out = -1; memcpy(&(linestring_filter->vector_meta), meta, sizeof(wk_vector_meta_t)); linestring_filter->vector_meta.geometry_type = WK_LINESTRING; linestring_filter->vector_meta.size = WK_VECTOR_SIZE_UNKNOWN; WK_META_RESET(linestring_filter->meta, WK_LINESTRING); return linestring_filter->next->vector_start(&(linestring_filter->vector_meta), linestring_filter->next->handler_data); } int wk_linestring_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; linestring_filter->feature_id++; R_xlen_t spec_i = linestring_filter->feature_id % linestring_filter->n_feature_id_spec; #ifdef HAS_ALTREP int feature_id_spec = INTEGER_ELT(linestring_filter->feature_id_sexp, spec_i); #else int feature_id_spec = linestring_filter->feature_id_spec[spec_i]; #endif int feature_id_spec_changed = feature_id_spec != linestring_filter->last_feature_id_spec; linestring_filter->last_feature_id_spec = feature_id_spec; linestring_filter->is_new_feature = feature_id_spec_changed || (linestring_filter->feature_id == 0); return WK_CONTINUE; } int wk_linestring_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; int result; if (linestring_filter->is_new_feature) { if (linestring_filter->feature_id_out >= 0) { HANDLE_OR_RETURN(wk_linestring_end(linestring_filter)); } linestring_filter->meta.flags = meta->flags; linestring_filter->meta.flags &= ~WK_FLAG_HAS_BOUNDS; linestring_filter->meta.precision = meta->precision; linestring_filter->meta.srid = meta->srid; HANDLE_OR_RETURN(wk_linestring_start(linestring_filter)); linestring_filter->is_new_feature = 0; } else { // check dimensions againist current meta because handlers make the assumption // that all coordinates passed have the same dimension for a single geometry int diff_z = (linestring_filter->meta.flags & WK_FLAG_HAS_Z) ^ (meta->flags & WK_FLAG_HAS_Z); int diff_m = (linestring_filter->meta.flags & WK_FLAG_HAS_M) ^ (meta->flags & WK_FLAG_HAS_M); int diff_srid = linestring_filter->meta.srid != meta->srid; if (diff_z || diff_m || diff_srid) { Rf_error("Can't create linestring using geometries with differing dimensions or SRID"); } } HANDLE_OR_RETURN(linestring_filter->next->coord(&(linestring_filter->meta), coord, linestring_filter->coord_id, linestring_filter->next->handler_data)); linestring_filter->coord_id++; return WK_CONTINUE; } SEXP wk_linestring_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; // if there weren't any features we need to start one int result = WK_CONTINUE; if (linestring_filter->feature_id_out == -1) { linestring_filter->meta.size = 0; result = wk_linestring_start(linestring_filter); } if (result != WK_ABORT) { wk_linestring_end(linestring_filter); } return linestring_filter->next->vector_end(&(linestring_filter->vector_meta), linestring_filter->next->handler_data); } int wk_linestring_filter_feature_null(void* handler_data) { return WK_CONTINUE; } int wk_linestring_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { return WK_CONTINUE; } int wk_linestring_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { return WK_CONTINUE; } int wk_linestring_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { return WK_CONTINUE; } int wk_linestring_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { return WK_CONTINUE; } int wk_linestring_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { return WK_CONTINUE; } int wk_linestring_filter_error(const char* message, void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; int result; HANDLE_OR_RETURN(linestring_filter->next->error(message, linestring_filter->next->handler_data)); return WK_CONTINUE; } void wk_linestring_filter_deinitialize(void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; linestring_filter->next->deinitialize(linestring_filter->next->handler_data); } void wk_linestring_filter_finalize(void* handler_data) { linestring_filter_t* linestring_filter = (linestring_filter_t*) handler_data; if (linestring_filter != NULL) { // finalizer for linestring_filter->next is run by the externalptr finalizer // and should not be called here free(linestring_filter); } } SEXP wk_c_linestring_filter_new(SEXP handler_xptr, SEXP feature_id) { #ifndef HAS_ALTREP int* feature_id_spec = INTEGER(feature_id); #endif wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_linestring_filter_initialize; handler->vector_start = &wk_linestring_filter_vector_start; handler->vector_end = &wk_linestring_filter_vector_end; handler->feature_start = &wk_linestring_filter_feature_start; handler->null_feature = &wk_linestring_filter_feature_null; handler->feature_end = &wk_linestring_filter_feature_end; handler->geometry_start = &wk_linestring_filter_geometry_start; handler->geometry_end = &wk_linestring_filter_geometry_end; handler->ring_start = &wk_linestring_filter_ring_start; handler->ring_end = &wk_linestring_filter_ring_end; handler->coord = &wk_linestring_filter_coord; handler->error = &wk_linestring_filter_error; handler->deinitialize = &wk_linestring_filter_deinitialize; handler->finalizer = &wk_linestring_filter_finalize; linestring_filter_t* linestring_filter = (linestring_filter_t*) malloc(sizeof(linestring_filter_t)); if (linestring_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } linestring_filter->next = (wk_handler_t*) R_ExternalPtrAddr(handler_xptr); if (linestring_filter->next->api_version != 1) { wk_handler_destroy(handler); // # nocov free(linestring_filter); Rf_error("Can't run a wk_handler with api_version '%d'", linestring_filter->next->api_version); // # nocov } linestring_filter->coord_id = 0; linestring_filter->feature_id = -1; linestring_filter->feature_id_out = 0; linestring_filter->feature_id_sexp = feature_id; #ifndef HAS_ALTREP linestring_filter->feature_id_spec = feature_id_spec; #endif linestring_filter->n_feature_id_spec = Rf_xlength(feature_id); linestring_filter->is_new_feature = 0; linestring_filter->last_feature_id_spec = NA_INTEGER; handler->handler_data = linestring_filter; // We need both the external pointer SEXP and the feature_id SEXP // to be valid for the lifetime of this object return wk_handler_create_xptr(handler, handler_xptr, feature_id); } wk/src/port.h0000644000176200001440000000355514147552730012637 0ustar liggesusers // Endian tools ----------------------------- #include // for WORDS_BIGENDIAN // IS_LITTLE_ENDIAN, IS_BIG_ENDIAN #if defined(WORDS_BIGENDIAN) #define IS_BIG_ENDIAN #undef IS_LITTLE_ENDIAN #else #define IS_LITTLE_ENDIAN #undef IS_BIG_ENDIAN #endif // The following guarantees declaration of the byte swap functions // (bswap_16, bswap_32, bswap_64). // from s2 library port.h #if defined(_WIN32) #ifdef __cplusplus #include #else #include #endif #define bswap_16(x) _byteswap_ushort(x) #define bswap_32(x) _byteswap_ulong(x) #define bswap_64(x) _byteswap_uint64(x) #elif defined(__APPLE__) // Mac OS X / Darwin features #include #define bswap_16(x) OSSwapInt16(x) #define bswap_32(x) OSSwapInt32(x) #define bswap_64(x) OSSwapInt64(x) #elif defined(__GLIBC__) || defined(__BIONIC__) || defined(__ASYLO__) #include // IWYU pragma: export #else #ifdef __cplusplus #include #else #include #endif static inline uint16_t bswap_16(uint16_t x) { #ifdef __cplusplus return static_cast(((x & 0xFF) << 8) | ((x & 0xFF00) >> 8)); #else return (uint16_t)(((x & 0xFF) << 8) | ((x & 0xFF00) >> 8)); // NOLINT #endif // __cplusplus } #define bswap_16(x) bswap_16(x) static inline uint32_t bswap_32(uint32_t x) { return (((x & 0xFF) << 24) | ((x & 0xFF00) << 8) | ((x & 0xFF0000) >> 8) | ((x & 0xFF000000) >> 24)); } #define bswap_32(x) bswap_32(x) static inline uint64_t bswap_64(uint64_t x) { return (((x & 0xFFULL) << 56) | ((x & 0xFF00ULL) << 40) | ((x & 0xFF0000ULL) << 24) | ((x & 0xFF000000ULL) << 8) | ((x & 0xFF00000000ULL) >> 8) | ((x & 0xFF0000000000ULL) >> 24) | ((x & 0xFF000000000000ULL) >> 40) | ((x & 0xFF00000000000000ULL) >> 56)); } #define bswap_64(x) bswap_64(x) #endif wk/src/meta-handler.c0000644000176200001440000001676514106220314014177 0ustar liggesusers #define R_NO_REMAP #include #include #include "wk-v1.h" #include #include typedef struct { SEXP result; R_xlen_t result_size; R_xlen_t feat_id; } meta_handler_t; SEXP meta_handler_alloc_result(R_xlen_t size) { const char* names[] = {"geometry_type", "size", "has_z", "has_m", "srid", "precision", ""}; SEXP result = PROTECT(Rf_mkNamed(VECSXP, names)); SET_VECTOR_ELT(result, 0, Rf_allocVector(INTSXP, size)); SET_VECTOR_ELT(result, 1, Rf_allocVector(INTSXP, size)); SET_VECTOR_ELT(result, 2, Rf_allocVector(LGLSXP, size)); SET_VECTOR_ELT(result, 3, Rf_allocVector(LGLSXP, size)); SET_VECTOR_ELT(result, 4, Rf_allocVector(INTSXP, size)); SET_VECTOR_ELT(result, 5, Rf_allocVector(REALSXP, size)); UNPROTECT(1); return result; } SEXP meta_handler_realloc_result(SEXP result, R_xlen_t new_size) { SEXP new_result = PROTECT(meta_handler_alloc_result(new_size)); R_xlen_t size_cpy; if (Rf_xlength(VECTOR_ELT(result, 0)) < new_size) { size_cpy = Rf_xlength(VECTOR_ELT(result, 0)); } else { size_cpy = new_size; } memcpy(INTEGER(VECTOR_ELT(new_result, 0)), INTEGER(VECTOR_ELT(result, 0)), sizeof(int) * size_cpy); memcpy(INTEGER(VECTOR_ELT(new_result, 1)), INTEGER(VECTOR_ELT(result, 1)), sizeof(int) * size_cpy); memcpy(LOGICAL(VECTOR_ELT(new_result, 2)), LOGICAL(VECTOR_ELT(result, 2)), sizeof(int) * size_cpy); memcpy(LOGICAL(VECTOR_ELT(new_result, 3)), LOGICAL(VECTOR_ELT(result, 3)), sizeof(int) * size_cpy); memcpy(INTEGER(VECTOR_ELT(new_result, 4)), INTEGER(VECTOR_ELT(result, 4)), sizeof(int) * size_cpy); memcpy(REAL(VECTOR_ELT(new_result, 5)), REAL(VECTOR_ELT(result, 5)), sizeof(double) * size_cpy); UNPROTECT(1); return new_result; } static inline void meta_handler_result_append(meta_handler_t* data, int geometry_type, int size, int has_z, int has_m, int srid, double precision) { if (data->feat_id >= data->result_size) { SEXP new_result = PROTECT(meta_handler_realloc_result(data->result, data->feat_id * 2 + 1)); R_ReleaseObject(data->result); data->result = new_result; R_PreserveObject(data->result); UNPROTECT(1); data->result_size = data->feat_id * 2 + 1; } INTEGER(VECTOR_ELT(data->result, 0))[data->feat_id] = geometry_type; INTEGER(VECTOR_ELT(data->result, 1))[data->feat_id] = size; LOGICAL(VECTOR_ELT(data->result, 2))[data->feat_id] = has_z; LOGICAL(VECTOR_ELT(data->result, 3))[data->feat_id] = has_m; INTEGER(VECTOR_ELT(data->result, 4))[data->feat_id] = srid; REAL(VECTOR_ELT(data->result, 5))[data->feat_id] = precision; data->feat_id++; } int meta_handler_vector_start(const wk_vector_meta_t* meta, void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; if (data->result != R_NilValue) { Rf_error("Destination vector was already allocated"); // # nocov } if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { data->result = PROTECT(meta_handler_alloc_result(1024)); data->result_size = 1024; } else { data->result = PROTECT(meta_handler_alloc_result(meta->size)); data->result_size = meta->size; } R_PreserveObject(data->result); UNPROTECT(1); return WK_CONTINUE; } int meta_handler_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; data->feat_id = feat_id; return WK_CONTINUE; } int meta_handler_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; int result_size; if (meta->size == WK_SIZE_UNKNOWN) { result_size = NA_INTEGER; } else { result_size = meta->size; } int result_srid; if (meta->srid == WK_SRID_NONE) { result_srid = NA_INTEGER; } else { result_srid = meta->srid; } meta_handler_result_append( data, meta->geometry_type, result_size, (meta->flags & WK_FLAG_HAS_Z) != 0, (meta->flags & WK_FLAG_HAS_M) != 0, result_srid, meta->precision ); return WK_ABORT_FEATURE; } int meta_handler_null_feature(void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; meta_handler_result_append( data, NA_INTEGER, NA_INTEGER, NA_LOGICAL, NA_LOGICAL, NA_INTEGER, NA_REAL ); return WK_ABORT_FEATURE; } SEXP meta_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; if (data->result_size != data->feat_id) { SEXP new_result = PROTECT(meta_handler_realloc_result(data->result, data->feat_id)); R_ReleaseObject(data->result); data->result = R_NilValue; UNPROTECT(1); return new_result; } else { return data->result; } } void meta_handler_deinitialize(void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; if (data->result != R_NilValue) { R_ReleaseObject(data->result); data->result = R_NilValue; } } void meta_handler_finalize(void* handler_data) { meta_handler_t* data = (meta_handler_t*) handler_data; if (data != NULL) { free(data); } } SEXP wk_c_meta_handler_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &meta_handler_vector_start; handler->feature_start = &meta_handler_feature_start; handler->null_feature = &meta_handler_null_feature; handler->geometry_start = &meta_handler_geometry_start; handler->vector_end = &meta_handler_vector_end; handler->deinitialize = &meta_handler_deinitialize; handler->finalizer = &meta_handler_finalize; meta_handler_t* data = (meta_handler_t*) malloc(sizeof(meta_handler_t)); if (data == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } data->feat_id = 0; data->result = R_NilValue; handler->handler_data = data; SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); return xptr; } int vector_meta_handler_vector_start(const wk_vector_meta_t* meta, void* handler_data) { return WK_ABORT; } SEXP vector_meta_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { const char* names[] = {"geometry_type", "size", "has_z", "has_m", ""}; SEXP result = PROTECT(Rf_mkNamed(VECSXP, names)); SET_VECTOR_ELT(result, 0, Rf_ScalarInteger(meta->geometry_type)); if (meta->size == WK_VECTOR_SIZE_UNKNOWN) { SET_VECTOR_ELT(result, 1, Rf_ScalarReal(NA_REAL)); } else { SET_VECTOR_ELT(result, 1, Rf_ScalarReal(meta->size)); } if (meta->flags & WK_FLAG_DIMS_UNKNOWN) { SET_VECTOR_ELT(result, 2, Rf_ScalarLogical(NA_LOGICAL)); SET_VECTOR_ELT(result, 3, Rf_ScalarLogical(NA_LOGICAL)); } else { SET_VECTOR_ELT(result, 2, Rf_ScalarLogical((meta->flags & WK_FLAG_HAS_Z) != 0)); SET_VECTOR_ELT(result, 3, Rf_ScalarLogical((meta->flags & WK_FLAG_HAS_M) != 0)); } UNPROTECT(1); return result; } SEXP wk_c_vector_meta_handler_new() { wk_handler_t* handler = wk_handler_create(); handler->vector_start = &vector_meta_handler_vector_start; handler->vector_end = &vector_meta_handler_vector_end; SEXP xptr = wk_handler_create_xptr(handler, R_NilValue, R_NilValue); return xptr; } wk/src/wk-v1.c0000644000176200001440000000003114106220314012556 0ustar liggesusers #include "wk-v1-impl.c" wk/src/identity-filter.c0000644000176200001440000001260114106220314014733 0ustar liggesusers#define R_NO_REMAP #include #include #include "wk-v1.h" typedef struct { wk_handler_t* next; } identity_filter_t; void wk_identity_filter_initialize(int* dirty, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; *dirty = 1; identity_filter->next->initialize(&identity_filter->next->dirty, identity_filter->next->handler_data); } int wk_identity_filter_vector_start(const wk_vector_meta_t* meta, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->vector_start(meta, identity_filter->next->handler_data); } SEXP wk_identity_filter_vector_end(const wk_vector_meta_t* meta, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->vector_end(meta, identity_filter->next->handler_data); } int wk_identity_filter_feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->feature_start(meta, feat_id, identity_filter->next->handler_data); } int wk_identity_filter_feature_null(void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->null_feature(identity_filter->next->handler_data); } int wk_identity_filter_feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->feature_end(meta, feat_id, identity_filter->next->handler_data); } int wk_identity_filter_geometry_start(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->geometry_start(meta, part_id, identity_filter->next->handler_data); } int wk_identity_filter_geometry_end(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->geometry_end(meta, part_id, identity_filter->next->handler_data); } int wk_identity_filter_ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->ring_start(meta, size, ring_id, identity_filter->next->handler_data); } int wk_identity_filter_ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->ring_end(meta, size, ring_id, identity_filter->next->handler_data); } int wk_identity_filter_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->coord(meta, coord, coord_id, identity_filter->next->handler_data); } int wk_identity_filter_error(const char* message, void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; return identity_filter->next->error(message, identity_filter->next->handler_data); } void wk_identity_filter_deinitialize(void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; identity_filter->next->deinitialize(identity_filter->next->handler_data); } void wk_identity_filter_finalize(void* handler_data) { identity_filter_t* identity_filter = (identity_filter_t*) handler_data; if (identity_filter != NULL) { // finalizer for identity_filter->next is run by the externalptr finalizer // and should not be called here free(identity_filter); } } SEXP wk_c_identity_filter_new(SEXP handler_xptr) { wk_handler_t* handler = wk_handler_create(); handler->initialize = &wk_identity_filter_initialize; handler->vector_start = &wk_identity_filter_vector_start; handler->vector_end = &wk_identity_filter_vector_end; handler->feature_start = &wk_identity_filter_feature_start; handler->null_feature = &wk_identity_filter_feature_null; handler->feature_end = &wk_identity_filter_feature_end; handler->geometry_start = &wk_identity_filter_geometry_start; handler->geometry_end = &wk_identity_filter_geometry_end; handler->ring_start = &wk_identity_filter_ring_start; handler->ring_end = &wk_identity_filter_ring_end; handler->coord = &wk_identity_filter_coord; handler->error = &wk_identity_filter_error; handler->deinitialize = &wk_identity_filter_deinitialize; handler->finalizer = &wk_identity_filter_finalize; identity_filter_t* identity_filter = (identity_filter_t*) malloc(sizeof(identity_filter_t)); if (identity_filter == NULL) { wk_handler_destroy(handler); // # nocov Rf_error("Failed to alloc handler data"); // # nocov } identity_filter->next = R_ExternalPtrAddr(handler_xptr); if (identity_filter->next->api_version != 1) { Rf_error("Can't run a wk_handler with api_version '%d'", identity_filter->next->api_version); // # nocov } handler->handler_data = identity_filter; // include the external pointer as a tag for this external pointer // which guarnatees that it will not be garbage collected until // this object is garbage collected return wk_handler_create_xptr(handler, handler_xptr, R_NilValue); } wk/src/altrep.h0000644000176200001440000000151314151152004013113 0ustar liggesusers #include "Rversion.h" #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) #define HAS_ALTREP #endif #if defined(HAS_ALTREP) #if R_VERSION < R_Version(3, 6, 0) // workaround because R's not so conveniently uses `class` // as a variable name, and C++ is not happy about that // // SEXP R_new_altrep(R_altrep_class_t class, SEXP data1, SEXP data2); // #define class klass // Because functions declared in have C linkage #ifdef __cplusplus extern "C" { #endif #include #ifdef __cplusplus } #endif // undo the workaround #undef class #else #include #endif #if (defined(R_VERSION) && R_VERSION >= R_Version(3, 6, 0)) #define HAS_ALTREP_RAW #endif #endif #define ALTREP_CHUNK_SIZE 1024 // uncomment to force a check without ALTREP defines // #undef HAS_ALTREP wk/R/0000755000176200001440000000000014163210157011074 5ustar liggesuserswk/R/set.R0000644000176200001440000000342614125354157012026 0ustar liggesusers #' Set coordinate values #' #' @inheritParams wk_handle #' @param z,m A vector of Z or M values applied feature-wise and recycled #' along `handleable`. Use `NA` to keep the existing value of a given #' feature. #' @param value An [xy()], [xyz()], [xym()], or [xyzm()] of coordinates #' used to replace values in the input. Use `NA` to keep the existing #' value. #' @param use_z,use_m Used to declare the output type. Use `TRUE` to #' ensure the output has that dimension, `FALSE` to ensure it does not, #' and `NA` to leave the dimension unchanged. #' #' @export #' #' @examples #' wk_set_z(wkt("POINT (0 1)"), 2) #' wk_set_m(wkt("POINT (0 1)"), 2) #' wk_drop_z(wkt("POINT ZM (0 1 2 3)")) #' wk_drop_m(wkt("POINT ZM (0 1 2 3)")) #' wk_set_z <- function(handleable, z, ...) { wk_set_base(handleable, wk_trans_set(xyz(NA, NA, z), use_z = TRUE), ...) } #' @rdname wk_set_z #' @export wk_set_m <- function(handleable, m, ...) { wk_set_base(handleable, wk_trans_set(xym(NA, NA, m), use_m = TRUE), ...) } #' @rdname wk_set_z #' @export wk_drop_z <- function(handleable, ...) { wk_set_base(handleable, wk_trans_set(xy(NA, NA), use_z = FALSE), ...) } #' @rdname wk_set_z #' @export wk_drop_m <- function(handleable, ...) { wk_set_base(handleable, wk_trans_set(xy(NA, NA), use_m = FALSE), ...) } #' @rdname wk_set_z #' @export wk_trans_set <- function(value, use_z = NA, use_m = NA) { value <- as_xy(value) value <- as_xy(value, dims = c("x", "y", "z", "m")) new_wk_trans( .Call(wk_c_trans_set_new, value, as.logical(use_z)[1], as.logical(use_m)[1]), "wk_trans_set" ) } wk_set_base <- function(handleable, trans, ...) { result <- wk_handle(handleable, wk_transform_filter(wk_writer(handleable), trans), ...) wk_set_crs(wk_restore(handleable, result), wk_crs(handleable)) } wk/R/count.R0000644000176200001440000000211614106220314012340 0ustar liggesusers #' Count geometry components #' #' Counts the number of geometries, rings, and coordinates found within #' each feature. As opposed to [wk_meta()], this handler will iterate #' over the entire geometry. #' #' @inheritParams wk_handle #' #' @return A data.frame with one row for every feature encountered and #' columns: #' - `n_geom`: The number of geometries encountered, including the #' root geometry. Will be zero for a null feature. #' - `n_ring`: The number of rings encountered. Will be zero for a #' null feature. #' - `n_coord`: The number of coordinates encountered. Will be zero #' for a null feature. #' @export #' #' @examples #' wk_count(as_wkt("LINESTRING (0 0, 1 1)")) #' wk_count(as_wkb("LINESTRING (0 0, 1 1)")) #' wk_count <- function(handleable, ...) { UseMethod("wk_count") } #' @rdname wk_count #' @export wk_count.default <- function(handleable, ...) { new_data_frame(wk_handle(handleable, wk_count_handler(), ...)) } #' @rdname wk_count #' @export wk_count_handler <- function() { new_wk_handler(.Call(wk_c_count_handler_new), "wk_count_handler") } wk/R/make.R0000644000176200001440000000541414163110540012133 0ustar liggesusers #' Create lines, polygons, and collections #' #' @inheritParams wk_handle #' @param feature_id An identifier where changes in sequential #' values indicate a new feature. This is recycled silently #' as needed. #' @param ring_id An identifier where changes in sequential #' values indicate a new ring. Rings are automatically #' closed. This is recycled silently as needed. #' @param geometry_type The collection type to create. #' @param geodesic Use `TRUE` or `FALSE` to explicitly force #' the geodesic-ness of the output. #' #' @return An object of the same class as `handleable` with #' whose coordinates have been assembled into the given #' type. #' @export #' #' @examples #' wk_linestring(xy(c(1, 1), c(2, 3))) #' wk_polygon(xy(c(0, 1, 0), c(0, 0, 1))) #' wk_collection(xy(c(1, 1), c(2, 3))) #' wk_linestring <- function(handleable, feature_id = 1L, ..., geodesic = NULL) { writer <- wk_writer(handleable, generic = TRUE) result <- wk_handle(handleable, wk_linestring_filter(writer, as.integer(feature_id)), ...) wk_crs(result) <- wk_crs(handleable) wk_is_geodesic(result) <- geodesic %||% wk_is_geodesic(handleable) result } #' @rdname wk_linestring #' @export wk_polygon <- function(handleable, feature_id = 1L, ring_id = 1L, ..., geodesic = NULL) { writer <- wk_writer(handleable, generic = TRUE) result <- wk_handle( handleable, wk_polygon_filter( writer, as.integer(feature_id), as.integer(ring_id) ), ... ) wk_crs(result) <- wk_crs(handleable) wk_is_geodesic(result) <- geodesic %||% wk_is_geodesic(handleable) result } #' @rdname wk_linestring #' @export wk_collection <- function(handleable, geometry_type = wk_geometry_type("geometrycollection"), feature_id = 1L, ...) { writer <- wk_writer(handleable, generic = TRUE) result <- wk_handle( handleable, wk_collection_filter( writer, as.integer(geometry_type)[1], as.integer(feature_id) ), ... ) wk_set_crs(result, wk_crs(handleable)) } #' @rdname wk_linestring #' @export wk_linestring_filter <- function(handler, feature_id = 1L) { new_wk_handler( .Call(wk_c_linestring_filter_new, as_wk_handler(handler), feature_id), "wk_linestring_filter" ) } #' @rdname wk_linestring #' @export wk_polygon_filter <- function(handler, feature_id = 1L, ring_id = 1L) { new_wk_handler( .Call(wk_c_polygon_filter_new, handler, feature_id, ring_id), "wk_polygon_filter" ) } #' @rdname wk_linestring #' @export wk_collection_filter <- function(handler, geometry_type = wk_geometry_type("geometrycollection"), feature_id = 1L) { new_wk_handler( .Call(wk_c_collection_filter_new, as_wk_handler(handler), geometry_type, feature_id), "wk_collection_filter" ) } wk/R/class-data-frame.R0000644000176200001440000000663014163110540014323 0ustar liggesusers #' Use data.frame with wk #' #' @inheritParams wk_handle #' @inheritParams wk_translate #' @inheritParams wk_crs #' @inheritParams wk_identity #' @inheritParams wk_is_geodesic #' #' @export #' #' @examples #' wk_handle(data.frame(a = wkt("POINT (0 1)")), wkb_writer()) #' wk_translate(wkt("POINT (0 1)"), data.frame(col_name = wkb())) #' wk_translate(data.frame(a = wkt("POINT (0 1)")), data.frame(wkb())) #' wk_handle.data.frame <- function(handleable, handler, ...) { col <- handleable_column_name(handleable) wk_handle(handleable[[col]], handler, ...) } #' @rdname wk_handle.data.frame #' @export wk_writer.data.frame <- function(handleable, ...) { col <- handleable_column_name(handleable) wk_writer(handleable[[col]], ...) } #' @rdname wk_handle.data.frame #' @export wk_crs.data.frame <- function(x) { col <- handleable_column_name(x) wk_crs(x[[col]]) } #' @rdname wk_handle.data.frame #' @export wk_set_crs.data.frame <- function(x, crs) { col <- handleable_column_name(x) x[[col]] <- wk_set_crs(x[[col]], crs) x } #' @rdname wk_handle.data.frame #' @export wk_is_geodesic.data.frame <- function(x) { col <- handleable_column_name(x) wk_is_geodesic(x[[col]]) } #' @rdname wk_handle.data.frame #' @export wk_set_geodesic.data.frame <- function(x, geodesic) { col <- handleable_column_name(x) x[[col]] <- wk_set_geodesic(x[[col]], geodesic) x } #' @rdname wk_handle.data.frame #' @export wk_restore.data.frame <- function(handleable, result, ...) { col <- handleable_column_name(handleable) if(nrow(handleable) == length(result)) { handleable[[col]] <- result handleable } else if (nrow(handleable) == 1) { handleable <- handleable[rep(1L, length(result)), , drop = FALSE] handleable[[col]] <- result handleable } else { stop( sprintf( "Can't assign result of length %d to data frame with %d rows", length(result), nrow(handleable) ), call. = FALSE ) } } #' @rdname wk_handle.data.frame #' @export wk_restore.tbl_df <- function(handleable, result, ...) { tibble::as_tibble(wk_restore.data.frame(handleable, result, ...)) } #' @rdname wk_handle.data.frame #' @export wk_translate.data.frame <- function(handleable, to, ...) { col <- handleable_column_name(to) col_value <- wk_translate(handleable, to[[col]], ...) if (inherits(handleable, "data.frame")) { handleable_col <- handleable_column_name(handleable) attributes(handleable) <- list(names = names(handleable)) handleable[handleable_col] <- list(col_value) new_data_frame(handleable) } else { df_raw <- list(col_value) names(df_raw) <- col new_data_frame(df_raw) } } #' @rdname wk_handle.data.frame #' @export wk_translate.tbl_df <- function(handleable, to, ...) { tibble::as_tibble(wk_translate.data.frame(handleable, to, ...)) } #' @rdname wk_handle_slice #' @export wk_handle_slice.data.frame <- function(handleable, handler, from = NULL, to = NULL, ...) { handleable_col <- handleable_column_name(handleable) wk_handle_slice( handleable[[handleable_col]], handler, from = from, to = to, ... ) } handleable_column_name <- function(df) { has_method <- vapply(df, is_handleable, FUN.VALUE = logical(1)) if (!any(has_method)) { stop( "To be used with wk_handle(), a data.frame must have at least one handleable column.", call. = FALSE ) } names(df)[which(has_method)[1L]] } wk/R/pkg-sf.R0000644000176200001440000001565514155244415012427 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.sfg <- function(handleable, handler, ...) { wk_handle(sf::st_sfc(handleable), handler, ...) } #' @rdname wk_handle #' @export wk_handle.sf <- function(handleable, handler, ...) { wk_handle(sf::st_geometry(handleable), handler, ...) } #' @rdname wk_handle #' @export wk_handle.bbox <- function(handleable, handler, ...) { wk_handle(as_rct(handleable), handler, ...) } #' @rdname wk_writer #' @export wk_writer.sfc <- function(handleable, ...) { sfc_writer() } #' @rdname wk_writer #' @export wk_writer.sf <- function(handleable, ...) { sfc_writer() } #' @rdname wk_translate #' @export wk_translate.sfc <- function(handleable, to, ...) { result <- wk_handle(handleable, sfc_writer(), ...) attr(result, "crs") <- sf::st_crs(wk_crs_output(handleable, to)) result } #' @rdname wk_handle.data.frame #' @export wk_translate.sf <- function(handleable, to, ...) { col_value <- wk_handle(handleable, sfc_writer(), ...) crs_out <- sf::st_crs(wk_crs_output(handleable, to)) if (inherits(handleable, "sf")) { sf::st_geometry(handleable) <- col_value } else if (inherits(handleable, "data.frame")) { col <- handleable_column_name(handleable) handleable[col] <- list(col_value) handleable <- sf::st_as_sf(handleable, sf_column_name = col) } else { handleable <- sf::st_as_sf(data.frame(geometry = col_value)) } sf::st_crs(handleable) <- crs_out handleable } #' @rdname wk_handle.data.frame #' @export wk_restore.sf <- function(handleable, result, ...) { col <- handleable_column_name(handleable) if(nrow(handleable) == length(result)) { sf::st_geometry(handleable) <- result handleable } else if (nrow(handleable) == 1) { handleable <- handleable[rep(1L, length(result)), , drop = FALSE] sf::st_geometry(handleable) <- result handleable } else { stop( sprintf( "Can't assign result of length %d to sf with %d rows", length(result), nrow(handleable) ), call. = FALSE ) } } #' @export wk_crs.sfc <- function(x) { sf::st_crs(x) } #' @export wk_set_crs.sfc <- function(x, crs) { sf::st_crs(x) <- sf::st_crs(crs) x } #' @export wk_crs.sf <- function(x) { sf::st_crs(x) } #' @export wk_set_crs.sf <- function(x, crs) { sf::st_crs(x) <- sf::st_crs(crs) x } #' @export wk_crs.sfg <- function(x) { sf::NA_crs_ } #' @export as_wkb.sfc <- function(x, ...) { wk_translate(x, new_wk_wkb(crs = wk_crs_inherit())) } #' @export as_wkb.sfg <- function(x, ...) { wk_translate(x, new_wk_wkb(crs = wk_crs_inherit())) } #' @export wk_crs_equal_generic.crs <- function(x, y, ...) { x == sf::st_crs(y) } #' @export wk_crs_proj_definition.crs <- function(crs, proj_version = NULL, verbose = FALSE) { if (is.na(crs)) { wk_crs_proj_definition(NULL) } else if (verbose) { crs$Wkt %||% crs$wkt } else if (isTRUE(is.na(crs$epsg)) || isTRUE(grepl("^[0-9A-Za-z]+:[0-9A-Za-z]+$", crs$input))) { wk_crs_proj_definition(crs$input) } else { paste0("EPSG:", crs$epsg) } } wk_crs_from_sf <- function(x) { crs <- sf::st_crs(x) if (is.na(crs)) NULL else crs } sf_crs_from_wk <- function(x) { sf::st_crs(wk_crs(x)) } #' @export as_xy.sfc <- function(x, ...) { if (length(x) == 0) { xy(crs = wk_crs_from_sf(x)) } else if (inherits(x, "sfc_POINT")) { coords <- sf::st_coordinates(x) dims <- colnames(coords) dimnames(coords) <- NULL if (identical(dims, c("X", "Y"))) { new_wk_xy( list( x = coords[, 1, drop = TRUE], y = coords[, 2, drop = TRUE] ), crs = wk_crs_from_sf(x) ) } else if (identical(dims, c("X", "Y", "Z"))) { new_wk_xyz( list( x = coords[, 1, drop = TRUE], y = coords[, 2, drop = TRUE], z = coords[, 3, drop = TRUE] ), crs = wk_crs_from_sf(x) ) } else if (identical(dims, c("X", "Y", "M"))) { new_wk_xym( list( x = coords[, 1, drop = TRUE], y = coords[, 2, drop = TRUE], m = coords[, 3, drop = TRUE] ), crs = wk_crs_from_sf(x) ) } else if (identical(dims, c("X", "Y", "Z", "M"))) { new_wk_xyzm( list( x = coords[, 1, drop = TRUE], y = coords[, 2, drop = TRUE], z = coords[, 3, drop = TRUE], m = coords[, 4, drop = TRUE] ), crs = wk_crs_from_sf(x) ) } else { stop("Unknown dimensions.", call. = FALSE) # nocov } } else { NextMethod() } } #' @export as_rct.bbox <- function(x, ...) { x_bare <- unclass(x) new_wk_rct(as.list(x_bare[c("xmin", "ymin", "xmax", "ymax")]), crs = wk_crs_from_sf(x)) } #' @export as_wkb.sf <- function(x, ...) { as_wkb(sf::st_geometry(x), ...) } #' @export as_wkt.sf <- function(x, ...) { as_wkt(sf::st_geometry(x), ...) } #' @export as_xy.sf <- function(x, ..., dims = NULL) { as_xy(sf::st_geometry(x), ..., dims = dims) } # dynamically exported st_as_sfc.wk_wkb <- function(x, ...) { sf::st_set_crs(sf::st_as_sfc(structure(x, class = "WKB"), EWKB = TRUE), sf_crs_from_wk(x)) } st_as_sf.wk_wkb <- function(x, ...) { sf::st_as_sf( new_data_frame( list(geometry = st_as_sfc.wk_wkb(x, ...)) ) ) } st_as_sfc.wk_wkt <- function(x, ...) { sf::st_as_sfc(as_wkb(x), ...) } st_as_sf.wk_wkt <- function(x, ...) { sf::st_as_sf( new_data_frame( list(geometry = st_as_sfc.wk_wkt(x, ...)) ) ) } st_as_sfc.wk_xy <- function(x, ...) { if (all(!is.na(x))) { st_as_sf.wk_xy(x, ...)$geometry } else { sf::st_as_sfc(as_wkb(x), ...) } } st_as_sf.wk_xy <- function(x, ...) { if ((length(x) > 0) && all(!is.na(x))) { sf::st_as_sf(as.data.frame(x), coords = xy_dims(x), crs = sf_crs_from_wk(x)) } else { sf::st_as_sf( new_data_frame( list(geometry = sf::st_as_sfc(as_wkb(x), ...)) ) ) } } st_as_sfc.wk_rct <- function(x, ...) { sf::st_as_sfc(as_wkb(x, ...)) } st_as_sfc.wk_crc <- function(x, ...) { sf::st_as_sfc(as_wkb(x, ...)) } st_as_sf.wk_rct <- function(x, ...) { sf::st_as_sf( new_data_frame( list(geometry = st_as_sfc.wk_rct(x, ...)) ) ) } st_as_sf.wk_crc <- function(x, ...) { sf::st_as_sf( new_data_frame( list(geometry = st_as_sfc.wk_crc(x, ...)) ) ) } # st_geometry methods() st_geometry.wk_wkb <- function(x, ...) { st_as_sfc.wk_wkb(x, ...) } st_geometry.wk_wkt <- function(x, ...) { st_as_sfc.wk_wkt(x, ...) } st_geometry.wk_xy <- function(x, ...) { st_as_sfc.wk_xy(x, ...) } st_geometry.wk_rct <- function(x, ...) { st_as_sfc.wk_rct(x, ...) } st_geometry.wk_crc <- function(x, ...) { st_as_sfc.wk_crc(x, ...) } # st_bbox() methods st_bbox.wk_wkb <- function(x, ...) { sf::st_bbox(wk_bbox(x)) } st_bbox.wk_wkt <- function(x, ...) { sf::st_bbox(wk_bbox(x)) } st_bbox.wk_xy <- function(x, ...) { sf::st_bbox(wk_bbox(x)) } st_bbox.wk_rct <- function(x, ...) { sf::st_bbox(unlist(x), crs = wk_crs(x)) } st_bbox.wk_crc <- function(x, ...) { sf::st_bbox(wk_bbox(x)) } wk/R/utils.R0000644000176200001440000000200114151152004012341 0ustar liggesusers `%||%` <- function(x, y) { if (is.null(x)) y else x } new_data_frame <- function(x) { structure(x, row.names = c(NA, length(x[[1]])), class = "data.frame") } # rep_len became an S3 generic in R 3.6, so we need to use # something else to make sure recycle_common() works on old # R versions rep_len_compat <- function(x, length_out) { rep(x, length.out = length_out) } recycle_common <- function(...) { dots <- list(...) lengths <- vapply(dots, length, integer(1)) non_constant_lengths <- unique(lengths[lengths != 1]) if (length(non_constant_lengths) == 0) { final_length <- 1 } else if(length(non_constant_lengths) == 1) { final_length <- non_constant_lengths } else { lengths_label <- paste0(non_constant_lengths, collapse = ", ") stop(sprintf("Incompatible lengths: %s", lengths_label)) } dots[lengths != final_length] <- lapply(dots[lengths != final_length], rep_len_compat, final_length) dots } is_vector_class <- function(x) { identical(class(x[integer(0)]), class(x)) } wk/R/zzz.R0000644000176200001440000000424414161345517012067 0ustar liggesusers # nocov start .onLoad <- function(...) { # Register S3 methods for Suggests for (cls in c("wk_wkb", "wk_wkt", "wk_xy", "wk_xyz", "wk_xym", "wk_xyzm", "wk_rct", "wk_crc")) { s3_register("vctrs::vec_proxy", cls) s3_register("vctrs::vec_restore", cls) s3_register("vctrs::vec_cast", cls) s3_register("vctrs::vec_ptype2", cls) } for (cls in c("wk_wkb", "wk_wkt", "wk_xy", "wk_rct", "wk_crc")) { s3_register("sf::st_as_sfc", cls) s3_register("sf::st_as_sf", cls) s3_register("sf::st_geometry", cls) s3_register("sf::st_bbox", cls) } s3_register("readr::output_column", "wk_vctr") s3_register("readr::output_column", "wk_rcrd") } .onUnload <- function (libpath) { library.dynam.unload("wk", libpath) } s3_register <- function(generic, class, method = NULL) { stopifnot(is.character(generic), length(generic) == 1) stopifnot(is.character(class), length(class) == 1) pieces <- strsplit(generic, "::")[[1]] stopifnot(length(pieces) == 2) package <- pieces[[1]] generic <- pieces[[2]] caller <- parent.frame() get_method_env <- function() { top <- topenv(caller) if (isNamespace(top)) { asNamespace(environmentName(top)) } else { caller } } get_method <- function(method, env) { if (is.null(method)) { get(paste0(generic, ".", class), envir = get_method_env()) } else { method } } method_fn <- get_method(method) stopifnot(is.function(method_fn)) # Always register hook in case package is later unloaded & reloaded setHook( packageEvent(package, "onLoad"), function(...) { ns <- asNamespace(package) # Refresh the method, it might have been updated by `devtools::load_all()` method_fn <- get_method(method) registerS3method(generic, class, method_fn, envir = ns) } ) # Avoid registration failures during loading (pkgload or regular) if (!isNamespaceLoaded(package)) { return(invisible()) } envir <- asNamespace(package) # Only register if generic can be accessed if (exists(generic, envir)) { registerS3method(generic, class, method_fn, envir = envir) } invisible() } # nocov end wk/R/wkt.R0000644000176200001440000000534214163210157012030 0ustar liggesusers #' Mark character vectors as well-known text #' #' @param x A [character()] vector containing well-known text. #' @inheritParams new_wk_wkb #' @param ... Unused #' #' @return A [new_wk_wkt()] #' @export #' #' @examples #' wkt("POINT (20 10)") #' wkt <- function(x = character(), crs = wk_crs_auto(), geodesic = FALSE) { x <- as.character(x) crs <- wk_crs_auto_value(x, crs) wkt <- new_wk_wkt(x, crs = crs, geodesic = geodesic_attr(geodesic)) validate_wk_wkt(wkt) wkt } #' @rdname wkt #' @export parse_wkt <- function(x, crs = wk_crs_auto(), geodesic = FALSE) { x <- as.character(x) crs <- wk_crs_auto_value(x, crs) wkt <- new_wk_wkt(x, crs = crs, geodesic = geodesic_attr(geodesic)) parse_base(wkt, wk_problems(wkt)) } #' @rdname wkt #' @export as_wkt <- function(x, ...) { UseMethod("as_wkt") } #' @rdname wkt #' @export as_wkt.default <- function(x, ...) { wk_translate( x, new_wk_wkt(crs = wk_crs_inherit(), geodesic = wk_geodesic_inherit()) ) } #' @rdname wkt #' @export as_wkt.character <- function(x, ..., crs = NULL, geodesic = FALSE) { wkt(x, crs = crs, geodesic = geodesic) } #' @rdname wkt #' @export as_wkt.wk_wkt <- function(x, ...) { x } #' S3 Details for wk_wkt #' #' @param x A (possibly) [wkt()] vector #' @inheritParams new_wk_wkb #' #' @export #' new_wk_wkt <- function(x = character(), crs = NULL, geodesic = NULL) { if (typeof(x) != "character" || !is.null(attributes(x))) { stop("wkt input must be a character() without attributes", call. = FALSE) } structure(x, class = c("wk_wkt", "wk_vctr"), crs = crs, geodesic = geodesic) } #' @rdname new_wk_wkt #' @export is_wk_wkt <- function(x) { inherits(x, "wk_wkt") } #' @rdname new_wk_wkt #' @export validate_wk_wkt <- function(x) { if (typeof(x) != "character") { stop("wkt() must be of type character()", call. = FALSE) } # See #123...validate_wk_wkt() is used in CRAN s2 on a raw character vector if (!inherits(x, "wk_wkt") || !inherits(x, "wk_vctr")) { # stop('wkt() must inherit from c("wk_wkt", "wk_vctr")', call. = FALSE) attributes(x) <- NULL problems <- wk_problems(new_wk_wkt(x)) } else { problems <- wk_problems(x) } stop_for_problems(problems) invisible(x) } #' @export `[<-.wk_wkt` <- function(x, i, value) { replacement <- as_wkt(value) crs_out <- wk_crs_output(x, replacement) geodesic_out <- wk_is_geodesic_output(x, replacement) x <- unclass(x) x[i] <- replacement attr(x, "crs") <- NULL attr(x, "geodesic") <- NULL new_wk_wkt(x, crs = crs_out, geodesic = geodesic_attr(geodesic_out)) } #' @export format.wk_wkt <- function(x, ..., max_coords = 6) { wk_format(x, max_coords = max_coords) } #' @export as.character.wk_wkt <- function(x, ...) { attr(x, "crs") <- NULL unclass(x) } wk/R/handle-slice.R0000644000176200001440000000222714145575672013572 0ustar liggesusers #' Handle specific regions of objects #' #' @inheritParams wk_handle #' @param from 1-based index of the feature to start from #' @param to 1-based index of the feature to end at #' #' @return A subset of `handleable` #' @export #' #' @examples #' wk_handle_slice(xy(1:5, 1:5), wkt_writer(), from = 3, to = 5) #' wk_handle_slice( #' data.frame(let = letters[1:5], geom = xy(1:5, 1:5)), #' wkt_writer(), #' from = 3, to = 5 #' ) #' wk_handle_slice <- function(handleable, handler = wk_writer(handleable), from = NULL, to = NULL, ...) { UseMethod("wk_handle_slice") } #' @rdname wk_handle_slice #' @export wk_handle_slice.default <- function(handleable, handler = wk_writer(handleable), from = NULL, to = NULL, ...) { # make sure we're dealing with a handleable and a vector stopifnot(is_handleable(handleable), is_vector_class(handleable)) from <- from %||% 1L to <- to %||% length(handleable) from <- max(from, 1L) to <- min(to, length(handleable)) if (to >= from) { wk_handle(handleable[from:to], handler, ...) } else { wk_handle(handleable[integer(0)], handler, ...) } } wk/R/chunk.R0000644000176200001440000002124614145575672012354 0ustar liggesusers #' Operate on handleables by chunk #' #' It is often impractical, inefficient, or impossible to perform #' an operation on a vector of geometries with all the geometries loaded #' into memory at the same time. These functions generalize the pattern of #' split-apply-combine to one or more handlers recycled along a common #' length. These functions are designed for developers rather than users #' and should be considered experimental. #' #' @param handleables A single handleable or a `list()` of handleables #' recycleable along a common length. #' @param fun A function called like #' `fun(!!! transformed_handleables, !!! vector_args, !!! args)` for each chunk. #' For [wk_chunk_map_feature()] this must be length-stable (i.e., return #' a value whose size is the recycled length of handleables and vector_args #' for that chunk). #' @param vector_args Vectorized arguments to `fun`. #' @param args Non-vectorized arguments to `fun`. #' @param input_handler_factory A function of `handleable` applied to #' handleable inputs. The default, [wk_writer()], will result in `fun` #' getting called with a clone of the handleables for each chunk. Another #' useful pattern is to return a single type of handler so that all #' `handleables` have a common type. #' @param output_template A vector whose subset-assign method will #' get called for every chunk or `NULL` to ignore the output of `fun`. #' @param strategy A function of `handleables` and `n_features` #' such as that returned by [wk_chunk_strategy_feature()]. #' #' @return `output_template` of the recycled common length of `handleables` #' and `vector_args` filled with values generated by `fun`. #' @export #' #' @examples #' # apply a transformation or calculate a value using the data frame version #' # of the geometries (but without resolving all of them at once) #' wk_chunk_map_feature( #' wk_linestring(xy(1:10, 1:10), rep(1:5, each = 2)), #' function(features) { #' coords <- wk_coords(features) #' vapply(split(coords, coords$feature_id), nrow, integer(1)) #' }, #' output_template = integer() #' ) #' wk_chunk_map_feature <- function(handleables, fun, vector_args = NULL, args = NULL, input_handler_factory = wk_writer, output_template = NULL, strategy = wk_chunk_strategy_feature(chunk_size = 1e4)) { if (is_handleable(handleables)) { handleables <- list(handleables) } else if (!is.list(handleables)) { stop("`handleables` must be a list() or a single handleable", call. = FALSE) } check_is_handleable <- vapply(handleables, is_handleable, logical(1)) if (any(!check_is_handleable)) { stop("All items in `handleables` must be objects with a wk_handle() method", call. = FALSE) } stopifnot( is.function(fun), is.null(vector_args) || inherits(vector_args, "data.frame"), is.null(args) || is.list(args), is.function(input_handler_factory), is.function(strategy) ) # get the number of features vector_metas <- lapply(handleables, wk_vector_meta) sizes <- vapply(vector_metas, "[[", "size", FUN.VALUE = double(1)) sizes_unknown <- is.na(sizes) sizes[is.na(sizes)] <- vapply( handleables[is.na(sizes)], function(handleable) nrow(wk_meta(handleable)), integer(1) ) # consider vector_args as number of features if passed if (!is.null(vector_args)) { sizes <- c(sizes, nrow(vector_args)) } # calculate the recycled length all_sizes <- unique(sizes) non_one_sizes <- unique(sizes[sizes != 1L]) if ((length(all_sizes) > 1L) && (length(non_one_sizes) != 1L)) { stop( "All items in `handleables` and `vector_meta` must be recycleable to a common length.", call. = FALSE ) } n_features <- if (length(all_sizes) == 1L) all_sizes else non_one_sizes # if the recycled size is 0, don't use the chunking strategy and return early if (n_features == 0) { return(output_template[integer(0)]) } chunks <- strategy(handleables, n_features) output <- output_template[rep(NA_integer_, n_features)] for (chunk_i in seq_len(nrow(chunks))) { from <- chunks$from[chunk_i] to <- chunks$to[chunk_i] handleables_chunk <- lapply(seq_along(handleables), function(handleable_i) { handleable <- handleables[[handleable_i]] if (sizes[handleable_i] == 1L) { wk_handle(handleable, input_handler_factory(handleable)) } else { wk_handle_slice( handleable, from = from, to = to, handler = input_handler_factory(handleable) ) } }) vector_args_chunk <- if (identical(nrow(vector_args), 1L)) { vector_args } else { vector_args[from:to, , drop = FALSE] } result_i <- do.call(fun, c(handleables_chunk, vector_args_chunk, args)) if (!is.null(output)) { output[from:to] <- result_i } } output } #' Chunking strategies #' #' @param reduce For [wk_chunk_strategy_coordinates()] this refers to #' the function used with [Reduce()] to combine coordinate counts #' from more than one handleable. #' @param n_chunks,chunk_size Exactly one of the number of #' chunks or the chunk size. For [wk_chunk_strategy_feature()] #' the chunk size refers to the number of features; for #' [wk_chunk_strategy_coordinates()] this refers to the number #' of coordinates as calculated from multiple handleables #' using `reduce`. #' #' @return A function that returns a `data.frame` with columns `from` and `to` #' when called with a `handleable` and the feature count. #' @export #' #' @examples #' feat <- c(as_wkt(xy(1:4, 1:4)), wkt("LINESTRING (1 1, 2 2)")) #' wk_chunk_strategy_single()(list(feat), 5) #' wk_chunk_strategy_feature(chunk_size = 2)(list(feat), 5) #' wk_chunk_strategy_coordinates(chunk_size = 2)(list(feat), 5) #' wk_chunk_strategy_single <- function() { function(handleables, n_features) { new_data_frame(list(from = 1, to = n_features)) } } #' @rdname wk_chunk_strategy_single #' @export wk_chunk_strategy_feature <- function(n_chunks = NULL, chunk_size = NULL) { force(n_chunks) force(chunk_size) function(handleables, n_features) { chunk_info <- chunk_info(n_features, n_chunks = n_chunks, chunk_size = chunk_size) from <- (chunk_info$chunk_size * (seq_len(chunk_info$n_chunks) - 1L)) + 1L to <- chunk_info$chunk_size * seq_len(chunk_info$n_chunks) to[chunk_info$n_chunks] <- n_features new_data_frame(list(from = from, to = to)) } } #' @rdname wk_chunk_strategy_single #' @export wk_chunk_strategy_coordinates <- function(n_chunks = NULL, chunk_size = NULL, reduce = "*") { force(n_chunks) force(reduce) function(handleables, n_features) { coord_count <- lapply(handleables, function(handleable) { vm <- wk_vector_meta(handleable) if (identical(vm$geometry_type, 1L)) { 1L } else { wk_count(handleable)$n_coord } }) coord_count <- Reduce(reduce, coord_count) if (identical(coord_count, 1L)) { return(wk_chunk_strategy_feature(n_chunks, chunk_size)(handleables, n_features)) } coord_count <- rep_len(coord_count, n_features) coord_count_total <- sum(coord_count) chunk_info <- chunk_info(coord_count_total, n_chunks, chunk_size) from <- rep(NA_integer_, chunk_info$n_chunks) to <- rep(NA_integer_, chunk_info$n_chunks) from[1] <- 1L coord_count_chunk <- (coord_count_total / chunk_info$n_chunks) coord_count_feat <- cumsum(coord_count) for (chunk_id in seq_len(chunk_info$n_chunks - 1L)) { next_coord_gt <- coord_count_feat >= coord_count_chunk if (!any(next_coord_gt)) { to[chunk_id] <- n_features break } i <- max(min(which(next_coord_gt)), from[chunk_id] + 1L) to[chunk_id] <- i from[chunk_id + 1L] <- i + 1L coord_count[1:i] <- 0L coord_count_feat <- cumsum(coord_count) } valid <- !is.na(from) from <- from[valid] to <- to[valid] if (is.na(to[length(to)])) { to[length(to)] <- n_features } new_data_frame(list(from = from, to = to)) } } chunk_info <- function(n_features, n_chunks = NULL, chunk_size = NULL) { if (is.null(n_chunks) && is.null(chunk_size)) { stop("Must specify exactly one of `n_chunks` or `chunk_size`", call. = FALSE) } else if (is.null(n_chunks)) { n_chunks <- ((n_features - 1L) %/% chunk_size) + 1L } else if (is.null(chunk_size)) { if (n_features == 0) { n_chunks <- 0L chunk_size <- 1L } else { chunk_size <- ((n_features - 1L) %/% n_chunks) + 1L } } else { stop("Must specify exactly one of `n_chunks` or `chunk_size`", call. = FALSE) } list(n_chunks = n_chunks, chunk_size = chunk_size) } wk/R/sfc-writer.R0000644000176200001440000000017414106220314013277 0ustar liggesusers #' @rdname wk_writer #' @export sfc_writer <- function() { new_wk_handler(.Call(wk_c_sfc_writer_new), "wk_sfc_writer") } wk/R/deprecated.R0000644000176200001440000000232314164565642013334 0ustar liggesusers #' Deprecated functions #' #' These functions are deprecated and will be removed in a future version. #' #' @param wkb A `list()` of [raw()] vectors, such as that #' returned by `sf::st_as_binary()`. #' @param wkt A character vector containing well-known text. #' @param trim Trim unnecessary zeroes in the output? #' @param precision The rounding precision to use when writing #' (number of decimal places). #' @param endian Force the endian of the resulting WKB. #' @param ... Used to keep backward compatibility with previous #' versions of these functions. #' #' @export #' @rdname deprecated #' wkb_translate_wkt <- function(wkb, ..., precision = 16, trim = TRUE) { unclass(wk_handle.wk_wkb(wkb, wkt_writer(precision, trim))) } #' @rdname deprecated #' @export wkb_translate_wkb <- function(wkb, ..., endian = NA_integer_) { unclass(wk_handle.wk_wkb(wkb, wkb_writer(endian = endian))) } #' @rdname deprecated #' @export wkt_translate_wkt <- function(wkt, ..., precision = 16, trim = TRUE) { unclass(wk_handle.wk_wkt(wkt, wkt_writer(precision, trim))) } #' @rdname deprecated #' @export wkt_translate_wkb <- function(wkt, ..., endian = NA_integer_) { unclass(wk_handle.wk_wkt(wkt, wkb_writer(endian = endian))) } wk/R/crc.R0000644000176200001440000000355114106220314011763 0ustar liggesusers #' 2D Circle Vectors #' #' @param x,y Coordinates of the center #' @param r Circle radius #' @param ... Extra arguments passed to `as_crc()`. #' @inheritParams new_wk_wkb #' #' @return A vector along the recycled length of bounds. #' @export #' #' @examples #' crc(1, 2, 3) #' crc <- function(x = double(), y = double(), r = double(), crs = wk_crs_auto()) { vec <- new_wk_crc( recycle_common( x = as.double(x), y = as.double(y), r = as.double(r) ), crs = wk_crs_auto_value(x, crs) ) validate_wk_crc(vec) vec } #' @rdname crc #' @export as_crc <- function(x, ...) { UseMethod("as_crc") } #' @rdname crc #' @export as_crc.wk_crc <- function(x, ...) { x } #' @rdname crc #' @export as_crc.matrix <- function(x, ..., crs = NULL) { if (ncol(x) == 3) { colnames(x) <- c("x", "y", "r") } as_crc(as.data.frame(x), ..., crs = crs) } #' @rdname crc #' @export as_crc.data.frame <- function(x, ..., crs = NULL) { stopifnot(all(c("x", "y", "r") %in% names(x))) new_wk_crc(lapply(x[c("x", "y", "r")], as.double), crs = crs) } validate_wk_crc <- function(x) { validate_wk_rcrd(x) stopifnot( identical(names(unclass(x)), c("x", "y", "r")) ) invisible(x) } #' S3 details for crc objects #' #' @param x A [crc()] #' @inheritParams new_wk_wkb #' #' @export #' new_wk_crc <- function(x = list(x = double(), y = double(), r = double()), crs = NULL) { structure(x, class = c("wk_crc", "wk_rcrd"), crs = crs) } #' @export format.wk_crc <- function(x, ...) { x <- unclass(x) sprintf( "[%s %s, r = %s]", format(x$x, ...), format(x$y, ...), format(x$r, ...) ) } #' @export `[<-.wk_crc` <- function(x, i, value) { replacement <- as_crc(value) result <- Map("[<-", unclass(x), i, unclass(replacement)) names(result) <- c("x", "y", "r") new_wk_crc(result, crs = wk_crs_output(x, replacement)) } wk/R/vertex-filter.R0000644000176200001440000000442514106220314014015 0ustar liggesusers #' Extract vertices #' #' These functions provide ways to extract individual coordinate values. #' Whereas `wk_vertices()` returns a vector of coordinates as in the same #' format as the input, `wk_coords()` returns a data frame with coordinates #' as columns. #' #' @inheritParams wk_handle #' @param add_details Use `TRUE` to add a "wk_details" attribute, which #' contains columns `feature_id`, `part_id`, and `ring_id`. #' #' @return #' - `wk_vertices()` extracts vertices and returns the in the same format as #' the handler #' - `wk_coords()` returns a data frame with columns columns `feature_id` #' (the index of the feature from whence it came), `part_id` (an arbitrary #' integer identifying the point, line, or polygon from whence it came), #' `ring_id` (an arbitrary integer identifying individual rings within #' polygons), and one column per coordinate (`x`, `y`, and/or `z` and/or `m`). #' @export #' #' @examples #' wk_vertices(wkt("LINESTRING (0 0, 1 1)")) #' wk_coords(wkt("LINESTRING (0 0, 1 1)")) #' wk_vertices <- function(handleable, ...) { # the results of this handler are not necessarily the same length as the input, # so we need to special-case data frames if (is.data.frame(handleable)) { result <- wk_handle( handleable, wk_vertex_filter(wk_writer(handleable), add_details = TRUE), ... ) feature_id <- attr(result, "wk_details", exact = TRUE)$feature_id attr(result, "wk_details") <- NULL result <- wk_restore(handleable[feature_id, , drop = FALSE], result, ...) } else { result <- wk_handle(handleable, wk_vertex_filter(wk_writer(handleable, generic = TRUE)), ...) result <- wk_restore(handleable, result, ...) } wk_set_crs(result, wk_crs(handleable)) } #' @rdname wk_vertices #' @export wk_coords <- function(handleable, ...) { result <- wk_handle( handleable, wk_vertex_filter(xy_writer(), add_details = TRUE), ... ) details <- attr(result, "wk_details", exact = TRUE) attr(result, "wk_details") <- NULL new_data_frame(c(details, unclass(result))) } #' @rdname wk_vertices #' @export wk_vertex_filter <- function(handler, add_details = FALSE) { new_wk_handler( .Call("wk_c_vertex_filter_new", as_wk_handler(handler), as.logical(add_details)[1]), "wk_vertex_filter" ) } wk/R/wk-rcrd.R0000644000176200001440000000661714161345517012611 0ustar liggesusers new_wk_rcrd <- function(x, template) { stopifnot( is.list(x), is.null(attr(x, "class")), !is.null(names(x)), all(names(x) != "") ) structure( x, class = unique(class(template)), crs = attr(template, "crs", exact = TRUE), geodesic = attr(template, "geodesic", exact = TRUE) ) } validate_wk_rcrd <- function(x) { x_bare <- unclass(x) stopifnot( typeof(x) == "list", !is.null(names(x_bare)), all(names(x_bare) != ""), all(vapply(x_bare, is.double, logical(1))) ) invisible(x) } #' @export format.wk_rcrd <- function(x, ...) { vapply(x, function(item) paste0(format(unclass(item), ...), collapse = "\n"), character(1)) } #' @export print.wk_rcrd <- function(x, ...) { crs <- wk_crs(x) is_geodesic <- wk_is_geodesic(x) header <- sprintf("%s[%s]", class(x)[1], length(x)) if (!is.null(crs)) { header <- paste0(header, " with CRS=", wk_crs_format(crs)) } if (isTRUE(is_geodesic)) { header <- paste0("geodesic ", header) } cat(sprintf("<%s>\n", header)) if (length(x) == 0) { return(invisible(x)) } max_print <- getOption("max.print", 1000) x_head <- format(utils::head(x, max_print)) out <- format(x_head) print(out, quote = FALSE) if (length(x) > max_print) { cat(sprintf("Reached max.print (%s)\n", max_print)) } invisible(x) } #' @export str.wk_rcrd <- function(object, ...) { str.wk_vctr(object, ...) } #' @export as.character.wk_rcrd <- function(x, ...) { format(x, ...) } #' @export is.na.wk_rcrd <- function(x, ...) { is_na <- lapply(unclass(x), is.na) Reduce("&", is_na) } #' @export `[.wk_rcrd` <- function(x, i) { new_wk_rcrd(lapply(unclass(x), "[", i), x) } #' @export `[[.wk_rcrd` <- function(x, i) { x[i] } #' @export `$.wk_rcrd` <- function(x, i) { stop("`$` is not meaningful for 'wk_rcrd' objects", call. = FALSE) } #' @export `[[<-.wk_rcrd` <- function(x, i, value) { x[i] <- value x } #' @export names.wk_rcrd <- function(x) { NULL } #' @export `names<-.wk_rcrd` <- function(x, value) { if (is.null(value)) { x } else { stop("Names of a 'wk_rcrd' must be NULL.") } } #' @export length.wk_rcrd <- function(x) { length(unclass(x)[[1]]) } #' @export rep.wk_rcrd <- function(x, ...) { new_wk_rcrd(lapply(unclass(x), rep, ...), x) } #' @method rep_len wk_rcrd #' @export rep_len.wk_rcrd <- function(x, ...) { new_wk_rcrd(lapply(unclass(x), rep_len, ...), x) } #' @export c.wk_rcrd <- function(...) { dots <- list(...) classes <- lapply(dots, class) first_class <- classes[[1]] if (!all(vapply(classes, identical, first_class, FUN.VALUE = logical(1)))) { stop("Can't combine 'wk_rcrd' objects that do not have identical classes.", call. = FALSE) } # compute output crs attr(dots[[1]], "crs") <- wk_crs_output(...) geodesic <- wk_is_geodesic_output(...) attr(dots[[1]], "geodesic") <- if (geodesic) TRUE else NULL new_wk_vctr(do.call(Map, c(list(c), lapply(dots, unclass))), dots[[1]]) } # data.frame() will call as.data.frame() with optional = TRUE #' @export as.data.frame.wk_rcrd <- function(x, ..., optional = FALSE) { if (!optional) { new_data_frame(unclass(x)) } else { new_data_frame(list(x)) } } #' @export as.matrix.wk_rcrd <- function(x, ...) { x_bare <- unclass(x) matrix( unlist(x_bare, use.names = FALSE), nrow = length(x), ncol = length(x_bare), byrow = FALSE, dimnames = list(NULL, names(x_bare)) ) } wk/R/handle-wkt.R0000644000176200001440000000106014160220603013244 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.wk_wkt <- function(handleable, handler, ...) { handler <- as_wk_handler(handler) .Call( wk_c_read_wkt, list(handleable, TRUE), handler ) } #' Test handlers for handling of unknown size vectors #' #' @inheritParams wk_handle #' @export #' #' @examples #' handle_wkt_without_vector_size(wkt(), wk_vector_meta_handler()) #' handle_wkt_without_vector_size <- function(handleable, handler) { handler <- as_wk_handler(handler) .Call( wk_c_read_wkt, list(handleable, FALSE), handler ) } wk/R/handle-sfc.R0000644000176200001440000000025114106220314013212 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.sfc <- function(handleable, handler, ...) { handler <- as_wk_handler(handler) .Call(wk_c_read_sfc, handleable, handler) } wk/R/wk-vctr.R0000644000176200001440000001004114161345517012617 0ustar liggesusers #' @export print.wk_vctr <- function(x, ...) { crs <- wk_crs(x) is_geodesic <- wk_is_geodesic(x) header <- sprintf("%s[%s]", class(x)[1], length(x)) if (!is.null(crs)) { header <- paste0(header, " with CRS=", wk_crs_format(crs)) } if (isTRUE(is_geodesic)) { header <- paste0("geodesic ", header) } cat(sprintf("<%s>\n", header)) if (length(x) == 0) { return(invisible(x)) } max_print <- getOption("max.print", 1000) x_head <- format(utils::head(x, max_print)) out <- stats::setNames(format(x_head), names(x_head)) print(out, quote = FALSE) if (length(x) > max_print) { cat(sprintf("Reached max.print (%s)\n", max_print)) } invisible(x) } # lifted from vctrs::obj_leaf() #' @export str.wk_vctr <- function(object, ..., indent.str = "", width = getOption("width")) { if (length(object) == 0) { cat(paste0(" ", class(object)[1], "[0]\n")) return(invisible(object)) } # estimate possible number of elements that could be displayed # to avoid formatting too many width <- width - nchar(indent.str) - 2 length <- min(length(object), ceiling(width / 5)) formatted <- format(object[seq_len(length)], trim = TRUE) title <- paste0(" ", class(object)[1], "[1:", length(object), "]") cat( paste0( title, " ", strtrim(paste0(formatted, collapse = ", "), width - nchar(title)), "\n" ) ) invisible(object) } #' @export `[.wk_vctr` <- function(x, i) { new_wk_vctr(NextMethod(), x) } #' @export `[[.wk_vctr` <- function(x, i) { x[i] } #' @export `[[<-.wk_vctr` <- function(x, i, value) { x[i] <- value x } #' @export c.wk_vctr <- function(...) { dots <- list(...) classes <- lapply(dots, class) first_class <- classes[[1]] if (!all(vapply(classes, identical, first_class, FUN.VALUE = logical(1)))) { stop("Can't combine 'wk_vctr' objects that do not have identical classes.", call. = FALSE) } # compute output crs, geodesic attr(dots[[1]], "crs") <- wk_crs_output(...) geodesic <- wk_is_geodesic_output(...) attr(dots[[1]], "geodesic") <- if (geodesic) TRUE else NULL new_wk_vctr(NextMethod(), dots[[1]]) } #' @export rep.wk_vctr <- function(x, ...) { new_wk_vctr(NextMethod(), x) } #' @method rep_len wk_vctr #' @export rep_len.wk_vctr <- function(x, ...) { new_wk_vctr(NextMethod(), x) } # data.frame() will call as.data.frame() with optional = TRUE #' @export as.data.frame.wk_vctr <- function(x, ..., optional = FALSE) { if (!optional) { NextMethod() } else { new_data_frame(list(x)) } } new_wk_vctr <- function(x, template) { structure( x, class = unique(class(template)), crs = attr(template, "crs", exact = TRUE), geodesic = attr(template, "geodesic", exact = TRUE) ) } parse_base <- function(x, problems) { x[!is.na(problems)] <- x[NA_integer_] problems_df <- action_for_problems( problems, function(msg) warning(paste0(msg, '\nSee attr(, "problems") for details.'), call. = FALSE) ) if (nrow(problems_df) > 0) { problems_df$actual <- unclass(x)[problems_df$row] attr(x, "problems") <- problems_df } x } stop_for_problems <- function(problems) { action_for_problems(problems, stop, call. = FALSE) } action_for_problems <- function(problems, action, ...) { if (any(!is.na(problems))) { n_problems <- sum(!is.na(problems)) summary_problems <- utils::head(which(!is.na(problems))) problem_summary <- paste0( sprintf("[%s] %s", summary_problems, problems[summary_problems]), collapse = "\n" ) if (n_problems > length(summary_problems)) { problem_summary <- paste0( problem_summary, sprintf("\n...and %s more problems", n_problems - length(summary_problems)) ) } action( sprintf( "Encountered %s parse problem%s:\n%s", n_problems, if (n_problems == 1) "" else "s", problem_summary ), ... ) } data.frame( row = which(!is.na(problems)), col = rep_len(NA_integer_, sum(!is.na(problems))), expected = problems[!is.na(problems)], stringsAsFactors = FALSE ) } wk/R/handler.R0000644000176200001440000000435714145575672012665 0ustar liggesusers #' Read geometry vectors #' #' The handler is the basic building block of the wk package. In #' particular, the [wk_handle()] generic allows operations written #' as handlers to "just work" with many different input types. The #' wk package provides the [wk_void()] handler, the [wk_format()] #' handler, the [wk_debug()] handler, the [wk_problems()] handler, #' and [wk_writer()]s for [wkb()], [wkt()], [xy()], and [sf::st_sfc()]) #' vectors. #' #' @param handler_ptr An external pointer to a newly created WK handler #' @param handler A [wk_handler][wk_handle] object. #' @param subclass The handler subclass #' @param handleable A geometry vector (e.g., [wkb()], [wkt()], [xy()], #' [rct()], or [sf::st_sfc()]) for which [wk_handle()] is defined. #' @param n_segments,resolution The number of segments to use when approximating #' a circle. The default uses `getOption("wk.crc_n_segments")` so that #' this value can be set for implicit conversions (e.g., `as_wkb()`). #' Alternatively, set the minimum distance between points on the circle #' (used to estimate `n_segments`). The default is obtained #' using `getOption("wk.crc_resolution")`. #' @param ... Passed to the [wk_handle()] method. #' #' @return A WK handler. #' @export #' wk_handle <- function(handleable, handler, ...) { UseMethod("wk_handle") } #' @rdname wk_handle #' @export is_handleable <- function(handleable) { force(handleable) # use vector_meta because it doesn't ever iterate over an entire vector tryCatch({wk_vector_meta(handleable); TRUE}, error = function(e) FALSE) } #' @rdname wk_handle #' @export new_wk_handler <- function(handler_ptr, subclass = character()) { stopifnot(typeof(handler_ptr) == "externalptr") structure(handler_ptr, class = union(subclass, "wk_handler")) } #' @rdname wk_handle #' @export is_wk_handler <- function(handler) { inherits(handler, "wk_handler") } #' @rdname wk_handle #' @export as_wk_handler <- function(handler, ...) { if (is.function(handler)) { handler() } else if (is_wk_handler(handler)) { handler } else { stop("`handler` must be a wk handler object", call. = FALSE) } } #' @export print.wk_handler <- function(x, ...) { cat(sprintf("<%s at %s>\n", class(x)[1], .Call(wk_c_handler_addr, x))) invisible(x) } wk/R/wk-package.R0000644000176200001440000000036114106220314013222 0ustar liggesusers#' @keywords internal "_PACKAGE" # The following block is used by usethis to automatically manage # roxygen namespace tags. Modify with care! ## usethis namespace: start #' @useDynLib wk, .registration = TRUE ## usethis namespace: end NULL wk/R/xy-writer.R0000644000176200001440000000017114106220314013161 0ustar liggesusers #' @rdname wk_writer #' @export xy_writer <- function() { new_wk_handler(.Call(wk_c_xy_writer_new), "wk_xy_writer") } wk/R/writer.R0000644000176200001440000000311214106220314012521 0ustar liggesusers #' Write geometry vectors #' #' When writing transformation functions, it is often useful to know which #' handler should be used to create a (potentially modified) version #' of an object. Some transformers (e.g., [wk_vertices()]) modify #' the geometry type of an object, in which case a generic writer is needed. #' This defaults to [wkb_writer()] because it is fast and can handle #' all geometry types. #' #' @inheritParams wk_handle #' @param precision If `trim` is `TRUE`, the total number of significant digits to keep #' for each result or the number of digits after the decimal place otherwise. #' @param trim Use `FALSE` to keep trailing zeroes after the decimal place. #' @param endian Use 1 for little endian, 0 for big endian, or NA for #' system endian. #' @param generic Use `TRUE` to obtain a writer that can write all geometry #' types. #' @param buffer_size Control the initial buffer size used when writing WKB. #' @param ... Passed to the writer constructor. #' #' @return A [wk_handler][wk_handle]. #' @export #' wk_writer <- function(handleable, ..., generic = FALSE) { UseMethod("wk_writer") } #' @rdname wk_writer #' @export wk_writer.default <- function(handleable, ...) { wkb_writer() } #' @rdname wk_writer #' @export wk_writer.wk_wkt <- function(handleable, ..., precision = 16, trim = TRUE) { wkt_writer(precision, trim) } #' @rdname wk_writer #' @export wk_writer.wk_wkb <- function(handleable, ...) { wkb_writer() } #' @rdname wk_writer #' @export wk_writer.wk_xy <- function(handleable, ..., generic = FALSE) { if (generic) wkb_writer() else xy_writer() } wk/R/bbox.R0000644000176200001440000000404114163110540012143 0ustar liggesusers #' 2D bounding rectangles #' #' @inheritParams wk_handle #' #' @return A [rct()] of length 1. #' @export #' #' @examples #' wk_bbox(wkt("LINESTRING (1 2, 3 5)")) #' wk_bbox <- function(handleable, ...) { UseMethod("wk_bbox") } #' @rdname wk_bbox #' @export wk_envelope <- function(handleable, ...) { UseMethod("wk_envelope") } #' @rdname wk_bbox #' @export wk_bbox.default <- function(handleable, ...) { if (wk_is_geodesic(handleable)) { stop("Can't compute bbox for geodesic object", call. = FALSE) } result <- wk_handle(handleable, wk_bbox_handler(), ...) wk_crs(result) <- wk_crs(handleable) result } #' @rdname wk_bbox #' @export wk_envelope.default <- function(handleable, ...) { if (wk_is_geodesic(handleable)) { stop("Can't compute envelope for geodesic object", call. = FALSE) } result <- wk_handle(handleable, wk_envelope_handler(), ...) wk_crs(result) <- wk_crs(handleable) result } #' @rdname wk_bbox #' @export wk_envelope.wk_rct <- function(handleable, ...) { handleable } #' @rdname wk_bbox #' @export wk_envelope.wk_crc <- function(handleable, ...) { unclassed <- unclass(handleable) rct_data <- list( xmin = unclassed$x - unclassed$r, ymin = unclassed$y - unclassed$r, xmax = unclassed$x + unclassed$r, ymax = unclassed$y + unclassed$r ) new_wk_rct(rct_data, crs = attr(handleable, "crs", exact = TRUE)) } #' @rdname wk_bbox #' @export wk_envelope.wk_xy <- function(handleable, ...) { unclassed <- unclass(handleable) rct_data <- c(unclassed[1:2], unclassed[1:2]) names(rct_data) <- c("xmin", "ymin", "xmax", "ymax") new_wk_rct(rct_data, crs = attr(handleable, "crs", exact = TRUE)) } # Note to future self: re-implementing wk_bbox() using range() # for record-style vectors is not faster than the default method #' @rdname wk_bbox #' @export wk_bbox_handler <- function() { new_wk_handler(.Call(wk_c_bbox_handler_new), "wk_bbox_handler") } #' @rdname wk_bbox #' @export wk_envelope_handler <- function() { new_wk_handler(.Call(wk_c_envelope_handler_new), "wk_envelope_handler") } wk/R/flatten.R0000644000176200001440000000302314106220314012643 0ustar liggesusers #' Extract simple geometries #' #' @inheritParams wk_handle #' @param max_depth The maximum (outer) depth to remove. #' @param add_details Use `TRUE` to add a "wk_details" attribute, which #' contains columns `feature_id`, `part_id`, and `ring_id`. #' #' @return `handleable` transformed such that collections have been #' expanded and only simple geometries (point, linestring, polygon) #' remain. #' @export #' #' @examples #' wk_flatten(wkt("MULTIPOINT (1 1, 2 2, 3 3)")) #' wk_flatten( #' wkt("GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (GEOMETRYCOLLECTION (POINT (0 1))))"), #' max_depth = 2 #' ) #' wk_flatten <- function(handleable, ..., max_depth = 1) { if (is.data.frame(handleable)) { result <- wk_handle( handleable, wk_flatten_filter(wk_writer(handleable), max_depth, add_details = TRUE), ... ) feature_id <- attr(result, "wk_details", exact = TRUE)$feature_id attr(result, "wk_details") <- NULL result <- wk_restore(handleable[feature_id, , drop = FALSE], result, ...) } else { result <- wk_handle(handleable, wk_flatten_filter(wk_writer(handleable, generic = TRUE), max_depth), ...) result <- wk_restore(handleable, result, ...) } wk_set_crs(result, wk_crs(handleable)) } #' @rdname wk_flatten #' @export wk_flatten_filter <- function(handler, max_depth = 1L, add_details = FALSE) { new_wk_handler( .Call( "wk_c_flatten_filter_new", as_wk_handler(handler), as.integer(max_depth)[1], as.logical(add_details)[1] ), "wk_flatten_filter" ) } wk/R/wkb.R0000644000176200001440000000645314163210157012012 0ustar liggesusers #' Mark lists of raw vectors as well-known binary #' #' @param x A [list()] of [raw()] vectors or `NULL`. #' @inheritParams new_wk_wkb #' @param ... Unused #' #' @return A [new_wk_wkb()] #' @export #' #' @examples #' as_wkb("POINT (20 10)") #' wkb <- function(x = list(), crs = wk_crs_auto(), geodesic = FALSE) { crs <- wk_crs_auto_value(x, crs) attributes(x) <- NULL wkb <- new_wk_wkb(x, crs = crs, geodesic = geodesic_attr(geodesic)) validate_wk_wkb(wkb) wkb } #' @rdname wkb #' @export parse_wkb <- function(x, crs = wk_crs_auto(), geodesic = FALSE) { crs <- wk_crs_auto_value(x, crs) attributes(x) <- NULL wkb <- new_wk_wkb(x, crs = crs, geodesic = geodesic_attr(geodesic)) parse_base(wkb, wk_problems(wkb)) } #' @rdname wkb #' @export wk_platform_endian <- function() { match(.Platform$endian, c("big", "little")) - 1L } #' @rdname wkb #' @export as_wkb <- function(x, ...) { UseMethod("as_wkb") } #' @rdname wkb #' @export as_wkb.default <- function(x, ...) { wk_translate( x, new_wk_wkb(crs = wk_crs_inherit(), geodesic = wk_geodesic_inherit()), ... ) } #' @rdname wkb #' @export as_wkb.character <- function(x, ..., crs = NULL, geodesic = FALSE) { as_wkb(wkt(x, crs = crs, geodesic = geodesic), ...) } #' @rdname wkb #' @export as_wkb.wk_wkb <- function(x, ...) { x } #' @rdname wkb #' @export as_wkb.blob <- function(x, ..., crs = NULL, geodesic = FALSE) { as_wkb(wkb(x, crs = crs, geodesic = geodesic), ...) } #' @rdname wkb #' @export as_wkb.WKB <- function(x, ..., crs = NULL, geodesic = FALSE) { as_wkb(wkb(x, crs = crs, geodesic = geodesic), ...) } #' S3 Details for wk_wkb #' #' @param x A (possibly) [wkb()] vector #' @param crs A value to be propagated as the CRS for this vector. #' @inheritParams wk_is_geodesic #' #' @export #' new_wk_wkb <- function(x = list(), crs = NULL, geodesic = NULL) { if (typeof(x) != "list" || !is.null(attributes(x))) { stop("wkb input must be a list without attributes", call. = FALSE) } structure(x, class = c("wk_wkb", "wk_vctr"), crs = crs, geodesic = geodesic) } #' @rdname new_wk_wkb #' @export validate_wk_wkb <- function(x) { if (typeof(x) != "list") { stop("wkb() must be of type list()", call. = FALSE) } good_types <- .Call(wk_c_wkb_is_raw_or_null, x) if (!all(good_types)) { stop("items in wkb input must be raw() or NULL", call. = FALSE) } if (!inherits(x, "wk_wkb") || !inherits(x, "wk_vctr")) { attributes(x) <- NULL problems <- wk_problems(new_wk_wkb(x)) } else { problems <- wk_problems(x) } stop_for_problems(problems) invisible(x) } #' @rdname new_wk_wkb #' @export is_wk_wkb <- function(x) { inherits(x, "wk_wkb") } #' @export `[<-.wk_wkb` <- function(x, i, value) { replacement <- as_wkb(value) crs_out <- wk_crs_output(x, replacement) geodesic_out <- wk_is_geodesic_output(x, replacement) x <- unclass(x) x[i] <- replacement attr(x, "crs") <- NULL attr(x, "geodesic") <- NULL new_wk_wkb(x, crs = crs_out, geodesic = geodesic_attr(geodesic_out)) } #' @export is.na.wk_wkb <- function(x) { .Call(wk_c_wkb_is_na, x) } #' @export format.wk_wkb <- function(x, ...) { paste0("<", wk_format(x), ">") } # as far as I can tell, this is the only way to change # how the object appears in the viewer #' @export as.character.wk_wkb <- function(x, ...) { format(x, ...) } wk/R/handle-wkb.R0000644000176200001440000000025414106220314013225 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.wk_wkb <- function(handleable, handler, ...) { handler <- as_wk_handler(handler) .Call(wk_c_read_wkb, handleable, handler) } wk/R/transform.R0000644000176200001440000000260614106220314013227 0ustar liggesusers #' Apply coordinate transformations #' #' @inheritParams wk_handle #' @param trans An external pointer to a wk_trans object #' #' @export #' #' @examples #' wk_transform(xy(0, 0), wk_affine_translate(2, 3)) #' wk_transform <- function(handleable, trans, ...) { result <- wk_handle( handleable, wk_transform_filter(wk_writer(handleable), trans), ... ) wk_restore(handleable, result, ...) } #' @rdname wk_transform #' @export wk_transform_filter <- function(handler, trans) { new_wk_handler( .Call(wk_c_trans_filter_new, as_wk_handler(handler), as_wk_trans(trans)), "wk_transform_filter" ) } #' Generic transform class #' #' @param ... Passed to S3 methods #' @param trans_ptr An external pointer to a wk_trans_t transform #' struct. #' @param subclass An optional subclass to apply to the pointer #' @param x An object to be converted to a transform. #' @inheritParams wk_transform #' #' @export #' wk_trans_inverse <- function(trans, ...) { UseMethod("wk_trans_inverse") } #' @rdname wk_trans_inverse #' @export as_wk_trans <- function(x, ...) { UseMethod("as_wk_trans") } #' @rdname wk_trans_inverse #' @export as_wk_trans.wk_trans <- function(x, ...) { x } #' @rdname wk_trans_inverse #' @export new_wk_trans <- function(trans_ptr, subclass = character()) { stopifnot(typeof(trans_ptr) == "externalptr") structure(trans_ptr, class = union(subclass, "wk_trans")) } wk/R/xyzm.R0000644000176200001440000001677314163175253012253 0ustar liggesusers #' Efficient point vectors #' #' @param x,y,z,m Coordinate values. #' @param dims A set containing one or more of `c("x", "y", "z", "m")`. #' @param ... Passed to methods. #' @inheritParams new_wk_wkb #' #' @return A vector of coordinate values. #' @export #' #' @examples #' xy(1:5, 1:5) #' xyz(1:5, 1:5, 10) #' xym(1:5, 1:5, 10) #' xyzm(1:5, 1:5, 10, 12) #' xy <- function(x = double(), y = double(), crs = wk_crs_auto()) { vec <- new_wk_xy(recycle_common(x = as.double(x), y = as.double(y)), crs = wk_crs_auto_value(x, crs)) validate_wk_xy(vec) vec } #' @rdname xy #' @export xyz <- function(x = double(), y = double(), z = double(), crs = wk_crs_auto()) { vec <- new_wk_xyz(recycle_common(x = as.double(x), y = as.double(y), z = as.double(z)), crs = wk_crs_auto_value(x, crs)) validate_wk_xyz(vec) vec } #' @rdname xy #' @export xym <- function(x = double(), y = double(), m = double(), crs = wk_crs_auto()) { vec <- new_wk_xym(recycle_common(x = as.double(x), y = as.double(y), m = as.double(m)), crs = wk_crs_auto_value(x, crs)) validate_wk_xym(vec) vec } #' @rdname xy #' @export xyzm <- function(x = double(), y = double(), z = double(), m = double(), crs = wk_crs_auto()) { vec <- new_wk_xyzm( recycle_common( x = as.double(x), y = as.double(y), z = as.double(z), m = as.double(m) ), crs = wk_crs_auto_value(x, crs) ) validate_wk_xyzm(vec) vec } #' @rdname xy #' @export xy_dims <- function(x) { names(unclass(x)) } #' @rdname xy #' @export as_xy <- function(x, ...) { UseMethod("as_xy") } #' @rdname xy #' @export as_xy.default <- function(x, ..., dims = NULL) { result <- wk_handle(x, xy_writer()) wk_crs(result) <- wk_crs(x) if (is.null(dims)) { result } else { as_xy(result, dims = dims) } } #' @rdname xy #' @export as_xy.wk_xy <- function(x, ..., dims = NULL) { if (is.null(dims)) { x } else if (setequal(dims, c("x", "y"))) { new_wk_xy(fill_missing_dims(unclass(x), c("x", "y"), length(x)), crs = wk_crs(x)) } else if (setequal(dims, c("x", "y", "z"))) { new_wk_xyz(fill_missing_dims(unclass(x), c("x", "y", "z"), length(x)), crs = wk_crs(x)) } else if (setequal(dims, c("x", "y", "m"))) { new_wk_xym(fill_missing_dims(unclass(x), c("x", "y", "m"), length(x)), crs = wk_crs(x)) } else if (setequal(dims, c("x", "y", "z", "m"))) { new_wk_xyzm(fill_missing_dims(unclass(x), c("x", "y", "z", "m"), length(x)), crs = wk_crs(x)) } else { stop("Unknown dims in as_xy().", call. = FALSE) } } #' @rdname xy #' @export as_xy.matrix <- function(x, ..., crs = NULL) { x[] <- as.numeric(x) colnames(x) <- tolower(colnames(x)) cols <- colnames(x) if (!is.null(cols)) { dim_cols <- intersect(c("x", "y", "z", "m"), cols) if (length(dim_cols) == 0) { stop( paste0( "Can't guess dimensions of matrix with column names\n", paste0("'", cols, "'", collapse = ", ") ), call. = FALSE ) } if (!identical(dim_cols, colnames(x))) { x <- x[, dim_cols, drop = FALSE] } } # prevent named subsets dimnames(x) <- NULL if (ncol(x) == 2) { new_wk_xy( list( x = x[, 1, drop = TRUE], y = x[, 2, drop = TRUE] ), crs = crs ) } else if (ncol(x) == 4) { new_wk_xyzm( list( x = x[, 1, drop = TRUE], y = x[, 2, drop = TRUE], z = x[, 3, drop = TRUE], m = x[, 4, drop = TRUE] ), crs = crs ) } else if (identical(cols, c("x", "y", "m"))) { new_wk_xym( list( x = x[, 1, drop = TRUE], y = x[, 2, drop = TRUE], m = x[, 3, drop = TRUE] ), crs = crs ) } else if (ncol(x) == 3) { new_wk_xyz( list( x = x[, 1, drop = TRUE], y = x[, 2, drop = TRUE], z = x[, 3, drop = TRUE] ), crs = crs ) } else { stop( sprintf("Can't guess dimensions of matrix with %s columns", ncol(x)), call. = FALSE ) } } #' @rdname xy #' @export as_xy.data.frame <- function(x, ..., dims = NULL, crs = NULL) { col_handleable <- vapply(x, is_handleable, logical(1)) if (any(col_handleable)) { stopifnot(missing(crs)) return(as_xy.default(x[[which(col_handleable)[1]]], dims = dims)) } if (is.null(dims)) { dims <- intersect(c("x", "y", "z", "m"), names(x)) } if (setequal(dims, c("x", "y"))) { new_wk_xy(fill_missing_dims(unclass(x), c("x", "y"), nrow(x)), crs = crs) } else if (setequal(dims, c("x", "y", "z"))) { new_wk_xyz(fill_missing_dims(unclass(x), c("x", "y", "z"), nrow(x)), crs = crs) } else if (setequal(dims, c("x", "y", "m"))) { new_wk_xym(fill_missing_dims(unclass(x), c("x", "y", "m"), nrow(x)), crs = crs) } else if (setequal(dims, c("x", "y", "z", "m"))) { new_wk_xyzm(fill_missing_dims(unclass(x), c("x", "y", "z", "m"), nrow(x)), crs = crs) } else { stop("Unknown dims in as_xy.data.frame().", call. = FALSE) } } fill_missing_dims <- function(x, dims, len) { missing_dims <- setdiff(dims, names(x)) x[missing_dims] <- lapply( stats::setNames(missing_dims, missing_dims), function(x) rep_len(NA_real_, len) ) lapply(x[dims], as.double) } #' S3 details for xy objects #' #' @param x A [xy()] object. #' @inheritParams new_wk_wkb #' #' @export #' new_wk_xy <- function(x = list(x = double(), y = double()), crs = NULL) { structure(x, class = c("wk_xy", "wk_rcrd"), crs = crs) } #' @rdname new_wk_xy #' @export new_wk_xyz <- function(x = list(x = double(), y = double(), z = double()), crs = NULL) { structure(x, class = c("wk_xyz", "wk_xy", "wk_rcrd"), crs = crs) } #' @rdname new_wk_xy #' @export new_wk_xym <- function(x = list(x = double(), y = double(), m = double()), crs = NULL) { structure(x, class = c("wk_xym", "wk_xy", "wk_rcrd"), crs = crs) } #' @rdname new_wk_xy #' @export new_wk_xyzm <- function(x = list(x = double(), y = double(), z = double(), m = double()), crs = NULL) { structure(x, class = c("wk_xyzm", "wk_xyz", "wk_xym", "wk_xy", "wk_rcrd"), crs = crs) } #' @rdname new_wk_xy #' @export validate_wk_xy <- function(x) { validate_wk_rcrd(x) stopifnot(identical(names(unclass(x)), c("x", "y"))) invisible(x) } #' @rdname new_wk_xy #' @export validate_wk_xyz <- function(x) { validate_wk_rcrd(x) stopifnot(identical(names(unclass(x)), c("x", "y", "z"))) invisible(x) } #' @rdname new_wk_xy #' @export validate_wk_xym <- function(x) { validate_wk_rcrd(x) stopifnot(identical(names(unclass(x)), c("x", "y", "m"))) invisible(x) } #' @rdname new_wk_xy #' @export validate_wk_xyzm <- function(x) { validate_wk_rcrd(x) stopifnot(identical(names(unclass(x)), c("x", "y", "z", "m"))) invisible(x) } #' @export format.wk_xy <- function(x, ...) { x <- unclass(x) sprintf("(%s %s)", format(x$x, ...), format(x$y, ...)) } #' @export format.wk_xyz <- function(x, ...) { x <- unclass(x) sprintf("Z (%s %s %s)", format(x$x, ...), format(x$y, ...), format(x$z, ...)) } #' @export format.wk_xym <- function(x, ...) { x <- unclass(x) sprintf("M (%s %s %s)", format(x$x, ...), format(x$y, ...), format(x$m, ...)) } #' @export format.wk_xyzm <- function(x, ...) { x <- unclass(x) sprintf("ZM (%s %s %s %s)", format(x$x, ...), format(x$y, ...), format(x$z, ...), format(x$m, ...)) } #' @export `[<-.wk_xy` <- function(x, i, value) { replacement <- as_xy(value) result <- Map( "[<-", unclass(x), list(i), fill_missing_dims(unclass(replacement), xy_dims(x), length(replacement)) ) names(result) <- names(unclass(x)) structure(result, class = class(x), crs = wk_crs_output(x, replacement)) } wk/R/wk-crs.R0000644000176200001440000002074314163210157012433 0ustar liggesusers #' Set and get vector CRS #' #' The wk package doesn't operate on CRS objects, but does propagate them #' through subsetting and concatenation. A CRS object can be any R object, #' and x can be any object whose 'crs' attribute carries a CRS. These functions #' are S3 generics to keep them from being used #' on objects that do not use this system of CRS propagation. #' #' @param x,... Objects whose "crs" attribute is used to carry a CRS. #' @param crs,value An object that can be interpreted as a CRS #' #' @export #' wk_crs <- function(x) { UseMethod("wk_crs") } #' @rdname wk_crs #' @export wk_crs.wk_vctr <- function(x) { attr(x, "crs", exact = TRUE) } #' @rdname wk_crs #' @export wk_crs.wk_rcrd <- function(x) { attr(x, "crs", exact = TRUE) } #' @rdname wk_crs #' @export `wk_crs<-` <- function(x, value) { wk_set_crs(x, value) } #' @rdname wk_crs #' @export wk_set_crs <- function(x, crs) { UseMethod("wk_set_crs") } #' @export wk_set_crs.wk_vctr <- function(x, crs) { attr(x, "crs") <- crs x } #' @export wk_set_crs.wk_rcrd <- function(x, crs) { attr(x, "crs") <- crs x } #' @rdname wk_crs #' @export wk_crs_output <- function(...) { dots <- list(...) crs <- lapply(dots, wk_crs) Reduce(wk_crs2, crs) } #' @rdname wk_crs #' @export wk_is_geodesic_output <- function(...) { dots <- list(...) geodesic <- lapply(dots, wk_is_geodesic) Reduce(wk_is_geodesic2, geodesic) } wk_crs2 <- function(x, y) { if (inherits(y, "wk_crs_inherit")) { x } else if (inherits(x, "wk_crs_inherit")) { y } else if (wk_crs_equal(x, y)) { x } else { stop(sprintf("CRS objects '%s' and '%s' are not equal.", format(x), format(y)), call. = FALSE) } } wk_is_geodesic2 <- function(x, y) { if (identical(x, y)) { x } else if (identical(x, NA)) { y } else if (identical(y, NA)) { x } else { stop("objects have differing values for geodesic", call. = FALSE) } } #' Compare CRS objects #' #' The [wk_crs_equal()] function uses special S3 dispatch on [wk_crs_equal_generic()] #' to evaluate whether or not two CRS values can be considered equal. When implementing #' [wk_crs_equal_generic()], every attempt should be made to make `wk_crs_equal(x, y)` #' and `wk_crs_equal(y, x)` return identically. #' #' @param x,y Objects stored in the `crs` attribute of a vector. #' @param ... Unused #' #' @return `TRUE` if `x` and `y` can be considered equal, `FALSE` otherwise. #' @export #' wk_crs_equal <- function(x, y) { if (is.object(y)) { wk_crs_equal_generic(y, x) } else { wk_crs_equal_generic(x, y) } } #' @rdname wk_crs_equal #' @export wk_crs_equal_generic <- function(x, y, ...) { UseMethod("wk_crs_equal_generic") } #' @export wk_crs_equal_generic.default <- function(x, y, ...) { identical(x, y) } #' @export wk_crs_equal_generic.integer <- function(x, y, ...) { isTRUE(x == y) } #' @export wk_crs_equal_generic.double <- function(x, y, ...) { isTRUE(x == y) } #' Set and get vector geodesic edge interpolation #' #' @param x An R object that contains edges #' @param geodesic,value `TRUE` if edges must be interpolated as geodesics when #' coordinates are spherical, `FALSE` otherwise. #' #' @return `TRUE` if edges must be interpolated as geodesics when #' coordinates are spherical, `FALSE` otherwise. #' @export #' wk_is_geodesic <- function(x) { UseMethod("wk_is_geodesic") } #' @rdname wk_is_geodesic #' @export wk_set_geodesic <- function(x, geodesic) { UseMethod("wk_set_geodesic") } #' @rdname wk_is_geodesic #' @export `wk_is_geodesic<-` <- function(x, value) { wk_set_geodesic(x, value) } #' @rdname wk_is_geodesic #' @export wk_geodesic_inherit <- function() { NA } #' @export wk_is_geodesic.default <- function(x) { FALSE } #' @export wk_is_geodesic.wk_wkb <- function(x) { attr(x, "geodesic", exact = TRUE) %||% FALSE } #' @export wk_is_geodesic.wk_wkt <- function(x) { attr(x, "geodesic", exact = TRUE) %||% FALSE } #' @export wk_set_geodesic.default <- function(x, geodesic) { if (geodesic) { warning( sprintf( "Ignoring wk_set_geodesic(x, TRUE) for object of class '%s'", class(x)[1] ) ) } x } #' @export wk_set_geodesic.wk_wkb <- function(x, geodesic) { attr(x, "geodesic") <- geodesic_attr(geodesic) x } #' @export wk_set_geodesic.wk_wkt <- function(x, geodesic) { attr(x, "geodesic") <- geodesic_attr(geodesic) x } geodesic_attr <- function(geodesic) { if (!is.logical(geodesic) || (length(geodesic) != 1L)) { stop("`geodesic` must be TRUE, FALSE, or NA", call. = FALSE) } if (identical(geodesic, FALSE)) { NULL } else { geodesic } } #' CRS object generic methods #' #' @param crs An arbitrary R object #' @param verbose Use `TRUE` to request a more verbose version of the #' PROJ definition (e.g., WKT2). The default of `FALSE` should return #' the most compact version that completely describes the CRS. An #' authority:code string (e.g., "OGC:CRS84") is the recommended way #' to represent a CRS when `verbose` is `FALSE`, if possible, falling #' back to the most recent version of WKT2. #' @param proj_version A [package_version()] of the PROJ version, or #' `NULL` if the PROJ version is unknown. #' #' @return #' - `wk_crs_proj_definition()` Returns a string used to represent the #' CRS in PROJ. For recent PROJ version you'll want to return WKT2; however #' you should check `proj_version` if you want this to work with older #' versions of PROJ. #' @export #' #' @examples #' wk_crs_proj_definition("EPSG:4326") #' wk_crs_proj_definition <- function(crs, proj_version = NULL, verbose = FALSE) { UseMethod("wk_crs_proj_definition") } #' @rdname wk_crs_proj_definition #' @export wk_crs_proj_definition.NULL <- function(crs, proj_version = NULL, verbose = FALSE) { NA_character_ } #' @rdname wk_crs_proj_definition #' @export wk_crs_proj_definition.character <- function(crs, proj_version = NULL, verbose = FALSE) { stopifnot(length(crs) == 1) crs } #' @rdname wk_crs_proj_definition #' @export wk_crs_proj_definition.double <- function(crs, proj_version = NULL, verbose = FALSE) { stopifnot(length(crs) == 1) if (is.na(crs)) wk_crs_proj_definition(NULL) else paste0("EPSG:", crs) } #' @rdname wk_crs_proj_definition #' @export wk_crs_proj_definition.integer <- function(crs, proj_version = NULL, verbose = FALSE) { stopifnot(length(crs) == 1) if (is.na(crs)) wk_crs_proj_definition(NULL) else paste0("EPSG:", crs) } #' Special CRS values #' #' The CRS handling in the wk package requires two sentinel CRS values. #' The first, [wk_crs_inherit()], signals that the vector should inherit #' a CRS of another vector if combined. This is useful for empty, `NULL`, #' and/or zero-length geometries. The second, [wk_crs_auto()], is used #' as the default argument of `crs` for constructors so that zero-length #' geometries are assigned a CRS of `wk_crs_inherit()` by default. #' #' @param x A raw input to a construuctor whose length and crs attributte #' is used to determine the default CRS returned by [wk_crs_auto()]. #' @param crs A value for the coordinate reference system supplied by #' the user. #' #' @export #' #' @examples #' wk_crs_auto_value(list(), wk_crs_auto()) #' wk_crs_auto_value(list(), 1234) #' wk_crs_auto_value(list(NULL), wk_crs_auto()) #' wk_crs_inherit <- function() { structure(list(), class = "wk_crs_inherit") } #' @rdname wk_crs_inherit #' @export wk_crs_longlat <- function(crs = NULL) { if (inherits(crs, "wk_crs_inherit") || is.null(crs) || identical(crs, "WGS84")) { return("OGC:CRS84") } crs_proj <- wk_crs_proj_definition(crs) switch( crs_proj, "OGC:CRS84" = , "EPSG:4326" = , "WGS84" = "OGC:CRS84", "OGC:CRS27" = , "EPSG:4267" = , "NAD27" = "OGC:CRS27", "OGC:CRS83" = , "EPSG:4269" = , "NAD83" = "OGC:CRS83", stop( sprintf( "Can't guess authority-compliant long/lat definition from CRS '%s'", format(crs_proj) ) ) ) } #' @rdname wk_crs_inherit #' @export wk_crs_auto <- function() { structure(list(), class = "wk_crs_auto") } #' @rdname wk_crs_inherit #' @export wk_crs_auto_value <- function(x, crs) { if (inherits(crs, "wk_crs_auto")) { if (length(x) == 0) wk_crs_inherit() else attr(x, "crs", exact = TRUE) } else { crs } } #' @export format.wk_crs_inherit <- function(x, ...) { format("wk_crs_inherit()", ...) } #' @export print.wk_crs_inherit <- function(x, ...) { cat("\n") } wk_crs_format <- function(x, ...) { tryCatch( wk_crs_proj_definition(x, verbose = FALSE), error = function(e) format(x, ...) ) } wk/R/plot.R0000644000176200001440000002025614163210157012202 0ustar liggesusers #' Plot well-known geometry vectors #' #' @param x A [wkb()] or [wkt()] #' @param add Should a new plot be created, or should `handleable` be added to the #' existing plot? #' @param ... Passed to plotting functions for features: [graphics::points()] #' for point and multipoint geometries, [graphics::lines()] for linestring #' and multilinestring geometries, and [graphics::polypath()] for polygon #' and multipolygon geometries. #' @param bbox The limits of the plot as a [rct()] or compatible object #' @param asp,xlab,ylab Passed to [graphics::plot()] #' @param rule The rule to use for filling polygons (see [graphics::polypath()]) #' @inheritParams wk_handle #' #' @return The input, invisibly. #' @importFrom graphics plot #' @export #' #' @examples #' plot(as_wkt("LINESTRING (0 0, 1 1)")) #' plot(as_wkb("LINESTRING (0 0, 1 1)")) #' wk_plot <- function(handleable, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE) { UseMethod("wk_plot") } #' @rdname wk_plot #' @export wk_plot.default <- function(handleable, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE) { # this is too hard without vctrs (already in Suggests) if (!requireNamespace("vctrs", quietly = TRUE)) { stop("Package 'vctrs' is required for wk_plot()", call. = FALSE) # nocov } if (isTRUE(wk_is_geodesic(handleable))) { stop( paste0( "wk_plot.default() can't plot geodesic objects.\n", "Use `wk_set_geodesic(x, FALSE)` to ignore geodesic edge specification" ), call. = FALSE ) } # should be refactored x <- handleable if (!add) { bbox <- unclass(bbox) bbox <- bbox %||% unclass(wk_bbox(x)) xlim <- c(bbox$xmin, bbox$xmax) ylim <- c(bbox$ymin, bbox$ymax) graphics::plot( numeric(0), numeric(0), xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, asp = asp ) } # for everything below we'll need to be able to subset if (!vctrs::vec_is(x)) { wk_plot(as_wkb(x), ..., rule = rule, add = TRUE) # nocov return(invisible(x)) # nocov } # get some background info size <- vctrs::vec_size(x) meta <- wk_meta(x) # points can be handled by as_xy() if (all(meta$geometry_type == 1L)) { coords <- unclass(as_xy(x)) graphics::points(coords, ...) return(invisible(x)) } # evaluate the dots dots <- list(..., rule = rule) is_scalar <- !vapply(dots, vctrs::vec_is, logical(1)) dots[is_scalar] <- lapply(dots[is_scalar], list) dots_length <- vapply(dots, vctrs::vec_size, integer(1)) dots_constant <- all(dots_length == 1L) is_rule <- length(dots) # point + multipoint is probably faster with a single coord vector if (all(meta$geometry_type %in% c(1, 4))) { coords <- wk_coords(x) if (dots_constant) { graphics::points(coords[c("x", "y")], ...) } else { dots$rule <- NULL dots <- vctrs::vec_recycle_common(!!!dots, .size = size) dots_tbl <- vctrs::new_data_frame(dots, n = size) do.call(graphics::points, c(coords[c("x", "y")], dots_tbl[coords$feature_id, , drop = FALSE])) } return(invisible(x)) } # it's not faster to flatten big vectors into a single go for anything else dots <- vctrs::vec_recycle_common(!!!dots, .size = size) for (i in seq_len(size)) { xi <- vctrs::vec_slice(x, i) dotsi <- lapply(dots, "[[", i) if (meta$geometry_type[i] %in% c(1, 4)) { wk_plot_point_or_multipoint(xi, dotsi[-is_rule]) } else if (meta$geometry_type[i] %in% c(2, 5)) { wk_plot_line_or_multiline(xi, dotsi[-is_rule]) } else if (meta$geometry_type[i] %in% c(3, 6)) { wk_plot_poly_or_multi_poly(xi, dotsi) } else { do.call(wk_plot, c(list(wk_flatten(xi, max_depth = .Machine$integer.max), add = TRUE), dotsi)) } } invisible(x) } wk_plot_point_or_multipoint <- function(x, dots) { coords <- wk_coords(x) do.call(graphics::points, c(coords[c("x", "y")], dots)) } wk_plot_line_or_multiline <- function(x, dots) { coords <- wk_coords(x) geom_id <- coords$part_id geom_id_lag <- c(-1L, geom_id[-length(geom_id)]) new_geom <- geom_id != geom_id_lag na_shift <- cumsum(new_geom) - 1L coords_seq <- seq_along(geom_id) coord_x <- rep(NA_real_, length(geom_id) + sum(new_geom) - 1L) coord_y <- rep(NA_real_, length(geom_id) + sum(new_geom) - 1L) coord_x[coords_seq + na_shift] <- coords$x coord_y[coords_seq + na_shift] <- coords$y dots$rule <- NULL do.call(graphics::lines, c(list(coord_x, coord_y), dots)) } wk_plot_poly_or_multi_poly <- function(x, dots) { coords <- wk_coords(x) # for polygons we can use the coord vectors directly # because the graphics device expects open loops geom_id <- coords$ring_id n <- length(geom_id) # leave the last loop closed the avoid a trailing NA (which results in error) geom_id_lead <- c(geom_id[-1L], geom_id[n]) new_geom_next <- geom_id != geom_id_lead coords$x[new_geom_next] <- NA_real_ coords$y[new_geom_next] <- NA_real_ do.call(graphics::polypath, c(coords[c("x", "y")], dots)) } #' @rdname wk_plot #' @export plot.wk_wkt <- function(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE) { wk_plot( x, ..., asp = asp, bbox = bbox, xlab = xlab, ylab = ylab, rule = rule, add = add ) invisible(x) } #' @rdname wk_plot #' @export plot.wk_wkb <- function(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", rule = "evenodd", add = FALSE) { wk_plot( x, ..., asp = asp, bbox = bbox, xlab = xlab, ylab = ylab, rule = rule, add = add ) invisible(x) } #' @rdname wk_plot #' @export plot.wk_xy <- function(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", add = FALSE) { x_bare <- unclass(x) if (!add) { graphics::plot( double(), double(), xlim = range(x_bare$x, finite = TRUE), ylim = range(x_bare$y, finite = TRUE), xlab = xlab, ylab = ylab, asp = asp ) } graphics::points(x_bare$x, x_bare$y, ...) invisible(x) } #' @rdname wk_plot #' @export plot.wk_rct <- function(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", add = FALSE) { x_bare <- unclass(x) if (!add) { xlim_min <- range(x_bare$xmin, finite = TRUE) xlim_max <- range(x_bare$xmax, finite = TRUE) ylim_min <- range(x_bare$ymin, finite = TRUE) ylim_max <- range(x_bare$ymax, finite = TRUE) graphics::plot( double(), double(), xlim = range(c(xlim_min, xlim_max), finite = TRUE), ylim = range(c(ylim_min, ylim_max), finite = TRUE), xlab = xlab, ylab = ylab, asp = asp ) } graphics::rect(x_bare$xmin, x_bare$ymin, x_bare$xmax, x_bare$ymax, ...) invisible(x) } #' @rdname wk_plot #' @export plot.wk_crc <- function(x, ..., asp = 1, bbox = NULL, xlab = "", ylab = "", add = FALSE) { x_bare <- unclass(x) if (!add) { xlim_min <- range(x_bare$x + x_bare$r, finite = TRUE) xlim_max <- range(x_bare$x - x_bare$r, finite = TRUE) ylim_min <- range(x_bare$y + x_bare$r, finite = TRUE) ylim_max <- range(x_bare$y - x_bare$r, finite = TRUE) graphics::plot( double(), double(), xlim = range(c(xlim_min, xlim_max), finite = TRUE), ylim = range(c(ylim_min, ylim_max), finite = TRUE), xlab = xlab, ylab = ylab, asp = asp ) } # estimate resolution for turning circles into segments usr <- graphics::par("usr") usr_x <- usr[1:2] usr_y <- usr[3:4] device_x <- graphics::grconvertX(usr_x, to = "device") device_y <- graphics::grconvertY(usr_y, to = "device") # Use resolution of 1 at the device level, scale to usr coords. # Changing this number to 2 or 4 doesn't really affect the speed # at which these plot; a value of 1 tends to give very good # resolution and is acceptable even when a plot in the interactive # device is zoomed. scale_x <- diff(device_x) / diff(usr_x) scale_y <- diff(device_y) / diff(usr_y) scale <- min(abs(scale_x), abs(scale_y)) resolution_usr <- 1 / scale plot( wk_handle(x, wkb_writer(), resolution = resolution_usr), ..., add = TRUE ) invisible(x) } wk/R/void.R0000644000176200001440000000131014106220314012144 0ustar liggesusers #' Do nothing #' #' This handler does nothing and returns `NULL`. It is useful for #' benchmarking readers and handlers and when using filters #' that have side-effects (e.g., [wk_debug()]). Note that this #' handler stops on the first parse error; to see a list of parse #' errors see the [wk_problems()] handler. #' #' @inheritParams wk_handle #' #' @return `NULL` #' @export #' #' @examples #' wk_void(wkt("POINT (1 4)")) #' wk_handle(wkt("POINT (1 4)"), wk_void_handler()) #' wk_void <- function(handleable, ...) { invisible(wk_handle(handleable, wk_void_handler(), ...)) } #' @rdname wk_void #' @export wk_void_handler <- function() { new_wk_handler(.Call(wk_c_handler_void_new), "wk_void_handler") } wk/R/debug.R0000644000176200001440000000077414106220314012306 0ustar liggesusers #' Debug filters and handlers #' #' @inheritParams wk_handle #' #' @return The result of the `handler`. #' @export #' #' @examples #' wk_debug(wkt("POINT (1 1)")) #' wk_handle(wkt("POINT (1 1)"), wk_debug_filter()) #' wk_debug <- function(handleable, handler = wk_void_handler(), ...) { wk_handle(handleable, wk_debug_filter(handler)) } #' @rdname wk_debug #' @export wk_debug_filter <- function(handler = wk_void_handler()) { new_wk_handler(.Call(wk_c_debug_filter_new, handler), "wk_debug_filter") } wk/R/handle-xy.R0000644000176200001440000000025214106220314013100 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.wk_xy <- function(handleable, handler, ...) { handler <- as_wk_handler(handler) .Call(wk_c_read_xy, handleable, handler) } wk/R/handle-crc.R0000644000176200001440000000154714106220314013217 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.wk_crc <- function(handleable, handler, ..., n_segments = getOption("wk.crc_n_segments", NULL), resolution = getOption("wk.crc_resolution", NULL)) { if (is.null(n_segments) && is.null(resolution)) { n_segments <- 100L } else if (is.null(n_segments)) { n_segments <- ceiling(2 * pi / (resolution / unclass(handleable)$r)) } n_segments <- as.integer(pmax(4L, n_segments)) n_segments[is.na(n_segments)] <- 4L if ((length(n_segments) != 1) && (length(n_segments) != length(handleable))) { stop( sprintf( "`n_segments`/`resolution` must be length 1 or length of data (%s)", length(handleable) ), call. = FALSE ) } handler <- as_wk_handler(handler) .Call(wk_c_read_crc, handleable, handler, n_segments) } wk/R/wkt-writer.R0000644000176200001440000000034714160220603013334 0ustar liggesusers #' @rdname wk_writer #' @export wkt_writer <- function(precision = 16L, trim = TRUE) { new_wk_handler( .Call( wk_c_wkt_writer, as.integer(precision)[1], as.logical(trim)[1] ), "wk_wkt_writer" ) } wk/R/pkg-vctrs.R0000644000176200001440000005746614163210157013161 0ustar liggesusers #' Vctrs methods #' #' @param x,y,to,... See [vctrs::vec_cast()] and [vctrs::vec_ptype2()]. #' @rdname vctrs-methods #' @name vctrs-methods #' NULL # wkb() -------- vec_proxy.wk_wkb <- function(x, ...) { unclass(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) attr(x, "crs") <- NULL attr(x, "geodesic") <- NULL new_wk_wkb(x, crs = crs_out, geodesic = geodesic_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_wkb vec_cast.wk_wkb <- function(x, to, ...) { UseMethod("vec_cast.wk_wkb") # nocov } #' @method vec_cast.wk_wkb default #' @export vec_cast.wk_wkb.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @method vec_cast.wk_wkb wk_wkb #' @export vec_cast.wk_wkb.wk_wkb <- function(x, to, ...) { wk_crs_output(x, to) wk_is_geodesic_output(x, to) x } #' @method vec_cast.wk_wkb wk_wkt #' @export vec_cast.wk_wkb.wk_wkt <- function(x, to, ...) { wk_crs_output(x, to) wk_is_geodesic_output(x, to) as_wkb(x) } #' @method vec_cast.wk_wkb wk_xy #' @export vec_cast.wk_wkb.wk_xy <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkb wk_xyz #' @export vec_cast.wk_wkb.wk_xyz <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkb wk_xym #' @export vec_cast.wk_wkb.wk_xym <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkb wk_xyzm #' @export vec_cast.wk_wkb.wk_xyzm <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkb wk_rct #' @export vec_cast.wk_wkb.wk_rct <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkb wk_crc #' @export vec_cast.wk_wkb.wk_crc <- function(x, to, ...) { wk_crs_output(x, to) as_wkb(x) } #' @rdname vctrs-methods #' @export vec_ptype2.wk_wkb vec_ptype2.wk_wkb <- function(x, y, ...) { UseMethod("vec_ptype2.wk_wkb", y) # nocov } #' @method vec_ptype2.wk_wkb default #' @export vec_ptype2.wk_wkb.default <- function(x, y, ..., x_arg = "x", y_arg = "y") { vctrs::vec_default_ptype2(x, y, x_arg = x_arg, y_arg = y_arg) # nocov } #' @method vec_ptype2.wk_wkb wk_wkb #' @export vec_ptype2.wk_wkb.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = geodesic_attr(wk_is_geodesic_output(x, y))) } #' @method vec_ptype2.wk_wkb wk_wkt #' @export vec_ptype2.wk_wkb.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = geodesic_attr(wk_is_geodesic_output(x, y))) } #' @method vec_ptype2.wk_wkb wk_xy #' @export vec_ptype2.wk_wkb.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkb wk_xyz #' @export vec_ptype2.wk_wkb.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkb wk_xym #' @export vec_ptype2.wk_wkb.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkb wk_xyzm #' @export vec_ptype2.wk_wkb.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkb wk_rct #' @export vec_ptype2.wk_wkb.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = geodesic_attr(wk_is_geodesic_output(x, y))) } #' @method vec_ptype2.wk_wkb wk_crc #' @export vec_ptype2.wk_wkb.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } # wkt() -------- vec_proxy.wk_wkt <- function(x, ...) { unclass(x) } vec_restore.wk_wkt <- 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) attr(x, "crs") <- NULL attr(x, "geodesic") <- NULL new_wk_wkt(x, crs = crs_out, geodesic = geodesic_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_wkt vec_cast.wk_wkt <- function(x, to, ...) { UseMethod("vec_cast.wk_wkt") # nocov } #' @method vec_cast.wk_wkt default #' @export vec_cast.wk_wkt.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @method vec_cast.wk_wkt wk_wkt #' @export vec_cast.wk_wkt.wk_wkt <- function(x, to, ...) { wk_crs_output(x, to) wk_is_geodesic_output(x, to) x } #' @method vec_cast.wk_wkt wk_wkb #' @export vec_cast.wk_wkt.wk_wkb <- function(x, to, ...) { wk_crs_output(x, to) wk_is_geodesic_output(x, to) as_wkt(x) } #' @method vec_cast.wk_wkt wk_xy #' @export vec_cast.wk_wkt.wk_xy <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkt wk_xyz #' @export vec_cast.wk_wkt.wk_xyz <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkt wk_xym #' @export vec_cast.wk_wkt.wk_xym <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkt wk_xyzm #' @export vec_cast.wk_wkt.wk_xyzm <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkt wk_rct #' @export vec_cast.wk_wkt.wk_rct <- function(x, to, ...) { wk_translate(x, to) } #' @method vec_cast.wk_wkt wk_crc #' @export vec_cast.wk_wkt.wk_crc <- function(x, to, ...) { wk_translate(x, to) } #' @rdname vctrs-methods #' @export vec_ptype2.wk_wkt vec_ptype2.wk_wkt <- function(x, y, ...) { UseMethod("vec_ptype2.wk_wkt", y) # nocov } #' @method vec_ptype2.wk_wkt default #' @export vec_ptype2.wk_wkt.default <- function(x, y, ..., x_arg = "x", y_arg = "y") { vctrs::vec_default_ptype2(x, y, x_arg = x_arg, y_arg = y_arg) # nocov } #' @method vec_ptype2.wk_wkt wk_wkt #' @export vec_ptype2.wk_wkt.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = geodesic_attr(wk_is_geodesic_output(x, y))) } #' @method vec_ptype2.wk_wkt wk_wkb #' @export vec_ptype2.wk_wkt.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = geodesic_attr(wk_is_geodesic_output(x, y))) } #' @method vec_ptype2.wk_wkt wk_xy #' @export vec_ptype2.wk_wkt.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkt wk_xyz #' @export vec_ptype2.wk_wkt.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkt wk_xym #' @export vec_ptype2.wk_wkt.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkt wk_xyzm #' @export vec_ptype2.wk_wkt.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_wkt wk_rct #' @export vec_ptype2.wk_wkt.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { wk_is_geodesic_output(x, y) new_wk_wkt(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_wkt wk_crc #' @export vec_ptype2.wk_wkt.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(x, "geodesic", exact = TRUE)) } # xy() -------- vec_proxy.wk_xy <- function(x, ...) { new_data_frame(unclass(x)) } vec_restore.wk_xy <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) attr(x, "crs") <- NULL attr(x, "row.names") <- NULL new_wk_xy(x, crs = crs_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_xy vec_cast.wk_xy <- function(x, to, ...) { UseMethod("vec_cast.wk_xy") # nocov } #' @method vec_cast.wk_xy default #' @export vec_cast.wk_xy.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @method vec_cast.wk_xy wk_xy #' @export vec_cast.wk_xy.wk_xy <- function(x, to, ...) { wk_crs_output(x, to) x } #' @method vec_cast.wk_xy wk_wkb #' @export vec_cast.wk_xy.wk_wkb <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x) } #' @method vec_cast.wk_xy wk_wkt #' @export vec_cast.wk_xy.wk_wkt <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x) } #' @method vec_cast.wk_xy wk_xyz #' @export vec_cast.wk_xy.wk_xyz <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y")), x, to, !is.na(unclass(x)$z) ) } #' @method vec_cast.wk_xy wk_xym #' @export vec_cast.wk_xy.wk_xym <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y")), x, to, !is.na(unclass(x)$m) ) } #' @method vec_cast.wk_xy wk_xyzm #' @export vec_cast.wk_xy.wk_xyzm <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y")), x, to, !is.na(unclass(x)$z) & !is.na(unclass(x)$m) ) } #' @rdname vctrs-methods #' @export vec_ptype2.wk_xy vec_ptype2.wk_xy <- function(x, y, ...) { UseMethod("vec_ptype2.wk_xy", y) # nocov } #' @method vec_ptype2.wk_xy wk_xy #' @export vec_ptype2.wk_xy.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xy(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xy wk_wkb #' @export vec_ptype2.wk_xy.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xy wk_wkt #' @export vec_ptype2.wk_xy.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xy wk_xyz #' @export vec_ptype2.wk_xy.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyz(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xy wk_xym #' @export vec_ptype2.wk_xy.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xym(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xy wk_xyzm #' @export vec_ptype2.wk_xy.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xy wk_rct #' @export vec_ptype2.wk_xy.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xy wk_crc #' @export vec_ptype2.wk_xy.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } # xyz() -------- vec_proxy.wk_xyz <- function(x, ...) { new_data_frame(unclass(x)) } vec_restore.wk_xyz <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) attr(x, "crs") <- NULL attr(x, "row.names") <- NULL new_wk_xyz(x, crs = crs_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_xyz vec_cast.wk_xyz <- function(x, to, ...) { UseMethod("vec_cast.wk_xyz") # nocov } #' @method vec_cast.wk_xyz default #' @export vec_cast.wk_xyz.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @method vec_cast.wk_xyz wk_xyz #' @export vec_cast.wk_xyz.wk_xyz <- function(x, to, ...) { wk_crs_output(x, to) x } #' @method vec_cast.wk_xyz wk_wkb #' @export vec_cast.wk_xyz.wk_wkb <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z")) } #' @method vec_cast.wk_xyz wk_wkt #' @export vec_cast.wk_xyz.wk_wkt <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z")) } #' @method vec_cast.wk_xyz wk_xy #' @export vec_cast.wk_xyz.wk_xy <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z")) } #' @method vec_cast.wk_xyz wk_xym #' @export vec_cast.wk_xyz.wk_xym <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y", "z")), x, to, !is.na(unclass(x)$m) ) } #' @method vec_cast.wk_xyz wk_xyzm #' @export vec_cast.wk_xyz.wk_xyzm <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y", "z")), x, to, !is.na(unclass(x)$m) ) } #' @rdname vctrs-methods #' @export vec_ptype2.wk_xyz vec_ptype2.wk_xyz <- function(x, y, ...) { UseMethod("vec_ptype2.wk_xyz", y) # nocov } #' @method vec_ptype2.wk_xyz wk_xyz #' @export vec_ptype2.wk_xyz.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyz(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyz wk_wkb #' @export vec_ptype2.wk_xyz.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xyz wk_wkt #' @export vec_ptype2.wk_xyz.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xyz wk_xy #' @export vec_ptype2.wk_xyz.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyz(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyz wk_xym #' @export vec_ptype2.wk_xyz.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyz wk_xyzm #' @export vec_ptype2.wk_xyz.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyz wk_rct #' @export vec_ptype2.wk_xyz.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyz wk_crc #' @export vec_ptype2.wk_xyz.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } # xym() -------- vec_proxy.wk_xym <- function(x, ...) { new_data_frame(unclass(x)) } vec_restore.wk_xym <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) attr(x, "crs") <- NULL attr(x, "row.names") <- NULL new_wk_xym(x, crs = crs_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_xym vec_cast.wk_xym <- function(x, to, ...) { UseMethod("vec_cast.wk_xym") # nocov } #' @method vec_cast.wk_xym default #' @export vec_cast.wk_xym.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @method vec_cast.wk_xym wk_xym #' @export vec_cast.wk_xym.wk_xym <- function(x, to, ...) { wk_crs_output(x, to) x } #' @method vec_cast.wk_xym wk_wkb #' @export vec_cast.wk_xym.wk_wkb <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "m")) } #' @method vec_cast.wk_xym wk_wkt #' @export vec_cast.wk_xym.wk_wkt <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "m")) } #' @method vec_cast.wk_xym wk_xy #' @export vec_cast.wk_xym.wk_xy <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "m")) } #' @method vec_cast.wk_xym wk_xyz #' @export vec_cast.wk_xym.wk_xyz <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y", "m")), x, to, !is.na(unclass(x)$z) ) } #' @method vec_cast.wk_xym wk_xyzm #' @export vec_cast.wk_xym.wk_xyzm <- function(x, to, ...) { wk_crs_output(x, to) vctrs::maybe_lossy_cast( as_xy(x, dims = c("x", "y", "m")), x, to, !is.na(unclass(x)$z) ) } #' @rdname vctrs-methods #' @export vec_ptype2.wk_xym vec_ptype2.wk_xym <- function(x, y, ...) { UseMethod("vec_ptype2.wk_xym", y) # nocov } #' @method vec_ptype2.wk_xym wk_xym #' @export vec_ptype2.wk_xym.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xym(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xym wk_wkb #' @export vec_ptype2.wk_xym.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xym wk_wkt #' @export vec_ptype2.wk_xym.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xym wk_xy #' @export vec_ptype2.wk_xym.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xym(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xym wk_xyz #' @export vec_ptype2.wk_xym.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xym wk_xyzm #' @export vec_ptype2.wk_xym.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xym wk_rct #' @export vec_ptype2.wk_xym.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xym wk_crc #' @export vec_ptype2.wk_xym.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } # xyzm() -------- vec_proxy.wk_xyzm <- function(x, ...) { new_data_frame(unclass(x)) } vec_restore.wk_xyzm <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) attr(x, "crs") <- NULL attr(x, "row.names") <- NULL new_wk_xyzm(x, crs = crs_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_xyzm vec_cast.wk_xyzm <- function(x, to, ...) { UseMethod("vec_cast.wk_xyzm") # nocov } #' @method vec_cast.wk_xyzm default #' @export vec_cast.wk_xyzm.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @method vec_cast.wk_xyzm wk_xyzm #' @export vec_cast.wk_xyzm.wk_xyzm <- function(x, to, ...) { wk_crs_output(x, to) x } #' @method vec_cast.wk_xyzm wk_wkb #' @export vec_cast.wk_xyzm.wk_wkb <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z", "m")) } #' @method vec_cast.wk_xyzm wk_wkt #' @export vec_cast.wk_xyzm.wk_wkt <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z", "m")) } #' @method vec_cast.wk_xyzm wk_xy #' @export vec_cast.wk_xyzm.wk_xy <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z", "m")) } #' @method vec_cast.wk_xyzm wk_xyz #' @export vec_cast.wk_xyzm.wk_xyz <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z", "m")) } #' @method vec_cast.wk_xyzm wk_xym #' @export vec_cast.wk_xyzm.wk_xym <- function(x, to, ...) { wk_crs_output(x, to) as_xy(x, dims = c("x", "y", "z", "m")) } #' @rdname vctrs-methods #' @export vec_ptype2.wk_xyzm vec_ptype2.wk_xyzm <- function(x, y, ...) { UseMethod("vec_ptype2.wk_xyzm", y) # nocov } #' @method vec_ptype2.wk_xyzm wk_xyzm #' @export vec_ptype2.wk_xyzm.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyzm wk_wkb #' @export vec_ptype2.wk_xyzm.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xyzm wk_wkt #' @export vec_ptype2.wk_xyzm.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_xyzm wk_xy #' @export vec_ptype2.wk_xyzm.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyzm wk_xyz #' @export vec_ptype2.wk_xyzm.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyzm wk_xym #' @export vec_ptype2.wk_xyzm.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_xyzm(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyzm wk_rct #' @export vec_ptype2.wk_xyzm.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_xyzm wk_crc #' @export vec_ptype2.wk_xyzm.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } # rct() -------- vec_proxy.wk_rct <- function(x, ...) { new_data_frame(unclass(x)) } vec_restore.wk_rct <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) attr(x, "crs") <- NULL attr(x, "row.names") <- NULL new_wk_rct(x, crs = crs_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_rct vec_cast.wk_rct <- function(x, to, ...) { UseMethod("vec_cast.wk_rct") # nocov } #' @method vec_cast.wk_rct default #' @export vec_cast.wk_rct.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @rdname vctrs-methods #' @export vec_ptype2.wk_rct vec_ptype2.wk_rct <- function(x, y, ...) { UseMethod("vec_ptype2.wk_rct", y) # nocov } #' @method vec_ptype2.wk_rct wk_rct #' @export vec_ptype2.wk_rct.wk_rct <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_rct(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_wkb #' @export vec_ptype2.wk_rct.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_wkt #' @export vec_ptype2.wk_rct.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_xy #' @export vec_ptype2.wk_rct.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_xyz #' @export vec_ptype2.wk_rct.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_xym #' @export vec_ptype2.wk_rct.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_xyzm #' @export vec_ptype2.wk_rct.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_rct wk_crc #' @export vec_ptype2.wk_rct.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } # crc() -------- vec_proxy.wk_crc <- function(x, ...) { new_data_frame(unclass(x)) } vec_restore.wk_crc <- function(x, to, ...) { crs_out <- attr(to, "crs", exact = TRUE) %||% attr(x, "crs", exact = TRUE) attr(x, "crs") <- NULL attr(x, "row.names") <- NULL new_wk_crc(x, crs = crs_out) } #' @rdname vctrs-methods #' @export vec_cast.wk_crc vec_cast.wk_crc <- function(x, to, ...) { UseMethod("vec_cast.wk_crc") # nocov } #' @method vec_cast.wk_crc default #' @export vec_cast.wk_crc.default <- function(x, to, ...) { vctrs::vec_default_cast(x, to) # nocov } #' @rdname vctrs-methods #' @export vec_ptype2.wk_crc vec_ptype2.wk_crc <- function(x, y, ...) { UseMethod("vec_ptype2.wk_crc", y) # nocov } #' @method vec_ptype2.wk_crc wk_crc #' @export vec_ptype2.wk_crc.wk_crc <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_crc(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_crc wk_wkb #' @export vec_ptype2.wk_crc.wk_wkb <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_crc wk_wkt #' @export vec_ptype2.wk_crc.wk_wkt <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkt(crs = wk_crs_output(x, y), geodesic = attr(y, "geodesic", exact = TRUE)) } #' @method vec_ptype2.wk_crc wk_xy #' @export vec_ptype2.wk_crc.wk_xy <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_crc wk_xyz #' @export vec_ptype2.wk_crc.wk_xyz <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_crc wk_xym #' @export vec_ptype2.wk_crc.wk_xym <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } #' @method vec_ptype2.wk_crc wk_xyzm #' @export vec_ptype2.wk_crc.wk_xyzm <- function(x, y, ..., x_arg = "x", y_arg = "y") { new_wk_wkb(crs = wk_crs_output(x, y)) } wk/R/filter.R0000644000176200001440000000153314106220314012477 0ustar liggesusers #' Copy a geometry vector #' #' @inheritParams wk_handle #' @param result The result of a filter operation intended to be a #' transformation. #' #' @return A copy of `handleable`. #' @export #' #' @examples #' wk_identity(wkt("POINT (1 2)")) #' wk_identity <- function(handleable, ...) { result <- wk_handle(handleable, wk_identity_filter(wk_writer(handleable)), ...) result <- wk_restore(handleable, result, ...) wk_set_crs(result, wk_crs(handleable)) } #' @rdname wk_identity #' @export wk_identity_filter <- function(handler) { new_wk_handler(.Call("wk_c_identity_filter_new", as_wk_handler(handler)), "wk_identity_filter") } #' @rdname wk_identity #' @export wk_restore <- function(handleable, result, ...) { UseMethod("wk_restore") } #' @rdname wk_identity #' @export wk_restore.default <- function(handleable, result, ...) { result } wk/R/rct.R0000644000176200001440000000422114163110540012001 0ustar liggesusers #' 2D rectangle vectors #' #' @param xmin,ymin,xmax,ymax Rectangle bounds. #' @param x An object to be converted to a [rct()]. #' @param ... Extra arguments passed to `as_rct()`. #' @inheritParams new_wk_wkb #' #' @return A vector along the recycled length of bounds. #' @export #' #' @examples #' rct(1, 2, 3, 4) #' rct <- function(xmin = double(), ymin = double(), xmax = double(), ymax = double(), crs = wk_crs_auto()) { vec <- new_wk_rct( recycle_common( xmin = as.double(xmin), ymin = as.double(ymin), xmax = as.double(xmax), ymax = as.double(ymax) ), crs = wk_crs_auto_value(xmin, crs) ) validate_wk_rct(vec) vec } #' @rdname rct #' @export as_rct <- function(x, ...) { UseMethod("as_rct") } #' @rdname rct #' @export as_rct.wk_rct <- function(x, ...) { x } #' @rdname rct #' @export as_rct.matrix <- function(x, ..., crs = NULL) { if (ncol(x) == 4) { colnames(x) <- c("xmin", "ymin", "xmax", "ymax") } as_rct(as.data.frame(x), ..., crs = crs) } #' @rdname rct #' @export as_rct.data.frame <- function(x, ..., crs = NULL) { stopifnot(all(c("xmin", "ymin", "xmax", "ymax") %in% names(x))) new_wk_rct( lapply(x[c("xmin", "ymin", "xmax", "ymax")], as.double), crs = crs ) } validate_wk_rct <- function(x) { validate_wk_rcrd(x) stopifnot( identical(names(unclass(x)), c("xmin", "ymin", "xmax", "ymax")) ) invisible(x) } #' S3 details for rct objects #' #' @param x A [rct()] #' @inheritParams new_wk_wkb #' #' @export #' new_wk_rct <- function(x = list(xmin = double(), ymin = double(), xmax = double(), ymax = double()), crs = NULL) { structure(x, class = c("wk_rct", "wk_rcrd"), crs = crs) } #' @export format.wk_rct <- function(x, ...) { x <- unclass(x) sprintf( "[%s %s %s %s]", format(x$xmin, ...), format(x$ymin, ...), format(x$xmax, ...), format(x$ymax, ...) ) } #' @export `[<-.wk_rct` <- function(x, i, value) { replacement <- as_rct(value) result <- Map("[<-", unclass(x), i, unclass(replacement)) names(result) <- c("xmin", "ymin", "xmax", "ymax") new_wk_rct( result, crs = wk_crs_output(x, replacement) ) } wk/R/meta.R0000644000176200001440000000625414106220314012145 0ustar liggesusers #' Extract feature-level meta #' #' These functions return the non-coordinate information of a geometry #' and/or vector. They do not parse an entire geometry/vector and are #' intended to be very fast even for large vectors. #' #' @inheritParams wk_handle #' @param geometry_type An integer code for the geometry type. These #' integers follow the WKB specification (e.g., 1 for point, #' 7 for geometrycollection). #' @param geometry_type_label A character vector of (lowercase) #' geometry type labels as would be found in WKT (e.g., point, #' geometrycollection). #' #' @return A data.frame with columns: #' - `geometry_type`: An integer identifying the geometry type. #' A value of 0 indicates that the types of geometry in the vector #' are not known without parsing the entire vector. #' - `size`: For points and linestrings, the number of coordinates; for #' polygons, the number of rings; for collections, the number of #' child geometries. A value of zero indicates an EMPTY geometry. #' A value of `NA` means this value is unknown without parsing the #' entire geometry. #' - `has_z`: `TRUE` if coordinates contain a Z value. A value of `NA` #' means this value is unknown without parsing the entire vector. #' - `has_m`: `TRUE` if coordinates contain an M value. A value of `NA` #' means this value is unknown without parsing the entire vector. #' - `srid`: An integer identifying a CRS or NA if this value was not #' provided. #' - `precision`: A grid size or 0.0 if a grid size was not provided. #' Note that coordinate values may not have been rounded; the grid #' size only refers to the level of detail with which they should #' be interpreted. #' #' @export #' #' @examples #' wk_vector_meta(as_wkt("LINESTRING (0 0, 1 1)")) #' wk_meta(as_wkt("LINESTRING (0 0, 1 1)")) #' wk_meta(as_wkb("LINESTRING (0 0, 1 1)")) #' #' wk_geometry_type_label(1:7) #' wk_geometry_type(c("point", "geometrycollection")) #' wk_meta <- function(handleable, ...) { UseMethod("wk_meta") } #' @rdname wk_meta #' @export wk_meta.default <- function(handleable, ...) { new_data_frame(wk_handle(handleable, wk_meta_handler(), ...)) } #' @rdname wk_meta #' @export wk_vector_meta <- function(handleable, ...) { UseMethod("wk_vector_meta") } #' @rdname wk_meta #' @export wk_vector_meta.default <- function(handleable, ...) { new_data_frame(wk_handle(handleable, wk_vector_meta_handler(), ...)) } #' @rdname wk_meta #' @export wk_meta_handler <- function() { new_wk_handler(.Call(wk_c_meta_handler_new), "wk_meta_handler") } #' @rdname wk_meta #' @export wk_vector_meta_handler <- function() { new_wk_handler(.Call(wk_c_vector_meta_handler_new), "wk_vector_meta_handler") } #' @rdname wk_meta #' @export wk_geometry_type_label <- function(geometry_type) { c( "point", "linestring", "polygon", "multipoint", "multilinestring", "multipolygon", "geometrycollection" )[as.integer(geometry_type)] } #' @rdname wk_meta #' @export wk_geometry_type <- function(geometry_type_label) { match( geometry_type_label, c( "point", "linestring", "polygon", "multipoint", "multilinestring", "multipolygon", "geometrycollection" ) ) } wk/R/translate.R0000644000176200001440000000071614163110540013213 0ustar liggesusers #' Translate geometry vectors #' #' @inheritParams wk_handle #' @param to A prototype object. #' #' @export #' wk_translate <- function(handleable, to, ...) { UseMethod("wk_translate", to) } #' @rdname wk_translate #' @export wk_translate.default <- function(handleable, to, ...) { result <- wk_handle(handleable, wk_writer(to), ...) attr(result, "crs") <- wk_crs_output(handleable, to) wk_set_geodesic(result, wk_is_geodesic_output(handleable, to)) } wk/R/problems.R0000644000176200001440000000141314106220314013032 0ustar liggesusers #' Validate well-known binary and well-known text #' #' The problems handler returns a character vector of parse #' errors and can be used to validate input of any type #' for which [wk_handle()] is defined. #' #' @inheritParams wk_handle #' #' @return A character vector of parsing errors. `NA` signifies #' that there was no parsing error. #' @export #' #' @examples #' wk_problems(new_wk_wkt(c("POINT EMTPY", "POINT (20 30)"))) #' wk_handle( #' new_wk_wkt(c("POINT EMTPY", "POINT (20 30)")), #' wk_problems_handler() #' ) #' wk_problems <- function(handleable, ...) { wk_handle(handleable, wk_problems_handler(), ...) } #' @rdname wk_problems #' @export wk_problems_handler <- function() { new_wk_handler(.Call(wk_c_problems_handler_new), "wk_problems_handler") } wk/R/pkg-readr.R0000644000176200001440000000040614161345517013102 0ustar liggesusers # registered in zzz.R output_column.wk_vctr <- function(x, name) { out <- as.character(as_wkt(x)) out[is.na(x)] <- NA_character_ out } output_column.wk_rcrd <- function(x, name) { out <- as.character(as_wkt(x)) out[is.na(x)] <- NA_character_ out } wk/R/handle-rct.R0000644000176200001440000000025414106220314013232 0ustar liggesusers #' @rdname wk_handle #' @export wk_handle.wk_rct <- function(handleable, handler, ...) { handler <- as_wk_handler(handler) .Call(wk_c_read_rct, handleable, handler) } wk/R/wkb-writer.R0000644000176200001440000000033614106220314013307 0ustar liggesusers #' @rdname wk_writer #' @export wkb_writer <- function(buffer_size = 2048L, endian = NA_integer_) { new_wk_handler( .Call(wk_c_wkb_writer_new, as.integer(buffer_size), as.integer(endian)), "wk_wkb_writer" ) } wk/R/affine.R0000644000176200001440000000615714125354157012467 0ustar liggesusers #' Affine transformer #' #' @param trans_matrix A 3x3 transformation matrix #' @param x A [wk_trans_affine()] #' @param dx,dy Coordinate offsets in the x and y direction #' @param scale_x,scale_y Scale factor to apply in the x and y directions, respectively #' @param rct_in,rct_out The input and output bounds #' @param rotation_deg A rotation to apply in degrees counterclockwise. #' @param src,dst Point vectors of control points used to estimate the affine mapping #' (using [base::qr.solve()]). #' @param ... Zero or more transforms in the order they should be applied. #' #' @export #' wk_trans_affine <- function(trans_matrix) { new_wk_trans(.Call(wk_c_trans_affine_new, trans_matrix), "wk_trans_affine") } #' @export wk_trans_inverse.wk_trans_affine <- function(trans, ...) { wk_affine_invert(trans) } #' @rdname wk_trans_affine #' @export wk_affine_identity <- function() { wk_affine_translate(0, 0) } #' @rdname wk_trans_affine #' @export wk_affine_rotate <- function(rotation_deg) { theta <- -rotation_deg * pi / 180 trans_matrix <- matrix( c( cos(theta), +sin(theta), 0, -sin(theta), cos(theta), 0, 0, 0, 1 ), nrow = 3, byrow = TRUE ) wk_trans_affine(trans_matrix) } #' @rdname wk_trans_affine #' @export wk_affine_scale <- function(scale_x = 1, scale_y = 1) { wk_trans_affine(matrix(c(scale_x, 0, 0, 0, scale_y, 0, 0, 0, 1), ncol = 3)) } #' @rdname wk_trans_affine #' @export wk_affine_translate <- function(dx = 0, dy = 0) { wk_trans_affine(matrix(c(1, 0, 0, 0, 1, 0, dx, dy, 1), ncol = 3)) } #' @rdname wk_trans_affine #' @export wk_affine_fit <- function(src, dst) { src <- as_xy(src) dst <- as_xy(dst) n <- length(src) stopifnot(length(src) == length(dst)) src <- unclass(src) dst <- unclass(dst) src_mat <- cbind(src$x, src$y, rep_len(1, n)) dst_mat <- cbind(dst$x, dst$y, rep_len(1, n)) wk_trans_affine(t(qr.solve(src_mat, dst_mat))) } #' @rdname wk_trans_affine #' @export wk_affine_rescale <- function(rct_in, rct_out) { # use bbox to sanitize input as rct of length 1 rct_in <- unclass(wk_bbox(rct_in)) rct_out <- unclass(wk_bbox(rct_out)) width_in <- rct_in$xmax - rct_in$xmin height_in <- rct_in$ymax - rct_in$ymin width_out <- rct_out$xmax - rct_out$xmin height_out <- rct_out$ymax - rct_out$ymin dx <- rct_out$xmin - rct_in$xmin dy <- rct_out$ymin - rct_in$ymin wk_affine_compose( wk_affine_scale(width_out / width_in, height_out / height_in), wk_affine_translate(dx, dy) ) } #' @rdname wk_trans_affine #' @export wk_affine_compose <- function(...) { trans_matrix <- Reduce( `%*%`, lapply(rev(list(...)), as.matrix), init = as.matrix(wk_affine_identity()) ) wk_trans_affine(trans_matrix) } #' @rdname wk_trans_affine #' @export wk_affine_invert <- function(x) { wk_trans_affine(solve(as.matrix(x))) } #' @export as.matrix.wk_trans_affine <- function(x, ...) { .Call(wk_c_trans_affine_as_matrix, x) } #' @export format.wk_trans_affine <- function(x, ...) { format(as.matrix(x), ...) } #' @export print.wk_trans_affine <- function(x, ...) { cat("\n") print(as.matrix(x), ...) invisible(x) } wk/R/format.R0000644000176200001440000000245614160220603012510 0ustar liggesusers #' Format well-known geometry for printing #' #' Provides an abbreviated version of the well-known text #' representation of a geometry. This returns a constant #' number of coordinates for each geometry, so is safe to #' use for geometry vectors with many (potentially large) #' features. Parse errors are passed on to the format string #' and do not cause this handler to error. #' #' @inheritParams wk_handle #' @inheritParams wk_writer #' @param max_coords The maximum number of coordinates to include #' in the output. #' #' @return A character vector of abbreviated well-known text. #' @export #' #' @examples #' wk_format(wkt("MULTIPOLYGON (((0 0, 10 0, 0 10, 0 0)))")) #' wk_format(new_wk_wkt("POINT ENTPY")) #' wk_handle( #' wkt("MULTIPOLYGON (((0 0, 10 0, 0 10, 0 0)))"), #' wkt_format_handler() #' ) #' wk_format <- function(handleable, precision = 7, trim = TRUE, max_coords = 6, ...) { wk_handle( handleable, wkt_format_handler(precision = precision, trim = trim, max_coords = max_coords), ... ) } #' @rdname wk_format #' @export wkt_format_handler <- function(precision = 7, trim = TRUE, max_coords = 6) { new_wk_handler( .Call( wk_c_wkt_formatter, as.integer(precision)[1], as.logical(trim)[1], as.integer(max_coords)[1] ), "wk_wkt_formatter" ) } wk/NEWS.md0000644000176200001440000001223714164560663012011 0ustar liggesusers# wk 0.6.0 * Fixed `wk_affine_rescale()` to apply the translate and scale operations in the correct order (#94). * Add `wk_handle_slice()` and `wk_chunk_map_feature()` to support a chunk + apply workflow when working with large vectors (#101, #107). * C and R code was rewritten to avoid materializing ALTREP vectors (#103, #109). * Added a `wk_crs_proj_definition()` generic for foreign CRS objects (#110, #112). * Added `wk_crs_longlat()` helper to help promote authority-compliant CRS choices (#112). * Added `wk_is_geodesic()`, `wk_set_geodesic()`, and argument `geodesic` in `wkt()` and `wkb()` as a flag for objects whose edges must be interpolated along a spherical/ellipsoidal trajectory (#112). * Added `sf::st_geometry()` and `sf::st_sfc()` methods for wk geometry vectors for better integration with sf (#113, #114). * Refactored well-known text parser to be more reusable and faster (#115, #104). * Minor performance enhancement for `is.na()` and `validate_wk_wkb()` when called on a very long `wkb()` vector (#117). * Fixed issue with `validate_wk_wkb()` and `validate_wk_wkt()`, which failed for most valid objects (#119). * Added `wk_envelope()` and `wk_envelope_handler()` to compute feature-wise bounding boxes (#120, #122). * Fixed headers and tests to pass on big endian systems (#105, #122). * Incorporated the geodesic attribute into vctrs methods, data frame columns, and bbox/envelope calculation (#124, #125). * Fix `as_xy()` for nested data frames and geodesic objects (#126, #128). * Remove deprecated `wkb_problems()`, `wkt_problems()`, `wkb_format()`, and `wkt_format()` (#129). * `wk_plot()` is now an S3 generic (#130). # wk 0.5.0 * Fixed bugs relating to the behaviour of wk classes as vectors (#64, #65, #67, #70). * `crc()` objects are now correctly exported as polygons with a closed loop (#66, #70). * Added `wk_vertices()` and `wk_coords()` to extract individual coordinate values from geometries with optional identifying information. For advanced users, the `wk_vertex_filter()` can be used as part of a pipeline to export coordinates as point geometries to another handler (#69, #71). * Added `wk_flatten()` to extract geometries from collections. For advanced users, the `wk_flatten_filter()` can be used as part of a pipeline (#75, #78). * `options("max.print")` is now respected by all vector classes (#72, #74). * Moved implementation of plot methods from wkutils to wk to simplify the dependency structure of both packages (#80, #76). * Added `wk_polygon()`, `wk_linestring()`, and `wk_collection()` to construct polygons, lines, and collections. For advanced users, `wk_polygon_filter()`, `wk_linestring_filter()`, and `wk_collection_filter()` can be used as part of a pipeline (#77, #84). * Added a C-level transform struct that can be used to simplify the the common pattern of transforming coordinates. These structs can be created by other packages; however, the `wk_trans_affine()` and `wk_trans_set()` transforms are also built using this feature. These are run using the new `wk_transform()` function and power the new `wk_set_z()`, `wk_set_m()`, `wk_drop_z()`, `wk_drop_m()`, functions (#87, #88, #89). # wk 0.4.1 * Fix LTO and MacOS 3.6.2 check errors (#61). # wk 0.4.0 * Removed `wksxp()` in favour of improved `sf::st_sfc()` support (#21). * Rewrite existing readers, writers, and handlers, using a new C API (#13). * Use new C API in favour of header-only approach for all wk functions (#19, #22). * Use cpp11 to manage safe use of callables that may longjmp from C++. * Vector classes now propagate `attr(, "crs")`, and check that operations that involve more than one vector have compatable CRS objects as determined by `wk_crs_equal()`. * Added an R-level framework for other packages to implement wk readers and handlers: `wk_handle()`, `wk_translate()`, and `wk_writer()` (#37). * Added a native reader and writer for `sf::st_sfc()` objects and implemented R-level generics for sfc, sfg, sf, and bbox objects (#28, #29, #38, #45). * Implement `crc()` vector class to represent circles (#40). * Added a 2D cartesian bounding box handler (`wk_bbox()`) (#42). * Refactored unit tests reflecting use of the new API and for improved test coverage (#44, #45, #46). * Added `wk_meta()`, `wk_vector_meta()`, and `wk_count()` to inspect properties of vectors (#53). * Modified all internal handlers such that they work with vectors of unknown length (#54). # wk 0.3.4 * Fixed reference to `wkutils::plot.wk_wksxp()`, which no longer exists. # wk 0.3.3 * Fixed WKB import of ZM geometries that do not use EWKB. * Added `xy()`, `xyz()`, `xym()` and `xyzm()` classes to efficiently store point geometries. * Added the `rct()` vector class to efficiently store two-dimensional rectangles. * Fixed the CRAN check failure caused by a circular dependency with the wkutils package. * Added S3 methods to coerce sf objects to and from `wkt()`, `wkb()` and `wksxp()`. # wk 0.3.2 * Fixed EWKB output for collections and multi-geometries that included SRID (#3). * Fixed CRAN check errors related to exception handling on MacOS/R 3.6.2. # wk 0.3.1 * Added a `NEWS.md` file to track changes to the package. wk/MD50000644000176200001440000002576614164574002011226 0ustar liggesusersaf93bf1476851daa5867e3fea6af1105 *DESCRIPTION 3af0d5f6726a14ed40722905f3202a79 *LICENSE 6cd4601f2b3a0eb1d9d2834e2042f5fe *NAMESPACE 462b4b92ec58750373e51bc5c56e3c04 *NEWS.md 07229ca016aac31aab432a2ebc28157f *R/affine.R d0e366211810d795520cd57940cef4b8 *R/bbox.R 7691fefc6966915326891a408800c6e2 *R/chunk.R b4b6d7144ef5ac4e243dc7405deaa101 *R/class-data-frame.R c85aca4610e5df0fe504f21fe0a5c602 *R/count.R 273baf8f519a57aec478c2a75b8786eb *R/crc.R 1ea41496e02be2c811b265327ab0c5e6 *R/debug.R 6f8fb587c2f43d702dd7fbffa865f8a1 *R/deprecated.R de3b34dc822c24333954fb68e3594108 *R/filter.R 50b749e262f70cef0b3f5f94ade60306 *R/flatten.R 5ae8ef67abc9c3cd864ea8794bffb202 *R/format.R a216561279e1672fbc1dcc19e18e8c2a *R/handle-crc.R cbfcb9195a860c9e7b1ee5eb568b283f *R/handle-rct.R e5474f9832d64d4dabbb7c978b9d11e4 *R/handle-sfc.R e674743526fd3dce75dbb0b217965c99 *R/handle-slice.R e599ddc46785bef59b1b1765677eee11 *R/handle-wkb.R 5d2a802ae7e14b123a7018ddfe7bceb4 *R/handle-wkt.R 8ac464eacf5a841a6e7f9a3f08d140ae *R/handle-xy.R e16f95228fcd18484647f402131e4eec *R/handler.R 84ec484bc8d6d48424d516a8520ba4b7 *R/make.R 0d5f7dbbf0e63ca5d5a9dae96a4edbd2 *R/meta.R 231c8340bafaecaa42d82aa52f5fdac2 *R/pkg-readr.R 095775ac3e88db05d9d612b84ef17fba *R/pkg-sf.R 65e8e2c7da7d2a52fca1fe43df0023ad *R/pkg-vctrs.R 2c7123bf9fbed42d5105a632c60d4f26 *R/plot.R ff2b3478976082700958ad1e7785d630 *R/problems.R b9efc30e2c29ee4ae86d45282656a60f *R/rct.R f4137c112b283959718fcf8ef7a731cc *R/set.R aa3c64ceaaf1afa96daa60ea5f13e635 *R/sfc-writer.R db01722e2087826a79be5c4aa9254401 *R/transform.R d436efe06000782bedf9d3ec9130184e *R/translate.R e8bbc21f285a4ec31386054e381d3c46 *R/utils.R 0ec723bbead30c6b7a3c9f8a77ecc69d *R/vertex-filter.R 8a5ff3cbb45bf9cb1df9be3e7c0a1398 *R/void.R 6a182fb3984fafb7768f5edc6dad98d5 *R/wk-crs.R ff67a2aa214f800b44d1f4c70888484d *R/wk-package.R 289479d91204317f19b4ab8c9ab4b04d *R/wk-rcrd.R f1c6f6733a3a6ea2f5d4312d6ae4e341 *R/wk-vctr.R a39beb279063ebcc5c1a503079c435d6 *R/wkb-writer.R 298513922a38c53799e6de020febbcd8 *R/wkb.R 64f8f59370841ab7cb51012a14baca05 *R/wkt-writer.R 08b1bf7405235da372f8f15ebcec6f46 *R/wkt.R 17df9ab99f89014ea5beb15ade0086e6 *R/writer.R 711be411600a37b5bb1ae679b878be67 *R/xy-writer.R 90518b39bc7f2cca6139a10ca5330c8d *R/xyzm.R 4f3e0067f8327c3f087c3f463d39f1f0 *R/zzz.R 813e8cfa66f963352cee77cf271fea8a *README.md 25b650133ad3cc0490aa767fa6fbb216 *inst/include/wk-v1-impl.c 4398e4ce425242c9999d2de7c277a301 *inst/include/wk-v1.h a89e851498bc705106625eb60ec60880 *inst/include/wk/coord.hpp 53c88e001fb0d554a35f2edca46d8bde *inst/include/wk/error-formatter.hpp bd893015cfbb75a15ad1c1cd59119312 *inst/include/wk/experimental/wk-v1-filter-cpp11.hpp ecaaf2dad9e6906ee6976a028751ab45 *inst/include/wk/experimental/wk-v1-handler-cpp11.hpp 805466a25bcbf23ec6918c1f485e05eb *inst/include/wk/experimental/wk-v1-reader-cpp11.hpp 949907ddc4641f873e46809e5e0850d2 *inst/include/wk/fields.hpp 637278cf7d166a0ebd57cb1d49a50848 *inst/include/wk/filter.hpp 7f953862bd3f302447d0f12593310a3d *inst/include/wk/geometry-debug-handler.hpp e5a00323d702c9991a9b709a9038f0d3 *inst/include/wk/geometry-formatter.hpp 53c58251e66114faeced948cc896a0f4 *inst/include/wk/geometry-handler.hpp fdad029efcd896f59c0ec2d717a6e00a *inst/include/wk/geometry-meta.hpp b7d7fc09f37716491ee7972b11653e01 *inst/include/wk/geometry.hpp c7830a7ff278c878ef831b4988baec5d *inst/include/wk/io-bytes.hpp 44e3be43c582f8771644db2aeefa4adb *inst/include/wk/io-string.hpp d9eb0147aa913a63756225d6470d8334 *inst/include/wk/io.hpp bf5333984941bfcbdcbad1fc72518b44 *inst/include/wk/parse-exception.hpp f6603a5b82b0efe0e6a784ef98adb9a4 *inst/include/wk/rcpp-coord-reader.hpp 7724ff6078e2b3a621c1ce69e6f81a92 *inst/include/wk/rcpp-io.hpp c23792454a0afd53dc9b8bd55f885e5a *inst/include/wk/rcpp-translate.hpp 1739f9ccc458c9c74e42a37e71937da3 *inst/include/wk/rct.hpp 676b944a4a46ef4a4ed2bef84e58cc8e *inst/include/wk/reader.hpp b2b159e10dd2173b013430920f3e5e1a *inst/include/wk/wkb-reader.hpp 43060bf580c3886cb42083bb5330f8ac *inst/include/wk/wkb-writer.hpp 691996f4c41a21769711097f47e14fa6 *inst/include/wk/wkt-reader.hpp f579c21ee106c62b8f2bc03f6e37221d *inst/include/wk/wkt-streamer.hpp e52814f7637bf098881a82cc88c2676b *inst/include/wk/wkt-writer.hpp ac0f8ace733cbad1f90c01060287fa3e *inst/include/wk/writer.hpp 25ae3d77517713a9ab3adede813a51ce *inst/include/wk/xyzm.hpp 1fabed39ac6ba232cfbdffe4aac65ed5 *man/crc.Rd d4755f9a404c2fc678f18c7591d84411 *man/deprecated.Rd 021aebc167b6a8727b8e2e8ebf64eb25 *man/handle_wkt_without_vector_size.Rd 019a99103e4c9e32fe4d8e005affdf61 *man/new_wk_crc.Rd 179f42bc8837684f59a03d9ef67291fa *man/new_wk_rct.Rd 693efd158835b045a69c9691ac971d4a *man/new_wk_wkb.Rd c5d543123928b1bff81c08620416fe9e *man/new_wk_wkt.Rd 2d5d3d149609b33de00290ef147d848c *man/new_wk_xy.Rd dde2f79536dc45098edafbcc9098581b *man/rct.Rd 6ddc9c905a30ec55cb87b0b03212d76b *man/vctrs-methods.Rd c3379cd338ef96af2f693b2d4a35a6a0 *man/wk-package.Rd afc0a306c05612dd2b1f536372a86014 *man/wk_bbox.Rd 2cd19c865dd73948988b2e9c2215238e *man/wk_chunk_map_feature.Rd 9ba0f48795f5b951e4b2634b5c656af3 *man/wk_chunk_strategy_single.Rd a12ae9ed6ca4faec7de2e04f768528a3 *man/wk_count.Rd 9d2848b776099fdfa03e7b83b121642c *man/wk_crs.Rd 4ba75a566d23b1ac35722ef6f5d33b11 *man/wk_crs_equal.Rd 904e567ee4e886117e361c7397aa9504 *man/wk_crs_inherit.Rd bb070540f70c128f4a0cffc10a5f8d14 *man/wk_crs_proj_definition.Rd d9a76039d8311f02b6ef3466b00c475d *man/wk_debug.Rd 780ac068de9265caccb8ff9089c39410 *man/wk_flatten.Rd 508710faba3c9f06732d68eddfb12190 *man/wk_format.Rd 1d5beccdeff76e4c01bf18d8458cbdef *man/wk_handle.Rd 1aae8b2072ac5cc0c41ac3d1940e23c0 *man/wk_handle.data.frame.Rd 1587996adffd121992c337360dea0fb7 *man/wk_handle_slice.Rd 00d75dc261250d9a564752f7e7c22e1e *man/wk_identity.Rd df2ffd3c1ce726cef13264f7cc86d303 *man/wk_is_geodesic.Rd 840f8de1d0335f205c79b759cd10bbff *man/wk_linestring.Rd 5d87ad58918709b2b3991dcd6d152876 *man/wk_meta.Rd 3edf36d740305e4055d18cbe1cbba1b0 *man/wk_plot.Rd 079690e5589ba1f7336cbb69d8ab7443 *man/wk_problems.Rd e79553346c3dc64f032dac5a4c56951f *man/wk_set_z.Rd 33d7146629ae06fcb2feb686327d19d3 *man/wk_trans_affine.Rd 6d13cd991603149c6864b36d6c90de6a *man/wk_trans_inverse.Rd 8f63984e0002b4bd8f31d20f1d80997b *man/wk_transform.Rd df06bec73d8dd55a872184243cd6ff95 *man/wk_translate.Rd d0d699d84b9c3a86226a1c0d58de3efb *man/wk_vertices.Rd 07fa0f0ce3c5ab7f234162614e6b8dc0 *man/wk_void.Rd 1a037cd19354bcee1c6146e75589baf4 *man/wk_writer.Rd c1d551816b45141d463b7a9b76695180 *man/wkb.Rd 8114fdf243cf23dddeff95afb6e4f0a9 *man/wkt.Rd 9382245a31b69b7845c4b3630c5c54be *man/xy.Rd f5b9af0803f934f67fe4bd2a96273acd *src/Makevars 17ba404d89dca491494045f3e5f2ae55 *src/altrep.h 2f7adb278dc065ffc7e2630677e687ee *src/bbox-handler.c e7239de7f8749c56e507eae4a760af6e *src/count-handler.c 1f9ae820394e37b7ea0689fbe1a5b7d0 *src/debug-filter.c b300d53a85b043d89e9666f1d8c7ba0e *src/flatten-filter.c 3e6a394588605b87bce8eed899bacf9e *src/handle-crc.c 7a950e21a20ee2fceb9d60380c69cd57 *src/handle-rct.c f7792b36d8bf3a7b1338994ae13ce050 *src/handle-sfc.c 8deabca4508679c0815b4d4faed44da5 *src/handle-wkb.c fa4910a37ea6bf1d62fe2d18f4007879 *src/handle-wkt.cpp 6c24033ca1a94a6402c06e3b158e349a *src/handle-xy.c 6711627012f8732db96b5c2a7cecf6c5 *src/identity-filter.c c87fb210639e7675c46860368321b4c1 *src/init.c 4c425ed6283915dee6022635840892e3 *src/internal/buffered-reader.hpp a4b55ab3a13ef91ae98585a3a1b1c5be *src/internal/fast_float/fast_float.h 60b5a87b68adbe208d5e16f96ad600b3 *src/internal/wk-v1-handler.hpp 4fd2d5cdc8502e2a0a0e8ff0361ccc7f *src/make-collection-filter.c b20bb632aa0b5fb894810983cc7385ee *src/make-linestring-filter.c 2c6136a66cbf2b1e46ebf44168a3a9b2 *src/make-polygon-filter.c fb78a5e36ea81a74c9eabeefbca1e2a3 *src/meta-handler.c 19d2d0225a905be46d3109bfc9476de3 *src/port.h 2ac6df712ed2e17aa6e6734acdf0f03e *src/problems-handler.c 0ef821a00dd04c18fa44c1ee62610e8f *src/sfc-writer.c 889d471dad233d05b63df8f8284993bc *src/trans-affine.c 4bc7dad639e9d9e0a1aa6121c6ab1b0d *src/trans-set.c 271c4e1f7607d5b16d492862e1fcf5ee *src/transform.c fe1d11373138bad041fe09970b54175f *src/vctr.c bf034ab7a1cd8c8cf50da8dddcd20707 *src/vertex-filter.c 9b2a4fd6e13861f729c662501194b868 *src/void-handler.c 3ff04996080488941707e8fd75d50d02 *src/wk-v1.c f89df040bd1408403c2e92297bd43199 *src/wkb-writer.c 5fc8e63c032e703d4a072d3a756d1e81 *src/wkt-writer.cpp b5958a09dfb996edaea66fd615e266fb *src/xy-writer.c b17060e2f3f82fabb10c17b68e310237 *tests/testthat.R 057682f8e2caf17d29aae2bfab50e095 *tests/testthat/Rplots.pdf b57e570ebc04b62c0a97647c7cc64f83 *tests/testthat/test-affine.R 7390227c225c1c188630852ff0d3ade2 *tests/testthat/test-bbox.R c534320f59ca2fb54ad6457e115c0203 *tests/testthat/test-chunk.R 1f4b3a793218aeb67d6d806308a58446 *tests/testthat/test-class-data-frame.R ed065e6d1837ac6455d68c92dc829254 *tests/testthat/test-count.R d7be591021c50286e0fed1ecbdb1267a *tests/testthat/test-crc.R cb2fec2820c9b86cc18a9b90cb425aee *tests/testthat/test-debug.R e5938ce732585d4c9c5977c8533cbf6b *tests/testthat/test-filter.R 51f74125012c0037f82a64d4f3951ef0 *tests/testthat/test-flatten.R 4b390cc1e7400ca42c9808149faff952 *tests/testthat/test-format.R 5dbfd3fe3296a47ec4d8f7db5c80776f *tests/testthat/test-handle-crc.R 3c3caecb814d2dbecbaf6d1f7535d33c *tests/testthat/test-handle-rct.R c55c88d5e01522aed112d1fb40e25056 *tests/testthat/test-handle-sfc.R ec0d8c681f262a04d4f384518a1e91f6 *tests/testthat/test-handle-slice.R 13f8b17710881d5e5e6730d9b37483f0 *tests/testthat/test-handle-wkb.R 6e9d04b0b23c40742136ac4cb7f89c83 *tests/testthat/test-handle-wkt.R bbe11c9102d84af30a83fc8034188387 *tests/testthat/test-handle-xy.R b6e101d8d5e0479019b0c4f73764a057 *tests/testthat/test-handler.R a2405953f45d0c9725e68778b352442c *tests/testthat/test-make.R 1796c3d8c0518e5b6336bee1070273de *tests/testthat/test-meta.R 27672dfa9540d728017e1d65e32490ca *tests/testthat/test-pkg-readr.R af7e50ccd37641a5666bc2d00d2928ec *tests/testthat/test-pkg-sf.R ea577734b5710a0db5141cb2c5582035 *tests/testthat/test-pkg-vctrs.R 6dec9fc5c62666fdb5b4ffb18b295cfe *tests/testthat/test-plot.R 8dbaeb61c3170d66455cc7dede88755d *tests/testthat/test-problems.R 0b15b0b725b4bf8c89ef01ccfa80902f *tests/testthat/test-rct.R b02cdbee1658aa72c93c8484c5b03a4e *tests/testthat/test-set.R 8048ab2974673b87a94d76a20aee74d3 *tests/testthat/test-sfc-writer.R 0d2d8e3be93e48bc34e69b3c074c4512 *tests/testthat/test-transform.R 10c6beb5a16b70d562e4c0f1108642c4 *tests/testthat/test-translate.R a9872cde8c76036fa50ee0036f6ae9b4 *tests/testthat/test-utils.R 49d002c7312c9028d68f49159b9a0ff4 *tests/testthat/test-vertex-filter.R 15dc5276e77ef3cb5b149ea02f8771fe *tests/testthat/test-void.R 65a404268235bbcab64bbbf04dd6b27e *tests/testthat/test-wk-crs.R 1b79a4e5f7b7e94ed858f54306026757 *tests/testthat/test-wk-rcrd.R 924336e47b963700582232bb63121e83 *tests/testthat/test-wk-vctr.R bdbb098c5a4f29aeaf59905a4579678e *tests/testthat/test-wkb-writer.R 5184d1243eaedabcae60ddc073971350 *tests/testthat/test-wkb.R 4112e162004f2a3f521d7f596fc83fa8 *tests/testthat/test-wkt-writer.R 8288f95e4d9f12a8981954c5047ac7b5 *tests/testthat/test-wkt.R e95a5af5c4d6ee02340fa9c6dac8f9d2 *tests/testthat/test-writer.R 8c7f24c40b7d218ed687000248cbe3dd *tests/testthat/test-xy-writer.R 72b4e37e3c2240bb438157791380d9cd *tests/testthat/test-xyzm.R wk/inst/0000755000176200001440000000000014106220314011641 5ustar liggesuserswk/inst/include/0000755000176200001440000000000014160220603013265 5ustar liggesuserswk/inst/include/wk/0000755000176200001440000000000014164574002013717 5ustar liggesuserswk/inst/include/wk/wkt-streamer.hpp0000644000176200001440000004321714106220314017052 0ustar liggesusers #ifndef WK_WKT_STREAMER_H #define WK_WKT_STREAMER_H #include #include #include "wk/reader.hpp" #include "wk/geometry-handler.hpp" #include "wk/io-string.hpp" #include using namespace Rcpp; class WKParseableStringException: public WKParseException { public: WKParseableStringException(std::string expected, std::string found, const char* src, size_t pos): WKParseException(makeError(expected, found, src, pos)), expected(expected), found(found), src(src), pos(pos) {} std::string expected; std::string found; std::string src; size_t pos; static std::string makeError(std::string expected, std::string found, const char* src, size_t pos) { std::stringstream stream; stream << "Expected " << expected << " but found " << found << " (:" << pos << ")"; return stream.str().c_str(); } }; class WKParseableString { public: WKParseableString(const char* str, const char* whitespace, const char* sep): str(str), length(strlen(str)), offset(0), whitespace(whitespace), sep(sep) {} // Change the position of the cursor size_t seek(size_t position) { if (position > this->length) { position = this->length; } else if (position < 0) { position = 0; } size_t delta = position - this->offset; this->offset = position; return delta; } void advance() { if (this->offset < this->length) { this->offset++; } } void advance(int n) { if ((this->offset + n) <= this->length) { this->offset += n; } else { this->offset = this->length; } } bool finished() { return this->offset >= this->length; } // Returns the character at the cursor and advances the cursor // by one char readChar() { char out = this->peekChar(); this->advance(); return out; } // Returns the character currently ahead of the cursor // without advancing the cursor (skips whitespace) char peekChar() { this->skipWhitespace(); if (this->offset < this->length) { return this->str[this->offset]; } else { return '\0'; } } // Returns true if the next character is one of `chars` bool is(char c) { return c == this->peekChar(); } // Returns true if the next character is one of `chars` bool isOneOf(const char* chars) { return strchr(chars, this->peekChar()) != nullptr; } // Returns true if the next character is most likely to be a number bool isNumber() { // complicated by nan and inf if (this->isOneOf("-nNiI")) { std::string text = this->peekUntilSep(); try { std::stod(text); return true; } catch(std::exception& e) { return false; } } else { return this->isOneOf("-0123456789"); } } // Returns true if the next character is a letter bool isLetter() { char found = this->peekChar(); return (found >= 'a' && found <= 'z') || (found >= 'A' && found <= 'Z'); } std::string assertWord() { std::string text = this->peekUntilSep(); if (!this->isLetter()) { this->error("a word", quote(text)); } this->advance(text.size()); return text; } // Returns the integer currently ahead of the cursor, // throwing an exception if whatever is ahead of the // cursor cannot be parsed into an integer uint32_t assertInteger() { std::string text = this->peekUntilSep(); try { uint32_t out = std::stoul(text); this->advance(text.size()); return out; } catch (std::exception& e) { if (this->finished()) { this->error("an integer", "end of input"); } else { this->error("an integer", quote(text)); } } } // Returns the double currently ahead of the cursor, // throwing an exception if whatever is ahead of the // cursor cannot be parsed into a double. This will // accept "inf", "-inf", and "nan". double assertNumber() { std::string text = this->peekUntilSep(); try { double out = std::stod(text); this->advance(text.size()); return out; } catch (std::exception& e) { if (this->finished()) { this->error("a number", "end of input"); } else { this->error("a number", quote(text)); } } } // Asserts that the character at the cursor is whitespace, and // returns a std::string of whitespace characters, advancing the // cursor to the end of the whitespace. std::string assertWhitespace() { if (this->finished()) { this->error("whitespace", "end of input"); } char found = this->str[this->offset]; if (strchr(this->whitespace, found) == nullptr) { this->error("whitespace", quote(this->peekUntilSep())); } size_t offset0 = this->offset; size_t nWhitespaceChars = this->skipWhitespace(); return std::string(&(this->str[offset0]), nWhitespaceChars); } void assert_(char c) { char found = this->peekChar(); if (found != c) { this->error(quote(c), quote(found)); } this->advance(); } // Asserts the that the character at the cursor is one of `chars` // and advances the cursor by one (throwing an exception otherwise). char assertOneOf(const char* chars) { char found = this->peekChar(); if ((strlen(chars) > 0) && this->finished()) { this->error(expectedFromChars(chars), "end of input"); } else if (strchr(chars, found) == nullptr) { this->error(expectedFromChars(chars), quote(this->peekUntilSep())); } this->advance(); return found; } // Asserts that the cursor is at the end of the input void assertFinished() { this->assertOneOf(""); } // Returns the text between the cursor and the next separator, // which is defined to be whitespace or the following characters: =;,() // advancing the cursor. If we are at the end of the string, this will // return std::string("") std::string readUntilSep() { this->skipWhitespace(); size_t wordLen = peekUntil(this->sep); bool finished = this->finished(); if (wordLen == 0 && !finished) { wordLen = 1; } std::string out(&(this->str[this->offset]), wordLen); this->advance(wordLen); return out; } // Returns the text between the cursor and the next separator // (" \r\n\t,();=") without advancing the cursor. std::string peekUntilSep() { this->skipWhitespace(); size_t wordLen = peekUntil(this->sep); if (wordLen == 0 && !this->finished()) { wordLen = 1; } return std::string(&(this->str[this->offset]), wordLen); } // Advances the cursor past any whitespace, returning the // number of characters skipped. size_t skipWhitespace() { return this->skipChars(this->whitespace); } // Skips all of the characters in `chars`, returning the number of // characters skipped. size_t skipChars(const char* chars) { size_t offset0 = this->offset; char c = this->str[this->offset]; while ((c != '\0') && strchr(chars, c)) { this->offset++; if (this->offset >= this->length) { break; } c = this->str[this->offset]; } return this->offset - offset0; } // Returns the number of characters until one of `chars` is encountered, // which may be 0. size_t peekUntil(const char* chars) { size_t offset0 = this->offset; size_t offseti = this->offset; char c = this->str[offseti]; while ((c != '\0') && !strchr(chars, c)) { offseti++; if (offseti >= this->length) { break; } c = this->str[offseti]; } return offseti - offset0; } [[ noreturn ]] void errorBefore(std::string expected, std::string found) { throw WKParseableStringException(expected, quote(found), this->str, this->offset - found.size()); } [[noreturn]] void error(std::string expected, std::string found) { throw WKParseableStringException(expected, found, this->str, this->offset); } [[noreturn]] void error(std::string expected) { throw WKParseableStringException(expected, quote(this->peekUntilSep()), this->str, this->offset); } private: const char* str; size_t length; size_t offset; const char* whitespace; const char* sep; static std::string expectedFromChars(const char* chars) { size_t nChars = strlen(chars); if (nChars == 0) { return "end of input"; } else if (nChars == 1) { return quote(chars); } std::stringstream stream; for (size_t i = 0; i < nChars; i++) { if (nChars > 2) { stream << ","; } if (i > 0) { stream << " or "; } stream << quote(chars[i]); } return stream.str(); } static std::string quote(std::string input) { if (input.size() == 0) { return "end of input"; } else { std::stringstream stream; stream << "'" << input << "'"; return stream.str(); } } static std::string quote(char input) { if (input == '\0') { return "end of input"; } else { std::stringstream stream; stream << "'" << input << "'"; return stream.str(); } } }; class WKTString: public WKParseableString { public: WKTString(const char* str): WKParseableString(str, " \r\n\t", " \r\n\t,();=") {} WKGeometryMeta assertGeometryMeta() { WKGeometryMeta meta; std::string geometryType = this->assertWord(); if (geometryType == "SRID") { this->assert_('='); meta.srid = this->assertInteger(); meta.hasSRID = true; this->assert_(';'); geometryType = this->assertWord(); } if (this->is('Z')) { this->assert_('Z'); meta.hasZ = true; } if (this->is('M')) { this->assert_('M'); meta.hasM = true; } if (this->isEMPTY()) { meta.hasSize = true; meta.size = 0; } meta.geometryType = this->geometryTypeFromString(geometryType); return meta; } int geometryTypeFromString(std::string geometryType) { if (geometryType == "POINT") { return WKGeometryType::Point; } else if(geometryType == "LINESTRING") { return WKGeometryType::LineString; } else if(geometryType == "POLYGON") { return WKGeometryType::Polygon; } else if(geometryType == "MULTIPOINT") { return WKGeometryType::MultiPoint; } else if(geometryType == "MULTILINESTRING") { return WKGeometryType::MultiLineString; } else if(geometryType == "MULTIPOLYGON") { return WKGeometryType::MultiPolygon; } else if(geometryType == "GEOMETRYCOLLECTION") { return WKGeometryType::GeometryCollection; } else { this->errorBefore("geometry type or 'SRID='", geometryType); } } bool isEMPTY() { return this->peekUntilSep() == "EMPTY"; } bool assertEMPTYOrOpen() { if (this->isLetter()) { std::string word = this->assertWord(); if (word != "EMPTY") { this->errorBefore("'(' or 'EMPTY'", word); } return true; } else if (this->is('(')) { this->assert_('('); return false; } else { this->error("'(' or 'EMPTY'"); } } }; class WKTStreamer: public WKReader { public: WKTStreamer(WKStringProvider& provider): WKReader(provider), provider(provider) { // constructor and deleter set the thread locale while the object is in use #ifdef _MSC_VER _configthreadlocale(_ENABLE_PER_THREAD_LOCALE); #endif char* p = std::setlocale(LC_NUMERIC, nullptr); if(p != nullptr) { this->saved_locale = p; } std::setlocale(LC_NUMERIC, "C"); } ~WKTStreamer() { std::setlocale(LC_NUMERIC, saved_locale.c_str()); } void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); if (this->provider.featureIsNull()) { this->handler->nextNull(featureId); } else { std::string str = this->provider.featureString(); WKTString s(str.c_str()); this->readGeometryWithType(s, PART_ID_NONE); // we probably want to assert finished here, but // keeping this commented-out until all examples of this // are removed from downstream packages (notably, s2) // s.assertFinished(); } this->handler->nextFeatureEnd(featureId); } protected: WKStringProvider& provider; void readGeometryWithType(WKTString& s, uint32_t partId) { WKGeometryMeta meta = s.assertGeometryMeta(); this->handler->nextGeometryStart(meta, partId); switch (meta.geometryType) { case WKGeometryType::Point: this->readPoint(s, meta); break; case WKGeometryType::LineString: this->readLineString(s, meta); break; case WKGeometryType::Polygon: this->readPolygon(s, meta); break; case WKGeometryType::MultiPoint: this->readMultiPoint(s, meta); break; case WKGeometryType::MultiLineString: this->readMultiLineString(s, meta); break; case WKGeometryType::MultiPolygon: this->readMultiPolygon(s, meta); break; case WKGeometryType::GeometryCollection: this->readGeometryCollection(s, meta); break; default: throw WKParseException("Unknown geometry type integer"); // # nocov } this->handler->nextGeometryEnd(meta, partId); } void readPoint(WKTString& s, const WKGeometryMeta& meta) { if (!s.assertEMPTYOrOpen()) { this->readPointCoordinate(s, meta); s.assert_(')'); } } void readLineString(WKTString& s, const WKGeometryMeta& meta) { this->readCoordinates(s, meta); } void readPolygon(WKTString& s, const WKGeometryMeta& meta) { this->readLinearRings(s, meta); } uint32_t readMultiPoint(WKTString& s, const WKGeometryMeta& meta) { if (s.assertEMPTYOrOpen()) { return 0; } WKGeometryMeta childMeta; uint32_t partId = 0; if (s.isNumber()) { // (0 0, 1 1) do { childMeta = this->childMeta(s, meta, WKGeometryType::Point); this->handler->nextGeometryStart(childMeta, partId); if (s.isEMPTY()) { s.assertWord(); } else { this->readPointCoordinate(s, childMeta); } this->handler->nextGeometryEnd(childMeta, partId); partId++; } while (s.assertOneOf(",)") != ')'); } else { // ((0 0), (1 1)) do { childMeta = this->childMeta(s, meta, WKGeometryType::Point); this->handler->nextGeometryStart(childMeta, partId); this->readPoint(s, childMeta); this->handler->nextGeometryEnd(childMeta, partId); partId++; } while (s.assertOneOf(",)") != ')'); } return partId; } uint32_t readMultiLineString(WKTString& s, const WKGeometryMeta& meta) { if (s.assertEMPTYOrOpen()) { return 0; } WKGeometryMeta childMeta; uint32_t partId = 0; do { childMeta = this->childMeta(s, meta, WKGeometryType::LineString); this->handler->nextGeometryStart(childMeta, partId); this->readLineString(s, childMeta); this->handler->nextGeometryEnd(childMeta, partId); partId++; } while (s.assertOneOf(",)") != ')'); return partId; } uint32_t readMultiPolygon(WKTString& s, const WKGeometryMeta& meta) { if (s.assertEMPTYOrOpen()) { return 0; } WKGeometryMeta childMeta; uint32_t partId = 0; do { childMeta = this->childMeta(s, meta, WKGeometryType::Polygon); this->handler->nextGeometryStart(childMeta, partId); this->readPolygon(s, childMeta); this->handler->nextGeometryEnd(childMeta, partId); partId++; } while (s.assertOneOf(",)") != ')'); return partId; } uint32_t readGeometryCollection(WKTString& s, const WKGeometryMeta& meta) { if (s.assertEMPTYOrOpen()) { return 0; } uint32_t partId = 0; do { this->readGeometryWithType(s, partId); partId++; } while (s.assertOneOf(",)") != ')'); return partId; } uint32_t readLinearRings(WKTString& s, const WKGeometryMeta& meta) { if (s.assertEMPTYOrOpen()) { return 0; } uint32_t ringId = 0; do { this->handler->nextLinearRingStart(meta, WKGeometryMeta::SIZE_UNKNOWN, ringId); this->readCoordinates(s, meta); this->handler->nextLinearRingEnd(meta, WKGeometryMeta::SIZE_UNKNOWN, ringId); ringId++; } while (s.assertOneOf(",)") != ')'); return ringId; } // Point coordinates are special in that there can only be one // coordinate (and reading more than one might cause errors since // writers are unlikely to expect a point geometry with many coordinates). // This assumes that `s` has already been checked for EMPTY or an opener // since this is different for POINT (...) and MULTIPOINT (.., ...) uint32_t readPointCoordinate(WKTString& s, const WKGeometryMeta& meta) { WKCoord coord = this->childCoordinate(meta); this->readCoordinate(s, coord); handler->nextCoordinate(meta, coord, 0); return 1; } uint32_t readCoordinates(WKTString& s, const WKGeometryMeta& meta) { WKCoord coord = this->childCoordinate(meta); if (s.assertEMPTYOrOpen()) { return 0; } uint32_t coordId = 0; do { this->readCoordinate(s, coord); handler->nextCoordinate(meta, coord, coordId); coordId++; } while (s.assertOneOf(",)") != ')'); return coordId; } void readCoordinate(WKTString& s, WKCoord& coord) { coord[0] = s.assertNumber(); for (size_t i = 1; i < coord.size(); i++) { s.assertWhitespace(); coord[i] = s.assertNumber(); } } WKCoord childCoordinate(const WKGeometryMeta& meta) { WKCoord coord; coord.hasZ = meta.hasZ; coord.hasM = meta.hasM; return coord; } WKGeometryMeta childMeta(WKTString& s, const WKGeometryMeta& parent, int geometryType) { WKGeometryMeta childMeta(parent); childMeta.geometryType = geometryType; if (s.isEMPTY()) { childMeta.hasSize = true; childMeta.size = 0; } else { childMeta.hasSize = false; childMeta.size = WKGeometryMeta::SIZE_UNKNOWN; } return childMeta; } private: std::string saved_locale; }; #endif wk/inst/include/wk/geometry-formatter.hpp0000644000176200001440000000256614106220314020263 0ustar liggesusers #ifndef WK_GEOMETRY_FORMATTER_H #define WK_GEOMETRY_FORMATTER_H #include "wk/geometry-handler.hpp" #include "wk/wkb-reader.hpp" #include "wk/wkt-streamer.hpp" #include "wk/wkt-writer.hpp" class WKMaxCoordinatesException: public WKParseException { public: static const int CODE_HAS_MAX_COORDS = 32453; WKMaxCoordinatesException(): WKParseException(CODE_HAS_MAX_COORDS) {} }; class WKGeometryFormatter: public WKTWriter { public: WKGeometryFormatter(WKStringExporter& exporter, int maxCoords): WKTWriter(exporter), maxCoords(maxCoords), thisFeatureCoords(0) {} void nextFeatureStart(size_t featureId) { this->thisFeatureCoords = 0; WKTWriter::nextFeatureStart(featureId); } void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { WKTWriter::nextCoordinate(meta, coord, coordId); this->thisFeatureCoords++; if (this->thisFeatureCoords >= this->maxCoords) { throw WKMaxCoordinatesException(); } } bool nextError(WKParseException& error, size_t featureId) { if (error.code() == WKMaxCoordinatesException::CODE_HAS_MAX_COORDS) { this->exporter.writeConstChar("..."); } else { this->exporter.writeConstChar("!!! "); this->exporter.writeConstChar(error.what()); } this->nextFeatureEnd(featureId); return true; } private: int maxCoords; int thisFeatureCoords; }; #endif wk/inst/include/wk/wkb-reader.hpp0000644000176200001440000001202414106220314016440 0ustar liggesusers #ifndef WK_WKB_READER_H #define WK_WKB_READER_H #include "wk/reader.hpp" #include "wk/parse-exception.hpp" #include "wk/geometry-meta.hpp" #include "wk/io-bytes.hpp" #include "wk/geometry-handler.hpp" #include "wk/coord.hpp" class WKBReader: public WKReader { public: const static unsigned char ENDIAN_NONE = 0xff; WKBReader(WKBytesProvider& provider): WKReader(provider), provider(provider) { this->swapEndian = false; this->featureId = 0; this->partId = PART_ID_NONE; this->ringId = RING_ID_NONE; this->coordId = COORD_ID_NONE; this->srid = WKGeometryMeta::SRID_NONE; this->endian = ENDIAN_NONE; } void iterateFeature() { this->endian = ENDIAN_NONE; WKReader::iterateFeature(); } protected: WKBytesProvider& provider; unsigned char endian; void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); if (this->provider.featureIsNull()) { this->handler->nextNull(featureId); } else { this->readGeometry(PART_ID_NONE); } this->handler->nextFeatureEnd(featureId); } void readGeometry(uint32_t partId) { WKGeometryMeta meta = this->readMeta(); this->handler->nextGeometryStart(meta, partId); switch (meta.geometryType) { case WKGeometryType::Point: this->readPoint(meta); break; case WKGeometryType::LineString: this->readLineString(meta); break; case WKGeometryType::Polygon: this->readPolygon(meta); break; case WKGeometryType::MultiPoint: case WKGeometryType::MultiLineString: case WKGeometryType::MultiPolygon: case WKGeometryType::GeometryCollection: this->readCollection(meta); break; default: // # nocov start std::stringstream err; err << "Invalid integer geometry type: " << meta.geometryType; throw WKParseException(err.str()); // # nocov end } this->handler->nextGeometryEnd(meta, partId); } WKGeometryMeta readMeta() { this->endian = this->readChar(); this->swapEndian = ((int)endian != (int)WKBytesUtils::nativeEndian()); WKGeometryMeta meta = WKGeometryMeta(this->readUint32()); if (meta.hasSRID) { meta.srid = this->readUint32(); this->srid = meta.srid; } if (meta.geometryType == WKGeometryType::Point) { meta.hasSize = true; meta.size = 1; } else { meta.hasSize = true; meta.size = this->readUint32(); } return meta; } void readPoint(const WKGeometryMeta& meta) { this->readCoordinate(meta, 0); } void readLineString(const WKGeometryMeta& meta) { for (uint32_t i=0; i < meta.size; i++) { this->coordId = i; this->readCoordinate(meta, i); } } void readPolygon(WKGeometryMeta& meta) { uint32_t ringSize; for (uint32_t i=0; i < meta.size; i++) { this->ringId = i; ringSize = this->readUint32(); this->readLinearRing(meta, ringSize, i); } } void readLinearRing(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->handler->nextLinearRingStart(meta, size, ringId); for (uint32_t i=0; i < size; i++) { this->coordId = i; this->readCoordinate(meta, i); } this->handler->nextLinearRingEnd(meta, size, ringId); } void readCollection(const WKGeometryMeta& meta) { for (uint32_t i=0; i < meta.size; i++) { this->partId = i; this->readGeometry(i); } } void readCoordinate(const WKGeometryMeta& meta, uint32_t coordId) { this->x = this->readDouble(); this->y = this->readDouble(); if (meta.hasZ && meta.hasM) { this->z = this->readDouble(); this->m = this->readDouble(); this->handler->nextCoordinate(meta, WKCoord::xyzm(x, y, z, m), coordId); } else if (meta.hasZ) { this->z = this->readDouble(); this->handler->nextCoordinate(meta, WKCoord::xyz(x, y, z), coordId); } else if (meta.hasM) { this->m = this->readDouble(); this->handler->nextCoordinate(meta, WKCoord::xym(x, y, m), coordId); } else { this->handler->nextCoordinate(meta, WKCoord::xy(x, y), coordId); } } // endian swapping is hard to replicate...these might be useful // for subclasses that implement an extension of WKB unsigned char readChar() { return this->readCharRaw(); } double readDouble() { if (this->swapEndian) { return WKBytesUtils::swapEndian(this->readDoubleRaw()); } else return this->readDoubleRaw(); } private: bool swapEndian; uint32_t partId; uint32_t ringId; uint32_t coordId; uint32_t srid; double x; double y; double z; double m; double readUint32() { if (this->swapEndian) { return WKBytesUtils::swapEndian(this->readUint32Raw()); } else return this->readUint32Raw(); } unsigned char readCharRaw() { return this->provider.readCharRaw(); } double readDoubleRaw() { return this->provider.readDoubleRaw(); } uint32_t readUint32Raw() { return this->provider.readUint32Raw(); } bool seekNextFeature() { return this->provider.seekNextFeature(); } }; #endif wk/inst/include/wk/xyzm.hpp0000644000176200001440000000642314106220314015432 0ustar liggesusers #ifndef WK_XYZM_HPP #define WK_XYZM_HPP #include #include "wk/fields.hpp" template class WKXYZMReader: public WKFieldsReader { public: WKXYZMReader(WKFieldsProvider& provider): WKFieldsReader(provider) {} void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); double x = this->provider.template field(0); double y = this->provider.template field(1); double z = this->provider.template field(2); double m = this->provider.template field(3); WKGeometryMeta meta(WKGeometryType::Point); meta.hasSize = true; meta.hasZ = !std::isnan(z); meta.hasM = !std::isnan(m); // treat NA, NA, NA as an empty point if (std::isnan(x) && std::isnan(y) && std::isnan(z) && std::isnan(m)) { meta.size = 0; this->handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); this->handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } else { meta.size = 1; WKCoord coord = WKCoord::xyzm(x, y, z, m); coord.hasZ = meta.hasZ; coord.hasM = meta.hasM; this->handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); this->handler->nextCoordinate(meta, coord, 0); this->handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } this->handler->nextFeatureEnd(featureId); } }; template class WKXYZMWriter: public WKFieldsWriter { public: WKXYZMWriter(WKFieldsExporter& exporter): WKFieldsWriter(exporter) {} virtual void nextFeatureStart(size_t featureId) { WKFieldsWriter::nextFeatureStart(featureId); } void nextNull(size_t featureId) { this->exporter.template setField(0, NAN); this->exporter.template setField(1, NAN); this->exporter.template setField(2, NAN); this->exporter.template setField(3, NAN); } void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { if (meta.geometryType != WKGeometryType::Point) { throw std::runtime_error("Can't create xy(zm) from a non-point"); } if (meta.size == 0) { this->exporter.template setField(0, NAN); this->exporter.template setField(1, NAN); this->exporter.template setField(2, NAN); this->exporter.template setField(3, NAN); } } void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->exporter.template setField(0, coord.x); this->exporter.template setField(1, coord.y); if (coord.hasZ) { this->exporter.template setField(2, coord.z); } else { this->exporter.template setField(2, NAN); } if (coord.hasM) { this->exporter.template setField(3, coord.m); } else { this->exporter.template setField(3, NAN); } } }; #endif wk/inst/include/wk/geometry-handler.hpp0000644000176200001440000000165014106220314017666 0ustar liggesusers #ifndef WK_GEOMETRY_HANDLER_H #define WK_GEOMETRY_HANDLER_H #include "wk/coord.hpp" #include "wk/parse-exception.hpp" #include "wk/geometry-meta.hpp" class WKGeometryHandler { public: virtual void nextFeatureStart(size_t featureId) { } virtual void nextFeatureEnd(size_t featureId) { } virtual void nextNull(size_t featureId) { } virtual void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { } virtual void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { } virtual void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { } virtual void nextLinearRingEnd(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { } virtual void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { } virtual bool nextError(WKParseException& error, size_t featureId) { return false; } }; #endif wk/inst/include/wk/geometry-debug-handler.hpp0000644000176200001440000000773114106220314020760 0ustar liggesusers #ifndef WK_GEOMETRY_DEBUG_HANDLER_H #define WK_GEOMETRY_DEBUG_HANDLER_H #include "wk/coord.hpp" #include "wk/geometry-handler.hpp" #include "wk/parse-exception.hpp" #include "wk/geometry-meta.hpp" #include "wk/geometry-debug-handler.hpp" class WKGeometryDebugHandler: public WKGeometryHandler { public: WKGeometryDebugHandler(std::ostream& out): out(out), indentationLevel(0) {} virtual void nextFeatureStart(size_t featureId) { this->indentationLevel = 0; this->indent(); out << "nextFeatureStart(" << featureId << ")\n"; this->indentationLevel++; } virtual void nextFeatureEnd(size_t featureId) { this->indentationLevel--; this->indent(); out << "nextFeatureEnd(" << featureId << ")\n"; } virtual void nextNull(size_t featureId) { this->indent(); out << "nextNull(" << featureId << ")\n"; } virtual void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { this->indent(); out << "nextGeometryStart("; this->writeMeta(meta); out << ", "; this->writeMaybeUnknown(partId, "WKReader::PART_ID_NONE"); out << ")\n"; this->indentationLevel++; } virtual void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { this->indentationLevel--; this->indent(); out << "nextGeometryEnd("; this->writeMeta(meta); out << ", "; this->writeMaybeUnknown(partId, "WKReader::PART_ID_NONE"); out << ")\n"; } virtual void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->indent(); out << "nextLinearRingStart("; this->writeMeta(meta); out << ", "; this->writeMaybeUnknown(size, "WKGeometryMeta::SIZE_UNKNOWN"); out << ", " << ringId << ")\n"; this->indentationLevel++; } virtual void nextLinearRingEnd(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->indentationLevel--; this->indent(); out << "nextLinearRingEnd("; this->writeMeta(meta); out << ", "; this->writeMaybeUnknown(size, "WKGeometryMeta::SIZE_UNKNOWN"); out << ", " << ringId << ")\n"; } virtual void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->indent(); out << "nextCoordinate("; this->writeMeta(meta); out << ", " << "WKCoord(x = " << coord.x << ", y = " << coord.y; if (coord.hasZ) { out << ", z = " << coord.z; } if (coord.hasM) { out << ", m = " << coord.m; } out << "), " << coordId << ")\n"; } virtual bool nextError(WKParseException& error, size_t featureId) { out << "nextError('" << error.what() << "', " << featureId << ")\n"; return true; } virtual void writeMaybeUnknown(uint32_t value, const char* ifUnknown) { if (value == UINT32_MAX) { out << ifUnknown; } else { out << value; } } virtual void writeMeta(const WKGeometryMeta& meta) { this->writeGeometryType(meta.geometryType); if (meta.hasSRID) { out << " SRID=" << meta.srid; } if (meta.hasSize) { out << " [" << meta.size << "]"; } else { out << " [unknown]"; } } virtual void writeGeometryType(uint32_t simpleGeometryType) { switch (simpleGeometryType) { case WKGeometryType::Point: out << "POINT"; break; case WKGeometryType::LineString: out << "LINESTRING"; break; case WKGeometryType::Polygon: out << "POLYGON"; break; case WKGeometryType::MultiPoint: out << "MULTIPOINT"; break; case WKGeometryType::MultiLineString: out << "MULTILINESTRING"; break; case WKGeometryType::MultiPolygon: out << "MULTIPOLYGON"; break; case WKGeometryType::GeometryCollection: out << "GEOMETRYCOLLECTION"; break; default: out << "Unknown Type (" << simpleGeometryType << ")"; break; } } virtual void indent() { for (int i=0; i < indentationLevel; i++) { out << " "; } } protected: std::ostream& out; int indentationLevel; }; #endif wk/inst/include/wk/io-string.hpp0000644000176200001440000000271514106220314016336 0ustar liggesusers #ifndef WK_IO_STRING_H #define WK_IO_STRING_H #include #include #include "wk/io.hpp" // for now, the only option is to provide a reference to a string // the string tokenizer operates on a string iterator, which might be // more flexible for the WKT reader but less flexible for other applications class WKStringProvider: public WKProvider { public: virtual const std::string featureString() = 0; }; class WKStringExporter: public WKExporter { public: WKStringExporter(size_t size): WKExporter(size) {} virtual void writeString(std::string value) = 0; virtual void writeConstChar(const char* value) = 0; virtual void writeDouble(double value) = 0; virtual void writeUint32(uint32_t value) = 0; }; class WKStringStreamExporter: public WKStringExporter { public: WKStringStreamExporter(size_t size): WKStringExporter(size) { this->stream.imbue(std::locale::classic()); } void setRoundingPrecision(int precision) { this->stream.precision(precision); } void setTrim(bool trim) { if (trim) { this->stream.unsetf(stream.fixed); } else { this->stream.setf(stream.fixed); } } void writeString(std::string value) { this->stream << value; } void writeConstChar(const char* value) { this->stream << value; } void writeDouble(double value) { this->stream << value; } void writeUint32(uint32_t value) { this->stream << value; } protected: std::stringstream stream; }; #endif wk/inst/include/wk/writer.hpp0000644000176200001440000000376514106220314015745 0ustar liggesusers #ifndef WK_WRITER_H #define WK_WRITER_H #include "wk/geometry-handler.hpp" #include "wk/geometry-meta.hpp" #include "wk/io.hpp" class WKWriter: public WKGeometryHandler { public: // by default, leave everything as is! WKWriter(WKExporter& exporter): exporter(exporter), includeZ(2), includeM(2), includeSRID(2) {} virtual void nextFeatureStart(size_t featureId) { exporter.prepareNextFeature(); } virtual void nextNull(size_t featureId) { exporter.writeNull(); } virtual void nextFeatureEnd(size_t featureId) { exporter.writeNextFeature(); } // creation options for all WKX formats void setIncludeSRID(int includeSRID) { this->includeSRID = includeSRID; } void setIncludeZ(int includeZ) { this->includeZ = includeZ; } void setIncludeM(int includeM) { this->includeM = includeM; } protected: WKExporter& exporter; int includeZ; int includeM; int includeSRID; WKGeometryMeta newMeta; virtual WKGeometryMeta getNewMeta(const WKGeometryMeta& meta) { WKGeometryMeta newMeta( meta.geometryType, this->actuallyIncludeZ(meta), this->actuallyIncludeM(meta), this->actuallyIncludeSRID(meta) ); newMeta.srid = meta.srid; newMeta.hasSize = meta.hasSize; newMeta.size = meta.size; return newMeta; } bool actuallyIncludeZ(const WKGeometryMeta& meta) { return actuallyInclude(this->includeZ, meta.hasZ, "Z"); } bool actuallyIncludeM(const WKGeometryMeta& meta) { return actuallyInclude(this->includeM, meta.hasM, "M"); } bool actuallyIncludeSRID(const WKGeometryMeta& meta) { return actuallyInclude(this->includeSRID, meta.hasSRID, "SRID"); } bool actuallyInclude(int flag, bool hasValue, const char* label) { if (flag == 1 && !hasValue) { std::stringstream err; err << "Can't include " << label << " values in a geometry for which " << label << " values are not defined"; throw std::runtime_error(err.str()); } return flag && hasValue; } }; #endif wk/inst/include/wk/rcpp-coord-reader.hpp0000644000176200001440000002133314106220314017730 0ustar liggesusers #ifndef WK_RCPP_COORD_READER_H #define WK_RCPP_COORD_READER_H #include #include "wk/io.hpp" #include "wk/coord.hpp" #include "wk/reader.hpp" #include "wk/geometry-meta.hpp" #include class WKRcppPointCoordProvider: public WKProvider { public: WKRcppPointCoordProvider(Rcpp::NumericVector x, Rcpp::NumericVector y, Rcpp::NumericVector z, Rcpp::NumericVector m): x(x), y(y), z(z), m(m), index(-1) {} void readFeature(WKGeometryHandler* handler) { if (((size_t) this->index) >= this->nFeatures() || this->index < 0) { throw std::runtime_error("attempt to access index out of range"); } if (this->coordEmpty(this->index)) { WKGeometryMeta meta(WKGeometryType::Point, 0); handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } else { WKCoord coord = this->coord(this->index); WKGeometryMeta meta(WKGeometryType::Point, 1); meta.hasZ = coord.hasZ; meta.hasM = coord.hasM; handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); handler->nextCoordinate(meta, coord, 0); handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } } WKCoord coord(R_xlen_t i) { double xi = x[i]; double yi = y[i]; double zi = z[i]; double mi = m[i]; if (std::isnan(zi) && std::isnan(mi)) { return WKCoord::xy(xi, yi); } else if (std::isnan(mi)) { return WKCoord::xyz(xi, yi, zi); } else if (std::isnan(zi)) { return WKCoord::xym(xi, yi, mi); } else { return WKCoord::xyzm(xi, yi, zi, mi); } } bool coordEmpty(R_xlen_t i) { return std::isnan(x[i]) && std::isnan(y[i]) && std::isnan(z[i]) && std::isnan(m[i]); } virtual bool seekNextFeature() { this->index++; if (this->index >= this->nFeatures()) { return false; } else { return true; } } virtual size_t nFeatures() { return this->x.size(); } bool featureIsNull() { return false; } void reset() { this->index = -1; } protected: Rcpp::NumericVector x; Rcpp::NumericVector y; Rcpp::NumericVector z; Rcpp::NumericVector m; R_xlen_t index; }; class WKRcppLinestringCoordProvider: public WKRcppPointCoordProvider { public: WKRcppLinestringCoordProvider(Rcpp::NumericVector x, Rcpp::NumericVector y, Rcpp::NumericVector z, Rcpp::NumericVector m, Rcpp::IntegerVector featureId): WKRcppPointCoordProvider(x, y, z, m), featureId(featureId), nSizes(-1) {} virtual void readFeature(WKGeometryHandler* handler) { if (this->index >= this->nFeatures() || this->index < 0) { throw std::runtime_error("attempt to access index out of range"); } uint32_t size = this->sizes[this->index]; R_xlen_t offset = this->offsets[this->index]; WKCoord firstCoord = this->coord(offset); WKGeometryMeta meta(WKGeometryType::LineString, size); meta.hasZ = firstCoord.hasZ; meta.hasM = firstCoord.hasM; handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); for (uint32_t i = 0; i < size; i++) { WKCoord coord = this->coord(offset + i); handler->nextCoordinate(meta, coord, i); } handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } virtual size_t nFeatures() { if (this->nSizes == -1) { if (featureId.size() == 0) { this->nSizes = 0; return this->nSizes; } R_xlen_t currentSize = 0; this->offsets.push_back(0); for (R_xlen_t i = 1; i < featureId.length(); i++) { currentSize++; if (this->featureId[i - 1] != this->featureId[i]) { this->sizes.push_back(currentSize); currentSize = 0; this->offsets.push_back(i); } } this->sizes.push_back(currentSize + 1); this->nSizes = this->offsets.size(); } return this->nSizes; } protected: Rcpp::IntegerVector featureId; R_xlen_t nSizes; std::vector sizes; std::vector offsets; }; class WKRcppPolygonCoordProvider: public WKRcppPointCoordProvider { public: WKRcppPolygonCoordProvider(Rcpp::NumericVector x, Rcpp::NumericVector y, Rcpp::NumericVector z, Rcpp::NumericVector m, Rcpp::IntegerVector featureId, Rcpp::IntegerVector ringId): WKRcppPointCoordProvider(x, y, z, m), featureId(featureId), ringId(ringId), nSizes(-1) {} virtual void readFeature(WKGeometryHandler* handler) { if (this->index >= this->nFeatures() || this->index < 0) { throw std::runtime_error("attempt to access index out of range"); } R_xlen_t featureOffset = this->offsets[this->index]; WKCoord firstCoord = this->coord(featureOffset); WKGeometryMeta meta(WKGeometryType::Polygon, this->ringSizes[this->index].size()); meta.hasZ = firstCoord.hasZ; meta.hasM = firstCoord.hasM; handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); R_xlen_t offset = featureOffset; for (uint32_t i = 0; i < meta.size; i++) { uint32_t ringSize = this->ringSizes[this->index][i]; bool ringIsClosed = this->ringClosed[this->index][i]; uint32_t ringSizeOut = ringSize + !ringIsClosed; firstCoord = this->coord(offset); handler->nextLinearRingStart(meta, ringSizeOut, i); for (uint32_t j = 0; j < ringSize; j++) { WKCoord coord = this->coord(offset + j); handler->nextCoordinate(meta, coord, j); } if (!ringIsClosed) { handler->nextCoordinate(meta, firstCoord, ringSize); } handler->nextLinearRingEnd(meta, ringSize, i); offset += ringSize; } handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } virtual size_t nFeatures() { if (this->nSizes == -1) { if (featureId.size() == 0) { this->nSizes = 0; return this->nSizes; } R_xlen_t currentSize = 0; WKCoord firstCoord = this->coord(0); std::vector featureRingClosed; std::vector featureRingSizes; this->offsets.push_back(0); for (R_xlen_t i = 1; i < featureId.length(); i++) { currentSize++; bool isRingTransition = currentSize > 1 && this->ringId[i - 1] != this->ringId[i]; bool isFeatureTransition = this->featureId[i - 1] != this->featureId[i]; if (isRingTransition || isFeatureTransition) { WKCoord lastCoord = this->coord(i - 1); featureRingClosed.push_back(lastCoord == firstCoord); featureRingSizes.push_back(currentSize); currentSize = 0; firstCoord = this->coord(i); } if (isFeatureTransition) { this->ringClosed.push_back(std::move(featureRingClosed)); this->ringSizes.push_back(std::move(featureRingSizes)); featureRingClosed = std::vector(); featureRingSizes = std::vector(); this->offsets.push_back(i); } } WKCoord lastCoord = this->coord(featureId.length() - 1); featureRingClosed.push_back(lastCoord == firstCoord); featureRingSizes.push_back(currentSize + 1); this->ringClosed.push_back(std::move(featureRingClosed)); this->ringSizes.push_back(std::move(featureRingSizes)); this->nSizes = this->offsets.size(); } return this->nSizes; } protected: Rcpp::IntegerVector featureId; Rcpp::IntegerVector ringId; R_xlen_t nSizes; std::vector> ringSizes; std::vector> ringClosed; std::vector offsets; }; class WKRcppPointCoordReader: public WKReader { public: WKRcppPointCoordReader(WKRcppPointCoordProvider& provider): WKReader(provider), provider(provider) {} void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); this->provider.readFeature(this->handler); this->handler->nextFeatureEnd(featureId); } protected: WKRcppPointCoordProvider& provider; }; class WKRcppLinestringCoordReader: public WKReader { public: WKRcppLinestringCoordReader(WKRcppLinestringCoordProvider& provider): WKReader(provider), provider(provider) {} void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); this->provider.readFeature(this->handler); this->handler->nextFeatureEnd(featureId); } protected: WKRcppLinestringCoordProvider& provider; }; class WKRcppPolygonCoordReader: public WKReader { public: WKRcppPolygonCoordReader(WKRcppPolygonCoordProvider& provider): WKReader(provider), provider(provider) {} void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); this->provider.readFeature(this->handler); this->handler->nextFeatureEnd(featureId); } protected: WKRcppPolygonCoordProvider& provider; }; #endif wk/inst/include/wk/geometry.hpp0000644000176200001440000000303114106220314016246 0ustar liggesusers #ifndef WK_GEOMETRY_H #define WK_GEOMETRY_H #include #include #include "wk/geometry-meta.hpp" #include "wk/coord.hpp" class WKGeometry { public: WKGeometry(WKGeometryMeta meta): meta(meta) {} virtual ~WKGeometry() {} WKGeometryMeta meta; virtual uint32_t size() = 0; virtual void addCoordinate(const WKCoord& coord) = 0; }; class WKPoint: public WKGeometry { public: WKPoint(WKGeometryMeta meta): WKGeometry(meta) {} std::vector coords; uint32_t size() { return coords.size(); } void addCoordinate(const WKCoord& coord) { coords.push_back(coord); } }; class WKLineString: public WKGeometry { public: WKLineString(WKGeometryMeta meta): WKGeometry(meta) {} std::vector coords; uint32_t size() { return coords.size(); } void addCoordinate(const WKCoord& coord) { coords.push_back(coord); } }; class WKLinearRing: public std::vector {}; class WKPolygon: public WKGeometry { public: WKPolygon(WKGeometryMeta meta): WKGeometry(meta) {} std::vector rings; uint32_t size() { return rings.size(); } void addCoordinate(const WKCoord& coord) { rings[rings.size() - 1].push_back(coord); } }; class WKCollection: public WKGeometry { public: WKCollection(WKGeometryMeta meta): WKGeometry(meta) {} std::vector> geometries; uint32_t size() { return geometries.size(); } void addCoordinate(const WKCoord& coord) { geometries[geometries.size() - 1]->addCoordinate(coord); } }; #endif wk/inst/include/wk/parse-exception.hpp0000644000176200001440000000073514106220314017531 0ustar liggesusers #ifndef WK_PARSE_EXCEPTION_H #define WK_PARSE_EXCEPTION_H #include #include class WKParseException: public std::runtime_error { public: static const int CODE_UNSPECIFIED = 0; WKParseException(int code): std::runtime_error(""), exceptionCode(code) {} WKParseException(std::string message): std::runtime_error(message), exceptionCode(CODE_UNSPECIFIED) {} int code() { return this->exceptionCode; } private: int exceptionCode; }; #endif wk/inst/include/wk/reader.hpp0000644000176200001440000000244114106220314015661 0ustar liggesusers #ifndef WK_READER_H #define WK_READER_H #include "wk/geometry-meta.hpp" #include "wk/geometry-handler.hpp" #include "wk/io.hpp" class WKReader { public: const static uint32_t PART_ID_NONE = UINT32_MAX; const static uint32_t RING_ID_NONE = UINT32_MAX; const static uint32_t COORD_ID_NONE = UINT32_MAX; WKReader(WKProvider& provider): handler(nullptr), provider(provider) { this->reset(); } virtual void reset() { this->provider.reset(); this->featureId = 0; } virtual void setHandler(WKGeometryHandler* handler) { this->handler = handler; } virtual bool hasNextFeature() { return this->provider.seekNextFeature(); } virtual void iterateFeature() { // check to make sure there is a valid handler if (handler == nullptr) { throw std::runtime_error("Unset handler in WKReader::iterateFeature()"); } try { this->readFeature(this->featureId); } catch (WKParseException& error) { if (!handler->nextError(error, this->featureId)) { throw error; } } this->featureId++; } virtual size_t nFeatures() { return this->provider.nFeatures(); } protected: WKGeometryHandler* handler; size_t featureId; virtual void readFeature(size_t featureId) = 0; private: WKProvider& provider; }; #endif wk/inst/include/wk/fields.hpp0000644000176200001440000000457314106220314015675 0ustar liggesusers #ifndef WK_FIELDS_HPP #define WK_FIELDS_HPP #include #include "wk/io.hpp" #include "wk/reader.hpp" #include "wk/writer.hpp" template class WKFieldsProvider: public WKProvider { public: WKFieldsProvider(const ContainerType& container, uint32_t size): container(container), size(size), index(UINT32_MAX) {} template ItemType field(size_t field) { const VectorType& vector = this->container[field]; return vector[this->index]; } virtual size_t nFields() { return this->container.size(); } size_t nFeatures() { return this->size; } // whether or not a feature is null has to be resolved // by individual type readers...without knowing anything // about the vector types it isn't possible bool featureIsNull() { return false; } void reset() { this->index = UINT32_MAX; } bool seekNextFeature() { if (this->index == UINT32_MAX) { this->index = 0; } else { this->index++; } return this->index < this->nFeatures(); } protected: const ContainerType& container; private: uint32_t size; uint32_t index; }; template class WKFieldsExporter: public WKExporter { public: WKFieldsExporter(ContainerType container, size_t size): WKExporter(size), container(container), index(0) {} template void setField(size_t field, ItemType value) { VectorType vector = this->container[field]; vector[this->index] = value; } size_t nFields() { return this->container.size(); } void prepareNextFeature() {} void writeNull() { throw std::runtime_error("writeNull() not meaningful for WKFieldsExporter"); } void writeNextFeature() { this->index++; } protected: ContainerType container; size_t index; }; template class WKFieldsReader: public WKReader { public: WKFieldsReader(WKFieldsProvider& provider): WKReader(provider), provider(provider) {} protected: WKFieldsProvider& provider; }; template class WKFieldsWriter: public WKWriter { public: WKFieldsWriter(WKFieldsExporter& exporter): WKWriter(exporter), exporter(exporter) {} virtual void nextNull(size_t featureId) = 0; protected: WKFieldsExporter& exporter; }; #endif wk/inst/include/wk/io.hpp0000644000176200001440000000101214106220314015017 0ustar liggesusers #ifndef WK_IO_H #define WK_IO_H class WKProvider { public: virtual bool seekNextFeature() = 0; virtual bool featureIsNull() = 0; virtual size_t nFeatures() = 0; virtual void reset() = 0; virtual ~WKProvider() {} }; class WKExporter { public: WKExporter(size_t size): size(size) {} virtual void prepareNextFeature() = 0; virtual void writeNull() = 0; virtual void writeNextFeature() = 0; size_t nFeatures() { return this->size; } virtual ~WKExporter() {} private: size_t size; }; #endif wk/inst/include/wk/coord.hpp0000644000176200001440000000351414106220314015527 0ustar liggesusers #ifndef WK_WKCOORD_H #define WK_WKCOORD_H #include #include #include class WKCoord { public: double x; double y; double z; double m; bool hasZ; bool hasM; WKCoord(): x(NAN), y(NAN), z(NAN), m(NAN), hasZ(false), hasM(false) {} WKCoord(double x, double y, double z, double m, bool hasZ, bool hasM): x(x), y(y), z(z), m(m), hasZ(hasZ), hasM(hasM) {} bool operator == (WKCoord& other) { if (this->hasZ != other.hasZ || this->hasM != other.hasM) { return false; } for (size_t i = 0; i < this->size(); i++) { if ((*this)[i] != other[i]) { return false; } } return true; } double& operator[](std::size_t idx) { switch (idx) { case 0: return x; case 1: return y; case 2: if (hasZ) { return z; } else if (hasM) { return m; } case 3: if (hasM) return m; default: throw std::runtime_error("Coordinate subscript out of range"); } } const double& operator[](std::size_t idx) const { switch (idx) { case 0: return x; case 1: return y; case 2: if (hasZ) { return z; } else if (hasM) { return m; } case 3: if (hasM) return m; default: throw std::runtime_error("Coordinate subscript out of range"); } } const size_t size() const { return 2 + hasZ + hasM; } static const WKCoord xy(double x, double y) { return WKCoord(x, y, NAN, NAN, false, false); } static const WKCoord xyz(double x, double y, double z) { return WKCoord(x, y, z, NAN, true, false); } static const WKCoord xym(double x, double y, double m) { return WKCoord(x, y, NAN, m, false, true); } static const WKCoord xyzm(double x, double y, double z, double m) { return WKCoord(x, y, z, m, true, true); } }; #endif wk/inst/include/wk/experimental/0000755000176200001440000000000014160220603016403 5ustar liggesuserswk/inst/include/wk/experimental/wk-v1-handler-cpp11.hpp0000644000176200001440000001632614160220603022426 0ustar liggesusers #ifndef WK_V1_HANDLER_HPP_INCLUDED #define WK_V1_HANDLER_HPP_INCLUDED #include "cpp11/protect.hpp" #include "cpp11/declarations.hpp" #include "wk-v1.h" // ---- the class one should extend when writing handlers in C++ --- class WKVoidHandler { public: WKVoidHandler() {} virtual ~WKVoidHandler() {} virtual void initialize(int* dirty) { if (*dirty) { cpp11::stop("Can't re-use this wk_handler"); } *dirty = 1; } virtual int vector_start(const wk_vector_meta_t* meta) { return WK_CONTINUE; } virtual int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return WK_CONTINUE; } virtual int null_feature() { return WK_CONTINUE; } virtual int geometry_start(const wk_meta_t* meta, uint32_t part_id) { return WK_CONTINUE; } virtual int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ring_id) { return WK_CONTINUE; } virtual int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id) { return WK_CONTINUE; } virtual int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ring_id) { return WK_CONTINUE; } virtual int geometry_end(const wk_meta_t* meta, uint32_t part_id) { return WK_CONTINUE; } virtual int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return WK_CONTINUE; } virtual SEXP vector_end(const wk_vector_meta_t* meta) { return R_NilValue; } virtual void deinitialize() { } virtual int error(const char* message) { cpp11::stop(message); } }; // Need our own BEGIN_CPP11 and END_CPP11 because we don't always return an SEXP // and the macro contains 'return R_NilValue' which causes a compiler error // https://github.com/r-lib/cpp11/blob/master/inst/include/cpp11/declarations.hpp #define WK_BEGIN_CPP11 \ SEXP err = R_NilValue; \ const size_t ERROR_SIZE = 8192; \ char buf[ERROR_SIZE] = ""; \ try { #define WK_END_CPP11(_ret) \ } \ catch (cpp11::unwind_exception & e) { \ err = e.token; \ } \ catch (std::exception & e) { \ strncpy(buf, e.what(), ERROR_SIZE - 1); \ } \ catch (...) { \ strncpy(buf, "C++ error (unknown cause)", ERROR_SIZE - 1); \ } \ if (buf[0] != '\0') { \ Rf_errorcall(R_NilValue, "%s", buf); \ } else if (err != R_NilValue) { \ CPP11_UNWIND \ } \ return _ret; template class WKHandlerFactory { public: static wk_handler_t* create(HandlerType* handler_data) { wk_handler_t* handler = wk_handler_create(); handler->handler_data = handler_data; handler->initialize = &initialize; handler->vector_start = &vector_start; handler->vector_end = &vector_end; handler->feature_start = &feature_start; handler->null_feature = &null_feature; handler->feature_end = &feature_end; handler->geometry_start = &geometry_start; handler->geometry_end = &geometry_end; handler->ring_start = &ring_start; handler->ring_end = &ring_end; handler->coord = &coord; handler->error = &error; handler->deinitialize = &deinitialize; handler->finalizer = &finalizer; return handler; } static SEXP create_xptr(HandlerType* handler_data) { wk_handler_t* handler = create(handler_data); return wk_handler_create_xptr(handler, R_NilValue, R_NilValue); } private: static void finalizer(void* handler_data) noexcept { HandlerType* cpp_handler = (HandlerType*) handler_data; if (cpp_handler != NULL) { delete cpp_handler; } } static void initialize(int* dirty, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->initialize(dirty); WK_END_CPP11() } static int vector_start(const wk_vector_meta_t* meta, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->vector_start(meta); WK_END_CPP11(WK_ABORT) } static int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->feature_start(meta, feat_id); WK_END_CPP11(WK_ABORT) } static int null_feature(void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->null_feature(); WK_END_CPP11(WK_ABORT) } static int geometry_start(const wk_meta_t* meta, uint32_t partId, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->geometry_start(meta, partId); WK_END_CPP11(WK_ABORT) } static int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ringId, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->ring_start(meta, size, ringId); WK_END_CPP11(WK_ABORT) } static int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->coord(meta, coord, coord_id); WK_END_CPP11(WK_ABORT) } static int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ringId, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->ring_end(meta, size, ringId); WK_END_CPP11(WK_ABORT) } static int geometry_end(const wk_meta_t* meta, uint32_t partId, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->geometry_end(meta, partId); WK_END_CPP11(WK_ABORT) } static int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->feature_end(meta, feat_id); WK_END_CPP11(WK_ABORT) } static SEXP vector_end(const wk_vector_meta_t* meta, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->vector_end(meta); WK_END_CPP11(R_NilValue) } static void deinitialize(void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; cpp_handler->deinitialize(); WK_END_CPP11() } static int error(const char* message, void* handler_data) noexcept { WK_BEGIN_CPP11 HandlerType* cpp_handler = (HandlerType*) handler_data; return cpp_handler->error(message); WK_END_CPP11(WK_ABORT) } }; #endif wk/inst/include/wk/experimental/wk-v1-reader-cpp11.hpp0000644000176200001440000000500414160220603022242 0ustar liggesusers #ifndef WK_V1_READER_HPP_INCLUDED #define WK_V1_READER_HPP_INCLUDED #include "cpp11/external_pointer.hpp" #include "cpp11/protect.hpp" #include #include #include "wk-v1.h" class WKParseException: public std::runtime_error { public: WKParseException(std::string message): std::runtime_error(message) {} }; class WKHandlerXPtr { public: // The constructor and deleter are replacements for the run_handler_xptr() function. // Instead, the scope of the WKHandler is used to guarantee that (1) the handler // is not being re-used and (2) vectorFinalize() is called and is called // as soon as possible. WKHandlerXPtr(cpp11::sexp handler_xptr): handler((wk_handler_t*) cpp11::safe[R_ExternalPtrAddr](handler_xptr)) { cpp11::safe[this->handler->initialize](&(this->handler->dirty), this->handler->handler_data); } ~WKHandlerXPtr() { handler->deinitialize(handler->handler_data); } int vector_start(const wk_vector_meta_t* meta) { return cpp11::safe[handler->vector_start](meta, handler->handler_data); } int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return cpp11::safe[handler->feature_start](meta, feat_id, handler->handler_data); } int null_feature() { return cpp11::safe[handler->null_feature](handler->handler_data); } int geometry_start(const wk_meta_t* meta, uint32_t partId) { return cpp11::safe[handler->geometry_start](meta, partId, handler->handler_data); } int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ringId) { return cpp11::safe[handler->ring_start](meta, size, ringId, handler->handler_data); } int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id) { return cpp11::safe[handler->coord](meta, coord, coord_id, handler->handler_data); } int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ringId) { return cpp11::safe[handler->ring_end](meta, size, ringId, handler->handler_data); } int geometry_end(const wk_meta_t* meta, uint32_t partId) { return cpp11::safe[handler->geometry_end](meta, partId, handler->handler_data); } int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return cpp11::safe[handler->feature_end](meta, feat_id, handler->handler_data); } SEXP vector_end(const wk_vector_meta_t* meta) { return cpp11::safe[handler->vector_end](meta, handler->handler_data); } int error(const char* message) { return cpp11::safe[handler->error](message, handler->handler_data); } private: wk_handler_t* handler; }; #endif wk/inst/include/wk/experimental/wk-v1-filter-cpp11.hpp0000644000176200001440000000422014160220603022264 0ustar liggesusers #ifndef WK_V1_FILTER_HPP_INCLUDED #define WK_V1_FILTER_HPP_INCLUDED #include "cpp11/external_pointer.hpp" #include "wk-v1.h" #include "wk-v1-handler-cpp11.hpp" class WKIdentityFilter: public WKVoidHandler { public: WKIdentityFilter(cpp11::sexp next): next((wk_handler_t*) cpp11::safe[R_ExternalPtrAddr](next)) {} virtual void initialize(int* dirty) { cpp11::safe[next->initialize](&(next->dirty), next->handler_data); } virtual int vector_start(const wk_vector_meta_t* meta) { return cpp11::safe[next->vector_start](meta, next->handler_data); } virtual int feature_start(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return cpp11::safe[next->feature_start](meta, feat_id, next->handler_data); } virtual int null_feature() { return cpp11::safe[next->null_feature](next->handler_data); } virtual int geometry_start(const wk_meta_t* meta, uint32_t partId) { return cpp11::safe[next->geometry_start](meta, partId, next->handler_data); } virtual int ring_start(const wk_meta_t* meta, uint32_t size, uint32_t ringId) { return cpp11::safe[next->ring_start](meta, size, ringId, next->handler_data); } virtual int coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id) { return cpp11::safe[next->coord](meta, coord, coord_id, next->handler_data); } virtual int ring_end(const wk_meta_t* meta, uint32_t size, uint32_t ringId) { return cpp11::safe[next->ring_end](meta, size, ringId, next->handler_data); } virtual int geometry_end(const wk_meta_t* meta, uint32_t partId) { return cpp11::safe[next->geometry_end](meta, partId, next->handler_data); } virtual int feature_end(const wk_vector_meta_t* meta, R_xlen_t feat_id) { return cpp11::safe[next->feature_end](meta, feat_id, next->handler_data); } virtual SEXP vector_end(const wk_vector_meta_t* meta) { return cpp11::safe[next->vector_end](meta, next->handler_data); } virtual int error(const char* message) { return cpp11::safe[next->error](message, next->handler_data); } virtual void deinitialize() { return cpp11::safe[next->deinitialize](next->handler_data); } private: wk_handler_t* next; }; #endif wk/inst/include/wk/rct.hpp0000644000176200001440000000377514106220314015222 0ustar liggesusers #ifndef WK_RCT_HPP #define WK_RCT_HPP #include #include "wk/fields.hpp" template class WKRctReader: public WKFieldsReader { public: WKRctReader(WKFieldsProvider& provider): WKFieldsReader(provider) {} void readFeature(size_t featureId) { this->handler->nextFeatureStart(featureId); double xmin = this->provider.template field(0); double ymin = this->provider.template field(1); double xmax = this->provider.template field(2); double ymax = this->provider.template field(3); WKGeometryMeta meta(WKGeometryType::Polygon, false, false, false); meta.hasSize = true; // treat any rectangle with a nan or -Inf width or height as empty // width/height of Inf *is* allowed, since this could be used to encode // a rectangle covering everything double width = xmax - xmin; double height = ymax - ymin; if ((std::isnan(width)) || (std::isnan(height)) || (width == -INFINITY) || (height == -INFINITY)) { meta.size = 0; this->handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); this->handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } else { meta.size = 1; this->handler->nextGeometryStart(meta, WKReader::PART_ID_NONE); this->handler->nextLinearRingStart(meta, 5, 0); this->handler->nextCoordinate(meta, WKCoord::xy(xmin, ymin), 0); this->handler->nextCoordinate(meta, WKCoord::xy(xmax, ymin), 1); this->handler->nextCoordinate(meta, WKCoord::xy(xmax, ymax), 2); this->handler->nextCoordinate(meta, WKCoord::xy(xmin, ymax), 3); this->handler->nextCoordinate(meta, WKCoord::xy(xmin, ymin), 4); this->handler->nextLinearRingEnd(meta, 5, 0); this->handler->nextGeometryEnd(meta, WKReader::PART_ID_NONE); } this->handler->nextFeatureEnd(featureId); } }; #endif wk/inst/include/wk/wkt-reader.hpp0000644000176200001440000001230714106220314016466 0ustar liggesusers #ifndef WK_WKT_READER_H #define WK_WKT_READER_H #include #include "wk/wkt-streamer.hpp" #include "wk/geometry.hpp" #include "wk/reader.hpp" #include "wk/io-string.hpp" #include "wk/error-formatter.hpp" #include "wk/geometry-handler.hpp" #include "wk/parse-exception.hpp" #include "wk/coord.hpp" class WKTReader: public WKReader, private WKGeometryHandler { public: WKTReader(WKStringProvider& provider): WKReader(provider), baseReader(provider), feature(nullptr) { this->baseReader.setHandler(this); } void readFeature(size_t featureId) { baseReader.readFeature(featureId); } protected: void nextFeatureStart(size_t featureId) { this->stack.clear(); this->handler->nextFeatureStart(featureId); } void nextNull(size_t featureId) { this->handler->nextNull(featureId); this->feature = std::unique_ptr(nullptr); } void nextFeatureEnd(size_t featureId) { if (this->feature) { this->readGeometry(*feature, PART_ID_NONE); } this->handler->nextFeatureEnd(featureId); } void readGeometry(const WKGeometry& geometry, uint32_t partId) { this->handler->nextGeometryStart(geometry.meta, partId); switch (geometry.meta.geometryType) { case WKGeometryType::Point: this->readPoint((WKPoint&)geometry); break; case WKGeometryType::LineString: this->readLinestring((WKLineString&)geometry); break; case WKGeometryType::Polygon: this->readPolygon((WKPolygon&)geometry); break; case WKGeometryType::MultiPoint: case WKGeometryType::MultiLineString: case WKGeometryType::MultiPolygon: case WKGeometryType::GeometryCollection: this->readCollection((WKCollection&)geometry); break; default: throw WKParseException( ErrorFormatter() << "Unrecognized geometry type: " << geometry.meta.geometryType ); } this->handler->nextGeometryEnd(geometry.meta, partId); } void readPoint(const WKPoint& geometry) { for (uint32_t i=0; i < geometry.coords.size(); i++) { this->handler->nextCoordinate(geometry.meta, geometry.coords[i], i); } } void readLinestring(const WKLineString& geometry) { for (uint32_t i=0; i < geometry.coords.size(); i++) { this->handler->nextCoordinate(geometry.meta, geometry.coords[i], i); } } void readPolygon(const WKPolygon& geometry) { uint32_t nRings = geometry.rings.size(); for (uint32_t i=0; i < nRings; i++) { uint32_t ringSize = geometry.rings[i].size(); this->handler->nextLinearRingStart(geometry.meta, ringSize, i); for (uint32_t j=0; j < ringSize; j++) { this->handler->nextCoordinate(geometry.meta, geometry.rings[i][j], j); } this->handler->nextLinearRingEnd(geometry.meta, ringSize, i); } } void readCollection(const WKCollection& geometry) { for (uint32_t i=0; i < geometry.meta.size; i++) { this->readGeometry(*geometry.geometries[i], i); } } void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { switch (meta.geometryType) { case WKGeometryType::Point: this->stack.push_back(std::unique_ptr(new WKPoint(meta))); break; case WKGeometryType::LineString: this->stack.push_back(std::unique_ptr(new WKLineString(meta))); break; case WKGeometryType::Polygon: this->stack.push_back(std::unique_ptr(new WKPolygon(meta))); break; case WKGeometryType::MultiPoint: case WKGeometryType::MultiLineString: case WKGeometryType::MultiPolygon: case WKGeometryType::GeometryCollection: this->stack.push_back(std::unique_ptr(new WKCollection(meta))); break; default: throw WKParseException( ErrorFormatter() << "Unrecognized geometry type: " << meta.geometryType ); } } void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { // there is almost certainly a better way to do this std::unique_ptr currentPtr(this->stack[this->stack.size() - 1].release()); this->stack.pop_back(); // set the size meta currentPtr->meta.size = currentPtr->size(); currentPtr->meta.hasSize = true; // if the parent is a collection, add this geometry to the collection if (stack.size() >= 1) { if (WKCollection* parent = dynamic_cast(&this->current())){ parent->geometries.push_back(std::unique_ptr(currentPtr.release())); } } else if (stack.size() == 0) { this->feature = std::unique_ptr(currentPtr.release()); } } void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { ((WKPolygon&)this->current()).rings.push_back(WKLinearRing()); } void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->current().addCoordinate(coord); } bool nextError(WKParseException& error, size_t featureId) { return this->handler->nextError(error, featureId); } protected: WKTStreamer baseReader; std::vector> stack; std::unique_ptr feature; WKGeometry& current() { return *stack[stack.size() - 1]; } }; #endif wk/inst/include/wk/rcpp-translate.hpp0000644000176200001440000000632514106220314017363 0ustar liggesusers #ifndef WK_RCPP_TRANSLATE_HPP #define WK_RCPP_TRANSLATE_HPP #include "wk/wkt-writer.hpp" #include "wk/wkt-reader.hpp" #include "wk/wkb-writer.hpp" #include "wk/wkb-reader.hpp" #include "wk/xyzm.hpp" #include "wk/rct.hpp" #include #include "wk/rcpp-io.hpp" class RcppWKFieldsProvider: public WKFieldsProvider { public: RcppWKFieldsProvider(const List& container): WKFieldsProvider(container, Rf_xlength(container[0])) {} }; class RcppFieldsExporter: public WKFieldsExporter { public: RcppFieldsExporter(const List& container): WKFieldsExporter(container, Rf_xlength(container[0])) {} }; class RcppXYZMReader: public WKXYZMReader { public: RcppXYZMReader(RcppWKFieldsProvider& provider): WKXYZMReader(provider) {} }; class RcppXYZMWriter: public WKXYZMWriter { public: RcppXYZMWriter(RcppFieldsExporter& exporter): WKXYZMWriter(exporter) {} }; class RcppWKRctReader: public WKRctReader { public: RcppWKRctReader(RcppWKFieldsProvider& provider): WKRctReader(provider) {} }; namespace wk { inline void rcpp_translate_base(WKReader& reader, WKWriter& writer, int includeZ = NA_INTEGER, int includeM = NA_INTEGER, int includeSRID = NA_INTEGER) { writer.setIncludeZ(includeZ); writer.setIncludeM(includeM); writer.setIncludeSRID(includeSRID); reader.setHandler(&writer); while (reader.hasNextFeature()) { Rcpp::checkUserInterrupt(); reader.iterateFeature(); } } inline Rcpp::List rcpp_translate_wkb(WKReader& reader, int endian, int bufferSize = 2048, int includeZ = NA_INTEGER, int includeM = NA_INTEGER, int includeSRID = NA_INTEGER) { WKRawVectorListExporter exporter(reader.nFeatures()); exporter.setBufferSize(bufferSize); WKBWriter writer(exporter); writer.setEndian(endian); rcpp_translate_base(reader, writer, includeZ, includeM, includeSRID); return exporter.output; } inline Rcpp::CharacterVector rcpp_translate_wkt(WKReader& reader, int precision = 16, bool trim = true, int includeZ = NA_INTEGER, int includeM = NA_INTEGER, int includeSRID = NA_INTEGER) { WKCharacterVectorExporter exporter(reader.nFeatures()); exporter.setRoundingPrecision(precision); exporter.setTrim(trim); WKTWriter writer(exporter); rcpp_translate_base(reader, writer, includeZ, includeM, includeSRID); return exporter.output; } Rcpp::List rcpp_translate_xyzm(WKReader& reader, int includeZ = NA_INTEGER, int includeM = NA_INTEGER) { Rcpp::List xyzm = List::create( _["x"] = NumericVector(reader.nFeatures()), _["y"] = NumericVector(reader.nFeatures()), _["z"] = NumericVector(reader.nFeatures()), _["m"] = NumericVector(reader.nFeatures()) ); RcppFieldsExporter exporter(xyzm); RcppXYZMWriter writer(exporter); rcpp_translate_base(reader, writer, includeZ, includeM, false); return xyzm; } } // namespace wk #endif wk/inst/include/wk/wkt-writer.hpp0000644000176200001440000000743614106220314016547 0ustar liggesusers #ifndef WK_WKT_WRITER_H #define WK_WKT_WRITER_H #include #include "wk/io-string.hpp" #include "wk/geometry-handler.hpp" #include "wk/writer.hpp" #include "wk/wkb-reader.hpp" class WKTWriter: public WKWriter { public: WKTWriter(WKStringExporter& exporter): WKWriter(exporter), exporter(exporter) {} void nextFeatureStart(size_t featureId) { this->stack.clear(); WKWriter::nextFeatureStart(featureId); } void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { this->stack.push_back(meta); this->newMeta = this->getNewMeta(meta); this->writeGeometrySep(this->newMeta, partId, this->newMeta.srid); this->writeGeometryOpen(meta.size); } void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { this->writeGeometryClose(meta.size); this->stack.pop_back(); } void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->writeRingSep(ringId); this->exporter.writeConstChar("("); } void nextLinearRingEnd(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->exporter.writeConstChar(")"); } void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->writeCoordSep(coordId); this->exporter.writeDouble(coord.x); this->exporter.writeConstChar(" "); this->exporter.writeDouble(coord.y); if (this->newMeta.hasZ && coord.hasZ) { this->exporter.writeConstChar(" "); this->exporter.writeDouble(coord.z); } if (this->newMeta.hasM && coord.hasM) { this->exporter.writeConstChar(" "); this->exporter.writeDouble(coord.m); } } protected: WKStringExporter& exporter; std::vector stack; void writeGeometryOpen(uint32_t size) { if (size == 0) { this->exporter.writeConstChar("EMPTY"); } else { this->exporter.writeConstChar("("); } } void writeGeometryClose(uint32_t size) { if (size > 0) { this->exporter.writeConstChar(")"); } } void writeGeometrySep(const WKGeometryMeta& meta, uint32_t partId, uint32_t srid) { bool iterCollection = iteratingCollection(); bool iterMulti = iteratingMulti(); if ((iterCollection || iterMulti) && partId > 0) { this->exporter.writeConstChar(", "); } if(iterMulti) { return; } if(!iterCollection && meta.hasSRID) { this->exporter.writeConstChar("SRID="); this->exporter.writeUint32(srid); this->exporter.writeConstChar(";"); } this->exporter.writeString(meta.wktType()); this->exporter.writeConstChar(" "); } void writeRingSep(uint32_t ringId) { if (ringId > 0) { this->exporter.writeConstChar(", "); } } void writeCoordSep(uint32_t coordId) { if (coordId > 0) { this->exporter.writeConstChar(", "); } } // stack accessors const WKGeometryMeta lastGeometryType(int level) { if (level >= 0) { return this->stack[level]; } else { return this->stack[this->stack.size() + level]; } } const WKGeometryMeta lastGeometryType() { return lastGeometryType(-1); } size_t recursionLevel() { return this->stack.size(); } bool iteratingMulti() { size_t stackSize = this->recursionLevel(); if (stackSize <= 1) { return false; } const WKGeometryMeta nester = this->lastGeometryType(-2); return nester.geometryType == WKGeometryType::MultiPoint || nester.geometryType == WKGeometryType::MultiLineString || nester.geometryType == WKGeometryType::MultiPolygon; } bool iteratingCollection() { size_t stackSize = this->recursionLevel(); if (stackSize <= 1) { return false; } const WKGeometryMeta nester = this->lastGeometryType(-2); return nester.geometryType == WKGeometryType::GeometryCollection; } }; #endif wk/inst/include/wk/io-bytes.hpp0000644000176200001440000000216114106220314016151 0ustar liggesusers #ifndef WK_IO_BYTES_H #define WK_IO_BYTES_H #include #include "wk/io.hpp" class WKBytesUtils { public: // https://github.com/r-spatial/sf/blob/master/src/wkb.cpp // https://stackoverflow.com/questions/105252/how-do-i-convert-between-big-endian-and-little-endian-values-in-c template static T swapEndian(T u) { union { T u; unsigned char u8[sizeof(T)]; } source, dest; source.u = u; for (size_t k = 0; k < sizeof(T); k++) dest.u8[k] = source.u8[sizeof(T) - k - 1]; return dest.u; } static char nativeEndian(void) { const int one = 1; unsigned char *cp = (unsigned char *) &one; return (char) *cp; } }; class WKBytesProvider: public WKProvider { public: virtual unsigned char readCharRaw() = 0; virtual double readDoubleRaw() = 0; virtual uint32_t readUint32Raw() = 0; }; class WKBytesExporter: public WKExporter { public: WKBytesExporter(size_t size): WKExporter(size) {} virtual size_t writeCharRaw(unsigned char value) = 0; virtual size_t writeDoubleRaw(double value) = 0; virtual size_t writeUint32Raw(uint32_t value) = 0; }; #endif wk/inst/include/wk/error-formatter.hpp0000644000176200001440000000146714106220314017560 0ustar liggesusers #ifndef WK_ERROR_FORMATTER #define WK_ERROR_FORMATTER // https://stackoverflow.com/questions/12261915/how-to-throw-stdexceptions-with-variable-messages #include #include #include class ErrorFormatter { public: ErrorFormatter() {} ~ErrorFormatter() {} template ErrorFormatter & operator << (const Type & value) { stream_ << value; return *this; } std::string str() const { return stream_.str(); } operator std::string () const { return stream_.str(); } enum ConvertToString { to_str }; std::string operator >> (ConvertToString) { return stream_.str(); } private: std::stringstream stream_; ErrorFormatter(const ErrorFormatter &); ErrorFormatter & operator = (ErrorFormatter &); }; # endif wk/inst/include/wk/filter.hpp0000644000176200001440000000570414106220314015711 0ustar liggesusers #ifndef WK_FILTER_H #define WK_FILTER_H #include "wk/geometry-handler.hpp" class WKFilter: public WKGeometryHandler { public: WKFilter(WKGeometryHandler& handler): handler(handler) {} virtual void nextFeatureStart(size_t featureId) { this->handler.nextFeatureStart(featureId); } virtual void nextFeatureEnd(size_t featureId) { this->handler.nextFeatureEnd(featureId); } virtual void nextNull(size_t featureId) { this->handler.nextNull(featureId); } virtual void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { this->handler.nextGeometryStart(meta, partId); } virtual void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { this->handler.nextGeometryEnd(meta, partId); } virtual void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->handler.nextLinearRingStart(meta, size, ringId); } virtual void nextLinearRingEnd(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->handler.nextLinearRingEnd(meta, size, ringId); } virtual void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->handler.nextCoordinate(meta, coord, coordId); } virtual bool nextError(WKParseException& error, size_t featureId) { return this->handler.nextError(error, featureId); } protected: WKGeometryHandler& handler; }; class WKMetaFilter: public WKFilter { public: WKMetaFilter(WKGeometryHandler& handler): WKFilter(handler) {} virtual WKGeometryMeta newGeometryMeta(const WKGeometryMeta& meta, uint32_t partId) = 0; virtual void nextFeatureStart(size_t featureId) { this->metaReplacement.clear(); this->handler.nextFeatureStart(featureId); } virtual void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { this->metaReplacement[meta.id()] = this->newGeometryMeta(meta, partId); this->handler.nextGeometryStart(this->metaReplacement[meta.id()], partId); } virtual void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { this->handler.nextGeometryEnd(this->metaReplacement[meta.id()], partId); } virtual void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->handler.nextLinearRingStart(this->metaReplacement[meta.id()], size, ringId); } virtual void nextLinearRingEnd(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->handler.nextLinearRingEnd(this->metaReplacement[meta.id()], size, ringId); } virtual void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->handler.nextCoordinate(this->metaReplacement[meta.id()], coord, coordId); } protected: // using a hash map to keep track of meta, because it's important to make sure that // identical meta objects are used for identical geometry // objects (used in s2 and elsewhere to handle nested collections) std::unordered_map metaReplacement; }; #endif wk/inst/include/wk/geometry-meta.hpp0000644000176200001440000001020114106220314017167 0ustar liggesusers #ifndef WK_GEOMETRY_TYPE_H #define WK_GEOMETRY_TYPE_H #include #include #include #include "parse-exception.hpp" // https://github.com/postgis/postgis/blob/2.1.0/doc/ZMSgeoms.txt // https://github.com/r-spatial/sf/blob/master/src/wkb.cpp enum WKGeometryType { Invalid = 0, Point = 1, LineString = 2, Polygon = 3, MultiPoint = 4, MultiLineString = 5, MultiPolygon = 6, GeometryCollection = 7 }; #define EWKB_Z_BIT 0x80000000 #define EWKB_M_BIT 0x40000000 #define EWKB_SRID_BIT 0x20000000 class WKGeometryMeta { public: const static uint32_t SRID_NONE = 0; const static uint32_t SIZE_UNKNOWN = UINT32_MAX; // type info uint32_t geometryType; bool hasZ; bool hasM; bool hasSRID; bool hasSize; uint32_t size; uint32_t srid; WKGeometryMeta(): geometryType(WKGeometryType::Invalid), hasZ(false), hasM(false), hasSRID(false), hasSize(false), size(SIZE_UNKNOWN), srid(SRID_NONE) {} WKGeometryMeta(uint32_t geometryType, uint32_t size = SIZE_UNKNOWN): geometryType(wkbSimpleGeometryType(geometryType)), hasZ(wkbTypeHasZ(geometryType)), hasM(wkbTypeHasM(geometryType)), hasSRID(geometryType & EWKB_SRID_BIT), hasSize(size != SIZE_UNKNOWN), size(size), srid(SRID_NONE) {} WKGeometryMeta(int geometryType, bool hasZ, bool hasM, bool hasSRID): geometryType(geometryType), hasZ(hasZ), hasM(hasM), hasSRID(hasSRID), hasSize(false), size(SIZE_UNKNOWN), srid(SRID_NONE) {} uint32_t ewkbType() { return calcEWKBType(this->geometryType, this->hasZ, this->hasM, this->hasSRID); } std::string wktType() const { std::stringstream f; f << wktSimpleGeometryType(this->geometryType); if (this->hasZ || this->hasM) { f << " "; } if (this->hasZ) { f << "Z"; } if (this->hasM) { f << "M"; } return f.str(); } // this is easier to store than a const WKGeometryMeta&, and safer than // casting to WKGeometryMeta* for testing identical geometryMeta objects uintptr_t id() const { return (uintptr_t) this; } private: static uint32_t calcEWKBType(int simpleGeometryType, bool hasZ, bool hasM, bool hasSRID) { uint32_t out = simpleGeometryType; if (hasZ) out |= EWKB_Z_BIT; if (hasM) out |= EWKB_M_BIT; if (hasSRID) out |= EWKB_SRID_BIT; return out; } static const char* wktSimpleGeometryType(uint32_t simpleGeometryType) { switch (simpleGeometryType) { case WKGeometryType::Point: return "POINT"; case WKGeometryType::LineString: return "LINESTRING"; case WKGeometryType::Polygon: return "POLYGON"; case WKGeometryType::MultiPoint: return "MULTIPOINT"; case WKGeometryType::MultiLineString: return "MULTILINESTRING"; case WKGeometryType::MultiPolygon: return "MULTIPOLYGON"; case WKGeometryType::GeometryCollection: return "GEOMETRYCOLLECTION"; default: // # nocov start std::stringstream err; err << "Invalid integer geometry type: " << simpleGeometryType; throw WKParseException(err.str()); // # nocov end } } // the 1000 + simpleGeometryType and 3000 + simpleGeometryType // series both have Z values as well as those marked with the // EWKB_Z_BIT static bool wkbTypeHasZ(uint32_t geometryType) { if (geometryType & EWKB_Z_BIT) { return true; } geometryType = geometryType & 0x0000ffff; return (geometryType >= 1000 && geometryType < 2000) || (geometryType > 3000); } static bool wkbTypeHasM(uint32_t geometryType) { if (geometryType & EWKB_M_BIT) { return true; } geometryType = geometryType & 0x0000ffff; return geometryType >= 2000; } // has to deal with both EWKB flags and the 1000-style WKB types static uint32_t wkbSimpleGeometryType(uint32_t geometryType) { geometryType = geometryType & 0x0000ffff; if (geometryType >= 3000) { return geometryType - 3000; } else if (geometryType >= 2000) { return geometryType - 2000; } else if (geometryType >= 1000) { return geometryType - 1000; } else { return geometryType; } } }; #endif wk/inst/include/wk/rcpp-io.hpp0000644000176200001440000001503114106220314015767 0ustar liggesusers #ifndef WK_RCPP_IO_H #define WK_RCPP_IO_H #include "wk/parse-exception.hpp" #include "wk/io-bytes.hpp" #include "wk/io-string.hpp" #include class WKRcppSEXPProvider: public WKProvider { public: const Rcpp::List& input; R_xlen_t index; WKRcppSEXPProvider(const Rcpp::List& input): input(input) { this->reset(); } void reset() { this->index = -1; } SEXP feature() { return this->input[this->index]; } bool seekNextFeature() { this->index++; return this->index < input.size(); } bool featureIsNull() { return this->input[this->index] == R_NilValue; } size_t nFeatures() { return input.size(); } }; class WKRcppSEXPExporter: public WKExporter { public: Rcpp::List output; R_xlen_t index; WKRcppSEXPExporter(size_t size): WKExporter(size), output(size), index(0) {} void prepareNextFeature() {} void setFeature(SEXP item) { this->item = item; } void writeNull() { this->setFeature(R_NilValue); } void writeNextFeature() { if (this->index >= output.size()) { Rcpp::stop("Attempt to set index out of range (WKRcppSEXPExporter)"); } this->output[this->index] = this->item; this->index++; } private: SEXP item; }; class WKRawVectorListProvider: public WKBytesProvider { public: WKRawVectorListProvider(const Rcpp::List& container): container(container) { this->reset(); } void reset() { this->index = -1; this->featureNull = true; this->offset = 0; } unsigned char readCharRaw() { return readBinary(); } double readDoubleRaw() { return readBinary(); } uint32_t readUint32Raw() { return readBinary(); } bool seekNextFeature() { this->index += 1; if (this->index >= this->container.size()) { return false; } SEXP item = this->container[this->index]; if (item == R_NilValue) { this->featureNull = true; this->data = nullptr; this->dataSize = 0; } else { this->featureNull = false; this->data = RAW(item); this->dataSize = Rf_xlength(item); } this->offset = 0; return true; } bool featureIsNull() { return this->featureNull; } size_t nFeatures() { return container.size(); } private: const Rcpp::List& container; R_xlen_t index; unsigned char* data; size_t dataSize; size_t offset; bool featureNull; template T readBinary() { if ((this->offset + sizeof(T)) > this->dataSize) { throw WKParseException("Reached end of RawVector input"); } T dst; memcpy(&dst, &(this->data[this->offset]), sizeof(T)); this->offset += sizeof(T); return dst; } }; class WKRawVectorListExporter: public WKBytesExporter { public: Rcpp::List output; std::vector buffer; bool featureNull; R_xlen_t index; size_t offset; WKRawVectorListExporter(size_t size): WKBytesExporter(size), buffer(2048) { this->featureNull = false; this->index = 0; this->offset = 0; output = Rcpp::List(size); } void prepareNextFeature() { this->offset = 0; this->featureNull = false; } void writeNull() { this->featureNull = true; } void writeNextFeature() { if (this->index >= output.size()) { Rcpp::stop("Attempt to set index out of range (WKRawVectorListExporter)"); } if (this->featureNull) { this->output[this->index] = R_NilValue; } else { Rcpp::RawVector item(this->offset); memcpy(&(item[0]), &(this->buffer[0]), this->offset); this->output[this->index] = item; } this->index++; } void setBufferSize(R_xlen_t bufferSize) { if (bufferSize <= 0) { throw std::runtime_error("Attempt to set zero or negative buffer size"); } this->buffer = std::vector(bufferSize); } void extendBufferSize(R_xlen_t bufferSize) { if (bufferSize < ((R_xlen_t) this->buffer.size())) { throw std::runtime_error("Attempt to shrink RawVector buffer size"); } std::vector newBuffer(bufferSize); memcpy(&newBuffer[0], &(this->buffer[0]), this->offset); this->buffer = newBuffer; } size_t writeCharRaw(unsigned char value) { return this->writeBinary(value); } size_t writeDoubleRaw(double value) { return this->writeBinary(value); } size_t writeUint32Raw(uint32_t value) { return this->writeBinary(value); } template size_t writeBinary(T value) { // Rcout << "Writing " << sizeof(T) << "(" << value << ") starting at " << this->offset << "\n"; while ((this->offset + sizeof(T)) > ((size_t) this->buffer.size())) { // we're going to need a bigger boat this->extendBufferSize(this->buffer.size() * 2); } memcpy(&(this->buffer[this->offset]), &value, sizeof(T)); this->offset += sizeof(T); return sizeof(T); } }; class WKCharacterVectorProvider: public WKStringProvider { public: const Rcpp::CharacterVector& container; R_xlen_t index; bool featureNull; std::string data; WKCharacterVectorProvider(const Rcpp::CharacterVector& container): container(container) { this->reset(); } void reset() { this->index = -1; this->featureNull = false; } bool seekNextFeature() { this->index++; if (this->index >= this->container.size()) { return false; } if (Rcpp::CharacterVector::is_na(this->container[this->index])) { this->featureNull = true; this->data = std::string(""); } else { this->featureNull = false; this->data = Rcpp::as(this->container[this->index]); } return true; } const std::string featureString() { return this->data; } bool featureIsNull() { return this->featureNull; } size_t nFeatures() { return container.size(); } }; class WKCharacterVectorExporter: public WKStringStreamExporter { public: Rcpp::CharacterVector output; R_xlen_t index; bool featureNull; WKCharacterVectorExporter(size_t size): WKStringStreamExporter(size), output(size), index(0), featureNull(false) {} void prepareNextFeature() { this->featureNull = false; this->stream.str(""); this->stream.clear(); } void writeNull() { this->featureNull = true; } void writeNextFeature() { if (this->index >= output.size()) { Rcpp::stop("Attempt to set index out of range (WKCharacterVectorExporter)"); } if (this->featureNull) { this->output[this->index] = NA_STRING; } else { this->output[this->index] = this->stream.str(); } this->index++; } }; #endif wk/inst/include/wk/wkb-writer.hpp0000644000176200001440000000635214106220314016521 0ustar liggesusers #ifndef WK_WKB_WRITER_H #define WK_WKB_WRITER_H #include "wk/geometry-handler.hpp" #include "wk/io-bytes.hpp" #include "wk/writer.hpp" #include "wk/wkb-reader.hpp" class WKBWriter: public WKWriter { public: WKBWriter(WKBytesExporter& exporter): WKWriter(exporter), exporter(exporter), level(0) {} void nextFeatureStart(size_t featureId) { WKWriter::nextFeatureStart(featureId); this->level = 0; } void setEndian(unsigned char endian) { this->endian = endian; this->swapEndian = WKBytesUtils::nativeEndian() != endian; } void nextGeometryStart(const WKGeometryMeta& meta, uint32_t partId) { this->level++; // make sure meta has a valid size if (!meta.hasSize || meta.size == WKGeometryMeta::SIZE_UNKNOWN) { throw std::runtime_error("Can't write WKB wihout a valid meta.size"); } // make a new geometry type based on the creation options this->newMeta = this->getNewMeta(meta); // never include SRID if not a top-level geometry if (this->level > 1) { this->newMeta.srid = WKGeometryMeta::SRID_NONE; this->newMeta.hasSRID = false; } this->writeEndian(); this->writeUint32(this->newMeta.ewkbType()); if (this->newMeta.hasSRID) this->writeUint32(this->newMeta.srid); if (this->newMeta.geometryType != WKGeometryType::Point) this->writeUint32(meta.size); // empty point hack! could also error here, but this feels more in line with // how these are represented in real life (certainly in R) if (this->newMeta.geometryType == WKGeometryType::Point && this->newMeta.size == 0) { this->writeDouble(NAN); this->writeDouble(NAN); if (this->newMeta.hasZ) { this->writeDouble(NAN); } if (this->newMeta.hasM) { this->writeDouble(NAN); } } } void nextLinearRingStart(const WKGeometryMeta& meta, uint32_t size, uint32_t ringId) { this->writeUint32(size); } void nextCoordinate(const WKGeometryMeta& meta, const WKCoord& coord, uint32_t coordId) { this->writeDouble(coord.x); this->writeDouble(coord.y); if (this->newMeta.hasZ && coord.hasZ) { this->writeDouble(coord.z); } if (this->newMeta.hasM && coord.hasM) { this->writeDouble(coord.m); } } void nextGeometryEnd(const WKGeometryMeta& meta, uint32_t partId) { this->level--; } private: bool swapEndian; unsigned char endian; WKBytesExporter& exporter; int level; size_t writeEndian() { return this->writeChar(this->endian); } size_t writeCoord(WKCoord coord) { size_t bytesWritten = 0; for (size_t i=0; i < coord.size(); i++) { bytesWritten += this->writeDouble(coord[i]); } return bytesWritten; } size_t writeChar(unsigned char value) { return this->exporter.writeCharRaw(value); } size_t writeDouble(double value) { if (this->swapEndian) { this->exporter.writeDoubleRaw(WKBytesUtils::swapEndian(value)); } else { this->exporter.writeDoubleRaw(value); } return sizeof(double); } size_t writeUint32(uint32_t value) { if (this->swapEndian) { this->exporter.writeUint32Raw(WKBytesUtils::swapEndian(value)); } else { this->exporter.writeUint32Raw(value); } return sizeof(uint32_t); } }; #endif wk/inst/include/wk-v1-impl.c0000644000176200001440000001255014125354157015355 0ustar liggesusers #include "wk-v1.h" #include void wk_default_handler_initialize(int* dirty, void* handler_data) { if (*dirty) { Rf_error("Can't re-use this wk_handler"); } *dirty = 1; } int wk_default_handler_vector_start(const wk_vector_meta_t* meta, void* handler_data) { return WK_CONTINUE; } SEXP wk_default_handler_vector_end(const wk_vector_meta_t* meta, void* handler_data) { return R_NilValue; } int wk_default_handler_feature(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data) { return WK_CONTINUE; } int wk_default_handler_null_feature(void* handler_data) { return WK_CONTINUE; } int wk_default_handler_geometry(const wk_meta_t* meta, uint32_t part_id, void* handler_data) { return WK_CONTINUE; } int wk_default_handler_ring(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data) { return WK_CONTINUE; } int wk_default_handler_coord(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data) { return WK_CONTINUE; } int wk_default_handler_error(const char* message, void* handler_data) { Rf_error(message); return WK_ABORT; } void wk_default_handler_finalizer(void* handler_data) { } wk_handler_t* wk_handler_create() { wk_handler_t* handler = (wk_handler_t*) malloc(sizeof(wk_handler_t)); if (handler == NULL) { Rf_error("Failed to alloc handler"); // # nocov } handler->api_version = 1; handler->dirty = 0; handler->handler_data = NULL; handler->initialize = &wk_default_handler_initialize; handler->vector_start = &wk_default_handler_vector_start; handler->vector_end = &wk_default_handler_vector_end; handler->feature_start = &wk_default_handler_feature; handler->null_feature = &wk_default_handler_null_feature; handler->feature_end = &wk_default_handler_feature; handler->geometry_start = &wk_default_handler_geometry; handler->geometry_end = &wk_default_handler_geometry; handler->ring_start = &wk_default_handler_ring; handler->ring_end = &wk_default_handler_ring; handler->coord = &wk_default_handler_coord; handler->error = &wk_default_handler_error; handler->deinitialize = &wk_default_handler_finalizer; handler->finalizer = &wk_default_handler_finalizer; return handler; } void wk_handler_destroy(wk_handler_t* handler) { if (handler != NULL) { handler->finalizer(handler->handler_data); free(handler); } } void wk_handler_destroy_xptr(SEXP xptr) { wk_handler_destroy((wk_handler_t*) R_ExternalPtrAddr(xptr)); } SEXP wk_handler_create_xptr(wk_handler_t* handler, SEXP tag, SEXP prot) { SEXP xptr = R_MakeExternalPtr(handler, tag, prot); R_RegisterCFinalizerEx(xptr, &wk_handler_destroy_xptr, FALSE); return xptr; } struct wk_handler_run_data { SEXP (*read_fun)(SEXP read_data, wk_handler_t* handler); SEXP read_data; wk_handler_t* handler; }; void wk_handler_run_cleanup(void* data) { struct wk_handler_run_data* run_data = (struct wk_handler_run_data*) data; run_data->handler->deinitialize(run_data->handler->handler_data); } SEXP wk_handler_run_internal(void* data) { struct wk_handler_run_data* run_data = (struct wk_handler_run_data*) data; if (run_data->handler->api_version != 1) { // # nocov start Rf_error("Can't run a wk_handler with api_version '%d'", run_data->handler->api_version); // # nocov end } run_data->handler->initialize(&(run_data->handler->dirty), run_data->handler->handler_data); return run_data->read_fun(run_data->read_data, run_data->handler); } SEXP wk_handler_run_xptr(SEXP (*read_fun)(SEXP read_data, wk_handler_t* handler), SEXP read_data, SEXP xptr) { wk_handler_t* handler = (wk_handler_t*) R_ExternalPtrAddr(xptr); struct wk_handler_run_data run_data = { read_fun, read_data, handler }; return R_ExecWithCleanup(&wk_handler_run_internal, &run_data, &wk_handler_run_cleanup, &run_data); } int wk_default_trans_trans(R_xlen_t feature_id, const double* xyzm_in, double* xyzm_out, void* trans_data) { xyzm_out[0] = xyzm_in[0]; xyzm_out[1] = xyzm_in[1]; xyzm_out[2] = xyzm_in[2]; xyzm_out[3] = xyzm_in[3]; return WK_CONTINUE; } void wk_default_trans_finalizer(void* trans_data) { } void wk_default_trans_vector(void* trans_data) { } wk_trans_t* wk_trans_create() { wk_trans_t* trans = (wk_trans_t*) malloc(sizeof(wk_trans_t)); if (trans == NULL) { Rf_error("Failed to alloc wk_trans_t*"); // # nocov } trans->api_version = 1001; trans->use_z = NA_INTEGER; trans->use_m = NA_INTEGER; trans->xyzm_out_min[0] = R_NegInf; trans->xyzm_out_min[1] = R_NegInf; trans->xyzm_out_min[2] = R_NegInf; trans->xyzm_out_min[3] = R_NegInf; trans->xyzm_out_max[0] = R_PosInf; trans->xyzm_out_max[1] = R_PosInf; trans->xyzm_out_max[2] = R_PosInf; trans->xyzm_out_max[3] = R_PosInf; trans->trans = &wk_default_trans_trans; trans->vector_end = &wk_default_trans_vector; trans->finalizer = &wk_default_trans_finalizer; trans->trans_data = NULL; return trans; } void wk_trans_destroy(wk_trans_t* trans) { if (trans != NULL) { trans->finalizer(trans->trans_data); free(trans); } } void wk_trans_destroy_xptr(SEXP trans_xptr) { wk_trans_destroy((wk_trans_t*) R_ExternalPtrAddr(trans_xptr)); } SEXP wk_trans_create_xptr(wk_trans_t* trans, SEXP tag, SEXP prot) { SEXP trans_xptr = PROTECT(R_MakeExternalPtr(trans, tag, prot)); R_RegisterCFinalizer(trans_xptr, &wk_trans_destroy_xptr); UNPROTECT(1); return trans_xptr; } wk/inst/include/wk-v1.h0000644000176200001440000000676214125354157014433 0ustar liggesusers #ifndef WK_V1_H_INCLUDED #define WK_V1_H_INCLUDED #include // for uint_32_t #include #define WK_CONTINUE 0 #define WK_ABORT 1 #define WK_ABORT_FEATURE 2 #define WK_FLAG_HAS_BOUNDS 1 #define WK_FLAG_HAS_Z 2 #define WK_FLAG_HAS_M 4 #define WK_FLAG_DIMS_UNKNOWN 8 #define WK_PRECISION_NONE 0.0 #define WK_PART_ID_NONE UINT32_MAX #define WK_SIZE_UNKNOWN UINT32_MAX #define WK_VECTOR_SIZE_UNKNOWN -1 #define WK_SRID_NONE UINT32_MAX enum wk_geometery_type_enum { WK_GEOMETRY = 0, WK_POINT = 1, WK_LINESTRING = 2, WK_POLYGON = 3, WK_MULTIPOINT = 4, WK_MULTILINESTRING = 5, WK_MULTIPOLYGON = 6, WK_GEOMETRYCOLLECTION = 7 }; typedef struct { uint32_t geometry_type; uint32_t flags; uint32_t srid; uint32_t size; double precision; double bounds_min[4]; double bounds_max[4]; } wk_meta_t; typedef struct { uint32_t geometry_type; uint32_t flags; R_xlen_t size; double bounds_min[4]; double bounds_max[4]; } wk_vector_meta_t; #define WK_META_RESET(meta, geometry_type_) \ meta.geometry_type = geometry_type_; \ meta.flags = 0; \ meta.precision = WK_PRECISION_NONE; \ meta.srid = WK_SRID_NONE; \ meta.size = WK_SIZE_UNKNOWN #define WK_VECTOR_META_RESET(meta, geometry_type_) \ meta.geometry_type = geometry_type_; \ meta.flags = 0; \ meta.size = WK_VECTOR_SIZE_UNKNOWN typedef struct { int api_version; int dirty; void* handler_data; void (*initialize)(int* dirty, void* handler_data); int (*vector_start)(const wk_vector_meta_t* meta, void* handler_data); int (*feature_start)(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data); int (*null_feature)(void* handler_data); int (*geometry_start)(const wk_meta_t* meta, uint32_t part_id, void* handler_data); int (*ring_start)(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data); int (*coord)(const wk_meta_t* meta, const double* coord, uint32_t coord_id, void* handler_data); int (*ring_end)(const wk_meta_t* meta, uint32_t size, uint32_t ring_id, void* handler_data); int (*geometry_end)(const wk_meta_t* meta, uint32_t part_id, void* handler_data); int (*feature_end)(const wk_vector_meta_t* meta, R_xlen_t feat_id, void* handler_data); SEXP (*vector_end)(const wk_vector_meta_t* meta, void* handler_data); int (*error)(const char* message, void* handler_data); void (*deinitialize)(void* handler_data); void (*finalizer)(void* handler_data); } wk_handler_t; typedef struct { int api_version; void* trans_data; int use_z; int use_m; double xyzm_out_min[4]; double xyzm_out_max[4]; int (*trans)(R_xlen_t feature_id, const double* xyzm_in, double* xyzm_out, void* trans_data); void (*vector_end)(void* trans_data); void (*finalizer)(void* trans_data); } wk_trans_t; #ifdef __cplusplus extern "C" { #endif // implementations in wk-v1-impl.c, which must be included exactly once in an R package wk_handler_t* wk_handler_create(); SEXP wk_handler_create_xptr(wk_handler_t* handler, SEXP tag, SEXP prot); void wk_handler_destroy(wk_handler_t* handler); SEXP wk_handler_run_xptr(SEXP (*read_fun)(SEXP read_data, wk_handler_t* handler), SEXP read_data, SEXP xptr); wk_trans_t* wk_trans_create(); SEXP wk_trans_create_xptr(wk_trans_t* trans, SEXP tag, SEXP prot); void wk_trans_destroy(wk_trans_t* trans); #ifdef __cplusplus } // extern "C" { #endif #endif