ARROW-14943: [R] Bindings for lubridate's ddays, dhours, dminutes, dmonths, dweeks, dyears

r/R/dplyr-funcs-datetime.R

@@ -353,6 +353,31 @@ register_bindings_duration <- 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/R/dplyr-funcs.R

@@ -107,6 +107,7 @@ create_binding_cache <- function() {
   register_bindings_conditional()
   register_bindings_datetime()
   register_bindings_duration()
+  register_bindings_duration_helpers()
   register_bindings_math()
   register_bindings_string()
   register_bindings_type()

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

@@ -1253,3 +1253,52 @@ test_that("`decimal_date()` and `date_decimal()`", {
     ignore_attr = "tzone"
   )
 })
+
+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")
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        dminutes = dminutes(x),
+        dhours = dhours(x),
+        ddays = ddays(x),
+        dweeks = dweeks(x),
+        dmonths = dmonths(x),
+        dyears = dyears(x)
+      ) %>%
+      collect(),
+    example_d,
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        dhours = dhours(x),
+        ddays = ddays(x),
+        new_date_1 = date_to_add + ddays,
+        new_date_2 = date_to_add + ddays - dhours(3),
+        new_duration = dhours - ddays
+      ) %>%
+      collect(),
+    example_d,
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        r_obj_dminutes = dminutes(1),
+        r_obj_dhours = dhours(2),
+        r_obj_ddays = ddays(3),
+        r_obj_dweeks = dweeks(4),
+        r_obj_dmonths = dmonths(5),
+        r_obj_dyears = dyears(6)
+      ) %>%
+      collect(),
+    tibble(),
+    ignore_attr = TRUE
+  )
+})