fix: Apply precision when converting sfc objects to geoarrow (#63)

Closes #55 

``` r
library(sf)
#> Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE
library(geoarrow)

sfc = st_point(c(1/3, 1/6)) |>
  st_sfc() |>
  st_set_precision(100)

brew_geoarrow = sfc |>
  geoarrow::as_geoarrow_array()

brew_geoarrow$children$x$buffers[[2]] |> as.vector()
#> [1] 0.33


# Unfortunately geoarrow.wkb will still be inappropriately precisioned
# because this isn't handled in wk
sfc |>wk::as_wkb()
#> <wk_wkb[1] with CRS=NA>
#> [1] <POINT (0.3333333 0.1666667)>
```

<sup>Created on 2025-03-07 with [reprex
v2.1.1](https://reprex.tidyverse.org)</sup>

Author: paleolimbot

src/r-sf-compat.c

@@ -4,8 +4,29 @@
 
 #include "geoarrow/geoarrow.h"
 
+// From sf/src/wkb.cpp to apply the precision from attr(sfc, "precision")
+static double make_precise(double d, double precision) {
+  if (precision == 0.0) return d;
+  if (precision < 0.0) {  // round to float, 4-byte precision
+    float f = d;
+    return (double)f;
+  }
+  return round(d * precision) / precision;
+}
+
+static void make_buffer_precise(double* ptr, int size_elements, double precision) {
+  if (precision == 0) {
+    return;
+  }
+
+  for (int i = 0; i < size_elements; i++) {
+    ptr[i] = make_precise(ptr[i], precision);
+  }
+}
+
 static inline int builder_append_sfg(SEXP item, struct GeoArrowBuilder* builder,
-                                     int level, int32_t* current_offsets) {
+                                     int level, int32_t* current_offsets,
+                                     double precision) {
   switch (TYPEOF(item)) {
     // Level of nesting
     case VECSXP: {
@@ -18,7 +39,8 @@ static inline int builder_append_sfg(SEXP item, struct GeoArrowBuilder* builder,
       GEOARROW_RETURN_NOT_OK(
           GeoArrowBuilderOffsetAppend(builder, level, current_offsets + level, 1));
       for (int32_t i = 0; i < n; i++) {
-        builder_append_sfg(VECTOR_ELT(item, i), builder, level + 1, current_offsets);
+        builder_append_sfg(VECTOR_ELT(item, i), builder, level + 1, current_offsets,
+                           precision);
       }
       break;
     }
@@ -47,8 +69,17 @@ static inline int builder_append_sfg(SEXP item, struct GeoArrowBuilder* builder,
           break;
         }
 
+        // Copy the buffer
         GEOARROW_RETURN_NOT_OK(
             GeoArrowBuilderAppendBuffer(builder, first_coord_buffer + i, view));
+
+        // Apply precision from sfc
+        double* ordinates =
+            (double*)(builder->view.buffers[first_coord_buffer + i].data.as_uint8 +
+                      builder->view.buffers[first_coord_buffer + i].size_bytes);
+        ordinates -= n_col;
+        make_buffer_precise(ordinates, n_col, precision);
+
         view.data += view.size_bytes;
       }
 
@@ -73,7 +104,8 @@ static inline int builder_append_sfg(SEXP item, struct GeoArrowBuilder* builder,
   return GEOARROW_OK;
 }
 
-static inline int builder_append_sfc_point(SEXP sfc, struct GeoArrowBuilder* builder) {
+static inline int builder_append_sfc_point(SEXP sfc, struct GeoArrowBuilder* builder,
+                                           double precision) {
   R_xlen_t n = Rf_xlength(sfc);
 
   for (int i = 0; i < builder->view.coords.n_values; i++) {
@@ -93,7 +125,7 @@ static inline int builder_append_sfc_point(SEXP sfc, struct GeoArrowBuilder* bui
         break;
       }
 
-      builder->view.coords.values[j][i] = item[j];
+      builder->view.coords.values[j][i] = make_precise(item[j], precision);
     }
 
     // Fill dimensions in builder but not in sfc with nan
@@ -107,9 +139,10 @@ static inline int builder_append_sfc_point(SEXP sfc, struct GeoArrowBuilder* bui
   return GEOARROW_OK;
 }
 
-static int builder_append_sfc(SEXP sfc, struct GeoArrowBuilder* builder) {
+static int builder_append_sfc(SEXP sfc, struct GeoArrowBuilder* builder,
+                              double precision) {
   if (Rf_inherits(sfc, "sfc_POINT")) {
-    return builder_append_sfc_point(sfc, builder);
+    return builder_append_sfc_point(sfc, builder, precision);
   }
 
   R_xlen_t n = Rf_xlength(sfc);
@@ -131,7 +164,8 @@ static int builder_append_sfc(SEXP sfc, struct GeoArrowBuilder* builder) {
   // Append elements
   for (R_xlen_t i = 0; i < n; i++) {
     SEXP item = VECTOR_ELT(sfc, i);
-    GEOARROW_RETURN_NOT_OK(builder_append_sfg(item, builder, 0, current_offsets));
+    GEOARROW_RETURN_NOT_OK(
+        builder_append_sfg(item, builder, 0, current_offsets, precision));
   }
 
   builder->view.length = n;
@@ -164,6 +198,24 @@ SEXP geoarrow_c_as_nanoarrow_array_sfc(SEXP sfc, SEXP schema_xptr, SEXP array_xp
   SEXP builder_xptr = PROTECT(R_MakeExternalPtr(builder, R_NilValue, R_NilValue));
   R_RegisterCFinalizer(builder_xptr, &finalize_builder_xptr);
 
+  // Get the precision from the sf object so we can apply it if needed
+  double precision = 0;
+  SEXP precision_sym = PROTECT(Rf_install("precision"));
+  SEXP precision_sexp = Rf_getAttrib(sfc, precision_sym);
+  UNPROTECT(1);
+  if (precision_sexp != R_NilValue && Rf_length(precision_sexp) == 1) {
+    switch (TYPEOF(precision_sexp)) {
+      case INTSXP:
+        precision = (double)INTEGER(precision_sexp)[0];
+        break;
+      case REALSXP:
+        precision = REAL(precision_sexp)[0];
+        break;
+      default:
+        break;
+    }
+  }
+
   struct GeoArrowError error;
   error.message[0] = '\0';
 
@@ -174,7 +226,7 @@ SEXP geoarrow_c_as_nanoarrow_array_sfc(SEXP sfc, SEXP schema_xptr, SEXP array_xp
   }
 
   // Build the offset buffers from the various layers of nesting
-  result = builder_append_sfc(sfc, builder);
+  result = builder_append_sfc(sfc, builder, precision);
   if (result != GEOARROW_OK) {
     Rf_error("builder_append_sfc() failed to allocate memory for offset buffers");
   }

tests/testthat/test-pkg-sf.R

@@ -238,6 +238,26 @@ test_that("as_nanoarrow_array() works for sfc_POINT", {
   )
 })
 
+test_that("as_nanoarrow_array() works for sfc_POINT with precision", {
+  skip_if_not_installed("sf")
+
+  sfc <- sf::st_sfc(
+    sf::st_point(c(1.33333333, 2.3333333)),
+    sf::st_point(c(3.33333333, 4.3333333))
+  )
+  sf::st_precision(sfc) <- 100
+
+  array <- as_nanoarrow_array(sfc)
+  expect_identical(
+    as.raw(array$children[[1]]$buffers[[2]]),
+    as.raw(nanoarrow::as_nanoarrow_buffer(c(1.33, 3.33)))
+  )
+  expect_identical(
+    as.raw(array$children[[2]]$buffers[[2]]),
+    as.raw(nanoarrow::as_nanoarrow_buffer(c(2.33, 4.33)))
+  )
+})
+
 test_that("as_nanoarrow_array() works for sfc_POINT with mixed XYZ dimensions", {
   skip_if_not_installed("sf")
 
@@ -302,6 +322,27 @@ test_that("as_nanoarrow_array() works for sfc_LINESTRING", {
   )
 })
 
+test_that("as_nanoarrow_array() works for sfc_LINESTRING with precision", {
+  skip_if_not_installed("sf")
+
+  sfc <- sf::st_sfc(
+    sf::st_linestring(
+      rbind(c(1.3333333, 2.33333333), c(3.3333333, 4.3333333))
+    )
+  )
+  sf::st_precision(sfc) <- 100
+
+  array <- as_nanoarrow_array(sfc)
+  expect_identical(
+    as.raw(array$children[[1]]$children[[1]]$buffers[[2]]),
+    as.raw(nanoarrow::as_nanoarrow_buffer(c(1.33, 3.33)))
+  )
+  expect_identical(
+    as.raw(array$children[[1]]$children[[2]]$buffers[[2]]),
+    as.raw(nanoarrow::as_nanoarrow_buffer(c(2.33, 4.33)))
+  )
+})
+
 test_that("as_nanoarrow_array() works for sfc_LINESTRING with mixed XYZ dimensions", {
   skip_if_not_installed("sf")