如何将重叠的时间段压缩/合并？

Question

如何将重叠的时间段压缩/合并？

21

我有一个大的数据集，其中包含由“开始”和“结束”列定义的时间段。一些时期重叠。

我想将所有重叠的时间段组合（压平/合并/折叠）为一个“开始”值和一个“结束”值。

以下是一些示例数据：

  ID      start        end
1  A 2013-01-01 2013-01-05
2  A 2013-01-01 2013-01-05
3  A 2013-01-02 2013-01-03
4  A 2013-01-04 2013-01-06
5  A 2013-01-07 2013-01-09
6  A 2013-01-08 2013-01-11
7  A 2013-01-12 2013-01-15

期望结果：

  ID      start        end
1  A 2013-01-01 2013-01-06
2  A 2013-01-07 2013-01-11
3  A 2013-01-12 2013-01-15

我尝试过的方法：

  require(dplyr)
  data <- structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L), class = "factor", .Label = "A"), 
    start = structure(c(1356998400, 1356998400, 1357084800, 1357257600, 
    1357516800, 1357603200, 1357948800), tzone = "UTC", class = c("POSIXct", 
    "POSIXt")), end = structure(c(1357344000, 1357344000, 1357171200, 
    1357430400, 1357689600, 1357862400, 1358208000), tzone = "UTC", class = c("POSIXct", 
    "POSIXt"))), .Names = c("ID", "start", "end"), row.names = c(NA, 
-7L), class = "data.frame")

remove.overlaps <- function(data){
data2 <- data
for ( i in 1:length(unique(data$start))) {
x3 <- filter(data2, start>=data$start[i] & start<=data$end[i])
x4 <- x3[1,]
x4$end <- max(x3$end)
data2 <- filter(data2, start<data$start[i] | start>data$end[i])
data2 <- rbind(data2,x4)  
}
data2 <- na.omit(data2)}

data <- remove.overlaps(data)

- Jonno Bourne

6个回答

17

@David Arenburg的回答很好，但我遇到了一个问题，早期的时间间隔在后期时间间隔之后结束 - 但是在summarise调用中使用last导致了错误的结束日期。我建议将first(start)和last(end)改为min(start)和max(end)

data %>%
  group_by(ID) %>%
  mutate(indx = c(0, cumsum(as.numeric(lead(start)) >
                     cummax(as.numeric(end)))[-n()])) %>%
  group_by(ID, indx) %>%
  summarise(start = min(start), end = max(end))

此外，正如 @Jonno Bourne所提到的，在应用该方法之前，按 start 和任何分组变量进行排序是很重要的。

- zack

你能解释一下[-n()]的含义吗？我知道n()表示行数，[]用于索引，但cumsum是一个整数。所以如果我们按ID分组并且有7行，那么在向量中获取整数的第-7个索引意味着什么？c(0, 2[-7])如何返回1？ - Nicholas Hassan

使用?[："对于仅限索引的情况，i、j等只能是逻辑向量，指示要选择的元素/切片。如果需要匹配相应的范围，则这些向量将被循环使用。i、j等也可以是负整数，表示要从选择中排除的元素/切片。"因此，[-n()]会留出组的最后一个元素。 - zack

6

为了完整起见，Bioconductor上的IRanges软件包有一些很棒的功能，可以用来处理日期或日期时间范围。其中之一是reduce()函数，它可以合并重叠或相邻的范围。

然而，这也有一个缺点，因为IRanges只能处理整数范围（因此得名），所以使用IRanges函数的便利性牺牲了将Date或POSIXct对象进行转换的代价。

此外，似乎dplyr与IRanges不兼容（至少在我有限的dplyr经验中是这样），因此我使用data.table。

library(data.table)
options(datatable.print.class = TRUE)
library(IRanges)
library(lubridate)

setDT(data)[, {
  ir <- reduce(IRanges(as.numeric(start), as.numeric(end)))
  .(start = as_datetime(start(ir)), end = as_datetime(end(ir)))
}, by = ID]

       ID      start        end
   <fctr>     <POSc>     <POSc>
1:      A 2013-01-01 2013-01-06
2:      A 2013-01-07 2013-01-11
3:      A 2013-01-12 2013-01-15

一个代码变体是

setDT(data)[, as.data.table(reduce(IRanges(as.numeric(start), as.numeric(end))))[
  , lapply(.SD, as_datetime), .SDcols = -"width"], 
  by = ID]

在这两种变体中，使用了lubridate包中的as_datetime()，它在将数字转换为POSIXct对象时省去了指定起始时间的步骤。

很有趣的是，可以看到IRanges方法与David's answer进行基准比较。

- Uwe

除了折叠具有重叠间隔的行之外，如果我还想获取另一列的最小值，我们该怎么做？例如，

data <- structure(list(ID = structure(c(1L, 1L, 1L, 1L), .Label = "A", class = "factor"), start = structure(c(15706, 15706, 15707, 15709), class = "Date"), end = structure(c(15710, 15710, 15708, 15711), class = "Date"), value = c(3L, 7L, 8L, 5L)), class = "data.frame", row.names = c(NA, -4L))

，那么 value 列将给出 3。 - HNSKD

@HNSKD，请将此作为单独的问题发布，并附上自己的[mcve]。但是，一个快速的答案是：

library(data.table); setDT(data)[order(start, end), grp := cumsum(cummax(shift(as.numeric(end), fill = 0)) < as.numeric(start))][, .(start = min(start), end = max(end), value = min(value)), by = grp]

- Uwe

3

我认为你可以使用dplyr和ivs包来很好地解决这个问题，该包被设计用于处理区间向量，就像你在这里所拥有的一样。它受IRanges的启发，但更适合在tidyverse中使用，并且完全通用，因此可以自动处理日期间隔（无需转换为数字再转回来）。

关键是将开始/结束边界组合成一个单独的区间向量列，然后使用iv_groups()。这将合并区间向量中所有重叠的区间，并返回合并重叠之后剩下的区间。

看起来你想按ID进行操作，因此我还按ID进行了分组。

library(ivs)
library(dplyr)

data <- tribble(
  ~ID,       ~start,         ~end,
  "A", "2013-01-01", "2013-01-05",
  "A", "2013-01-01", "2013-01-05",
  "A", "2013-01-02", "2013-01-03",
  "A", "2013-01-04", "2013-01-06",
  "A", "2013-01-07", "2013-01-09",
  "A", "2013-01-08", "2013-01-11",
  "A", "2013-01-12", "2013-01-15"
) %>%
  mutate(
    start = as.Date(start),
    end = as.Date(end)
  )

data
#> # A tibble: 7 × 3
#>   ID    start      end       
#>   <chr> <date>     <date>    
#> 1 A     2013-01-01 2013-01-05
#> 2 A     2013-01-01 2013-01-05
#> 3 A     2013-01-02 2013-01-03
#> 4 A     2013-01-04 2013-01-06
#> 5 A     2013-01-07 2013-01-09
#> 6 A     2013-01-08 2013-01-11
#> 7 A     2013-01-12 2013-01-15

# Combine `start` and `end` into a single interval vector column
data <- data %>%
  mutate(interval = iv(start, end), .keep = "unused")

# Note that this is a half-open interval!
data  
#> # A tibble: 7 × 2
#>   ID                    interval
#>   <chr>               <iv<date>>
#> 1 A     [2013-01-01, 2013-01-05)
#> 2 A     [2013-01-01, 2013-01-05)
#> 3 A     [2013-01-02, 2013-01-03)
#> 4 A     [2013-01-04, 2013-01-06)
#> 5 A     [2013-01-07, 2013-01-09)
#> 6 A     [2013-01-08, 2013-01-11)
#> 7 A     [2013-01-12, 2013-01-15)

# It seems like you'd want to group by ID, so lets do that.
# Then we use `iv_groups()` which merges all overlapping intervals and returns
# the intervals that remain after all the overlaps have been merged
data %>%
  group_by(ID) %>%
  summarise(interval = iv_groups(interval), .groups = "drop")
#> # A tibble: 3 × 2
#>   ID                    interval
#>   <chr>               <iv<date>>
#> 1 A     [2013-01-01, 2013-01-06)
#> 2 A     [2013-01-07, 2013-01-11)
#> 3 A     [2013-01-12, 2013-01-15)

^{由 reprex 包 (v2.0.1) 于2022年4月5日创建}

- Davis Vaughan

有没有一种简单的方法将区间转换回“起始”和“结束”列？ - Maël

2

iv_start()和iv_end()分别提取起始/结束向量 - Davis Vaughan

非常好的解决方案！我在使用epi包时遇到了问题，因为coarse.Lexis函数似乎删除了一些区间。谢谢 :) - Kirsten

2

看起来我来晚了一点，但是我使用 data.table 重写了 @zach 的代码。我没有进行全面的测试，但是这个版本似乎比 tidy 版本快了约20%。（我无法测试 IRange 方法，因为该包尚未适用于 R 3.5.1）此外，值得一提的是，被接受的答案没有捕捉到一个日期范围完全在另一个日期范围内的边缘情况（例如，2018-07-07 到 2017-07-14 在 2018-05-01 到 2018-12-01 内）。@zach 的答案捕捉到了这种边缘情况。

library(data.table)

start_col = c("2018-01-01","2018-03-01","2018-03-10","2018-03-20","2018-04-10","2018-05-01","2018-05-05","2018-05-10","2018-07-07")
end_col = c("2018-01-21","2018-03-21","2018-03-31","2018-04-09","2018-04-30","2018-05-21","2018-05-26","2018-05-30","2018-07-14")

# create fake data, double it, add ID
# change row 17, such that each ID grouping is a little different
# also adds an edge case in which one date range is totally within another
# (this is the edge case not currently captured by the accepted answer)
d <- data.table(start_col = as.Date(start_col), end_col = as.Date(end_col))
d2<- rbind(d,d)
d2[1:(.N/2), ID := 1]
d2[(.N/2 +1):.N, ID := 2]
d2[17,end_col := as.Date('2018-12-01')]

# set keys (also orders)
setkey(d2, ID, start_col, end_col)

# get rid of overlapping transactions and do the date math
squished <- d2[,.(START_DT = start_col, 
                  END_DT = end_col, 
                  indx = c(0, cumsum(as.numeric(lead(start_col)) > cummax(as.numeric(end_col)))[-.N])),
               keyby=ID
               ][,.(start=min(START_DT), 
                    end = max(END_DT)),
                 by=c("ID","indx")
                 ]

- enmyj

1

通过更快的`data.table`解决方案进行基准测试

首先，我同意@enmyj和@zach的观点，即接受的答案中的解决方案在一个范围完全位于另一个范围内时会给出错误的结果。

一种更快的方法，它让人想起接受的答案中提出的方法:

按ID排序，然后按所有日期(start和end组合)排序。
将开始日期数的累计总和减去结束日期数的累计总和。
找到这个总和为0的索引。这些行上的日期是每个重叠日期范围集合的结束日期。下一行上的日期是下一个重叠日期范围集合的开始日期。这些索引也可用于轻松执行其他列的汇总计算。

这仅涉及几个向量化调用和没有分组操作，因此非常高效。

作为一个函数：

flatten <- function(dt) {
  setorder(dt[, rbindlist(.(.(ID, start, 1L), .(ID, end, -1L)))], V1, V2)[
    , .(
      ID = V1[i <- which(!cumsum(V3))],
      start = V2[c(1L, i[-length(i)] + 1L)],
      end = V2[i]
    )
  ]
}

基准测试

基准测试使用一个相对较大的 data.table。

library(data.table)
library(dplyr)
library(ivs)

data <- data.table(
  ID = sample(1e3, 1e5, 1),
  start = as.Date(sample(1e4:2e4, 1e5, 1), origin = "1970-01-01")
)[, end := start + sample(100)]

fCum <- function(dt) {
  # adapted from https://dev59.com/qF4b5IYBdhLWcg3wlihP#47337684
  dt %>%
    arrange(ID, start) %>%
    group_by(ID) %>%
    mutate(indx = c(0, cumsum(as.numeric(lead(start)) >
                                cummax(as.numeric(end)))[-n()])) %>%
    group_by(ID, indx) %>%
    reframe(start = min(start), end = max(end)) %>%
    select(-indx)
}

fivs <- function(dt) {
  # adapted from https://dev59.com/qF4b5IYBdhLWcg3wlihP#71754454
  dt %>%
    mutate(interval = iv(start, end), .keep = "unused") %>%
    group_by(ID) %>%
    reframe(interval = iv_groups(interval)) %>%
    mutate(start = iv_start(interval), end = iv_end(interval)) %>%
    select(-interval)
}

squish <- function(dt) {
  # adapted from https://dev59.com/qF4b5IYBdhLWcg3wlihP#53890653
  setkey(dt, ID, start, end)
  dt[,.(START_DT = start, 
        END_DT = end, 
        indx = c(0, cumsum(as.numeric(lead(start)) > cummax(as.numeric(end)))[-.N])),
     keyby=ID
  ][,.(start=min(START_DT), 
       end = max(END_DT)),
    by=c("ID","indx")
  ][, indx := NULL]
}

时间:

microbenchmark::microbenchmark(
  flatten = flatten(dt),
  fCum = setDT(fCum(dt)),
  fivs = setDT(fivs(dt)),
  squish = squish(dt),
  times = 10,
  check = "equal",
  setup = {dt <- copy(data)}
)
#> Unit: milliseconds
#>     expr       min        lq       mean     median        uq       max neval
#>  flatten   11.4732   11.8141   13.86760   12.36580   15.9228   19.1775    10
#>     fCum 1827.1197 1876.7701 1898.24285 1908.88640 1926.6548 1939.2919    10
#>     fivs  160.2568  163.9617  173.31783  173.32095  177.3789  192.7755    10
#>   squish   62.5197   64.9126   66.26047   65.08515   67.1685   70.9916    10

聚合其他列

flatten使用的方法也使得在data.table中聚合其他列变得容易。

data[, v := runif(1e5)]

setorder(data[, rbindlist(.(.(ID, start, 1L, 0), .(ID, end, -1L, v)))], V1, V2)[
  , .(
    ID = V1[i <- which(!cumsum(V3))],
    start = V2[c(1L, i[-length(i)] + 1L)],
    end = V2[i],
    v = diff(c(0, cumsum(V4)[i]))
  )
]
#>          ID      start        end          v
#>     1:    1 1997-09-25 1997-09-27 0.40898255
#>     2:    1 1997-11-09 1997-11-30 0.44067634
#>     3:    1 1998-04-27 1998-07-17 1.73142460
#>     4:    1 1999-08-05 1999-11-05 0.41103832
#>     5:    1 1999-12-09 2000-01-26 0.90639735
#>    ---                                      
#> 60286: 1000 2023-01-06 2023-03-28 0.54727106
#> 60287: 1000 2023-07-20 2023-10-16 1.74270130
#> 60288: 1000 2024-03-24 2024-06-23 0.07110824
#> 60289: 1000 2024-07-13 2024-07-31 0.63888263
#> 60290: 1000 2024-10-02 2024-10-19 0.22872167

- jblood94

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- David Arenburg · Accepted Answer

以下是可能的解决方案。基本思路是使用cummax函数将滞后的start日期与“直到现在”的最大结束日期进行比较，并创建一个索引，将数据分成组。

data %>%
  arrange(ID, start) %>% # as suggested by @Jonno in case the data is unsorted
  group_by(ID) %>%
  mutate(indx = c(0, cumsum(as.numeric(lead(start)) >
                     cummax(as.numeric(end)))[-n()])) %>%
  group_by(ID, indx) %>%
  summarise(start = first(start), end = last(end))

# Source: local data frame [3 x 4]
# Groups: ID
# 
#   ID indx      start        end
# 1  A    0 2013-01-01 2013-01-06
# 2  A    1 2013-01-07 2013-01-11
# 3  A    2 2013-01-12 2013-01-15

如何将重叠的时间段压缩/合并？

通过更快的data.table解决方案进行基准测试

基准测试

聚合其他列

通过更快的`data.table`解决方案进行基准测试