From 8e10cbe53d6a3fec93d1e9c7b258b3a8f762f606 Mon Sep 17 00:00:00 2001 From: John Kerl Date: Fri, 7 Jan 2022 11:07:17 -0500 Subject: [PATCH 01/13] Adapt schema-print for notebook use --- R/ArraySchema.R | 30 +++++++++++++++++++++++++++++- R/Attribute.R | 10 +++++++++- R/Dim.R | 28 ++++++++++++++++++++++++++++ R/Domain.R | 11 ++++++++--- R/Filter.R | 17 +++++++++++++++++ R/FilterList.R | 17 +++++++++++++++++ 6 files changed, 108 insertions(+), 5 deletions(-) diff --git a/R/ArraySchema.R b/R/ArraySchema.R index 42ac319a15..3f57e63ee9 100644 --- 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 index caef8c75ea..2a04eafa63 100644 --- 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 index acbbcf474d..9577341865 100644 --- 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 index 2063c819cf..e0e1c68744 100644 --- 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 index d761d8bf65..8bb1b88216 100644 --- 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 index 386f48b489..e505723be4 100644 --- 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")) From 14ec424cc01b24169b999b4ab7d9a20883c1198a Mon Sep 17 00:00:00 2001 From: John Kerl Date: Fri, 7 Jan 2022 11:15:00 -0500 Subject: [PATCH 02/13] rebase 341 in --- R/Dim.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/Dim.R b/R/Dim.R index 9577341865..2e8adde495 100644 --- a/R/Dim.R +++ b/R/Dim.R @@ -103,10 +103,9 @@ setMethod("show", signature(object = "tiledb_dim"), 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_dim_get_cell_val_num(object) + cat("- Cell val num: ", cell_val_num, "\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") From 1a4f60093ae05f218e5a551cb517e1ad0a395d7e Mon Sep 17 00:00:00 2001 From: John Kerl Date: Fri, 7 Jan 2022 11:17:54 -0500 Subject: [PATCH 03/13] roxygenise --- man/show-tiledb_dim-method.Rd | 14 ++++++++++++++ man/show-tiledb_domain-method.Rd | 6 +++--- man/show-tiledb_filter-method.Rd | 14 ++++++++++++++ man/show-tiledb_filter_list-method.Rd | 14 ++++++++++++++ 4 files changed, 45 insertions(+), 3 deletions(-) create mode 100644 man/show-tiledb_dim-method.Rd create mode 100644 man/show-tiledb_filter-method.Rd create mode 100644 man/show-tiledb_filter_list-method.Rd diff --git a/man/show-tiledb_dim-method.Rd b/man/show-tiledb_dim-method.Rd new file mode 100644 index 0000000000..23cefbda66 --- /dev/null +++ b/man/show-tiledb_dim-method.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Dim.R +\name{show,tiledb_dim-method} +\alias{show,tiledb_dim-method} +\title{Prints a dimension object} +\usage{ +\S4method{show}{tiledb_dim}(object) +} +\arguments{ +\item{object}{An array_schema object} +} +\description{ +Prints a dimension object +} diff --git a/man/show-tiledb_domain-method.Rd b/man/show-tiledb_domain-method.Rd index ebe6dec53f..70765fcb66 100644 --- a/man/show-tiledb_domain-method.Rd +++ b/man/show-tiledb_domain-method.Rd @@ -2,13 +2,13 @@ % Please edit documentation in R/Domain.R \name{show,tiledb_domain-method} \alias{show,tiledb_domain-method} -\title{Prints an domain object} +\title{Prints a domain object} \usage{ \S4method{show}{tiledb_domain}(object) } \arguments{ -\item{object}{An domain object} +\item{object}{A domain object} } \description{ -Prints an domain object +Prints a domain object } diff --git a/man/show-tiledb_filter-method.Rd b/man/show-tiledb_filter-method.Rd new file mode 100644 index 0000000000..34f03dc5dd --- /dev/null +++ b/man/show-tiledb_filter-method.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Filter.R +\name{show,tiledb_filter-method} +\alias{show,tiledb_filter-method} +\title{Prints a filter object} +\usage{ +\S4method{show}{tiledb_filter}(object) +} +\arguments{ +\item{object}{A filter object} +} +\description{ +Prints a filter object +} diff --git a/man/show-tiledb_filter_list-method.Rd b/man/show-tiledb_filter_list-method.Rd new file mode 100644 index 0000000000..77fd771056 --- /dev/null +++ b/man/show-tiledb_filter_list-method.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/FilterList.R +\name{show,tiledb_filter_list-method} +\alias{show,tiledb_filter_list-method} +\title{Prints a filter_list object} +\usage{ +\S4method{show}{tiledb_filter_list}(object) +} +\arguments{ +\item{object}{A filter_list object} +} +\description{ +Prints a filter_list object +} From b9664df6b989b2a8701b830a0f9e53fac1c38f33 Mon Sep 17 00:00:00 2001 From: John Kerl Date: Fri, 7 Jan 2022 11:34:05 -0500 Subject: [PATCH 04/13] fix typo sch -> object --- R/ArraySchema.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/ArraySchema.R b/R/ArraySchema.R index 3f57e63ee9..cd8af056f5 100644 --- a/R/ArraySchema.R +++ b/R/ArraySchema.R @@ -145,17 +145,17 @@ tiledb_array_schema.from_array <- function(x, ctx = tiledb_get_context()) { #' @export setMethod("show", signature(object = "tiledb_array_schema"), function(object) { - 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") + 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") + if (is.sparse(object)) { + cat("- Allows duplicates:", allows_dups(object), "\n") } else { cat("- Allows duplicates:", FALSE, "\n") } - fl <- filter_list(sch) + fl <- filter_list(object) flc <- fl$coords cat("- Coordinates filters:", nfilters(flc), "\n") @@ -169,10 +169,10 @@ setMethod("show", signature(object = "tiledb_array_schema"), show(domain(object)) - nattr <- length(attrs(sch)) + nattr <- length(attrs(object)) for (i in 1:nattr) { cat("\n") - show(attrs(sch, i)) + show(attrs(object, i)) } }) From ae3aa3a6f0e75a43e67cb2514fa704574f6c19a1 Mon Sep 17 00:00:00 2001 From: John Kerl Date: Fri, 7 Jan 2022 14:27:32 -0500 Subject: [PATCH 05/13] Proofreading against core schema-printer --- R/Attribute.R | 4 +++- R/Dim.R | 24 ++++++++++++++++-------- src/libtiledb.cpp | 12 ++++++------ 3 files changed, 25 insertions(+), 15 deletions(-) diff --git a/R/Attribute.R b/R/Attribute.R index 2a04eafa63..e5fd24ad78 100644 --- a/R/Attribute.R +++ b/R/Attribute.R @@ -80,7 +80,9 @@ setMethod("show", "tiledb_attr", 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)) + fl <- filter_list(object) + cat("- Filters: ", nfilters(fl), "\n", sep="") + show(fl) # 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 index 2e8adde495..184e76a25e 100644 --- a/R/Dim.R +++ b/R/Dim.R @@ -106,18 +106,26 @@ setMethod("show", signature(object = "tiledb_dim"), cell_val_num <- tiledb_dim_get_cell_val_num(object) cat("- Cell val num: ", cell_val_num, "\n") + # Example output: "1 4". If we do + # cat(ifelse(is.na(cell_val_num), "(null)", domain(object)), "\n") + # then only the "1" prints. cat("- Domain: ") - cat(ifelse(is.na(cell_val_num), "(null)", domain(object)), "\n") + if (is.na(cell_val_num)) { + cat("(null)\n") + } else { + cat(domain(object), "\n", sep="") + } cat("- Tile extent: ") - cat(ifelse(is.na(cell_val_num), "(null)", tile(object)), "\n") + if (is.na(cell_val_num)) { + cat("(null)\n") + } else { + cat(tile(object), "\n", sep="") + } - show(filter_list(object)) - - cat("- Cell val num: ") - try( cat(tiledb:::libtiledb_dim_get_cell_val_num(object@ptr), "\n") ) - - show(filter_list(object)) + fl <- filter_list(object) + cat("- Filters: ", nfilters(fl), "\n", sep="") + show(fl) }) #' Return the `tiledb_dim` name diff --git a/src/libtiledb.cpp b/src/libtiledb.cpp index 4ce18a592d..7831cb5369 100644 --- a/src/libtiledb.cpp +++ b/src/libtiledb.cpp @@ -4183,13 +4183,13 @@ void libtiledb_fragment_info_dump(XPtr fi) { #endif } -// [[Rcpp::export]] +//// [[Rcpp::export]] std::string libtiledb_error_message(XPtr ctx) { -#if TILEDB_VERSION >= TileDB_Version(2,5,0) - tiledb::Error error(*ctx.get()); - std::string txt(error.error_message()); -#else +//#if TILEDB_VERSION >= TileDB_Version(2,5,0) +// tiledb::Error error(*ctx.get()); +// std::string txt(error.error_message()); +//#else std::string txt("This function requires TileDB 2.5.0 or later."); -#endif +//#endif return txt; } From dc073b477d6ad04e327e28ac9341a795804877ea Mon Sep 17 00:00:00 2001 From: John Kerl Date: Fri, 7 Jan 2022 15:50:28 -0500 Subject: [PATCH 06/13] rebase in #343 --- src/libtiledb.cpp | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/libtiledb.cpp b/src/libtiledb.cpp index 7831cb5369..4ce18a592d 100644 --- a/src/libtiledb.cpp +++ b/src/libtiledb.cpp @@ -4183,13 +4183,13 @@ void libtiledb_fragment_info_dump(XPtr fi) { #endif } -//// [[Rcpp::export]] +// [[Rcpp::export]] std::string libtiledb_error_message(XPtr ctx) { -//#if TILEDB_VERSION >= TileDB_Version(2,5,0) -// tiledb::Error error(*ctx.get()); -// std::string txt(error.error_message()); -//#else +#if TILEDB_VERSION >= TileDB_Version(2,5,0) + tiledb::Error error(*ctx.get()); + std::string txt(error.error_message()); +#else std::string txt("This function requires TileDB 2.5.0 or later."); -//#endif +#endif return txt; } From 745abe3d27fcad95cdba429b7e2c1db751cba45f Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 08:10:24 -0600 Subject: [PATCH 07/13] array_schema show method --- R/ArraySchema.R | 50 +++++++++++++++++++------------------------------ 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/R/ArraySchema.R b/R/ArraySchema.R index cd8af056f5..61a16b87ff 100644 --- a/R/ArraySchema.R +++ b/R/ArraySchema.R @@ -144,37 +144,25 @@ 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) { - 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") - if (is.sparse(object)) { - cat("- Allows duplicates:", allows_dups(object), "\n") - } else { - cat("- Allows duplicates:", FALSE, "\n") - } - - fl <- filter_list(object) - - 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(object)) - for (i in 1:nattr) { - cat("\n") - show(attrs(object, i)) - } - }) + 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 + + show(domain(object)) + + ## attrs() returns a list, could make it proper tiledb_* object with its show() method + sapply(seq_along(attrs(object)), function(i) { cat("\n"); show(attrs(object, i)) } ) +}) #' @rdname generics #' @export From a5d1b741e3055d9d43dc8590355dc2b54505eb5b Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 08:18:36 -0600 Subject: [PATCH 08/13] attr show method --- R/Attribute.R | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/R/Attribute.R b/R/Attribute.R index e5fd24ad78..ce3b63dbfd 100644 --- a/R/Attribute.R +++ b/R/Attribute.R @@ -73,20 +73,21 @@ tiledb_attr <- function(name, #' #' @param object An attribute object #' @export -setMethod("show", "tiledb_attr", - 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) - # TODO: prints as NA but core says -2147483648 - cat("- Fill value: ") - try(cat(tiledb_attribute_get_fill_value(object), "\n")) - }) +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") +}) #' @rdname generics From 3c702b002b4d80832f108879f6769798f1dfb765 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 09:00:01 -0600 Subject: [PATCH 09/13] dimemsion show method --- R/Dim.R | 42 +++++++++++++----------------------------- 1 file changed, 13 insertions(+), 29 deletions(-) diff --git a/R/Dim.R b/R/Dim.R index 184e76a25e..7987083e46 100644 --- a/R/Dim.R +++ b/R/Dim.R @@ -98,35 +98,19 @@ tiledb_dim <- function(name, domain, tile, type, ctx = tiledb_get_context()) { #' @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") - - cell_val_num <- tiledb_dim_get_cell_val_num(object) - cat("- Cell val num: ", cell_val_num, "\n") - - # Example output: "1 4". If we do - # cat(ifelse(is.na(cell_val_num), "(null)", domain(object)), "\n") - # then only the "1" prints. - cat("- Domain: ") - if (is.na(cell_val_num)) { - cat("(null)\n") - } else { - cat(domain(object), "\n", sep="") - } - - cat("- Tile extent: ") - if (is.na(cell_val_num)) { - cat("(null)\n") - } else { - cat(tile(object), "\n", sep="") - } - - fl <- filter_list(object) - cat("- Filters: ", nfilters(fl), "\n", sep="") - show(fl) - }) + 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) +}) #' Return the `tiledb_dim` name #' From 99e039bcf6f8a6064e0586b2c2c18b4ea81d7f73 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 09:21:15 -0600 Subject: [PATCH 10/13] domain show method, plus some linebreak improvements --- R/ArraySchema.R | 3 ++- R/Attribute.R | 1 + R/Dim.R | 1 + R/Domain.R | 11 +++-------- 4 files changed, 7 insertions(+), 9 deletions(-) diff --git a/R/ArraySchema.R b/R/ArraySchema.R index 61a16b87ff..c6feb1ef03 100644 --- a/R/ArraySchema.R +++ b/R/ArraySchema.R @@ -157,11 +157,12 @@ setMethod("show", signature(object = "tiledb_array_schema"), 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(seq_along(attrs(object)), function(i) { cat("\n"); show(attrs(object, i)) } ) + sapply(attrs(object), show) }) #' @rdname generics diff --git a/R/Attribute.R b/R/Attribute.R index ce3b63dbfd..045349fb08 100644 --- a/R/Attribute.R +++ b/R/Attribute.R @@ -87,6 +87,7 @@ setMethod("show", signature(object = "tiledb_attr"), cat("- Fill value: ", if (tiledb_attribute_get_nullable(object)) "" else format(tiledb_attribute_get_fill_value(object)), "\n") + cat("\n") }) diff --git a/R/Dim.R b/R/Dim.R index 7987083e46..d612a0f4c0 100644 --- a/R/Dim.R +++ b/R/Dim.R @@ -110,6 +110,7 @@ setMethod("show", signature(object = "tiledb_dim"), fl <- filter_list(object) cat("- Filters: ", nfilters(fl), "\n", sep="") show(fl) + cat("\n") }) #' Return the `tiledb_dim` name diff --git a/R/Domain.R b/R/Domain.R index e0e1c68744..be512ad809 100644 --- a/R/Domain.R +++ b/R/Domain.R @@ -65,14 +65,9 @@ tiledb_domain <- function(dims, ctx = tiledb_get_context()) { #' @param object A domain object #' @export setMethod("show", "tiledb_domain", - function(object) { - ndim <- tiledb_ndim(object) - dims <- dimensions(object) - for (i in 1:ndim) { - cat("\n") - show(dims[[i]]) - } - }) + definition = function(object) { + sapply(dimensions(object), show) +}) #' Returns a list of the tiledb_domain dimension objects #' From 1122b307b7c912168e5a0d32fde1a0b0bcdbba37 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 09:35:54 -0600 Subject: [PATCH 11/13] filter show method --- R/Filter.R | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/R/Filter.R b/R/Filter.R index 8bb1b88216..86fa8a7ea6 100644 --- a/R/Filter.R +++ b/R/Filter.R @@ -70,17 +70,21 @@ tiledb_filter <- function(name = "NONE", ctx = tiledb_get_context()) { #' @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") - }) + 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 #' From 00212811f4f11f1f98a0766a833bc993701920f2 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 09:41:57 -0600 Subject: [PATCH 12/13] filterlist show method --- R/FilterList.R | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/R/FilterList.R b/R/FilterList.R index e505723be4..f1a853099c 100644 --- a/R/FilterList.R +++ b/R/FilterList.R @@ -68,17 +68,10 @@ tiledb_filter_list <- function(filters = c(), ctx = tiledb_get_context()) { #' @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]) - } - } - }) + 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 From 0d7adb04ade8bc426fb0b9047f5e57a4264d983b Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Sun, 9 Jan 2022 10:01:42 -0600 Subject: [PATCH 13/13] switch test from deprecated tiledb_dense to tiledb_array --- inst/tinytest/test_attr.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/tinytest/test_attr.R b/inst/tinytest/test_attr.R index 6b54903f43..3025df4611 100644 --- a/inst/tinytest/test_attr.R +++ b/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)