我有两个序列。他们是几秒钟的时间。我想知道序列b中哪些值出现在序列a中任何值的10s内。
seqa = c(4.53333333333333, 7.43333333333334, 9.03333333333333, 20.6166666666667,
20.6333333333333, 42.5666666666667, 48.3166666666667, 48.8, 49.75,
55.1, 56.7833333333333, 59.3833333333333, 110.15, 113.95, 114.6)
seqb = c(18.3833333333333, 18.3833333333333, 63.8833333333333, 72.3166666666667,
76.7166666666667, 85.2166666666667, 91.25, 91.3666666666667,
96.2833333333333)
我使用两个for循环完成了此操作。浏览seqb的每个元素，并测试它是否发生在大于seqa的每个值但在10秒限制内的时间。
matX <- matrix(nrow=length(seqa), ncol=length(seqb))
for(j in seq_along(seqb)){
for(i in seq_along(seqa)){
test1 <- seqb[j]>=seqa[i]
test2 <- seqb[j]<=seqa[i]+10
matX[i,j] <- sum(test1 + test2)
}
}
matX
我将结果存储在矩阵中。您可以在第1,2和3列中看到值2。
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 1 1 1 1 1 1 1 1
[2,] 1 1 1 1 1 1 1 1 1
[3,] 2 2 1 1 1 1 1 1 1
[4,] 1 1 1 1 1 1 1 1 1
[5,] 1 1 1 1 1 1 1 1 1
[6,] 1 1 1 1 1 1 1 1 1
[7,] 1 1 1 1 1 1 1 1 1
[8,] 1 1 1 1 1 1 1 1 1
[9,] 1 1 1 1 1 1 1 1 1
[10,] 1 1 2 1 1 1 1 1 1
[11,] 1 1 2 1 1 1 1 1 1
[12,] 1 1 2 1 1 1 1 1 1
[13,] 1 1 1 1 1 1 1 1 1
[14,] 1 1 1 1 1 1 1 1 1
[15,] 1 1 1 1 1 1 1 1 1
out <- apply(matX, 2, function(x) any(x>=2))
seqb[out]
# [1] 18.38333 18.38333 63.88333
这些值是在seqa中至少一个值的10s内发生的值。 （前两个发生在9.03333的10s内，第三个值63.8333发生在seqa的三个值的10s内（55.1,56.78333,59.38333）。
我正在努力加快速度，因为我将对约2000个元素的序列进行一些随机化。任何想法都非常感激。
答案 0 :(得分：4)
以下是两个基本选项
seqa = c(4.53333333333333, 7.43333333333334, 9.03333333333333, 20.6166666666667,
20.6333333333333, 42.5666666666667, 48.3166666666667, 48.8, 49.75,
55.1, 56.7833333333333, 59.3833333333333, 110.15, 113.95, 114.6)
seqb = c(18.3833333333333, 18.3833333333333, 63.8833333333333, 72.3166666666667,
76.7166666666667, 85.2166666666667, 91.25, 91.3666666666667,
96.2833333333333)
## via alexis_laz
a <- function() seqb[seqa[findInterval(seqb, seqa)] + 10 >= seqb]
# [1] 18.38333 18.38333 63.88333
## f
(function() {
la <- length(seqa)
lb <- length(seqb)
rr <- rep(seqb, each = la)
m <- matrix(rep(seqa, length(seqb)) - rr, la)
+(m < 0 & abs(m) <= 10)
})()
## g
o <- outer(seqa, seqb, `-`)
x <- +(o < 0 & abs(o) <= 10)
`dimnames<-`(x, list(round(seqa, 2), round(seqb, 2)))
# 18.38 18.38 63.88 72.32 76.72 85.22 91.25 91.37 96.28
# 4.53 0 0 0 0 0 0 0 0 0
# 7.43 0 0 0 0 0 0 0 0 0
# 9.03 1 1 0 0 0 0 0 0 0
# 20.62 0 0 0 0 0 0 0 0 0
# 20.63 0 0 0 0 0 0 0 0 0
# 42.57 0 0 0 0 0 0 0 0 0
# 48.32 0 0 0 0 0 0 0 0 0
# 48.8 0 0 0 0 0 0 0 0 0
# 49.75 0 0 0 0 0 0 0 0 0
# 55.1 0 0 1 0 0 0 0 0 0
# 56.78 0 0 1 0 0 0 0 0 0
# 59.38 0 0 1 0 0 0 0 0 0
# 110.15 0 0 0 0 0 0 0 0 0
# 113.95 0 0 0 0 0 0 0 0 0
# 114.6 0 0 0 0 0 0 0 0 0
我的硬件硬件上的一些长凳
library('microbenchmark')
seqa <- rep(seqa, 100)
seqb <- rep(seqb, 100)
microbenchmark(f(), g(), baseR(), DT(), unit = 'relative')
# Unit: relative
# expr min lq mean median uq max neval cld
# f() 525.3178 374.23871 402.51609 386.4717 372.50657 496.6496 100 c
# g() 293.2158 223.21560 247.40211 241.3430 225.80202 443.5323 100 bc
# baseR() 13268.9357 9357.70517 8895.30834 9111.6828 8466.15623 6702.1735 100 d
# DT() 136.1109 93.61985 96.88054 96.0771 95.03329 100.5602 100 ab
# a() 1.0000 1.00000 1.00000 1.0000 1.00000 1.0000 100 a
答案 1 :(得分：1)
您可以尝试foverlaps包中的data.table功能。
library(data.table)
b <- data.table(seqb)
a <- data.table(seqa)
a[, end := seqa + 10]
setkey(a)
b[, end := seqb]
inds <- foverlaps(b, a,
by.x=c("seqb","end"),
type="within",
mult="all",
which=TRUE # you can use nomatch=0L, but it doesn't change the final matrix
)
# xid yid
#1: 1 3
#2: 2 3
#3: 3 10
#4: 3 11
#5: 3 12
#6: 4 NA
#7: 5 NA
#8: 6 NA
#9: 7 NA
#10: 8 NA
#11: 9 NA
现在可以使用这些索引创建所需的矩阵。
mat <- matrix(1, nrow=length(seqa), ncol=length(seqb))
mat[cbind(inds$yid, inds$xid)] <- 2
这是一个包含seqa和seqb硬编码的函数：
DT <- function(){
b <- data.table(seqb)
a <- data.table(seqa)
a[, end := seqa + 10]
setkey(a)
b[, end := seqb]
inds <- foverlaps(b, a,
by.x=c("seqb","end"),
type="within",
mult="all",
which=TRUE
)
mat <- matrix(1, nrow=length(seqa), ncol=length(seqb))
mat[cbind(inds$yid, inds$xid)] <- 2
mat
}
答案 2 :(得分：1)
seqa = c(4.53333333333333, 7.43333333333334, 9.03333333333333, 20.6166666666667, 20.6333333333333, 42.5666666666667, 48.3166666666667, 48.8, 49.75, 55.1, 56.7833333333333, 59.3833333333333, 110.15, 113.95, 114.6)
seqb = c(18.3833333333333, 18.3833333333333, 63.8833333333333, 2.3166666666667, 76.7166666666667, 85.2166666666667, 91.25, 91.3666666666667, 96.2833333333333)
上面的数据。下面，我展示了我的方法，以及@jota的方法。请注意，这是一个有点愚蠢的比较，因为数据非常小。对于较大的数据，data.table解决方案几乎肯定会更快。
library(microbenchmark)
library(data.table)
DT <- function(){
b <- data.table(seqb)
a <- data.table(seqa)
a[, end := seqa + 10]
setkey(a)
b[, end := seqb]
inds <- foverlaps(b, a,
by.x=c("seqb","end"),
type="within",
mult="all",
which=TRUE
)
mat <- matrix(1, nrow=length(seqa), ncol=length(seqb))
mat[cbind(inds$yid, inds$xid)] <- 2
mat
}
baseR <- function(){
out <- matrix(NA, ncol=length(seqb), nrow=length(seqa));
for(i in 1:length(seqa)){
out[i,] <- sapply(seqb, function(x){seqa[i] -10 < x & x < seqa[i] +10})
}
out
}
microbenchmark(
baseR(), DT()
)
微基准测试的结果（为了好玩）。
Unit: microseconds
expr min lq mean median uq max neval
baseR() 703.382 750.129 786.283 770.867 788.3085 1905.357 100
DT() 7289.433 7415.906 7631.574 7503.236 7575.7345 8794.439 100
答案 3 :(得分：0)
您可以使用IRanges包。
library(IRanges)
a.ir <- IRanges(round(seqa, 4)*1e4, round(seqa, 4)*1e4+10*1e4)
b.ir <- IRanges(round(seqb, 4)*1e4, round(seqb, 4)*1e4)
findOverlaps(b.ir, a.ir)
# Hits of length 5
# queryLength: 9
# subjectLength: 15
# queryHits subjectHits
# <integer> <integer>
# 1 1 3
# 2 2 3
# 3 3 10
# 4 3 11
# 5 3 12
seqb[unique(queryHits(findOverlaps(b.ir, a.ir)))]
# [1] 18.38333 18.38333 63.88333