diff --git a/r/R/dictionary.R b/r/R/dictionary.R index df94ada035e14..d42a10ad596c7 100644 --- a/r/R/dictionary.R +++ b/r/R/dictionary.R @@ -35,18 +35,18 @@ DictionaryType <- R6Class("DictionaryType", ToString = function() { prettier_dictionary_type(DataType__ToString(self)) }, - code = function() { + code = function(namespace = FALSE) { details <- list() if (self$index_type != int32()) { - details$index_type <- self$index_type$code() + details$index_type <- self$index_type$code(namespace) } if (self$value_type != utf8()) { - details$value_type <- self$value_type$code() + details$value_type <- self$value_type$code(namespace) } if (isTRUE(self$ordered)) { details$ordered <- TRUE } - call2("dictionary", !!!details) + call2("dictionary", !!!details, .ns = if (namespace) "arrow") } ), active = list( diff --git a/r/R/schema.R b/r/R/schema.R index ac0604b2b345c..75623668d9621 100644 --- a/r/R/schema.R +++ b/r/R/schema.R @@ -39,6 +39,7 @@ #' - `$WithMetadata(metadata)`: returns a new `Schema` with the key-value #' `metadata` set. Note that all list elements in `metadata` will be coerced #' to `character`. +#' - `$code(namespace)`: returns the R code needed to generate this schema. Use `namespace=TRUE` to call with `arrow::`. #' #' @section Active bindings: #' @@ -107,14 +108,13 @@ Schema <- R6Class("Schema", inherits(other, "Schema") && Schema__Equals(self, other, isTRUE(check_metadata)) }, export_to_c = function(ptr) ExportSchema(self, ptr), - code = function() { + code = function(namespace = FALSE) { names <- self$names codes <- map2(names, self$fields, function(name, field) { - field$type$code() + field$type$code(namespace) }) codes <- set_names(codes, names) - - call2("schema", !!!codes) + call2("schema", !!!codes, .ns = if (namespace) "arrow") }, WithNames = function(names) { if (!inherits(names, "character")) { diff --git a/r/R/type.R b/r/R/type.R index 58d3267243220..d6db6f146edcd 100644 --- a/r/R/type.R +++ b/r/R/type.R @@ -27,7 +27,7 @@ #' - `$ToString()`: String representation of the DataType #' - `$Equals(other)`: Is the DataType equal to `other` #' - `$fields()`: The children fields associated with this type -#' - `$code()`: Produces an R call of the data type. +#' - `$code(namespace)`: Produces an R call of the data type. Use `namespace=TRUE` to call with `arrow::`. #' #' There are also some active bindings: #' - `$id`: integer Arrow type id. @@ -51,7 +51,7 @@ DataType <- R6Class("DataType", DataType__fields(self) }, export_to_c = function(ptr) ExportType(self, ptr), - code = function() call("stop", paste0("Unsupported type: <", self$ToString(), ">.")) + code = function(namespace = FALSE) call("stop", paste0("Unsupported type: <", self$ToString(), ">.")) ), active = list( id = function() DataType__id(self), @@ -158,7 +158,7 @@ infer_type.Expression <- function(x, ...) x$type() FixedWidthType <- R6Class("FixedWidthType", inherit = DataType, public = list( - code = function() call(tolower(self$name)) + code = function(namespace = FALSE) call2(tolower(self$name), .ns = if (namespace) "arrow") ), active = list( bit_width = function() FixedWidthType__bit_width(self) @@ -178,45 +178,47 @@ Float32 <- R6Class("Float32", inherit = FixedWidthType) Float64 <- R6Class("Float64", inherit = FixedWidthType, public = list( - code = function() call("float64") + code = function(namespace = FALSE) call2("float64", .ns = if (namespace) "arrow") ) ) Boolean <- R6Class("Boolean", inherit = FixedWidthType) Utf8 <- R6Class("Utf8", inherit = DataType, public = list( - code = function() call("utf8") + code = function(namespace = FALSE) call2("utf8", .ns = if (namespace) "arrow") ) ) LargeUtf8 <- R6Class("LargeUtf8", inherit = DataType, public = list( - code = function() call("large_utf8") + code = function(namespace = FALSE) call2("large_utf8", .ns = if (namespace) "arrow") ) ) Binary <- R6Class("Binary", inherit = DataType, public = list( - code = function() call("binary") + code = function(namespace = FALSE) call2("binary", .ns = if (namespace) "arrow") ) ) LargeBinary <- R6Class("LargeBinary", inherit = DataType, public = list( - code = function() call("large_binary") + code = function(namespace = FALSE) call2("large_binary", .ns = if (namespace) "arrow") ) ) FixedSizeBinary <- R6Class("FixedSizeBinary", inherit = FixedWidthType, public = list( byte_width = function() FixedSizeBinary__byte_width(self), - code = function() call2("fixed_size_binary", byte_width = self$byte_width()) + code = function(namespace = FALSE) { + call2("fixed_size_binary", byte_width = self$byte_width(), .ns = if (namespace) "arrow") + } ) ) DateType <- R6Class("DateType", inherit = FixedWidthType, public = list( - code = function() call2(tolower(self$name)), + code = function(namespace = FALSE) call2(tolower(self$name), .ns = if (namespace) "arrow"), unit = function() DateType__unit(self) ) ) @@ -232,26 +234,26 @@ TimeType <- R6Class("TimeType", Time32 <- R6Class("Time32", inherit = TimeType, public = list( - code = function() { + code = function(namespace = FALSE) { unit <- if (self$unit() == TimeUnit$MILLI) { "ms" } else { "s" } - call2("time32", unit = unit) + call2("time32", unit = unit, .ns = if (namespace) "arrow") } ) ) Time64 <- R6Class("Time64", inherit = TimeType, public = list( - code = function() { + code = function(namespace = FALSE) { unit <- if (self$unit() == TimeUnit$NANO) { "ns" } else { "us" } - call2("time64", unit = unit) + call2("time64", unit = unit, .ns = if (namespace) "arrow") } ) ) @@ -266,20 +268,20 @@ DurationType <- R6Class("DurationType", Null <- R6Class("Null", inherit = DataType, public = list( - code = function() call("null") + code = function(namespace = FALSE) call2("null", .ns = if (namespace) "arrow") ) ) Timestamp <- R6Class("Timestamp", inherit = FixedWidthType, public = list( - code = function() { + code = function(namespace = FALSE) { unit <- c("s", "ms", "us", "ns")[self$unit() + 1L] tz <- self$timezone() if (identical(tz, "")) { - call2("timestamp", unit = unit) + call2("timestamp", unit = unit, .ns = if (namespace) "arrow") } else { - call2("timestamp", unit = unit, timezone = tz) + call2("timestamp", unit = unit, timezone = tz, .ns = if (namespace) "arrow") } }, timezone = function() TimestampType__timezone(self), @@ -290,8 +292,8 @@ Timestamp <- R6Class("Timestamp", DecimalType <- R6Class("DecimalType", inherit = FixedWidthType, public = list( - code = function() { - call2("decimal", precision = self$precision(), scale = self$scale()) + code = function(namespace = FALSE) { + call2("decimal", precision = self$precision(), scale = self$scale(), .ns = if (namespace) "arrow") }, precision = function() DecimalType__precision(self), scale = function() DecimalType__scale(self) @@ -624,13 +626,13 @@ check_decimal_args <- function(precision, scale) { StructType <- R6Class("StructType", inherit = NestedType, public = list( - code = function() { + code = function(namespace = FALSE) { field_names <- StructType__field_names(self) codes <- map(field_names, function(name) { - self$GetFieldByName(name)$type$code() + self$GetFieldByName(name)$type$code(namespace) }) codes <- set_names(codes, field_names) - call2("struct", !!!codes) + call2("struct", !!!codes, .ns = if (namespace) "arrow") }, GetFieldByName = function(name) StructType__GetFieldByName(self, name), GetFieldIndex = function(name) StructType__GetFieldIndex(self, name) @@ -648,8 +650,8 @@ names.StructType <- function(x) StructType__field_names(x) ListType <- R6Class("ListType", inherit = NestedType, public = list( - code = function() { - call("list_of", self$value_type$code()) + code = function(namespace = FALSE) { + call2("list_of", self$value_type$code(namespace), .ns = if (namespace) "arrow") } ), active = list( @@ -665,8 +667,8 @@ list_of <- function(type) list__(type) LargeListType <- R6Class("LargeListType", inherit = NestedType, public = list( - code = function() { - call2("large_list_of", self$value_type$code()) + code = function(namespace = FALSE) { + call2("large_list_of", self$value_type$code(namespace), .ns = if (namespace) "arrow") } ), active = list( @@ -684,8 +686,10 @@ large_list_of <- function(type) large_list__(type) FixedSizeListType <- R6Class("FixedSizeListType", inherit = NestedType, public = list( - code = function() { - call2("fixed_size_list_of", self$value_type$code(), list_size = self$list_size) + code = function(namespace = FALSE) { + call2("fixed_size_list_of", self$value_type$code(namespace), + list_size = self$list_size, .ns = if (namespace) "arrow" + ) } ), active = list( diff --git a/r/man/DataType-class.Rd b/r/man/DataType-class.Rd index 4f95578133bd1..5c17c072f92b5 100644 --- a/r/man/DataType-class.Rd +++ b/r/man/DataType-class.Rd @@ -13,7 +13,7 @@ DataType class \item \verb{$ToString()}: String representation of the DataType \item \verb{$Equals(other)}: Is the DataType equal to \code{other} \item \verb{$fields()}: The children fields associated with this type -\item \verb{$code()}: Produces an R call of the data type. +\item \verb{$code(namespace)}: Produces an R call of the data type. Use \code{namespace=TRUE} to call with \verb{arrow::}. } There are also some active bindings: diff --git a/r/man/Schema-class.Rd b/r/man/Schema-class.Rd index 32250cdfe7d05..ecd216af07d78 100644 --- a/r/man/Schema-class.Rd +++ b/r/man/Schema-class.Rd @@ -24,6 +24,7 @@ Many Arrow objects, including \link{Table} and \link{Dataset}, have a \verb{$sch \item \verb{$WithMetadata(metadata)}: returns a new \code{Schema} with the key-value \code{metadata} set. Note that all list elements in \code{metadata} will be coerced to \code{character}. +\item \verb{$code(namespace)}: returns the R code needed to generate this schema. Use \code{namespace=TRUE} to call with \verb{arrow::}. } } diff --git a/r/tests/testthat/helper-roundtrip.R b/r/tests/testthat/helper-roundtrip.R index d6b965ca6597d..449a30dd9dbf1 100644 --- a/r/tests/testthat/helper-roundtrip.R +++ b/r/tests/testthat/helper-roundtrip.R @@ -44,5 +44,13 @@ expect_array_roundtrip <- function(x, type, as = NULL) { } expect_code_roundtrip <- function(x) { - expect_equal(eval(x$code()), x) + code <- x$code() + code_with_ns <- x$code(namespace = TRUE) + + pkg_prefix_pattern <- "^arrow[:][:]" + expect_no_match(as.character(code), pkg_prefix_pattern) + expect_match(as.character(code_with_ns)[1], pkg_prefix_pattern) + + expect_equal(eval(code), x) + expect_equal(eval(code_with_ns), x) }