如何解决有效地找到R中两个时间间隔之间的重叠
我使用 combn()
使用 lubridate
package 查找两个日期/时间之间的重叠。但是 combn()
太 slow 无法处理我正在处理的大型数据集。我正在尝试使用 comboGeneral()
包中的 RcppAlgos
,但我无法让它工作。任何帮助,将不胜感激。如果您知道我应该查看的任何其他包/功能,也请告诉我。
get_overlap <- function(.data,.id,.start,.end) {
id <- .data[[.id]]
int <- interval(.data[[.start]],.data[[.end]])
names <- combn(id,2,FUN = function(.) paste(.,collapse = "-"))
setNames(combn(int,function(.) intersect(.[1],.[2])),names)
}
get_overlap(dat,"id","start","end")
# a-b a-c a-d a-e b-c b-d b-e c-d c-e d-e
# 49 1 4 17 23 14 18 NA 2 NA
这是我使用 comboGeneral()
失败的尝试。
comboGeneral(dat$int,FUN = function(.) intersect(.[1],.[2]))
# Output:
# [[1]]
# numeric(0)
#
# [[2]]
# numeric(0)
#
# [[3]]
# numeric(0)
# <omitted>
这是数据集:
dat <- structure(list(id = c("a","b","c","d","e"),start = structure(c(1623903457.7771,1623903447.7771,1623903505.7771,1623903406.7771,1623903489.7771
),class = c("POSIXct","POSIXt")),end = structure(c(1623903506.7771,1623903528.7771,1623903543.7771,1623903461.7771,1623903507.7771
),"POSIXt"))),row.names = c(NA,-5L),class = c("tbl_df","tbl","data.frame"))
更新:
感谢您迄今为止提出的所有好建议!我使用我写得不雅的函数做了一些基准测试。如果你能帮助进一步改进它,那就太好了。我会根据反馈再次更新。
请注意,comboIter
是 comboIter_vector
的一部分,我在其中包含了从 C++ object
对象中提取值的机制。我想了解 comboIter()
的精益效率。
# Unit: microseconds
# expr min lq mean median uq max neval cld
# combn 36092.801 37000.251 40356.8080 37311.901 38112.1010 226049.201 100 d
# comboGeneral 33744.301 34608.702 36756.3749 35099.851 38738.6010 49378.301 100 c
# comboIter 447.401 568.601 634.2019 580.901 606.0505 5866.501 100 a
# comboIter_vector 38037.201 38823.301 39919.0570 39108.952 39562.5505 49880.101 100 cd
# data.table 7816.001 8007.201 8289.0060 8113.401 8230.5510 15489.201 100 b
# IRanges 6451.001 6806.751 7104.0659 6879.651 6994.9005 14415.301 100 b
代码如下:
library(lubridate)
library(RcppAlgos)
library(data.table)
library(IRanges)
# combn
get_overlap_combn <- function(.data) {
names <- combn(.data$id,function(x) paste(x,collapse = "-"))
setNames(combn(interval(.data$start,.data$end),function(x) intersect(x[1],x[2])),names)
}
get_overlap_combn(dat)
# comboGeneral
get_overlap_cpp1 <- function(.data) {
names <- unlist(comboGeneral(dat$id,FUN = function(x) paste(x,collapse = "-")))
int <- interval(.data$start,.data$end)
setNames(unlist(comboGeneral(seq_along(int),FUN = function(x) intersect(int[x[1]],int[x[2]]))),names)
}
get_overlap_cpp1(dat)
# comboIter
get_overlap_cpp2 <- function(.data) {
int <- interval(.data$start,.data$end)
comboIter(seq_along(int),FUN = function(x) as.double(intersect(int[x[1]],int[x[2]])))
}
get_overlap_cpp2(dat)
# C++ object <000002c2b172ee90> of class 'ComboFUN' <000002c2b16fcc90>
# comboIter_vector
get_overlap_cpp3 <- function(.data) {
int <- interval(.data$start,.data$end)
obj_name <- comboIter(.data$id,collapse = "-"))
obj_int <- comboIter(seq_along(int),int[x[2]])))
obj_length <- obj_int$summary()$totalResults
v <- vector("double",obj_length)
name <- vector("character",obj_length)
i <- 1
while (i <= obj_length) {
v[i] <- obj_int$nextIter()
name[i] <- obj_name$nextIter()
i <- i + 1
}
setNames(v,name)
}
get_overlap_cpp3(dat)
# data.table
get_overlap_dt <- function(.data) {
data <- .data
setDT(data)
setkey(data,start,end)
data <- foverlaps(data,data)[id != i.id]
dup <- duplicated(t(apply(data[,c("id","i.id")],1,sort)))
data <-
data[dup
][,`:=`(
overlap = as.double(intersect(interval(start,end),interval(i.start,i.end))),name = paste(id,i.id,sep = "-")
)]
setNames(data$overlap,data$name)
}
get_overlap_dt(dat)
get_overlap_iranges <- function(.data) {
# setup the IRanges object
ir <- IRanges(as.numeric(.data$start),as.numeric(.data$end),names = .data$id)
# find which ids overlap with each other
ovrlp <- findOverlaps(ir,drop.self = TRUE,drop.redundant = TRUE)
# store id indices for further use
hit1 <- queryHits(ovrlp)
hit2 <- subjectHits(ovrlp)
# width of overlaps between ids
widths <- width(pintersect(ir[hit1],ir[hit2])) - 1
names(widths) <- paste(names(ir)[hit1],names(ir)[hit2],sep = "-")
widths
}
get_overlap_iranges(dat)
解决方法
也许试试 data.table
foverlaps
函数:
library(data.table)
setDT(dat)
setkey(dat,start,end)
foverlaps(dat,dat)[id != i.id]
,
处理间隔的另一种选择是“IRanges”包:
library(IRanges)
# setup the IRanges object
ir = IRanges(as.numeric(dat$start),as.numeric(dat$end),names = dat$id)
# find which ids overlap with each other
ovrlp = findOverlaps(ir,drop.self = TRUE,drop.redundant = TRUE)
# store id indices for further use
hit1 = queryHits(ovrlp)
hit2 = subjectHits(ovrlp)
# width of overlaps between ids
widths = width(pintersect(ir[hit1],ir[hit2])) - 1
# result
data.frame(id1 = names(ir)[hit1],id2 = names(ir)[hit2],widths)
# id1 id2 widths
#1 a d 4
#2 a b 49
#3 a e 17
#4 a c 1
#5 b d 14
#6 b e 18
#7 b c 23
#8 c e 2
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。