You are viewing a plain text version of this content. The canonical link for it is here.
Posted to github@arrow.apache.org by GitBox <gi...@apache.org> on 2021/12/08 22:13:54 UTC

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

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



##########
File path: r/R/dplyr-funcs-string.R
##########
@@ -0,0 +1,492 @@
+# 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.
+
+# String function helpers
+
+#' Get `stringr` pattern options
+#'
+#' This function assigns definitions for the `stringr` pattern modifier
+#' functions (`fixed()`, `regex()`, etc.) inside itself, and uses them to
+#' evaluate the quoted expression `pattern`, returning a list that is used
+#' to control pattern matching behavior in internal `arrow` functions.
+#'
+#' @param pattern Unevaluated expression containing a call to a `stringr`
+#' pattern modifier function
+#'
+#' @return List containing elements `pattern`, `fixed`, and `ignore_case`
+#' @keywords internal
+get_stringr_pattern_options <- function(pattern) {
+  fixed <- function(pattern, ignore_case = FALSE, ...) {
+    check_dots(...)
+    list(pattern = pattern, fixed = TRUE, ignore_case = ignore_case)
+  }
+  regex <- function(pattern, ignore_case = FALSE, ...) {
+    check_dots(...)
+    list(pattern = pattern, fixed = FALSE, ignore_case = ignore_case)
+  }
+  coll <- function(...) {
+    arrow_not_supported("Pattern modifier `coll()`")
+  }
+  boundary <- function(...) {
+    arrow_not_supported("Pattern modifier `boundary()`")
+  }
+  check_dots <- function(...) {
+    dots <- list(...)
+    if (length(dots)) {
+      warning(
+        "Ignoring pattern modifier ",
+        ngettext(length(dots), "argument ", "arguments "),
+        "not supported in Arrow: ",
+        oxford_paste(names(dots)),
+        call. = FALSE
+      )
+    }
+  }
+  ensure_opts <- function(opts) {
+    if (is.character(opts)) {
+      opts <- list(pattern = opts, fixed = FALSE, ignore_case = FALSE)
+    }
+    opts
+  }
+  ensure_opts(eval(pattern))
+}
+
+#' Does this string contain regex metacharacters?
+#'
+#' @param string String to be tested
+#' @keywords internal
+#' @return Logical: does `string` contain regex metacharacters?
+contains_regex <- function(string) {
+  grepl("[.\\|()[{^$*+?]", string)
+}
+
+# format `pattern` as needed for case insensitivity and literal matching by RE2
+format_string_pattern <- function(pattern, ignore.case, fixed) {
+  # Arrow lacks native support for case-insensitive literal string matching and
+  # replacement, so we use the regular expression engine (RE2) to do this.
+  # https://github.com/google/re2/wiki/Syntax
+  if (ignore.case) {
+    if (fixed) {
+      # Everything between "\Q" and "\E" is treated as literal text.
+      # If the search text contains any literal "\E" strings, make them
+      # lowercase so they won't signal the end of the literal text:
+      pattern <- gsub("\\E", "\\e", pattern, fixed = TRUE)
+      pattern <- paste0("\\Q", pattern, "\\E")
+    }
+    # Prepend "(?i)" for case-insensitive matching
+    pattern <- paste0("(?i)", pattern)
+  }
+  pattern
+}
+
+# format `replacement` as needed for literal replacement by RE2
+format_string_replacement <- function(replacement, ignore.case, fixed) {
+  # Arrow lacks native support for case-insensitive literal string
+  # replacement, so we use the regular expression engine (RE2) to do this.
+  # https://github.com/google/re2/wiki/Syntax
+  if (ignore.case && fixed) {
+    # Escape single backslashes in the regex replacement text so they are
+    # interpreted as literal backslashes:
+    replacement <- gsub("\\", "\\\\", replacement, fixed = TRUE)
+  }
+  replacement
+}
+
+# Currently, Arrow does not supports a locale option for string case conversion
+# functions, contrast to stringr's API, so the 'locale' argument is only valid
+# for stringr's default value ("en"). The following are string functions that
+# take a 'locale' option as its second argument:
+#   str_to_lower
+#   str_to_upper
+#   str_to_title
+#
+# Arrow locale will be supported with ARROW-14126
+stop_if_locale_provided <- function(locale) {
+  if (!identical(locale, "en")) {
+    stop("Providing a value for 'locale' other than the default ('en') is not supported in Arrow. ",
+         "To change locale, use 'Sys.setlocale()'",
+         call. = FALSE
+    )
+  }
+}
+
+register_string_translations <- function() {

Review comment:
       We might want to turn off cyclocomp checking entirely, or find a way to simplify this chunk

##########
File path: r/R/dplyr-funcs.R
##########
@@ -0,0 +1,128 @@
+# 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.
+
+
+#' @include expression.R
+NULL
+
+
+#' Register compute translations
+#'
+#' The `register_translation()` and `register_translation_agg()` functions
+#' are used to populate a list of functions that operate on (and return)
+#' Expressions. These are the basis for the `.data` mask inside dplyr methods.
+#'
+#' @section Writing translations:
+#' When to use `build_expr()` vs. `Expression$create()`?
+#'
+#' Use `build_expr()` if you need to
+#' - map R function names to Arrow C++ functions
+#' - wrap R inputs (vectors) as Array/Scalar
+#'
+#' `Expression$create()` is lower level. Most of the translations use it
+#' because they manage the preparation of the user-provided inputs
+#' and don't need or don't want to the automatic conversion of R objects
+#' to [Scalar].
+#'
+#' @param fun_name A function name in the form `"function"` or
+#'   `"package::function"`. The package name is currently not used but
+#'   may be used in the future to allow these types of function calls.
+#' @param fun A function or `NULL` to un-register a previous function.
+#'   This function must accept `Expression` objects as arguments and return
+#'   `Expression` objects instead of regular R objects.
+#' @param agg_fun An aggregate function or `NULL` to un-register a previous
+#'   aggregate function. This function must accept `Expression` objects as
+#'   arguments and return a `list()` with components:
+#'   - `fun`: string function name
+#'   - `data`: `Expression` (these are all currently a single field)
+#'   - `options`: list of function options, as passed to call_function
+#' @param registry An `environment()` in which the functions should be
+#'   assigned.
+#'
+#' @return The previously registered function or `NULL` if no previously
+#'   registered function existed.
+#' @keywords internal
+#'
+register_translation <- function(fun_name, fun, registry = translation_registry()) {
+  name <- gsub("^.*?::", "", fun_name)
+  namespace <- gsub("::.*$", "", fun_name)

Review comment:
       this `namespace` is not currently used, right? I'm fine keeping it, but maybe we should also add tests for registering with a namespace to confirm it all still works like it did in the paste (basically ignores / doesn't work to match anything before the `::`) 

##########
File path: r/R/dplyr-funcs.R
##########
@@ -0,0 +1,128 @@
+# 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.
+
+
+#' @include expression.R
+NULL
+
+
+#' Register compute translations
+#'
+#' The `register_translation()` and `register_translation_agg()` functions
+#' are used to populate a list of functions that operate on (and return)
+#' Expressions. These are the basis for the `.data` mask inside dplyr methods.
+#'
+#' @section Writing translations:
+#' When to use `build_expr()` vs. `Expression$create()`?
+#'
+#' Use `build_expr()` if you need to
+#' - map R function names to Arrow C++ functions
+#' - wrap R inputs (vectors) as Array/Scalar
+#'
+#' `Expression$create()` is lower level. Most of the translations use it
+#' because they manage the preparation of the user-provided inputs
+#' and don't need or don't want to the automatic conversion of R objects
+#' to [Scalar].
+#'
+#' @param fun_name A function name in the form `"function"` or
+#'   `"package::function"`. The package name is currently not used but
+#'   may be used in the future to allow these types of function calls.
+#' @param fun A function or `NULL` to un-register a previous function.
+#'   This function must accept `Expression` objects as arguments and return
+#'   `Expression` objects instead of regular R objects.
+#' @param agg_fun An aggregate function or `NULL` to un-register a previous
+#'   aggregate function. This function must accept `Expression` objects as
+#'   arguments and return a `list()` with components:
+#'   - `fun`: string function name
+#'   - `data`: `Expression` (these are all currently a single field)
+#'   - `options`: list of function options, as passed to call_function
+#' @param registry An `environment()` in which the functions should be
+#'   assigned.
+#'
+#' @return The previously registered function or `NULL` if no previously
+#'   registered function existed.
+#' @keywords internal
+#'
+register_translation <- function(fun_name, fun, registry = translation_registry()) {
+  name <- gsub("^.*?::", "", fun_name)
+  namespace <- gsub("::.*$", "", fun_name)
+
+  previous_fun <- if (name %in% names(registry)) registry[[name]] else NULL
+
+  if (is.null(fun) && !is.null(previous_fun)) {
+    rm(list = name, envir = registry, inherits = FALSE)
+  } else {
+    registry[[name]] <- fun
+  }
+
+  invisible(previous_fun)
+}
+
+register_translation_agg <- function(fun_name, agg_fun, registry = translation_registry_agg()) {
+  register_translation(fun_name, agg_fun, registry = registry)
+}
+
+translation_registry <- function() {
+  nse_funcs
+}
+
+translation_registry_agg <- function() {
+  agg_funcs
+}
+
+# Supports functions and tests that call previously-defined translations.
+call_translation <- function(fun_name, ...) {
+  nse_funcs[[fun_name]](...)
+}
+
+call_translation_agg <- function(fun_name, ...) {
+  agg_funcs[[fun_name]](...)
+}
+
+# Called in .onLoad()
+create_translation_cache <- function() {
+  arrow_funcs <- list()
+
+  # Register all available Arrow Compute functions, namespaced as arrow_fun.
+  if (arrow_available()) {
+    all_arrow_funs <- list_compute_functions()
+    arrow_funcs <- set_names(
+      lapply(all_arrow_funs, function(fun) {
+        force(fun)
+        function(...) build_expr(fun, ...)
+      }),
+      paste0("arrow_", all_arrow_funs)
+    )
+  }
+
+  # Register translations into nse_funcs and agg_funcs
+  register_array_function_map_translations()
+  register_aggregate_translations()
+  register_conditional_translations()
+  register_datetime_translations()
+  register_math_translations()
+  register_string_translations()
+  register_type_translations()
+
+  # We only create the cache for nse_funcs and not agg_funcs
+  .cache$functions <- c(as.list(nse_funcs), arrow_funcs)
+}
+
+# environments in the arrow namespace used in the above functions
+nse_funcs <- new.env(parent = emptyenv())
+agg_funcs <- new.env(parent = emptyenv())
+.cache <- new.env(parent = emptyenv())

Review comment:
       The old .cache used `hash = TRUE` any reason we're moving away from that?
   
   Also do we need / want to specify the parent here? https://issues.apache.org/jira/browse/ARROW-14071 is well out of scope for this PR and I'm not trying to bring it in, but I would imagine that doing it would involve keeping these environments on the search path to global (which IIRC `emptyenv()` is out of, but maybe I'm misremembering that?)  




-- 
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