Generalize the as.matrix accessor to supported selected ranges (#247)

* generalize as.matrix return to work with selected_ranges

* refined logic

* additional tests

* additional NEWS entry

NEWS.md

@@ -1,5 +1,9 @@
 # tiledb 'under development'
 
+## Improvements
+
+* Matrix objects can now be returned under range selections (#247)
+
 ## Bug Fixes
 
 * Unit tests of character columns in data frames accomodate R versions prior to R 4.0.0 in all cases (#243)

R/TileDBArray.R

@@ -104,7 +104,7 @@ tiledb_array <- function(uri,
   if (missing(uri) || !is.scalar(uri, "character"))
     stop("argument uri must be a string scalar", call. = FALSE)
   if (as.data.frame && as.matrix)
-    stop("arguments as.data.frame and as.matrix cannot be selected togethers", call. = FALSE)
+    stop("arguments as.data.frame and as.matrix cannot be selected together", call. = FALSE)
   if (isTRUE(is.sparse) && as.matrix)
     stop("argument as.matrix cannot be selected for sparse arrays", call. = FALSE)
 
@@ -624,12 +624,17 @@ setMethod("[", "tiledb_array",
        res <- res[, -k]
     }
     if (ncol(res) < 3) {
-      message("ignoring as.matrix argument with insufficient result set")
-    } else if (!is.null(i)) {
-      message("case of row selection not supported for accessing as.matrix")
-    } else if (!is.null(j)) {
-      message("case of column selection not supported for accessing as.matrix")
-    } else if (ncol(res) == 3) {
+      stop("Seeing as.matrix argument with insufficient result set")
+    }
+    if (!identical(unique(res[,1]), seq(1, length(unique(res[,1]))))) {
+        cur <- unique(res[,1])
+        for (l in seq_len(length(cur))) res[ which(res[,1] == cur[l]), 1 ] <- l
+    }
+    if (!identical(unique(res[,2]), seq(1, length(unique(res[,2]))))) {
+        cur <- unique(res[,2])
+        for (l in seq_len(length(cur))) res[ which(res[,2] == cur[l]), 2 ] <- l
+    }
+    if (ncol(res) == 3) {
       mat <- matrix(, nrow=max(res[,1]), ncol=max(res[,2]))
       mat[ cbind( res[,1], res[,2] ) ] <- res[,3]
       res <- mat

inst/tinytest/test_tiledbarray.R

@@ -1055,9 +1055,20 @@ expect_equal(mat, mat2)                 # check round-turn
 
 ## check no double selection
 expect_error(tiledb_array(tmp, as.data.frame=TRUE, as.matrix=TRUE))
-## check normal data.frame return when row col select
-expect_true(is.data.frame(suppressMessages(arr2[1:2,])))
-expect_true(is.data.frame(suppressMessages(arr2[,3])))
+## check matrix return and not data.frame return when row col select
+expect_false(is.data.frame(suppressMessages(arr2[1:2,])))
+expect_true(is.matrix(suppressMessages(arr2[1:2,])))
+expect_false(is.data.frame(suppressMessages(arr2[,3])))
+expect_true(is.matrix(suppressMessages(arr2[,3])))
+## selections via i and j
+expect_equal(arr2[1:2,], cbind( c(1,2), c(6,7), c(11,12), c(16,17)))
+expect_equal(arr2[,3], cbind(11:15) )
+## more complex selection with holes via selected_ranges()
+selected_ranges(arr2) <- list(cbind(c(1,4),c(2,5)), cbind(2,3))
+expect_equal(arr2[], cbind(c(6,7,9,10), c(11,12,14,15)))
+selected_ranges(arr2) <- list(cbind(c(1,4),c(2,5)), cbind(2,2))
+expect_equal(arr2[], cbind(c(6,7,9,10)))
+
 
 arr3 <- tiledb_array(tmp, as.data.frame=TRUE)
 df1 <- arr3[]