Определить события в пределах временного окна в R

Question

Мне нужно идентифицировать серию (максимум 3 события) событий, которые произошли в течение 60 секунд.

Здесь есть данные 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

Вот кадр данных с некоторыми крайними случаями:

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 таким образом, чтобы вы могли следовать за ними, но если у вас естьвопросы не стесняйтесь оставлять в комментариях.

Answer 2

Вот решение с использованием пакетов 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="")

Я удалил пустую первую строку фрейма входных данных, так как это вызывало проблемы.Следующая функция фильтрует фрейм данных для этих элементов в течение 60 секунд до заданного ref_time и подсчитывает количество строк, используя 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.Я не уверен, откуда взялась вторая ...

---

РЕДАКТИРОВАТЬ: это новая строка в таблице чтения, которая портит его.

РЕДАКТИРОВАТЬ²: Это возвращает максимум3 ...

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