代码之家 › 专栏 › 技术社区 › JFG123

将起始和结束范围中的重叠部分分离到数据帧的自己行中

overlap tidyr dplyr r

JFG123 · 技术社区 · 5 年前

我有以下数据:

start_data <- data.frame(stringsAsFactors=FALSE,
                          Person = c(1, 1, 1, 1),
                          Event = c(1, 2, 3, 4),
                          Var1 = c(1, 2, 3, 5),
                          Var2 = c(7, 8, 9, 6),
                          Var3 = c(13, 14, 15, 7),
                          Start_Date = c("1/01/2020", "5/01/2020", "21/01/2020", "23/01/2020"),
                          End_Date = c("10/01/2020", "20/01/2020", "30/01/2020", "25/01/2020")
)
 
start_data
  Person Event Var1 Var2 Var3 Start_Date   End_Date
1      1     1    1    7   13  1/01/2020 10/01/2020
2      1     2    2    8   14  5/01/2020 20/01/2020
3      1     3    3    9   15 21/01/2020 30/01/2020
4      1     4    5    6    7 23/01/2020 25/01/2020

我想把它转换成:

end_data <- data.frame(stringsAsFactors=FALSE,
                        Person = c(1, 1, 1, 1, 1, 1),
                        Event = c("1", "1 AND 2", "2", "3", "3 AND 4", "3"),
                        Var1 = c("1", "1 AND 2", "2", "3", "3 AND 5", "3"),
                        Var2 = c("7", "7 AND 8", "8", "9", "9 AND 6", "9"),
                        Var3 = c(13, 14, 14, 15, 15, 15),
                        Start_Date = c("1/01/2020", "5/01/2020", "11/01/2020", "21/01/2020",
                                       "23/01/2020", "26/01/2020"),
                        End_Date = c("4/01/2020", "10/01/2020", "20/01/2020", "22/01/2020",
                                     "25/01/2020", "30/01/2020")
)
 
end_data
  Person   Event    Var1    Var2 Var3 Start_Date   End_Date
1      1       1       1       7   13  1/01/2020  4/01/2020
2      1 1 AND 2 1 AND 2 7 AND 8   14  5/01/2020 10/01/2020
3      1       2       2       8   14 11/01/2020 20/01/2020
4      1       3       3       9   15 21/01/2020 22/01/2020
5      1 3 AND 4 3 AND 5 9 AND 6   15 23/01/2020 25/01/2020
6      1       3       3       9   15 26/01/2020 30/01/2020

代码应该扩展数据框,以隔离重叠的开始日期和结束日期范围。当存在重叠范围时,它应该创建一个包含重叠数据的新行。因此,在查看最终表格时,不应该有开始日期和结束日期范围相互重叠。此外,应通过将结果串联起来,总结事件Var1和Var3的表格结果。Var 3也应通过取重叠范围内的最大值进行聚合。

理想情况下,我希望将这段代码应用于多个“人”,这样就可以更好地使用group_by()或与dplyr嵌套。

编辑:

根据下面的问题,在3个重叠时期的情况下。看起来是这样的;

编辑2:

@ekoam的解决方案非常接近。但是,它不涉及以下示例。事件5概括了整个时期。因此,不应缺少范围。然而,“2017-05-17”和“2017-06-11”分别缺少“开始”和“结束”。

> trial_start_data <- data.frame(stringsAsFactors=FALSE,
+                          Person = c(1, 1, 1, 1),
+                          Event = c(5,6,7,8),
+                          Start_Date = as.Date(c("24/04/2017","09/05/2017","12/06/2017","21/06/2017"), "%d/%m/%Y"),
+                          End_Date = as.Date(c("28/09/2017","16/05/2017","21/06/2017","25/06/2017"), "%d/%m/%Y")
+ )
> 
> trial_start_data
  Person Event Start_Date   End_Date
1      1     5 2017-04-24 2017-09-28
2      1     6 2017-05-09 2017-05-16
3      1     7 2017-06-12 2017-06-21
4      1     8 2017-06-21 2017-06-25

> disjoint_subsets(trial_start_data$Start_Date, trial_start_data$End_Date)
       start        end
1 2017-04-24 2017-05-08
2 2017-05-09 2017-05-16
3 2017-06-12 2017-06-20
4 2017-06-21 2017-06-21
5 2017-06-22 2017-06-25
6 2017-06-26 2017-09-28

0 回复 | 直到 5 年前

ekoam 5 年前

这里的主要问题是如何高效地找到一组区间的所有不相交子集。考虑这个函数

disjoint_subsets <- function(starts, ends) {
  t1 <- min(starts)
  starts <- as.integer(starts - t1)
  ends <- as.integer(ends - t1) + 2L
  nvec <- ends - starts + 1L
  x <- sequence(nvec, starts) * 10L
  ends <- cumsum(nvec); starts <- ends - nvec + 1L
  x[ends] <- x[ends] - 9L; x[starts] <- x[starts] + 9L
  x <- sort(unique(x))
  b <- which(x %% 10L > 0L)
  lb <- x[head(b[!(b + 1L) %in% b], -1L)]
  ub <- x[tail(b[!(b - 1L) %in% b], -1L)]
  lb <- (lb + 9L * (lb %% 10L < 2L) + 1L) %/% 10L
  ub <- (ub - 9L * (ub %% 10L > 8L) - 1L) %/% 10L
  data.frame(start = lb + t1 - 1L, end = ub + t1 - 1L)
}

用法

> with(trial_start_data, disjoint_subsets(Start_Date, End_Date))
       start        end
1 2017-04-24 2017-05-08
2 2017-05-09 2017-05-16
3 2017-05-17 2017-06-11
4 2017-06-12 2017-06-20
5 2017-06-21 2017-06-21
6 2017-06-22 2017-06-25
7 2017-06-26 2017-09-28

但是,功能有点慢。仍有改进的余地。对于一个有100k行的数据帧,它会在大约一秒钟内找到所有不相交的子集。对于具有100万行的数据帧,运行需要10-15秒。参见基准

starts_e6 <- sample(Sys.Date() + -1000:1000, size = 1e6, T)
ends_e6 <- starts_e6 + sample.int(1000, 1e6, T)
starts_e5 <- sample(Sys.Date() + -1000:1000, size = 1e5, T)
ends_e5 <- starts_e5 + sample.int(1000, 1e5, T)
microbenchmark::microbenchmark(
  disjoint_subsets(starts_e6, ends_e6),
  disjoint_subsets(starts_e5, ends_e5), 
  times = 2L
)

Unit: milliseconds
                                 expr      min       lq      mean    median        uq       max neval cld
 disjoint_subsets(starts_e6, ends_e6) 11299.59 11299.59 11366.623 11366.623 11433.652 11433.652     2   b
 disjoint_subsets(starts_e5, ends_e5)   873.66   873.66  1028.057  1028.057  1182.455  1182.455     2  a

base::unique 是这里的瓶颈。然而,如果我们能以某种方式使用较少的元素来表示间隔,那么我们可以节省大量时间。

剩下的只是小菜一碟。你可以用 data.table::foverlap 进行不相等的连接 start_data 以及所有不相交的子集。然后,总结合并的数据。桌上拿着 end_data 你想要的。例如

library(data.table)

setDT(trial_start_data)[, c("Start_Date", "End_Date") := lapply(.SD, as.Date, "%d/%m/%Y"), .SDcols = c("Start_Date", "End_Date")]
dsubs = trial_start_data[, disjoint_subsets(Start_Date, End_Date)]; setDT(dsubs)

setkey(dsubs, start, end)
setkey(trial_start_data, Start_Date, End_Date)

foverlaps(dsubs, trial_start_data, type = "within")

输出

    Person Event Start_Date   End_Date      start        end
 1:      1     5 2017-04-24 2017-09-28 2017-04-24 2017-05-08
 2:      1     5 2017-04-24 2017-09-28 2017-05-09 2017-05-16
 3:      1     6 2017-05-09 2017-05-16 2017-05-09 2017-05-16
 4:      1     5 2017-04-24 2017-09-28 2017-05-17 2017-06-11
 5:      1     5 2017-04-24 2017-09-28 2017-06-12 2017-06-20
 6:      1     7 2017-06-12 2017-06-21 2017-06-12 2017-06-20
 7:      1     5 2017-04-24 2017-09-28 2017-06-21 2017-06-21
 8:      1     7 2017-06-12 2017-06-21 2017-06-21 2017-06-21
 9:      1     8 2017-06-21 2017-06-25 2017-06-21 2017-06-21
10:      1     5 2017-04-24 2017-09-28 2017-06-22 2017-06-25
11:      1     8 2017-06-21 2017-06-25 2017-06-22 2017-06-25
12:      1     5 2017-04-24 2017-09-28 2017-06-26 2017-09-28

对于任何数据来说,只有10万行的数据帧都不应该是问题。表函数。这也是迄今为止我能想到的最有效的方法。我将省略剩下的步骤,因为现在答案相当长。此外,我认为我对你之前的一篇帖子的回答涵盖了这些内容。