ARROW-16407: [R] Extend parse_date_time to cover hour, dates, and minutes components

r/NEWS.md

@@ -20,8 +20,7 @@
 # arrow 8.0.0.9000
 
 * `lubridate::parse_date_time()` datetime parser:
-  * currently parses only `orders` with year, month, and day components. In a future release `orders` support for other datetime components (such as hours, minutes, seconds, etc) will be added.
-  * strings with no separators (e.g. `"20210917"`) could be ambiguous and are not yet supported.
+  * `orders` with year, month, day, hours, minutes, and seconds components are supported.
   * the `orders` argument in the Arrow binding works as follows: `orders` are transformed into `formats` which subsequently get applied in turn. There is no `select_formats` parameter and no inference takes place (like is the case in `lubridate::parse_date_time()`).
 
 # arrow 8.0.0

r/R/dplyr-datetime-helpers.R

@@ -152,11 +152,24 @@ binding_as_date_numeric <- function(x, origin = "1970-01-01") {
   x
 }
 
+#' Build formats from multiple orders
+#'
+#' This function is a vectorised version of `build_format_from_order()`. In
+#' addition to `build_format_from_order()`, it also checks if the supplied
+#' orders are currently supported.
+#'
+#' @inheritParams process_data_for_parsing
+#'
+#' @return a vector of unique formats
+#'
+#' @noRd
 build_formats <- function(orders) {
   # only keep the letters and the underscore as separator -> allow the users to
-  # pass strptime-like formats (with "%"). Processing is needed (instead of passing
+  # pass strptime-like formats (with "%"). We process the data -> we need to
+  # process the `orders` (even if supplied in the desired format)
+  # Processing is needed (instead of passing
   # formats as-is) due to the processing of the character vector in parse_date_time()
-  orders <- gsub("[^A-Za-z_]", "", orders)
+  orders <- gsub("[^A-Za-z]", "", orders)
   orders <- gsub("Y", "y", orders)
 
   # we separate "ym', "my", and "yq" from the rest of the `orders` vector and
@@ -170,7 +183,7 @@ build_formats <- function(orders) {
     orders1 <- setdiff(orders, short_orders)
     orders2 <- intersect(orders, short_orders)
     orders2 <- paste0(orders2, "d")
-    orders <- unique(c(orders1, orders2))
+    orders <- unique(c(orders2, orders1))
   }
 
   if (any(orders == "yq")) {
@@ -179,7 +192,30 @@ build_formats <- function(orders) {
     orders <- unique(c(orders1, orders2))
   }
 
-  supported_orders <- c("ymd", "ydm", "mdy", "myd", "dmy", "dym")
+  if (any(orders == "qy")) {
+    orders1 <- setdiff(orders, "qy")
+    orders2 <- "ymd"
+    orders <- unique(c(orders1, orders2))
+  }
+
+  ymd_orders <- c("ymd", "ydm", "mdy", "myd", "dmy", "dym")
+  ymd_hms_orders <- c(
+    "ymd_HMS", "ymd_HM", "ymd_H", "dmy_HMS", "dmy_HM", "dmy_H", "mdy_HMS",
+    "mdy_HM", "mdy_H", "ydm_HMS", "ydm_HM", "ydm_H"
+  )
+  # support "%I" hour formats
+  ymd_ims_orders <- gsub("H", "I", ymd_hms_orders)
+
+  supported_orders <- c(
+    ymd_orders,
+    ymd_hms_orders,
+    gsub("_", " ", ymd_hms_orders), # allow "_", " " and "" as order separators
+    gsub("_", "", ymd_hms_orders),
+    ymd_ims_orders,
+    gsub("_", " ", ymd_ims_orders), # allow "_", " " and "" as order separators
+    gsub("_", "", ymd_ims_orders)
+  )
+
   unsupported_passed_orders <- setdiff(orders, supported_orders)
   supported_passed_orders <- intersect(orders, supported_orders)
 
@@ -200,20 +236,191 @@ build_formats <- function(orders) {
   unique(formats)
 }
 
+#' Build formats from a single order
+#'
+#' @param order a single string date-time format, such as `"ymd"` or `"ymd_hms"`
+#'
+#' @return a vector of all possible formats derived from the input
+#' order
+#'
+#' @noRd
 build_format_from_order <- function(order) {
-  year_chars <- c("%y", "%Y")
-  month_chars <- c("%m", "%B", "%b")
-  day_chars <- "%d"
-
-  outcome <- switch(
-    order,
-    "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)
+  char_list <- list(
+    "y" = c("%y", "%Y"),
+    "m" = c("%m", "%B", "%b"),
+    "d" = "%d",
+    "H" = "%H",
+    "M" = "%M",
+    "S" = "%S",
+    "I" = "%I"
+  )
+
+  split_order <- strsplit(order, split = "")[[1]]
+
+  outcome <- expand.grid(char_list[split_order])
+  # we combine formats with and without the "-" separator, we will later
+  # coalesce through all of them (benchmarking indicated this is a more
+  # computationally efficient approach rather than figuring out if a string has
+  # separators or not and applying only )
+  # during parsing if the string to be parsed does not contain a separator
+  formats_with_sep <- do.call(paste, c(outcome, sep = "-"))
+  formats_without_sep <- do.call(paste, c(outcome, sep = ""))
+  c(formats_with_sep, formats_without_sep)
+}
+
+#' Process data in preparation for parsing
+#'
+#' `process_data_for_parsing()` takes a data column and a vector of `orders` and
+#' prepares several versions of the input data:
+#'   * `processed_x` is a version of `x` where all separators were replaced with
+#'  `"-"` and multiple separators were collapsed into a single one. This element
+#'  is only set to an empty list when the `orders` argument indicate we're only
+#'  interested in parsing the augmented version of `x`.
+#'  * each of the other 3 elements augment `x` in some way
+#'    * `augmented_x_ym` - builds the `ym` and `my` formats by adding `"01"`
+#'    (to indicate the first day of the month)
+#'    * `augmented_x_yq` - transforms the `yq` format to `ymd`, by deriving the
+#'    first month of the quarter and adding `"01"` to indicate the first day
+#'    * `augmented_x_qy` - transforms the `qy` format to `ymd` in a similar
+#'    manner to `"yq"`
+#'
+#' @param x an Expression corresponding to a character or numeric vector of
+#' dates to be parsed.
+#' @param orders a character vector of date-time formats.
+#'
+#' @return a list made up of 4 lists, each a different version of x:
+#'  * `processed_x`
+#'  * `augmented_x_ym`
+#'  * `augmented_x_yq`
+#'  * `augmented_x_qy`
+#' @noRd
+process_data_for_parsing <- function(x, orders) {
+
+  processed_x <- x$cast(string())
+
+  # make all separators (non-letters and non-numbers) into "-"
+  processed_x <- call_binding("gsub", "[^A-Za-z0-9]", "-", processed_x)
+  # collapse multiple separators into a single one
+  processed_x <- call_binding("gsub", "-{2,}", "-", processed_x)
+
+  # we need to transform `x` when orders are `ym`, `my`, and `yq`
+  # for `ym` and `my` orders we add a day ("01")
+  # TODO revisit after https://issues.apache.org/jira/browse/ARROW-16627
+  augmented_x_ym <- NULL
+  if (any(orders %in% c("ym", "my", "Ym", "mY"))) {
+    # add day as "-01" if there is a "-" separator and as "01" if not
+    augmented_x_ym <- call_binding(
+      "if_else",
+      call_binding("grepl", "-", processed_x),
+      call_binding("paste0", processed_x, "-01"),
+      call_binding("paste0", processed_x, "01")
+    )
+  }
+
+  # for `yq` we need to transform the quarter into the start month (lubridate
+  # behaviour) and then add 01 to parse to the first day of the quarter
+  augmented_x_yq <- NULL
+  if (any(orders %in% c("yq", "Yq"))) {
+    # extract everything that comes after the `-` separator, i.e. the quarter
+    # (e.g. 4 from 2022-4)
+    quarter_x <- call_binding("gsub", "^.*?-", "", processed_x)
+    # we should probably error if quarter is not in 1:4
+    # extract everything that comes before the `-`, i.e. the year (e.g. 2002
+    # in 2002-4)
+    year_x <- call_binding("gsub", "-.*$", "", processed_x)
+    quarter_x <- quarter_x$cast(int32())
+    month_x <- (quarter_x - 1) * 3 + 1
+    augmented_x_yq <- call_binding("paste0", year_x, "-", month_x, "-01")
+  }
+
+  # same as for `yq`, we need to derive the month from the quarter and add a
+  # "01" to give us the first day of the month
+  augmented_x_qy <- NULL
+  if (any(orders %in% c("qy", "qY"))) {
+    quarter_x <- call_binding("gsub", "-.*$", "", processed_x)
+    quarter_x <- quarter_x$cast(int32())
+    year_x <- call_binding("gsub", "^.*?-", "", processed_x)
+    # year might be missing the final 0s when extracted from a float, hence the
+    # need to pad
+    year_x <- call_binding("str_pad", year_x, width = 4, side = "right", pad = "0")
+    month_x <- (quarter_x - 1) * 3 + 1
+    augmented_x_qy <- call_binding("paste0", year_x, "-", month_x, "-01")
+  }
+
+  list(
+    "augmented_x_ym" = augmented_x_ym,
+    "augmented_x_yq" = augmented_x_yq,
+    "augmented_x_qy" = augmented_x_qy,
+    "processed_x" = processed_x
+  )
+}
+
+
+#' Attempt parsing
+#'
+#' This function does several things:
+#'   * builds all possible `formats` from the supplied `orders`
+#'   * processes the data with `process_data_for_parsing()`
+#'   * build a list of the possible `strptime` Expressions for the data & formats
+#'   combinations
+#'
+#' @inheritParams process_data_for_parsing
+#'
+#' @return a list of `strptime` Expressions we can use with `coalesce`
+#' @noRd
+attempt_parsing <- function(x, orders) {
+  # translate orders into possible formats
+  formats <- build_formats(orders)
+
+  # depending on the orders argument we need to do some processing to the input
+  # data. `process_data_for_parsing()` uses the passed `orders` and not the
+  # derived `formats`
+  processed_data <- process_data_for_parsing(x, orders)
+
+  # build a list of expressions for parsing each processed_data element and
+  # format combination
+  parse_attempt_exprs_list <- map(processed_data, build_strptime_exprs, formats)
+
+  # if all orders are in c("ym", "my", "yq", "qy") only attempt to parse the
+  # augmented version(s) of x
+  if (all(orders %in% c("ym", "Ym", "my", "mY", "yq", "Yq", "qy", "qY"))) {
+    parse_attempt_exprs_list$processed_x <- list()
+  }
+
+  # we need the output to be a list of expressions (currently it is a list of
+  # lists of expressions due to the shape of the processed data. we have one list
+  # of expressions for each element of/ list in processed_data) -> we need to
+  # remove a level of hierarchy from the list
+  purrr::flatten(parse_attempt_exprs_list)
+}
+
+#' Build `strptime` expressions
+#'
+#' This function takes several `formats`, iterates over them and builds a
+#' `strptime` Expression for each of them. Given these Expressions are evaluated
+#' row-wise we can leverage this behaviour and introduce a condition. If `x` has
+#' a separator, use the `format` as is, if it doesn't have a separator, remove
+#' the `"-"` separator from the `format`.
+#'
+#' @param x an Expression corresponding to a character or numeric vector of
+#' dates to be parsed.
+#' @param formats a character vector of formats as returned by
+#' `build_format_from_order`
+#'
+#' @return a list of Expressions
+#' @noRd
+build_strptime_exprs <- function(x, formats) {
+  # returning an empty list helps when iterating
+  if (is.null(x)) {
+    return(list())
+  }
+
+  map(
+    formats,
+    ~ build_expr(
+      "strptime",
+      x,
+      options = list(format = .x, unit = 0L, error_is_null = TRUE)
+    )
   )
-  outcome$format <- paste(outcome$Var1, outcome$Var2, outcome$Var3, sep = "-")
-  outcome$format
 }