在非重叠间隔上合并两个数据帧答案

【问题标题】：merge two data frames on non overlapping intervals在非重叠间隔上合并两个数据帧
【发布时间】：2012-03-22 22:25:48
【问题描述】：

我想合并两个数据框。它们都有一个开始日期和一个结束日期。

如果给定的间隔重叠，我想将结果行拆分为不重叠的间隔。

请看这个例子：

a
 id      beg_a      end_a prop_a
  1 2000-01-01 2002-12-31      A
  2 2000-01-01 2000-02-15      B
  2 2000-04-01 2000-04-15      A
  2 2002-01-01 2002-12-31      B
  3 2000-01-01 2000-06-15      A

b
 id      beg_b      end_b prop_b
  1 1999-06-01 2000-05-15      D
  1 2003-01-15 2003-01-31      D
  2 1999-01-01 2003-01-15      D
  3 2000-07-01 2001-08-01      E

merged
  id      beg_a      end_a prop_a      beg_b      end_b prop_b overallBeg overallEnd
   1       <NA>       <NA>   <NA> 1999-06-01 2000-05-15      D 1999-06-01 1999-12-31
   1 2000-01-01 2002-12-31      A 1999-06-01 2000-05-15      D 2000-01-01 2000-05-15
   1 2000-01-01 2002-12-31      A       <NA>       <NA>   <NA> 2000-05-16 2002-12-31
   1       <NA>       <NA>   <NA> 2003-01-15 2003-01-31      D 2003-01-15 2003-01-31
   2       <NA>       <NA>   <NA> 1999-01-01 2003-01-15      D 1999-01-01 1999-12-31
   2 2000-01-01 2000-02-15      B 1999-01-01 2003-01-15      D 2000-01-01 2000-02-15
   2       <NA>       <NA>   <NA> 1999-01-01 2003-01-15      D 2000-02-16 2000-03-31
   2 2000-04-01 2000-04-15      A 1999-01-01 2003-01-15      D 2000-04-01 2000-04-15
   2       <NA>       <NA>   <NA> 1999-01-01 2003-01-15      D 2000-04-16 2001-12-31
   2 2002-01-01 2002-12-31      B 1999-01-01 2003-01-15      D 2002-01-01 2002-12-31
   2       <NA>       <NA>   <NA> 1999-01-01 2003-01-15      D 2003-01-01 2003-01-15
   3 2000-01-01 2000-06-15      A       <NA>       <NA>   <NA> 2000-01-01 2000-06-15
   3       <NA>       <NA>   <NA> 2000-07-01 2001-08-01      E 2000-07-01 2001-08-01

（或简单地在 R 中使用这些命令）

a <- structure(list(id = c(1, 2, 2, 2, 3), beg_a = structure(c(10957, 
  10957, 11048, 11688, 10957), class = "Date"), end_a = structure(c(12052, 
  11002, 11062, 12052, 11123), class = "Date"), prop_a = structure(c(1L, 
  2L, 1L, 2L, 1L), .Label = c("A", "B"), class = "factor")), .Names = c("id", 
  "beg_a", "end_a", "prop_a"), row.names = c(NA, -5L), class = "data.frame")

b <- structure(list(id = c(1, 1, 2, 3), beg_b = structure(c(10743, 
  12067, 10592, 11139), class = "Date"), end_b = structure(c(11092, 
  12083, 12067, 11535), class = "Date"), prop_b = structure(c(1L, 
  1L, 1L, 2L), .Label = c("D", "E"), class = "factor")), .Names = c("id", 
  "beg_b", "end_b", "prop_b"), row.names = c(NA, -4L), class = "data.frame")

merged <- structure(list(id = c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3), 
      beg_a = structure(c(NA, 10957, 10957, NA, NA, 10957, NA, 
      11048, NA, 11688, NA, 10957, NA), class = "Date"), end_a = structure(c(NA, 
      12052, 12052, NA, NA, 11002, NA, 11062, NA, 12052, NA, 11123, 
      NA), class = "Date"), prop_a = structure(c(NA, 1L, 1L, NA, 
      NA, 2L, NA, 1L, NA, 2L, NA, 1L, NA), .Label = c("A", "B"), class = "factor"), 
      beg_b = structure(c(10743, 10743, NA, 12067, 10592, 10592, 
      10592, 10592, 10592, 10592, 10592, NA, 11139), class = "Date"), 
      end_b = structure(c(11092, 11092, NA, 12083, 12067, 12067, 
      12067, 12067, 12067, 12067, 12067, NA, 11535), class = "Date"), 
      prop_b = structure(c(1L, 1L, NA, 1L, 1L, 1L, 1L, 1L, 1L, 
      1L, 1L, NA, 2L), .Label = c("D", "E"), class = "factor"), 
      overallBeg = structure(c(10743, 10957, 11093, 12067, 10592, 
      10957, 11003, 11048, 11063, 11688, 12053, 10957, 11139), class = "Date"), 
      overallEnd = structure(c(10956, 11092, 12052, 12083, 10956, 
      11002, 11047, 11062, 11687, 12052, 12067, 11123, 11535), class = "Date")), .Names = c("id", 
  "beg_a", "end_a", "prop_a", "beg_b", "end_b", "prop_b", "overallBeg", 
  "overallEnd"), row.names = c(NA, -13L), class = "data.frame")

我认为与我的另一个问题有一些相似之处： "smoothing" time data - can it be done more efficient?

但也略有不同。

提前感谢您的帮助！

【问题讨论】：

我不知道你想要什么。是否有任何值（可能是prop_*）需要与日期对齐？您的 merged 对象的实用性使我无法理解。如果您不需要创建新的（密切的）间隔，只需 sort(c(a$beg_a,a$end_a,b$beg_b,b$end_b)) 。所以，回到我最喜欢的回答：你要解决的问题是什么？（参见数据 Munger 大师）
感谢您的回复。我尝试用我的数据进行生存分析。为此，我需要为每个id 设置一行，每次发生状态更改（状态更改可以是一集结束或另一集开始）。我的问题是，我拥有的信息分布在 2 张桌子上。存储在这些表中的剧集可以重叠。我的目标是在一张表中获取信息，而不会重叠剧集。

标签： r date intervals

【解决方案1】：

sqldf 可以，但我尝试了一个“纯”R 解决方案。它有效，但它有点草率。我还没有想出如何“矢量化”解决方案（删除 split.interval 中的两个 for 循环，并不再需要覆盖 id.split）。

首先我创建了两个可以接受一个 id 的函数，并将 'a' 和 'b' 合并在一起：

split.interval = function(sub.a, sub.b) {
    begs = c(sub.a$beg_a,sub.b$beg_b)  
    ends = c(sub.a$end_a,sub.b$end_b)
    dates=c(begs,ends)
    dates = dates[order(dates)]
    d = data.frame(overallBeg = dates[-length(dates)], overallEnd = dates[-1])
    date.match = function(x,y) {
            s = match(x, d$overallBeg )
            e = match(y, d$overallEnd )
            join=as.Date(rep(NA,length(d$overallBeg)))
            for (i in 1:length(x)) join [s[i]:e[i]]= x[i]
            join
    }

    d$a_join = date.match(sub.a$beg_a,sub.a$end_a)
    d$b_join = date.match(sub.b$beg_b,sub.b$end_b)

    d = merge(sub.a,d,by.x='beg_a',by.y='a_join',all.y=T)
    d = merge(sub.b,d,by.x='beg_b',by.y='b_join',all.y=T)

    d$id=pmax(d$id.x,d$id.y,na.rm=T)
    d = d [order(d$overallBeg),c('id','beg_a','end_a','prop_a','beg_b','end_b','prop_b','overallBeg','overallEnd')]
    # This next line will lead to a bug if overallBeg == overallEnd
    d$overallEnd [d$overallEnd == c(d$overallBeg[-1],F)] = d$overallEnd [d$overallEnd == c(d$overallBeg[-1],F)] - 1  
    d

}

id.split = function (ids) {
    sub.a=a[a$id==ids,]
    sub.b=b[b$id==ids,]

    split.interval ( sub.a , sub.b )
}

然后我为每个 ID 运行该函数，并将它们绑定在一起。

l=lapply(unique(c(a$id,b$id)), id.split) 
res = do.call(rbind,l)
row.names(res) = NULL
res

【讨论】：

哇，这真是太棒了。只是想弄清楚它是如何工作的。是否很难使输出与我的merged 数据框相同（它已经非常相似，但有一个区别：如果存在重叠序列，则之前的序列分别在末尾有-1天，之后的序列开始 +1 天（希望你明白我的意思）。
我为 +1 天做了更改。正如我所指出的，它会导致任何时间段的 bug，其中 generalBeg ==overallEnd。另外，我担心您“需要”为生存分析执行此操作。这种分析我很熟悉，从来不需要这种结构。
刚刚注意到您所说的错误。也许我找到了解决方法。嗯，我对生存分析比较陌生，但我认为需要非间歇序列。你能给我更多关于这方面的信息吗？（我现在会接受你的回答，而不是谈论剩余的错误，因为我认为我可以轻松解决这个问题）。

【解决方案2】：

您可以分两步完成：首先，计算所有所需的间隔并将它们放入一个中间表中，然后将该表与两个初始 data.frame 连接起来。

# First build all the desired intervals
names(a) <- c( "id", "valid_from", "valid_until", "prop_a" )
names(b) <- c( "id", "valid_from", "valid_until", "prop_b" )

intervals <- rbind( 
  data.frame( id = a$id, date = a$valid_from ),
  data.frame( id = a$id, date = a$valid_until ),
  data.frame( id = b$id, date = b$valid_from ),
  data.frame( id = b$id, date = b$valid_until )
)
intervals <- unique( intervals )
intervals <- intervals[ order(intervals$id, intervals$date), ]
n <- dim(intervals)[1]
intervals <- data.frame(
  id = intervals$id[-n],
  id2 = intervals$id[-1],
  valid_from = intervals$date[-n],
  valid_until = intervals$date[-1]
)
intervals <- intervals[ 
  intervals$id == intervals$id2, 
  c("id", "valid_from", "valid_until") 
]

由于我们加入数据的条件不是简单的相等，所以让我们使用sqldf。

library(sqldf)
d <- sqldf( "
  SELECT intervals.id,
         intervals.valid_from, intervals.valid_until, 
         a.prop_a, b.prop_b
  FROM intervals
  LEFT JOIN a
  ON          a.valid_from  <= intervals.valid_from 
  AND intervals.valid_until <=         a.valid_until
  AND intervals.id = a.id
  LEFT JOIN b
  ON          b.valid_from  <= intervals.valid_from 
  AND intervals.valid_until <=         b.valid_until
  AND intervals.id = b.id
" )

【讨论】：