折叠并合并重叠的时间间隔
Collapse and merge overlapping time intervals
我正在开发一个基于 tidyverse 的数据工作流，遇到了一个情况，我的数据框有很多时间间隔。让我们调用数据框my_time_intervals，它可以这样重现：
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")
)
这是同一数据框的 tibble 视图：
> my_time_intervals
# A tibble: 8 x 4
id group start_time end_time
<int> <int> <dttm> <dttm>
1 1 1 2018-04-12 11:15:03 2018-05-14 02:32:10
2 2 1 2018-07-04 02:53:20 2018-07-14 18:09:01
3 3 1 2018-05-07 13:02:04 2018-05-23 08:13:06
4 4 2 2018-02-28 17:43:29 2018-04-20 03:48:40
5 5 2 2018-04-20 01:19:52 2018-08-12 12:56:37
6 6 2 2018-04-18 20:47:22 2018-04-19 16:07:29
7 7 2 2018-10-02 14:08:03 2018-11-08 00:01:23
8 8 3 2018-03-11 22:30:51 2018-10-20 21:01:42
关于my_time_intervals的几点说明：
数据通过group变量分为三组。
id 变量只是数据框中每一行的唯一 ID。
时间间隔的开始和结束以lubridate形式存储在start_time和end_time中。
有些时间间隔重叠，有些则不重叠，而且它们并不总是按顺序排列。例如，行 1 与行 3 重叠，但它们都不与行 2.
重叠
两个以上的区间可能相互重叠，并且一些区间完全落在其他区间内。查看 group == 2.
中的 4 至 6 行
我想要的是在每个 group 内，将任何重叠的时间间隔折叠成连续的间隔。在这种情况下，我想要的结果如下所示：
# 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
请注意，在 不同 group 之间重叠的时间间隔不会 合并。另外，此时我不关心 id 列发生了什么。
我知道 lubridate 包中包含与区间相关的函数，但我不知道如何将它们应用到这个用例中。
我怎样才能做到这一点？
my_time_intervals %>%
group_by(group) %>% arrange(start_time, by_group = TRUE) %>%
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
根据 OP 的要求进行解释：
我正在制作另一个数据集，它在每个组中有更多的重叠时间，这样解决方案就会得到更多的曝光，希望能更好地掌握；
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")
)
所以让我们看一下此数据集的 indx 列。我在 group 列中添加 arrange 以查看所有相同的分组行；但是，如您所知，因为我们有 group_by(group) 我们实际上并不需要它。
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
如您所见，在第一组中，我们有 3 个具有重叠数据点的不同时间段和一个在该组中没有重叠条目的数据点。 indx 列将这些数据点分为 4 组（即 0, 1, 2, 3）。稍后在解决方案中，当我们 group_by(indx,group) 时，我们将这些重叠的每一个都放在一起，我们得到第一个开始时间和最后一个结束时间以产生所需的输出。
只是为了使解决方案更容易出错（以防我们有一个数据点比一组（组和索引）中的所有其他数据点开始得早但结束得晚，就像我们在数据点中拥有的那样6 和 7 的 ID）我将 first() 和 last() 更改为 min() 和 max().
所以...
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
我们使用每个重叠时间和日期的唯一索引来获取每个时间和日期的时间段（开始和结束）。
除此之外，您需要阅读 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_time 排序，然后在子表中嵌套并使用 reduce 在相关时合并行（使用 Masoud 的数据）：
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
我认为这个问题可以通过 dplyr 和 ivs 包的组合非常优雅地解决，这个包是一个用于处理区间向量的包，就像这样。
这里的关键是iv_group()，它合并了所有重叠的区间和returns合并所有重叠后剩下的一组区间。
library(tidyverse)
library(lubridate)
library(ivs)
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")
)
# Combine the start/end boundaries into a single interval vector
my_time_intervals <- my_time_intervals %>%
mutate(time = iv(start_time, end_time), .keep = "unused")
# Note that these are half-open intervals, but that won't affect anything here
my_time_intervals
#> # A tibble: 8 × 3
#> id group time
#> <int> <int> <iv<dttm>>
#> 1 1 1 [2018-04-12 11:15:03, 2018-05-14 02:32:10)
#> 2 2 1 [2018-07-04 02:53:20, 2018-07-14 18:09:01)
#> 3 3 1 [2018-05-07 13:02:04, 2018-05-23 08:13:06)
#> 4 4 2 [2018-02-28 17:43:29, 2018-04-20 03:48:40)
#> 5 5 2 [2018-04-20 01:19:52, 2018-08-12 12:56:37)
#> 6 6 2 [2018-04-18 20:47:22, 2018-04-19 16:07:29)
#> 7 7 2 [2018-10-02 14:08:03, 2018-11-08 00:01:23)
#> 8 8 3 [2018-03-11 22:30:51, 2018-10-20 21:01:42)
# For each `group` compute the interval "groups". These represent the collapsed
# date-time intervals that you are looking for.
my_time_intervals %>%
group_by(group) %>%
summarise(time = iv_groups(time), .groups = "drop")
#> # A tibble: 5 × 2
#> group time
#> <int> <iv<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)
由 reprex package (v2.0.1)
于 2022-04-05 创建
我正在开发一个基于 tidyverse 的数据工作流，遇到了一个情况，我的数据框有很多时间间隔。让我们调用数据框my_time_intervals，它可以这样重现：
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")
)
这是同一数据框的 tibble 视图：
> my_time_intervals
# A tibble: 8 x 4
id group start_time end_time
<int> <int> <dttm> <dttm>
1 1 1 2018-04-12 11:15:03 2018-05-14 02:32:10
2 2 1 2018-07-04 02:53:20 2018-07-14 18:09:01
3 3 1 2018-05-07 13:02:04 2018-05-23 08:13:06
4 4 2 2018-02-28 17:43:29 2018-04-20 03:48:40
5 5 2 2018-04-20 01:19:52 2018-08-12 12:56:37
6 6 2 2018-04-18 20:47:22 2018-04-19 16:07:29
7 7 2 2018-10-02 14:08:03 2018-11-08 00:01:23
8 8 3 2018-03-11 22:30:51 2018-10-20 21:01:42
关于my_time_intervals的几点说明：
数据通过
group变量分为三组。id变量只是数据框中每一行的唯一 ID。时间间隔的开始和结束以
lubridate形式存储在start_time和end_time中。有些时间间隔重叠，有些则不重叠，而且它们并不总是按顺序排列。例如，行
重叠1与行3重叠，但它们都不与行2.两个以上的区间可能相互重叠，并且一些区间完全落在其他区间内。查看
中的group == 2.4至6行
我想要的是在每个 group 内，将任何重叠的时间间隔折叠成连续的间隔。在这种情况下，我想要的结果如下所示：
# 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
请注意，在 不同 group 之间重叠的时间间隔不会 合并。另外，此时我不关心 id 列发生了什么。
我知道 lubridate 包中包含与区间相关的函数，但我不知道如何将它们应用到这个用例中。
我怎样才能做到这一点？
my_time_intervals %>%
group_by(group) %>% arrange(start_time, by_group = TRUE) %>%
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
根据 OP 的要求进行解释：
我正在制作另一个数据集，它在每个组中有更多的重叠时间，这样解决方案就会得到更多的曝光，希望能更好地掌握；
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")
)
所以让我们看一下此数据集的 indx 列。我在 group 列中添加 arrange 以查看所有相同的分组行；但是，如您所知，因为我们有 group_by(group) 我们实际上并不需要它。
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
如您所见，在第一组中，我们有 3 个具有重叠数据点的不同时间段和一个在该组中没有重叠条目的数据点。 indx 列将这些数据点分为 4 组（即 0, 1, 2, 3）。稍后在解决方案中，当我们 group_by(indx,group) 时，我们将这些重叠的每一个都放在一起，我们得到第一个开始时间和最后一个结束时间以产生所需的输出。
只是为了使解决方案更容易出错（以防我们有一个数据点比一组（组和索引）中的所有其他数据点开始得早但结束得晚，就像我们在数据点中拥有的那样6 和 7 的 ID）我将 first() 和 last() 更改为 min() 和 max().
所以...
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
我们使用每个重叠时间和日期的唯一索引来获取每个时间和日期的时间段（开始和结束）。
除此之外，您需要阅读 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_time 排序，然后在子表中嵌套并使用 reduce 在相关时合并行（使用 Masoud 的数据）：
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
我认为这个问题可以通过 dplyr 和 ivs 包的组合非常优雅地解决，这个包是一个用于处理区间向量的包，就像这样。
这里的关键是iv_group()，它合并了所有重叠的区间和returns合并所有重叠后剩下的一组区间。
library(tidyverse)
library(lubridate)
library(ivs)
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")
)
# Combine the start/end boundaries into a single interval vector
my_time_intervals <- my_time_intervals %>%
mutate(time = iv(start_time, end_time), .keep = "unused")
# Note that these are half-open intervals, but that won't affect anything here
my_time_intervals
#> # A tibble: 8 × 3
#> id group time
#> <int> <int> <iv<dttm>>
#> 1 1 1 [2018-04-12 11:15:03, 2018-05-14 02:32:10)
#> 2 2 1 [2018-07-04 02:53:20, 2018-07-14 18:09:01)
#> 3 3 1 [2018-05-07 13:02:04, 2018-05-23 08:13:06)
#> 4 4 2 [2018-02-28 17:43:29, 2018-04-20 03:48:40)
#> 5 5 2 [2018-04-20 01:19:52, 2018-08-12 12:56:37)
#> 6 6 2 [2018-04-18 20:47:22, 2018-04-19 16:07:29)
#> 7 7 2 [2018-10-02 14:08:03, 2018-11-08 00:01:23)
#> 8 8 3 [2018-03-11 22:30:51, 2018-10-20 21:01:42)
# For each `group` compute the interval "groups". These represent the collapsed
# date-time intervals that you are looking for.
my_time_intervals %>%
group_by(group) %>%
summarise(time = iv_groups(time), .groups = "drop")
#> # A tibble: 5 × 2
#> group time
#> <int> <iv<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)
由 reprex package (v2.0.1)
于 2022-04-05 创建