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/plot.R

@@ -145,12 +145,12 @@ cap_to_polygon <- function(centre = s2_lnglat(0, 0), radius_rad) {
     c(0, rad_proj, 0, -rad_proj, 0),
     c(rad_proj, 0, -rad_proj, 0, rad_proj)
   )
-  points_s2 <- wk::wk_handle(
+  points_s2 <- new_s2_geography(wk::wk_handle(
     points,
     s2_geography_writer(
       projection = s2_projection_orthographic(centre)
     )
-  )
+  ))
   s2_make_polygon(s2_x(points_s2), s2_y(points_s2))
 }
 

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

@@ -91,17 +91,19 @@
 #' )
 #'
 s2_geog_point <- function(longitude, latitude) {
-  wk::wk_handle(wk::xy(longitude, latitude), s2_geography_writer())
+  new_s2_geography(wk::wk_handle(wk::xy(longitude, latitude), s2_geography_writer()))
 }
 
 #' @rdname s2_geog_point
 #' @export
 s2_make_line <- function(longitude, latitude, feature_id = 1L) {
-  wk::wk_handle(
-    wk::xy(longitude, latitude),
-    wk::wk_linestring_filter(
-      s2_geography_writer(),
-      feature_id = as.integer(feature_id)
+  new_s2_geography(
+    wk::wk_handle(
+      wk::xy(longitude, latitude),
+      wk::wk_linestring_filter(
+        s2_geography_writer(),
+        feature_id = as.integer(feature_id)
+      )
     )
   )
 }
@@ -110,12 +112,14 @@ s2_make_line <- function(longitude, latitude, feature_id = 1L) {
 #' @export
 s2_make_polygon <- function(longitude, latitude, feature_id = 1L, ring_id = 1L,
                             oriented = FALSE, check = TRUE) {
-  wk::wk_handle(
-    wk::xy(longitude, latitude),
-    wk::wk_polygon_filter(
-      s2_geography_writer(oriented = oriented, check = check),
-      feature_id = as.integer(feature_id),
-      ring_id = as.integer(ring_id)
+  new_s2_geography(
+    wk::wk_handle(
+      wk::xy(longitude, latitude),
+      wk::wk_polygon_filter(
+        s2_geography_writer(oriented = oriented, check = check),
+        feature_id = as.integer(feature_id),
+        ring_id = as.integer(ring_id)
+      )
     )
   )
 }
@@ -129,16 +133,18 @@ s2_geog_from_text <- function(wkt_string, oriented = FALSE, check = TRUE,
   wkt <- wk::new_wk_wkt(wkt_string, geodesic = TRUE)
   wk::validate_wk_wkt(wkt)
 
-  wk::wk_handle(
-    wkt,
-    s2_geography_writer(
-      oriented = oriented,
-      check = check,
-      tessellate_tol = if (planar) {
-        tessellate_tol_m / s2_earth_radius_meters()
-      } else {
-        Inf
-      }
+  new_s2_geography(
+    wk::wk_handle(
+      wkt,
+      s2_geography_writer(
+        oriented = oriented,
+        check = check,
+        tessellate_tol = if (planar) {
+          tessellate_tol_m / s2_earth_radius_meters()
+        } else {
+          Inf
+        }
+      )
     )
   )
 }
@@ -151,16 +157,19 @@ 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(
-      oriented = oriented,
-      check = check,
-      tessellate_tol = if (planar) {
-        tessellate_tol_m / s2_earth_radius_meters()
-      } else {
-        Inf
-      }
+
+  new_s2_geography(
+    wk::wk_handle(
+      wkb,
+      s2_geography_writer(
+        oriented = oriented,
+        check = check,
+        tessellate_tol = if (planar) {
+          tessellate_tol_m / s2_earth_radius_meters()
+        } else {
+          Inf
+        }
+      )
     )
   )
 }

R/s2-geography.R

@@ -71,9 +71,11 @@ as_s2_geography.wk_wkb <- function(x, ..., oriented = FALSE, check = TRUE) {
     }
   }
 
-  wk::wk_handle(
-    x,
-    s2_geography_writer(oriented = oriented, check = check)
+  new_s2_geography(
+    wk::wk_handle(
+      x,
+      s2_geography_writer(oriented = oriented, check = check)
+    )
   )
 }
 
@@ -108,9 +110,11 @@ as_s2_geography.wk_wkt <- function(x, ..., oriented = FALSE, check = TRUE) {
     }
   }
 
-  wk::wk_handle(
-    x,
-    s2_geography_writer(oriented = oriented, check = check)
+  new_s2_geography(
+    wk::wk_handle(
+      x,
+      s2_geography_writer(oriented = oriented, check = check)
+    )
   )
 }
 
@@ -180,7 +184,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,20 @@
+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) {
+  new_s2_geography(
+    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/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) {
@@ -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},
@@ -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.