R Сравните один набор значений с несколькими наборами.

Question

У меня есть вектор значений (x).

Я хотел бы определить длину его перекрытия с каждым из наборов, сидящих в списке (y) - но без запуска al oop или lapply. Является ли это возможным? Я действительно заинтересован в ускорении исполнения.

Большое спасибо! Ниже приведен пример с использованием al oop:

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

. Ниже приводится сравнение некоторых методов, предложенных в ответах ниже. Как видите, l oop по-прежнему самый быстрый, но я бы хотел найти что-нибудь быстрее:

# 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

Используйте sapply для компактности кода.

Даже если sapply не принесет значительного выигрыша в производительности, по сравнению с l oop, по крайней мере, код гораздо более компактен. Это sapply эквивалент вашего кода:

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

Прирост производительности

Как правильно сказано @StupidWolf, не sapply замедляет выполнение, а скорее length и intersect. Это мой тест с 100.000 выполнениями:

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

Как мы видим, второй подход - безусловно, победитель производительности.

Надеюсь, это поможет.

Answer 2

Вы можете использовать карту из purrr, она проходит через каждый элемент списка y и выполняет функцию. Ниже я использую map_dbl, который возвращает вектор

library(purrr)
map_dbl(y,~+(. %in% x))
[1] 5 4 3 2 1 0

Чтобы увидеть время:

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

Давайте проверим:

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 

Итак, если вы хотите скорость, сделайте что-нибудь вроде sapply +% в%, если что-то легко читаемо, сделайте purrr

Answer 3

Вот вариант, использующий data.table, который должен быть быстрым, если у вас длинный список векторов в y.

library(data.table)
DT <- data.table(ID=rep(seq_along(y), lengths(y)), Y=unlist(y))
DT[.(Y=x), on=.(Y)][, .N, ID]

Кроме того, если вам нужно запустить его для нескольких x Я бы предложил создать data.table, который объединит все x перед запуском вывода кода

:

   ID N
1:  1 5
2:  2 4
3:  3 3
4:  4 2
5:  5 1