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()", {