Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Complete CurrentDomain support #737

Merged
merged 10 commits into from
Jul 25, 2024
3 changes: 3 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -105,12 +105,15 @@ export(tiledb_array_schema_evolution_add_enumeration_empty)
export(tiledb_array_schema_evolution_array_evolve)
export(tiledb_array_schema_evolution_drop_attribute)
export(tiledb_array_schema_evolution_drop_enumeration)
export(tiledb_array_schema_evolution_expand_current_domain)
export(tiledb_array_schema_evolution_extend_enumeration)
export(tiledb_array_schema_get_allows_dups)
export(tiledb_array_schema_get_capacity)
export(tiledb_array_schema_get_current_domain)
export(tiledb_array_schema_set_allows_dups)
export(tiledb_array_schema_set_capacity)
export(tiledb_array_schema_set_coords_filter_list)
export(tiledb_array_schema_set_current_domain)
export(tiledb_array_schema_set_enumeration_empty)
export(tiledb_array_schema_set_offsets_filter_list)
export(tiledb_array_schema_set_validity_filter_list)
Expand Down
33 changes: 32 additions & 1 deletion R/ArraySchema.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
# MIT License
#
# Copyright (c) 2017-2023 TileDB Inc.
# Copyright (c) 2017-2024 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
Expand Down Expand Up @@ -906,3 +906,34 @@ tiledb_array_schema_set_enumeration_empty <- function(schema, attr, enum_name,
ordered)
schema
}

#' Get the Current Domain of an Array Schema
#'
#' Note that 'CurrendDomain' object may be empty.
#' @param schema An Array Schema
#' @param ctx Optional tiledb_ctx object
#' @return A 'CurrendDomain' object
#' @export
tiledb_array_schema_get_current_domain <- function(schema, ctx = tiledb_get_context()) {
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)
}

#' Set a Current Domain of an Array Schema
#'
#' @param schema An Array Schema
#' @param cd An CurrendDomain object
#' @param ctx Optional tiledb_ctx object
#' @return Nothing is returned from this function (but an error, should it occur is reported)
#' @export
tiledb_array_schema_set_current_domain <- function(schema, cd, ctx = tiledb_get_context()) {
stopifnot("Argument 'schema' must be a 'tiledb_array_schema'" = is(schema, "tiledb_array_schema"),
"Argument 'cd' must be a 'tiledb_current_domain'" = is(cd, "tiledb_current_domain"),
"Argument 'ctx' must be a 'tiledb_ctx'" = is(ctx, "tiledb_ctx"))
libtiledb_array_schema_set_current_domain(ctx@ptr, schema@ptr, cd@ptr)
invisible(NULL)
}
16 changes: 16 additions & 0 deletions R/ArraySchemaEvolution.R
Original file line number Diff line number Diff line change
Expand Up @@ -160,6 +160,7 @@ tiledb_array_schema_evolution_add_enumeration_empty <- function(ase, enum_name,
#' @param ordered A logical value indicating standard \code{factor} (when \code{FALSE}, the default)
#' or \code{ordered} (when \code{TRUE})
#' @param ctx Optional tiledb_ctx object
#' @return The modified ArraySchemaEvolution object
#' @export
tiledb_array_schema_evolution_extend_enumeration <- function(ase, array, enum_name,
new_values, nullable = FALSE,
Expand All @@ -178,3 +179,18 @@ tiledb_array_schema_evolution_extend_enumeration <- function(ase, array, enum_na
nullable, ordered)
ase
}

#' Expand an the Current Domain of an Array via Array Schema Evolution
#'
#' @param ase An ArraySchemaEvolution object
#' @param cd A CurrentDomain object
#' @return The modified ArraySchemaEvolution object
#' @export
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")
ase@ptr <- libtiledb_array_schema_evolution_expand_current_domain(ase@ptr, cd@ptr)
ase
}
16 changes: 11 additions & 5 deletions R/CurrentDomain.R
Original file line number Diff line number Diff line change
Expand Up @@ -23,24 +23,28 @@
#' 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"))
slots = list(ptr = "externalptr",
datatype = "character"))

#' Creates a `tiledb_current_domain` object
#'
#' @param ctx (optional) A TileDB Ctx object
#' @return The `tiledb_current_domain` object
#' @examples
#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
#' cd <-tiledb_current_domain()
#' if (tiledb_version(TRUE) >= "2.25.0") {
#' cd <-tiledb_current_domain()
#' }
#'
#' @export
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))
return(new("tiledb_current_domain", ptr = ptr, datatype = NA_character_))
}

#' Get `tiledb_current_domain` data type as string
Expand All @@ -66,7 +70,9 @@ tiledb_current_domain_set_ndrectangle <- function(cd, ndr) {
is(cd, "tiledb_current_domain"),
"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")
libtiledb_current_domain_set_ndrectangle(cd@ptr, ndr@ptr)
cd@ptr <- libtiledb_current_domain_set_ndrectangle(cd@ptr, ndr@ptr)
cd@datatype <- ndr@datatype
cd
}

#' Get a `tiledb_ndrectangle` from a `tiledb_current_domain` object
Expand All @@ -79,7 +85,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 <- libtiledb_current_domain_type(cd@ptr)
tpstr <- cd@datatype
return(new("tiledb_ndrectangle", ptr = ptr, datatype = tpstr))
}

Expand Down
37 changes: 22 additions & 15 deletions R/NDRectangle.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,20 +31,23 @@ setClass("tiledb_ndrectangle",

#' Creates a `tiledb_ndrectangle` object
#'
#' @param domain A TileDB Domain object for which the NDRectangle object is created
#' @param dom A TileDB Domain object for which the NDRectangle object is created
#' @param ctx (optional) A TileDB Ctx object
#' @return The `tiledb_ndrectangle` object
#' @examples
#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
#' dom <-tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
#' ndr <- tiledb_ndrectangle(dom)
#' if (tiledb_version(TRUE) >= "2.25.0") {
#' dom <-tiledb_domain(dim = tiledb_dim("d1", c(1L, 100L), type = "INT32"))
#' ndr <- tiledb_ndrectangle(dom)
#' }
#'
#' @export
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 <- datatype(dom)
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))
}
Expand All @@ -62,10 +65,11 @@ tiledb_ndrectangle <- function(dom, ctx = tiledb_get_context()) {
#' string dimensions.
#' @examples
#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
#' 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)
#'
#' if (tiledb_version(TRUE) >= "2.25.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)
#' }
#' @export
tiledb_ndrectangle_set_range <- function(ndr, dimname, start, end) {
stopifnot("The first argument must be a TileDB NDRectangle object" = is(ndr, "tiledb_ndrectangle"),
Expand All @@ -75,7 +79,8 @@ tiledb_ndrectangle_set_range <- function(ndr, dimname, start, end) {
"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")
ndr@ptr <- libtiledb_ndrectangle_set_range(ndr@ptr, ndr@datatype, dimname, start, end)
dtype <- unname(ndr@datatype[dimname])
ndr@ptr <- libtiledb_ndrectangle_set_range(ndr@ptr, dtype, dimname, start, end)
invisible(ndr)
}

Expand All @@ -86,17 +91,19 @@ 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())}
#' 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)
#' tiledb_ndrectangle_get_range(ndr, "d1")
#'
#' if (tiledb_version(TRUE) >= "2.25.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)
#' tiledb_ndrectangle_get_range(ndr, "d1")
#' }
#' @export
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")
rng <- libtiledb_ndrectangle_get_range(ndr@ptr, dimname, ndr@datatype)
dtype <- unname(ndr@datatype[dimname])
rng <- libtiledb_ndrectangle_get_range(ndr@ptr, dimname, dtype)
rng
}
12 changes: 12 additions & 0 deletions R/RcppExports.R
Original file line number Diff line number Diff line change
Expand Up @@ -436,6 +436,14 @@ libtiledb_array_schema_set_enumeration_empty <- function(ctx, schema, attr, enum
.Call(`_tiledb_libtiledb_array_schema_set_enumeration_empty`, ctx, schema, attr, enum_name, type_str, cell_val_num, ordered)
}

libtiledb_array_schema_get_current_domain <- function(ctx, sch) {
.Call(`_tiledb_libtiledb_array_schema_get_current_domain`, ctx, sch)
}

libtiledb_array_schema_set_current_domain <- function(ctx, sch, cd) {
invisible(.Call(`_tiledb_libtiledb_array_schema_set_current_domain`, ctx, sch, cd))
}

libtiledb_array_schema_evolution <- function(ctx) {
.Call(`_tiledb_libtiledb_array_schema_evolution`, ctx)
}
Expand Down Expand Up @@ -468,6 +476,10 @@ libtiledb_array_schema_evolution_extend_enumeration <- function(ctx, ase, array,
.Call(`_tiledb_libtiledb_array_schema_evolution_extend_enumeration`, ctx, ase, array, enum_name, new_values, nullable, ordered)
}

libtiledb_array_schema_evolution_expand_current_domain <- function(ase, cd) {
.Call(`_tiledb_libtiledb_array_schema_evolution_expand_current_domain`, ase, cd)
}

libtiledb_array_create <- function(uri, schema) {
.Call(`_tiledb_libtiledb_array_create`, uri, schema)
}
Expand Down
15 changes: 12 additions & 3 deletions inst/tinytest/test_arrayschema.R
Original file line number Diff line number Diff line change
Expand Up @@ -130,9 +130,8 @@ ctx <- tiledb_ctx(oldconfig) # reset to no encryption via previous config
#test_that("tiledb_array_schema dups setter/getter", {
dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L, 4L), 4L, "INT32"),
tiledb_dim("cols", c(1L, 4L), 4L, "INT32")))
sch <- tiledb_array_schema(dom,
attrs = c(tiledb_attr("a", type = "INT32")),
sparse = TRUE)
attr <- tiledb_attr("a", type = "INT32")
sch <- tiledb_array_schema(dom, attrs = attr, sparse = TRUE)

## false by default
expect_false(allows_dups(sch))
Expand All @@ -141,3 +140,13 @@ expect_false(allows_dups(sch))
allows_dups(sch) <- TRUE
expect_true(allows_dups(sch))
#})


## current domain
if (tiledb_version(TRUE) < "2.25.0") exit_file("Needs TileDB 2.25.* 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))

dsch <- tiledb_array_schema(dom, attrs = attr, sparse = FALSE)
expect_error(tiledb_array_schema_set_current_domain(dsch, cd)) # not for dense
16 changes: 16 additions & 0 deletions inst/tinytest/test_arrayschemaevolution.R
Original file line number Diff line number Diff line change
Expand Up @@ -255,3 +255,19 @@ v <- res[["val"]]$as_vector()
expect_true(is.factor(v))
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")
uri <- tempfile()
dim <- tiledb_dim("dim", c(1L, 1000L), 50L, type = "INT32")
dom <- tiledb_domain(dim = dim)
attr <- tiledb_attr("a", type = "INT32")
sch <- tiledb_array_schema(dom, attrs = attr, sparse = TRUE)
arr <- tiledb_array_create(uri, sch)
cd <- tiledb_current_domain()
ndr <- tiledb_ndrectangle(dom)
tiledb_ndrectangle_set_range(ndr, "dim", 1L, 100L)
cd <- tiledb_current_domain_set_ndrectangle(cd, ndr)
ase <- tiledb_array_schema_evolution()
expect_silent(tiledb_array_schema_evolution_expand_current_domain(ase, cd))
expect_silent(tiledb_array_schema_evolution_array_evolve(ase, uri))
21 changes: 0 additions & 21 deletions inst/tinytest/test_current_domain.R

This file was deleted.

68 changes: 68 additions & 0 deletions inst/tinytest/test_currentdomain.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,68 @@
library(tinytest)
library(tiledb)

ctx <- tiledb_ctx(limitTileDBCores())

if (tiledb_version(TRUE) < "2.25.0") exit_file("These tests needs TileDB 2.25.0 or later")

expect_silent(intdim <- tiledb_dim("dim", c(1L, 100L), type = "INT32"))
expect_silent(intdom <- tiledb_domain(dim = intdim))
expect_silent(ndr <- tiledb_ndrectangle(intdom))
expect_silent(tiledb_ndrectangle_set_range(ndr, "dim", 41L, 42L))

expect_silent(cd <- tiledb_current_domain())
expect_true(tiledb_current_domain_is_empty(cd))
expect_error(tiledb_current_domain_get_type(cd))

expect_silent(cd <- tiledb_current_domain_set_ndrectangle(cd, ndr))
expect_silent(newndr <- tiledb_current_domain_get_ndrectangle(cd))
expect_silent(newtp <- tiledb_current_domain_get_type(cd))
expect_true(is(newndr, "tiledb_ndrectangle"))
expect_equal(tiledb_ndrectangle_get_range(newndr, "dim"), c(41L, 42L))

## complete example with multiple dims and schema evolution
uri <- tempfile()
dim <- c(tiledb_dim("row", c(1L, 1000L), 50L, type = "INT32"),
tiledb_dim("col", c(1L, 100000L), 500L, type = "INT64"),
tiledb_dim("key", c(NULL, NULL), NULL, type = "ASCII"))
dom <- tiledb_domain(dim = dim)
attr <- tiledb_attr("a", type = "INT32") # unused
sch <- tiledb_array_schema(dom, attrs = attr, sparse = TRUE)
arr <- tiledb_array_create(uri, sch)
expandDomain <- function(uri, upperend=200L, upperkey="dd") {
ase <- tiledb_array_schema_evolution()
sch <- tiledb::schema(uri)
dom <- tiledb::domain(sch)
cd <- tiledb_current_domain()
ndr <- tiledb_ndrectangle(dom)
tiledb_ndrectangle_set_range(ndr, "row", 1L, upperend)
tiledb_ndrectangle_set_range(ndr, "col", bit64::as.integer64(1L), bit64::as.integer64(10 * upperend))
tiledb_ndrectangle_set_range(ndr, "key", "bb", upperkey)
tiledb_current_domain_set_ndrectangle(cd, ndr)
tiledb_array_schema_evolution_expand_current_domain(ase, cd)
tiledb_array_schema_evolution_array_evolve(ase, uri)
invisible(NULL)
}
expect_silent(expandDomain(uri))
sch <- tiledb::schema(uri)
cd <- tiledb_array_schema_get_current_domain(sch)
ndr <- tiledb_current_domain_get_ndrectangle(cd)
expect_equal(tiledb_ndrectangle_get_range(ndr, "row"), c(1, 200))
expect_equal(tiledb_ndrectangle_get_range(ndr, "col"), bit64::as.integer64(c(1, 2000)))
expect_equal(tiledb_ndrectangle_get_range(ndr, "key"), c("bb", "dd"))

expandDomain(uri, 300L, "ff")
sch <- tiledb::schema(uri)
cd <- tiledb_array_schema_get_current_domain(sch)
ndr <- tiledb_current_domain_get_ndrectangle(cd)
expect_equal(tiledb_ndrectangle_get_range(ndr, "row"), c(1, 300))
expect_equal(tiledb_ndrectangle_get_range(ndr, "col"), bit64::as.integer64(c(1, 3000)))
expect_equal(tiledb_ndrectangle_get_range(ndr, "key"), c("bb", "ff"))

expandDomain(uri, 400L, "kk")
sch <- tiledb::schema(uri)
cd <- tiledb_array_schema_get_current_domain(sch)
ndr <- tiledb_current_domain_get_ndrectangle(cd)
expect_equal(tiledb_ndrectangle_get_range(ndr, "row"), c(1, 400))
expect_equal(tiledb_ndrectangle_get_range(ndr, "col"), bit64::as.integer64(c(1, 4000)))
expect_equal(tiledb_ndrectangle_get_range(ndr, "key"), c("bb", "kk"))
2 changes: 0 additions & 2 deletions inst/tinytest/test_ndrectangle.R
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,4 @@ expect_error(tiledb_ndrectangle_set_range(ndr, "strdim", 1L, 2)) # wrong type
expect_silent(ndr <- tiledb_ndrectangle_set_range(ndr, "strdim", "aa", "zz"))

expect_error(tiledb_ndrectangle_set_range(ndr, "notdim")) # wrong name
## for reasons that are unclear this passes under dev aka 2.26.0 but creates CI issues with 2.25.0-rc0
if (tiledb_version(TRUE) < "2.26.0") exit_file("These tests needs TileDB 2.26.0 or later")
expect_equal(tiledb_ndrectangle_get_range(ndr, "strdim"), c("aa", "zz"))
Loading
Loading