diff --git a/r/NEWS.md b/r/NEWS.md index 9083249a99b..eb5cd9a1554 100644 --- a/r/NEWS.md +++ b/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 diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 7657a79271b..a674a6402bd 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/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") diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R index b1ff505004b..a4c5ee3c224 100644 --- a/r/tests/testthat/test-dplyr-funcs-datetime.R +++ b/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()", {