ARROW-14469: [R] Binding for lubridate::month() doesn't have label …

…argument implemented Closes #11575 from thisisnic/ARROW-14469_month_label Authored-by: Nic Crane <thisisnic@gmail.com> Signed-off-by: Nic Crane <thisisnic@gmail.com>
apache · Nov 10, 2021 · e216c2e · e216c2e
1 parent 575a437
commit e216c2e
Show file tree

Hide file tree

Showing 3 changed files with 61 additions and 1 deletion.
diff --git a/r/R/dplyr-functions.R b/r/R/dplyr-functions.R
@@ -838,6 +838,19 @@ nse_funcs$wday <- function(x,
   Expression$create("day_of_week", x, options = list(count_from_zero = FALSE, week_start = week_start))
 }
 
+nse_funcs$month <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) {
+  if (label) {
+    if (abbr) {
+      format <- "%b"
+    } else {
+      format <- "%B"
+    }
+    return(Expression$create("strftime", x, options = list(format = format, locale = locale)))
+  }
+
+  Expression$create("month", x)
+}
+
 nse_funcs$is.Date <- function(x) {
   inherits(x, "Date") ||
     (inherits(x, "Expression") && x$type_id() %in% Type[c("DATE32", "DATE64")])

diff --git a/r/R/expression.R b/r/R/expression.R
@@ -67,7 +67,6 @@
   "epiweek" = "us_week",
   "isoyear" = "iso_year",
   "minute" = "minute",
-  "month" = "month",
   "quarter" = "quarter",
   # second is defined in dplyr-functions.R
   # wday is defined in dplyr-functions.R

diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R
@@ -122,6 +122,25 @@ test_that("extract month from timestamp", {
       collect(),
     test_df
   )
+
+  skip_on_os("windows") # https://issues.apache.org/jira/browse/ARROW-13168
+
+  compare_dplyr_binding(
+    .input %>%
+      # R returns ordered factor whereas Arrow returns character
+      mutate(x = as.character(month(datetime, label = TRUE))) %>%
+      collect(),
+    test_df,
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(x = as.character(month(datetime, label = TRUE, abbr = TRUE))) %>%
+      collect(),
+    test_df,
+    ignore_attr = TRUE
+  )
 })
 
 test_that("extract isoweek from timestamp", {
@@ -286,6 +305,35 @@ test_that("extract epiweek from date", {
   )
 })
 
+test_that("extract month from date", {
+  compare_dplyr_binding(
+    .input %>%
+      mutate(x = month(date)) %>%
+      collect(),
+    test_df
+  )
+
+  skip_on_os("windows") # https://issues.apache.org/jira/browse/ARROW-13168
+
+  compare_dplyr_binding(
+    .input %>%
+      # R returns ordered factor whereas Arrow returns character
+      mutate(x = as.character(month(date, label = TRUE))) %>%
+      collect(),
+    test_df,
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(x = as.character(month(date, label = TRUE, abbr = TRUE))) %>%
+      collect(),
+    test_df,
+    ignore_attr = TRUE
+  )
+})
+
+
 test_that("extract day from date", {
   compare_dplyr_binding(
     .input %>%