[jira] [Commented] (ARROW-15008) [R] Not all group generic functions are supported for Arrays

["Neal Richardson (Jira)" <ji...@apache.org>]

    [ https://issues.apache.org/jira/browse/ARROW-15008?page=com.atlassian.jira.plugin.system.issuetabpanels:comment-tabpanel&focusedCommentId=17454705#comment-17454705 ] 

Neal Richardson commented on ARROW-15008:
-----------------------------------------

Duplicate of ARROW-13337?

> [R] Not all group generic functions are supported for Arrays
> ------------------------------------------------------------
>
>                 Key: ARROW-15008
>                 URL: https://issues.apache.org/jira/browse/ARROW-15008
>             Project: Apache Arrow
>          Issue Type: Improvement
>          Components: R
>            Reporter: Dewey Dunnington
>            Priority: Major
>
> When trying to do some math with decimal types, I noticed that a lot of the group generic functions are not implemented. Many users will use the dplyr bindings (where these are accessible), but it's useful to do this on Arrays and Scalars, too, particularly for decimal types whose math isn't accessible anywhere else in R.
> Some template code that might be helpful from carrow:
> {code:R}
> #' @export
> Math.carrow_vctr <- function(x, ...) {
>   switch(
>     .Generic,
>     abs =, sign =, sqrt =,
>     floor =, ceiling =, trunc =,
>     round =, signif =,
>     exp =, log =, expm1 =, log1p =,
>     cos =, sin =, tan =,
>     cospi =, sinpi =, tanpi =,
>     acos =, asin =, atan =,
>     cosh =, sinh =, tanh =,
>     acosh =, asinh =, atanh =,
>     lgamma =, gamma =, digamma =, trigamma =,
>     cumsum =, cumprod =, cummax =, cumin = {
>       assert_arrow("Math group generics")
>       array <- as_arrow_array(x)
>       arrow_array <- from_carrow_array(array, arrow::Array)
>       getNamespace("base")[[.Generic]](arrow_array)
>     },
>     stop(sprintf("Math generic '%s' not supported for carrow_vctr()", .Generic)) # nocov
>   )
> }
> #' @export
> Ops.carrow_vctr <- function(e1, e2) {
>   if (missing(e2)) {
>     switch(
>       .Generic,
>       "!" =, "+" =, "-" = {
>         assert_arrow("Unary Ops group generics")
>         array <- as_carrow_array(e1)
>         arrow_array <- from_carrow_array(array, arrow::Array)
>         result <- getNamespace("base")[[.Generic]](arrow_array)
>         return(as_carrow_vctr(result))
>       },
>       # R catches these before we do with 'invalid unary operator'
>       stop(sprintf("Unary '%s' not supported for carrow_vctr()", .Generic)) # nocov
>     )
>   }
>   switch(
>     .Generic,
>     "+" =, "-" =, "*" =, "/" =, "^" =, "%%" =, "%/%" =,
>     "&" =, "|" =, "!" =,
>     "==" =, "!=" =, "<" =, "<=" =, ">=" =, ">" = {
>       assert_arrow("Ops group generics")
>       vctr1 <- as_carrow_vctr(e1)
>       vctr2 <- as_carrow_vctr(e2)
>       array1 <- as_carrow_array(vctr1)
>       array2 <- as_carrow_array(vctr2)
>       arrow_array1 <- from_carrow_array(array1, arrow::Array)
>       arrow_array2 <- from_carrow_array(array2, arrow::Array)
>       result <- getNamespace("base")[[.Generic]](arrow_array1, arrow_array2)
>       as_carrow_vctr(result)
>     },
>     stop(sprintf("Ops generic '%s' not supported for carrow_vctr()", .Generic)) # nocov
>   )
> }
> #' @export
> Summary.carrow_vctr <- function(x, ..., na.rm = FALSE) {
>   assert_arrow("Math group generics")
>   switch(
>     .Generic,
>     all =, any =,
>     sum =, prod =,
>     min =, max =,
>     range = {
>       # make sure dots are empty because we ignore them
>       stopifnot(...length() == 0L)
>       array <- as_carrow_array(x)
>       arrow_array <- from_carrow_array(array, arrow::Array)
>       getNamespace("base")[[.Generic]](arrow_array, na.rm = na.rm)
>     },
>     stop(sprintf("Summary generic '%s' not supported for carrow_vctr()", .Generic)) # nocov
>   )
> }
> #' @export
> Complex.carrow_vctr <- function(z) {
>   stop("Complex group generics are not supported for carrow_vctr", call. = FALSE)
> }
> {code}
> And some tests that might be useful to copy:
> {code:R}
> test_that("Math generics work", {
>   # none of these are implemented in Arrow, so none are here either
> })
> test_that("Ops numeric generics work", {
>   skip_if_not_installed("arrow")
>   v1 <- c(1:5, NA)
>   v2 <- 6:11
>   vctr1 <- as_carrow_vctr(v1)
>   vctr2 <- as_carrow_vctr(v2)
>   # unary expressions are broken in Arrow so these don't work
>   # expect_identical(
>   #   from_carrow_array(as_carrow_array(+vctr1)),
>   #   +v1
>   # )
>   #
>   # expect_identical(
>   #   from_carrow_array(as_carrow_array(-vctr1)),
>   #   -v1
>   # )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 + vctr2)),
>     v1 + v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 - vctr2)),
>     v1 - v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 * vctr2)),
>     v1 * v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 / vctr2)),
>     v1 / v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 ^ vctr2)),
>     as.integer(v1 ^ v2)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 %% vctr2)),
>     v1 %% v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 %/% vctr2)),
>     v1 %/% v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 + vctr2)),
>     v1 + v2
>   )
> })
> test_that("Ops logical generics work", {
>   skip_if_not_installed("arrow")
>   skip("until logical conversion is improved")
>   v1 <- c(TRUE, TRUE, FALSE, FALSE, NA, NA, NA)
>   v2 <- c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, NA)
>   vctr1 <- as_carrow_vctr(v1)
>   vctr2 <- as_carrow_vctr(v2)
>   expect_identical(
>     from_carrow_array(as_carrow_array(!vctr1)),
>     !v1
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 & vctr2)),
>     v1 & v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 & vctr2)),
>     v1 | v2
>   )
> })
> test_that("Ops comparison generics work", {
>   skip_if_not_installed("arrow")
>   skip("until logical conversion is improved")
>   v1 <- c(1, 2, 3, 4, 5, 1, NA, 3, NA, 5, NA)
>   v2 <- c(5, 4, 3, 2, 1, NA, 4, NA, 2, 1, NA)
>   vctr1 <- as_carrow_vctr(v1)
>   vctr2 <- as_carrow_vctr(v2)
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 == vctr2)),
>     v1 == v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 != vctr2)),
>     v1 != v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 < vctr2)),
>     v1 < v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 <= vctr2)),
>     v1 <= v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 >= vctr2)),
>     v1 >= v2
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(vctr1 > vctr2)),
>     v1 > v2
>   )
> })
> test_that("Summary numeric generics work", {
>   skip_if_not_installed("arrow")
>   v1 <- c(1:5, NA)
>   vctr1 <- as_carrow_vctr(v1)
>   expect_identical(
>     from_carrow_array(as_carrow_array(sum(vctr1, na.rm = TRUE))),
>     as.double(sum(v1, na.rm = TRUE))
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(sum(vctr1, na.rm = FALSE))),
>     as.double(sum(v1, na.rm = FALSE))
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(min(vctr1, na.rm = TRUE))),
>     min(v1, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(min(vctr1, na.rm = FALSE))),
>     min(v1, na.rm = FALSE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(max(vctr1, na.rm = TRUE))),
>     max(v1, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(max(vctr1, na.rm = FALSE))),
>     max(v1, na.rm = FALSE)
>   )
>   skip("not all Summary generics are implemented in Arrow")
>   expect_identical(
>     from_carrow_array(as_carrow_array(range(vctr1, na.rm = TRUE))),
>     range(v1, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(range(vctr1, na.rm = FALSE))),
>     range(v1, na.rm = FALSE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(prod(vctr1, na.rm = TRUE))),
>     prod(v1, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(prod(vctr1, na.rm = FALSE))),
>     prod(v1, na.rm = FALSE)
>   )
> })
> test_that("Summary logical generics work", {
>   skip_if_not_installed("arrow")
>   skip("until logical conversion is fixed")
>   v1 <- c(FALSE, FALSE, NA)
>   v2 <- c(TRUE, TRUE, NA)
>   vctr1 <- as_carrow_vctr(v1)
>   vctr2 <- as_carrow_vctr(v2)
>   expect_identical(
>     from_carrow_array(as_carrow_array(any(vctr1, na.rm = TRUE))),
>     any(v1, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(any(vctr1, na.rm = FALSE))),
>     any(v1, na.rm = FALSE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(any(vctr2, na.rm = TRUE))),
>     any(v2, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(any(vctr2, na.rm = FALSE))),
>     any(v2, na.rm = FALSE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(all(vctr1, na.rm = TRUE))),
>     all(v1, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(all(vctr1, na.rm = FALSE))),
>     all(v1, na.rm = FALSE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(all(vctr2, na.rm = TRUE))),
>     all(v2, na.rm = TRUE)
>   )
>   expect_identical(
>     from_carrow_array(as_carrow_array(all(vctr2, na.rm = FALSE))),
>     all(v2, na.rm = FALSE)
>   )
> })
> {code}



--
This message was sent by Atlassian Jira
(v8.20.1#820001)