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

user_1297830 0
Viewed 131

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?

posixct r rounding datetime
3 Answers

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)
user_65740380

I would extract the hour component, use cut to bin it, and assign the binned hours back to the original:

hours_of_day = c(2, 14, 20)

library(lubridate)
library(magrittr)  ## just for the pipe
new_hours = timestamps %>% 
  hour %>% 
  cut(breaks = c(0, hours_of_day), labels = hours_of_day, include.lowest = TRUE) %>% 
  as.character() %>%
  as.integer()

result = floor_date(timestamps, "hour")
hour(result) = new_hours

result
# [1] "2021-01-23 02:00:00 EST" "2021-01-23 14:00:00 EST" "2021-01-23 14:00:00 EST"
# [4] "2021-01-23 14:00:00 EST" "2021-01-23 20:00:00 EST" "2021-01-24 02:00:00 EST"
user_9030610

Building on the approach by @jay.sf, I made a function for floor as well while adding support for NA values.

floor_date_to = function(timestamps, hours_of_day) {

  # Handle NA with a temporary filler so code below doesn't break
  na_timestamps = is.na(timestamps)
  timestamps[na_timestamps] = as.POSIXct("9999-12-31")  

  # Proceed as usual
  timestamps = as.POSIXlt(timestamps)
  hours_of_day = rev(hours_of_day)  # floor-specific: because which.max returns the first index by default
  nearest_hour = hours_of_day[sapply(lapply(with(timestamps, hour + min/60 + sec/3600), `<`, hours_of_day), function(x) which.max(-x))]  # floor-specific: negative which.max()
  rounded = with(timestamps, ISOdate(1900 + year, mon + 1, mday, nearest_hour, tz = attr(timestamps, "tzone")[1]))
  rounded[rounded > timestamps] = rounded[rounded > timestamps] - 86400  # floor: use minus
  return(rounded)
  timestamps[na_timestamps] = NA  # Overwrite with NA again
}
user_12978300
Related