[GitHub] [arrow] jonkeane commented on a change in pull request #11904: ARROW-15010: [R] Create a function registry for our NSE funcs

[GitBox <gi...@apache.org>]

jonkeane commented on a change in pull request #11904:
URL: https://github.com/apache/arrow/pull/11904#discussion_r777698855



##########
File path: r/R/dplyr-funcs-type.R
##########
@@ -0,0 +1,250 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+# Split up into several register functions by category to satisfy the linter
+register_bindings_type <- function() {
+  register_bindings_type_cast()
+  register_bindings_type_inspect()
+  register_bindings_type_elementwise()
+}
+
+
+  register_binding("cast", function(x, target_type, safe = TRUE, ...) {
+    opts <- cast_options(safe, ...)
+    opts$to_type <- as_type(target_type)
+    Expression$create("cast", x, options = opts)
+  })
+
+  register_binding("dictionary_encode", function(x,
+                                                     null_encoding_behavior = c("mask", "encode")) {
+    behavior <- toupper(match.arg(null_encoding_behavior))
+    null_encoding_behavior <- NullEncodingBehavior[[behavior]]
+    Expression$create(
+      "dictionary_encode",
+      x,
+      options = list(null_encoding_behavior = null_encoding_behavior)
+    )
+  })
+
+  # as.* type casting functions
+  # as.factor() is mapped in expression.R
+  register_binding("as.character", function(x) {
+    Expression$create("cast", x, options = cast_options(to_type = string()))
+  })
+  register_binding("as.double", function(x) {
+    Expression$create("cast", x, options = cast_options(to_type = float64()))
+  })
+  register_binding("as.integer", function(x) {
+    Expression$create(
+      "cast",
+      x,
+      options = cast_options(
+        to_type = int32(),
+        allow_float_truncate = TRUE,
+        allow_decimal_truncate = TRUE
+      )
+    )
+  })
+  register_binding("as.integer64", function(x) {
+    Expression$create(
+      "cast",
+      x,
+      options = cast_options(
+        to_type = int64(),
+        allow_float_truncate = TRUE,
+        allow_decimal_truncate = TRUE
+      )
+    )
+  })
+  register_binding("as.logical", function(x) {
+    Expression$create("cast", x, options = cast_options(to_type = boolean()))
+  })
+  register_binding("as.numeric", function(x) {
+    Expression$create("cast", x, options = cast_options(to_type = float64()))
+  })
+
+  register_binding("is", function(object, class2) {
+    if (is.string(class2)) {
+      switch(class2,
+        # for R data types, pass off to is.*() functions
+        character = call_binding("is.character", object),
+        numeric = call_binding("is.numeric", object),
+        integer = call_binding("is.integer", object),
+        integer64 = call_binding("is.integer64", object),
+        logical = call_binding("is.logical", object),
+        factor = call_binding("is.factor", object),
+        list = call_binding("is.list", object),
+        # for Arrow data types, compare class2 with object$type()$ToString(),
+        # but first strip off any parameters to only compare the top-level data
+        # type,  and canonicalize class2
+        sub("^([^([<]+).*$", "\\1", object$type()$ToString()) ==
+          canonical_type_str(class2)
+      )
+    } else if (inherits(class2, "DataType")) {
+      object$type() == as_type(class2)
+    } else {
+      stop("Second argument to is() is not a string or DataType", call. = FALSE)
+    }
+  })
+
+  # Create a data frame/tibble/struct column
+  register_binding("tibble", function(..., .rows = NULL, .name_repair = NULL) {
+    if (!is.null(.rows)) arrow_not_supported(".rows")
+    if (!is.null(.name_repair)) arrow_not_supported(".name_repair")
+
+    # use dots_list() because this is what tibble() uses to allow the
+    # useful shorthand of tibble(col1, col2) -> tibble(col1 = col1, col2 = col2)
+    # we have a stronger enforcement of unique names for arguments because
+    # it is difficult to replicate the .name_repair semantics and expanding of
+    # unnamed data frame arguments in the same way that the tibble() constructor
+    # does.
+    args <- rlang::dots_list(..., .named = TRUE, .homonyms = "error")
+
+    build_expr(
+      "make_struct",
+      args = unname(args),
+      options = list(field_names = names(args))
+    )
+  })
+
+  register_binding("data.frame", function(..., row.names = NULL,
+                                              check.rows = NULL, check.names = TRUE, fix.empty.names = TRUE,
+                                              stringsAsFactors = FALSE) {
+    # we need a specific value of stringsAsFactors because the default was
+    # TRUE in R <= 3.6
+    if (!identical(stringsAsFactors, FALSE)) {
+      arrow_not_supported("stringsAsFactors = TRUE")
+    }
+
+    # ignore row.names and check.rows with a warning
+    if (!is.null(row.names)) arrow_not_supported("row.names")
+    if (!is.null(check.rows)) arrow_not_supported("check.rows")
+
+    args <- rlang::dots_list(..., .named = fix.empty.names)
+    if (is.null(names(args))) {
+      names(args) <- rep("", length(args))
+    }
+
+    if (identical(check.names, TRUE)) {
+      if (identical(fix.empty.names, TRUE)) {
+        names(args) <- make.names(names(args), unique = TRUE)
+      } else {
+        name_emtpy <- names(args) == ""
+        names(args)[!name_emtpy] <- make.names(names(args)[!name_emtpy], unique = TRUE)
+      }
+    }
+
+    build_expr(
+      "make_struct",
+      args = unname(args),
+      options = list(field_names = names(args))
+    )
+  })
+}

Review comment:
       ```suggestion
   ```
   
   This is extraneous, no? And it looks like the lines above this are also indented?




-- 
This is an automated message from the Apache Git Service.
To respond to the message, please log on to GitHub and use the
URL above to go to the specific comment.

To unsubscribe, e-mail: github-unsubscribe@arrow.apache.org

For queries about this service, please contact Infrastructure at:
users@infra.apache.org