Implement serialization support for s2_geometry vectors

R/RcppExports.R

@@ -1,10 +1,6 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-cpp_s2_init <- function() {
-    invisible(.Call(`_s2_cpp_s2_init`))
-}
-
 cpp_s2_is_collection <- function(geog) {
     .Call(`_s2_cpp_s2_is_collection`, geog)
 }
@@ -61,6 +57,10 @@ cpp_s2_max_distance <- function(geog1, geog2) {
     .Call(`_s2_cpp_s2_max_distance`, geog1, geog2)
 }
 
+make_s2_geography_altrep <- function(list) {
+    .Call(`_s2_make_s2_geography_altrep`, list)
+}
+
 cpp_s2_bounds_cap <- function(geog) {
     .Call(`_s2_cpp_s2_bounds_cap`, geog)
 }

R/s2-cell.R

@@ -222,26 +222,26 @@ s2_cell_to_lnglat <- function(x) {
 #' @rdname s2_cell_is_valid
 #' @export
 s2_cell_center <- function(x) {
-  cpp_s2_cell_center(x)
+  new_s2_geography(cpp_s2_cell_center(x))
 }
 
 #' @rdname s2_cell_is_valid
 #' @export
 s2_cell_boundary <- function(x) {
-  s2_boundary(cpp_s2_cell_polygon(x))
+  s2_boundary(new_s2_geography(cpp_s2_cell_polygon(x)))
 }
 
 #' @rdname s2_cell_is_valid
 #' @export
 s2_cell_polygon <- function(x) {
-  cpp_s2_cell_polygon(x)
+  new_s2_geography(cpp_s2_cell_polygon(x))
 }
 
 #' @rdname s2_cell_is_valid
 #' @export
 s2_cell_vertex <- function(x, k) {
   recycled <- recycle_common(x, k)
-  cpp_s2_cell_vertex(recycled[[1]], recycled[[2]])
+  new_s2_geography(cpp_s2_cell_vertex(recycled[[1]], recycled[[2]]))
 }
 
 # accessors

R/s2-constructors-formatters.R

@@ -151,6 +151,7 @@ s2_geog_from_wkb <- function(wkb_bytes, oriented = FALSE, check = TRUE,
   attributes(wkb_bytes) <- NULL
   wkb <- wk::new_wk_wkb(wkb_bytes)
   wk::validate_wk_wkb(wkb)
+
   wk::wk_handle(
     wkb,
     s2_geography_writer(

R/s2-geography.R

@@ -180,7 +180,14 @@ wk_set_geodesic.s2_geography <- function(x, geodesic) {
 }
 
 new_s2_geography <- function(x) {
-  structure(x, class = c("s2_geography", "wk_vctr"))
+  # set the ALTREP class
+  if (!isTRUE(getOption("s2.disable_altrep"))) {
+    x <- make_s2_geography_altrep(x)
+  }
+  # set the s2_geography class
+  class(x) <- c("s2_geography", "wk_vctr")
+
+  x
 }
 
 #' @export

R/s2-serialize.R

@@ -0,0 +1,18 @@
+s2_geography_serialize <- function(x) {
+  wk::wk_handle(
+    as_s2_geography(x),
+    wk::wkb_writer(endian = 1L),
+    s2_projection = NULL
+  )
+}
+
+s2_geography_unserialize <- function(bytes) {
+  wk::wk_handle(
+    bytes,
+    s2::s2_geography_writer(
+      oriented = TRUE,
+      check = FALSE,
+      projection = NULL
+    )
+  )
+}

R/utils.R

@@ -86,3 +86,7 @@ expect_wkt_equal <- function(x, y, precision = 16) {
 expect_near <- function(x, y, epsilon) {
   testthat::expect_true(abs(y - x) < epsilon)
 }
+
+expect_wkt_serializeable <- function(x) {
+  expect_wkt_equal(x, unserialize(serialize(x, NULL)), precision = 8)
+}

R/wk-utils.R

@@ -7,6 +7,9 @@
 #' @param tessellate_tol,s2_tessellate_tol An angle in radians.
 #'   Points will not be added if a line segment is within this
 #'   distance of a point.
+#' @param use_altrep A flag indicating whether ALTREP representation of s2 geography
+#'    vectors should be used with support for data serialization (default: `TRUE` on R 4.3.0 and later,
+#'    set the option `s2.disable_altrep` to disable)
 #' @param x_scale The maximum x value of the projection
 #' @param centre The center point of the orthographic projection
 #' @param epsilon_east_west,epsilon_north_south Use a positive number to
@@ -39,7 +42,8 @@ wk_handle.s2_geography <- function(handleable, handler, ...,
 #' @export
 s2_geography_writer <- function(oriented = FALSE, check = TRUE,
                                 projection = s2_projection_plate_carree(),
-                                tessellate_tol = Inf) {
+                                tessellate_tol = Inf,
+                                use_altrep = !isTRUE(getOption("s2.disable_altrep"))) {
   stopifnot(is.null(projection) || inherits(projection, "s2_projection"))
 
   wk::new_wk_handler(
@@ -48,7 +52,8 @@ s2_geography_writer <- function(oriented = FALSE, check = TRUE,
       as.logical(oriented)[1],
       as.logical(check)[1],
       projection,
-      as.double(tessellate_tol[1])
+      as.double(tessellate_tol[1]),
+      as.logical(use_altrep)[1]
     ),
     "s2_geography_writer"
   )

R/zzz.R

@@ -1,9 +1,6 @@
 
 # nocov start
 .onLoad <- function(...) {
-  # call c++ init
-  cpp_s2_init()
-
   # dynamically register vctrs dependencies
   for (cls in c("s2_geography", "s2_cell", "s2_cell_union")) {
     s3_register("vctrs::vec_proxy", cls)

src/Makevars.in

@@ -106,6 +106,7 @@ S2_OBJECTS = s2/encoded_s2cell_id_vector.o \
 STATLIB = s2/libs2static.a
 
 OBJECTS = cpp-compat.o \
+     s2-altrep.o \
      s2-accessors.o \
      s2-bounds.o \
      s2-cell.o \
@@ -114,6 +115,7 @@ OBJECTS = cpp-compat.o \
      s2-predicates.o \
      s2-transformers.o \
      init.o \
+     util.o \
      RcppExports.o \
      s2-geography.o \
      s2-lnglat.o \

src/Makevars.win

@@ -127,6 +127,7 @@ OBJECTS = s2/encoded_s2cell_id_vector.o \
      s2/util/math/mathutil.o \
      s2/util/units/length-units.o \
      cpp-compat.o \
+     s2-altrep.o \
      s2-accessors.o \
      s2-bounds.o \
      s2-cell.o \
@@ -135,6 +136,7 @@ OBJECTS = s2/encoded_s2cell_id_vector.o \
      s2-predicates.o \
      s2-transformers.o \
      init.o \
+     util.o \
      RcppExports.o \
      s2-geography.o \
      s2-lnglat.o \

src/RcppExports.cpp

@@ -10,15 +10,6 @@ Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
 Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
 #endif
 
-// cpp_s2_init
-void cpp_s2_init();
-RcppExport SEXP _s2_cpp_s2_init() {
-BEGIN_RCPP
-    Rcpp::RNGScope rcpp_rngScope_gen;
-    cpp_s2_init();
-    return R_NilValue;
-END_RCPP
-}
 // cpp_s2_is_collection
 LogicalVector cpp_s2_is_collection(List geog);
 RcppExport SEXP _s2_cpp_s2_is_collection(SEXP geogSEXP) {
@@ -176,6 +167,17 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// make_s2_geography_altrep
+SEXP make_s2_geography_altrep(SEXP list);
+RcppExport SEXP _s2_make_s2_geography_altrep(SEXP listSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXP >::type list(listSEXP);
+    rcpp_result_gen = Rcpp::wrap(make_s2_geography_altrep(list));
+    return rcpp_result_gen;
+END_RCPP
+}
 // cpp_s2_bounds_cap
 DataFrame cpp_s2_bounds_cap(List geog);
 RcppExport SEXP _s2_cpp_s2_bounds_cap(SEXP geogSEXP) {
@@ -1344,7 +1346,7 @@ BEGIN_RCPP
 END_RCPP
 }
 
-RcppExport SEXP c_s2_geography_writer_new(SEXP, SEXP, SEXP, SEXP);
+RcppExport SEXP c_s2_geography_writer_new(SEXP, SEXP, SEXP, SEXP, SEXP);
 RcppExport SEXP c_s2_handle_geography(SEXP, SEXP);
 RcppExport SEXP c_s2_handle_geography_tessellated(SEXP, SEXP);
 RcppExport SEXP c_s2_projection_mercator(SEXP);
@@ -1354,7 +1356,6 @@ RcppExport SEXP c_s2_trans_s2_lnglat_new(void);
 RcppExport SEXP c_s2_trans_s2_point_new(void);
 
 static const R_CallMethodDef CallEntries[] = {
-    {"_s2_cpp_s2_init", (DL_FUNC) &_s2_cpp_s2_init, 0},
     {"_s2_cpp_s2_is_collection", (DL_FUNC) &_s2_cpp_s2_is_collection, 1},
     {"_s2_cpp_s2_is_valid", (DL_FUNC) &_s2_cpp_s2_is_valid, 1},
     {"_s2_cpp_s2_is_valid_reason", (DL_FUNC) &_s2_cpp_s2_is_valid_reason, 1},
@@ -1369,6 +1370,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_s2_cpp_s2_project_normalized", (DL_FUNC) &_s2_cpp_s2_project_normalized, 2},
     {"_s2_cpp_s2_distance", (DL_FUNC) &_s2_cpp_s2_distance, 2},
     {"_s2_cpp_s2_max_distance", (DL_FUNC) &_s2_cpp_s2_max_distance, 2},
+    {"_s2_make_s2_geography_altrep", (DL_FUNC) &_s2_make_s2_geography_altrep, 1},
     {"_s2_cpp_s2_bounds_cap", (DL_FUNC) &_s2_cpp_s2_bounds_cap, 1},
     {"_s2_cpp_s2_bounds_rect", (DL_FUNC) &_s2_cpp_s2_bounds_rect, 1},
     {"_s2_cpp_s2_cell_union_normalize", (DL_FUNC) &_s2_cpp_s2_cell_union_normalize, 1},
@@ -1465,7 +1467,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_s2_cpp_s2_buffer_cells", (DL_FUNC) &_s2_cpp_s2_buffer_cells, 4},
     {"_s2_cpp_s2_convex_hull", (DL_FUNC) &_s2_cpp_s2_convex_hull, 1},
     {"_s2_cpp_s2_convex_hull_agg", (DL_FUNC) &_s2_cpp_s2_convex_hull_agg, 2},
-    {"c_s2_geography_writer_new",         (DL_FUNC) &c_s2_geography_writer_new,         4},
+    {"c_s2_geography_writer_new",         (DL_FUNC) &c_s2_geography_writer_new,         5},
     {"c_s2_handle_geography",             (DL_FUNC) &c_s2_handle_geography,             2},
     {"c_s2_handle_geography_tessellated", (DL_FUNC) &c_s2_handle_geography_tessellated, 2},
     {"c_s2_projection_mercator",          (DL_FUNC) &c_s2_projection_mercator,          1},
@@ -1476,7 +1478,9 @@ static const R_CallMethodDef CallEntries[] = {
     {NULL, NULL, 0}
 };
 
+void cpp_s2_init(DllInfo *dll);
 RcppExport void R_init_s2(DllInfo *dll) {
     R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
     R_useDynamicSymbols(dll, FALSE);
+    cpp_s2_init(dll);
 }

src/geography.h

@@ -5,6 +5,7 @@
 #include <Rcpp.h>
 
 #include "s2geography.h"
+#include "s2-altrep.h"
 
 class RGeography {
 public:

src/init.cpp

@@ -2,10 +2,19 @@
 #include "absl/log/log.h"
 #include "s2/s2debug.h"
 #include <Rcpp.h>
+#include "s2-altrep.h"
+#include "util.h"
+
 using namespace Rcpp;
 
-// [[Rcpp::export]]
-void cpp_s2_init() {
+// [[Rcpp::init]]
+void cpp_s2_init(DllInfo *dll) {
+  // init the altrep classes
+  s2_init_altrep(dll);
+
+  // init the global sexp cache
+  s2_init_cached_sexps();
+
   // It's important to set this flag, as users might have "debug" flags
   // for their build environment, and there are some checks that will terminate
   // R instead of throw an exception if this value is set to true.

src/s2-altrep.cpp

@@ -0,0 +1,67 @@
+#define R_NO_REMAP
+#include <R.h>
+#include <Rinternals.h>
+#include <Rversion.h>
+
+#include "s2-altrep.h"
+#include "util.h"
+
+// ALTREP implementation for s2_geography
+
+#if defined(S2_GEOGRAPHY_ALTREP)
+#include "R_ext/Altrep.h"
+R_altrep_class_t s2_geography_altrep_cls;
+
+static R_xlen_t s2_altrep_Length(SEXP obj) {
+  SEXP data = R_altrep_data1(obj);
+  return Rf_xlength(data);
+}
+
+static SEXP s2_altrep_Elt(SEXP obj, R_xlen_t i) {
+  SEXP data = R_altrep_data1(obj);
+  return VECTOR_ELT(data, i);
+}
+
+static SEXP s2_altrep_Serialized_state(SEXP obj) {
+  // fetch the pointer to s2::s2_geography_serialize()
+  SEXP fn = Rf_findFun(Rf_install("s2_geography_serialize"), s2_ns_pkg);
+
+  SEXP call = PROTECT(Rf_lang2(fn, obj));
+  SEXP out = Rf_eval(call, s2_ns_pkg);
+
+  UNPROTECT(1);
+  return out;
+}
+
+static SEXP s2_altrep_Unserialize(SEXP cls, SEXP state) {
+  // fetch the pointer to s2::s2_geography_unserialize()
+  SEXP fn = Rf_findFun(Rf_install("s2_geography_unserialize"), s2_ns_pkg);
+
+  SEXP call = PROTECT(Rf_lang2(fn, state));
+  SEXP out = Rf_eval(call, s2_ns_pkg);
+
+  UNPROTECT(1);
+  return out;
+}
+#endif
+
+// [[Rcpp::export]]
+SEXP make_s2_geography_altrep(SEXP list) {
+#if defined(S2_GEOGRAPHY_ALTREP)
+  return R_new_altrep(s2_geography_altrep_cls, list, R_NilValue);
+#else
+  // nothing to do
+  return list;
+#endif
+}
+
+void s2_init_altrep(DllInfo *dll) {
+#if defined(S2_GEOGRAPHY_ALTREP)
+  s2_geography_altrep_cls = R_make_altlist_class("s2_geography", "s2", dll);
+
+  R_set_altrep_Length_method(s2_geography_altrep_cls, s2_altrep_Length);
+  R_set_altlist_Elt_method(s2_geography_altrep_cls, s2_altrep_Elt);
+  R_set_altrep_Serialized_state_method(s2_geography_altrep_cls, s2_altrep_Serialized_state);
+  R_set_altrep_Unserialize_method(s2_geography_altrep_cls, s2_altrep_Unserialize);
+#endif
+}

src/s2-altrep.h

@@ -0,0 +1,17 @@
+#ifndef S2_ALTREP_H
+#define S2_ALTREP_H
+
+#include <Rcpp.h>
+#include <Rversion.h>
+
+// ALTREP VECSXP are supported starting from R 4.3.0
+//
+// When compiling for an earlier target serialization support is disabled
+#if defined(R_VERSION) && R_VERSION >= R_Version(4, 3, 0)
+#define S2_GEOGRAPHY_ALTREP
+#endif
+
+void s2_init_altrep(DllInfo *dll);
+SEXP make_s2_geography_altrep(SEXP list);
+
+#endif