如何展平/合并重叠的时间段

时间:2015-03-09 08:58:02

标签: r date datetime lubridate

我有一个大型的时间段数据集,由一个' start'定义。和一个'结束'柱。有些时期重叠。

我想将所有重叠的时间段合并(展平/合并/折叠),以便有一个“开始”#39;价值和一个结束'值。

一些示例数据:

  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)

4 个答案:

答案 0 :(得分:13)

这是一个可能的解决方案。这里的基本想法是将滞后start日期与最大结束日期进行比较&#34;直到现在&#34;使用cummax函数创建一个将数据分成组的索引

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

答案 1 :(得分:10)

@David Arenburg的答案很棒 - 但我遇到了一个问题,其中较早的间隔在稍后的间隔后结束 - 但在last电话中使用summarise会导致错误的结束日期。我建议将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和任何分组变量排序很重要。

答案 2 :(得分:3)

为了完整起见,the IRanges package on Bioconductor有一些简洁的功能,可用于处理日期或日期时间范围。其中一个是合并重叠或相邻范围的reduce()函数。

但是,有一个缺点,因为IRanges适用于整数范围(因此名称),因此使用IRanges函数的便利性是以转换Date或{{为代价的。 1}}来回的对象。

此外,似乎POSIXctdplyr的效果不佳(至少根据我对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] 包中的as_datetime(),在将数字转换为lubridate个对象时,备用来指定原点。

看到POSIXct方法与David's answer的基准比较会很有趣。

答案 3 :(得分:0)

我参加聚会似乎有点晚了,但是我使用了@zach的代码,并使用下面的data.table重新编写了代码。我没有进行全面的测试,但这似乎比tidy版本快了20%。 (我无法测试IRange方法,因为该软件包尚不适用于R 3.5.1)

另外,首先,被接受的答案不能捕获其中一个日期范围完全在另一个日期范围内的极端情况(例如2018-07-072017-07-142018-05-01至{{ 1}})。 @zach的答案确实捕获了这种极端情况。

2018-12-01