diff --git a/r/NEWS.md b/r/NEWS.md index e69d46275fe..20cae164445 100644 --- a/r/NEWS.md +++ b/r/NEWS.md @@ -21,6 +21,7 @@ * `lubridate`: * `tz()` to extract/get timezone + * `semester()` to extract/get semester # arrow 7.0.0 diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index d9bfcbd7e3e..a72df4c777a 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -154,4 +154,14 @@ register_bindings_datetime <- function() { x$type()$timezone() }) + register_binding("semester", function(x, with_year = FALSE) { + month <- call_binding("month", x) + semester <- call_binding("if_else", month <= 6, 1L, 2L) + if (with_year) { + year <- call_binding("year", x) + return(year + semester / 10) + } else { + return(semester) + } + }) } diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R index e3092f3455c..c5de2684c02 100644 --- a/r/tests/testthat/test-dplyr-funcs-datetime.R +++ b/r/tests/testthat/test-dplyr-funcs-datetime.R @@ -744,8 +744,45 @@ test_that("extract tz", { ) # Test one expression + expect_error( + call_binding("tz", Expression$scalar("2020-10-01")), + "timezone extraction for objects of class `string` not supported in Arrow" + ) +}) + +test_that("semester works with temporal types and integers", { + test_df <- tibble( + month_as_int = c(1:12, NA), + month_as_char_pad = sprintf("%02i", month_as_int), + dates = as.Date(paste0("2021-", month_as_char_pad, "-15")) + ) + + # semester extraction from dates + compare_dplyr_binding( + .input %>% + mutate(sem_wo_year = semester(dates), + sem_w_year = semester(dates, with_year = TRUE)) %>% + collect(), + test_df + ) + # semester extraction from months as integers is not supported yet + # it will be once https://issues.apache.org/jira/browse/ARROW-15701 is done + # TODO change from expect_error to compare_dplyr_bindings expect_error( - call_binding("tz", Expression$scalar("2020-10-01")), - "timezone extraction for objects of class `string` not supported in Arrow" + test_df %>% + arrow_table() %>% + mutate(sem_month_as_int = semester(month_as_int)) %>% + collect(), + regexp = "NotImplemented: Function 'month' has no kernel matching input types (array[int32])", + fixed = TRUE + ) + + expect_error( + test_df %>% + arrow_table() %>% + mutate(sem_month_as_char_pad = semester(month_as_char_pad)) %>% + collect(), + regexp = "NotImplemented: Function 'month' has no kernel matching input types (array[string])", + fixed = TRUE ) })