在 R 中识别时间窗口内的事件

Question

我需要确定在 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)

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

任何帮助将不胜感激。

Answer 1

这是使用dplyr、magrittr 和lubridate 包的解决方案。

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 的条目。我不确定第二个来自哪里......

---

编辑：是读取表中的新行搞砸了。

EDIT²：最​​多返回 3...

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

Answer 2

这是一个带有一些极端情况的数据框：

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 行比中组时间晚一分钟，而不是参考时间。如果没有施加限制，5 行也是组的第四个成员。

这是我使用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 电话的组织方式让您可以关注他们，但如果您有任何问题，请随时在 cmets 中发帖。