ARROW-14942: [R] Bindings for lubridate's dpicoseconds, dnanoseconds, desconds, dmilliseconds, dmicroseconds

r/NEWS.md

@@ -25,6 +25,7 @@
   * Added `make_date()` & `make_datetime()` + `ISOdatetime()` & `ISOdate()` to create date-times from numeric representations. 
   * Added `decimal_date()` and `date_decimal()`
   * Added `make_difftime()` (duration constructor)
+  * Added duration helper functions: `dyears()`, `dmonths()`, `dweeks()`, `ddays()`, `dhours()`, `dminutes()`, `dseconds()`, `dmilliseconds()`, `dmicroseconds()`, `dnanoseconds()`.
 * date-time functionality:
   * Added `difftime` and `as.difftime()` 
   * Added `as.Date()` to convert to date

r/R/dplyr-funcs-datetime.R

@@ -353,6 +353,44 @@ register_bindings_duration <- function() {
   })
 }
 
+.helpers_function_map <- list(
+  "dminutes" = list(60, "s"),
+  "dhours" = list(3600, "s"),
+  "ddays" = list(86400, "s"),
+  "dweeks" = list(604800, "s"),
+  "dmonths" = list(2629800, "s"),
+  "dyears" = list(31557600, "s"),
+  "dseconds" = list(1, "s"),
+  "dmilliseconds" = list(1, "ms"),
+  "dmicroseconds" = list(1, "us"),
+  "dnanoseconds" = list(1, "ns")
+)
+make_duration <- function(x, unit) {
+  x <- build_expr("cast", x, options = cast_options(to_type = int64()))
+  x$cast(duration(unit))
+}
+register_bindings_duration_helpers <- function() {
+  duration_helpers_map_factory <- function(value, unit) {
+    force(value)
+    force(unit)
+    function(x = 1) make_duration(x * value, unit)
+  }
+
+  for (name in names(.helpers_function_map)) {
+    register_binding(
+      name,
+      duration_helpers_map_factory(
+        .helpers_function_map[[name]][[1]],
+        .helpers_function_map[[name]][[2]]
+      )
+    )
+  }
+
+  register_binding("dpicoseconds", function(x = 1) {
+    abort("Duration in picoseconds not supported in Arrow.")
+  })
+}
+
 register_bindings_difftime_constructors <- function() {
   register_binding("make_difftime", function(num = NULL,
                                              units = "secs",
@@ -383,31 +421,6 @@ register_bindings_difftime_constructors <- function() {
   })
 }
 
-make_duration <- function(x, unit) {
-  x <- build_expr("cast", x, options = cast_options(to_type = int64()))
-  x$cast(duration(unit))
-}
-register_bindings_duration_helpers <- function() {
-  register_binding("dminutes", function(x = 1) {
-    make_duration(x * 60, "s")
-  })
-  register_binding("dhours", function(x = 1) {
-    make_duration(x * 3600, "s")
-  })
-  register_binding("ddays", function(x = 1) {
-    make_duration(x * 86400, "s")
-  })
-  register_binding("dweeks", function(x = 1) {
-    make_duration(x * 604800, "s")
-  })
-  register_binding("dmonths", function(x = 1) {
-    make_duration(x * 2629800, "s")
-  })
-  register_binding("dyears", function(x = 1) {
-    make_duration(x * 31557600, "s")
-  })
-}
-
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {
   if (usetz) {
     format <- paste(format, "%Z")

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1258,7 +1258,12 @@ test_that("`decimal_date()` and `date_decimal()`", {
 
 test_that("dminutes, dhours, ddays, dweeks, dmonths, dyears", {
   example_d <- tibble(x = c(1:10, NA))
-  date_to_add <- ymd("2009-08-03", tz = "America/Chicago")
+  date_to_add <- ymd("2009-08-03", tz = "Pacific/Marquesas")
+
+  # When comparing results we use ignore_attr = TRUE because of the diff in:
+  # attribute 'package' (absent vs. 'lubridate')
+  # class (difftime vs Duration)
+  # attribute 'units' (character vector ('secs') vs. absent)
 
   compare_dplyr_binding(
     .input %>%
@@ -1303,6 +1308,79 @@ test_that("dminutes, dhours, ddays, dweeks, dmonths, dyears", {
     tibble(),
     ignore_attr = TRUE
   )
+
+  # double -> duration not supported in Arrow.
+  # Error is generated in the C++ code
+  expect_error(
+    test_df %>%
+      arrow_table() %>%
+      mutate(r_obj_dminutes = dminutes(1.12345)) %>%
+      collect()
+  )
+})
+
+test_that("dseconds, dmilliseconds, dmicroseconds, dnanoseconds, dpicoseconds", {
+  example_d <- tibble(x = c(1:10, NA))
+  date_to_add <- ymd("2009-08-03", tz = "Pacific/Marquesas")
+
+  # When comparing results we use ignore_attr = TRUE because of the diff in:
+  # attribute 'package' (absent vs. 'lubridate')
+  # class (difftime vs Duration)
+  # attribute 'units' (character vector ('secs') vs. absent)
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        dseconds = dseconds(x),
+        dmilliseconds = dmilliseconds(x),
+        dmicroseconds = dmicroseconds(x),
+        dnanoseconds = dnanoseconds(x),
+      ) %>%
+      collect(),
+    example_d,
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        dseconds = dseconds(x),
+        dmicroseconds = dmicroseconds(x),
+        new_date_1 = date_to_add + dseconds,
+        new_date_2 = date_to_add + dseconds - dmicroseconds,
+        new_duration = dseconds - dmicroseconds
+      ) %>%
+      collect(),
+    example_d,
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        r_obj_dseconds = dseconds(1),
+        r_obj_dmilliseconds = dmilliseconds(2),
+        r_obj_dmicroseconds = dmicroseconds(3),
+        r_obj_dnanoseconds = dnanoseconds(4)
+      ) %>%
+      collect(),
+    tibble(),
+    ignore_attr = TRUE
+  )
+
+  expect_error(
+    call_binding("dpicoseconds"),
+    "Duration in picoseconds not supported in Arrow"
+  )
+
+  # double -> duration not supported in Arrow.
+  # Error is generated in the C++ code
+  expect_error(
+    test_df %>%
+      arrow_table() %>%
+      mutate(r_obj_dseconds = dseconds(1.12345)) %>%
+      collect()
+  )
 })
 
 test_that("make_difftime()", {