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