R Compare one set of values with multiple sets - r

Question

I have a vector of values (x).
I would like to determine the length of its overlap with each of the sets sitting in a list (y) - but without running a loop or lapply. Is it possible?
I am really interested in accelerating the execution.
Thank you very much!
Below is an example with an implementation using a loop:
x <- c(1:5)
y <- list(1:5, 2:6, 3:7, 4:8, 5:9, 6:10)
overlaps <- rep(0, length(y))
for (i in seq(length(y))) { #i=1
# overlaps[i] <- length(intersect(x, y[[i]])) # it is slower than %in%
overlaps[i] <- sum(x %in% y[[i]])
}
overlaps
And below is the comparison of some of the methods that were suggested in the responses below. As you can see, the loop is still the fastest - but I'd love to find something faster:
# Function with the loop:
myloop <- function(x, y) {
overlaps <- rep(0, length(y))
for (i in seq(length(y))) overlaps[i] <- sum(x %in% y[[i]])
overlaps
}
# Function with sapply:
mysapply <- function(x, y) sapply(y, function(e) sum(e %in% x))
# Function with map_dbl:
library(purrr)
mymap <- function(x, y) {
map_dbl(y, ~sum(. %in% x))
}
library(microbenchmark)
microbenchmark(myloop(x, y), mysapply(x, y), mymap(x, y), times = 30000)
# Unit: microseconds
# expr min lq mean median uq max neval
# myloop(x, y) 17.2 19.4 26.64801 21.2 22.6 9348.6 30000
# mysapply(x, y) 27.1 29.5 39.19692 31.0 32.9 20176.2 30000
# mymap(x, y) 59.8 64.1 88.40618 66.0 70.5 114776.7 30000

Answer 1

Use sapply for code compactness.
Even if sapply doesn't bring much performance benefits, compared to a for loop, at least the code is far more compact. This is the sapply equivalent of your code:
x <- c(1:5)
y <- list(1:5, 2:6, 3:7, 4:8, 5:9, 6:10)
res <- sapply(y, function(e) length(intersect(e, x)))
> res
[1] 5 4 3 2 1 0
Performance gains
As correctly stated by #StupidWolf, it's not sapply that is slowing down the execution, but rather length and intersect. That's my test with 100.000 executions:
B <- 100000
system.time(replicate(B, sapply(y, function(e) length(intersect(e, x)))))
user system elapsed
9.79 0.01 9.79
system.time(replicate(B, sapply(y, function(e) sum(e %in% x))))
user system elapsed
2 0 2
#Using microbenchmark for preciser results:
library(microbenchmark)
microbenchmark(expr1 = sapply(y, function(e) length(intersect(e, x))), times = B)
expr min lq mean median uq max neval
expr1 81.4 84.9 91.87689 86.5 88.2 7368.7 1e+05
microbenchmark(expr2 = sapply(y, function(e) sum(e %in% x)), times = B)
expr min lq mean median uq max neval
expr2 15.4 16.1 17.68144 16.4 17 7567.9 1e+05
As we can see, the second approach is by far the performance winner.
Hope this helps.

Answer 2

You can use map from purrr, it goes through every element of the list y, and performs a function. Below i use map_dbl which returns a vector
library(purrr)
map_dbl(y,~+(. %in% x))
[1] 5 4 3 2 1 0
To see the time:
f1 = function(){
x <- c(1:5)
y <- lapply(1:5,function(i)sample(1:10,5,replace=TRUE))
map_dbl(y,~sum(. %in% x))
}
f2 = function(){
x <- c(1:5)
y <- lapply(1:5,function(i)sample(1:10,5,replace=TRUE))
overlaps <- rep(0, length(y))
for (i in seq(length(y))) { #i=1
overlaps[i] <- length(intersect(x, y[[i]]))
}
overlaps
}
f3 = function(){
x <- c(1:5)
y <- lapply(1:5,function(i)sample(1:10,5,replace=TRUE))
sapply(y,function(i)sum(i%in%x))
}
Let's put it to test:
system.time(replicate(10000,f1()))
user system elapsed
1.27 0.02 1.35
system.time(replicate(10000,f2()))
user system elapsed
1.72 0.00 1.72
system.time(replicate(10000,f3()))
user system elapsed
0.97 0.00 0.97
So if you want speed, do something like sapply + %in% , if something easily readable, do purrr

Answer 3

Here is an option using data.table which should be fast if you have a long list of vectors in y.
library(data.table)
DT <- data.table(ID=rep(seq_along(y), lengths(y)), Y=unlist(y))
DT[.(Y=x), on=.(Y)][, .N, ID]
In addition if you need to run this for multiple x, I would suggest creating a data.table that combines all of the x before running the code
output:
ID N
1: 1 5
2: 2 4
3: 3 3
4: 4 2
5: 5 1