R 如何将datetime四舍五入到一天中最近的时间，最好是矢量化的？

假设我有一个POSIXct向量，比如

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

我想用向量将这些时间四舍五入到一天中最近的一小时：

hours_of_day = c(6, 14, 20)

i、 e.得出以下结果：

           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

是否有矢量化的解决方案（或其他快速解决方案）？我有几百万个时间戳，需要在每天的几个小时内应用它

---

简化此问题的一种方法是：（1）为每个

lubridate:：hour（timestamps）

查找下一个

hours\u of_day

，然后（2）

result=lubridate:：floor\u date（timestamps）+next\u hours\u of_of_day*3600

。但是如何将步骤1矢量化？

转换为

as.POSIXlt

，它允许您提取小时和分钟，并计算十进制小时数。在

lappy

/

sapply

组合中，首先查找那些小于一天中的小时数向量的位置，然后使用

which.max

选择最大小时数。现在使用

ISOdate

创建新的日期时间，如果日期时间小于原始时间，则添加一天

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

注：我在时间戳中添加了
“2021-01-24 23:59:00 CET”
，以演示日期更改


基准
在长度为1.4e6的向量上进行测试

# 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


数据：

timestamps我将提取
hour
组件，使用
cut
将其装箱，并将装箱的小时数分配回原始时间：

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"

在@jay.sf方法的基础上，我还为floor创建了一个函数，同时添加了对
NA
值的支持

floor\u date\u to=功能（时间戳，每天的小时数）{
#用临时填充符处理NA，这样下面的代码就不会中断
na_timestaps=is.na（时间戳）
时间戳[na_时间戳]=as.POSIXct（“9999-12-31”）
#照常进行
timestamps=as.POSIXlt（timestamps）
hours_of_day=rev（hours_of_day）#特定于楼层：因为which.max默认返回第一个索引
最近的小时数=一天中的小时数[sapply（lapply）（带有（时间戳，小时+分钟/60+秒/3600），`timestamps]=四舍五入[rounded>时间戳]-86400#楼层：使用减号
返回（四舍五入）
时间戳[na#U时间戳]=na#再次用na覆盖
}
谢谢，但这些结果不正确。
时间戳[2]
向下舍入。@JonasLindeløv谢谢，更新的代码！为什么
时间戳[4]
另一种解决方案，四舍五入，没有错误？谢谢你指出这一点！我接受了你的回答。我的笔记本电脑上的140万个POSIXct时间戳需要7秒。@JonasLindeløv欢迎！如果你的7秒是真的，我肯定需要买一台新的笔记本电脑。啊，这是一个更好的优雅解决方案。你还可以添加“+sec/3600”一直以来。
时间戳
可以有几个不同的时区，虽然通常是UTC。似乎因为
tz（时间戳）
在这种情况下是“”，所以它默认为系统tz？在
ISOdate（…，tz=tz（时间戳））
的情况下都可以工作。很漂亮，谢谢。运行
bench:：mark（）
，我发现在一台普通的笔记本电脑上，140万行和三个切点大约需要2秒。不使用
cut
，您可能可以缩短时间-只有3种可能性嵌套
ifelse
（或者更好，如果else
或者
case\u当
dplyr
中的
时）通过避免类转换，将比
cut
快一点。四舍五入
时间戳[4]
，不适用于
“2021-01-24 23:59:00”
。
timestamps <- structure(c(1611356400, 1611373680, 1611390960, 1611408240, 1611425520, 
1611442800, 1611529140, 1611774000), class = c("POSIXct", "POSIXt"
))
hours_of_day <- c(6, 14, 20)

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"