Skip to content

Commit

Permalink
Merge pull request #87 from TileDB-Inc/de/array_metadata
Browse files Browse the repository at this point in the history
Add array metadata support
  • Loading branch information
eddelbuettel authored Jan 18, 2020
2 parents 0d2bdc9 + 588c4bf commit a8d37c7
Show file tree
Hide file tree
Showing 79 changed files with 2,351 additions and 251 deletions.
10 changes: 10 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ S3method(dim,tiledb_dim)
S3method(dim,tiledb_domain)
S3method(is.anonymous,tiledb_attr)
S3method(is.anonymous,tiledb_dim)
S3method(print,tiledb_metadata)
export(as_data_frame)
export(attrs)
export(cell_order)
Expand All @@ -29,14 +30,17 @@ export(schema)
export(set_max_chunk_size)
export(tile)
export(tile_order)
export(tiledb_array_close)
export(tiledb_array_create)
export(tiledb_array_open)
export(tiledb_array_schema)
export(tiledb_attr)
export(tiledb_config)
export(tiledb_config_load)
export(tiledb_config_save)
export(tiledb_ctx)
export(tiledb_ctx_set_tag)
export(tiledb_delete_metadata)
export(tiledb_dense)
export(tiledb_dim)
export(tiledb_domain)
Expand All @@ -45,14 +49,20 @@ export(tiledb_filter_get_option)
export(tiledb_filter_list)
export(tiledb_filter_set_option)
export(tiledb_filter_type)
export(tiledb_get_all_metadata)
export(tiledb_get_metadata)
export(tiledb_group_create)
export(tiledb_has_metadata)
export(tiledb_is_supported_fs)
export(tiledb_ndim)
export(tiledb_num_metadata)
export(tiledb_object_ls)
export(tiledb_object_mv)
export(tiledb_object_rm)
export(tiledb_object_type)
export(tiledb_object_walk)
export(tiledb_put_metadata)
export(tiledb_set_context)
export(tiledb_sparse)
export(tiledb_stats_disable)
export(tiledb_stats_dump)
Expand Down
4 changes: 2 additions & 2 deletions R/ArraySchema.R
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ tiledb_array_schema <- function(
sparse = FALSE,
coords_filter_list = NULL,
offsets_filter_list = NULL,
ctx = tiledb:::getContext()
ctx = tiledb_get_context()
) {
if (!is(ctx, "tiledb_ctx")) {
stop("ctx argument must be a tiledb_ctx")
Expand Down Expand Up @@ -83,7 +83,7 @@ tiledb_array_schema <- function(
return(new("tiledb_array_schema", ptr = ptr))
}

tiledb_array_schema.from_array <- function(x, ctx = tiledb:::getContext()) {
tiledb_array_schema.from_array <- function(x, ctx = tiledb_get_context()) {
if (!is(ctx, "tiledb_ctx")) {
stop("ctx argument must be a tiledb_ctx")
} else if (missing(x) || !is.array(x)) {
Expand Down
2 changes: 1 addition & 1 deletion R/Attribute.R
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ tiledb_attr <- function(name,
type,
filter_list=tiledb_filter_list(),
ncells=1,
ctx = tiledb:::getContext()
ctx = tiledb_get_context()
) {
if (missing(name)) {
name <- ""
Expand Down
24 changes: 19 additions & 5 deletions R/Ctx.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,10 @@
setClass("tiledb_ctx",
slots = list(ptr = "externalptr"))

getContext <- function() {
#' Retrieve a TileDB context object from the package cache
#'
#' @return A TileDB context object
tiledb_get_context <- function() {
## return the ctx entry from the package environment (a lightweight hash)
ctx <- .pkgenv[["ctx"]]

Expand All @@ -17,11 +20,22 @@ getContext <- function() {
ctx
}

setContext <- function(ctx) {
# provided old renamed context for continuity/compatibility
getContext <- function() tiledb_get_context()

#' Store a TileDB context object in the package cache
#'
#' @param ctx A TileDB context object
#' @return A TileDB context object
#' @export
tiledb_set_context <- function(ctx) {
## set the ctx entry from the package environment (a lightweight hash)
.pkgenv[["ctx"]] <- ctx
}

# provided old renamed context for continuity/compatibility
setContext <- function(ctx) tiledb_set_context(ctx)

#' Creates a `tiledb_ctx` object
#'
#' @param config (optonal) character vector of config parameter names, values
Expand Down Expand Up @@ -61,7 +75,7 @@ tiledb_ctx <- function(config = NULL, cached = TRUE) {

tiledb_ctx_set_default_tags(ctx)

setContext(ctx)
tiledb_set_context(ctx)

return(ctx)
}
Expand All @@ -83,7 +97,7 @@ setGeneric("config", function(object, ...) {
#'
#' @export
setMethod("config", signature(object = "tiledb_ctx"),
function(object = tiledb:::getContext()) {
function(object = tiledb_get_context()) {
ptr <- libtiledb_ctx_config(object@ptr)
tiledb_config.from_ptr(ptr)
})
Expand All @@ -105,7 +119,7 @@ setMethod("config", signature(object = "tiledb_ctx"),
#' tiledb_is_supported_fs("s3")
#'
#' @export
tiledb_is_supported_fs <- function(scheme, object = tiledb:::getContext()) {
tiledb_is_supported_fs <- function(scheme, object = tiledb_get_context()) {
libtiledb_ctx_is_supported_fs(object@ptr, scheme)
}

Expand Down
8 changes: 5 additions & 3 deletions R/DenseArray.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,8 @@
#' @slot ptr External pointer to the underlying implementation
#' @exportClass tiledb_dense
setClass("tiledb_dense",
slots = list(ctx = "tiledb_ctx", uri = "character", as.data.frame = "logical", ptr = "externalptr"))
slots = list(ctx = "tiledb_ctx", uri = "character",
as.data.frame = "logical", ptr = "externalptr"))

#' Constructs a tiledb_dense object backed by a persisted tiledb array uri
#'
Expand All @@ -16,7 +17,8 @@ setClass("tiledb_dense",
#' @param ctx tiledb_ctx (optional)
#' @return tiledb_dense array object
#' @export
tiledb_dense <- function(uri, query_type = c("READ", "WRITE"), as.data.frame=FALSE, ctx = tiledb:::getContext()) {
tiledb_dense <- function(uri, query_type = c("READ", "WRITE"),
as.data.frame=FALSE, ctx = tiledb_get_context()) {
query_type = match.arg(query_type)
if (!is(ctx, "tiledb_ctx")) {
stop("argument ctx must be a tiledb_ctx")
Expand All @@ -36,7 +38,7 @@ tiledb_dense <- function(uri, query_type = c("READ", "WRITE"), as.data.frame=FAL

setMethod("show", "tiledb_dense",
function (object) {
cat("tiledb_dense(uri = \"", object@uri, "\")")
cat("tiledb_dense(uri = \"", object@uri, "\")\n", sep="")
})

#' #' Reopens a TileDB array an opened tiledb array
Expand Down
2 changes: 1 addition & 1 deletion R/Dim.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ tiledb_dim.from_ptr <- function(ptr) {
#'
#' @importFrom methods new
#' @export tiledb_dim
tiledb_dim <- function(name="", domain, tile, type, ctx = tiledb:::getContext()) {
tiledb_dim <- function(name="", domain, tile, type, ctx = tiledb_get_context()) {
if (!is(ctx, "tiledb_ctx")) {
stop("ctx argument must be a tiledb_ctx")
} else if (!is.scalar(name, "character")) {
Expand Down
2 changes: 1 addition & 1 deletion R/Domain.R
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ tiledb_domain.from_ptr <- function(ptr) {
#' @importFrom methods slot
#' @importFrom methods new
#' @export tiledb_domain
tiledb_domain <- function(dims, ctx = tiledb:::getContext()) {
tiledb_domain <- function(dims, ctx = tiledb_get_context()) {
if (!is(ctx, "tiledb_ctx")) {
stop("argument ctx must be a tiledb_ctx")
}
Expand Down
2 changes: 1 addition & 1 deletion R/Filter.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ tiledb_filter.from_ptr <- function(ptr) {
#' tiledb_filter("ZSTD")
#'
#' @export tiledb_filter
tiledb_filter <- function(name = "NONE", ctx = tiledb:::getContext()) {
tiledb_filter <- function(name = "NONE", ctx = tiledb_get_context()) {
if (!is(ctx, "tiledb_ctx")) {
stop("argument ctx must be a tiledb_ctx")
} else if (!is.scalar(name, "character")) {
Expand Down
2 changes: 1 addition & 1 deletion R/FilterList.R
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ tiledb_filter_list.from_ptr <- function(ptr) {
#' filter_list
#'
#' @export tiledb_filter_list
tiledb_filter_list <- function(filters = c(), ctx = tiledb:::getContext()) {
tiledb_filter_list <- function(filters = c(), ctx = tiledb_get_context()) {
if (!is(ctx, "tiledb_ctx")) {
stop("argument ctx must be a tiledb_ctx")
}
Expand Down
161 changes: 161 additions & 0 deletions R/Metadata.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,161 @@

.isArray <- function(arr) is(arr, "tiledb_sparse") || is(arr, "tiledb_dense")
.assertArray <- function(arr) stopifnot(is(arr, "tiledb_sparse") || is(arr, "tiledb_dense"))

##' Test if TileDB Array has Metadata
##'
##' @param arr A TileDB Array object, or a character URI describing one
##' @param key A character value describing a metadata key
##' @return A logical value indicating if the given key exists in the
##' metdata of the given array
##' @export
tiledb_has_metadata <- function(arr, key) {
if (is.character(arr)) {
return(has_metadata_simple(arr, key))
} else if (!.isArray(arr)) {
message("Neither (text) URI nor Array.")
return(NULL)
}

## Now deal with (default) case of an array object
## Check for 'is it open' ?
if (!libtiledb_array_is_open_for_reading(arr@ptr)) {
stop("Array is not open for reading, cannot access metadata.", call.=FALSE)
}

## Run query
return(has_metadata_ptr(arr@ptr, key))
}

##' Return count of TileDB Array Metadata objects
##'
##' @param arr A TileDB Array object, or a character URI describing one
##' @return A integer variable with the number of Metadata objects
##' @export
tiledb_num_metadata <- function(arr) {
if (is.character(arr)) {
return(num_metadata_simple(arr))
} else if (!.isArray(arr)) {
message("Neither (text) URI nor Array.")
return(NULL)
}

## Now deal with (default) case of an array object
## Check for 'is it open' ?
if (!libtiledb_array_is_open_for_reading(arr@ptr)) {
stop("Array is not open for reading, cannot access metadata.", call.=FALSE)
}

## Run query
return(num_metadata_ptr(arr@ptr))
}

##' Return a TileDB Array Metadata object given by key
##'
##' @param arr A TileDB Array object, or a character URI describing one
##' @param key A character value describing a metadata key
##' @return A object stored in the Metadata under the given key
##' @export
tiledb_get_metadata <- function(arr, key) {
if (is.character(arr)) {
return(get_metadata_simple(arr, key))
} else if (!.isArray(arr)) {
message("Neither (text) URI nor Array.")
return(NULL)
}

## Now deal with (default) case of an array object
## Check for 'is it open' ?
if (!libtiledb_array_is_open_for_reading(arr@ptr)) {
stop("Array is not open for reading, cannot access metadata.", call.=FALSE)
}

## Run query
return(get_metadata_ptr(arr@ptr, key))
}

##' Store an object in TileDB Array Metadata under given key
##'
##' @param arr A TileDB Array object, or a character URI describing one
##' @param key A character value describing a metadata key
##' @param val An object to be store
##' @return A boolean value indicating success
##' @export
tiledb_put_metadata <- function(arr, key, val) {
if (is.character(arr)) {
return(put_metadata_simple(arr, key, val))
} else if (!.isArray(arr)) {
message("Neither (text) URI nor Array.")
return(NULL)
}

## Now deal with (default) case of an array object
## Check for 'is it open' ?
if (!libtiledb_array_is_open_for_writing(arr@ptr)) {
stop("Array is not open for writing, cannot access metadata.", call.=FALSE)
}

## Run query
return(put_metadata_ptr(arr@ptr, key, val))
}


##' Return a TileDB Array Metadata object given by key
##'
##' @param arr A TileDB Array object, or a character URI describing one
##' @return A object stored in the Metadata under the given key
##' @export
tiledb_get_all_metadata <- function(arr) {
if (is.character(arr)) {
res <- get_all_metadata_simple(arr)
class(res) <- "tiledb_metadata"
return(res)
} else if (!.isArray(arr)) {
message("Neither (text) URI nor Array.")
return(NULL)
}

## Now deal with (default) case of an array object
## Check for 'is it open' ?
if (!libtiledb_array_is_open_for_reading(arr@ptr)) {
stop("Array is not open for reading, cannot access metadata.", call.=FALSE)
}

## Run query
res <- get_all_metadata_ptr(arr@ptr)
class(res) <- "tiledb_metadata"
return(res)
}

##' @export
print.tiledb_metadata <- function(x, width=NULL, ...) {
nm <- names(x)
for (i in 1:length(nm)) {
cat(nm[i], ":\t", format(x[i]), "\n", sep="")
}
invisible(x)
}

##' Delete a TileDB Array Metadata object given by key
##'
##' @param arr A TileDB Array object, or a character URI describing one
##' @param key A character value describing a metadata key
##' @return A boolean indicating success
##' @export
tiledb_delete_metadata <- function(arr, key) {
if (is.character(arr)) {
return(delete_metadata_simple(arr, key))
} else if (!.isArray(arr)) {
message("Neither (text) URI nor Array.")
return(NULL)
}

## Now deal with (default) case of an array object
## Check for 'is it open' ?
if (!libtiledb_array_is_open_for_writing(arr@ptr)) {
stop("Array is not open for writing, cannot access metadata.", call.=FALSE)
}

## Run query
return(delete_metadata_ptr(arr@ptr, key))
}
Loading

0 comments on commit a8d37c7

Please sign in to comment.