根据条件按 ID 组合重叠日期答案

【问题标题】：Combining overlapping dates by ID based on a condition根据条件按 ID 组合重叠日期
【发布时间】：2017-08-28 10:21:19
【问题描述】：

我想根据条件为每个 ID 选择开始和结束日期。

对于每个 ID，如果结束日期和开始日期之间的差异

我已经能够为 ID 的 45 和 28 执行此操作，但不能为 81 执行此操作，因为它有几个小于 14 天的日期。

我已附上我的数据以及我希望最终得到的结果。

ID  STARTDATE   ENDDATE     Difference  
45  2004-09-04  2004-10-09  NA
45  2004-11-04  2004-12-08  26      
28  2013-07-25  2013-08-28  NA      
28  2013-08-27  2017-04-06  -1
81  2013-02-22  2013-03-28  NA
81  2013-03-25  2013-04-26  -3
81  2013-04-24  2013-05-26  -2
81  2013-05-22  2013-06-23  -4
81  2013-06-24  2013-07-26  1
81  2013-07-22  2013-08-23  -4


ID  STARTDATE   ENDDATE     Difference      startdate     enddate
45  2004-09-04  2004-10-09    NA            2004-09-04  2004-10-09
45  2004-11-04  2004-12-08    26            2004-11-04  2004-12-08
28  2013-08-27  2017-04-06    -1            2013-07-25  2017-04-06
81  2013-07-22  2013-08-23    -4            2013-02-22  2013-08-23

新数据样本

ID  START_DATE  end.date.plus   end.date    start.date  
75  18/10/11    21/11/11    1/01/70 1/01/70  
46  2/10/09     8/08/10     1/01/70 1/01/70  
45  4/09/04     9/10/04     1/01/70 1/01/70  
45  4/11/04     8/12/04     1/01/70 1/01/70  
28  25/07/13    28/08/13    1/01/70 1/01/70  
28  27/08/13    6/04/17     1/01/70 1/01/70  
81  22/02/13    28/03/13    1/01/70 1/01/70  
81  25/03/13    26/04/13    1/01/70 1/01/70  
81  24/04/13    26/05/13    1/01/70 1/01/70  
81  22/05/13    23/06/13    1/01/70 1/01/70  
81  24/06/13    26/07/13    1/01/70 1/01/70  
81  22/07/13    23/08/13    1/01/70 1/01/70

【问题讨论】：

为什么保留ID == 45 和Difference == NA 的行，而不保留Difference == NA 的其他行？
因为 ID 45 的行之间的差异 >= 14 天。
如果差值 >= 14 天，我不想合并时间段（重叠时间段）。

标签： r date datetime dplyr

【解决方案1】：

我建议使用以下按 ID 计算组结构的函数（列差异，我将其保存在数据框中，但是，它无关紧要）。首先，使用您的示例；

data <- read.table(text=
                  "ID  STARTDATE   ENDDATE     Difference  
                   45  2004-09-04  2004-10-09  NA
                   45  2004-11-04  2004-12-08  26      
                   28  2013-07-25  2013-08-28  NA      
                   28  2013-08-27  2017-04-06  -1
                   81  2013-02-22  2013-03-28  NA
                   81  2013-03-25  2013-04-26  -3
                   81  2013-04-24  2013-05-26  -2
                   81  2013-05-22  2013-06-23  -4
                   81  2013-06-24  2013-07-26  1
                   81  2013-07-22  2013-08-23  -4", header=T)

continuum <- function(data){
  library(parsedate, quietly=T) #access to parse_date() function for automatic recognition of date format
  data[,c("STARTDATE", "ENDDATE")] <- lapply(data[,c("STARTDATE", "ENDDATE")], function(e) as.Date(parse_date(e)))
  data <- data[with(data, order(ID, STARTDATE)),]
  data$diffr <- 0
  result <- data.frame()
  for ( i in unique(data$ID)){
    temp <-data[data$ID==i,]
    if(length(temp$ID)==1){
      startdate <- temp$STARTDATE
      enddate <- temp$ENDDATE
    } else{
    for(j in 1:(length(temp$ID)-1)){
      temp$diffr[j+1] <- difftime(temp$STARTDATE[j+1], temp$ENDDATE[j])
    }
    startdate <- c(temp$STARTDATE[temp$diffr==0], temp$STARTDATE[temp$diffr>14])
      if(identical(rep(TRUE, length(temp$ID)), temp$diffr<=14)){
        enddate <- max(temp$ENDDATE)
      } else{
        enddate <- c(temp$ENDDATE[match(temp$ENDDATE[temp$diffr>14], temp$ENDDATE)-1], temp$ENDDATE[length(temp$diffr)])
      }
      } 
    result <- rbind(result, 
                    data.frame(
                      ID=rep(i, length(startdate)),
                      startdate=startdate,
                      enddate=enddate))
  }
  return(result)
}

continuum(data)
#  ID  startdate    enddate
#1 28 2013-07-25 2017-04-06
#2 45 2004-09-04 2004-10-09
#3 45 2004-11-04 2004-12-08
#4 81 2013-02-22 2013-08-23

其次，举个更复杂的例子：

data2 <- read.table(text=
                  "ID  STARTDATE   ENDDATE     Difference  
                   45  2004-09-04  2004-10-09  NA
                   45  2004-11-04  2004-12-08  26      
                   28  2013-07-25  2013-08-28  NA      
                   28  2013-08-27  2017-04-06  -1
                   81  2013-02-22  2013-03-28  NA
                   81  2013-03-25  2013-04-26  -3
                   81  2013-04-24  2013-05-26  -2
                   81  2013-05-22  2013-06-23  -4
                   81  2013-06-24  2013-07-26  1
                   81  2013-07-22  2013-08-23  -4
                   81  2014-05-01  2015-06-02  8 
                   81  2015-07-05  2015-09-06  9", header=T)
continuum(data2)
#  ID  startdate    enddate
#1 28 2013-07-25 2017-04-06
#2 45 2004-09-04 2004-10-09
#3 45 2004-11-04 2004-12-08
#4 81 2013-02-22 2013-08-23
#5 81 2014-05-01 2015-06-02
#6 81 2015-07-05 2015-09-06

编辑：该功能已调整，它会自动识别日期格式（至少是您迄今为止提供的格式，而不是声称它会识别乱码）。现在遵循您的新的、更详细的示例：

data3 <- read.table(text="
                    ID START_DATE end.date.plus end.date start.date
                    75 18/10/11 21/11/11 1/01/70 1/01/70
                    46 2/10/09 8/08/10 1/01/70 1/01/70
                    45 4/09/04 9/10/04 1/01/70 1/01/70
                    45 4/11/04 8/12/04 1/01/70 1/01/70
                    28 25/07/13 28/08/13 1/01/70 1/01/70
                    28 27/08/13 6/04/17 1/01/70 1/01/70
                    81 22/02/13 28/03/13 1/01/70 1/01/70
                    81 25/03/13 26/04/13 1/01/70 1/01/70
                    81 24/04/13 26/05/13 1/01/70 1/01/70
                    81 22/05/13 23/06/13 1/01/70 1/01/70
                    81 24/06/13 26/07/13 1/01/70 1/01/70
                    81 22/07/13 23/08/13 1/01/70 1/01/70", header=T)

此数据集与前面的示例不同，不仅在日期格式方面，这也是该函数不起作用的原因。这也是一个更强大的示例，更好的示例，因为您涵盖了两个日期的行为的更多案例，例如 ID 45 的实例，情况是新的（一个子连续体被较长的一个隐藏），没有发生在前面的例子中。这也使功能更加强大！接下来需要为函数提供正确的变量名称STARTDATE 和ENDDATE。我认为end.date 和start.date 是傻瓜，这就是为什么我将START_DATE 转换为STARTDATE 和end.date.plus 为ENDDATE，因为这个逻辑是为了问你的问题。

names(data3)[2] <- "STARTDATE"
names(data3)[3] <- "ENDDATE"

您可以重命名列，从上面加载函数并将其应用于数据集data3：

continuum(data3)

打印出来的

 #  ID  startdate    enddate
 #1 28 2013-07-25 2017-06-04
 #2 45 2004-04-09 2004-09-10
 #3 46 2009-02-10 2010-08-08
 #4 75 2011-10-18 2011-11-21
 #5 81 2013-02-22 2013-08-23

EDIT2：我为自己创建了一个复杂的日期示例并创建了以下函数：

continuum <- function(data){
  data <- data[with(data, order(ID, STARTDATE)),]
  result <- data.frame()
  for ( i in unique(data$ID)){
    temp <-data[data$ID==i,]
    j <- 1
    startdate <- temp$STARTDATE[1]
    enddate <- temp$ENDDATE[1]
    if(length(temp$ID)==1){result <- rbind(result, data.frame(ID=i, STARTDATE=startdate, ENDDATE=enddate))
    } else 
      while(j < length(temp$ID)){
        if(temp$STARTDATE[j+1]-14<=temp$ENDDATE[j]){ 
          startdate <- startdate
          if(temp$ENDDATE[j+1]<=enddate){enddate <- enddate} else{enddate <- temp$ENDDATE[j+1]}
          if(j==(length(temp$ID)-1)){result <- rbind(result, data.frame(ID=i, STARTDATE=startdate, ENDDATE=enddate))}
          j <- j+1
        } else if(temp$STARTDATE[j+1]-14>enddate){
          result <- rbind(result, data.frame(ID=i, STARTDATE=startdate, ENDDATE=enddate))
          startdate <- temp$STARTDATE[j+1]
          enddate <- temp$ENDDATE[j+1]
          if(j==(length(temp$ID)-1)){result <- rbind(result, data.frame(ID=i, STARTDATE=startdate, ENDDATE=enddate))}
          j <- j+1 
        } else{
          if(temp$ENDDATE[j+1]<=enddate){enddate <- enddate} else{enddate <- temp$ENDDATE[j+1]}
          if(j==(length(temp$ID)-1)){result <- rbind(result, data.frame(ID=i, STARTDATE=startdate, ENDDATE=enddate))}
          j <- j+1}
      }
  }
  return(result)
}

确保您的日期被 R 正确解释！像这样的日期

45 4/11/04 8/12/04 1/01/70 1/01/70 
28 25/07/13 28/08/13 1/01/70 1/01/70

日期格式不好，最好是2017-04-23这样的格式，

让我知道它是否对你有用。

【讨论】：

您好，Patrik，感谢您的回复。我有几个简单的问题 -
因为我已经有数据 n 一个数据框，我可以将数据框的名称替换为“数据”吗？
另外，我已经加载了 dlpyr，所以我可以省略 - “library(dplyr, quiet = T)”。
你在哪里 - “result
for (i in 1:nrow(df)) { if (df$overlap[i]==TRUE){ df$startdate[i]