Extend NDRectangle support

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tiledb
 Type: Package
-Version: 0.29.0.3
+Version: 0.29.0.4
 Title: Modern Database Engine for Complex Data Based on Multi-Dimensional Arrays
 Authors@R: c(person("TileDB, Inc.", role = c("aut", "cph")),
   person("Dirk", "Eddelbuettel", email = "dirk@tiledb.com", role = "cre"))

NAMESPACE

@@ -224,6 +224,9 @@ export(tiledb_has_metadata)
 export(tiledb_is_supported_fs)
 export(tiledb_ndim)
 export(tiledb_ndrectangle)
+export(tiledb_ndrectangle_datatype)
+export(tiledb_ndrectangle_datatype_by_ind)
+export(tiledb_ndrectangle_dim_num)
 export(tiledb_ndrectangle_get_range)
 export(tiledb_ndrectangle_set_range)
 export(tiledb_num_metadata)

NEWS.md

@@ -4,7 +4,9 @@
 
 * Error messages displayed when a mismatched external pointer is detected now show both expected and encountered types (#740)
 
-* `NDRectangle` types can now be instantiated for more domain data types (#741, #742)
+* `NDRectangle` objects can now instantiate from more domain data types (#741, #742)
+
+* `NDRectangle` objects can now return their number of dimensions and dimension data types (#743)
 
 ## Documentation
 

R/ArraySchema.R

@@ -918,9 +918,7 @@ tiledb_array_schema_get_current_domain <- function(schema, ctx = tiledb_get_cont
     stopifnot("Argument 'schema' must be a 'tiledb_array_schema'" = is(schema, "tiledb_array_schema"),
               "Argument 'ctx' must be a 'tiledb_ctx'" = is(ctx, "tiledb_ctx"))
     cdptr <- libtiledb_array_schema_get_current_domain(ctx@ptr, schema@ptr)
-    typestr <- tiledb::datatype(tiledb::domain(schema))
-    names(typestr) <- sapply(tiledb::dimensions(tiledb::domain(schema)), name)
-    new("tiledb_current_domain", ptr=cdptr, datatype=typestr)
+    new("tiledb_current_domain", ptr=cdptr)
 }
 
 #' Set a Current Domain of an Array Schema

R/ArraySchemaEvolution.R

@@ -190,7 +190,7 @@ tiledb_array_schema_evolution_expand_current_domain <- function(ase, cd) {
    stopifnot("Argument 'ase' must be an Array Schema Evolution object" =
                   is(ase, "tiledb_array_schema_evolution"),
               "Argument 'cd' must be a CurrentDomain object" = is(cd, "tiledb_current_domain"),
-              "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
+              "This function needs TileDB 2.26.0 or later" = tiledb_version(TRUE) >= "2.26.0")
     ase@ptr <- libtiledb_array_schema_evolution_expand_current_domain(ase@ptr, cd@ptr)
     ase
 }

R/CurrentDomain.R

@@ -23,11 +23,9 @@
 #' An S4 class for a TileDB CurrentDomain object
 #'
 #' @slot ptr An external pointer to the underlying CurrentDomain object
-#' @slot datatype An character variable describing the data type of the domain
 #' @exportClass tiledb_current_domain
 setClass("tiledb_current_domain",
-         slots = list(ptr = "externalptr",
-                      datatype = "character"))
+         slots = list(ptr = "externalptr"))
 
 #' Creates a `tiledb_current_domain` object
 #'
@@ -44,7 +42,7 @@ tiledb_current_domain <- function(ctx = tiledb_get_context()) {
     stopifnot("The first argment must be a TileDB Ctx object" = is(ctx, "tiledb_ctx"),
               "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
     ptr <- libtiledb_current_domain_create(ctx@ptr)
-    return(new("tiledb_current_domain", ptr = ptr, datatype = NA_character_))
+    return(new("tiledb_current_domain", ptr = ptr))
 }
 
 #' Get `tiledb_current_domain` data type as string
@@ -71,7 +69,6 @@ tiledb_current_domain_set_ndrectangle <- function(cd, ndr) {
               "The second argument must be a TileDB NDRectangle object" = is(ndr, "tiledb_ndrectangle"),
               "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
     cd@ptr <- libtiledb_current_domain_set_ndrectangle(cd@ptr, ndr@ptr)
-    cd@datatype <- ndr@datatype
     cd
 }
 
@@ -85,8 +82,7 @@ tiledb_current_domain_get_ndrectangle <- function(cd) {
                   is(cd, "tiledb_current_domain"),
               "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
     ptr <- libtiledb_current_domain_get_ndrectangle(cd@ptr)
-    tpstr <- cd@datatype
-    return(new("tiledb_ndrectangle", ptr = ptr, datatype = tpstr))
+    return(new("tiledb_ndrectangle", ptr = ptr))
 }
 
 #' Test `tiledb_current_domain` object for being empty

R/NDRectangle.R

@@ -23,11 +23,9 @@
 #' An S4 class for a TileDB NDRectangle object
 #'
 #' @slot ptr An external pointer to the underlying NDRectangle object
-#' @slot datatype A character variable with the TileDB type of the corresponding domain
 #' @exportClass tiledb_ndrectangle
 setClass("tiledb_ndrectangle",
-         slots = list(ptr = "externalptr",
-                      datatype = "character"))
+         slots = list(ptr = "externalptr"))
 
 #' Creates a `tiledb_ndrectangle` object
 #'
@@ -46,10 +44,8 @@ tiledb_ndrectangle <- function(dom, ctx = tiledb_get_context()) {
     stopifnot("The first argument must be a TileDB Domain object" = is(dom, "tiledb_domain"),
               "The second argment must be a TileDB Ctx object" = is(ctx, "tiledb_ctx"),
               "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
-    typestr <- tiledb::datatype(dom)
-    names(typestr) <- sapply(tiledb::dimensions(dom), name)
     ptr <- libtiledb_ndrectangle_create(ctx@ptr, dom@ptr)
-    return(new("tiledb_ndrectangle", ptr = ptr, datatype = typestr))
+    return(new("tiledb_ndrectangle", ptr = ptr))
 }
 
 #' Set a range on a `tiledb_ndrectangle` object
@@ -65,7 +61,7 @@ tiledb_ndrectangle <- function(dom, ctx = tiledb_get_context()) {
 #' string dimensions.
 #' @examples
 #' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
-#' if (tiledb_version(TRUE) >= "2.25.0") {
+#' if (tiledb_version(TRUE) >= "2.26.0") {
 #'    dom <-tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
 #'    ndr <- tiledb_ndrectangle(dom)
 #'    ndr <- tiledb_ndrectangle_set_range(ndr, "d1", 50, 500)
@@ -78,8 +74,8 @@ tiledb_ndrectangle_set_range <- function(ndr, dimname, start, end) {
               "The third argument must be scalar" = length(start) == 1,
               "The fourth argument must be scalar" = length(end) == 1,
               "The fourth and first argument must be of the same class" = class(start) == class(end),
-              "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
-    dtype <- unname(ndr@datatype[dimname])
+              "This function needs TileDB 2.26.0 or later" = tiledb_version(TRUE) >= "2.26.0")
+    dtype <- libtiledb_ndrectangle_datatype(ndr@ptr, dimname)
     ndr@ptr <- libtiledb_ndrectangle_set_range(ndr@ptr, dtype, dimname, start, end)
     invisible(ndr)
 }
@@ -91,7 +87,7 @@ tiledb_ndrectangle_set_range <- function(ndr, dimname, start, end) {
 #' @return The `tiledb_ndrectangle` range as a two-element vector
 #' @examples
 #' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
-#' if (tiledb_version(TRUE) >= "2.25.0") {
+#' if (tiledb_version(TRUE) >= "2.26.0") {
 #'    dom <- tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
 #'    ndr <- tiledb_ndrectangle(dom)
 #'    ndr <- tiledb_ndrectangle_set_range(ndr, "d1", 50, 500)
@@ -102,8 +98,68 @@ tiledb_ndrectangle_get_range <- function(ndr, dimname) {
     stopifnot("The first argument must be a TileDB NDRectangle object" = is(ndr, "tiledb_ndrectangle"),
               "The second argument must a single character object" = is.character(dimname) &&
                   length(dimname) == 1,
-              "This function needs TileDB 2.25.0 or later" = tiledb_version(TRUE) >= "2.25.0")
-    dtype <- unname(ndr@datatype[dimname])
+              "This function needs TileDB 2.26.0 or later" = tiledb_version(TRUE) >= "2.26.0")
+    dtype <- libtiledb_ndrectangle_datatype(ndr@ptr, dimname)
     rng <- libtiledb_ndrectangle_get_range(ndr@ptr, dimname, dtype)
     rng
 }
+
+#' Get the number of dimensions for `tiledb_ndrectangle` object
+#'
+#' @param ndr A TileDB NDRectangle object
+#' @return The number of dimentiones for the `tiledb_ndrectangle`
+#' @examples
+#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
+#' if (tiledb_version(TRUE) >= "2.26.0") {
+#'    dom <- tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
+#'    ndr <- tiledb_ndrectangle(dom)
+#'    tiledb_ndrectangle_dim_num(ndr)
+#' }
+#' @export
+tiledb_ndrectangle_dim_num <- function(ndr) {
+    stopifnot("The argument must be a TileDB NDRectangle object" = is(ndr, "tiledb_ndrectangle"),
+              "This function needs TileDB 2.26.0 or later" = tiledb_version(TRUE) >= "2.26.0")
+    libtiledb_ndrectangle_dim_num(ndr@ptr)
+}
+
+#' Get the datatype of a named `tiledb_ndrectangle` dimension
+#'
+#' @param ndr A TileDB NDRectangle object
+#' @param dimname A character variable with the dimension for which to get a datatype
+#' @return The `tiledb_ndrectangle` dimension datatype as a character
+#' @examples
+#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
+#' if (tiledb_version(TRUE) >= "2.26.0") {
+#'    dom <- tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
+#'    ndr <- tiledb_ndrectangle(dom)
+#'    tiledb_ndrectangle_datatype(ndr, "d1")
+#' }
+#' @export
+tiledb_ndrectangle_datatype <- function(ndr, dimname) {
+    stopifnot("The first argument must be a TileDB NDRectangle object" = is(ndr, "tiledb_ndrectangle"),
+              "The second argument must a single character object" = is.character(dimname) &&
+                  length(dimname) == 1,
+              "This function needs TileDB 2.26.0 or later" = tiledb_version(TRUE) >= "2.26.0")
+    libtiledb_ndrectangle_datatype(ndr@ptr, dimname)
+}
+
+#' Get the datatype of a `tiledb_ndrectangle` dimension by index
+#'
+#' @param ndr A TileDB NDRectangle object
+#' @param dim Am integer value for the dimension for which to get a datatype
+#' @return The `tiledb_ndrectangle` dimension datatype as a character
+#' @examples
+#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
+#' if (tiledb_version(TRUE) >= "2.26.0") {
+#'    dom <- tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
+#'    ndr <- tiledb_ndrectangle(dom)
+#'    tiledb_ndrectangle_datatype_by_ind(ndr, 0)
+#' }
+#' @export
+tiledb_ndrectangle_datatype_by_ind <- function(ndr, dim) {
+    stopifnot("The first argument must be a TileDB NDRectangle object" = is(ndr, "tiledb_ndrectangle"),
+              "The second argument must a single numeric object" = is.numeric(dim) &&
+                  length(dim) == 1,
+              "This function needs TileDB 2.26.0 or later" = tiledb_version(TRUE) >= "2.26.0")
+    libtiledb_ndrectangle_datatype_by_ind(ndr@ptr, dim)
+}

R/RcppExports.R

@@ -1196,6 +1196,18 @@ libtiledb_ndrectangle_get_range <- function(ndr, dimname, dtype) {
     .Call(`_tiledb_libtiledb_ndrectangle_get_range`, ndr, dimname, dtype)
 }
 
+libtiledb_ndrectangle_dim_num <- function(ndr) {
+    .Call(`_tiledb_libtiledb_ndrectangle_dim_num`, ndr)
+}
+
+libtiledb_ndrectangle_datatype <- function(ndr, name) {
+    .Call(`_tiledb_libtiledb_ndrectangle_datatype`, ndr, name)
+}
+
+libtiledb_ndrectangle_datatype_by_ind <- function(ndr, dim) {
+    .Call(`_tiledb_libtiledb_ndrectangle_datatype_by_ind`, ndr, dim)
+}
+
 libtiledb_current_domain_create <- function(ctx) {
     .Call(`_tiledb_libtiledb_current_domain_create`, ctx)
 }

inst/tinytest/test_arrayschema.R

@@ -143,7 +143,7 @@ expect_true(allows_dups(sch))
 
 
 ## current domain
-if (tiledb_version(TRUE) < "2.25.0") exit_file("Needs TileDB 2.25.* or later")
+if (tiledb_version(TRUE) < "2.26.0") exit_file("Needs TileDB 2.26.* or later")
 expect_error(tiledb_array_schema_get_current_domain(dom))           # wrong object
 expect_silent(cd <- tiledb_array_schema_get_current_domain(sch))
 expect_silent(tiledb_array_schema_set_current_domain(sch, cd))

inst/tinytest/test_arrayschemaevolution.R

@@ -257,7 +257,7 @@ expect_equal(levels(v), enums)
 expect_equal(as.integer(v), c(1:5,5:1))
 
 ## current domain
-if (tiledb_version(TRUE) < "2.25.0") exit_file("Needs TileDB 2.25.* or later")
+if (tiledb_version(TRUE) < "2.26.0") exit_file("Needs TileDB 2.26.* or later")
 uri <- tempfile()
 dim <- tiledb_dim("dim", c(1L, 1000L), 50L, type = "INT32")
 dom <- tiledb_domain(dim = dim)

inst/tinytest/test_currentdomain.R

@@ -3,7 +3,7 @@ library(tiledb)
 
 ctx <- tiledb_ctx(limitTileDBCores())
 
-if (tiledb_version(TRUE) < "2.25.0") exit_file("These tests needs TileDB 2.25.0 or later")
+if (tiledb_version(TRUE) < "2.26.0") exit_file("These tests needs TileDB 2.26.0 or later")
 
 expect_silent(intdim <- tiledb_dim("dim", c(1L, 100L), type = "INT32"))
 expect_silent(intdom <- tiledb_domain(dim = intdim))

inst/tinytest/test_ndrectangle.R

@@ -4,7 +4,7 @@ library(tiledb)
 
 ctx <- tiledb_ctx(limitTileDBCores())
 
-if (tiledb_version(TRUE) < "2.25.0") exit_file("These tests needs TileDB 2.25.0 or later")
+if (tiledb_version(TRUE) < "2.26.0") exit_file("These tests needs TileDB 2.26.0 or later")
 
 for (tp in c("INT32", "UINT32", "INT16", "UINT16", "INT64", "UINT64", "INT8", "UINT8", "FLOAT32", "FLOAT64")) {
     if (grepl("INT64", tp)) {
@@ -43,6 +43,12 @@ for (tp in c("INT32", "UINT32", "INT16", "UINT16", "INT64", "UINT64", "INT8", "U
     } else {
         expect_equal(tiledb_ndrectangle_get_range(ndr, "dim"), c(1L, 20L))
     }
+
+    expect_equal(tiledb_ndrectangle_dim_num(ndr), 1)
+    expect_equal(tiledb_ndrectangle_datatype(ndr, "dim"), tp)
+    expect_error(tiledb_ndrectangle_datatype(ndr, "not_a_dim"))
+    expect_equal(tiledb_ndrectangle_datatype_by_ind(ndr, 0), tp)
+    expect_error(tiledb_ndrectangle_datatype_by_ind(ndr, 1))
 }
 
 ## ASCII