Let C code handle string conversion

R/read_npy.R

@@ -118,7 +118,9 @@ parse_npy_datatype <- function(descr) {
     "f" = "numeric",
     "i" = "integer",
     "u" = "integer",
+    "?" = "logical",
     "b" = "logical",
+    "a" = "string",
     "S" = "string",
     "U" = "unicode",
     stop("Unsupported data type in .npy file: ", descr[1])
@@ -129,7 +131,9 @@ parse_npy_datatype <- function(descr) {
     "f" = "float",
     "i" = "int",
     "u" = "uint",
+    "?" = "bool",
     "b" = "bool",
+    "a" = "string",
     "S" = "string",
     "U" = "unicode"
   )
@@ -139,7 +143,9 @@ parse_npy_datatype <- function(descr) {
     "f" = as.integer(descr[4]),
     "i" = as.integer(descr[4]),
     "u" = as.integer(descr[4]),
+    "?" = 1L,
     "b" = 1L,
+    "a" = as.integer(descr[4]),
     "S" = as.integer(descr[4]),
     "U" = as.integer(descr[4]) * 4L
   )
@@ -157,51 +163,23 @@ parse_npy_datatype <- function(descr) {
 parse_npy_data <- function(bytes, shape, datatype, signed, typesize, endian) {
   num_elements <- prod(shape)
 
+  bytes <- readBin(bytes, "raw", n = num_elements * typesize)
+  # FIXME: optimize this
+  if (datatype != "unicode" && !is.na(endian) && endian != .Platform$endian) {
+    ind <- rep_len(rev(seq_len(typesize)), length(bytes)) +
+      (seq_along(bytes) - 1L) %/% typesize * typesize
+    bytes <- bytes[ind]
+  }
+
   if (datatype == "unicode") {
-    ints <- readBin(
-      bytes,
-      what = "integer",
-      size = 4,
-      n = num_elements * typesize / 4,
-      endian = "little"
-    )
-    tmp <- split(
-      ints,
-      f = ceiling(seq_along(ints) / (typesize / 4))
-    )
-    data <- vapply(
-      tmp,
-      intToUtf8,
-      FUN.VALUE = character(1),
-      USE.NAMES = FALSE
-    )
-  } else if (datatype == "string") {
-    ints <- readBin(
+    data <- .Call(
+      "type_convert_unicode",
       bytes,
-      what = "integer",
-      size = 1,
-      n = num_elements * typesize,
-      endian = "little"
-    )
-    tmp <- split(
-      ints,
-      f = ceiling(seq_along(ints) / typesize)
-    )
-    data <- vapply(
-      tmp,
-      function(x) rawToChar(as.raw(x)),
-      FUN.VALUE = character(1),
-      USE.NAMES = FALSE
+      typesize,
+      endian,
+      PACKAGE = "grumpy"
     )
   } else {
-    # FIXME: optimize this
-    bytes <- readBin(bytes, "raw", n = num_elements * typesize)
-    if (!is.na(endian) && endian != .Platform$endian) {
-      ind <- rep_len(rev(seq_len(typesize)), length(bytes)) +
-        (seq_along(bytes) - 1L) %/% typesize * typesize
-      bytes <- bytes[ind]
-    }
-
     data <- .Call(
       paste0("type_convert_", datatype),
       bytes,

inst/scripts/generate_test_data.py

@@ -39,7 +39,7 @@
 np.save("inst/extdata/test_empty.npy", np.array([], dtype="float32"))
 
 # String types (unicode and byte strings)
-np.save("inst/extdata/test_str_unicode.npy", np.array(["foo", "bar", "baz", "qux", "hello", "world", "alpha", "beta", "gamma", "delta", "epsilon", "zeta"], dtype="U7"))
+np.save("inst/extdata/test_str_unicode.npy", np.array(['¡Hola mundo!', 'Hej Världen!', 'Servus Woid!', 'Hei maailma!', 'Xin chào thế giới', 'Njatjeta Botë!', 'Γεια σου κόσμε!', 'こんにちは世界', '世界，你好！', 'Helló, világ!', 'Zdravo svete!', 'เฮลโลเวิลด์'], dtype="U20"))
 np.save("inst/extdata/test_str_bytes.npy", np.array([b"foo", b"bar", b"baz", b"qux", b"hello", b"world", b"alpha", b"beta", b"gamma", b"delta", b"eps", b"zeta"], dtype="S5"))
 
 # NPZ archive (multiple arrays)

src/grumpy.c

@@ -7,6 +7,7 @@ static const R_CallMethodDef callMethods[] = {
   {"type_convert_float", (DL_FUNC) &type_convert_float, 2},
   {"type_convert_bool", (DL_FUNC) &type_convert_bool, 2},
   {"type_convert_string", (DL_FUNC) &type_convert_string, 2},
+  {"type_convert_unicode", (DL_FUNC) &type_convert_unicode, 3},
   {NULL, NULL, 0}
 };
 

src/type_conversion.c

@@ -1,4 +1,5 @@
 #include "type_conversion.h"
+#include <R_ext/Riconv.h>
 
 SEXP type_convert_int(SEXP input, SEXP _n_bytes) {
 
@@ -174,6 +175,63 @@ SEXP type_convert_string(SEXP input, SEXP _n_bytes) {
       SET_STRING_ELT(data, i, mkCharCE(field, CE_BYTES));
   }
 
+  UNPROTECT(1);
+  return(data);
+}
+
+SEXP type_convert_unicode(SEXP input, SEXP _n_bytes, SEXP _endian) {
+
+  // n_bytes is the total bytes per string element (num_codepoints * 4).
+  // Bytes are passed as-is from the file; we select UTF-32LE or UTF-32BE
+  // based on the file's endianness so no R-side byte-swapping is needed.
+  const size_t n_bytes = (size_t)INTEGER(_n_bytes)[0];
+  const R_xlen_t length = xlength(input);
+  const char *raw_buffer = (const char *)RAW(input);
+
+  const R_xlen_t data_length = length / n_bytes;
+  R_xlen_t i;
+  SEXP data;
+
+  const char *endian = CHAR(STRING_ELT(_endian, 0));
+  const char *utf32_enc = (strcmp(endian, "big") == 0) ? "UTF-32BE" : "UTF-32LE";
+
+  // Worst case: 4 UTF-8 bytes per UTF-32 codepoint.
+  char *utf8_buf = (char *)R_alloc(n_bytes + 1, 1);
+
+  void *cd = Riconv_open("UTF-8", utf32_enc);
+  if (cd == (void *)-1)
+    error("Riconv_open failed: cannot convert UTF-32LE to UTF-8");
+
+  data = PROTECT(allocVector(STRSXP, data_length));
+
+  for (i = 0; i < data_length; i++) {
+    const char *inbuf = raw_buffer + i * n_bytes;
+
+    // Find the actual length: stop at the first null codepoint (4 zero bytes),
+    // or at n_bytes if there is no null terminator.
+    // This allows us to handle both fixed-length and null-terminated strings.
+    size_t field_bytes = 0;
+    while (field_bytes + 4 <= n_bytes) {
+      uint32_t cp;
+      memcpy(&cp, inbuf + field_bytes, 4);
+      if (cp == 0) break;
+      field_bytes += 4;
+    }
+
+    size_t inbytesleft = field_bytes;
+    size_t outbytesleft = n_bytes; // safe upper bound
+    char *outbuf = utf8_buf;
+
+    Riconv(cd, &inbuf, &inbytesleft, &outbuf, &outbytesleft);
+    *outbuf = '\0';
+
+    SET_STRING_ELT(data, i, mkCharCE(utf8_buf, CE_UTF8));
+
+    // Reset the converter state for the next element.
+    Riconv(cd, NULL, NULL, NULL, NULL);
+  }
+
+  Riconv_close(cd);
   UNPROTECT(1);
   return(data);
 }

src/type_conversion.h

@@ -8,3 +8,4 @@ SEXP type_convert_uint(SEXP input, SEXP _n_bytes);
 SEXP type_convert_float(SEXP input, SEXP _n_bytes);
 SEXP type_convert_bool(SEXP input, SEXP _n_bytes);
 SEXP type_convert_string(SEXP input, SEXP _n_bytes);
+SEXP type_convert_unicode(SEXP input, SEXP _n_bytes, SEXP _endian);

tests/testthat/test-read_npy.R

@@ -153,52 +153,24 @@ test_that("different types work", {
       ),
       dim = 12L
     ))
-})
-
-test_that("big endian files work", {
-  system.file("extdata", "test_bigendian.npy", package = "grumpy") |>
-    read_npy() |>
-    expect_no_condition() |>
-    expect_identical(array(as.double(1:12), dim = 12L))
-})
-
-test_that("higher-dimension arrays work", {
-  system.file("extdata", "test_2d.npy", package = "grumpy") |>
-    read_npy() |>
-    expect_no_condition() |>
-    expect_identical(array(0:11, dim = c(3L, 4L)))
-
-  system.file("extdata", "test_3d.npy", package = "grumpy") |>
-    read_npy() |>
-    expect_no_condition() |>
-    expect_identical(array(0:23, dim = c(2L, 3L, 4L)))
-})
-
-test_that("fortran order arrays work", {
-  system.file("extdata", "test_fortran.npy", package = "grumpy") |>
-    read_npy() |>
-    expect_no_condition() |>
-    expect_identical(matrix(0:11, nrow = 3L, ncol = 4L, byrow = TRUE))
-})
 
-test_that("string dtypes raise an informative error", {
   system.file("extdata", "test_str_unicode.npy", package = "grumpy") |>
     read_npy() |>
     expect_no_condition() |>
     expect_identical(array(
       c(
-        "foo",
-        "bar",
-        "baz",
-        "qux",
-        "hello",
-        "world",
-        "alpha",
-        "beta",
-        "gamma",
-        "delta",
-        "epsilon",
-        "zeta"
+        '¡Hola mundo!',
+        'Hej Världen!',
+        'Servus Woid!',
+        'Hei maailma!',
+        'Xin chào thế giới',
+        'Njatjeta Botë!',
+        'Γεια σου κόσμε!',
+        'こんにちは世界',
+        '世界，你好！',
+        'Helló, világ!',
+        'Zdravo svete!',
+        'เฮลโลเวิลด์'
       ),
       dim = 12L
     ))
@@ -225,6 +197,32 @@ test_that("string dtypes raise an informative error", {
     ))
 })
 
+test_that("big endian files work", {
+  system.file("extdata", "test_bigendian.npy", package = "grumpy") |>
+    read_npy() |>
+    expect_no_condition() |>
+    expect_identical(array(as.double(1:12), dim = 12L))
+})
+
+test_that("higher-dimension arrays work", {
+  system.file("extdata", "test_2d.npy", package = "grumpy") |>
+    read_npy() |>
+    expect_no_condition() |>
+    expect_identical(array(0:11, dim = c(3L, 4L)))
+
+  system.file("extdata", "test_3d.npy", package = "grumpy") |>
+    read_npy() |>
+    expect_no_condition() |>
+    expect_identical(array(0:23, dim = c(2L, 3L, 4L)))
+})
+
+test_that("fortran order arrays work", {
+  system.file("extdata", "test_fortran.npy", package = "grumpy") |>
+    read_npy() |>
+    expect_no_condition() |>
+    expect_identical(matrix(0:11, nrow = 3L, ncol = 4L, byrow = TRUE))
+})
+
 test_that("scalar or empty arrays work", {
   system.file("extdata", "test_scalar.npy", package = "grumpy") |>
     read_npy() |>