根据条件按 ID 组合重叠日期
Posted
技术标签:
【中文标题】根据条件按 ID 组合重叠日期【英文标题】：Combining overlapping dates by ID based on a condition 【发布时间】：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 天，我不想合并时间段（重叠时间段）。
【参考方案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 elseenddate <- 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 elseenddate <- 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]以上是关于根据条件按 ID 组合重叠日期的主要内容，如果未能解决你的问题，请参考以下文章