如果间隔超过一定时间,则找到持续时间并创建脱粒

时间:2020-04-01 00:25:39

标签: r dplyr tidyverse

目标:

我有一个数据集df,我想对ID进行分组并根据以下条件找到持续时间:Focus == True,Read == True,ID!=“”。但是,我不想汇总这些ID,因为我希望将它们放在自己的单独“块”中,我也希望创建一个阈值,如果在此之间的时间超过4分钟,则将其分开分组,如图所示在输出下方。

ID            Date                   Focus        Read


A             1/2/2020 5:00:00 AM    TRUE         TRUE
A             1/2/2020 5:00:05 AM    TRUE         TRUE
              1/3/2020 6:00:00 AM    TRUE
              1/3/2020 6:00:05 AM    TRUE         
B             1/4/2020 7:00:00 AM    TRUE         TRUE
B             1/4/2020 7:00:05 AM    TRUE         TRUE
B             1/4/2020 7:20:00 AM    TRUE         TRUE
B             1/4/2020 7:20:10 AM    TRUE         TRUE
A             1/2/2020 7:30:00 AM    TRUE         TRUE
A             1/2/2020 7:30:20 AM    TRUE         TRUE

我想要以下输出:

ID                          Duration              Start                    End

A                           5 sec                 1/2/2020 5:00:00 AM     1/2/2020 5:00:05 AM
B                           5 sec                 1/4/2020 7:00:00 AM     1/4/2020 7:00:05 AM    
B                           10 sec                1/4/2020 7:20:00 AM     1/4/2020 7:20:10 AM
A                           20 sec                1/2/2020 7:30:00 AM     1/2/2020 7:30:20 AM     

投放:

structure(list(ID = structure(c(2L, 2L, 1L, 1L, 3L, 3L, 3L, 3L, 
2L, 2L), .Label = c("", "A", "B"), class = "factor"), Date = structure(c(1L, 
2L, 5L, 6L, 7L, 8L, 9L, 10L, 3L, 4L), .Label = c("1/2/2020 5:00:00 AM", 
"1/2/2020 5:00:05 AM", "1/2/2020 7:30:00 AM", "1/2/2020 7:30:20 AM", 
"1/3/2020 6:00:00 AM", "1/3/2020 6:00:05 AM", "1/4/2020 7:00:00 AM", 
"1/4/2020 7:00:05 AM", "1/4/2020 7:20:00 AM", "1/4/2020 7:20:10 AM"
), class = "factor"), Focus = structure(c(1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L), .Label = "True ", class = "factor"), Read = structure(c(2L, 
2L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("", "True "), class = "factor")), class =    "data.frame", row.names = c(NA, 
-10L))

这很好用,但是我不汇总ID,而是将它们分开:

 library(dplyr)
 library(lubridate)
 df %>% 
 filter(as.logical(trimws(Read)), as.logical(trimws(Focus))) %>%
 mutate(Date = mdy_hms(Date)) %>%
 group_by(ID) %>% 
 summarise(Duration = difftime(last(Date), first(Date), units = "secs"))

任何建议都值得赞赏。

1 个答案:

答案 0 :(得分:2)

我们可以删除ReadFocus中的空白值,转换Date,创建阈值为4分钟的单独组,并获得last之间的时间差和first值。

library(dplyr)

df %>% 
  filter(as.logical(trimws(Read)), as.logical(trimws(Focus))) %>%
  mutate(Date = lubridate::mdy_hms(Date)) %>% 
  group_by(grp = cumsum(abs(difftime(Date, lag(Date, 
                            default = first(Date)), units = "mins")) > 4)) %>%
  summarise(ID = first(ID),
            Duration = difftime(last(Date), first(Date), units = "secs"), 
            Start = first(Date), 
            End = last(Date)) %>%
  select(-grp)


#  ID    Duration Start               End                
#  <fct> <drtn>   <dttm>              <dttm>             
#1 A      5 secs  2020-01-02 05:00:00 2020-01-02 05:00:05
#2 B      5 secs  2020-01-04 07:00:00 2020-01-04 07:00:05
#3 B     10 secs  2020-01-04 07:20:00 2020-01-04 07:20:10
#4 A     20 secs  2020-01-02 07:30:00 2020-01-02 07:30:20