Skip to content

Commit

Permalink
implement int() and zb_int() functions, update indexing methods for i…
Browse files Browse the repository at this point in the history
…nt/zb_int), add tests
  • Loading branch information
Artur-man committed Oct 20, 2024
1 parent 6f5d6c2 commit 3fa0a47
Show file tree
Hide file tree
Showing 6 changed files with 64 additions and 64 deletions.
8 changes: 5 additions & 3 deletions R/atomic.R
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ is_scalar <- function(s) {
#' Check if a value is an integer R vector or scalar.
#' @keywords internal
is_integer <- function(s) {
if(is.atomic(s) && is.numeric(s) && all(s %% 1 == 0)) {
if(is.atomic(s) && is.numeric(s) && all(s %% 1 == 0) && length(s) == 1) {
return(TRUE)
}
return(FALSE)
Expand All @@ -42,8 +42,10 @@ is_integer_scalar <- function(s) {
#' explicitly tagged as a scalar.
#' @keywords internal
is_integer_vec <- function(s) {
if(!is_scalar(s) && is_integer(s)) {
return(TRUE)
if(!is_scalar(s) && is.vector(s) && !is.list(s) && all(sapply(s,is_integer))) {
if(length(s) > 1){
return(TRUE)
}
}
return(FALSE)
}
Expand Down
12 changes: 8 additions & 4 deletions R/filters.R
Original file line number Diff line number Diff line change
Expand Up @@ -30,18 +30,22 @@ manage_filters <- function(filters) {
to <- ifelse("to" %in% arg_names, x[[which("to" == arg_names)]], x[[3]])
if(length(x) > 3) {
by <- ifelse("by" %in% arg_names, x[[which("by" == arg_names)]], x[[4]])
return(seq(from, to, by))
# return(seq(from, to, by))
return(int(seq(from, to, by)))
} else {
by <- NA
return(seq(from, to))
# return(seq(from, to))
return(int(seq(from, to)))
}
return(seq(from, to, by))
# return(seq(from, to, by))
return(int(seq(from, to, by)))
} else if(x[[1]] == "c") {
# return elements of the combine function as indices
check_func <- sapply(x, function(y) {
!is.function(eval(y))
})
return(floor(unlist(x[check_func])))
# return(floor(unlist(x[check_func])))
return(int(floor(unlist(x[check_func]))))
} else {
stop("Unsupported filter '", as.character(x), "' supplied")
}
Expand Down
34 changes: 19 additions & 15 deletions R/indexing.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,8 @@ is_pure_fancy_indexing <- function(selection, ndim = length(selection)) {
(is_integer(sel) | is_integer_list(sel)) | is_integer_vec(sel)
}))
any_integer <- any(sapply(selection, function(sel){
is_integer_list(sel) | is_integer_vec(sel)
# is_integer_list(sel) | is_integer_vec(sel)
is_integer_list(sel) | is_integer_vec(sel) | is_integer(sel)
}))

# return
Expand Down Expand Up @@ -409,8 +410,8 @@ OrthogonalIndexer <- R6::R6Class("OrthogonalIndexer",
dim_indexer <- SliceDimIndexer$new(dim_sel, dim_len, dim_chunk_len)
} else if(length(dim_sel) > 1) {
dim_indexer <- IntArrayDimIndexer$new(dim_sel, dim_len, dim_chunk_len)
# TODO: implement BoolArrayDimIndexer and fix if condition here
# } else if(is_slice(dim_sel)) {
# TODO: implement BoolArrayDimIndexer and fix if condition here (is_bool_vec)
# } else if(is_bool_vec(dim_sel)) {
# dim_indexer <- BoolArrayDimIndexer$new(dim_sel, dim_len, dim_chunk_len)
} else {
stop('Unsupported selection item for basic indexing, expected integer, slice, vector of integer or boolean')
Expand Down Expand Up @@ -576,7 +577,8 @@ IntArrayDimIndexer <- R6::R6Class("IntArrayDimIndexer",
self$num_items <- length(dim_sel)
self$num_chunks <- ceiling(self$dim_len / self$dim_chunk_len)

dim_sel_chunk <- ceiling(dim_sel / dim_chunk_len)
# dim_sel_chunk <- ceiling(dim_sel / dim_chunk_len) # pre zb_int() implementation
dim_sel_chunk <- floor(dim_sel / dim_chunk_len)

# determine order of indices
if(sel_order == Order$public_fields$UNKNOWN)
Expand All @@ -587,17 +589,18 @@ IntArrayDimIndexer <- R6::R6Class("IntArrayDimIndexer",
self$dim_sel <- dim_sel
} else if(self$order == Order$public_fields$DECREASING) {
self$dim_sel = rev(dim_sel)
# self$dim_out_sel = rev(seq(1,self$num_items))
self$dim_out_sel = rev(seq(0,self$num_items-1)) # Python based indexing
self$dim_out_sel = rev(seq(1,self$num_items))
# self$dim_out_sel = rev(seq(0,self$num_items-1)) # Python based indexing
} else {
# sort indices to group by chunk
self$dim_out_sel = order(dim_sel_chunk)
self$dim_sel <- dim_sel[self$dim_out_sel]
self$dim_out_sel <- self$dim_out_sel - 1 # Python based indexing
# self$dim_out_sel <- self$dim_out_sel - 1 # Python based indexing
}

# precompute number of selected items for each chunk
self$chunk_nitems <- tabulate(dim_sel_chunk, nbins = self$num_chunks)
# self$chunk_nitems <- tabulate(dim_sel_chunk, nbins = self$num_chunks) # pre zb_int() implementation
self$chunk_nitems <- tabulate(dim_sel_chunk + 1, nbins = self$num_chunks)

# find chunks that we need to visit
self$dim_chunk_ixs = which(self$chunk_nitems != 0)
Expand All @@ -617,7 +620,7 @@ IntArrayDimIndexer <- R6::R6Class("IntArrayDimIndexer",

# find region in output
# if (dim_chunk_ix == 0) {
if (dim_chunk_ix == 1) {
if (dim_chunk_ix == 1) {
start <- 0
} else {
start <- self$chunk_nitems_cumsum[dim_chunk_ix - 1]
Expand All @@ -634,19 +637,20 @@ IntArrayDimIndexer <- R6::R6Class("IntArrayDimIndexer",
dim_out_sel <- seq(start, stop - 1)
} else {
dim_out_sel <- self$dim_out_sel[(start + 1):stop]
# START R-SPECIFIC
dim_out_sel <- dim_out_sel - 1
# END R-SPECIFIC
}
# dim_out_sel <- self$dim_out_sel[(start + 1):stop]


# START R-SPECIFIC
dim_chunk_ix <- dim_chunk_ix - 1
# END R-SPECIFIC

# find region in chunk
dim_offset <- dim_chunk_ix * self$dim_chunk_len
# dim_chunk_sel <- self$dim_sel[(start + 1):stop] - dim_offset
# dim_chunk_sel <- self$dim_sel[(start + 1):stop] - dim_offset + 1
dim_chunk_sel <- self$dim_sel[(start + 1):stop] - dim_offset - 1

# dim_chunk_sel <- self$dim_sel[(start + 1):stop] - dim_offset - 1 # pre zb_int implementation()
dim_chunk_sel <- self$dim_sel[(start + 1):stop] - dim_offset

# # START R-SPECIFIC
# dim_chunk_ix <- dim_chunk_ix - 1
# # END R-SPECIFIC
Expand Down
63 changes: 26 additions & 37 deletions R/int.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
# Reference: https://github.com/gzuidhof/zarr.js/blob/292804/src/core/slice.ts#L78
# TODO: for now these are defined but not used, should be used in the future ?
# TODO: int() and zb_int() now being used but do we need 'Int' Class ?

#' Abstract Int object
#' @title Int Class
Expand Down Expand Up @@ -35,38 +34,28 @@ Int <- R6::R6Class("Int",
)
)

#' #' Convenience function for the internal Int class constructor.
#' #' @param index The integer index.
#' #' @param zero_based The index of the dimension. By default, FALSE for R-like behavior.
#' #' @return A Int instance with the specified parameters.
#' #' @export
#' int <- function(index, zero_based = FALSE) {
#' index_offset <- ifelse(zero_based, 0, -1)
#' if(!is_na(index) && is.numeric(index)) {
#' index <- index + index_offset
#' }
#' # Assumed to be zero-based
#' # and stop-inclusive
#' return(Int$new(
#' index = index
#' ))
#' }
#'
#' #' Convenience function for the internal Int class constructor
#' #' with zero-based indexing
#' #' @param index integer index
#' #' @export
#' zb_int <- function(index) {
#' return(int(index, zero_based = TRUE))
#' }
#'
#' #' Check if a value is a Int instance.
#' #' @param s The value to check.
#' #' @return TRUE if the value is a Slice instance, FALSE otherwise.
#' #' @export
#' is_int<- function(s) {
#' if(class(s)[[1]] == "Int") {
#' return(TRUE)
#' }
#' return(FALSE)
#' }
#' Convenience function for the internal Int class constructor.
#' @param index The integer index.
#' @param zero_based The index of the dimension. By default, FALSE for R-like behavior.
#' @return A Int instance with the specified parameters.
#' @export
int <- function(index, zero_based = FALSE) {
index_offset <- ifelse(zero_based, 0, -1)
if(!is_na(index) && is.numeric(index)) {
index <- index + index_offset
}
# Assumed to be zero-based
# and stop-inclusive
# return(Int$new(
# index = index
# ))
index
}

#' Convenience function for the internal Int class constructor
#' with zero-based indexing
#' @param index integer index
#' @export
zb_int <- function(index) {
return(int(index, zero_based = TRUE))
}
7 changes: 4 additions & 3 deletions R/normalize.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,8 @@ normalize_list_selection <- function(selection, shape, convert_integer_selection

for(i in seq_along(selection)) {
dim_sel <- selection[[i]]
if(length(dim_sel) == 1 && is_integer(dim_sel)) {
# if(length(dim_sel) == 1 && is_integer(dim_sel)) {
if(is_integer(dim_sel)){
if(convert_integer_selection_to_slices) {
selection[[i]] <- zb_slice(dim_sel, dim_sel + 1, 1)
} else {
Expand Down Expand Up @@ -37,8 +38,8 @@ normalize_integer_selection <- function(dim_sel, dim_len) {

# TODO: do we need to normalize R indexing or Python indexing here ?
# handle out of bounds
# if(dim_sel >= dim_len || dim_sel < 0) {
if(dim_sel > dim_len || dim_sel < 1) {
if(dim_sel >= dim_len || dim_sel < 0) {
# if(dim_sel > dim_len || dim_sel < 1) { # pre zb_int implementation
stop('BoundsCheckError(dim_len)')
}

Expand Down
4 changes: 2 additions & 2 deletions R/zarr-array.R
Original file line number Diff line number Diff line change
Expand Up @@ -1069,8 +1069,8 @@ ZarrArray <- R6::R6Class("ZarrArray",
# Reference: https://github.com/gzuidhof/zarr.js/blob/master/src/core/index.ts#L266

if(is_pure_fancy_indexing(selection)){
# TODO: implement vindex further for vertical indexing
stop("vertical indexing is not supported yet")
# TODO: implement vindex further for vectorized indexing
stop("vectorized indexing is not supported yet")
# return(self$get_vindex()$get_item(selection))
} else {
return(self$get_basic_selection(selection))
Expand Down

0 comments on commit 3fa0a47

Please sign in to comment.