Workaround to enable writing of high-dimensional dense arrays.

Seems to be an issue with the underlying tiledb package, but whatever.

Author: LTLA

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: TileDBArray
-Version: 1.21.0
-Date: 2025-06-19
+Version: 1.21.1
+Date: 2026-04-04
 Title: Using TileDB as a DelayedArray Backend
 Description: Implements a DelayedArray backend for reading and
     writing dense or sparse arrays in the TileDB format. The

R/TileDBRealizationSink.R

@@ -210,7 +210,6 @@ setValidity2("TileDBRealizationSink", function(object) {
 #' @importFrom SparseArray nzwhich nzvals
 #' @importFrom DelayedArray start width
 setMethod("write_block", "TileDBRealizationSink", function(sink, viewport, block) {
-    starts <- start(viewport) - 1L
     obj <- tiledb_array(sink@path, attrs=sink@attr, query_type="WRITE")
     on.exit(tiledb_array_close(obj))
 
@@ -220,24 +219,27 @@ setMethod("write_block", "TileDBRealizationSink", function(sink, viewport, block
 
         ndim <- ncol(idx)
         store <- vector("list", ndim + 1L)
+        starts <- start(viewport)
         for (i in seq_len(ndim)) {
-            store[[i]] <- idx[,i] + starts[i] + sink@offset[i] - 1L
+            store[[i]] <- idx[,i] + (starts[i] - 1L) + (sink@offset[i] - 1L)
         }
         store[[ndim + 1]] <- vals
 
         names(store) <- c(sprintf("d%i", seq_len(ndim)), sink@attr)
         obj[] <- data.frame(store)
 
     } else {
-        args <- lapply(width(viewport), seq_len)
-        for (i in seq_along(args)) {
-            args[[i]] <- args[[i]] + starts[i] + sink@offset[i] - 1L
-        }
+        starts <- start(viewport)
+        widths <- width(viewport)
+        ndim <- length(starts)
 
-        # Need to coerce the block, because it could be a SparseArray
-        # derivative.
-        args <- c(list(sink=obj), args, list(value=as.array(block)))
-        do.call("[<-", args)
+        ranges <- vector("list", ndim)
+        for (i in seq_len(ndim)) {
+            actual.start <- starts[i] + (sink@offset[i] - 1L)
+            ranges[[i]] <- cbind(actual.start, actual.start + widths[i] - 1L)
+        }
+        selected_ranges(obj) <- ranges
+        obj[] <- as.array(block) # Need to coerce the block, because it could be a SparseArray derivative.
     }
 
     sink

inst/NEWS.Rd

@@ -2,6 +2,10 @@
 \title{TileDBArray News}
 \encoding{UTF-8}
 
+\section{Version 1.22.0}{\itemize{
+\item Workaround for \code{TileDBRealizationSink} to properly write higher-dimensional dense arrays.
+}}
+
 \section{Version 1.16.0}{\itemize{
 \item Minor fix for \code{as.data.frame=} deprecation in \code{tiledb_array()}.
 

tests/testthat/test-write.R

@@ -54,6 +54,20 @@ test_that("can shunt between sparse and non-sparse, regardless of the format", {
     }
 })
 
+test_that("works with high-dimensional arrays", {
+    path <- tempfile()
+    arr <- array(runif(1000), dim=c(10, 5, 20))
+    out <- writeTileDBArray(arr, path=path)
+    expect_identical(unname(as.array(out)), arr)
+
+    path <- tempfile()
+    arr[] <- 0
+    arr[sample(length(arr), 100)] <- rpois(100, lambda=10)
+    arr <- as(arr, "SVT_SparseArray")
+    out <- writeTileDBArray(arr, path=path, sparse=TRUE)
+    expect_identical(as(out, "SVT_SparseArray"), arr)
+})
+
 test_that("responds to the path", {
     path <- tempfile()
     expect_false(file.exists(path))