使用difftime按间隔分组

Question

如何获取"hms" "difftime"类的列ts，并使用它按间隔对数据框的其余部分进行分组？

> example
# A tibble: 10 x 2
   ts        val
   <time>  <dbl>
 1 00'00" -0.7  
 2 00'01" -1.69 
 3 00'02"  0.03 
 4 00'03"  0.570
 5 00'04" -0.15 
 6 00'05" -0.34 
 7 00'06" -0.45 
 8 00'07"  0.77 
 9 00'08"  0.6  
10 00'09"  0.01 

> class(example$ts)
[1] "hms"      "difftime"

我通常使用lubridate::floor_date将时间戳字段绑定到时间间隔中。但是如果我直接尝试这样做，我会得到一个错误：

example %>% mutate(win_5s = floor_date(ts, unit = "5 seconds"))

Error in UseMethod("reclass_date", orig) : 
no applicable method for 'reclass_date' applied to an object of class "c('hms', 'difftime')"

到目前为止，我的解决方法是首先使用as.POSIXct转换ts

example %>%
  mutate(ts2 = as.POSIXct(ts),
         window_5s = floor_date(ts2, "5 seconds")) %>%
  group_by(window_5s) %>%
  summarise(avg = mean(val))

# A tibble: 2 x 2
  window_5s              avg
  <dttm>               <dbl>
1 1970-01-01 00:00:00 -0.388
2 1970-01-01 00:00:05  0.118

但这感觉像是我在lubridate生态系统中遗漏了一些东西-- ts已经被识别为具有正确单位的time对象，所以有没有更直接或更"lubridatey“的方法来完成这种分组，而不是转换为完整的datetime (具有不相关或不正确的日期)？

用于example的dput：

structure(list(ts = structure(c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9), class = c("hms", 
"difftime"), units = "secs"), val = c(-0.7, -1.69, 0.03, 0.57, 
-0.15, -0.34, -0.45, 0.77, 0.6, 0.01)), row.names = c(NA, -10L
), class = c("tbl_df", "tbl", "data.frame"))

Answer 1

有一个似乎可以工作的hms::round_hms()函数：

> test %>% mutate(hms::round_hms(ts, 5))

# A tibble: 10 x 3
   ts        val `hms::round_hms(ts, 5)`
   <time>  <dbl> <time>                 
 1 00'00" -0.7   00'00"                 
 2 00'01" -1.69  00'00"                 
 3 00'02"  0.03  00'00"                 
 4 00'03"  0.570 00'05"                 
 5 00'04" -0.15  00'05"                 
 6 00'05" -0.34  00'05"                 
 7 00'06" -0.45  00'05"                 
 8 00'07"  0.77  00'05"                 
 9 00'08"  0.6   00'10"                 
10 00'09"  0.01  00'10"      

如果你想实现它，我认为你需要一个定制的函数，但是round_hms()的源代码提供了一个很好的模板来实现这一点：https://github.com/tidyverse/hms/blob/master/R/round.R

这就是它：

floor_hms <- function(x, secs) {
  vctrs::vec_restore(floor(as.numeric(x) / secs) * secs, x)
}

示例：

> test %>% mutate(hms::round_hms(ts, 5), floor_hms(ts, 5))

# A tibble: 10 x 4
   ts        val `hms::round_hms(ts, 5)` `floor_hms(ts, 5)`
   <time>  <dbl> <time>                  <time>            
 1 00'00" -0.7   00'00"                  00'00"            
 2 00'01" -1.69  00'00"                  00'00"            
 3 00'02"  0.03  00'00"                  00'00"            
 4 00'03"  0.570 00'05"                  00'00"            
 5 00'04" -0.15  00'05"                  00'00"            
 6 00'05" -0.34  00'05"                  00'05"            
 7 00'06" -0.45  00'05"                  00'05"            
 8 00'07"  0.77  00'05"                  00'05"            
 9 00'08"  0.6   00'10"                  00'05"            
10 00'09"  0.01  00'10"                  00'05"