Оптимизация расчета комбинаций в список - большой набор данных - PullRequest
Новая
       12

Оптимизация расчета комбинаций в список - большой набор данных

0 голосов
/ 08 июня 2018

Интересно, сможет ли кто-нибудь найти более быстрый способ вычисления комбинаций элементов в векторе.Мой подход работает, но медленный, с вектором около 6 миллионов элементов.

Тестовый вектор 

test.vector <- c("335261 344015 537633","22404 132858","254654 355860 488288","219943 373817","331839 404477")

Мой подход 

lapply(strsplit(test.vector, " "), function(x) unique(apply(combn(x, 2), 2, function(y) paste0(y, collapse = ""))))

Ожидаемый результат 

[[1]]
[1] "335261344015" "335261537633" "344015537633"

[[2]]
[1] "22404132858"

[[3]]
[1] "254654355860" "254654488288" "355860488288"

[[4]]
[1] "219943373817"

[[5]]
[1] "331839404477"

1 Ответ

0 голосов
/ 08 июня 2018

Вот ответ, который на 25x быстрее, чем решение OP для больших тестовых случаев.Он не полагается на paste, а скорее использует свойства чисел и векторизованных операций.Мы также используем comboGeneral из пакета RcppAlgos (я автор), который намного быстрее, чем combn и combnPrim из связанного ответа для генерации комбинаций вектора.Сначала мы показываем повышение эффективности comboGeneral по сравнению с другими функциями: 

## library(gRbase)
library(RcppAlgos)
library(microbenchmark)

microbenchmark(gRbase::combnPrim(300, 2), combn(300, 2), 
               comboGeneral(300, 2), unit = "relative")
Unit: relative
                     expr        min         lq      mean     median         uq       max neval
gRbase::combnPrim(300, 2)   5.145654   5.192439   4.83561   7.167839   4.320497   3.98992   100
            combn(300, 2) 204.866624 192.559119 143.75540 174.079339 102.733367 539.12325   100
     comboGeneral(300, 2)   1.000000   1.000000   1.00000   1.000000   1.000000   1.00000   100

Теперь мы создаем функцию для создания некоторых случайных воспроизводимых данных, которые будут переданы нашим тестовым функциям: 

makeTestSet <- function(vectorSize, elementSize, mySeed = 42, withRep = FALSE) {
    set.seed(mySeed)
    sapply(1:vectorSize, function(x) {
        paste(sample(10^6, s1 <- sample(2:elementSize, 1), replace = withRep), collapse = " ")
    })
}

makeTestSet(5, 3)
[1] "937076 286140 830446" "519096 736588 134667" "705065 457742 719111" 
[4] "255429 462293 940013" "117488 474997 560332"

Это выглядит хорошо.Теперь давайте посмотрим, приносит ли нам установка fixed = TRUE какие-либо выгоды (как предложено выше @MichaelChirico): 

bigVec <- makeTestSet(10, 100000)

microbenchmark(standard = strsplit(bigVec, " "), 
               withFixed = strsplit(bigVec, " ", fixed = TRUE), 
               times = 15, unit = "relative")
Unit: relative
     expr      min       lq     mean   median       uq      max neval
 standard 4.447413 4.296662 4.133797 4.339537 4.084019 3.415639    15
withFixed 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    15

@ MichaelChirico был на месте.Собрав все это вместе, мы получим: 

combPairFast <- function(testVec) {
    lapply(strsplit(testVec, " ", fixed = TRUE), function(x) {
        combs <- RcppAlgos::comboGeneral(as.numeric(x), 2)
        unique(combs[,1] * (10)^(as.integer(log10(combs[,2])) + 1L) + combs[,2])
    })
}

## test.vector defined above by OP
combPairFast(test.vector)
[[1]]
[1] 335261344015 335261537633 344015537633

[[2]]
[1] 22404132858

[[3]]
[1] 254654355860 254654488288 355860488288

[[4]]
[1] 219943373817

[[5]]
[1] 331839404477

## OP original code
combPairOP <- function(testVec) {
    lapply(strsplit(testVec, " "), function(x) unique(apply(combn(x, 2), 2, function(y) paste0(y, collapse = ""))))
}

Как указано в комментариях ОП, максимальное число составляет менее миллиона (точнее 600000), что означает, что после того, как мы умножим одно из чиселне более чем на 10 ^ 6 и добавить его к другому 6-значному числу (эквивалентно простому объединению двух строк чисел), мы гарантированно окажемся в пределах числовой точности базы R (т. е. 2^53 - 1).Это хорошо, потому что арифметические операции над числовыми числами намного эффективнее, чем операции со строками.

Все, что осталось, это сравнительный тест: 

test.vector <- makeTestSet(100, 50)

microbenchmark(combPairOP(test.vector), 
               combPairFast(test.vector),
               times = 20, unit = "relative")
Unit: relative
                     expr      min      lq     mean   median     uq      max neval
  combPairOP(test.vector) 22.33991 22.4264 21.67291 22.11017 21.729 25.23342    20
combPairFast(test.vector)  1.00000  1.0000  1.00000  1.00000  1.000  1.00000    20

И на больших векторах: 

bigTest.vector <- makeTestSet(1000, 100, mySeed = 22, withRep = TRUE)

## Duplicate values exist
any(sapply(strsplit(bigTest.vector, " ", fixed = TRUE), function(x) {
    any(duplicated(x))
}))
[1] TRUE

system.time(t1 <- combPairFast(bigTest.vector))
 user  system elapsed 
0.303   0.011   0.314 

system.time(t2 <- combPairOP(bigTest.vector))
 user  system elapsed 
8.820   0.081   8.902    ### 8.902 / 0.314 ~= 28x faster

## results are the same
all.equal(t1, lapply(t2, as.numeric))
[1] TRUE
...