ARROW-14848: [R] Implement bindings for lubridate's parse_date_time

r/NEWS.md

@@ -27,6 +27,7 @@
 * date-time functionality:
   * Added `difftime` and `as.difftime()` 
   * Added `as.Date()` to convert to date
+  * Added `parse_date_time()` & `fast_strptime()` datetime parsers
 * `median()` and `quantile()` will warn once about approximate calculations regardless of interactivity.
 
 # arrow 7.0.0

r/R/dplyr-funcs-datetime.R

@@ -351,6 +351,62 @@ register_bindings_duration <- function() {
     delta <- delta$cast(int64())
     start + delta$cast(duration("s"))
   })
+  register_binding("fast_strptime", function(x,
+                                             format,
+                                             tz = "UTC",
+                                             lt = TRUE,
+                                             cutoff_2000 = 68L,
+                                             unit = "s") {
+    # TODO support multiple formats once
+    # https://issues.apache.org/jira/browse/ARROW-15665 is done
+    if (length(format) > 1) {
+      arrow_not_supported("multiple values for `format`")
+    }
+
+    if (!missing(tz)) {
+      arrow_not_supported("Time zone argument")
+    }
+    # `lt` controls the output `lt = TRUE` returns a POSIXlt (which doesn't play
+    # well with mutate, for example)
+    if (lt) {
+      arrow_not_supported("`lt = TRUE` argument")
+    }
+
+    if (cutoff_2000 != 68L) {
+      arrow_not_supported("`cutoff_2000` != 68L argument")
+    }
+
+    unit <- make_valid_time_unit(unit, c(valid_time64_units, valid_time32_units))
+
+    build_expr("strptime", x, options = list(format = format, unit = unit))
+  })
+  register_binding("parse_date_time", function(x,
+                                               orders,
+                                               tz = "UTC") {
+
+    # make all separators (non-letters and non-numbers) into "-"
+    x <- call_binding("gsub", "[^A-Za-z0-9]", "-", x)
+    # collapse multiple separators into a single one
+    x <- call_binding("gsub", "-{2,}", "-", x)
+
+    # TODO figure out how to parse strings that have no separators)
+    # we could insert separators at the "likely" positions, but it might be
+    # tricky given the possible combinations between dmy formats + locale
+
+    # each order is translated into 6 possible formats
+    formats <- build_formats(orders)
+    coalesce_output <- build_expr(
+      "coalesce",
+      build_expr("strptime", x, options = list(format = formats[1], unit = 0L, error_is_null = TRUE)),
+      build_expr("strptime", x, options = list(format = formats[2], unit = 0L, error_is_null = TRUE)),
+      build_expr("strptime", x, options = list(format = formats[3], unit = 0L, error_is_null = TRUE)),
+      build_expr("strptime", x, options = list(format = formats[4], unit = 0L, error_is_null = TRUE)),
+      build_expr("strptime", x, options = list(format = formats[5], unit = 0L, error_is_null = TRUE)),
+      build_expr("strptime", x, options = list(format = formats[6], unit = 0L, error_is_null = TRUE))
+    )
+
+    build_expr("assume_timezone", coalesce_output, options = list(timezone = tz))
+  })
 }
 
 binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {
@@ -372,3 +428,27 @@ binding_format_datetime <- function(x, format = "", tz = "", usetz = FALSE) {
 
   build_expr("strftime", x, options = list(format = format, locale = Sys.getlocale("LC_TIME")))
 }
+
+build_formats <- function(orders) {
+  year_chars <- sprintf("%%%s", c("y", "Y"))
+  month_chars <- sprintf("%%%s", c("m", "B", "b"))
+  day_chars <- sprintf("%%%s", c("d"))
+
+  outcome <- switch(
+    orders,
+    "ymd" = expand.grid(year_chars, month_chars, day_chars),
+    "ydm" = expand.grid(year_chars, day_chars, month_chars),
+    "mdy" = expand.grid(month_chars, day_chars, year_chars),
+    "myd" = expand.grid(month_chars, year_chars, day_chars),
+    "dmy" = expand.grid(day_chars, month_chars, year_chars),
+    "dym" = expand.grid(day_chars, year_chars, month_chars)
+  )
+  outcome$format <- paste(outcome$Var1, outcome$Var2, outcome$Var3, sep = "-")
+  outcome$format
+}
+
+instert_at_position <- function(string, positions, replacement) {
+  if (positions < 0) {
+    pattern <- paste0("^(.{", nchar(string) - positions, "})(.*)$")
+  }
+}

r/tests/testthat/test-dplyr-funcs-datetime.R

@@ -1253,3 +1253,149 @@ test_that("`decimal_date()` and `date_decimal()`", {
     ignore_attr = "tzone"
   )
 })
+
+test_that("parse_date_time()", {
+  test_df <- tibble(
+    dates = c("09-01-17", "02-Sep-17")
+  )
+
+  test_dates <- tibble::tibble(
+    string_ymd = c(
+      "2021-09-1", "2021/09///2", "2021.09.03", "2021,09,4", "2021:09::5",
+      "2021 09   6", "21-09-07", "21/09/08", "21.09.9", "21,09,10",
+      "21:09:11", "2021 Sep 12", "2021 September 13", "21 Sep 14",
+      "21 September 15",
+      # not yet working for strings with no separators, like "20210917", "210918" or "2021Sep19
+      # no separators and %b or %B are even more complicated (and they work in
+      # lubridate). not to mention locale
+      NA
+    ),
+    string_dmy = c(
+      "1-09-2021", "2/09//2021", "03.09.2021", "04,09,2021", "5:::09:2021",
+      "6  09  2021", "07-09-21", "08/09/21", "9.09.21", "10,09,21", "11:09:21",
+      "12 Sep 2021", "13 September 2021", "14 Sep 21", "15 September 21",
+      # not yet working for strings with no separators, like "10092021", "100921",
+      NA
+    ),
+    string_mdy = c(
+      "09-01-2021", "09/2/2021", "09.3.2021", "09,04,2021", "09:05:2021",
+      "09 6 2021", "09-7-21", "09/08/21", "09.9.21", "09,10,21", "09:11:21",
+      "Sep 12 2021", "September 13 2021", "Sep 14 21", "September 15 21",
+      # not yet working for strings with no separators, like "09102021", "091021",
+      NA
+    )
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        parsed_date_ymd = parse_date_time(string_ymd, orders = "ymd"),
+        parsed_date_dmy = parse_date_time(string_dmy, orders = "dmy"),
+        parsed_date_mdy = parse_date_time(string_mdy, orders = "mdy")
+      ) %>%
+      collect(),
+    test_dates
+  )
+})
+
+test_that("lubridate's fast_strptime", {
+  t_string <- tibble(x = c("2018-10-07 19:04:05", NA))
+  t_string_y <- tibble(x = c("68-10-07 19:04:05", "69-10-07 19:04:05", NA))
+  t_string_2formats <- tibble(x = c("2018-10-07 19:04:05", "68-10-07 19:04:05"))
+  t_stamp <- tibble(x = c(lubridate::ymd_hms("2018-10-07 19:04:05"), NA))
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(y = fast_strptime(x, format = "%Y-%m-%d %H:%M:%S", lt = FALSE)) %>%
+      collect(),
+    t_string,
+    # arrow does not preserve the `tzone` attribute
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(y =
+               fast_strptime("68-10-07 19:04:05", format = "%y-%m-%d %H:%M:%S", lt = FALSE)
+      ) %>%
+      collect(),
+    t_string,
+    ignore_attr = TRUE
+  )
+
+  # fast_strptime()'s `cutoff_2000` argument is not supported, but its value is
+  # implicitly set to 68L both in base R and in Arrow
+  compare_dplyr_binding(
+    .input %>%
+      mutate(date_short_year = fast_strptime(x, format = "%y-%m-%d %H:%M:%S", lt = FALSE)) %>%
+      collect(),
+    t_string_y,
+    # arrow does not preserve the `tzone` attribute
+    ignore_attr = TRUE
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        date_short_year =
+          fast_strptime(x, format = "%y-%m-%d %H:%M:%S", lt = FALSE, cutoff_2000 = 69L)
+      ) %>%
+      collect(),
+    t_string_y,
+    warning = TRUE
+  )
+
+  formats <- c("%Y-%m-%d %H:%M:%S", "%y-%m-%d %H:%M:%S")
+  compare_dplyr_binding(
+    .input %>%
+      mutate(date_multi_formats =
+               fast_strptime(x, format = formats, lt = FALSE)) %>%
+      collect(),
+    t_string_2formats,
+    warning = TRUE
+  )
+})
+
+test_that("parse_date_time()", {
+  test_df <- tibble(
+    dates = c("09-01-17", "02-Sep-17")
+  )
+
+  test_dates <- tibble::tibble(
+    string_ymd = c(
+      "2021-09-1", "2021/09///2", "2021.09.03", "2021,09,4", "2021:09::5",
+      "2021 09   6", "21-09-07", "21/09/08", "21.09.9", "21,09,10",
+      "21:09:11", "2021 Sep 12", "2021 September 13", "21 Sep 14",
+      "21 September 15",
+      # not yet working for strings with no separators, like "20210917", "210918" or "2021Sep19
+      # no separators and %b or %B are even more complicated (and they work in
+      # lubridate). not to mention locale
+      NA
+    ),
+    string_dmy = c(
+      "1-09-2021", "2/09//2021", "03.09.2021", "04,09,2021", "5:::09:2021",
+      "6  09  2021", "07-09-21", "08/09/21", "9.09.21", "10,09,21", "11:09:21",
+      "12 Sep 2021", "13 September 2021", "14 Sep 21", "15 September 21",
+      # not yet working for strings with no separators, like "10092021", "100921",
+      NA
+    ),
+    string_mdy = c(
+      "09-01-2021", "09/2/2021", "09.3.2021", "09,04,2021", "09:05:2021",
+      "09 6 2021", "09-7-21", "09/08/21", "09.9.21", "09,10,21", "09:11:21",
+      "Sep 12 2021", "September 13 2021", "Sep 14 21", "September 15 21",
+      # not yet working for strings with no separators, like "09102021", "091021",
+      NA
+    )
+  )
+
+  compare_dplyr_binding(
+    .input %>%
+      mutate(
+        parsed_date_ymd = parse_date_time(string_ymd, orders = "ymd"),
+        parsed_date_dmy = parse_date_time(string_dmy, orders = "dmy"),
+        parsed_date_mdy = parse_date_time(string_mdy, orders = "mdy")
+      ) %>%
+      collect(),
+    test_dates
+  )
+})