折叠和合并重叠的时间间隔
Posted
技术标签:
【中文标题】折叠和合并重叠的时间间隔【英文标题】：Collapse and merge overlapping time intervals 【发布时间】：2022-01-06 18:12:20 【问题描述】：我正在开发一个基于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
请注意，重叠在不同groups之间的时间间隔不合并。另外，此时我不关心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 = first(start_time), end_time = last(end_time)) %>% select(-indx)
感谢@Masoud 的建议。我不确定代码是什么意思，但我试过了，结果与问题中我想要的输出不匹配（我会将不正确的输出与您的代码一起附加到问题中，以便您查看）。你能解释一下你的代码是做什么的吗？谢谢！
你错过了arrange。效果很好。
【参考方案1】：
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) 时，我们将这些重叠的每一个放在一起，并获得第一个开始时间和最后一个结束时间以产生所需的输出。
只是为了使解决方案更容易出错（以防我们有一个数据点开始较早但比一组（组和索引）中的所有其他数据点结束得晚，就像我们在具有 id 的数据点中所拥有的一样6 和 7) 我将 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 的信息，并查看这两个函数针对此特定问题的输出，以了解为什么我进行的比较最终为我们提供了每个函数的唯一标识符重叠的时间和日期。
希望这会有所帮助，因为这是我最好的。
【讨论】：
谢谢@Masoud，这次代码对我有用（我将删除对原始问题的编辑）。我很难破译mutate() 行在做什么，你能解释一下吗？谢谢！
具体来说，我不明白cumsum(as.numeric(lead(start_time)) > cummax(as.numeric(end_time)) )[-n()] 在做什么......有人可以解释一下吗？谢谢！
@hpy 抱歉，今天有点忙来说明这一点。但是您可以做的是改变整个比较的每个部分并查看它们的输出。例如，mutate(cumsum(as.numeric(lead(start_time))) 并查看输出。
lead 从数据末尾删除一个条目并放入NA。阅读?lead()。看看lead(my_time_intervals$start_time)。我正在通过[-n()] 摆脱它。 n() in tidyverse 给出最后一行。我需要与mutate() 的数据相同的大小；所以，我在开头添加0。为什么是0？因为第一行与后面的相同（在重叠方面）。 cumsum 将从 0 开始。请查看管道内的输出，因为在管道外部您看不到分组的效果，也不能使用 n()（对于后者，您可以手动定义最后一行）。干杯。
@hpy 阅读上述评论。同时，您需要单独阅读本解决方案中使用的所有功能，然后在解决方案中逐步了解它们的使用。在 R 中为每个函数键入以下命令：?name_of_the_package::name_of_the_function()。这将帮助您更好地理解单独的功能，然后在此特定解决方案中研究它们是下一步。【参考方案2】：
另一个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)
【讨论】：
谢谢@avid_user，有一个问题：g = new_end_time != end_time | is.na(new_end_time) 是什么意思？我不明白 = 后跟 != 然后 |...
@hpy new_end_time != end_time | is.na(new_end_time) 是一个逻辑表达式，如果 new_end_time 不等于 (!=) end_time 或 (|) new_end_time，则返回 TRUE等于NA。结果分配给变量g。这个想法是，对于与下一个start_time 重叠的end_time，end_time 被下一个end_time 替换。 g 允许我在使用 filter 与当前重叠行合并后删除不需要的“下一行”。
谢谢你的解释，有道理！但是，在运行代码时在我的输出中的group == 2 中，我看到了从 2018-02-28 到 2018-04-19 的时间间隔，而它应该是从 2018-02-28 到 2018-08-12。这是因为原始数据中有 三个 重叠区间而不是两个。在我真实的完整数据集中，可能有不止三个重叠区间。您的解决方案可以解决这个问题吗？谢谢！【参考方案3】：
我们可以按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
【讨论】：
干杯伙伴。将您的输出与我的输出进行比较。它们并不完全相同（我猜你的方法假设如果一个事件开始得越早，它也应该结束得越早，不确定）。 我看不出有什么区别，你能告诉我哪一行和哪一列吗？ 例如前 4 或 5 行中的所有开始时间（不是日期）。 对，我不在电脑上，所以稍后我会测试，但我的值不在你的原始数据中，这很奇怪，我稍后会检查它以供评论跨度> 我刚做了，结果ymd_hms默认有tz="UTC"，但是使用tribbles将时区更改为我的本地时区“CEST”，然后tibble的打印方法没有'不显示时区，所以你无法分辨。因此数据是“正确的”，但显示是错误的。不确定它是否属于错误，但它肯定是违反直觉的，我将提交一个 github 问题。以上是关于折叠和合并重叠的时间间隔的主要内容，如果未能解决你的问题，请参考以下文章