Fix tiledb_array_schema() enumeration mapping

R/ArraySchema.R

@@ -1,6 +1,6 @@
 #  MIT License
 #
-#  Copyright (c) 2017-2024 TileDB Inc.
+#  Copyright (c) 2017-2025 TileDB Inc.
 #
 #  Permission is hereby granted, free of charge, to any person obtaining a copy
 #  of this software and associated documentation files (the "Software"), to deal
@@ -60,7 +60,7 @@ tiledb_array_schema.from_ptr <- function(ptr, arrptr = NULL) {
 #' ctx <- tiledb_ctx(limitTileDBCores())
 #' }
 #' schema <- tiledb_array_schema(
-#'   dom = tiledb_domain(
+#'   domain = tiledb_domain(
 #'     dims = c(
 #'       tiledb_dim("rows", c(1L, 4L), 4L, "INT32"),
 #'       tiledb_dim("cols", c(1L, 4L), 4L, "INT32")
@@ -95,7 +95,7 @@ tiledb_array_schema <- function(
     } # make it a list so that lapply works below
     stopifnot(
       "length of 'attrs' cannot be zero" = length(attrs) > 0,
-      "'attrs' must be a list of one or tiled_attr objects" = all(vapply(attrs, is_attr, logical(1)))
+      "'attrs' must be a list of 'tiledb_attr' objects" = all(vapply(attrs, is_attr, logical(1)))
     )
   } else {
     attrs <- NULL
@@ -114,7 +114,22 @@ tiledb_array_schema <- function(
   )
   # if (allows_dups && !sparse) stop("'allows_dups' requires 'sparse' TRUE")
 
-  attr_ptr_list <- if (is.list(attrs)) lapply(attrs, function(obj) slot(obj, "ptr")) else list()
+  if (is.list(attrs)) {
+    attr_names <- sapply(attrs, name)
+    attr_ptr_list <- lapply(attrs, function(obj) slot(obj, "ptr"))
+    names(attr_ptr_list) <- attr_names
+
+    # Do not allow enum named list to have different names than attributes
+    if (!is.null(enumerations)) {
+      if (!all(names(enumerations) %in% attr_names)) {
+        stop("'enumerations' should be a named list mapped to attributes names")
+      }
+    }
+
+  } else {
+    attr_ptr_list <- list()
+  }
+
   coords_filter_list_ptr <- if (!is.null(coords_filter_list)) coords_filter_list@ptr else NULL
   offsets_filter_list_ptr <- if (!is.null(offsets_filter_list)) offsets_filter_list@ptr else NULL
   validity_filter_list_ptr <- if (!is.null(validity_filter_list)) validity_filter_list@ptr else NULL

inst/tinytest/test_arrayschema.R

@@ -153,3 +153,120 @@ if (tiledb_version(TRUE) < "2.27.0") {
 } else {
   expect_silent(tiledb_array_schema_set_current_domain(dsch, cd))
 }
+
+## enumerations
+if (tiledb_version(TRUE) >= "2.17.0") {
+
+dom <- tiledb_domain(c(tiledb_dim(
+  name = "id",
+  domain = c(NULL, NULL),
+  tile = NULL,
+  type = "ASCII")))
+
+attrs <- c(
+
+  tiledb_attr(
+    name = "col1",
+    type = "INT32",
+    ncells = 1,
+    nullable = FALSE),
+  tiledb_attr(
+    name = "enum1",
+    type = "INT32",
+    ncells = 1,
+    nullable = FALSE,
+    enumeration = TRUE
+  ),
+  tiledb_attr(
+    name = "col2",
+    type = "INT32",
+    ncells = 1,
+    nullable = FALSE
+  ),
+  tiledb_attr(
+    name = "enum2",
+    type = "INT32",
+    ncells = 1,
+    nullable = FALSE,
+    enumeration = TRUE
+  ),
+  tiledb_attr(
+    name = "enum3",
+    type = "INT32",
+    ncells = 1,
+    nullable = FALSE,
+    enumeration = TRUE
+  )
+)
+
+# case 1 (ordered enums)
+uri <- tempfile()
+
+enums <- list(
+  enum1 =  c("A", "B"),
+  enum2 = c("yes", "no"),
+  enum3 = c("aa")
+)
+
+sch <- tiledb_array_schema(domain = dom, attrs = attrs, sparse = TRUE, enumerations = enums)
+tiledb_array_create(uri, sch)
+arr <- tiledb_array(uri)
+
+# columns with enums
+trg <- c(col1 = FALSE, enum1 = TRUE, col2 = FALSE, enum2 = TRUE, enum3 = TRUE)
+
+expect_equal(tiledb_array_has_enumeration(arr), trg)
+
+unlink(uri)
+
+# case 2 (unordered enums)
+uri <- tempfile()
+
+enums <- list(
+  enum2 = c("yes", "no"),
+  enum1 =  c("A", "B"),
+  enum3 = c("aa")
+)
+
+sch <- tiledb_array_schema(domain = dom, attrs = attrs, sparse = TRUE, enumerations = enums)
+tiledb_array_create(uri, sch)
+arr <- tiledb_array(uri)
+
+expect_equal(tiledb_array_has_enumeration(arr), trg)
+
+unlink(uri)
+
+# case 3 (unordered map all attributes)
+uri <- tempfile()
+
+enums <- list(
+  enum1 =  c("A", "B"),
+  col1 = NULL,
+  enum2 = c("yes", "no"),
+  enum3 = c("aa"),
+  col2 = NULL
+)
+
+
+sch <- tiledb_array_schema(domain = dom, attrs = attrs, sparse = TRUE, enumerations = enums)
+tiledb_array_create(uri, sch)
+arr <- tiledb_array(uri)
+
+expect_equal(tiledb_array_has_enumeration(arr), trg)
+
+# case 4 (unknown mapping name)
+uri <- tempfile()
+
+enums <- list(
+  name =  c("A", "B"),
+  col1 = NULL,
+  enum2 = c("yes", "no"),
+  enum3 = c("aa"),
+  col2 = NULL
+)
+
+# enums contains a named element that is not found in attributes
+expect_error(tiledb_array_schema(domain = dom, attrs = attrs, sparse = TRUE, enumerations = enums))
+
+unlink(uri)
+}

src/libtiledb.cpp

@@ -1914,11 +1914,15 @@ XPtr<tiledb::ArraySchema> libtiledb_array_schema(
     for (R_xlen_t i = 0; i < nenum; i++) {
       bool nn = enumerations[i] == R_NilValue;
       if (nn == false) {
-        XPtr<tiledb::Attribute> attr =
-            as<XPtr<tiledb::Attribute>>(attributes[i]);
         std::vector<std::string> enums =
             as<std::vector<std::string>>(enumerations[i]);
         std::string enum_name = std::string(enumnames[i]);
+
+        // Get attribute by enum name ('attributes' list is named from R level)
+        // See https://github.com/TileDB-Inc/TileDB-R/issues/853
+        XPtr<tiledb::Attribute> attr =
+            as<XPtr<tiledb::Attribute>>(attributes[enum_name]);
+
         bool is_ordered = false; // default
         // 'ordered' is an attribute off the CharacterVector
         CharacterVector enumvect = enumerations[i];