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

问题描述 投票：0回答：4

我正在开发一个基于 

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
    变量只是数据框中每一行的唯一ID。

  3. 时间间隔的开始和结束以 

    start_time
    形式存储在 
    end_time
    和 
    lubridate
    中。

  4. 有些时间间隔重叠，有些则不重叠，而且它们不总是按顺序排列。例如，第 

    1
    行与第 
    3
    行重叠，但它们都不与第 
    2
    行重叠。

  5. 两个以上的区间可能会相互重叠，并且某些区间完全落在其他区间内。请参阅 

    4
    中的第 
    6
    至 
    group == 2
    行。

我想要的是在每个

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

 包包含与间隔相关的函数，但我不知道如何将它们应用到这个用例中。

我怎样才能实现这个目标？

r dataframe datetime tidyverse lubridate
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
 列。我通过 
arrange
 列添加 
group
 来查看所有相同分组的行；但是，如您所知，因为我们有 
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
 的内容，并查看这两个函数针对此特定问题的输出，以了解为什么我所做的比较最终为我们提供了每个函数的唯一标识符重叠时间和日期。

    



      

      
      
      

      

        

          

            

              
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)

    



      

      
      
      

      

        

          

            

              
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

    



      

      
      
      

      

        

          

            

              
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 包于 2022 年 4 月 5 日创建（v2.0.1）
    



      

      
    

  

  

    
最新问题


  





  

    © www.soinside.com 2019 - 2024. All rights reserved.