From f2a612ffcd76e66b16ec6b1c3ad4b4dac611653e Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Fri, 11 Mar 2022 15:49:38 +0100 Subject: [PATCH 1/9] Add temporary implementation for ddays, ... --- r/R/dplyr-funcs-datetime.R | 30 +++++++++++++++++ r/tests/testthat/test-dplyr-funcs-datetime.R | 34 ++++++++++++++++++++ 2 files changed, 64 insertions(+) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 1ca485f56e1..95d63615bd5 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -197,6 +197,36 @@ register_bindings_datetime <- function() { register_binding("date", function(x) { build_expr("cast", x, options = list(to_type = date32())) }) + + register_binding("dminutes", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 60, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dhours", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 3600, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("ddays", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 86400, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dweeks", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 604800, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dmonths", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 2629800, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dyears", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 31557600, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) } register_bindings_duration <- function() { diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R index b9277c08c40..38ceb60715a 100644 --- a/r/tests/testthat/test-dplyr-funcs-datetime.R +++ b/r/tests/testthat/test-dplyr-funcs-datetime.R @@ -1253,3 +1253,37 @@ 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, + new_duration = dhours - ddays + ) %>% + collect(), + example_d, + ignore_attr = TRUE + ) +}) From ff9d7e2cda73852f1074ec5d47bb1d8505baa082 Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Tue, 5 Apr 2022 13:22:01 +0200 Subject: [PATCH 2/9] Linter corrections --- r/tests/testthat/test-dplyr-funcs-datetime.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R index 38ceb60715a..c9e1fbf000c 100644 --- a/r/tests/testthat/test-dplyr-funcs-datetime.R +++ b/r/tests/testthat/test-dplyr-funcs-datetime.R @@ -1259,7 +1259,7 @@ test_that("dminutes, dhours, ddays, dweeks, dmonths, dyears", { date_to_add <- ymd("2009-08-03", tz = "America/Chicago") compare_dplyr_binding( - .input%>% + .input %>% mutate( dminutes = dminutes(x), dhours = dhours(x), @@ -1274,7 +1274,7 @@ test_that("dminutes, dhours, ddays, dweeks, dmonths, dyears", { ) compare_dplyr_binding( - .input%>% + .input %>% mutate( dhours = dhours(x), ddays = ddays(x), From fc9c8f50ff7c9f188aa1214950617f36dd98b0e2 Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Tue, 5 Apr 2022 14:33:42 +0200 Subject: [PATCH 3/9] Move the bindings under register_bindings_duration and correct typo in var names --- r/R/dplyr-funcs-datetime.R | 59 +++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 30 deletions(-) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 95d63615bd5..70843d53646 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -197,36 +197,6 @@ register_bindings_datetime <- function() { register_binding("date", function(x) { build_expr("cast", x, options = list(to_type = date32())) }) - - register_binding("dminutes", function(x=1) { - ddays_int64 <- Expression$create("cast", x * 60, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) - }) - - register_binding("dhours", function(x=1) { - ddays_int64 <- Expression$create("cast", x * 3600, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) - }) - - register_binding("ddays", function(x=1) { - ddays_int64 <- Expression$create("cast", x * 86400, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) - }) - - register_binding("dweeks", function(x=1) { - ddays_int64 <- Expression$create("cast", x * 604800, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) - }) - - register_binding("dmonths", function(x=1) { - ddays_int64 <- Expression$create("cast", x * 2629800, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) - }) - - register_binding("dyears", function(x=1) { - ddays_int64 <- Expression$create("cast", x * 31557600, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) - }) } register_bindings_duration <- function() { @@ -381,6 +351,35 @@ register_bindings_duration <- function() { delta <- delta$cast(int64()) start + delta$cast(duration("s")) }) + register_binding("dminutes", function(x=1) { + dmin_int64 <- Expression$create("cast", x * 60, options = cast_options(to_type = int64())) + build_expr("cast", dmin_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dhours", function(x=1) { + dhours_int64 <- Expression$create("cast", x * 3600, options = cast_options(to_type = int64())) + build_expr("cast", dhours_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("ddays", function(x=1) { + ddays_int64 <- Expression$create("cast", x * 86400, options = cast_options(to_type = int64())) + build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dweeks", function(x=1) { + dweeks_int64 <- Expression$create("cast", x * 604800, options = cast_options(to_type = int64())) + build_expr("cast", dweeks_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dmonths", function(x=1) { + dmonths_int64 <- Expression$create("cast", x * 2629800, options = cast_options(to_type = int64())) + build_expr("cast", dmonths_int64, options = list(to_type = duration(unit = "s"))) + }) + + register_binding("dyears", function(x=1) { + dyears_int64 <- Expression$create("cast", x * 31557600, options = cast_options(to_type = int64())) + build_expr("cast", dyears_int64, options = list(to_type = duration(unit = "s"))) + }) } binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) { From 7c6d9b49dfaaaeb52004da8ffa86a125baa68dd9 Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Mon, 11 Apr 2022 06:31:16 +0200 Subject: [PATCH 4/9] Apply suggestions from code review Co-authored-by: Dewey Dunnington --- r/R/dplyr-funcs-datetime.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 70843d53646..dd1ea430193 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -323,6 +323,7 @@ register_bindings_duration <- function() { build_expr("cast", x, options = cast_options(to_type = duration(unit = "s"))) }) +<<<<<<< HEAD register_binding("decimal_date", function(date) { y <- build_expr("year", date) start <- call_binding("make_datetime", year = y, tz = "UTC") @@ -351,32 +352,32 @@ register_bindings_duration <- function() { delta <- delta$cast(int64()) start + delta$cast(duration("s")) }) - register_binding("dminutes", function(x=1) { + register_binding("dminutes", function(x = 1) { dmin_int64 <- Expression$create("cast", x * 60, options = cast_options(to_type = int64())) build_expr("cast", dmin_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dhours", function(x=1) { + register_binding("dhours", function(x = 1) { dhours_int64 <- Expression$create("cast", x * 3600, options = cast_options(to_type = int64())) build_expr("cast", dhours_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("ddays", function(x=1) { + register_binding("ddays", function(x = 1) { ddays_int64 <- Expression$create("cast", x * 86400, options = cast_options(to_type = int64())) build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dweeks", function(x=1) { + register_binding("dweeks", function(x = 1) { dweeks_int64 <- Expression$create("cast", x * 604800, options = cast_options(to_type = int64())) build_expr("cast", dweeks_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dmonths", function(x=1) { + register_binding("dmonths", function(x = 1) { dmonths_int64 <- Expression$create("cast", x * 2629800, options = cast_options(to_type = int64())) build_expr("cast", dmonths_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dyears", function(x=1) { + register_binding("dyears", function(x = 1) { dyears_int64 <- Expression$create("cast", x * 31557600, options = cast_options(to_type = int64())) build_expr("cast", dyears_int64, options = list(to_type = duration(unit = "s"))) }) From 4354ff608670c06864899e876392d2f3a1e956ef Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Tue, 12 Apr 2022 13:04:18 +0200 Subject: [PATCH 5/9] Add a check for argument not an Expression and amend the tests --- r/R/dplyr-funcs-datetime.R | 24 +++++++++++++++----- r/tests/testthat/test-dplyr-funcs-datetime.R | 17 +++++++++++++- 2 files changed, 34 insertions(+), 7 deletions(-) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index dd1ea430193..826efb61fa8 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -323,7 +323,6 @@ register_bindings_duration <- function() { build_expr("cast", x, options = cast_options(to_type = duration(unit = "s"))) }) -<<<<<<< HEAD register_binding("decimal_date", function(date) { y <- build_expr("year", date) start <- call_binding("make_datetime", year = y, tz = "UTC") @@ -353,31 +352,44 @@ register_bindings_duration <- function() { start + delta$cast(duration("s")) }) register_binding("dminutes", function(x = 1) { + if (!inherits(x, "Expression")) { + x <- Expression$scalar(x) + } dmin_int64 <- Expression$create("cast", x * 60, options = cast_options(to_type = int64())) build_expr("cast", dmin_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dhours", function(x = 1) { + if (!inherits(x, "Expression")) { + x <- Expression$scalar(x) + } dhours_int64 <- Expression$create("cast", x * 3600, options = cast_options(to_type = int64())) build_expr("cast", dhours_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("ddays", function(x = 1) { + if (!inherits(x, "Expression")) { + x <- Expression$scalar(x) + } ddays_int64 <- Expression$create("cast", x * 86400, options = cast_options(to_type = int64())) build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dweeks", function(x = 1) { + if (!inherits(x, "Expression")) { + x <- Expression$scalar(x) + } dweeks_int64 <- Expression$create("cast", x * 604800, options = cast_options(to_type = int64())) build_expr("cast", dweeks_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dmonths", function(x = 1) { + if (!inherits(x, "Expression")) { + x <- Expression$scalar(x) + } dmonths_int64 <- Expression$create("cast", x * 2629800, options = cast_options(to_type = int64())) build_expr("cast", dmonths_int64, options = list(to_type = duration(unit = "s"))) }) - register_binding("dyears", function(x = 1) { + if (!inherits(x, "Expression")) { + x <- Expression$scalar(x) + } dyears_int64 <- Expression$create("cast", x * 31557600, options = cast_options(to_type = int64())) build_expr("cast", dyears_int64, options = list(to_type = duration(unit = "s"))) }) diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R index c9e1fbf000c..79b922f6e24 100644 --- a/r/tests/testthat/test-dplyr-funcs-datetime.R +++ b/r/tests/testthat/test-dplyr-funcs-datetime.R @@ -1279,11 +1279,26 @@ test_that("dminutes, dhours, ddays, dweeks, dmonths, dyears", { dhours = dhours(x), ddays = ddays(x), new_date_1 = date_to_add + ddays, - new_date_2 = date_to_add + ddays - dhours, + 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 + ) }) From ef08c2d4fbdd1bf4af7af242b0ac1c83ea93fb8a Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Wed, 13 Apr 2022 13:37:18 +0200 Subject: [PATCH 6/9] CI Win error fix (cyclomatic complexity) --- r/R/dplyr-funcs-datetime.R | 3 +++ r/R/dplyr-funcs.R | 1 + 2 files changed, 4 insertions(+) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 826efb61fa8..a28ed113726 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -351,6 +351,9 @@ register_bindings_duration <- function() { delta <- delta$cast(int64()) start + delta$cast(duration("s")) }) +} + +register_bindings_duration_helpers <- function() { register_binding("dminutes", function(x = 1) { if (!inherits(x, "Expression")) { x <- Expression$scalar(x) diff --git a/r/R/dplyr-funcs.R b/r/R/dplyr-funcs.R index 01e522e537b..eaa6ed9dc67 100644 --- a/r/R/dplyr-funcs.R +++ b/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() From 2db206bb8ff39e54649ddeb09e8af58106b07404 Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Thu, 14 Apr 2022 10:34:06 +0200 Subject: [PATCH 7/9] Replace Expression() with build_expr() --- r/R/dplyr-funcs-datetime.R | 42 +++++++++++--------------------------- 1 file changed, 12 insertions(+), 30 deletions(-) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index a28ed113726..c926e3d407e 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -355,46 +355,28 @@ register_bindings_duration <- function() { register_bindings_duration_helpers <- function() { register_binding("dminutes", function(x = 1) { - if (!inherits(x, "Expression")) { - x <- Expression$scalar(x) - } - dmin_int64 <- Expression$create("cast", x * 60, options = cast_options(to_type = int64())) - build_expr("cast", dmin_int64, options = list(to_type = duration(unit = "s"))) + x <- build_expr("cast", x * 60, options = cast_options(to_type = int64())) + x$cast(duration("s")) }) register_binding("dhours", function(x = 1) { - if (!inherits(x, "Expression")) { - x <- Expression$scalar(x) - } - dhours_int64 <- Expression$create("cast", x * 3600, options = cast_options(to_type = int64())) - build_expr("cast", dhours_int64, options = list(to_type = duration(unit = "s"))) + x <- build_expr("cast", x * 3600, options = cast_options(to_type = int64())) + x$cast(duration("s")) }) register_binding("ddays", function(x = 1) { - if (!inherits(x, "Expression")) { - x <- Expression$scalar(x) - } - ddays_int64 <- Expression$create("cast", x * 86400, options = cast_options(to_type = int64())) - build_expr("cast", ddays_int64, options = list(to_type = duration(unit = "s"))) + x <- build_expr("cast", x * 86400, options = cast_options(to_type = int64())) + x$cast(duration("s")) }) register_binding("dweeks", function(x = 1) { - if (!inherits(x, "Expression")) { - x <- Expression$scalar(x) - } - dweeks_int64 <- Expression$create("cast", x * 604800, options = cast_options(to_type = int64())) - build_expr("cast", dweeks_int64, options = list(to_type = duration(unit = "s"))) + x <- build_expr("cast", x * 604800, options = cast_options(to_type = int64())) + x$cast(duration("s")) }) register_binding("dmonths", function(x = 1) { - if (!inherits(x, "Expression")) { - x <- Expression$scalar(x) - } - dmonths_int64 <- Expression$create("cast", x * 2629800, options = cast_options(to_type = int64())) - build_expr("cast", dmonths_int64, options = list(to_type = duration(unit = "s"))) + x <- build_expr("cast", x * 2629800, options = cast_options(to_type = int64())) + x$cast(duration("s")) }) register_binding("dyears", function(x = 1) { - if (!inherits(x, "Expression")) { - x <- Expression$scalar(x) - } - dyears_int64 <- Expression$create("cast", x * 31557600, options = cast_options(to_type = int64())) - build_expr("cast", dyears_int64, options = list(to_type = duration(unit = "s"))) + x <- build_expr("cast", x * 31557600, options = cast_options(to_type = int64())) + x$cast(duration("s")) }) } From 28ff00b02720daa95a51ad0a6898354faef4fbb4 Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Thu, 14 Apr 2022 10:45:00 +0200 Subject: [PATCH 8/9] Add a helper function to avoid repetition --- r/R/dplyr-funcs-datetime.R | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index c926e3d407e..9e821338140 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -354,29 +354,27 @@ register_bindings_duration <- function() { } register_bindings_duration_helpers <- function() { + make_duration <- function(x, unit) { + x <- build_expr("cast", x, options = cast_options(to_type = int64())) + x$cast(duration(unit)) + } register_binding("dminutes", function(x = 1) { - x <- build_expr("cast", x * 60, options = cast_options(to_type = int64())) - x$cast(duration("s")) + make_duration(x * 60, "s") }) register_binding("dhours", function(x = 1) { - x <- build_expr("cast", x * 3600, options = cast_options(to_type = int64())) - x$cast(duration("s")) + make_duration(x * 3600, "s") }) register_binding("ddays", function(x = 1) { - x <- build_expr("cast", x * 86400, options = cast_options(to_type = int64())) - x$cast(duration("s")) + make_duration(x * 86400, "s") }) register_binding("dweeks", function(x = 1) { - x <- build_expr("cast", x * 604800, options = cast_options(to_type = int64())) - x$cast(duration("s")) + make_duration(x * 604800, "s") }) register_binding("dmonths", function(x = 1) { - x <- build_expr("cast", x * 2629800, options = cast_options(to_type = int64())) - x$cast(duration("s")) + make_duration(x * 2629800, "s") }) register_binding("dyears", function(x = 1) { - x <- build_expr("cast", x * 31557600, options = cast_options(to_type = int64())) - x$cast(duration("s")) + make_duration(x * 31557600, "s") }) } From 0ee2ff41c638b7cf0d891c6d26c89874d234f4dc Mon Sep 17 00:00:00 2001 From: Alenka Frim Date: Thu, 14 Apr 2022 11:12:04 +0200 Subject: [PATCH 9/9] Make make_duration a standalone function --- r/R/dplyr-funcs-datetime.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 9e821338140..3b03477cc81 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -353,11 +353,11 @@ 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() { - make_duration <- function(x, unit) { - x <- build_expr("cast", x, options = cast_options(to_type = int64())) - x$cast(duration(unit)) - } register_binding("dminutes", function(x = 1) { make_duration(x * 60, "s") })