时间戳

首页 > 解决方案 > 如何更快地计算排列的“交叉连接”？

r - 如何更快地计算排列的“交叉连接”？

问题描述

我有一个包含 2 列的 data.table。
“事件，组”
最多可以有 20 行，或者少至 1 行。
每个事件都被分类到一个给定的组中。
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)}

第一种方法使用tapply。
第二种方法尝试以 data.table 的方式进行计算。第三种方法试图让小团体的计算速度更快。
我正在使用“安排”包中的排列，因为它很快。随意使用任何包（例如 RcppAlgos）或编写自己的算法。
我不介意输出是矩阵、data.table、列表、转置、使用其他容器还是以不同方式排序。 

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=letters[1:21], gr=rep(1:6, times=rep(6:1)) 来做它需要超过3 分钟，太长了，因为在我的实际问题中，我需要执行 100 万次计算。

标签： rdata.tablecombinationspermutationcross-join

解决方案

迟早你会遇到内存不足的问题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

推荐阅读