GH-47257: [R] Fix truncation of time variables to work with numeric subseconds time with hms bindings (#47278)

### Rationale for this change

Subsecond times truncated

### What changes are included in this PR?

Work with times as milliseconds

### Are these changes tested?

Yes

### Are there any user-facing changes?

Yes
* GitHub Issue: #47257

Authored-by: Nic Crane <[email protected]>
Signed-off-by: Nic Crane <[email protected]>

Author: thisisnic

r/R/dplyr-funcs-datetime.R

@@ -831,7 +831,7 @@ register_bindings_datetime_rounding <- function() {
 register_bindings_hms <- function() {
   numeric_to_time32 <- function(x) {
     # The only numeric which can be cast to time32 is int32 so double cast to make sure
-    cast(cast(x, int32()), time32(unit = "s"))
+    cast(cast(x, int32()), time32(unit = "ms"))
   }
 
   datetime_to_time32 <- function(datetime) {
@@ -850,14 +850,14 @@ register_bindings_hms <- function() {
         abort("All arguments must be numeric or NA_real_")
       }
 
-      total_secs <- seconds +
-        Expression$create("multiply_checked", minutes, 60) +
-        Expression$create("multiply_checked", hours, 3600) +
-        Expression$create("multiply_checked", days, 86400)
+      total_ms <- Expression$create("multiply_checked", seconds, 1000) +
+        Expression$create("multiply_checked", minutes, 60000) +
+        Expression$create("multiply_checked", hours, 3600000) +
+        Expression$create("multiply_checked", days, 86400000)
 
-      return(numeric_to_time32(total_secs))
+      return(numeric_to_time32(total_ms))
     },
-    notes = "subsecond times not supported"
+    notes = "nanosecond times not supported"
   )
 
   register_binding(
@@ -868,20 +868,22 @@ register_bindings_hms <- function() {
       }
 
       if (call_binding("is.numeric", x)) {
-        return(numeric_to_time32(x))
+        return(numeric_to_time32(Expression$create("multiply_checked", x, 1000)))
       }
 
       if (call_binding("is.character", x)) {
-        dash <- call_binding("gsub", ":", "-", x)
-        as_date_time_string <- call_binding("str_c", "1970-01-01", dash, sep = "-")
-        as_date_time <- Expression$create(
+        # Parse time strings using strptime with a time format
+        # Since strptime expects full datetime strings, we need to prefix with a dummy date
+        # Note: Arrow's strptime doesn't support subsecond precision for time parsing
+        prefixed_string <- call_binding("str_c", "1970-01-01 ", x)
+        parsed_datetime <- Expression$create(
           "strptime",
-          as_date_time_string,
-          options = list(format = "%Y-%m-%d-%H-%M-%S", unit = 0L)
+          prefixed_string,
+          options = list(format = "%Y-%m-%d %H:%M:%S", unit = 3L)
         )
-        return(datetime_to_time32(as_date_time))
+        return(datetime_to_time32(parsed_datetime))
       }
     },
-    notes = "subsecond times not supported"
+    notes = "subsecond precision not supported for character input"
   )
 }

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

@@ -3769,28 +3769,38 @@ test_that("hms::hms", {
 test_that("hms::as_hms", {
   test_df <- tibble(
     hms_string = c("0:7:45", "12:34:56"),
+    hms_subsec_string = c("0:7:45.1234", "12:34:56.12345"),
     int = c(30L, 75L),
     integerish_dbl = c(31, 76),
     dbl = c(31.2, 76.4),
-    datetime = as.POSIXct(c(1645243500, 1745243500), tz = "UTC", origin = "1970-01-01")
+    nanosecs = c(31.21234564, 76.412345),
+    datetime = as.POSIXct(c(1645243500.123, 1745243500.123), tz = "UTC", origin = "1970-01-01")
   )
 
   compare_dplyr_binding(
     .input %>%
       mutate(
-        x2 = hms::as_hms(int),
-        x3 = hms::as_hms(integerish_dbl),
+        x1 = hms::as_hms(int),
+        x2 = hms::as_hms(integerish_dbl),
+        x3 = hms::as_hms(dbl),
         x4 = hms::as_hms(datetime)
       ) %>%
       collect(),
     test_df
   )
 
+  # can only do millisecond precision
   expect_error(
-    arrow_table(test_df) %>% mutate(y = hms::as_hms(dbl)) %>% collect(),
+    arrow_table(test_df) %>% mutate(y = hms::as_hms(nanosecs)) %>% collect(),
     "was truncated converting to int32"
   )
 
+  # no subsecond precision with character strings
+  expect_error(
+    arrow_table(test_df) %>% mutate(y = hms::as_hms(hms_subsec_string)) %>% collect(),
+    "Failed to parse string"
+  )
+
   skip_if_not_available("utf8proc")
 
   compare_dplyr_binding(