[arrow-nanoarrow] branch main updated: fix(r): Ensure `ordered` is reflected in `na_dictionary()` (#299)

[pa...@apache.org]

This is an automated email from the ASF dual-hosted git repository.

paleolimbot pushed a commit to branch main
in repository https://gitbox.apache.org/repos/asf/arrow-nanoarrow.git


The following commit(s) were added to refs/heads/main by this push:
     new 2060685  fix(r): Ensure `ordered` is reflected in `na_dictionary()` (#299)
2060685 is described below

commit 2060685e549b3d13014b00efdcfa2035b4174b5d
Author: Dewey Dunnington <de...@dunnington.ca>
AuthorDate: Tue Sep 19 22:29:01 2023 +0200

    fix(r): Ensure `ordered` is reflected in `na_dictionary()` (#299)
    
    Closes #296.
    
    ``` r
    library(nanoarrow)
    
    arrow::as_data_type(na_dictionary(na_string(), ordered = FALSE))
    #> DictionaryType
    #> dictionary<values=string, indices=int32>
    arrow::as_data_type(na_dictionary(na_string(), ordered = TRUE))
    #> DictionaryType
    #> dictionary<values=string, indices=int32>
    
    arrow::as_data_type(
      infer_nanoarrow_schema(factor(letters[1:5], ordered = TRUE))
    )
    #> DictionaryType
    #> dictionary<values=string, indices=int32>
    arrow::as_data_type(
      infer_nanoarrow_schema(factor(letters[1:5], ordered = FALSE))
    )
    #> DictionaryType
    #> dictionary<values=string, indices=int32>
    ```
    
    <sup>Created on 2023-09-18 with [reprex
    v2.0.2](https://reprex.tidyverse.org)</sup>
---
 r/R/type.R                   | 16 ++++++++++++++++
 r/tests/testthat/test-type.R |  9 ++++++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/r/R/type.R b/r/R/type.R
index f0b5a49..d0c116c 100644
--- a/r/R/type.R
+++ b/r/R/type.R
@@ -386,6 +386,16 @@ na_map <- function(key_type, item_type, keys_sorted = FALSE, nullable = TRUE) {
 na_dictionary <- function(value_type, index_type = na_int32(), ordered = FALSE) {
   index_type <- as_nanoarrow_schema(index_type)
   index_type$dictionary <- value_type
+
+  if (ordered) {
+    index_type$flags <- bitwOr(index_type$flags, ARROW_FLAG$DICTIONARY_ORDERED)
+  } else {
+    index_type$flags <- bitwAnd(
+      index_type$flags,
+      bitwNot(ARROW_FLAG$DICTIONARY_ORDERED)
+    )
+  }
+
   index_type
 }
 
@@ -452,3 +462,9 @@ NANOARROW_TYPE <- list(
   LARGE_LIST = 37L,
   INTERVAL_MONTH_DAY_NANO = 38L
 )
+
+ARROW_FLAG <- list(
+  DICTIONARY_ORDERED = 1L,
+  NULLABLE = 2L,
+  MAP_KEYS_SORTED = 4L
+)
diff --git a/r/tests/testthat/test-type.R b/r/tests/testthat/test-type.R
index 041903d..eb10fac 100644
--- a/r/tests/testthat/test-type.R
+++ b/r/tests/testthat/test-type.R
@@ -136,9 +136,16 @@ test_that("map constructor assigns the correct key and value types", {
 })
 
 test_that("dictionary types can be created", {
-  schema <- na_dictionary(na_string())
+  schema <- na_dictionary(na_string(), ordered = FALSE)
   expect_identical(schema$format, "i")
   expect_identical(schema$dictionary$format, "u")
+  expect_identical(schema$flags, ARROW_FLAG$NULLABLE)
+
+  schema <- na_dictionary(na_string(), ordered = TRUE)
+  expect_identical(
+    schema$flags,
+    bitwOr(ARROW_FLAG$NULLABLE, ARROW_FLAG$DICTIONARY_ORDERED)
+  )
 })
 
 test_that("extension types can be created", {