Refine query conditions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tiledb
 Type: Package
-Version: 0.14.1
+Version: 0.14.1.1
 Title: Universal Storage Engine for Sparse and Dense Multidimensional Arrays
 Authors@R: c(person("TileDB, Inc.", role = c("aut", "cph")),
  person("Dirk", "Eddelbuettel", email = "dirk@tiledb.com", role = "cre"))

NEWS.md

@@ -2,6 +2,8 @@
 
 ## Improvements
 
+* Support for query conditions has been extended to dense arrays (#447)
+
 ## Bug Fixes
 
 ## Build and Test Systems

R/QueryCondition.R

@@ -67,7 +67,11 @@ tiledb_query_condition_init <- function(attr, value, dtype, op, qc = tiledb_quer
               "Argument 'dtype' must be character" = is.character(dtype),
               "Argument 'op' must be character" = is.character(op))
     op <- match.arg(op, c("LT", "LE", "GT", "GE", "EQ", "NE"))
-    ## maybe check dtype too
+    ## if dtype is INT64 or UINT64 but the class of value does not yet inherit from integer64, cast
+    if (grepl("INT64", dtype) && !inherits(value, "integer64")) {
+        value <- bit64::as.integer64(value)
+        #message("QCI ", attr, ", ", value, ", ", class(value)[1], ", ", dtype, ", ", op)
+    }
     libtiledb_query_condition_init(qc@ptr, attr, value, dtype, op)
     qc@init <- TRUE
     invisible(qc)
@@ -106,9 +110,20 @@ tiledb_query_condition_combine <- function(lhs, rhs, op) {
 #' to 'FALSE'.
 #' @param strict A boolean toogle to, if set, errors if a non-existing attribute is selected
 #' or filtered on, defaults to 'TRUE'; if 'FALSE' a warning is shown by execution proceeds.
+#' @param use_int64 A boolean toggle to switch to \code{integer64} if \code{integer} is seen,
+#' default is false to remain as a default four-byte \code{int}
 #' @return A `tiledb_query_condition` object
+#' @examples
+#' \dontshow{ctx <- tiledb_ctx(limitTileDBCores())}
+#' \dontrun{
+#' uri <- "mem://airquality"    # change to on-disk for persistence
+#' fromDataFrame(airquality, uri, col_index=c("Month", "Day"))  # dense array
+#' ## query condition on dense array requires extended=FALSE
+#' tiledb_array(uri, return_as="data.frame", extended=FALSE,
+#'              query_condition=parse_query_condition(Temp > 90))[]
+#' }
 #' @export
-parse_query_condition <- function(expr, ta=NULL, debug=FALSE, strict=TRUE) {
+parse_query_condition <- function(expr, ta=NULL, debug=FALSE, strict=TRUE, use_int64=FALSE) {
     .hasArray <- !is.null(ta) && is(ta, "tiledb_array")
     if (.hasArray && length(ta@sil) == 0) ta@sil <- .fill_schema_info_list(ta@uri)
     .isComparisonOperator <- function(x) as.character(x) %in% c(">", ">=", "<", "<=", "==", "!=")
@@ -117,8 +132,8 @@ parse_query_condition <- function(expr, ta=NULL, debug=FALSE, strict=TRUE) {
     .isInteger <- function(x) grepl("^[[:digit:]]+$", as.character(x))
     .isDouble <- function(x) grepl("^[[:digit:]\\.]+$", as.character(x)) && length(grepRaw(".", as.character(x), fixed = TRUE, all = TRUE)) == 1
     .errorFunction <- if (strict) stop else warning
-    .getType <- function(x) {
-        if (isTRUE(.isInteger(x))) "INT32"
+    .getType <- function(x, use_int64=FALSE) {
+        if (isTRUE(.isInteger(x))) { if (use_int64) "INT64" else "INT32" }
         else if (isTRUE(.isDouble(x))) "FLOAT64"
         else "ASCII"
     }
@@ -150,7 +165,7 @@ parse_query_condition <- function(expr, ta=NULL, debug=FALSE, strict=TRUE) {
             op <- as.character(x[1])
             attr <- as.character(x[2])
             ch <- as.character(x[3])
-            dtype <- .getType(ch)
+            dtype <- .getType(ch, use_int64)
             if (.hasArray) {
                 ind <- match(attr, ta@sil$names)
                 if (!is.finite(ind)) {

R/TileDBArray.R

@@ -653,9 +653,9 @@ setMethod("[", "tiledb_array",
     if (is.null(x@selected_ranges[[k]])) {
       #cat("Adding null dim", k, "on", dimtypes[k], "\n")
       vec <- .map2integer64(nonemptydom[[k]], dimtypes[k])
-      if (vec[1] != 0 && vec[2] != 0) { # corner case of A[] on empty array
-          qryptr <- libtiledb_query_add_range_with_type(qryptr, k-1, dimtypes[k], vec[1], vec[2])
-          rangeunset <- FALSE
+      if (vec[1] != 0 || vec[2] != 0) { # corner case of A[] on empty array
+        qryptr <- libtiledb_query_add_range_with_type(qryptr, k-1, dimtypes[k], vec[1], vec[2])
+        rangeunset <- FALSE
       }
     } else if (is.null(nrow(x@selected_ranges[[k]]))) {
       #cat("Adding nrow null dim", k, "on", dimtypes[k], "\n")

inst/examples/quickstart_dense_memfs.R

@@ -5,7 +5,7 @@
 #
 # The MIT License
 #
-# Copyright (c) 2018-2021 TileDB, Inc.
+# Copyright (c) 2018-2022 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
@@ -80,10 +80,9 @@ write_array_via_query <- function(uri) {
 }
 
 write_array_via_query_piped <- function(uri) {
-    stopifnot(requireNamespace("magrittr", quietly=TRUE))
-    library(magrittr)
     data <- 1:16
-    qry <- tiledb_array(uri = uri, "WRITE")
+    arr <- tiledb_array(uri = uri)
+    qry <- tiledb_query(arr, "WRITE")
     qry |>
         tiledb_query_set_layout("ROW_MAJOR") |>  # also default, transpose if COL_MAJOR
         tiledb_query_set_buffer("a", data) |>

inst/tinytest/test_querycondition.R

@@ -345,3 +345,10 @@ for (col in c("int8", "uint8", "int16", "uint16", "int32", "uint32",
     arr <- tiledb_array(tmp, return_as="data.frame", query_condition = qc)
     expect_equal( NROW(arr[]), 10)      # ten rows if we restrict to 'value' > 10
 }
+
+## test on dense array (without dims) and query condition
+uri <- tempfile()
+fromDataFrame(airquality, uri, col_index=c("Month", "Day"))  # dense array
+res <- tiledb_array(uri, return_as="data.frame", extended=FALSE,
+                    query_condition=parse_query_condition(Temp > 90))[]
+expect_equal(NROW(res), 14)