在 R 中识别时间 window 内的事件

Identify events within a time window in R

我需要确定 60 秒内发生的一系列事件(最多 3 个事件)。

这里是IN数据

IN<-read.table(header = FALSE, text = "
2018-06-01_04:29:47
2018-06-01_05:44:41
2018-06-01_05:44:43
2018-06-01_05:44:45
2018-06-01_05:57:54
2018-06-01_05:57:56
2018-06-01_05:57:58
2018-06-01_08:10:35
2018-06-01_08:41:20
2018-06-01_08:41:22
2018-06-01_08:41:24
2018-06-01_08:52:01
2018-06-01_09:02:13
2018-06-01_09:22:45", quote="\n",col.names="time")

IN$time<-as.POSIXct(IN$time, "%Y-%m-%d_%H:%M:%S",tz="")

这里有所需的输出

OUT<-read.table(header = FALSE, text = "
2018-06-01_04:29:47        1
2018-06-01_05:44:41        1
2018-06-01_05:44:43        2
2018-06-01_05:44:45        3
2018-06-01_05:57:54        1
2018-06-01_05:57:56        2
2018-06-01_05:57:58        3
2018-06-01_08:10:35        1
2018-06-01_08:41:20        1
2018-06-01_08:41:22        2
2018-06-01_08:41:24        3
2018-06-01_08:52:01        1
2018-06-01_09:02:13        1
2018-06-01_09:22:45        1
",quote="\n",col.names=c("time","response"))

我搜索过类似的问题,但没有成功。 我猜函数 diff 是解决这个问题的第一步,

response<-as.numeric(diff(IN$time)>60)

但我不知道如何继续获得所需的输出。

任何帮助将不胜感激。

这是使用 dplyrmagrittrlubridate 包的解决方案。

IN<-read.table(header = FALSE, text = "2018-06-01_04:29:47
               2018-06-01_05:44:41
               2018-06-01_05:44:43
               2018-06-01_05:44:45
               2018-06-01_05:57:54
               2018-06-01_05:57:56
               2018-06-01_05:57:58
               2018-06-01_08:10:35
               2018-06-01_08:41:20
               2018-06-01_08:41:22
               2018-06-01_08:41:24
               2018-06-01_08:52:01
               2018-06-01_09:02:13
               2018-06-01_09:22:45", quote="\n",col.names="time")

IN$time<-as.POSIXct(IN$time, "%Y-%m-%d_%H:%M:%S",tz="")

我删除了输入数据框的空白第一行,因为它会导致问题。以下函数将数据框过滤为给定 ref_time 之前 60 秒内的那些元素,并使用 nrow.

计算行数
event_count <- function(ref_time){
  IN %>% filter(time %within% interval(ref_time - 60, ref_time)) %>% nrow
}

在这里,我以行方式应用函数,记录计数,并根据时间排序。 (可能是不必要的...)使用来自 magrittr.

的复合赋值管道将结果通过管道返回到输入数据帧
IN %<>% 
  rowwise() %>% 
  mutate(counts = event_count(time)) %>% 
  arrange(time)

终于有结果了。

# A tibble: 14 x 2
#    time                counts
#    <dttm>               <int>
# 1  2018-06-01 04:29:47      1
# 2  2018-06-01 05:44:41      1
# 3  2018-06-01 05:44:43      2
# 4  2018-06-01 05:44:45      3
# 5  2018-06-01 05:57:54      1
# 6  2018-06-01 05:57:56      2
# 7  2018-06-01 05:57:58      3
# 8  2018-06-01 08:10:35      1
# 9  2018-06-01 08:41:20      1
# 10 2018-06-01 08:41:22      2
# 11 2018-06-01 08:41:24      3
# 12 2018-06-01 08:52:01      1
# 13 2018-06-01 09:02:13      1
# 14 2018-06-01 09:22:45      1

我认为@PoGibas 暗示的是出于某种原因在输入数据框中有两个时间为 2018-06-01 05:57:54 的条目。我不确定第二个来自哪里...


编辑:阅读 table 中的新行搞砸了。

编辑²:这 returns 最多 3...

event_count <- function(ref_time){
  min(IN %>% filter(time %within% interval(ref_time - 60, ref_time)) %>% nrow, 3)
}

这是一个包含一些边缘情况的数据框:

IN<-read.table(header = FALSE, text = "2018-06-01_04:29:47
           2018-06-01_05:44:41
           2018-06-01_05:44:43
           2018-06-01_05:44:45
           2018-06-01_05:44:47
           2018-06-01_05:57:54
           2018-06-01_05:57:56
           2018-06-01_05:57:58
           2018-06-01_05:58:56
           2018-06-01_08:10:35
           2018-06-01_08:41:20
           2018-06-01_08:41:22
           2018-06-01_08:41:24
           2018-06-01_08:52:01
           2018-06-01_09:02:13
           2018-06-01_09:22:45", quote="\n",col.names="time")

IN$time<-as.POSIXct(IN$time, "%Y-%m-%d_%H:%M:%S",tz="")

IN
                  time
1  2018-06-01 04:29:47
2  2018-06-01 05:44:41
3  2018-06-01 05:44:43
4  2018-06-01 05:44:45
5  2018-06-01 05:44:47
6  2018-06-01 05:57:54
7  2018-06-01 05:57:56
8  2018-06-01 05:57:58
9  2018-06-01 05:58:56
10 2018-06-01 08:10:35
11 2018-06-01 08:41:20
12 2018-06-01 08:41:22
13 2018-06-01 08:41:24
14 2018-06-01 08:52:01
15 2018-06-01 09:02:13
16 2018-06-01 09:22:45

您会注意到第 9 行比 mid-group 时间晚一分钟,但不是参考时间。如果没有施加限制,第 5 行也是组中的第 4 个成员。

这是我使用 dplyr 的解决方案。我认为一般来说它有效:

res <- IN %>% mutate(diffs = as.numeric(time - lag(time)),
                     helper1 = case_when(is.na(diffs) ~ 1,
                                         diffs <= 60 ~ 0 ,
                                         TRUE ~ 1),
                     grouper1 = cumsum(helper1)) %>%
  group_by(grouper1) %>%
  mutate(helper2 = cumsum(diffs) - first(diffs),
         helper3 = helper2 %/% 60,
         helper4 = helper1 + if_else(is.na(helper3), 0, helper3)) %>%
  ungroup() %>%
  mutate(grouper2 = cumsum(helper4)) %>%
  group_by(grouper2) %>%
  mutate(rn0 = row_number() - 1,
         grouper3 = rn0 %/% 3) %>%
  group_by(grouper2, grouper3) %>%
  mutate(count = row_number()) %>%
  ungroup() %>%
  select(time, count)

结果:

> res
# A tibble: 16 x 2
   time                count
   <dttm>              <int>
 1 2018-06-01 04:29:47     1
 2 2018-06-01 05:44:41     1
 3 2018-06-01 05:44:43     2
 4 2018-06-01 05:44:45     3
 5 2018-06-01 05:44:47     1
 6 2018-06-01 05:57:54     1
 7 2018-06-01 05:57:56     2
 8 2018-06-01 05:57:58     3
 9 2018-06-01 05:58:56     1
10 2018-06-01 08:10:35     1
11 2018-06-01 08:41:20     1
12 2018-06-01 08:41:22     2
13 2018-06-01 08:41:24     3
14 2018-06-01 08:52:01     1
15 2018-06-01 09:02:13     1
16 2018-06-01 09:22:45     1

我想我以一种您可以关注的方式组织了 dplyr 电话会议,但如果您有任何问题,请随时在评论中 post。