8

我想找到每个 ID 的重叠日期，并使用重叠日期创建一个新行，并将字符（char）组合起来。我的数据可能有 >2 个重叠并且需要 >2 个字符组合。例如。风险管理

数据：

ID    date1         date2       char
15  2003-04-05  2003-05-06      E
15  2003-04-20  2003-06-20      R
16  2001-01-02  2002-03-04      M
17  2003-03-05  2007-02-22      I   
17  2005-04-15  2014-05-19      C
17  2007-05-15  2008-02-05      I
17  2008-02-05  2012-02-14      M
17  2010-06-07  2011-02-14      V
17  2010-09-22  2014-05-19      P
17  2012-02-28  2013-03-04      R

我想要的输出：

ID  date1       date2           char
15  2003-04-05  2003-04-20      E
15  2003-04-20  2003-05-06      ER
15  2003-05-06  2003-06-20      R
16  2001-01-02  2002-03-04      M
17  2003-03-05  2005-04-15      I
17  2005-04-15  2007-02-22      IC
17  2005-04-15  2007-05-15      C   
17  2007-05-15  2008-02-05      CI
17  2008-02-05  2012-02-14      CM
17  2010-06-07  2011-02-14      CV
17  2010-09-22  2014-05-19      CP
17  2012-02-28  2013-03-04      CR
17  2014-05-19  2014-05-19      P
17  2010-06-07  2012-02-14      MV
17  2010-09-22  2011-02-14      VP
17  2012-02-28  2013-03-04      RP

我尝试过的：我尝试使用以下行从当前行中减去日期 2：

df$diff <- c(NA,df[2:nrow(tdf), "date1"] - df[1:(nrow(df)-1), "date2"])

然后确定行之间的重叠：

df$overlap[which(df$diff<1)] <-1
df$overlap.up <- c(df$overlap[2:(nrow(df))], "NA")
df$overlap.final[which(df$overlap==1 | df$overlap.up==1)] <- 1

然后我选择了那些有重叠.final==1 的并将它们放入另一个数据框中，并找到每个 ID 的重叠。

但是，我意识到这太简单了，也有缺陷，因为它只选择顺序发生的重叠（使用第一步中的日期差异）。我需要做的是获取每个 ID 的一系列日期并循环遍历每个组合以确定是否存在重叠，然后，如果有，则记录该开始和结束日期并创建一个新字符“char”，表明是什么在这两个日期期间合并。我想我需要一个循环来做到这一点。

我试图创建一个循环来查找 date1 和 date 2 之间的重叠间隔

df <- df[which(!duplicated(df$ ID)),]

for (i in 1:nrow(df)) {
  tmp <- length(which(df $ID[i] & (df$date1[i] >df$date1 & df$date1[i]< df$date2) | (df$date2[i] < df$date2&  df$date2[i]> df$date1))) >0
  df$int[i]<- tmp

}

但是，这不起作用。

确定重叠间隔后，我需要为每个新的开始日期和结束日期创建新行，并创建一个表示重叠的新字符。

我试图识别重叠的另一个版本的循环：

for (i in 1:nrow(df)) {
  if (df$ID[i]==IDs$ID){
  tmp <- length(df, df$ ID[i]==IDs$ & (df$date1[i]> df$date1 & df$date1 [i]< df$date2 | df$date2[i] < df$date2 &  df$date2[i]> df$date1)) >0
  df$int[i]<- tmp
  }
}
4

2 回答 2

12

首先，我们data.table为每个ID.

所有可能的间隔意味着我们获取 an 的所有开始日期和结束日期，ID并将它们组合在一个排序的向量tmp中。唯一值表示时间轴上所有给定间隔的所有可能交点（或中断）。ID对于以后的加入，中断会以每行的一个间隔重新排列，并带有一个start和一个end列：

library(data.table)
options(datatable.print.class = TRUE)
breaks <- DT[, {
  tmp <- unique(sort(c(date1, date2)))
  .(start = head(tmp, -1L), end = tail(tmp, -1L))
  }, by = ID]
breaks

       ID      start        end
    <int>     <IDat>     <IDat>
 1:    15 2003-04-05 2003-04-20
 2:    15 2003-04-20 2003-05-06
 3:    15 2003-05-06 2003-06-20
 4:    16 2001-01-02 2002-03-04
 5:    17 2003-03-05 2005-04-15
 6:    17 2005-04-15 2007-02-22
 7:    17 2007-02-22 2007-05-15
 8:    17 2007-05-15 2008-02-05
 9:    17 2008-02-05 2010-06-07
10:    17 2010-06-07 2010-09-22
11:    17 2010-09-22 2011-02-14
12:    17 2011-02-14 2012-02-14
13:    17 2012-02-14 2012-02-28
14:    17 2012-02-28 2013-03-04
15:    17 2013-03-04 2014-05-19

然后，执行非等连接 ，其中值在连接条件下同时聚合（by = .EACHI称为按每个 i 分组，有关更详细的解释，请参阅此答案）：

DT[breaks, on = .(ID, date1 <= start, date2 >= end), paste(char, collapse = ""),  
   by = .EACHI, allow.cartesian = TRUE]

       ID      date1      date2     V1
    <int>     <IDat>     <IDat> <char>
 1:    15 2003-04-05 2003-04-20      E
 2:    15 2003-04-20 2003-05-06     ER
 3:    15 2003-05-06 2003-06-20      R
 4:    16 2001-01-02 2002-03-04      M
 5:    17 2003-03-05 2005-04-15      I
 6:    17 2005-04-15 2007-02-22     IC
 7:    17 2007-02-22 2007-05-15      C
 8:    17 2007-05-15 2008-02-05     CI
 9:    17 2008-02-05 2010-06-07     CM
10:    17 2010-06-07 2010-09-22    CMV
11:    17 2010-09-22 2011-02-14   CMVP
12:    17 2011-02-14 2012-02-14    CMP
13:    17 2012-02-14 2012-02-28     CP
14:    17 2012-02-28 2013-03-04    CPR
15:    17 2013-03-04 2014-05-19     CP

结果与 OP 发布的预期结果不同，但绘制数据表明上述结果显示了所有可能的重叠：

library(ggplot2)
ggplot(DT) + aes(y = char, yend = char, x = date1, xend = date2) + 
  geom_segment() + facet_wrap("ID", ncol = 1L)

在此处输入图像描述

数据

library(data.table)
DT <- fread(
  "ID    date1         date2       char
15  2003-04-05  2003-05-06      E
15  2003-04-20  2003-06-20      R
16  2001-01-02  2002-03-04      M
17  2003-03-05  2007-02-22      I   
17  2005-04-15  2014-05-19      C
17  2007-05-15  2008-02-05      I
17  2008-02-05  2012-02-14      M
17  2010-06-07  2011-02-14      V
17  2010-09-22  2014-05-19      P
17  2012-02-28  2013-03-04      R"
)
cols <- c("date1", "date2")
DT[, (cols) := lapply(.SD, as.IDate), .SDcols = cols]
于 2017-09-12T09:54:35.890 回答
1

介绍

for您添加到问题中的-loop 和包含的比较是一个好的开始。应该是一些额外的括号(和)日期比较。这种for-loop-approach 自动考虑数据框中的新行。因此，您可以在列中获得三个、四个和更多字符的字符串char。

创建输入数据

df = as.data.frame(list('ID'=c(15, 15, 16, 17, 17, 17, 17, 17, 17, 17),
                        'date1'=as.Date(c('2003-04-05', '2003-04-20', '2001-01-02', '2003-03-05', '2005-04-15', '2007-05-15', '2008-02-05', '2010-06-07', '2010-09-22', '2012-02-28')),
                        'date2'=as.Date(c('2003-05-06', '2003-06-20', '2002-03-04', '2007-02-22', '2014-05-19', '2008-02-05', '2012-02-14', '2011-02-14', '2014-05-19', '2013-03-04')),
                        'char'=c('E', 'R', 'M', 'I', 'C', 'I', 'M', 'V', 'P', 'R')),
                   stringsAsFactors=FALSE)

解决方案

迭代所有行（存在于原始 data.frame 中）并将它们与所有当前行进行比较。

nrow_init = nrow(df)
for (i in 1:(nrow(df)-1)) {
  print(i)
  ## get rows of df that have overlapping dates
  ##   (1:nrow(df))>i :: consider only rows below the current row to avoid double processing of two row-pairs
  ##   (!grepl(df$char[i],df$char)) :: prevent double letters
  ## Because we call nrow(df) each time (and not save it as a variable once in the beginning), we consider also new rows here. Therefore, we do not need the specific procedure for comparing 3 or more rows.
  loc = ((1:nrow(df))>i) & (!grepl(df$char[i],df$char)) & (df$ID[i]==df$ID) & (((df$date1[i]>df$date1) & (df$date1[i]<df$date2)) | ((df$date1>df$date1[i]) & (df$date1<df$date2[i])) | ((df$date2[i]<df$date2) & (df$date2[i]>df$date1)) | ((df$date2<df$date2[i]) & (df$date2>df$date1[i])))
  ## Uncomment this line, if you want to compare only two rows each and not more
  # loc = ((1:nrow(df))<=nrow_init) & ((1:nrow(df))>i) & (df$ID[i]==df$ID) & (((df$date1[i]>df$date1) & (df$date1[i]<df$date2)) | ((df$date2[i]<df$date2) & (df$date2[i]>df$date1)))

  ## proceed only of at least one duplicate row was found
  if (sum(loc) > 0) {
    # build new rows
    #  pmax and pmin do element-wise min and max calculation; df$date1[i] and df$date2[i] are automatically extended to the length of df$date1[loc] and df$date2[loc], respectively
    df_append = as.data.frame(list('ID'=df$ID[loc],
                                   'date1'=pmax(df$date1[i],df$date1[loc]),
                                   'date2'=pmin(df$date2[i],df$date2[loc]),
                                   'char'=paste0(df$char[i],df$char[loc])))
    ## append new rows
    df = rbind(df, df_append)
  }
}

## create a new column and sort the characters in it
##  idea for sort: https://stackoverflow.com/a/5904854/4612235
df$sort_char = df$char
for (i in 1:nrow(df)) df$sort_char[i] = paste(sort(unlist(strsplit(df$sort_char[i], ""))), collapse = "")
## remove duplicates
df = df[!duplicated(df[c('ID', 'date1', 'date2', 'sort_char')]),]
## remove additional column
df$sort_char = NULL

输出

ID      date1      date2 char
15 2003-04-05 2003-05-06    E
15 2003-04-20 2003-06-20    R
16 2001-01-02 2002-03-04    M
17 2003-03-05 2007-02-22    I
17 2005-04-15 2014-05-19    C
17 2007-05-15 2008-02-05    I
17 2008-02-05 2012-02-14    M
17 2010-06-07 2011-02-14    V
17 2010-09-22 2014-05-19    P
17 2012-02-28 2013-03-04    R
15 2003-04-20 2003-05-06   ER
17 2005-04-15 2007-02-22   IC
17 2007-05-15 2008-02-05   CI
17 2008-02-05 2012-02-14   CM
17 2010-06-07 2011-02-14   CV
17 2010-09-22 2014-05-19   CP
17 2012-02-28 2013-03-04   CR
17 2010-06-07 2011-02-14   MV
17 2010-09-22 2012-02-14   MP
17 2010-06-07 2011-02-14  MCV
17 2010-09-22 2012-02-14  MCP
17 2010-09-22 2011-02-14   VP
17 2010-09-22 2011-02-14  VCP
17 2010-09-22 2011-02-14  VMP
17 2010-09-22 2011-02-14 VMCP
17 2012-02-28 2013-03-04   PR
17 2012-02-28 2013-03-04  PCR
于 2017-09-12T08:40:26.693 回答