feat(r): Implement string view support in R bindings (#636)

This PR adds support for string view and binary view types to the R
bindings. As a side effect of this, conversion of character vectors to
Arrow types is now simpler (just goes through nanoarrow C's array
builder) and supports more types (e.g., the arrow package is no longer
required to create large_string, large_binary, or fixed_size_binary).

``` r
library(nanoarrow)

long_strings <- rep(strrep(letters, 100), 100)

(array <- as_nanoarrow_array(long_strings, schema = na_string_view()))
#> <nanoarrow_array string_view[2600]>
#>  $ length    : int 2600
#>  $ null_count: int 0
#>  $ offset    : int 0
#>  $ buffers   :List of 11
#>   ..$ :<nanoarrow_buffer validity<bool>[0][0 b]> ``
#>   ..$ :<nanoarrow_buffer unknown<string_view>[2600][41600 b]>`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `aaaaaaaaaaaaaaaaaaaaaaaaaaa...`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `ppppppppppppppppppppppppppp...`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `eeeeeeeeeeeeeeeeeeeeeeeeeee...`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `ttttttttttttttttttttttttttt...`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `iiiiiiiiiiiiiiiiiiiiiiiiiii...`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `xxxxxxxxxxxxxxxxxxxxxxxxxxx...`
#>   ..$ :<nanoarrow_buffer data<string>[32700 b]> `mmmmmmmmmmmmmmmmmmmmmmmmmmm...`
#>   ..$ :<nanoarrow_buffer data<string>[31100 b]> `bbbbbbbbbbbbbbbbbbbbbbbbbbb...`
#>   ..$ :<nanoarrow_buffer data<int64>[8][64 b]> `32700 32700 32700 32700 3270...`
#>  $ dictionary: NULL
#>  $ children  : list()

identical(convert_array(array), long_strings)
#> [1] TRUE
```

<sup>Created on 2024-09-27 with [reprex
v2.1.1](https://reprex.tidyverse.org)</sup>

---------

Co-authored-by: Bryce Mecum <[email protected]>

Author: paleolimbot

r/NAMESPACE

@@ -147,6 +147,7 @@ export(infer_nanoarrow_ptype)
 export(infer_nanoarrow_ptype_extension)
 export(infer_nanoarrow_schema)
 export(na_binary)
+export(na_binary_view)
 export(na_bool)
 export(na_date32)
 export(na_date64)
@@ -176,6 +177,7 @@ export(na_map)
 export(na_na)
 export(na_sparse_union)
 export(na_string)
+export(na_string_view)
 export(na_struct)
 export(na_time32)
 export(na_time64)

r/R/buffer.R

@@ -64,7 +64,7 @@ as_nanoarrow_buffer.default <- function(x, ...) {
 
 #' @importFrom utils str
 #' @export
-str.nanoarrow_buffer <- function(object, ..., db = F, indent.str = "",
+str.nanoarrow_buffer <- function(object, ..., indent.str = "",
                                  width = getOption("width")) {
   formatted <- format(object)
   cat(formatted)
@@ -117,8 +117,10 @@ print.nanoarrow_buffer <- function(x, ...) {
 }
 
 #' @export
+
 format.nanoarrow_buffer <- function(x, ...) {
   info <- nanoarrow_buffer_info(x)
+  is_null <- identical(nanoarrow_pointer_addr_chr(info$data), "0")
   if (info$data_type == "unknown") {
     len <- ""
   } else if (info$element_size_bits == 0 || info$data_type %in% c("binary", "string")) {
@@ -128,14 +130,17 @@ format.nanoarrow_buffer <- function(x, ...) {
     len <- sprintf("[%s][%s b]", logical_length, info$size_bytes)
   }
 
-
-  sprintf(
-    "<%s %s<%s>%s>",
-    class(x)[1],
-    info$type,
-    info$data_type,
-    len
-  )
+  if (is_null) {
+    sprintf("<%s %s<%s>[null]", class(x)[1], info$type, info$data_type)
+  } else {
+    sprintf(
+      "<%s %s<%s>%s>",
+      class(x)[1],
+      info$type,
+      info$data_type,
+      len
+    )
+  }
 }
 
 #' Create and modify nanoarrow buffers
@@ -209,7 +214,7 @@ as_nanoarrow_array.nanoarrow_buffer <- function(x, ..., schema = NULL) {
         buffers = list(NULL, offsets, x)
       )
     )
-  } else if(data_type %in% c("string", "binary")) {
+  } else if (data_type %in% c("string", "binary")) {
     array <- nanoarrow_array_init(na_type(paste0("large_", data_type)))
     offsets <- as_nanoarrow_array(c(0, logical_length), schema = na_int64())$buffers[[2]]
     nanoarrow_array_modify(
@@ -220,6 +225,8 @@ as_nanoarrow_array.nanoarrow_buffer <- function(x, ..., schema = NULL) {
         buffers = list(NULL, offsets, x)
       )
     )
+  } else if (data_type %in% c("string_view", "binary_view")) {
+    stop("Can't convert buffer of type string_view or binary_view to array")
   } else {
     array <- nanoarrow_array_init(na_type(data_type))
     nanoarrow_array_modify(

r/R/infer-ptype.R

@@ -76,7 +76,8 @@ infer_ptype_other <- function(schema) {
     parsed$type,
     "na" = vctrs::unspecified(),
     "binary" = ,
-    "large_binary" = new_blob_internal(),
+    "large_binary" = ,
+    "binary_view" = new_blob_internal(),
     "date32" = structure(numeric(), class = "Date"),
     "time32" = ,
     "time64" = hms::hms(),

r/R/type.R

@@ -186,6 +186,12 @@ na_large_string <- function(nullable = TRUE) {
   .Call(nanoarrow_c_schema_init, NANOARROW_TYPE$LARGE_STRING, isTRUE(nullable))
 }
 
+#' @rdname na_type
+#' @export
+na_string_view <- function(nullable = TRUE) {
+  .Call(nanoarrow_c_schema_init, NANOARROW_TYPE$STRING_VIEW, isTRUE(nullable))
+}
+
 #' @rdname na_type
 #' @export
 na_binary <- function(nullable = TRUE) {
@@ -209,6 +215,12 @@ na_fixed_size_binary <- function(byte_width, nullable = TRUE) {
   )
 }
 
+#' @rdname na_type
+#' @export
+na_binary_view <- function(nullable = TRUE) {
+  .Call(nanoarrow_c_schema_init, NANOARROW_TYPE$BINARY_VIEW, isTRUE(nullable))
+}
+
 #' @rdname na_type
 #' @export
 na_date32 <- function(nullable = TRUE) {
@@ -460,7 +472,10 @@ NANOARROW_TYPE <- list(
   LARGE_STRING = 35L,
   LARGE_BINARY = 36L,
   LARGE_LIST = 37L,
-  INTERVAL_MONTH_DAY_NANO = 38L
+  INTERVAL_MONTH_DAY_NANO = 38L,
+  RUN_END_ENCODED = 39L,
+  BINARY_VIEW = 40L,
+  STRING_VIEW = 41L
 )
 
 ARROW_FLAG <- list(

r/man/na_type.Rd

@@ -370,13 +370,43 @@ static SEXP borrow_buffer(struct ArrowArrayView* array_view, int64_t i, SEXP she
   SEXP buffer_class = PROTECT(Rf_allocVector(STRSXP, 2));
   SET_STRING_ELT(buffer_class, 1, Rf_mkChar("nanoarrow_buffer"));
 
+  struct ArrowBufferView view;
+  enum ArrowBufferType buffer_type;
+  enum ArrowType data_type;
+  int64_t element_size_bits;
+  if ((array_view->storage_type == NANOARROW_TYPE_STRING_VIEW ||
+       array_view->storage_type == NANOARROW_TYPE_BINARY_VIEW) &&
+      i >= NANOARROW_BINARY_VIEW_FIXED_BUFFERS) {
+    view.data.data = array_view->array->buffers[i];
+
+    if (i == (array_view->n_variadic_buffers + NANOARROW_BINARY_VIEW_FIXED_BUFFERS)) {
+      view.size_bytes = array_view->n_variadic_buffers * sizeof(int64_t);
+      buffer_type = NANOARROW_BUFFER_TYPE_DATA;
+      data_type = NANOARROW_TYPE_INT64;
+      element_size_bits = 64;
+    } else {
+      view.size_bytes =
+          array_view->variadic_buffer_sizes[i - NANOARROW_BINARY_VIEW_FIXED_BUFFERS];
+      buffer_type = NANOARROW_BUFFER_TYPE_DATA;
+
+      if (array_view->storage_type == NANOARROW_TYPE_STRING_VIEW) {
+        data_type = NANOARROW_TYPE_STRING;
+      } else {
+        data_type = NANOARROW_TYPE_BINARY;
+      }
+      element_size_bits = 0;
+    }
+  } else {
+    view = array_view->buffer_views[i];
+    buffer_type = array_view->layout.buffer_type[i];
+    data_type = array_view->layout.buffer_data_type[i];
+    element_size_bits = array_view->layout.element_size_bits[i];
+  }
+
   SEXP buffer_xptr =
-      PROTECT(buffer_borrowed_xptr(array_view->buffer_views[i].data.data,
-                                   array_view->buffer_views[i].size_bytes, shelter));
+      PROTECT(buffer_borrowed_xptr(view.data.data, view.size_bytes, shelter));
 
-  buffer_borrowed_xptr_set_type(buffer_xptr, array_view->layout.buffer_type[i],
-                                array_view->layout.buffer_data_type[i],
-                                array_view->layout.element_size_bits[i]);
+  buffer_borrowed_xptr_set_type(buffer_xptr, buffer_type, data_type, element_size_bits);
   UNPROTECT(2);
   return buffer_xptr;
 }