diff --git a/apis/r/R/utils-arrow.R b/apis/r/R/utils-arrow.R index 891c532b43..9ea924a0d9 100644 --- a/apis/r/R/utils-arrow.R +++ b/apis/r/R/utils-arrow.R @@ -488,7 +488,26 @@ get_domain_and_extent_dataframe <- function(tbl_schema, ind_col_names, domain = requested_slot <- domain[[ind_col_name]] ind_cur_dom <- if (is.null(requested_slot)) { - ind_max_dom + if (.new_shape_feature_flag_is_enabled()) { + # New shape: if the slot is null, make the size as small + # as possible since current domain can only be resized upward. + # + # Core current-domain semantics are (lo, hi) with both + # inclusive, with lo <= hi. This means smallest is (0, 0) + # which is shape 1, not 0. + if (bit64::is.integer64(ind_max_dom)) { + c(bit64::as.integer64(0), bit64::as.integer64(0)) + } else if (is.integer(ind_max_dom)) { + c(0L, 0L) + } else { + c(0, 0) + } + } else { + # Old shape: if the slot is null, make the size as large + # as possible since there is not current domain, and the + # max domain is immutable. + ind_max_dom + } } else { requested_slot } diff --git a/apis/r/tests/testthat/helper-test-data.R b/apis/r/tests/testthat/helper-test-data.R index a3e8c6d692..efdd572de9 100644 --- a/apis/r/tests/testthat/helper-test-data.R +++ b/apis/r/tests/testthat/helper-test-data.R @@ -78,3 +78,15 @@ create_arrow_table <- function(nrows = 10L, factors = FALSE) { # schema = create_arrow_schema(false) ) } + +domain_for_arrow_table <- function() { + return( + list( + int_column = c(0, 1000000), + soma_joinid = c(0, 1000000), + float_column = c(-1e6, 1e6), + string_column = NULL, + grp = NULL + ) + ) +} diff --git a/apis/r/tests/testthat/helper-test-soma-objects.R b/apis/r/tests/testthat/helper-test-soma-objects.R index a2927e5abd..8bc4927e4f 100644 --- a/apis/r/tests/testthat/helper-test-soma-objects.R +++ b/apis/r/tests/testthat/helper-test-soma-objects.R @@ -1,4 +1,5 @@ # Returns the object created, populated, and closed (unless otherwise requested) + create_and_populate_soma_dataframe <- function( uri, nrows = 10L, @@ -9,10 +10,21 @@ create_and_populate_soma_dataframe <- function( ) { set.seed(seed) - # arrow_schema <- create_arrow_schema() tbl <- create_arrow_table(nrows = nrows, factors = factors) - sdf <- SOMADataFrameCreate(uri, tbl$schema, index_column_names = index_column_names) + full_domain <- domain_for_arrow_table() + domain <- list() + for (index_column in index_column_names) { + domain[[index_column]] <- full_domain[[index_column]] + } + + sdf <- SOMADataFrameCreate( + uri, + tbl$schema, + index_column_names = index_column_names, + domain = domain + ) + sdf$write(tbl) if (is.null(mode)) {