R 折叠和合并重叠的时间间隔_R_Dataframe_Datetime_Tidyverse_Lubridate

R 折叠和合并重叠的时间间隔

r dataframe datetime

R 折叠和合并重叠的时间间隔,r,dataframe,datetime,tidyverse,lubridate,R,Dataframe,Datetime,Tidyverse,Lubridate,我正在开发一个基于tidyverse的数据工作流，遇到了这样一种情况：我有一个具有很多时间间隔的数据框架。让我们调用数据帧my_time_interval，它可以这样复制： library(tidyverse) library(lubridate) my_time_intervals <- tribble( ~id, ~group, ~start_time, ~end_time, 1L, 1L, ymd_hms("2018-04-12 11:15:03"), ymd_hm

我正在开发一个基于tidyverse的数据工作流，遇到了这样一种情况：我有一个具有很多时间间隔的数据框架。让我们调用数据帧

my_time_interval

，它可以这样复制：

library(tidyverse)
library(lubridate)

my_time_intervals <- tribble(
    ~id, ~group, ~start_time, ~end_time,
    1L, 1L, ymd_hms("2018-04-12 11:15:03"), ymd_hms("2018-05-14 02:32:10"),
    2L, 1L, ymd_hms("2018-07-04 02:53:20"), ymd_hms("2018-07-14 18:09:01"),
    3L, 1L, ymd_hms("2018-05-07 13:02:04"), ymd_hms("2018-05-23 08:13:06"),
    4L, 2L, ymd_hms("2018-02-28 17:43:29"), ymd_hms("2018-04-20 03:48:40"),
    5L, 2L, ymd_hms("2018-04-20 01:19:52"), ymd_hms("2018-08-12 12:56:37"),
    6L, 2L, ymd_hms("2018-04-18 20:47:22"), ymd_hms("2018-04-19 16:07:29"),
    7L, 2L, ymd_hms("2018-10-02 14:08:03"), ymd_hms("2018-11-08 00:01:23"),
    8L, 3L, ymd_hms("2018-03-11 22:30:51"), ymd_hms("2018-10-20 21:01:42")
)

关于我的时间间隔的几点注意事项：

通过

group

变量将数据分为三组

id

变量只是数据帧中每一行的唯一id

时间间隔的开始和结束以

start\u time

和

end\u time

的形式存储在

lubridate

中

有些时间间隔重叠，有些不重叠，而且它们并不总是有序的。例如，行

与行

重叠，但它们都不与行

重叠

两个以上的间隔可能相互重叠，有些间隔完全位于其他间隔内。请参见

group==2

中的行

到

我想要的是，在每个

组中

，将任何重叠的时间间隔折叠成连续的时间间隔。在这种情况下，我期望的结果如下所示：

# A tibble: 5 x 4
     id group start_time          end_time           
  <int> <int> <dttm>              <dttm>             
1     1     1 2018-04-12 11:15:03 2018-05-23 08:13:06
2     2     1 2018-07-04 02:53:20 2018-07-14 18:09:01
3     4     2 2018-02-28 17:43:29 2018-08-12 12:56:37
4     7     2 2018-10-02 14:08:03 2018-11-08 00:01:23
5     8     3 2018-03-11 22:30:51 2018-10-20 21:01:42

#一个tible:5 x 4
id组开始\u时间结束\u时间
1     1     1 2018-04-12 11:15:03 2018-05-23 08:13:06
2     2     1 2018-07-04 02:53:20 2018-07-14 18:09:01
3     4     2 2018-02-28 17:43:29 2018-08-12 12:56:37
4     7     2 2018-10-02 14:08:03 2018-11-08 00:01:23
5     8     3 2018-03-11 22:30:51 2018-10-20 21:01:42

请注意，不同

组之间重叠的时间间隔不会合并。另外，我不关心此时id
列会发生什么情况
我知道lubridate
包包含与间隔相关的函数，但我不知道如何将它们应用到这个用例中
我如何做到这一点？多谢各位
my_time_intervals %>% group_by(group) %>% arrange(start_time) %>% 
                      mutate(indx = c(0, cumsum(as.numeric(lead(start_time)) >
                              cummax(as.numeric(end_time)))[-n()])) %>%
                      group_by(group, indx) %>%
                      summarise(start_time = min(start_time), end_time = max(end_time)) %>%
                      select(-indx)


# # A tibble: 5 x 3
# # Groups:   group [3]
# group start_time          end_time           
# <int> <dttm>              <dttm>             
# 1     1 2018-04-12 11:15:03 2018-05-23 08:13:06
# 2     1 2018-07-04 02:53:20 2018-07-14 18:09:01
# 3     2 2018-02-28 17:43:29 2018-08-12 12:56:37
# 4     2 2018-10-02 14:08:03 2018-11-08 00:01:23
# 5     3 2018-03-11 22:30:51 2018-10-20 21:01:42

如您所见，在第一组中，我们有3个不同的时间段，其中有重叠的数据点，还有一个数据点在该组中没有重叠的条目。indx
列将这些数据点分为4组（即0、1、2、3
）。在随后的解决方案中，当我们group_by（indx，group）
我们将这些重叠的部分放在一起，得到第一个开始时间和最后一个结束时间，以获得所需的输出
为了使解决方案更容易出错（如果我们有一个数据点，它比一个组（组和索引）中的所有其他数据点（如id为6和7的数据点）开始得早，但结束得晚），我将first（）
和last（）
更改为min（）
和max（）

所以
my\u time\u interval%%>%group\u by（group）%%>%arrange（group，start\u time）%%
变异（indx=c（0，累计值）（如数字（提前期（开始时间））>
cummax（作为.numeric（结束时间）））[-n（））%>%
分组依据（分组，indx）%>%
总结（开始时间=最小（开始时间），结束时间=最大（结束时间））
##tibble:7 x 4
##组：组[？]
#组indx开始时间结束时间
#                              
# 1     1     0 2018-04-12 11:15:03 2018-05-23 08:13:06
# 2     1     1 2018-07-04 02:53:20 2018-07-14 18:09:01
# 3     1     2 2018-07-15 01:53:20 2018-07-19 18:09:01
# 4     1     3 2018-07-20 02:53:20 2018-07-22 18:09:01
# 5     2     0 2018-02-28 17:43:29 2018-08-12 12:56:37
# 6     2     1 2018-10-02 14:08:03 2018-11-08 00:01:23
# 7     3     0 2018-03-11 22:30:51 2018-10-20 21:01:42

我们使用每个重叠时间和日期的唯一索引来获取每个重叠时间和日期的周期（开始和结束）
除此之外，您还需要阅读有关cumsum
和cummax
的内容，并查看这两个函数的输出以了解为什么我所做的比较最终为每个重叠的时间和日期提供了唯一的标识符
希望这对我有帮助，因为这是我最好的方法。
另一种tidyverse
方法：
library(tidyverse)
library(lubridate)

my_time_intervals %>%
  arrange(group, start_time) %>%
  group_by(group) %>%
  mutate(new_end_time = if_else(end_time >= lead(start_time), lead(end_time), end_time),
         g = new_end_time != end_time | is.na(new_end_time),
         end_time = if_else(end_time != new_end_time & !is.na(new_end_time), new_end_time, end_time)) %>%
  filter(g) %>%
  select(-new_end_time, -g)

我们可以按start\u time
排序，然后嵌套并在相关的子表中使用reduce合并行（使用Masoud的数据）：
库（tidyverse）
df%>%
安排（开始时间）%>%
选择（-id）%%>%
嵌套（开始时间，结束时间，.key=“startend”）%>%
突变（startend=map）（startend，~reduce(
序号（nrow（）[-1]，
~if（…3[.y，1].x[nrow（.x），2]）`[%
排列（组）%>%
unnest（）
##tibble:7 x 3
#组开始时间结束时间
#                             
# 1     1 2018-04-12 13:15:03 2018-05-23 10:13:06
# 2     1 2018-07-04 04:53:20 2018-07-14 20:09:01
# 3     1 2018-07-15 03:53:20 2018-07-19 20:09:01
# 4     1 2018-07-20 04:53:20 2018-07-22 20:09:01
# 5     2 2018-02-28 18:43:29 2018-08-12 14:56:37
# 6     2 2018-10-02 16:08:03 2018-11-08 01:01:23
# 7     3 2018-03-11 23:30:51 2018-10-20 23:01:42
my_时间间隔%>%group_by（group）%%>%arrange（start_time）%%>%mutate（indx=c（0，cumsum（as.numeric（lead（start_time））>cummax（as.numeric（end_time）））[-n（）]）%>%group_by（group，indx）%%>%summary（start_time=first（start_time），end_time=last（end_time））%%>%select（-indx）
谢谢@Masoud的建议。我不确定代码是什么意思，但我尝试过，结果与问题中我想要的结果不匹配（我会将错误的输出与您的代码附加到问题中，以便您可以看到）。你能解释一下你的代码是什么吗？谢谢！你错过了arrange
。它工作得很好。谢谢@avid\u useR，有一个问题：什么是g=new\u end\u time！=end\u time是。na（new\u end\u time）
的意思？我不明白=/code>后面跟着！=/code>然后
。@hpynew\u end\u\u\u time！=end\u时间是（新结束时间）是一个逻辑e
my_time_intervals <- tribble(
  ~id, ~group, ~start_time, ~end_time,
  1L, 1L, ymd_hms("2018-04-12 11:15:03"), ymd_hms("2018-05-14 02:32:10"),
  2L, 1L, ymd_hms("2018-07-04 02:53:20"), ymd_hms("2018-07-14 18:09:01"),
  3L, 1L, ymd_hms("2018-07-05 02:53:20"), ymd_hms("2018-07-14 18:09:01"),
  4L, 1L, ymd_hms("2018-07-15 02:53:20"), ymd_hms("2018-07-16 18:09:01"),
  5L, 1L, ymd_hms("2018-07-15 01:53:20"), ymd_hms("2018-07-19 18:09:01"),
  6L, 1L, ymd_hms("2018-07-20 02:53:20"), ymd_hms("2018-07-22 18:09:01"),
  7L, 1L, ymd_hms("2018-05-07 13:02:04"), ymd_hms("2018-05-23 08:13:06"),
  8L, 1L, ymd_hms("2018-05-10 13:02:04"), ymd_hms("2018-05-23 08:13:06"),
  9L, 2L, ymd_hms("2018-02-28 17:43:29"), ymd_hms("2018-04-20 03:48:40"),
  10L, 2L, ymd_hms("2018-04-20 01:19:52"), ymd_hms("2018-08-12 12:56:37"),
  11L, 2L, ymd_hms("2018-04-18 20:47:22"), ymd_hms("2018-04-19 16:07:29"),
  12L, 2L, ymd_hms("2018-10-02 14:08:03"), ymd_hms("2018-11-08 00:01:23"),
  13L, 3L, ymd_hms("2018-03-11 22:30:51"), ymd_hms("2018-10-20 21:01:42")
)

my_time_intervals %>% group_by(group) %>% arrange(group,start_time) %>% 
  mutate(indx = c(0, cumsum(as.numeric(lead(start_time)) >
                              cummax(as.numeric(end_time)))[-n()]))


  # # A tibble: 13 x 5
  # # Groups:   group [3]
  # id group start_time          end_time             indx
  # <int> <int> <dttm>              <dttm>              <dbl>
  # 1     1      1 2018-04-12 11:15:03 2018-05-14 02:32:10     0
  # 2     7      1 2018-05-07 13:02:04 2018-05-23 08:13:06     0
  # 3     8      1 2018-05-10 13:02:04 2018-05-23 08:13:06     0
  # 4     2      1 2018-07-04 02:53:20 2018-07-14 18:09:01     1
  # 5     3      1 2018-07-05 02:53:20 2018-07-14 18:09:01     1
  # 6     5      1 2018-07-15 01:53:20 2018-07-19 18:09:01     2
  # 7     4      1 2018-07-15 02:53:20 2018-07-16 18:09:01     2
  # 8     6      1 2018-07-20 02:53:20 2018-07-22 18:09:01     3
  # 9     9      2 2018-02-28 17:43:29 2018-04-20 03:48:40     0
  # 10    11     2 2018-04-18 20:47:22 2018-04-19 16:07:29     0
  # 11    10     2 2018-04-20 01:19:52 2018-08-12 12:56:37     0
  # 12    12     2 2018-10-02 14:08:03 2018-11-08 00:01:23     1
  # 13    13     3 2018-03-11 22:30:51 2018-10-20 21:01:42     0

my_time_intervals %>% group_by(group) %>% arrange(group,start_time) %>% 
  mutate(indx = c(0, cumsum(as.numeric(lead(start_time)) >
                              cummax(as.numeric(end_time)))[-n()])) %>%
  group_by(group, indx) %>%
  summarise(start_time = min(start_time), end_time = max(end_time)) 


# # A tibble: 7 x 4
# # Groups:   group [?]
# group  indx start_time          end_time           
# <int> <dbl> <dttm>              <dttm>             
# 1     1     0 2018-04-12 11:15:03 2018-05-23 08:13:06
# 2     1     1 2018-07-04 02:53:20 2018-07-14 18:09:01
# 3     1     2 2018-07-15 01:53:20 2018-07-19 18:09:01
# 4     1     3 2018-07-20 02:53:20 2018-07-22 18:09:01
# 5     2     0 2018-02-28 17:43:29 2018-08-12 12:56:37
# 6     2     1 2018-10-02 14:08:03 2018-11-08 00:01:23
# 7     3     0 2018-03-11 22:30:51 2018-10-20 21:01:42

library(tidyverse)
library(lubridate)

my_time_intervals %>%
  arrange(group, start_time) %>%
  group_by(group) %>%
  mutate(new_end_time = if_else(end_time >= lead(start_time), lead(end_time), end_time),
         g = new_end_time != end_time | is.na(new_end_time),
         end_time = if_else(end_time != new_end_time & !is.na(new_end_time), new_end_time, end_time)) %>%
  filter(g) %>%
  select(-new_end_time, -g)

library(tidyverse)
df %>% 
  arrange(start_time) %>% # 
  select(-id) %>%
  nest(start_time, end_time,.key="startend") %>%
  mutate(startend = map(startend,~reduce(
    seq(nrow(.))[-1],
    ~ if(..3[.y,1] <= .x[nrow(.x),2]) 
        if(..3[.y,2] > .x[nrow(.x),2]) `[<-`(.x, nrow(.x), 2, value = ..3[.y,2])
        else .x
      else bind_rows(.x,..3[.y,]),
    .init = .[1,],
    .))) %>%
  arrange(group) %>%
  unnest()

# # A tibble: 7 x 3
# group          start_time            end_time
# <int>              <dttm>              <dttm>
# 1     1 2018-04-12 13:15:03 2018-05-23 10:13:06
# 2     1 2018-07-04 04:53:20 2018-07-14 20:09:01
# 3     1 2018-07-15 03:53:20 2018-07-19 20:09:01
# 4     1 2018-07-20 04:53:20 2018-07-22 20:09:01
# 5     2 2018-02-28 18:43:29 2018-08-12 14:56:37
# 6     2 2018-10-02 16:08:03 2018-11-08 01:01:23
# 7     3 2018-03-11 23:30:51 2018-10-20 23:01:42