Как быстрее рассчитать «перекрестное соединение» перестановок? - PullRequest
Новая
       25

Как быстрее рассчитать «перекрестное соединение» перестановок?

2 голосов
/ 05 ноября 2019

У меня есть data.table с двумя столбцами.
"события, группа"
Может быть до 20 строк или всего 1.
Каждое из этих событий классифицируется в данныйgroup.
data.table уже отсортирован по группам.

Например: 

Events   group   
     a       1
     b       2
     c       2
     d       2
     e       3
     f       3

Что мне нужно сделать:
- Для каждой группы вычислить все перестановки ее событий.
- Вычислить все перекрестные комбинации этих перестановок.
- Позже для каждой «комбинации» я буду дополнительно вычислять дополнительные.

В моем примере я получу эту перестановку (показана в строке) 

a 

b  c  d 
b  d  c 
c  b  d 
c  d  b 
d  b  c 
d  c  b 

e  f 
f  e

И, наконец, это кросс-комбинациястроки: 

a  b  c  d  e  f 
a  b  d  c  e  f 
a  c  b  d  e  f 
a  c  d  b  e  f 
a  d  b  c  e  f 
a  d  c  b  e  f 
a  b  c  d  f  e 
a  b  d  c  f  e 
a  c  b  d  f  e 
a  c  d  b  f  e 
a  d  b  c  f  e 
a  d  c  b  f  e

То, как я этого добился, было: 

library(data.table)
library(arrangements)

myDT <- data.table(ll=letters[1:6], gr=c(1,2,2,2,3,3))   #simple example 

dos <- function(x,y) {
  temp <- expand.grid(1:nrow(x),1:nrow(y))
  cbind(x[temp[,1],], y[temp[,2],])
}

fun2 <- function(z) Reduce(dos,z)


permu <- function(xx )  {   # alternative to compute the permutations
  if (length(xx)==1) {
    matrix(xx)
  } else if (length(xx)==2) {
    rbind(c(xx[1], xx[2]),c(xx[2], xx[1]))
  } else {
  permutations(xx) 
} } 

f1 <- function(x) {fun2(tapply(myDT$ll,myDT$gr, permutations))}
f2 <- function(x) {fun2(myDT[,.(.(permutations(ll))),by=gr]$V1)}
f3 <- function(x) {fun2(myDT[,.(.(permu(ll))),by=gr]$V1)}

Первый метод использует tappply.
Второй метод пытается выполнить вычисления в таблице данных. путь. Третий метод пытается ускорить вычисления для небольших групп.
Я использую перестановки из пакета "договоренности", потому что это быстро. Не стесняйтесь использовать любой пакет (например, RcppAlgos) или кодировать свой собственный алгоритм.
Я не возражаю, если вывод представляет собой матрицу, таблицу данных, список, транспонированный, если вы используете другие контейнеры или если онзаказал по-другому. 

myDT <- data.table(ll=letters[1:6], gr=c(1,2,2,2,3,3))

f1()      982.05us      1.88KB    501ms 
f2()        2.38ms     52.27KB    501ms 
f3()        1.83ms     52.27KB    501ms

Для сравнения мы можем использовать более крупный пример. 

myDT <- data.table(ll=letters[1:15], gr=rep(1:5, times=rep(5:1)))  # larger example

               min     median   mem_alloc     gc total_time 
f1()       381.5ms     911ms       22.3MB       1.82s 
f2()       123.5ms     185ms       22.3MB       580.22ms
f3()        99.3ms     130ms       22.3MB       505.05ms

Как я могу сделать это быстрее? (также лучше использовать меньше памяти)
Если я попытаюсь сделать это с помощью data.table (ll = буквы [1:21], gr = rep (1: 6, times = rep (6: 1))занимает больше 3 минут, слишком много, потому что в моей реальной задаче мне нужно выполнить вычисления 1 миллион раз.

1 Ответ

2 голосов
/ 06 ноября 2019

Рано или поздно вы столкнетесь с проблемой нехватки памяти, и с data.table(ll=letters[1:21], gr=rep(1:6, times=rep(6:1))) вы создадите 24 883 200 строк (prod(factorial(DT[, .N, gr]$N))).

В любом случае, если это абсолютно необходимо генерировать все перестановки, вот вариант: 

library(data.table)
library(RcppAlgos)
DT <- data.table(ll=letters[1:6], gr=c(1,2,2,2,3,3))
DT <- data.table(ll=letters[1:21], gr=rep(1:6, times=rep(6:1)))
#prod(factorial(DT[, .N, gr]$N))

CJ.dt_1 <- function(...) {
    Reduce(f=function(x, y) cbind(x[rep(1:nrow(x), times=nrow(y)),], y[rep(1:nrow(y), each=nrow(x)),]),
        x=list(...))
} #CJ.dt_1

system.time(
    ans <- do.call(CJ.dt_1, DT[, .(.(RcppAlgos::permuteGeneral(ll, .N))), gr]$V1)
)

#   user  system elapsed 
#  16.49    4.63   21.15
...