Extend query_object for var char columns

NAMESPACE

@@ -80,14 +80,19 @@ export(tiledb_put_metadata)
 export(tiledb_query)
 export(tiledb_query_add_range)
 export(tiledb_query_add_range_with_type)
+export(tiledb_query_alloc_buffer_ptr_char)
+export(tiledb_query_alloc_buffer_ptr_char_subarray)
 export(tiledb_query_buffer_alloc_ptr)
 export(tiledb_query_create_buffer_ptr)
+export(tiledb_query_create_buffer_ptr_char)
 export(tiledb_query_finalize)
+export(tiledb_query_get_buffer_char)
 export(tiledb_query_get_buffer_ptr)
 export(tiledb_query_get_layout)
 export(tiledb_query_result_buffer_elements)
 export(tiledb_query_set_buffer)
 export(tiledb_query_set_buffer_ptr)
+export(tiledb_query_set_buffer_ptr_char)
 export(tiledb_query_set_layout)
 export(tiledb_query_set_subarray)
 export(tiledb_query_status)

R/Query.R

@@ -114,28 +114,67 @@ tiledb_query_set_buffer <- function(query, attr, buffer) {
   invisible(query)
 }
 
-## TODO var char support
-##
-## There are four function for vlc_buf_t -- variable length char buffer type
-##
-##   XPtr<vlc_buf_t> libtiledb_query_buffer_var_char_alloc_direct(int szoffsets,
-##                                                                int szdata)
-##    - allocates directly for reads given offset and data vector sizes
-##
-##   XPtr<vlc_buf_t> libtiledb_query_buffer_var_char_create(IntegerVector intoffsets,
-##                                                          std::string data)
-##    - creates / allocates for writes from given offsets and data vecroe
-##
-##   XPtr<tiledb::Query> libtiledb_query_set_buffer_var_char(XPtr<tiledb::Query> query,
-##                                                           std::string attr,
-##                                                           XPtr<vlc_buf_t> bufptr)
-##     - sets a buffer to the query
-##
-##   CharacterMatrix libtiledb_query_get_buffer_var_char(XPtr<vlc_buf_t> bufptr,
-##                                                       int32_t len=0, int32_t nchar=0)
-##     - retrieves a query buffer's content as Char matrix
+#' Allocate and populate a Query buffer for writing the given char vector
+#'
+#' @param query A TileDB Query object
+#' @param varvec A vector of strings
+#' @return An external pointer to the allocated buffer object
+#' @export
+tiledb_query_create_buffer_ptr_char <- function(query, varvec) {
+  stopifnot(query_object=is(query, "tiledb_query"),
+            is_vector=is.vector(varvec))
+  n <- length(varvec)
+  offsets <- integer(n)
+  data <- convertStringVectorIntoOffsetsAndString(varvec, offsets)
+  bufptr <- libtiledb_query_buffer_var_char_create(offsets, data)
+  bufptr
+}
 
+#' Allocate a Query buffer for reading a character attribute
+#'
+#' @param sizeoffsets An optional value of the size of the offsets vector
+#' @param sizedata An optional value of the size of the data string
+#' @return An external pointer to the allocated buffer object
+#' @export
+tiledb_query_alloc_buffer_ptr_char <- function(sizeoffsets, sizedata) {
+  bufptr <- libtiledb_query_buffer_var_char_alloc_direct(sizeoffsets, sizedata)
+  bufptr
+}
 
+#' Allocate a Query buffer for reading a character attribute using a subarray
+#'
+#' Note that this uses an API part that may be deprecated in the future.
+#' @param array A TileDB Array object
+#' @param attr A character value containing the attribute
+#' @param subarray A vector of length four describing the subarray required for dense arrays
+#' @param sizeoffsets An optional value of the size of the offsets vector
+#' @param sizedata An optional value of the size of the data string
+#' @return An external pointer to the allocated buffer object
+#' @export
+tiledb_query_alloc_buffer_ptr_char_subarray <- function(array, attr, subarray=NULL,
+                                                        sizeoffsets=0, sizedata=0) {
+  stopifnot(array_ptr=is(array@ptr, "externalptr"),
+            is_vector=is.vector(subarray),
+            attribute_string=is.character(attr))
+  bufptr <- libtiledb_query_buffer_var_char_alloc(array@ptr, subarray, attr, sizeoffsets, sizedata)
+  bufptr
+}
+
+#' Assign a buffer to a Query attribute
+#'
+#' @param query A TileDB Query object
+#' @param attr A character value containing the attribute
+#' @param bufptr An external pointer with a query buffer
+#' @return The modified query object, invisibly
+#' @export
+tiledb_query_set_buffer_ptr_char <- function(query, attr, bufptr) {
+  stopifnot(query_object=is(query, "tiledb_query"),
+            attribute_string=is.character(attr),
+            bufptr=is(bufptr, "externalptr"))
+  libtiledb_query_set_buffer_var_char(query@ptr, attr, bufptr)
+  invisible(query)
+
+}
 
 #' Allocate a Query buffer for a given type
 #'
@@ -151,7 +190,7 @@ tiledb_query_buffer_alloc_ptr <- function(query, datatype, ncells) {
   bufptr <- libtiledb_query_buffer_alloc_ptr(query@ptr, datatype, ncells)
 }
 
-#' Allocate, populate and set a Query buffer for a given object of a given data type.
+#' Allocate and populate a Query buffer for a given object of a given data type.
 #'
 #' This function allocates a query buffer for the given data object of the given
 #' type and assigns the object content to the buffer.
@@ -197,6 +236,20 @@ tiledb_query_get_buffer_ptr <- function(bufptr) {
   libtiledb_query_get_buffer_ptr(bufptr)
 }
 
+#' Retrieve content from a Query character buffer
+#'
+#' This function uses a query buffer for a character attribute
+#' or dimension and returns its content.
+#' @param bufptr An external pointer with a query buffer
+#' @param sizeoffsets An optional argument for the length of the internal offsets vector
+#' @param sizestring An optional argument for the length of the internal string
+#' @return An R object as resulting from the query
+#' @export
+tiledb_query_get_buffer_char <- function(bufptr, sizeoffsets=0, sizestring=0) {
+  stopifnot(bufptr=is(bufptr, "externalptr"))
+  libtiledb_query_get_buffer_var_char(bufptr, sizeoffsets, sizestring)
+}
+
 
 #' Submit TileDB Query
 #'

R/RcppExports.R

@@ -453,6 +453,10 @@ libtiledb_query_buffer_var_char_alloc_direct <- function(szoffsets, szdata) {
     .Call(`_tiledb_libtiledb_query_buffer_var_char_alloc_direct`, szoffsets, szdata)
 }
 
+convertStringVectorIntoOffsetsAndString <- function(vec, offsets) {
+    .Call(`_tiledb_convertStringVectorIntoOffsetsAndString`, vec, offsets)
+}
+
 libtiledb_query_buffer_var_char_create <- function(intoffsets, data) {
     .Call(`_tiledb_libtiledb_query_buffer_var_char_create`, intoffsets, data)
 }

inst/examples/ex_7.R

@@ -45,10 +45,9 @@ write_array <- function(uri) {
   rowbufptr <- tiledb_query_create_buffer_ptr(qry, domrowtype, rows)
   qry <- tiledb_query_set_buffer_ptr(qry, "rows", rowbufptr)
 
-  coldata <- "aabbccccddeeffgghhiijj"
-  coloffsets <- c(0L, 2L, 4L, 8L, 10L, 12L, 14L, 16L, 18L, 20L)
-  colbufptr <- tiledb:::libtiledb_query_buffer_var_char_create(coloffsets, coldata)
-  qry@ptr <- tiledb:::libtiledb_query_set_buffer_var_char(qry@ptr, "cols", colbufptr)
+  cols <- c("aa", "bb", "cc", "dd", "ee", "ff", "gg", "hh", "ii", "jj")
+  colbufptr <- tiledb_query_create_buffer_ptr_char(qry, cols)
+  qry <- tiledb_query_set_buffer_ptr_char(qry, "cols", colbufptr)
 
   a1data <- seq(1:10)
   d1data <- switch(attrowtype,

inst/examples/ex_8.R

@@ -45,10 +45,9 @@ write_thrice_array <- function(uri) {
     rowbufptr <- tiledb_query_create_buffer_ptr(qry, domrowtype, rows)
     qry <- tiledb_query_set_buffer_ptr(qry, "rows", rowbufptr)
 
-    coldata <- "aabbccddeeffgghhiijj"
-    coloffsets <- c(0L, 2L, 4L, 6L, 8L, 10L, 12L, 14L, 16L, 18L)
-    colbufptr <- tiledb:::libtiledb_query_buffer_var_char_create(coloffsets, coldata)
-    qry@ptr <- tiledb:::libtiledb_query_set_buffer_var_char(qry@ptr, "cols", colbufptr)
+    cols <- c("aa", "bb", "cc", "dd", "ee", "ff", "gg", "hh", "ii", "jj")
+    colbufptr <- tiledb_query_create_buffer_ptr_char(qry, cols)
+    query <- tiledb_query_set_buffer_ptr_char(qry, "cols", colbufptr)
 
     a1data <- (i-1)*10 + seq(1:10)
     d1data <- switch(attrowtype,
@@ -73,8 +72,6 @@ read_array <- function(uri) {
   sch <- schema(arr)
   qry <- tiledb_query(arr, "READ")
 
-  arrptr <- arr@ptr
-  qryptr <- qry@ptr
   ## important: we currently cannot retrieve more than nrow
   ## (though this maybe be a constraint we impose)
   #nrow <- 8
@@ -83,8 +80,8 @@ read_array <- function(uri) {
   rowptr <- tiledb_query_buffer_alloc_ptr(qry, domrowtype, nrow)
   qry <- tiledb_query_set_buffer_ptr(qry, "rows", rowptr)
 
-  colptr <- tiledb:::libtiledb_query_buffer_var_char_alloc_direct(nrow, 90)
-  qry@ptr <- tiledb:::libtiledb_query_set_buffer_var_char(qry@ptr, "cols", colptr)
+  colptr <- tiledb_query_alloc_buffer_ptr_char(nrow, 90)
+  qry <- tiledb_query_set_buffer_ptr_char(qry, "cols", colptr)
   qry <- tiledb_query_add_range(qry, sch, "cols", "aa", "zz")
 
   a1r <- vector(mode="integer", length=nrow) * NA_integer_
@@ -93,12 +90,12 @@ read_array <- function(uri) {
   d1ptr <- tiledb_query_buffer_alloc_ptr(qry, attrowtype, nrow)
   qry <- tiledb_query_set_buffer_ptr(qry, "d1", d1ptr)
 
-  qryptr <- tiledb:::libtiledb_query_submit(qryptr)
-  tiledb:::libtiledb_array_close(arrptr)
+  qry <- tiledb_query_submit(qry)
+  tiledb_array_close(arr)
 
-  rows <- tiledb:::libtiledb_query_get_buffer_ptr(rowptr)
-  cols <- tiledb:::libtiledb_query_get_buffer_var_char(colptr)
-  d1r <- tiledb:::libtiledb_query_get_buffer_ptr(d1ptr)
+  rows <- tiledb_query_get_buffer_ptr(rowptr)
+  cols <- tiledb_query_get_buffer_char(colptr)
+  d1r <- tiledb_query_get_buffer_ptr(d1ptr)
   print(data.frame(rows,cols,a1r,d1r))
 }
 

inst/examples/ex_var_length_char_new.R

@@ -0,0 +1,74 @@
+library(tiledb)
+
+## Name of the array to create. Will get auto-deleted.
+## Replace with filename in existing directory if you want to keep it.
+array_name <- tempfile()
+
+create_array <- function() {
+  ## Check if the array already exists.
+  if (tiledb_object_type(array_name) == "ARRAY") {
+    message("Array already exists.")
+    return(invisible(NULL))
+  }
+
+  ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4].
+  dom <- tiledb_domain(c(tiledb_dim("rows", c(1L, 4L), 4L, "INT32"),
+                         tiledb_dim("cols", c(1L, 4L), 4L, "INT32")))
+  sch <- tiledb_array_schema(dom,
+                             attrs = c(tiledb_attr("a1", type="CHAR", ncells=NA)),
+                             cell_order = "ROW_MAJOR",
+                             tile_order = "ROW_MAJOR",
+                             sparse = FALSE)
+  tiledb_array_create(array_name, sch)
+  invisible(NULL)
+}
+
+write_array <- function() {
+  datavec <- c("a","bb", "ccc", "dd", "eee", "f", "g", "hhh",
+               "i", "jjj", "kk", "l", "m", "n", "oo", "p")
+
+  array <- tiledb_dense(array_name, "WRITE")
+  query <- tiledb_query(array, "WRITE")
+  bufptr <- tiledb_query_create_buffer_ptr_char(query, datavec)
+  query <- tiledb_query_set_buffer_ptr_char(query, "a1", bufptr)
+  query <- tiledb_query_submit(query)
+  tiledb_array_close(array)
+  invisible(NULL)
+}
+
+read_array <- function(txt="", subarr=NULL) {
+  cat("\nReading", txt, "\n")
+  ctx <- tiledb_ctx()
+  array <- tiledb_dense(array_name, "READ")
+  query <- tiledb_query(array, "READ")
+  if (is.null(subarr)) {
+    d <- dim(schema(array))
+    subarr <- c(1L, d[1], 1L, d[2])
+  }
+  query <- tiledb_query_set_subarray(query, subarr)
+  bufptr <- tiledb_query_alloc_buffer_ptr_char_subarray(array, "a1", subarr)
+  query <- tiledb_query_set_buffer_ptr_char(query, "a1", bufptr)
+  query <- tiledb_query_submit(query)
+  print(tiledb_query_get_buffer_char(bufptr), quote=FALSE)
+}
+
+write_subarray <- function() {
+  datavec <- c("K", "LLL", "MM", "N")
+  subarr <- c(2L,3L, 2L,3L)
+
+  array <- tiledb_dense(array_name, "WRITE")
+  query <- tiledb_query(array, "WRITE")
+  query <- tiledb_query_set_subarray(query, subarr)
+  bufptr <- tiledb_query_create_buffer_ptr_char(query, datavec)
+  query <- tiledb_query_set_buffer_ptr_char(query, "a1", bufptr)
+  query <- tiledb_query_submit(query)
+  tiledb_array_close(array)
+  invisible(NULL)
+}
+
+create_array()
+write_array()
+read_array("original array")
+write_subarray()
+read_array("after subarray write")
+read_array("after subarray write, subset", c(2L,3L,2L,3L))