Implement promote_to_multi when converting WKB to sfc

R/RcppExports.R

@@ -397,6 +397,10 @@ CPL_read_wkb <- function(wkb_list, EWKB = FALSE, spatialite = FALSE) {
  .Call(`_sf_CPL_read_wkb`, wkb_list, EWKB, spatialite)
 }
 
+CPL_read_wkb2 <- function(wkb_list, options) {
+ .Call(`_sf_CPL_read_wkb2`, wkb_list, options)
+}
+
 CPL_write_wkb <- function(sfc, EWKB = FALSE) {
  .Call(`_sf_CPL_write_wkb`, sfc, EWKB)
 }

R/read.R

@@ -76,7 +76,7 @@ set_utf8 = function(x) {
 #'
 #' In case of problems reading shapefiles from USB drives on OSX, please see
 #' \url{https://github.com/r-spatial/sf/issues/252}. Reading shapefiles (or other
-#' data sources) directly from zip files can be done by prepending the path 
+#' data sources) directly from zip files can be done by prepending the path
 #' with \code{/vsizip/}. This is part of the GDAL Virtual File Systems interface
 #' that also supports .gz, curl, and other operations, including chaining; see
 #' \url{https://gdal.org/user/virtual_file_systems.html} for a complete
@@ -225,42 +225,38 @@ process_cpl_read_ogr_stream = function(x, geom_column_info, num_features, fid_co
  function(s) identical(s$metadata[["ARROW:extension:name"]], "ogc.wkb"),
  logical(1)
  )
- 
+
  geom_column_info$index = which(is_geometry_column)
- 
+
  if (num_features == -1) {
  num_features = NULL
  }
- 
+
  # Suppress warnings about extension type conversion (since we want the
  # default behaviour of converting the storage type)
  df = suppressWarnings(nanoarrow::convert_array_stream(x, size = num_features))
- 
+
  for (i in seq_len(nrow(geom_column_info))) {
  crs = if (is.null(crs)) st_crs(geom_column_info$crs[[i]]) else st_crs(crs)
  name = geom_column_info$name[[i]]
  index = geom_column_info$index[[i]]
- 
+
  column_wkb = df[[index]]
- attributes(column_wkb) = NULL
- column_sfc = wk::wk_handle(
- wk::new_wk_wkb(column_wkb),
- wk::sfc_writer(promote_multi = promote_to_multi)
- )
-
- df[[index]] = st_set_crs(column_sfc, crs)
+ class(column_wkb) <- "WKB"
+ column_sfc = sf::st_as_sfc(column_wkb, crs = crs, promote_to_multi = promote_to_multi)
+ df[[index]] = column_sfc
  names(df)[index] = name
  }
- 
+
  # Rename OGC_FID to fid_column_name and move to end
  if (length(fid_column_name) == 1 && "OGC_FID" %in% names(df)) {
  df = df[c(setdiff(names(df), "OGC_FID"), "OGC_FID")]
  names(df)[names(df) == "OGC_FID"] = fid_column_name
  }
- 
+
  # All geometry columns to the end
  df = df[c(setdiff(seq_along(df), geom_column_info$index), geom_column_info$index)]
- 
+
  process_cpl_read_ogr(df, ...)
 }
 

R/wkb.R

@@ -25,14 +25,17 @@ skip0x = function(x) {
 #' @param EWKB logical; if `TRUE`, parse as EWKB (extended WKB; PostGIS: ST_AsEWKB), otherwise as ISO WKB (PostGIS: ST_AsBinary)
 #' @param spatialite logical; if \code{TRUE}, WKB is assumed to be in the spatialite dialect, see \url{https://www.gaia-gis.it/gaia-sins/BLOB-Geometry.html}; this is only supported in native endian-ness (i.e., files written on system with the same endian-ness as that on which it is being read).
 #' @param pureR logical; if `TRUE`, use only R code, if `FALSE`, use compiled (C++) code; use `TRUE` when the endian-ness of the binary differs from the host machine (\code{.Platform$endian}).
+#' @param promote_to_multi logical; if `TRUE`, attempt to promote combinations of simple/multi
+#' such that all output geometries are multi geometries of the same type.
 #' @details When converting from WKB, the object \code{x} is either a character vector such as typically obtained from PostGIS (either with leading "0x" or without), or a list with raw vectors representing the features in binary (raw) form.
 #' @examples
 #' wkb = structure(list("01010000204071000000000000801A064100000000AC5C1441"), class = "WKB")
 #' st_as_sfc(wkb, EWKB = TRUE)
 #' wkb = structure(list("0x01010000204071000000000000801A064100000000AC5C1441"), class = "WKB")
 #' st_as_sfc(wkb, EWKB = TRUE)
 #' @export
-st_as_sfc.WKB = function(x, ..., EWKB = FALSE, spatialite = FALSE, pureR = FALSE, crs = NA_crs_) {
+st_as_sfc.WKB = function(x, ..., EWKB = FALSE, spatialite = FALSE, pureR = FALSE, crs = NA_crs_,
+ promote_to_multi = FALSE) {
  if (EWKB && spatialite)
  stop("arguments EWKB and spatialite cannot both be TRUE")
  if (spatialite && pureR)
@@ -49,7 +52,10 @@ st_as_sfc.WKB = function(x, ..., EWKB = FALSE, spatialite = FALSE, pureR = FALSE
  ret = if (pureR)
  R_read_wkb(x, readWKB, EWKB = EWKB)
  else
- CPL_read_wkb(x, EWKB, spatialite)
+ CPL_read_wkb2(x,
+ list(EWKB = EWKB,
+ spatialite = spatialite,
+ promote_to_multi = promote_to_multi))
  if (is.na(crs) && (EWKB || spatialite) && !is.null(attr(ret, "srid")) && attr(ret, "srid") != 0)
  crs = attr(ret, "srid")
  if (! is.na(st_crs(crs))) {

inst/include/sf_RcppExports.h

@@ -45,6 +45,27 @@ namespace sf {
  return Rcpp::as<Rcpp::List >(rcpp_result_gen);
  }
 
+ inline Rcpp::List CPL_read_wkb2(Rcpp::List wkb_list, Rcpp::List options) {
+ typedef SEXP(*Ptr_CPL_read_wkb2)(SEXP,SEXP);
+ static Ptr_CPL_read_wkb2 p_CPL_read_wkb2 = NULL;
+ if (p_CPL_read_wkb2 == NULL) {
+ validateSignature("Rcpp::List(*CPL_read_wkb2)(Rcpp::List,Rcpp::List)");
+ p_CPL_read_wkb2 = (Ptr_CPL_read_wkb2)R_GetCCallable("sf", "_sf_CPL_read_wkb2");
+ }
+ RObject rcpp_result_gen;
+ {
+ RNGScope RCPP_rngScope_gen;
+ rcpp_result_gen = p_CPL_read_wkb2(Shield<SEXP>(Rcpp::wrap(wkb_list)), Shield<SEXP>(Rcpp::wrap(options)));
+ }
+ if (rcpp_result_gen.inherits("interrupted-error"))
+ throw Rcpp::internal::InterruptedException();
+ if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen))
+ throw Rcpp::LongjumpException(rcpp_result_gen);
+ if (rcpp_result_gen.inherits("try-error"))
+ throw Rcpp::exception(Rcpp::as<std::string>(rcpp_result_gen).c_str());
+ return Rcpp::as<Rcpp::List >(rcpp_result_gen);
+ }
+
  inline Rcpp::List CPL_write_wkb(Rcpp::List sfc, bool EWKB = false) {
  typedef SEXP(*Ptr_CPL_write_wkb)(SEXP,SEXP);
  static Ptr_CPL_write_wkb p_CPL_write_wkb = NULL;

src/RcppExports.cpp

@@ -1378,6 +1378,41 @@ RcppExport SEXP _sf_CPL_read_wkb(SEXP wkb_listSEXP, SEXP EWKBSEXP, SEXP spatiali
  UNPROTECT(1);
  return rcpp_result_gen;
 }
+// CPL_read_wkb2
+Rcpp::List CPL_read_wkb2(Rcpp::List wkb_list, Rcpp::List options);
+static SEXP _sf_CPL_read_wkb2_try(SEXP wkb_listSEXP, SEXP optionsSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::traits::input_parameter< Rcpp::List >::type wkb_list(wkb_listSEXP);
+ Rcpp::traits::input_parameter< Rcpp::List >::type options(optionsSEXP);
+ rcpp_result_gen = Rcpp::wrap(CPL_read_wkb2(wkb_list, options));
+ return rcpp_result_gen;
+END_RCPP_RETURN_ERROR
+}
+RcppExport SEXP _sf_CPL_read_wkb2(SEXP wkb_listSEXP, SEXP optionsSEXP) {
+ SEXP rcpp_result_gen;
+ {
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ rcpp_result_gen = PROTECT(_sf_CPL_read_wkb2_try(wkb_listSEXP, optionsSEXP));
+ }
+ Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
+ if (rcpp_isInterrupt_gen) {
+ UNPROTECT(1);
+ Rf_onintr();
+ }
+ bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen);
+ if (rcpp_isLongjump_gen) {
+ Rcpp::internal::resumeJump(rcpp_result_gen);
+ }
+ Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
+ if (rcpp_isError_gen) {
+ SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
+ UNPROTECT(1);
+ Rf_error("%s", CHAR(rcpp_msgSEXP_gen));
+ }
+ UNPROTECT(1);
+ return rcpp_result_gen;
+}
 // CPL_write_wkb
 Rcpp::List CPL_write_wkb(Rcpp::List sfc, bool EWKB);
 static SEXP _sf_CPL_write_wkb_try(SEXP sfcSEXP, SEXP EWKBSEXP) {
@@ -1443,6 +1478,7 @@ static int _sf_RcppExport_validate(const char* sig) {
  static std::set<std::string> signatures;
  if (signatures.empty()) {
  signatures.insert("Rcpp::List(*CPL_read_wkb)(Rcpp::List,bool,bool)");
+ signatures.insert("Rcpp::List(*CPL_read_wkb2)(Rcpp::List,Rcpp::List)");
  signatures.insert("Rcpp::List(*CPL_write_wkb)(Rcpp::List,bool)");
  }
  return signatures.find(sig) != signatures.end();
@@ -1451,6 +1487,7 @@ static int _sf_RcppExport_validate(const char* sig) {
 // registerCCallable (register entry points for exported C++ functions)
 RcppExport SEXP _sf_RcppExport_registerCCallable() { 
  R_RegisterCCallable("sf", "_sf_CPL_read_wkb", (DL_FUNC)_sf_CPL_read_wkb_try);
+ R_RegisterCCallable("sf", "_sf_CPL_read_wkb2", (DL_FUNC)_sf_CPL_read_wkb2_try);
  R_RegisterCCallable("sf", "_sf_CPL_write_wkb", (DL_FUNC)_sf_CPL_write_wkb_try);
  R_RegisterCCallable("sf", "_sf_RcppExport_validate", (DL_FUNC)_sf_RcppExport_validate);
  return R_NilValue;
@@ -1556,6 +1593,7 @@ static const R_CallMethodDef CallEntries[] = {
  {"_sf_CPL_extract", (DL_FUNC) &_sf_CPL_extract, 3},
  {"_sf_CPL_create", (DL_FUNC) &_sf_CPL_create, 6},
  {"_sf_CPL_read_wkb", (DL_FUNC) &_sf_CPL_read_wkb, 3},
+ {"_sf_CPL_read_wkb2", (DL_FUNC) &_sf_CPL_read_wkb2, 2},
  {"_sf_CPL_write_wkb", (DL_FUNC) &_sf_CPL_write_wkb, 2},
  {"_sf_CPL_get_z_range", (DL_FUNC) &_sf_CPL_get_z_range, 2},
  {"_sf_CPL_get_m_range", (DL_FUNC) &_sf_CPL_get_m_range, 2},

src/gdal.cpp

@@ -330,7 +330,7 @@ Rcpp::List CPL_crs_parameters(Rcpp::List crs) {
  Rcpp::IntegerVector orientation(ac);
  for (int i = 0; i < ac; i++) {
  OGRAxisOrientation peOrientation;
- const char *ret = srs->GetAxis(srs->IsGeographic() ? "GEOGCS" : "PROJCS", 
+ const char *ret = srs->GetAxis(srs->IsGeographic() ? "GEOGCS" : "PROJCS",
  i, &peOrientation);
  if (ret != NULL) {
  nms[i] = ret;

src/geos.cpp

@@ -871,7 +871,7 @@ Rcpp::List CPL_geos_op(std::string op, Rcpp::List sfc,
 #ifdef HAVE310
  if (op == "triangulate_constrained") {
  for (size_t i = 0; i < g.size(); i++)
- out[i] = geos_ptr(chkNULL(GEOSConstrainedDelaunayTriangulation_r(hGEOSCtxt, g[i].get())), 
+ out[i] = geos_ptr(chkNULL(GEOSConstrainedDelaunayTriangulation_r(hGEOSCtxt, g[i].get())),
  hGEOSCtxt);
  } else
 #endif
@@ -1307,14 +1307,14 @@ Rcpp::List CPL_nary_intersection(Rcpp::List sfc) {
  errors++;
  else if (!chk_(GEOSisEmpty_r(hGEOSCtxt, inters.get()))) { // i and k intersection
  // cut out inters from geom:
- geom = geos_ptr(GEOSDifference_r(hGEOSCtxt, geom.get(), inters.get()), hGEOSCtxt); 
+ geom = geos_ptr(GEOSDifference_r(hGEOSCtxt, geom.get(), inters.get()), hGEOSCtxt);
  if (geom == nullptr)
  Rcpp::stop("GEOS exception"); // #nocov
  // cut out inters from out[k]:
 #ifndef HAVE_390
- GeomPtr g = geos_ptr(GEOSDifference_r(hGEOSCtxt, out[k].get(), inters.get()), hGEOSCtxt); 
+ GeomPtr g = geos_ptr(GEOSDifference_r(hGEOSCtxt, out[k].get(), inters.get()), hGEOSCtxt);
 #else
- GeomPtr g = geos_ptr(GEOSDifferencePrec_r(hGEOSCtxt, out[k].get(), inters.get(), grid_size), hGEOSCtxt); 
+ GeomPtr g = geos_ptr(GEOSDifferencePrec_r(hGEOSCtxt, out[k].get(), inters.get(), grid_size), hGEOSCtxt);
 #endif
  if (g == nullptr)
  Rcpp::warning("GEOS difference returns NULL"); // #nocov