Find list of values in list of ranges in R - r

Question

I have two data frames:
set.seed(123)
myData<-data.frame(id=1:10, pos=21:30)
refData<-data.frame(id=letters[1:15], pos=sample(10:40,15))
looking like that
> myData
id1 pos1
1 21
2 22
3 23
4 24
5 25
6 26
7 27
8 28
9 29
10 30
> refData
id2 pos2
a 18
b 33
c 21
d 34
e 35
f 11
g 23
h 31
i 22
j 20
k 30
l 19
m 32
n 39
o 36
I want an extended data frame of myData. For each row in myData i want to check if there is an entry in refData with a distance less than 2 numbers and if so, i want the IDs of refData pasted in a new column of myData.
In the end my new data frame should look like that:
id1 pos1 newColumn
1 21 c, g, i, j, l
2 22 c, g, i, j
3 23 c, g, i
4 24 g, i
5 25 g
6 26
7 27
8 28 k
9 29 h, k
10 30 h, k, m
Obviously, i could do that with the following loop, which works fine:
myData$newColumn<-rep(NA, nrow(myData))
for(i in 1:nrow(myData)){
ww<-which(abs(refData$pos2 - myData$pos1[i]) <= 2)
myData$newColumn[i]<-paste(refData[ww,1],collapse=", ")
}
But, i'm looking for a really fast way to do that, since my real data has about 10^6 entries, and my real refData has about 10^7 entries.
I really appreciate any help and ideas of a fast way to do that!

Answer 1

You could try:
myData$newColumn = lapply(myData$pos,
function(x) {paste(refData$id[abs(refData$pos-x)<3],collapse=', ')})
Output:
id pos newColumn
1 1 21 c, g, i, j, l
2 2 22 c, g, i, j
3 3 23 c, g, i
4 4 24 g, i
5 5 25 g
6 6 26
7 7 27
8 8 28 k
9 9 29 h, k
10 10 30 h, k, m
Hope this helps!

Answer 2

Another option would be
myData$newColumn <- sapply(myData$pos, function(x) paste(refData$id[refData$pos >= x-2 & refData$pos <= x+2], collapse = ", "))
A benchmark with n = 1000 shows #Florian's solution slightly ahead:
set.seed(123)
myData<-data.frame(id=1:1000, pos=sample(21:30, 1000, replace = T))
refData<-data.frame(id=sample(letters[1:15], 1000, replace = T), pos=sample(10:40, 1000, replace = T))
myData$newColumn<-rep(NA, nrow(myData))
library(microbenchmark)
microbenchmark(for(i in 1:nrow(myData)){
ww<-which(abs(refData$pos - myData$pos[i]) <= 2)
myData$newColumn[i]<-paste(refData[ww, "id"],collapse=", ")
},
myData$newColumn2 <- sapply(myData$pos, function(x) paste(refData$id[refData$pos >= x-2 & refData$pos <= x+2], collapse = ", ")),
myData$newColumn3 <- lapply(myData$pos, function(x) paste(refData$id[abs(refData$pos - x) < 3], collapse = ", ")))
Unit: milliseconds
expr
for (i in 1:nrow(myData)) { ww <- which(abs(refData$pos - myData$pos[i]) <= 2) myData$newColumn[i] <- paste(refData[ww, "id"], collapse = ", ") }
myData$newColumn2 <- sapply(myData$pos, function(x) paste(refData$id[refData$pos >= x - 2 & refData$pos <= x + 2], collapse = ", "))
myData$newColumn3 <- lapply(myData$pos, function(x) paste(refData$id[abs(refData$pos - x) < 3], collapse = ", "))
min lq mean median uq max neval cld
62.97657 64.74155 70.01541 68.81024 71.02023 206.80477 100 c
46.55872 47.90585 50.75397 50.42333 53.42990 58.01813 100 b
36.69362 37.34244 39.70480 38.54905 42.49614 46.27513 100 a

Answer 3

Your current problem has two main bottlenecks -- 1) the nrow(myData) * nrow(refData) computations and, 2) the creation of possibly large character vectors by concatenating refData$id.
To overcome the first one, one way (since myData$pos is/can be sorted) is to use findInterval to locate the ranges that each refData$pos falls in regards to myData$pos +/- the allowed distance (here 2). This way, the computational complexity gets reduced to nrow(refData) * log(nrow(myData)) or, possibly, even less.
To save some typing:
a = myData$pos
b = refData$pos
As a start, we need to find the interval of a + 2 where each b is found:
i = findInterval(b, a + 2L, all.inside = TRUE, left.open = TRUE)
#> i
# [1] 1 9 1 9 9 1 1 8 1 1 7 1 9 9 9
We specify the intervals as (lower, upper] and avoid falling outside of the 1:(length(a) - 1) range so we can calculate easily the first index where b is 2 units away from a:
i1 = ifelse(abs(b - a[i + 1L]) <= 2, i + 1L, NA)
i2 = ifelse(abs(b - a[i]) <= 2, i, NA)
ii = pmin(i1, i2, na.rm = TRUE)
#> ii
# [1] NA NA 1 NA NA NA 1 9 1 1 8 1 10 NA NA
We, also, need to locate the ([lower, upper)) interval of a - 2 where each b falls and we find the last index of a where b is 2 units away:
j = findInterval(b, a - 2L, all.inside = TRUE, left.open = FALSE)
j1 = ifelse(abs(b - a[j + 1L]) <= 2, j + 1L, NA)
j2 = ifelse(abs(b - a[j]) <= 2, j, NA)
jj = pmax(j1, j2, na.rm = TRUE)
#> jj
# [1] NA NA 3 NA NA NA 5 10 4 2 10 1 10 NA NA
Now, we are left with the location of the first (ii) and last (jj) index of myData$pos (a) where each refData$pos (b) is located +/- 2 units away (where the missing values denote no matching).
A way to overcome the second bottleneck is to avoid it overall if we can utilize the above format to continue.
Nonetheless, to further proceed with representing the matches as concatenated refData$ids, we could, probably, utilize the IRanges package from here on to hope for something efficient:
library(IRanges)
nr = 1:nrow(myData)
myrng = IRanges(nr, nr)
refrng = IRanges(ifelse(is.na(ii), 0L, ii), ifelse(is.na(jj), 0L, jj)) ## replace NA with 0
ovrs = findOverlaps(myrng, refrng)
tapply(refData$id[subjectHits(ovrs)], factor(queryHits(ovrs), nr), toString)
# 1 2 3 4 5
#"c, g, i, j, l" "c, g, i, j" "c, g, i" "g, i" "g"
# 6 7 8 9 10
# NA NA "k" "h, k" "h, k, m"