r - How to round datetime to nearest time of day, preferably vectorized?

Question

Say I have a POSIXct vector like

timestamps = seq(as.POSIXct("2021-01-23"), as.POSIXct("2021-01-24"), length.out = 6)

I would like to round these times up to the nearest hour of the day in a vector:

hours_of_day = c(6, 14, 20)

i.e., the following result:

           timestamps              result
1 2021-01-23 00:00:00 2021-01-23 02:00:00
2 2021-01-23 04:48:00 2021-01-23 14:00:00
3 2021-01-23 09:36:00 2021-01-23 14:00:00
4 2021-01-23 14:24:00 2021-01-23 20:00:00
5 2021-01-23 19:12:00 2021-01-23 20:00:00
6 2021-01-24 00:00:00 2021-01-24 02:00:00

Is there a vectorized solution to this (or otherwise fast)? I have a few million timestamps and need to apply it for several hours_of_day.

One way to simplify this problem is to (1) find the next hours_of_day for each lubridate::hour(timestamps) and then (2) result = lubridate::floor_date(timestamps) + next_hour_of_day * 3600. But how to do step 1 vectorized?

question from:https://stackoverflow.com/questions/65887284/how-to-round-datetime-to-nearest-time-of-day-preferably-vectorized

Answer 1

Convert to as.POSIXlt, which allows you to extract hours and minutes, and calculate decimal hours. In an lapply/sapply combination first look up where these are less than the hours of the day vector, and choose the maximum hour using which.max. Now create new date-time using ISOdate and add one day ifelse date-time is smaller than original time.

timestamps <- as.POSIXlt(timestamps)

h <- hours_of_day[sapply(lapply(with(timestamps, hour + min/60 + sec/3600), 
                                `<=`, hours_of_day), which.max)]
r <- with(timestamps, ISOdate(1900 + year, mon + 1, mday, h,
                              tz=attr(timestamps, "tzone")[[1]]))
r[r < timestamps] <- r[r < timestamps] + 86400

Result

r
# [1] "2021-01-23 06:00:00 CET" "2021-01-23 06:00:00 CET"
# [3] "2021-01-23 14:00:00 CET" "2021-01-23 20:00:00 CET"
# [5] "2021-01-23 20:00:00 CET" "2021-01-24 06:00:00 CET"
# [7] "2021-01-25 06:00:00 CET" "2021-01-27 20:00:00 CET"

data.frame(timestamps, r)
#            timestamps                   r
# 1 2021-01-23 00:00:00 2021-01-23 06:00:00
# 2 2021-01-23 04:48:00 2021-01-23 06:00:00
# 3 2021-01-23 09:36:00 2021-01-23 14:00:00
# 4 2021-01-23 14:24:00 2021-01-23 20:00:00
# 5 2021-01-23 19:12:00 2021-01-23 20:00:00
# 6 2021-01-24 00:00:00 2021-01-24 06:00:00
# 7 2021-01-24 23:59:00 2021-01-25 06:00:00
# 8 2021-01-27 20:00:00 2021-01-27 20:00:00

Note: I've added "2021-01-24 23:59:00 CET" to timestamps to demonstrate the date change.

---

Benchmark

Tested on a length 1.4e6 vector.

# Unit: seconds
#         expr      min       lq     mean   median       uq      max neval cld
#      POSIX() 32.96197 33.06495 33.32104 33.16793 33.50057 33.83321     3  a 
#  lubridate() 47.36412 47.57762 47.75280 47.79113 47.94715 48.10316     3   b

---

Data:

timestamps <- structure(c(1611356400, 1611373680, 1611390960, 1611408240, 1611425520, 
1611442800, 1611529140, 1611774000), class = c("POSIXct", "POSIXt"
))
hours_of_day <- c(6, 14, 20)