Question

我有一个如下所示的数据框：

w<-read.table(header=TRUE,text="
start.date   end.date
2006-06-26 2006-07-24
2006-07-19 2006-08-16
2007-06-09 2007-07-07
2007-06-24 2007-07-22
2007-07-03 2007-07-31
2007-08-04 2007-09-01
2007-08-07 2007-09-04
2007-09-05 2007-10-03
2007-09-14 2007-10-12
2007-10-19 2007-11-16
2007-11-17 2007-12-15
2008-06-18 2008-07-16
2008-06-28 2008-07-26
2008-07-11 2008-08-08
2008-07-23 2008-08-20")

我正在尝试获取将重叠的开始日期和结束日期组合到一个日期范围内的输出。所以对于示例集，我想得到：

w<-read.table(header=TRUE,text="
start.date   end.date
2006-06-26 2006-08-16
2007-06-09 2007-07-31
2007-08-04 2007-09-04
2007-09-05 2007-10-12
2007-10-19 2007-11-16
2007-11-17 2007-12-15
2008-06-18 2008-08-20")

问题类似于Date roll-up in R，但我不需要做任何类型的小组，因此答案令人困惑。

此外，针对我的问题建议的代码不适用于我的数据框的某些部分，例如：

x<-read.table(header=TRUE,text="start.date   end.date
2006-01-19 2006-01-20
2006-01-25 2006-01-29
2006-02-24 2006-02-25
2006-03-15 2006-03-22
2006-04-29 2006-04-30
2006-05-24 2006-05-25
2006-06-26 2006-08-16
2006-07-05 2006-07-10
2006-07-12 2006-07-21
2006-08-13 2006-08-15
2006-08-18 2006-08-19
2006-08-28 2006-09-02")

我很困惑，为什么不呢？

Answer 1

试试这个：

w[] <- lapply(w, function(x) as.Date(x, '%Y-%m-%d'))
w <- w[order(w$start.date),] # sort the data by start dates if already not sorted
w$group <- 1:nrow(w) # common intervals should belong to same group
merge.indices <- lapply(2:nrow(w), function(x) {
                    indices <- which(findInterval(w$end.date[1:(x-1)], w$start.date[x])==1)
                    if (length(indices) > 0) indices <- c(indices, x) 
                    indices})
# assign the intervals the right groups
for (i in 1:length(merge.indices)) {
  if (length(merge.indices[[i]]) > 0) {
    w$group[merge.indices[[i]]] <- min(w$group[merge.indices[[i]]])
  }
}

do.call(rbind, lapply(split(w, w$group), function(x) data.frame(start.date=min(x[,1]), end.date=max(x[,2]))))

概念上将重叠区间合并到同一组中，如下所示：

带输出：

   start.date   end.date
1  2006-01-19 2006-01-20
2  2006-01-25 2006-01-29
3  2006-02-24 2006-02-25
4  2006-03-15 2006-03-22
5  2006-04-29 2006-04-30
6  2006-05-24 2006-05-25
7  2006-06-26 2006-08-16
11 2006-08-18 2006-08-19
12 2006-08-28 2006-09-02

Answer 2

IRanges package on Bioconductor包含函数reduce，可用于将重叠的开始日期和结束日期合并到一个日期范围内。

IRanges适用于整数范围，因此您必须将数据从Date转换为integer并返回。这可以包含在一个函数中：

collapse_date_ranges <- function(w, min.gapwidth = 1L) {
  library(data.table)
  library(magrittr)
  IRanges::IRanges(start = as.integer(as.Date(w$start.date)), 
                   end = as.integer(as.Date(w$end.date))) %>% 
    IRanges::reduce(min.gapwidth = min.gapwidth) %>% 
    as.data.table() %>% 
    .[, lapply(.SD, lubridate::as_date),
      .SDcols = c("start", "end")]
}

collapse_date_ranges(w, 0L)
#        start        end
#1: 2006-06-26 2006-08-16
#2: 2007-06-09 2007-07-31
#3: 2007-08-04 2007-09-04
#4: 2007-09-05 2007-10-12
#5: 2007-10-19 2007-11-16
#6: 2007-11-17 2007-12-15
#7: 2008-06-18 2008-08-20

collapse_date_ranges(x, 0L)
#        start        end
#1: 2006-01-19 2006-01-20
#2: 2006-01-25 2006-01-29
#3: 2006-02-24 2006-02-25
#4: 2006-03-15 2006-03-22
#5: 2006-04-29 2006-04-30
#6: 2006-05-24 2006-05-25
#7: 2006-06-26 2006-08-16
#8: 2006-08-18 2006-08-19
#9: 2006-08-28 2006-09-02

说明

为了避免名称冲突，我更喜欢使用双冒号操作符::来访问IRanges包中的单个函数，而不是使用加载整个包的library(IRanges)。
开始日期和结束日期转换为整数（as.Date只是为了确保正确的类）并创建一个IRanges对象。
reduce做了所有艰苦的工作。此处需要参数min.gapwidth，因为默认情况下reduce会折叠相邻的范围（见下文）。
最后，结果从整数转换回日期。（您也可以使用dplyr代替data.table。）
该解决方案适用于样本数据集w和x。 x包含一个特殊情况，其中一个日期范围将其他日期范围嵌入到最大范围内。

附录：折叠相邻日期范围

OP给出的样本结果显示相邻数据范围应该不折叠，例如，2007-10-19到2007-11-16的范围与范围{{1尽管第二个范围仅在第一个范围结束后的一天开始，但是2007-11-17。

。}

以防万一，相邻日期范围将折叠，这可以通过使用2007-12-15参数的默认值来实现：

min.gapwidth

Answer 3

解。

w<-read.table(header=TRUE, stringsAsFactor=F, text="
start.date   end.date
2006-06-26 2006-07-24
2006-07-19 2006-08-16
2007-06-09 2007-07-07
2007-06-24 2007-07-22
2007-07-03 2007-07-31
2007-08-04 2007-09-01
2007-08-07 2007-09-04
2007-09-05 2007-10-03
2007-09-14 2007-10-12
2007-10-19 2007-11-16
2007-11-17 2007-12-15
2008-06-18 2008-07-16
2008-06-28 2008-07-26
2008-07-11 2008-08-08
2008-07-23 2008-08-20")

w <- data.frame(lapply(w, as.Date))

library(lubridate)

idx.rle <- rle(as.numeric(sapply(1:(nrow(w)-1), function(i) int_overlaps(interval(w[i,1],w[i,2]), interval(w[i+1,1],w[i+1,2])))))




i.starts <- nrow(w)-rev(cumsum(rev(idx.rle$length)))
i.ends <-  1+cumsum(idx.rle$length)

 do.call(rbind,
    lapply(1:length(idx.rle$lengths),
           function(i) {
               i.start <- i.starts[i]
               i.end <-  i.ends[i]
               if(idx.rle$values[i]==1) {
                   d <- data.frame(start.date=w[i.start,1],
                                   end.date=max(w[i.start:i.end,2]) );
                   names(d) <- names(w);
                   d
               } else {
                   if(idx.rle$lengths[i]>1&i>1&i<length(idx.rle$lengths)) {
                       data.frame(w[(i.start+1):(i.end-1),] )
                   } else {
                       if (idx.rle$lengths[i]>=1&i==1) {
                           data.frame(w[(i.start):(i.end-1),])
                       } else {
                           if(idx.rle$lengths[i]>=1&i==length(idx.rle$lengths)) data.frame(w[(i.start+1):(i.end),] ) 
                       }
                   }
               }
           }))

在R

3 个答案:

说明

附录：折叠相邻日期范围