All geek questions in one place

Search for vector values ​​that occur within the range of other vector values

I have two sequences. These are times in seconds. I want to know which values ​​in sequence b occur within 10 seconds of any value in sequence a.

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)

I did this using two cycles for. Passage of each element seqband testing, if it occurs at a point in time, exceeding each value seqa, but within 10 seconds.

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

I save the results in a matrix. You can see the values ​​of 2 in columns 1, 2, and 3.

      [,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

, 10 seqa. ( 10 9.03333, 63.8333 10 seqa (55.1, 56.78333, 59.38333).

, 2000 . .

+4
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
+4

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 hardcode:

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
}
+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)

Data read above. Below I show my approach, as well as @jota. Note that this is a bit of a dumb comparison as the data is so small. The solution is data.tablealmost certainly faster with big data.

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()
)

And the results for microbenchmark (for fun).

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
+1
source

You can use the package 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
0
source

Source: https://habr.com/ru/post/1620843/

More articles:


All Articles