目标:
我有一个数据集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"))
任何建议都值得赞赏。
答案 0 :(得分:2)
我们可以删除Read
和Focus
中的空白值,转换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