Allow passing list of coords vectors for writes

Dense arrays do not currently support sparse writes. When they do this
will just work

R/DenseArray.R

@@ -175,6 +175,11 @@ attribute_buffers <- function(array, sch, dom, sub, filter_attributes=list()) {
 setMethod("[", "tiledb_dense",
           function(x, i, j, ..., drop = FALSE) {
             index <- nd_index_from_syscall(sys.call(), parent.frame())
+            # If we have a list of lists of lists we need to remove one layer
+            # This happens when a user uses a list of coordinates
+            if (isNestedList(index[1])) {
+              index <- index[[1]]
+            }
             ctx <- x@ctx
             uri <- x@uri
             schema <- tiledb::schema(x)
@@ -256,6 +261,11 @@ setMethod("[<-", "tiledb_dense",
               }
             }
             index <- nd_index_from_syscall(sys.call(), parent.frame())
+            # If we have a list of lists of lists we need to remove one layer
+            # This happens when a user uses a list of coordinates
+            if (isNestedList(index[1])) {
+              index <- index[[1]]
+            }
             ctx <- x@ctx
             schema <- tiledb::schema(x)
             uri <- x@uri

R/SparseArray.R

@@ -87,6 +87,11 @@ as_data_frame <- function(dom, data) {
 setMethod("[", "tiledb_sparse",
           function(x, i, j, ..., drop = FALSE) {
             index <- nd_index_from_syscall(sys.call(), parent.frame())
+            # If we have a list of lists of lists we need to remove one layer
+            # This happens when a user uses a list of coordinates
+            if (isNestedList(index[1])) {
+              index <- index[[1]]
+            }
             ctx <- x@ctx
             uri <- x@uri
             schema <- tiledb::schema(x)
@@ -161,6 +166,11 @@ setMethod("[<-", "tiledb_sparse",
               }
             }
             index <- nd_index_from_syscall(sys.call(), parent.frame())
+            # If we have a list of lists of lists we need to remove one layer
+            # This happens when a user uses a list of coordinates
+            if (isNestedList(index[1])) {
+              index <- index[[1]]
+            }
             ctx <- x@ctx
             schema <- tiledb::schema(x)
             uri <- x@uri

R/utils.R

@@ -18,4 +18,12 @@ nd_index_from_syscall <- function(call, env_frame) {
   if (length(index) == 1L && is.null(index[[1L]]))
     index <- list() 
   return(index)
+}
+
+isNestedList <- function(l) {
+  stopifnot(is.list(l))
+  for (i in l) {
+    if (is.list(i)) return(TRUE)
+  }
+  return(FALSE)
 }

src/libtiledb.cpp

@@ -664,6 +664,7 @@ NumericVector dim_domain_subarray(NumericVector domain, NumericVector subscript)
       throw Rcpp::exception(errmsg.str().c_str());
     }
     double diff = high - low;
+    std::cout << diff << std::endl;
     if (diff > 1.0 || diff < 1.0) {
       // end one subarray range
       sub.push_back(low);

tests/testthat/test_DenseArray.R

@@ -387,6 +387,41 @@ test_that("test tiledb_subarray read for dense array as dataframe", {
   # vector range syntax
   expect_equal(tiledb_subarray(arr, list(1,3,1,3), attrs=c("val2"))$val2, unlist(as.list(dat2[1:3, 1:3])))
 
+  teardown({
+    unlink(tmp, recursive = TRUE)
+  })
+})
+
+test_that("Can read / write a simple 2D matrix with list of coordinates", {
+  tmp <- tempdir()
+  setup({
+    unlink_and_create(tmp)
+  })
+
+  ctx <- tiledb_ctx()
+  d1  <- tiledb_dim(ctx, domain = c(1L, 5L))
+  d2  <- tiledb_dim(ctx, domain = c(1L, 5L))
+  dom <- tiledb_domain(ctx, c(d1, d2))
+  val <- tiledb_attr(ctx, name="val")
+  sch <- tiledb_array_schema(ctx, dom, c(val))
+  tiledb_array_create(tmp, sch)
+
+  dat <- matrix(rnorm(25), 5, 5)
+  arr <- tiledb_dense(ctx, tmp, as.data.frame=FALSE)
+
+  arr[] <- dat
+  expect_equal(arr[], dat)
+
+  # explicit range enumeration
+  expect_equal(arr[list(c(3,4,5), c(3,4,5))],
+               dat[c(3,4,5), c(3,4,5)])
+
+  # vector range syntax
+  expect_equal(arr[list(c(1:3), c(1:3))], dat[1:3, 1:3])
+
+  # scalar indexing
+  expect_equal(arr[list(c(3), c(3))], dat[3, 3])
+
   teardown({
     unlink(tmp, recursive = TRUE)
   })

tests/testthat/test_SparseArray.R

@@ -143,6 +143,42 @@ test_that("test tiledb_subarray read for sparse array as dataframe", {
   # vector range syntax
   expect_equal(tiledb_subarray(arr, list(1,3,1,3), attrs=c("val2"))$val2, unlist(as.list(dat2[1:3, 1:3])))
 
+  teardown({
+    unlink(tmp, recursive = TRUE)
+  })
+})
+
+
+test_that("test tiledb_subarray read/write for sparse array with list of coordinates", {
+  tmp <- tempdir()
+  setup({
+    unlink_and_create(tmp)
+  })
+
+  ctx <- tiledb_ctx()
+  d1  <- tiledb_dim(ctx, domain = c(1L, 5L))
+  d2  <- tiledb_dim(ctx, domain = c(1L, 5L))
+  dom <- tiledb_domain(ctx, c(d1, d2))
+  val <- tiledb_attr(ctx, name="val")
+  sch <- tiledb_array_schema(ctx, dom, c(val), sparse=TRUE)
+  tiledb_array_create(tmp, sch)
+
+  dat <- matrix(rnorm(25), 5, 5)
+  arr <- tiledb_sparse(ctx, tmp, as.data.frame=FALSE)
+  I <- c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5,1,2,3,4,5,1,2,3,4,5)
+  J <- c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5,5,5,5,5)
+
+  coords = list(I, J)
+  arr[coords] <- dat
+  expect_equal(arr[]$val, unlist(as.list(dat)))
+
+  # explicit range enumeration
+  expect_equal(arr[list(c(3,4,5), c(3,4,5))]$val,
+               unlist(as.list(dat[c(3,4,5), c(3,4,5)])))
+
+  # vector range syntax
+  expect_equal(arr[list(c(1:3), c(1:3))]$val, unlist(as.list(dat[1:3, 1:3])))
+
   teardown({
     unlink(tmp, recursive = TRUE)
   })