From 43cabd226ff2484db0e02295bf36c9114b65b3d0 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Tue, 6 Oct 2026 15:51:55 -0400 Subject: [PATCH] Fix dense `[<-` writes and support `[i, j, k]` and `selected_ranges()` Dense `[<-` silently wrote nothing for one-column right-hand sides, rejected three-column ones as dimension/attribute columns, ignored `selected_ranges()`, and built an INT32-only 2-d subarray from `range(i)` and `range(j)`. Writes now build a typed subarray for any number of dimensions from `[i, j, k]` or `selected_ranges()`, matching `[`. Closes #877 Co-Authored-By: Claude Opus 5.5 --- NEWS.md | 18 ++ R/TileDBArray.R | 162 ++++++++++++++++-- R/Utils.R | 13 +- inst/tinytest/test_densewrite.R | 153 +++++++++++++++++ man/subset-tiledb_array-ANY-ANY-ANY-method.Rd | 19 +- 5 files changed, 349 insertions(+), 16 deletions(-) create mode 100644 inst/tinytest/test_densewrite.R diff --git a/NEWS.md b/NEWS.md index 6b2ee46e52..95d62da1e3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,21 @@ +# tiledb (development version) + +## Bug Fixes + +* `[<-` on dense arrays with a single attribute now writes one-column and three-column right-hand sides; these were previously silently dropped or rejected as dimension/attribute columns ([#877](https://github.com/TileDB-Inc/TileDB-R/issues/877)) + +* `[<-` on dense arrays with multiple attributes now writes to the region given by `[i, j]`; previously the indices were ignored and the write failed unless it covered the full domain ([#877](https://github.com/TileDB-Inc/TileDB-R/issues/877)) + +* `[<-` now raises an error when the assigned value does not match the array, instead of silently writing nothing ([#877](https://github.com/TileDB-Inc/TileDB-R/issues/877)) + +## Improvements + +* `[<-` on dense arrays now supports a third index, as in `arr[i, j, k] <- value`, matching `[`; previously a third index was ignored for two-dimensional arrays, and is now an error ([#877](https://github.com/TileDB-Inc/TileDB-R/issues/877)) + +* `[<-` on dense arrays now honors `selected_ranges()` and supports arrays with any number of dimensions and with non-`INT32` dimension types; previously only `INT32` `[i, j]` indices were used and `selected_ranges()` was ignored. Ranges set on an array object, e.g. for an earlier read, now also apply to writes through it. Selecting more than one range per dimension, or setting `selected_points()`, is now an error for writes ([#877](https://github.com/TileDB-Inc/TileDB-R/issues/877)) + +* Indices for `[<-` on dense arrays must be contiguous increasing sequences; previously, other indices were silently widened to their range ([#877](https://github.com/TileDB-Inc/TileDB-R/issues/877)) + # tiledb 0.34.0 * This release of the R package builds against [TileDB 2.30.0](https://github.com/TileDB-Inc/TileDB/releases/tag/2.30.0), and has also been tested against earlier releases as well as the development version diff --git a/R/TileDBArray.R b/R/TileDBArray.R index 8cc8835b23..3b291f2b0c 100644 --- a/R/TileDBArray.R +++ b/R/TileDBArray.R @@ -498,6 +498,101 @@ setValidity("tiledb_array", function(object) { bit64::as.integer64(val) } +## Compute the (low, high) range per dimension for a write to a dense array +## from the [i,j,k] indices and the selected_ranges() of the array object. +## Dimensions without a selection span their full domain. Returns NULL if no +## selection was made at all, in which case no subarray is set. +.dense_write_ranges <- function(x, dims, dimnames, dimtypes, index) { + ndims <- length(dims) + idxnames <- c("i", "j", "k") + + if (any(!vapply(x@selected_points, is.null, logical(1)))) { + stop( + "Writes to dense arrays do not support 'selected_points'.", + call. = FALSE + ) + } + + ## expand (or reorder) a named selected_ranges list, pad an unnamed one + sr <- x@selected_ranges + if (length(sr) > 0 && !is.null(names(sr))) { + ind <- match(names(sr), dimnames) + if (anyNA(ind)) { + stop( + "Name for selected ranges does not match dimension names.", + call. = FALSE + ) + } + fulllist <- vector(mode = "list", length = ndims) + fulllist[ind] <- sr + sr <- fulllist + } + if (length(sr) > ndims) { + stop( + "More selected ranges than dimensions in array.", + call. = FALSE + ) + } + length(sr) <- ndims + + ## fold the [i,j,k] indices into the selected ranges + for (m in seq_along(index)) { + if (is.null(index[[m]])) next + nm <- idxnames[m] + if (m > ndims) { + stop(sprintf( + "Setting dimension '%s' requires at least %d dimensions.", nm, m + ), call. = FALSE) + } + if (!is.null(sr[[m]])) { + stop(sprintf( + "Cannot set both '%s' and element %d of 'selected_ranges'.", nm, m + ), call. = FALSE) + } + vec <- .map2integer64(index[[m]], dimtypes[m]) + if (length(vec) == 0) { + stop(sprintf("Index '%s' is empty.", nm), call. = FALSE) + } + if (length(vec) > 1 && !all(diff(vec) == 1)) { + stop(sprintf( + paste( + "Index '%s' must be a contiguous increasing sequence", + "for writes to dense arrays." + ), + nm + ), call. = FALSE) + } + sr[[m]] <- vec[c(1L, length(vec))] + } + + if (all(vapply(sr, is.null, logical(1)))) { + return(NULL) + } + + ranges <- vector(mode = "list", length = ndims) + for (m in seq_len(ndims)) { + rng <- sr[[m]] + if (is.null(rng)) { + rng <- domain(dims[[m]]) + } else if (!is.null(nrow(rng))) { + if (nrow(rng) != 1) { + stop(sprintf( + paste( + "Writes to dense arrays need a single range per dimension,", + "but 'selected_ranges' has %d for dimension '%s'." + ), + nrow(rng), dimnames[m] + ), call. = FALSE) + } + rng <- c(rng[1, 1], rng[1, 2]) + } else { + rng <- c(min(rng), max(rng)) + } + ranges[[m]] <- .map2integer64(rng, dimtypes[m]) + } + return(ranges) +} + #' Returns a TileDB array, allowing for specific subset ranges. #' #' Heterogeneous domains are supported, including timestamps and characters. @@ -1252,12 +1347,29 @@ setMethod( #' as part of the left-hand side object, or as part of the data.frame #' provided appropriate column names. #' +#' For dense arrays, the region written to is given by the indices \code{i}, +#' \code{j} and (for arrays with three or more dimensions) \code{k}, or by +#' the \code{\link{selected_ranges}} of the array object. Each index must be +#' a contiguous increasing sequence, and each selected range a single range. +#' Dimensions without an index or selected range span their full domain. +#' Arrays with more than three dimensions can be written to via +#' \code{\link{selected_ranges}}. Note that selected ranges set on an array +#' object, e.g. for an earlier read, also apply to writes through it. +#' +#' For dense arrays, an error is raised for an index that is not a +#' contiguous increasing sequence, an index for a dimension the array does +#' not have, more than three indices, more than one selected range for a +#' dimension, or any \code{\link{selected_points}}. For all arrays, an error +#' is raised if the assigned value does not match the attributes (and, where +#' given, dimensions) of the array. +#' #' This function may still change; the current implementation should be #' considered as an initial draft. #' @param x sparse or dense TileDB array object #' @param i parameter row index #' @param j parameter column index -#' @param ... Extra parameter for method signature, currently unused. +#' @param ... For dense arrays, an optional third index \code{k}; further +#' indices are not supported. #' @param value The value being assigned #' @return The modified object #' @examples @@ -1294,8 +1406,18 @@ setMethod( ## add defaults if (missing(i)) i <- NULL if (missing(j)) j <- NULL + k <- NULL spdl::debug("[tiledb_array] '[<-' accessor started") + ## deal with possible n-dim indexing + ndlist <- nd_index_from_syscall(sys.call(), parent.frame()) + if (length(ndlist) >= 3 && !is.null(ndlist[[3]])) k <- ndlist[[3]] + if (length(ndlist) >= 4) { + stop("Indices beyond the third dimension not supported in [i,j,k] form. Use selected_ranges().", call. = FALSE) + } + ## keep the indices together as 'k' is reused as a loop index below + index <- list(i, j, k) + ctx <- x@ctx uri <- x@uri sel <- x@attrs @@ -1351,7 +1473,10 @@ setMethod( ## There is more to do here but it is a start ## Case 1 - if (length(colnames(value)) == length(allnames)) { + ## for dense arrays, a matrix or array RHS can have as many columns as + ## there are dimensions and attributes, so also require matching names + if (length(colnames(value)) == length(allnames) && + (sparse || any(colnames(value) %in% allnames))) { ## same length is good if (length(intersect(colnames(value), allnames)) == length(allnames)) { ## all good, proceed @@ -1382,10 +1507,10 @@ setMethod( ## is.null(i) && is.null(j) && length(attrnames) == 1) { d <- dim(value) - if ((d[2] > 1) && - (inherits(value, "data.frame") || inherits(value, "matrix")) && + if ((inherits(value, "data.frame") || inherits(value, "matrix")) && !any(grepl("rows", colnames(value))) && - !any(grepl("cols", colnames(value)))) { + !any(grepl("cols", colnames(value))) && + !any(colnames(value) %in% dimnames)) { ## turn the 2-d RHS in 1-d and align the names for the test that follows ## in effect, we just rewrite the query for the user value <- data.frame(x = as.matrix(value)[seq(1, d[1] * d[2])]) @@ -1418,6 +1543,13 @@ setMethod( nm <- if (is.list(value)) names(value) else colnames(value) if (isTRUE(all.equal(sort(allnames), sort(nm)))) { + ## case of dense array with subarray writes needs to set the subarray, + ## computed before opening the array so that errors leave nothing open + ranges <- NULL + if (!sparse && !any(dimnames %in% allnames)) { + ranges <- .dense_write_ranges(x, dims, dimnames, dimtypes, index) + } + if (libtiledb_array_is_open_for_writing(x@ptr)) { # if open for writing arrptr <- x@ptr # use array } else { # else open appropriately @@ -1529,15 +1661,25 @@ setMethod( } } - ## case of dense array with subarray writes needs to set the subarray - if (!sparse && !is.null(i) && !is.null(j) && length(allnames) == 1) { - if (!is.vector(i) || !is.vector(j)) message("'i' and 'j' should be simple vectors.") - subarr <- as.integer(c(range(i), range(j))) - qryptr <- libtiledb_query_set_subarray(qryptr, subarr) + if (!is.null(ranges)) { + sbrptr <- libtiledb_subarray(qryptr) + for (m in seq_along(ranges)) { + sbrptr <- libtiledb_subarray_add_range_with_type( + sbrptr, m - 1, dimtypes[m], ranges[[m]][1], ranges[[m]][2] + ) + } + qryptr <- libtiledb_query_set_subarray_object(qryptr, sbrptr) } qryptr <- libtiledb_query_submit(qryptr) if (!x@keep_open) libtiledb_array_close(arrptr) + } else { + stop( + "Assigned value does not match the array: expected columns '", + paste(allnames, collapse = ", "), "' but got '", + paste(nm, collapse = ", "), "'.", + call. = FALSE + ) } invisible(x) } diff --git a/R/Utils.R b/R/Utils.R index c8dff9ebfc..026c094306 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -190,8 +190,15 @@ is.scalar <- function(x, typestr) { ## Adapted from the DelayedArray package ##' @importFrom utils tail nd_index_from_syscall <- function(call, env_frame) { + idx <- seq_len(length(call) - 2L) + argnames <- tail(names(call), n = -2L) + if (!is.null(argnames)) { + ## drop named arguments before evaluating, so that e.g. the (possibly + ## large) 'value' of an assignment is not evaluated a second time + idx <- idx[!(argnames %in% c("drop", "exact", "value"))] + } index <- lapply( - seq_len(length(call) - 2L), + idx, function(idx) { subscript <- call[[2L + idx]] if (missing(subscript)) { @@ -201,10 +208,6 @@ nd_index_from_syscall <- function(call, env_frame) { return(subscript) } ) - argnames <- tail(names(call), n = -2L) - if (!is.null(argnames)) { - index <- index[!(argnames %in% c("drop", "exact", "value"))] - } if (length(index) == 1L && is.null(index[[1L]])) { index <- list() } diff --git a/inst/tinytest/test_densewrite.R b/inst/tinytest/test_densewrite.R new file mode 100644 index 0000000000..2231a45434 --- /dev/null +++ b/inst/tinytest/test_densewrite.R @@ -0,0 +1,153 @@ +library(tinytest) +library(tiledb) + +ctx <- tiledb_ctx(limitTileDBCores()) + +## Writes to dense arrays via `[<-`, see issue #877 + +#' Create an empty dense array +#' +#' @param ndim Number of dimensions, named \code{d1}, \code{d2}, ... +#' @param type Datatype of the dimensions +#' @param nattr Number of \code{FLOAT64} attributes, named \code{x}, \code{y} +#' +#' @return The URI of the new array +#' +#' @noRd +#' +make_dense <- function(ndim = 2L, type = "INT32", nattr = 1L) { + uri <- tempfile() + ext <- c(4L, 4L, 2L, 2L)[seq_len(ndim)] + dims <- lapply(seq_len(ndim), function(m) { + tiledb_dim(paste0("d", m), c(1L, ext[m]), ext[m], type = type) + }) + attrs <- lapply(c("x", "y")[seq_len(nattr)], tiledb_attr, type = "FLOAT64") + sch <- tiledb_array_schema(tiledb_domain(dims = dims), attrs = attrs, + sparse = FALSE) + tiledb_array_create(uri, sch) + return(uri) +} + +#' Read a dense array back as a full-domain R array +#' +#' Cells that were never written are \code{NA}; a plain read would only +#' return the non-empty domain +#' +#' @param uri URI of an array created by \code{make_dense()} +#' @param attr Name of the attribute to return +#' +#' @return An R array with one element per cell of the full domain +#' +#' @noRd +#' +read_dense <- function(uri, attr = "x") { + df <- tiledb_array(uri, return_as = "data.frame")[] + dn <- grep("^d[0-9]$", names(df), value = TRUE) + out <- array(NA_real_, c(4L, 4L, 2L, 2L)[seq_along(dn)]) + idx <- vapply(df[dn], as.integer, integer(nrow(df))) + out[matrix(idx, ncol = length(dn))] <- df[[attr]] + return(out) +} + +## 2-d, every block width: [i, j] and selected_ranges() +for (nc in 1:4) { + m <- matrix(as.numeric(seq_len(4 * nc)), 4, nc) + + uri <- make_dense() + arr <- tiledb_array(uri) + arr[1:4, seq_len(nc)] <- m + expect_equal(read_dense(uri)[, seq_len(nc), drop = FALSE], m, + info = sprintf("[i, j] with %d columns", nc)) + + uri <- make_dense() + arr <- tiledb_array(uri) + selected_ranges(arr) <- list(cbind(1, 4), cbind(1, nc)) + arr[] <- m + expect_equal(read_dense(uri)[, seq_len(nc), drop = FALSE], m, + info = sprintf("selected_ranges() with %d columns", nc)) +} + +## 2-d, offset block leaves the remaining cells empty +uri <- make_dense() +arr <- tiledb_array(uri) +arr[2:3, 3] <- matrix(c(1, 2), 2, 1) +res <- read_dense(uri) +expect_equal(res[2:3, 3], c(1, 2)) +expect_equal(sum(!is.na(res)), 2L) + +## 3-d, [i, j, k] and [i, , k] +uri <- make_dense(3L) +arr <- tiledb_array(uri) +arr[1:4, 2:4, 1] <- matrix(101:112, 4, 3) +arr[1:4, 2:4, 2] <- matrix(201:212, 4, 3) +res <- read_dense(uri) +expect_equal(res[, 2:4, 1], matrix(as.numeric(101:112), 4, 3)) +expect_equal(res[, 2:4, 2], matrix(as.numeric(201:212), 4, 3)) +expect_true(all(is.na(res[, 1, ]))) + +uri <- make_dense(3L) +arr <- tiledb_array(uri) +arr[2:3, , 2] <- matrix(1:8, 2, 4) +res <- read_dense(uri) +expect_equal(res[2:3, , 2], matrix(as.numeric(1:8), 2, 4)) +expect_equal(sum(!is.na(res)), 8L) + +## 3-d, an array right-hand side +uri <- make_dense(3L) +arr <- tiledb_array(uri) +arr[1:2, 1:4, 1:2] <- array(1:16, c(2, 4, 2)) +expect_equal(read_dense(uri)[1:2, , ], array(as.numeric(1:16), c(2, 4, 2))) + +## 4-d via named selected_ranges(), given out of order +uri <- make_dense(4L) +arr <- tiledb_array(uri) +selected_ranges(arr) <- list(d4 = cbind(2, 2), d3 = cbind(1, 1)) +arr[] <- matrix(1:16, 4, 4) +res <- read_dense(uri) +expect_equal(res[, , 1, 2], matrix(as.numeric(1:16), 4, 4)) +expect_equal(sum(!is.na(res)), 16L) + +## 1-d +uri <- make_dense(1L) +arr <- tiledb_array(uri) +arr[2:3] <- c(7, 8) +expect_equal(as.vector(read_dense(uri)), c(NA, 7, 8, NA)) + +## INT64 dimensions +if (requireNamespace("bit64", quietly = TRUE)) { + uri <- make_dense(2L, "INT64") + arr <- tiledb_array(uri) + arr[bit64::as.integer64(2:3), bit64::as.integer64(1:3)] <- matrix(1:6, 2, 3) + expect_equal(read_dense(uri)[2:3, 1:3], matrix(as.numeric(1:6), 2, 3)) +} + +## multiple attributes, [i, j] with a list right-hand side +uri <- make_dense(2L, nattr = 2L) +arr <- tiledb_array(uri) +arr[2:3, 1:2] <- list(x = matrix(1:4, 2, 2), y = matrix(5:8, 2, 2)) +expect_equal(read_dense(uri, "x")[2:3, 1:2], matrix(as.numeric(1:4), 2, 2)) +expect_equal(read_dense(uri, "y")[2:3, 1:2], matrix(as.numeric(5:8), 2, 2)) +expect_equal(sum(!is.na(read_dense(uri, "x"))), 4L) +## previously a silent no-op +expect_error(arr[] <- data.frame(a = 1, b = 1, c = 1), "does not match") + +## errors +uri <- make_dense() +arr <- tiledb_array(uri) +expect_error(arr[1:4, 1:2, 1] <- matrix(1, 4, 2), "at least 3 dimensions") +expect_error(arr[c(1, 3), 1:2] <- matrix(1, 2, 2), "contiguous") +expect_error(arr[4:1, 1:2] <- matrix(1, 4, 2), "contiguous") +selected_ranges(arr) <- list(cbind(1, 4), NULL) +expect_error(arr[1:4, 1:2] <- matrix(1, 4, 2), "Cannot set both 'i'") +selected_ranges(arr) <- list(cbind(c(1, 3), c(1, 4)), NULL) +expect_error(arr[] <- matrix(1, 3, 4), "single range") +selected_ranges(arr) <- list() +selected_points(arr) <- list(c(1, 2), NULL) +expect_error(arr[] <- matrix(1, 2, 4), "selected_points") + +uri <- make_dense(4L) +arr <- tiledb_array(uri) +expect_error(arr[1:4, 1:4, 1, 1] <- matrix(1, 4, 4), "third dimension") + +## nothing was written by the failing assignments +expect_equal(tiledb_fragment_info_get_num(tiledb_fragment_info(uri)), 0) diff --git a/man/subset-tiledb_array-ANY-ANY-ANY-method.Rd b/man/subset-tiledb_array-ANY-ANY-ANY-method.Rd index f74b5f6f14..cc219695f2 100644 --- a/man/subset-tiledb_array-ANY-ANY-ANY-method.Rd +++ b/man/subset-tiledb_array-ANY-ANY-ANY-method.Rd @@ -17,7 +17,8 @@ \item{j}{parameter column index} -\item{...}{Extra parameter for method signature, currently unused.} +\item{...}{For dense arrays, an optional third index \code{k}; further +indices are not supported.} \item{value}{The value being assigned} } @@ -33,6 +34,22 @@ For sparse matrices, row and column indices can either be supplied as part of the left-hand side object, or as part of the data.frame provided appropriate column names. +For dense arrays, the region written to is given by the indices \code{i}, +\code{j} and (for arrays with three or more dimensions) \code{k}, or by +the \code{\link{selected_ranges}} of the array object. Each index must be +a contiguous increasing sequence, and each selected range a single range. +Dimensions without an index or selected range span their full domain. +Arrays with more than three dimensions can be written to via +\code{\link{selected_ranges}}. Note that selected ranges set on an array +object, e.g. for an earlier read, also apply to writes through it. + +For dense arrays, an error is raised for an index that is not a +contiguous increasing sequence, an index for a dimension the array does +not have, more than three indices, more than one selected range for a +dimension, or any \code{\link{selected_points}}. For all arrays, an error +is raised if the assigned value does not match the attributes (and, where +given, dimensions) of the array. + This function may still change; the current implementation should be considered as an initial draft. }