合并重叠时间间隔

7

我正在开发一个基于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的一些说明:

  1. 数据通过group变量分成了三组。

  2. id变量只是数据框中每行的唯一标识符。

  3. 时间间隔的开始和结束时间以lubridate形式存储在start_timeend_time中。

  4. 一些时间间隔重叠,一些不重叠,并且它们不总是按顺序排列。例如,第1行与第3行重叠,但它们都不与第2行重叠。

  5. 超过两个时间间隔可能相互重叠,并且某些时间间隔完全包含在其他时间间隔中。请参见group == 2中的第46行。

我想要的是,在每个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”包包含与间隔相关的函数,但我无法弄清如何将它们应用于此用例。
我该如何实现这一点?

1
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) - M--
感谢@Masoud的建议。我不确定这段代码的含义,但我尝试了一下,结果与我在问题中期望的输出不符合(我将使用您的代码追加错误输出到问题中,以便您查看)。您可以解释一下您的代码是做什么的吗?非常感谢! - hpy
1
你错过了 arrange。它完美地工作了。 - M--
4个回答

9
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

我们使用每个重叠时间和日期的唯一索引来获取它们的区间(起始和结束)。
除此之外,您需要阅读有关 cumsumcummax 的内容,并查看这两个函数在此特定问题上的输出,以了解为什么我所做的比较最终为我们提供了每个重叠时间和日期的唯一标识符。
希望这可以帮助你,因为这是我最好的努力。

具体来说,我不明白 cumsum(as.numeric(lead(start_time)) > cummax(as.numeric(end_time)) )[-n()] 是在做什么... 有人能解释一下吗?谢谢! - hpy
1
@hpy 抱歉,今天有点忙,暂时无法为您进行说明。但是您可以对该整个比较的每个部分进行变异并查看它们的输出。例如,mutate(cumsum(as.numeric(lead(start_time))) 并查看输出结果。 - M--
谢谢@Masoud,我尝试分解mutate()调用,这确实帮助我更好地理解它。话虽如此,我仍然不明白indx如何变成数字并在每个连续时间间隔中递增。如果您有机会再解释一下这个过程,我将非常感激! - hpy
1
lead()函数从数据末尾删除一个条目并将其替换为NA。请查看?lead()。看看lead(my_time_intervals$start_time)。我通过[-n()]来去掉它。在 tidyverse 中,n()代表最后一行。mutate()需要与数据相同的大小,因此我在开头添加了0。为什么是0? 因为第一行与其后面的行相同(重叠)。 cumsum从0开始计算。请查看管道中的输出,因为在其外部您无法查看分组的效果,也无法使用n()(不过您可以手动定义最后一行)。干杯。 - M--
1
@hpy,请阅读上面的评论。同时,您需要单独阅读有关此解决方案中使用的所有函数,然后按步骤跟随它们的使用。对于每个函数,在R中键入以下命令:?name_of_the_package::name_of_the_function()。这将帮助您更好地理解函数的独立性,然后调查它们在特定解决方案中的使用是下一步。 - M--
显示剩余2条评论

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
1
@hpy new_end_time != end_time | is.na(new_end_time) 是一个逻辑表达式,如果 new_end_time 不等于 (!=) end_time 或者 (|) new_end_time 等于 NA,则返回 TRUE。结果被赋值给变量 g。这个想法是对于与下一个 start_time 重叠的 end_time,用下一个 end_time 替换 end_time。使用 filterg 与当前重叠行合并后,可以删除不需要的“下一行”。 - acylam
谢谢您的解释,我明白了!然而,在运行您的代码时,当group == 2时,我在输出中看到一个区间从2018-02-28到2018-04-19,但实际上应该是从2018-02-28到2018-08-12。这是因为原始数据中有三个重叠的区间,而不是两个。在我的真实完整数据集中,可能会有多于三个的重叠区间。您的解决方案能够解决这个问题吗?谢谢! - hpy

1
我们可以按照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

干杯,伙计。比较一下你的输出和我的。它们并不完全相同(我猜你的方法假设如果一个事件开始得更早,那么它也应该更早结束,但我不确定)。 - M--
我看不出区别,你能告诉我是哪一行和哪一列吗? - moodymudskipper
例如,在前4或5行中,只返回开始时间(而不是日期)。 - M--
好的,我现在不在电脑旁边,稍后再测试。但是我手头的数值并不在你原始数据中,这很奇怪,我稍后会检查一下。感谢你的评论。 - moodymudskipper
你有机会调查这个问题吗?(出于好奇心询问) - M--
1
我刚刚试了一下,发现 ymd_hms 默认的时区是 tz="UTC",但使用 tribbles 后会将时区更改为我的本地时区 "CEST",然后 tibble 的打印方法不会显示时区,因此你无法知道。因此数据是“正确”的,但显示是错误的。不确定它是否符合 bug 的标准,但肯定是违反直觉的,我会在 GitHub 上提交一个问题。 - moodymudskipper

1
我认为这个问题可以非常优雅地通过dplyr和ivs包的组合来解决,这是一个用于处理像这样的区间向量的包。
关键在于iv_group(),它合并所有重叠的区间,并返回在所有重叠被合并后剩余的区间集合。
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 包 (v2.0.1) 于2022年4月5日创建


这看起来很优雅,是个绝妙的解决方案,谢谢@Davis Vaughan!我会把它加入我的工具箱。 - hpy

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接