ARROW-14815 [R] bindings for lubridate::semester()

r/NEWS.md

@@ -21,6 +21,7 @@
 
 * `lubridate`: 
   * `tz()` to extract/get timezone
+  * `semester()` to extract/get semester
 
 # arrow 7.0.0
 

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

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