Merge pull request #342 from TileDB-Inc/kerl/sc-12282-array-schema-show

Adapt schema-print for notebook use

R/ArraySchema.R

@@ -144,9 +144,26 @@ tiledb_array_schema.from_array <- function(x, ctx = tiledb_get_context()) {
 #' @param object An array_schema object
 #' @export
 setMethod("show", signature(object = "tiledb_array_schema"),
-          function(object) {
-            libtiledb_array_schema_dump(object@ptr)
-          })
+          definition = function(object) {
+    cat("- Array type:", if (is.sparse(object)) "sparse" else "dense", "\n")
+    cat("- Cell order:", cell_order(object), "\n")
+    cat("- Tile order:", tile_order(object), "\n")
+    cat("- Capacity:", capacity(object), "\n")
+    cat("- Allows duplicates:", if (is.sparse(object)) allows_dups(object) else FALSE, "\n")
+
+    fl <- filter_list(object)
+    cat("- Coordinates filters:", nfilters(fl$coords), "\n")
+    show(fl$coords)
+    cat("- Offsets filters:", nfilters(fl$offsets), "\n")
+    show(fl$offsets)
+    ## Validity filters are not currently exposed in either the Python or R API
+    cat("\n")
+
+    show(domain(object))
+
+    ## attrs() returns a list, could make it proper tiledb_* object with its show() method
+    sapply(attrs(object), show)
+})
 
 #' @rdname generics
 #' @export

R/Attribute.R

@@ -73,10 +73,22 @@ tiledb_attr <- function(name,
 #'
 #' @param object An attribute object
 #' @export
-setMethod("show", "tiledb_attr",
-          function(object) {
-            libtiledb_attribute_dump(object@ptr)
-          })
+setMethod("show", signature(object = "tiledb_attr"),
+          definition = function(object) {
+    cat("### Attribute ###\n")
+    cat("- Name:", name(object), "\n")
+    cat("- Type:", datatype(object), "\n")
+    cat("- Nullable:", tiledb_attribute_get_nullable(object), "\n")
+    cat("- Cell val num:", cell_val_num(object), "\n")
+    fl <- filter_list(object)
+    cat("- Filters: ", nfilters(fl), "\n", sep="")
+    show(fl)
+    ## NB: prints NA whereas core shows -2147483648 as core does not know about R's NA
+    cat("- Fill value: ",
+        if (tiledb_attribute_get_nullable(object)) ""
+        else format(tiledb_attribute_get_fill_value(object)), "\n")
+    cat("\n")
+})
 
 
 #' @rdname generics

R/Dim.R

@@ -93,6 +93,26 @@ tiledb_dim <- function(name, domain, tile, type, ctx = tiledb_get_context()) {
   return(new("tiledb_dim", ptr = ptr))
 }
 
+#' Prints a dimension object
+#'
+#' @param object An array_schema object
+#' @export
+setMethod("show", signature(object = "tiledb_dim"),
+          definition = function(object) {
+    cat("### Dimension ###\n")
+    cat("- Name:", name(object), "\n")
+    cat("- Type:", datatype(object), "\n")
+    cells <- cell_val_num(object)
+    cat("- Cell val num:", cells, "\n")
+    cat("- Domain:", if (is.na(cells)) "(null,null)"
+                     else paste0("[", paste0(domain(object), collapse=","), "]"), "\n")
+    cat("- Tile extent:", if (is.na(cells)) "(null)" else dim(object), "\n")
+    fl <- filter_list(object)
+    cat("- Filters: ", nfilters(fl), "\n", sep="")
+    show(fl)
+    cat("\n")
+})
+
 #' Return the `tiledb_dim` name
 #'
 #' @param object `tiledb_dim` object

R/Domain.R

@@ -60,14 +60,14 @@ tiledb_domain <- function(dims, ctx = tiledb_get_context()) {
   return(new("tiledb_domain", ptr = ptr))
 }
 
-#' Prints an domain object
+#' Prints a domain object
 #'
-#' @param object An domain object
+#' @param object A domain object
 #' @export
 setMethod("show", "tiledb_domain",
-          function(object) {
-            return(libtiledb_domain_dump(object@ptr))
-          })
+          definition = function(object) {
+    sapply(dimensions(object), show)
+})
 
 #' Returns a list of the tiledb_domain dimension objects
 #'

R/Filter.R

@@ -65,6 +65,27 @@ tiledb_filter <- function(name = "NONE", ctx = tiledb_get_context()) {
   return(new("tiledb_filter", ptr = ptr))
 }
 
+#' Prints a filter object
+#'
+#' @param object A filter object
+#' @export
+setMethod("show", signature(object = "tiledb_filter"),
+          definition = function(object) {
+    flt <- tiledb_filter_type(object)
+    .getAndShow <- function(obj, arg) cat(paste0(arg, "=", tiledb_filter_get_option(obj, arg)))
+    cat("  > ", flt, ": ", sep="")
+    if (flt %in% c("GZIP", "ZSTD", "LZ4", "BZIP2")) {
+        .getAndShow(object, "COMPRESSION_LEVEL")
+    } else if (flt %in% "BIT_WIDTH_REDUCTION") {
+        .getAndShow(object, "BIT_WIDTH_MAX_WINDOW")
+    } else if (flt %in% "POSITIVE_DELTA") {
+        .getAndShow(object, "POSITIVE_DELTA_MAX_WINDOW")
+    } else {
+        cat("NA")
+    }
+    cat("\n")
+})
+
 #' Returns the type of the filter used
 #'
 #' @param object tiledb_filter

R/FilterList.R

@@ -63,6 +63,16 @@ tiledb_filter_list <- function(filters = c(), ctx = tiledb_get_context()) {
   return(new("tiledb_filter_list", ptr = ptr))
 }
 
+#' Prints a filter_list object
+#'
+#' @param object A filter_list object
+#' @export
+setMethod("show", signature(object = "tiledb_filter_list"),
+          definition = function(object) {
+    ## This is necessary as these are 0-up indexed (unusually for R, a leftover from older code here)
+    sapply(seq_len(nfilters(object)), function(i) show(object[i-1]))
+})
+
 #' @rdname tiledb_filter_list_set_max_chunk_size
 #' @export
 setGeneric("set_max_chunk_size", function(object, value) standardGeneric("set_max_chunk_size"))

inst/tinytest/test_attr.R

@@ -93,10 +93,10 @@ sch <- tiledb_array_schema(dom, attr)
 uri <- tempfile()
 if (dir.exists(uri)) unlink(uri, recursive=TRUE)
 tiledb_array_create(uri, sch)
-arr <- tiledb_dense(uri)
-val <- arr[]
+arr <- tiledb_array(uri, return_as="asis", extended=FALSE)
+val <- arr[1:4][[1]]
 ## when fill value has been set, expect value
-expect_equal(val, array(rep(42, 4)))
+expect_equal(val, rep(42, 4))
 expect_equal(tiledb_attribute_get_fill_value(attr), 42)
 
 attr <- tiledb_attr("b", type = "CHAR", ncells = NA)