ARROW-10089: [R] inject base class for Array, ChunkedArray and Scalar

r/DESCRIPTION

@@ -54,7 +54,9 @@ Collate:
     'arrow-package.R'
     'type.R'
     'array-data.R'
+    'arrow-datum.R'
     'array.R'
+    'arrow-tabular.R'
     'arrowExports.R'
     'buffer.R'
     'chunked-array.R'
@@ -86,6 +88,7 @@ Collate:
     'list.R'
     'memory-pool.R'
     'message.R'
+    'metadata.R'
     'parquet.R'
     'python.R'
     'record-batch-reader.R'

r/NAMESPACE

@@ -1,85 +1,57 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("!=",ArrowObject)
-S3method("$",RecordBatch)
+S3method("$",ArrowTabular)
 S3method("$",Schema)
 S3method("$",SubTreeFileSystem)
-S3method("$",Table)
-S3method("$<-",Table)
+S3method("$<-",ArrowTabular)
 S3method("==",ArrowObject)
-S3method("[",Array)
-S3method("[",ChunkedArray)
+S3method("[",ArrowDatum)
+S3method("[",ArrowTabular)
 S3method("[",Dataset)
-S3method("[",RecordBatch)
 S3method("[",Schema)
-S3method("[",Table)
 S3method("[",arrow_dplyr_query)
-S3method("[[",RecordBatch)
+S3method("[[",ArrowTabular)
 S3method("[[",Schema)
-S3method("[[",Table)
-S3method("[[<-",Table)
-S3method("names<-",RecordBatch)
-S3method("names<-",Table)
-S3method(Ops,Array)
-S3method(Ops,ChunkedArray)
+S3method("[[<-",ArrowTabular)
+S3method("names<-",ArrowTabular)
+S3method(Ops,ArrowDatum)
 S3method(Ops,Expression)
 S3method(Ops,array_expression)
 S3method(all,equal.ArrowObject)
-S3method(as.character,Array)
-S3method(as.character,ChunkedArray)
+S3method(as.character,ArrowDatum)
 S3method(as.character,FileFormat)
-S3method(as.character,Scalar)
-S3method(as.data.frame,RecordBatch)
-S3method(as.data.frame,Table)
+S3method(as.data.frame,ArrowTabular)
 S3method(as.data.frame,arrow_dplyr_query)
-S3method(as.double,Array)
-S3method(as.double,ChunkedArray)
-S3method(as.double,Scalar)
-S3method(as.integer,Array)
-S3method(as.integer,ChunkedArray)
-S3method(as.integer,Scalar)
-S3method(as.list,RecordBatch)
+S3method(as.double,ArrowDatum)
+S3method(as.integer,ArrowDatum)
+S3method(as.list,ArrowTabular)
 S3method(as.list,Schema)
-S3method(as.list,Table)
 S3method(as.raw,Buffer)
-S3method(as.vector,Array)
-S3method(as.vector,ChunkedArray)
-S3method(as.vector,Scalar)
+S3method(as.vector,ArrowDatum)
 S3method(as.vector,array_expression)
 S3method(c,Dataset)
+S3method(dim,ArrowTabular)
 S3method(dim,Dataset)
-S3method(dim,RecordBatch)
-S3method(dim,Table)
 S3method(dim,arrow_dplyr_query)
-S3method(dimnames,RecordBatch)
-S3method(dimnames,Table)
-S3method(head,Array)
-S3method(head,ChunkedArray)
+S3method(dimnames,ArrowTabular)
+S3method(head,ArrowDatum)
+S3method(head,ArrowTabular)
 S3method(head,Dataset)
-S3method(head,RecordBatch)
-S3method(head,Table)
 S3method(head,arrow_dplyr_query)
-S3method(is.na,Array)
-S3method(is.na,ChunkedArray)
+S3method(is.na,ArrowDatum)
 S3method(is.na,Expression)
 S3method(is.na,Scalar)
 S3method(is.na,array_expression)
-S3method(is.nan,Array)
-S3method(is.nan,ChunkedArray)
-S3method(length,Array)
-S3method(length,ChunkedArray)
+S3method(is.nan,ArrowDatum)
+S3method(length,ArrowDatum)
 S3method(length,Scalar)
 S3method(length,Schema)
-S3method(match_arrow,Array)
-S3method(match_arrow,ChunkedArray)
+S3method(match_arrow,ArrowDatum)
 S3method(match_arrow,default)
-S3method(max,Array)
-S3method(max,ChunkedArray)
-S3method(mean,Array)
-S3method(mean,ChunkedArray)
-S3method(mean,Scalar)
-S3method(min,Array)
-S3method(min,ChunkedArray)
+S3method(max,ArrowDatum)
+S3method(mean,ArrowDatum)
+S3method(min,ArrowDatum)
 S3method(names,Dataset)
 S3method(names,FeatherReader)
 S3method(names,RecordBatch)
@@ -96,22 +68,15 @@ S3method(print,arrow_r_metadata)
 S3method(read_message,InputStream)
 S3method(read_message,MessageReader)
 S3method(read_message,default)
-S3method(row.names,RecordBatch)
-S3method(row.names,Table)
-S3method(sum,Array)
-S3method(sum,ChunkedArray)
-S3method(sum,Scalar)
-S3method(tail,Array)
-S3method(tail,ChunkedArray)
+S3method(row.names,ArrowTabular)
+S3method(sum,ArrowDatum)
+S3method(tail,ArrowDatum)
+S3method(tail,ArrowTabular)
 S3method(tail,Dataset)
-S3method(tail,RecordBatch)
-S3method(tail,Table)
 S3method(tail,arrow_dplyr_query)
-S3method(type,Array)
-S3method(type,ChunkedArray)
+S3method(type,ArrowDatum)
 S3method(type,default)
-S3method(unique,Array)
-S3method(unique,ChunkedArray)
+S3method(unique,ArrowDatum)
 S3method(vec_ptype_abbr,arrow_fixed_size_binary)
 S3method(vec_ptype_abbr,arrow_fixed_size_list)
 S3method(vec_ptype_abbr,arrow_large_list)

r/R/array.R

@@ -15,7 +15,7 @@
 # specific language governing permissions and limitations
 # under the License.
 
-#' @include arrow-package.R
+#' @include arrow-datum.R
 
 #' @title Arrow Arrays
 #' @description An `Array` is an immutable data array with some logical type
@@ -83,7 +83,7 @@
 #' @name array
 #' @export
 Array <- R6Class("Array",
-  inherit = ArrowObject,
+  inherit = ArrowDatum,
   public = list(
     IsNull = function(i) Array__IsNull(self, i),
     IsValid = function(i) Array__IsValid(self, i),
@@ -128,10 +128,6 @@ Array <- R6Class("Array",
       assert_is(other, "Array")
       Array__RangeEquals(self, other, start_idx, end_idx, other_start_idx)
     },
-    cast = function(target_type, safe = TRUE, options = cast_options(safe)) {
-      assert_is(options, "CastOptions")
-      Array$create(Array__cast(self, as_type(target_type), options))
-    },
     View = function(type) {
       Array$create(Array__View(self, as_type(type)))
     },
@@ -241,120 +237,10 @@ FixedSizeListArray <- R6Class("FixedSizeListArray", inherit = Array,
   )
 )
 
-#' @export
-length.Array <- function(x) x$length()
-
-#' @export
-is.na.Array <- function(x) call_function("is_null", x)
-
-#' @export
-is.nan.Array <- function(x) call_function("is_nan", x)
-
-#' @export
-as.vector.Array <- function(x, mode) x$as_vector()
-
-filter_rows <- function(x, i, keep_na = TRUE, ...) {
-  # General purpose function for [ row subsetting with R semantics
-  # Based on the input for `i`, calls x$Filter, x$Slice, or x$Take
-  nrows <- x$num_rows %||% x$length() # Depends on whether Array or Table-like
-  if (inherits(i, "array_expression")) {
-    # Evaluate it
-    i <- eval_array_expression(i)
-  }
-  if (is.logical(i)) {
-    if (isTRUE(i)) {
-      # Shortcut without doing any work
-      x
-    } else {
-      i <- rep_len(i, nrows) # For R recycling behavior; consider vctrs::vec_recycle()
-      x$Filter(i, keep_na)
-    }
-  } else if (is.numeric(i)) {
-    if (all(i < 0)) {
-      # in R, negative i means "everything but i"
-      i <- setdiff(seq_len(nrows), -1 * i)
-    }
-    if (is.sliceable(i)) {
-      x$Slice(i[1] - 1, length(i))
-    } else if (all(i > 0)) {
-      x$Take(i - 1)
-    } else {
-      stop("Cannot mix positive and negative indices", call. = FALSE)
-    }
-  } else if (is.Array(i, INTEGER_TYPES)) {
-    # NOTE: this doesn't do the - 1 offset
-    x$Take(i)
-  } else if (is.Array(i, "bool")) {
-    x$Filter(i, keep_na)
-  } else {
-    # Unsupported cases
-    if (is.Array(i)) {
-      stop("Cannot extract rows with an Array of type ", i$type$ToString(), call. = FALSE)
-    }
-    stop("Cannot extract rows with an object of class ", class(i), call.=FALSE)
-  }
-}
-
-#' @export
-`[.Array` <- filter_rows
-
-#' @importFrom utils head
-#' @export
-head.Array <- function(x, n = 6L, ...) {
-  assert_is(n, c("numeric", "integer"))
-  assert_that(length(n) == 1)
-  len <- NROW(x)
-  if (n < 0) {
-    # head(x, negative) means all but the last n rows
-    n <- max(len + n, 0)
-  } else {
-    n <- min(len, n)
-  }
-  if (n == len) {
-    return(x)
-  }
-  x$Slice(0, n)
-}
-
-#' @importFrom utils tail
-#' @export
-tail.Array <- function(x, n = 6L, ...) {
-  assert_is(n, c("numeric", "integer"))
-  assert_that(length(n) == 1)
-  len <- NROW(x)
-  if (n < 0) {
-    # tail(x, negative) means all but the first n rows
-    n <- min(-n, len)
-  } else {
-    n <- max(len - n, 0)
-  }
-  if (n == 0) {
-    return(x)
-  }
-  x$Slice(n)
-}
-
-is.sliceable <- function(i) {
-  # Determine whether `i` can be expressed as a $Slice() command
-  is.numeric(i) &&
-    length(i) > 0 &&
-    all(i > 0) &&
-    identical(as.integer(i), i[1]:i[length(i)])
-}
-
 is.Array <- function(x, type = NULL) {
   is_it <- inherits(x, c("Array", "ChunkedArray"))
   if (is_it && !is.null(type)) {
     is_it <- x$type$ToString() %in% type
   }
   is_it
 }
-
-#' @export
-as.double.Array <- function(x, ...) as.double(as.vector(x), ...)
-
-#' @export
-as.integer.Array <- function(x, ...) as.integer(as.vector(x), ...)
-
-#' @export
-as.character.Array <- function(x, ...) as.character(as.vector(x), ...)