Adapt schema-print for notebook use

TileDB-Inc · Jan 7, 2022 · 3acd0b8 · 3acd0b8
1 parent 6dde272
commit 3acd0b8
Show file tree

Hide file tree

Showing 7 changed files with 119 additions and 6 deletions.
diff --git a/R/ArraySchema.R b/R/ArraySchema.R
@@ -145,7 +145,35 @@ tiledb_array_schema.from_array <- function(x, ctx = tiledb_get_context()) {
 #' @export
 setMethod("show", signature(object = "tiledb_array_schema"),
           function(object) {
-            libtiledb_array_schema_dump(object@ptr)
+            cat("- Array type:", if (is.sparse(sch)) "sparse" else "dense", "\n")
+            cat("- Cell order:", cell_order(sch), "\n")
+            cat("- Tile order:", tile_order(sch), "\n")
+            cat("- Capacity:", capacity(sch), "\n")
+            if (is.sparse(sch)) {
+              cat("- Allows duplicates:", allows_dups(sch), "\n")
+            } else {
+              cat("- Allows duplicates:", FALSE, "\n")
+            }
+
+            fl <- filter_list(sch)
+
+            flc <- fl$coords
+            cat("- Coordinates filters:", nfilters(flc), "\n")
+            show(flc)
+
+            flo <- fl$offsets
+            cat("- Offsets filters:", nfilters(flo), "\n")
+            show(flo)
+
+            # Validity filters are not currently exposed in either the Python or R API
+
+            show(domain(object))
+
+            nattr <- length(attrs(sch))
+            for (i in 1:nattr) {
+              cat("\n")
+              show(attrs(sch, i))
+            }
           })
 
 #' @rdname generics

diff --git a/R/Attribute.R b/R/Attribute.R
@@ -75,7 +75,15 @@ tiledb_attr <- function(name,
 #' @export
 setMethod("show", "tiledb_attr",
           function(object) {
-            libtiledb_attribute_dump(object@ptr)
+            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")
+            show(filter_list(object))
+            # TODO: prints as NA but core says -2147483648
+            cat("- Fill value: ")
+            try(cat(tiledb_attribute_get_fill_value(object), "\n"))
           })
 
 

diff --git a/R/Dim.R b/R/Dim.R
@@ -93,6 +93,34 @@ 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"),
+          function(object) {
+            cat("### Dimension ###\n")
+            cat("- Name:", name(object), "\n")
+            cat("- Type:", datatype(object), "\n")
+
+            cat("- Cell val num: ")
+            try( cat(tiledb:::libtiledb_dim_get_cell_val_num(object@ptr), "\n") )
+
+            cell_val_num <- tiledb:::libtiledb_dim_get_cell_val_num(object@ptr)
+            cat("- Domain: ")
+            cat(ifelse(is.na(cell_val_num), "(null)", domain(object)), "\n")
+
+            cat("- Tile extent: ")
+            cat(ifelse(is.na(cell_val_num), "(null)", tile(object)), "\n")
+
+            show(filter_list(object))
+
+            cat("- Cell val num: ")
+            try( cat(tiledb:::libtiledb_dim_get_cell_val_num(object@ptr), "\n") )
+
+            show(filter_list(object))
+          })
+
 #' Return the `tiledb_dim` name
 #'
 #' @param object `tiledb_dim` object

diff --git a/R/Domain.R b/R/Domain.R
@@ -60,13 +60,18 @@ 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))
+            ndim <- tiledb_ndim(object)
+            dims <- dimensions(object)
+            for (i in 1:ndim) {
+              cat("\n")
+              show(dims[[i]])
+            }
           })
 
 #' Returns a list of the tiledb_domain dimension objects

diff --git a/R/Filter.R b/R/Filter.R
@@ -65,6 +65,23 @@ 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"),
+          function(object) {
+            cat("  > ")
+            cat(tiledb_filter_type(object), ": ", sep="")
+            for (option in c("COMPRESSION_LEVEL", "BIT_WIDTH_MAX_WINDOW", "POSITIVE_DELTA_MAX_WINDOW")) {
+              tryCatch(
+                cat(option, "=", tiledb_filter_get_option(object, option), sep=""),
+                error=function(x){}
+              )
+            }
+            cat("\n")
+          })
+
 #' Returns the type of the filter used
 #'
 #' @param object tiledb_filter

diff --git a/R/FilterList.R b/R/FilterList.R
@@ -63,6 +63,23 @@ 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"),
+          function(object) {
+            nfi <- nfilters(object)
+            # This is necessary to avoid out-of-bounds error on nfi == 0 case.
+            # That's because these are 0-up indexed (unusually for R), and 1:0 is
+            # the two-element sequence (1,0).
+            if (nfi > 0) {
+              for (i in 1:nfi) {
+                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"))

diff --git a/src/libtiledb.cpp b/src/libtiledb.cpp
@@ -985,7 +985,7 @@ SEXP libtiledb_dim_get_tile_extent(XPtr<tiledb::Dimension> dim) {
       return IntegerVector({static_cast<int32_t>(t),});
     }
     default:
-      Rcpp::stop("invalid tiledb_dim domain type");
+      Rcpp::stop("invalid tiledb_dim domain type (%d)", dim_type);
   }
 }
 
@@ -1298,6 +1298,9 @@ XPtr<tiledb::Attribute> libtiledb_attribute(XPtr<tiledb::Context> ctx,
     if (attr_dtype == TILEDB_INT32) {
         using DType = tiledb::impl::tiledb_to_type<TILEDB_INT32>::type;
         attr = XPtr<tiledb::Attribute>(new tiledb::Attribute(tiledb::Attribute::create<DType>(*ctx.get(), name)), false);
+    } else if (attr_dtype == TILEDB_UINT32) {
+        using DType = tiledb::impl::tiledb_to_type<TILEDB_UINT32>::type;
+        attr = XPtr<tiledb::Attribute>(new tiledb::Attribute(tiledb::Attribute::create<DType>(*ctx.get(), name)), false);
     } else if (attr_dtype == TILEDB_FLOAT64) {
         using DType = tiledb::impl::tiledb_to_type<TILEDB_FLOAT64>::type;
         attr = XPtr<tiledb::Attribute>(new tiledb::Attribute(tiledb::Attribute::create<DType>(*ctx.get(), name)), false);
@@ -1423,6 +1426,10 @@ void libtiledb_attribute_set_fill_value(XPtr<tiledb::Attribute> attr, SEXP val)
     IntegerVector v(val);
     if (v.size() > 1) Rcpp::stop("Setting fill values only supports scalar values for now.");
     attr->set_fill_value((void*) &(v[0]), static_cast<uint64_t>(sizeof(int32_t)));
+  } else if (dtype == TILEDB_UINT32) {
+    IntegerVector v(val);
+    if (v.size() > 1) Rcpp::stop("Setting fill values only supports scalar values for now.");
+    attr->set_fill_value((void*) &(v[0]), static_cast<uint64_t>(sizeof(uint32_t)));
   } else if (dtype == TILEDB_FLOAT64) {
     NumericVector v(val);
     if (v.size() > 1) Rcpp::stop("Setting fill values only supports scalar values for now.");
@@ -1451,6 +1458,9 @@ SEXP libtiledb_attribute_get_fill_value(XPtr<tiledb::Attribute> attr) {
   if (dtype == TILEDB_INT32) {
     int32_t v = *(const int32_t*)valptr;
     return wrap(v);
+  } else if (dtype == TILEDB_UINT32) {
+    uint32_t v = *(const uint32_t*)valptr;
+    return wrap(v);
   } else if (dtype == TILEDB_FLOAT64) {
     double v = *(const double*)valptr;
     return wrap(v);