Question

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

对于每个ID，如果结束日期和开始日期之间的差异是＆lt; = 14天，那么我想取该行的结束日期并从上面的行中取出开始日期。 IE浏览器。将时间段合并为小于14天的间隔。

我已经能够为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

Answer 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，

这样的格式

让我知道它是否适合你。

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

1 个答案: