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
+ )
+})