From ca6ad9f511374ee367b6c1408ed41a9530cf3c5e Mon Sep 17 00:00:00 2001 From: Seth Shelnutt Date: Wed, 30 Jan 2019 11:22:19 -0500 Subject: [PATCH] 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 | 10 +++++++++ R/SparseArray.R | 10 +++++++++ R/utils.R | 8 +++++++ tests/testthat/test_DenseArray.R | 35 ++++++++++++++++++++++++++++++ tests/testthat/test_SparseArray.R | 36 +++++++++++++++++++++++++++++++ 5 files changed, 99 insertions(+) diff --git a/R/DenseArray.R b/R/DenseArray.R index 6e737bbd34..31cf398cd4 100644 --- a/R/DenseArray.R +++ b/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 diff --git a/R/SparseArray.R b/R/SparseArray.R index 6aaed1342b..3dec509585 100644 --- a/R/SparseArray.R +++ b/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 diff --git a/R/utils.R b/R/utils.R index dd57492972..7121026844 100644 --- a/R/utils.R +++ b/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) } \ No newline at end of file diff --git a/tests/testthat/test_DenseArray.R b/tests/testthat/test_DenseArray.R index 6ad38f1bb6..be22d48658 100644 --- a/tests/testthat/test_DenseArray.R +++ b/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) }) diff --git a/tests/testthat/test_SparseArray.R b/tests/testthat/test_SparseArray.R index 0682ed83e9..22897b88e6 100644 --- a/tests/testthat/test_SparseArray.R +++ b/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) })