Performance 在R中交叉制表两个大规模逻辑向量的最快方法

对于长度>1E8的两个逻辑向量，

x

和

y

，计算2x2交叉表格的最快方法是什么

我怀疑答案是用C/C++编写的，但我想知道在R中是否有什么东西已经非常聪明地解决了这个问题，因为这并不少见

示例代码，针对300M条目（如果3E8太大，请随意选择N=1E8；我选择的总大小略低于2.5GB（2.4GB）。我的目标密度为0.02，只是为了让它更有趣（如果有帮助，可以使用稀疏向量，但类型转换可能需要时间）

一些明显的方法：

表格

bigtablate

简单的逻辑运算（例如，

sum（x&y）

）

向量乘法（boo）

数据表

上述部分，使用来自

多核

软件包（或新的

并行

软件包）的

并行

）

我尝试了前三种选择（见我的答案），但我觉得一定有更好更快的选择

我发现

table

的工作速度非常慢。

bigtablate

对于一对逻辑向量来说似乎有些过火。最后，执行普通的逻辑操作似乎是一个难题，它会对每个向量看太多次（3X？7X？），更不用说它在处理过程中会占用大量额外内存，这是一个巨大的时间浪费

向量乘法通常是个坏主意，但当向量稀疏时，可以将其存储为稀疏，然后使用向量乘法

如果能证明制表函数的任何有趣行为，请随意更改

N

和

p

。）

---

更新1。我的第一个答案给出了三种简单方法的时间安排，这是相信

table

很慢的基础。然而，要认识到的关键是，“逻辑”方法效率极低。看看它在做什么：

• 4逻辑向量运算
• 4种类型转换（逻辑到整数或FP-for

  sum

  ）
• 4矢量求和
• 8个赋值（1个用于逻辑运算，1个用于求和）

不仅如此，它甚至没有被编译或并行化。然而，它仍然把

表格

打得落花流水。请注意，带有额外类型转换（

1*cbind…

）的

bigtable

）仍然优于

table

更新2。为了避免有人指出R中的逻辑向量支持

NA

，而这将是这些交叉表格系统中的一个障碍（在大多数情况下是正确的），我应该指出我的向量来自

is.NA（）

或

is.finite（）

：）我一直在调试

NA

和其他非有限值-。如果您不知道是否所有条目都是

NA

，您可以使用

any（is.NA（yourVector））

进行测试-在您采纳本问答中提出的一些想法之前，这将是明智的

---

更新3。Brandon Bertelsen在评论中提出了一个非常合理的问题：当子样本（毕竟，初始集是样本；-）可能足以创建交叉制表时，为什么要使用这么多数据？不要过分沉迷于统计，但数据来自于两个变量的

TRUE

观测值非常罕见的情况。一个是由于数据异常，另一个是由于代码中可能存在错误（可能存在错误，因为我们只看到计算结果-将变量

x

视为“垃圾输入”，将

y

视为“垃圾输出”。因此，问题是，代码导致的输出问题是否仅限于数据异常的情况，还是存在其他一些好数据变差的情况？（这就是我提出问题的原因。）

这也解释了为什么我的示例中

TRUE

值的概率很低；这些值实际发生的时间远远少于0.1%

---

这是否表明了一种不同的解决方案？是的：它表明我们可以使用两个索引（即

TRUE

在每个集合中的位置）并计算集合交点。我避免集合交点，因为我被Matlab烧掉了一段时间（是的，这是R，但请容忍我），它将首先对集合中的元素进行排序，然后再进行交集。（我模糊地回忆起，复杂性甚至更令人尴尬：例如

O（n^2）

而不是

O（n log n）

）

以下是逻辑方法的结果，

table

，以及

bigtable

，对于n=3E8：

         test replications elapsed relative user.self sys.self
2     logical            1  23.861 1.000000     15.36     8.50
3 bigtabulate            1  36.477 1.528729     28.04     8.43
1       table            1 184.652 7.738653    150.61    33.99

在这种情况下，

表

是一个灾难

为了比较，这里是N=3E6：

         test replications elapsed relative user.self sys.self
2     logical            1   0.220 1.000000      0.14     0.08
3 bigtabulate            1   0.534 2.427273      0.45     0.08
1       table            1   1.956 8.890909      1.87     0.09

在这一点上，似乎编写自己的逻辑函数是最好的，即使这样会滥用

求和

，并多次检查每个逻辑向量。我还没有尝试编译函数，但这应该会产生更好的结果

更新1如果我们给出已经是整数的

bigtablate

值，即如果我们在bigtablate之外进行类型转换

1*cbind（v1，v2）

，那么N=3E6的倍数是1.80，而不是2.4。相对于“逻辑”方法，N=3E8的倍数只有1.21，而不是1.53

---

更新2

正如Joshua Ulrich所指出的，转换为位向量是一个显著的改进——我们分配和移动的数据要少得多：R的逻辑向量每个条目消耗4字节（“为什么？”，你可能会问…），而位向量每个条目消耗一位，即1/32的数据量。因此，

x

消耗1.2e9字节，而

xb

（下面代码中的位版本）仅消耗3.75e7字节

我已经删除了更新基准（N=3e8）的

table

和

bigtablate

变体

         test replications elapsed relative user.self sys.self
2     logical            1   0.220 1.000000      0.14     0.08
3 bigtabulate            1   0.534 2.427273      0.45     0.08
1       table            1   1.956 8.890909      1.87     0.09

        test replications elapsed  relative user.self sys.self
4 logical3B1            1   1.276  1.000000      1.11     0.17
2  logicalB1            1   1.768  1.385580      1.56     0.21
5 logical3B2            1   2.297  1.800157      2.15     0.14
3  logicalB2            1   2.782  2.180251      2.53     0.26
1    logical            1  22.953 17.988245     15.14     7.82

library(rbenchmark)
library(bigtabulate)
library(bit)

set.seed(0)
N <- 3E8
p <- 0.02

x <- sample(c(TRUE, FALSE), N, prob = c(p, 1-p), replace = TRUE)
y <- sample(c(TRUE, FALSE), N, prob = c(p, 1-p), replace = TRUE)

x1 <- 1*x
y1 <- 1*y

xb <- as.bit(x)
yb <- as.bit(y)

func_table  <- function(v1,v2){
    return(table(v1,v2))
}

func_logical  <- function(v1,v2){
    return(c(sum(v1 & v2), sum(v1 & !v2), sum(!v1 & v2), sum(!v1 & !v2)))
}

func_logicalB  <- function(v1,v2){
    v1B <- as.bit(v1)
    v2B <- as.bit(v2)
    return(c(sum(v1B & v2B), sum(v1B & !v2B), sum(!v1B & v2B), sum(!v1B & !v2B)))
}

func_bigtabulate    <- function(v1,v2){
    return(bigtabulate(1*cbind(v1,v2), ccols = c(1,2)))
}

func_bigtabulate2    <- function(v1,v2){
    return(bigtabulate(cbind(v1,v2), ccols = c(1,2)))
}

func_logical3   <- function(v1,v2){
    r1  <- sum(v1 & v2)
    r2  <- sum(v1 & !v2)
    r3  <- sum(!v1 & v2)
    r4  <- length(v1) - sum(c(r1, r2, r3))
    return(c(r1, r2, r3, r4))
}

func_logical3B   <- function(v1,v2){
    v1B <- as.bit(v1)
    v2B <- as.bit(v2)
    r1  <- sum(v1B & v2B)
    r2  <- sum(v1B & !v2B)
    r3  <- sum(!v1B & v2B)
    r4  <- length(v1) - sum(c(r1, r2, r3))
    return(c(r1, r2, r3, r4))
}

benchmark(replications = 1, order = "elapsed", 
    #table = {res <- func_table(x,y)},
    logical = {res <- func_logical(x,y)},
    logicalB1 = {res <- func_logical(xb,yb)},
    logicalB2 = {res <- func_logicalB(x,y)},

    logical3B1 = {res <- func_logical3(xb,yb)},
    logical3B2 = {res <- func_logical3B(x,y)}

    #bigtabulate = {res <- func_bigtabulate(x,y)},
    #bigtabulate2 = {res <- func_bigtabulate2(x1,y1)}
)

# N <- 3e7
require(bit)
xb <- as.bit(x)
yb <- as.bit(y)
benchmark(replications = 1, order = "elapsed", 
    bit = {res <- func_logical(xb,yb)},
    logical = {res <- func_logical(x,y)}
)
#      test replications elapsed relative user.self sys.self user.child sys.child
# 1     bit            1   0.129  1.00000     0.132    0.000          0         0
# 2 logical            1   3.677 28.50388     2.684    0.928          0         0

          test replications elapsed   relative user.self sys.self
6   logical3B1            1   1.298   1.000000      1.13     0.17
4    logicalB1            1   1.805   1.390601      1.57     0.23
7   logical3B2            1   2.317   1.785054      2.12     0.20
5    logicalB2            1   2.820   2.172573      2.53     0.29
2       find01            1   6.125   4.718798      4.24     1.88
9 bigtabulate2            1  22.823  17.583205     21.00     1.81
3      logical            1  23.800  18.335901     15.51     8.28
8  bigtabulate            1  27.674  21.320493     24.27     3.40
1        table            1 183.467 141.345917    149.01    34.41

        test replications elapsed relative user.self sys.self
3     find02            1   1.078 1.000000      1.03     0.04
6 logical3B1            1   1.312 1.217069      1.18     0.13
4  logicalB1            1   1.797 1.666976      1.58     0.22
2    find01B            1   2.104 1.951763      2.03     0.08
7 logical3B2            1   2.319 2.151206      2.13     0.19
5  logicalB2            1   2.817 2.613173      2.50     0.31
1     find01            1   6.143 5.698516      4.21     1.93

 user  system elapsed 
7.670   5.140  12.815 

func_find01 <- function(v1, v2){
    ix1 <- which(v1 == TRUE)
    ix2 <- which(v2 == TRUE)

    len_ixJ <- sum(ix1 %in% ix2)
    len1    <- length(ix1)
    len2    <- length(ix2)
    return(c(len_ixJ, len1 - len_ixJ, len2 - len_ixJ,
             length(v1) - len1 - len2 + len_ixJ))
}

func_find01B <- function(v1, v2){
    v1b = as.bit(v1)
    v2b = as.bit(v2)

    len_ixJ <- sum(v1b & v2b)
    len1 <- sum(v1b)
    len2 <- sum(v2b)

    return(c(len_ixJ, len1 - len_ixJ, len2 - len_ixJ,
             length(v1) - len1 - len2 + len_ixJ))
}

func_find02 <- function(v1b, v2b){
    len_ixJ <- sum(v1b & v2b)
    len1 <- sum(v1b)
    len2 <- sum(v2b)

    return(c(len_ixJ, len1 - len_ixJ, len2 - len_ixJ,
             length(v1b) - len1 - len2 + len_ixJ))
}

func_bigtabulate2    <- function(v1,v2){
    return(bigtabulate(cbind(v1,v2), ccols = c(1,2)))
}

func_tabulate01 <- function(v1,v2){
    return(tabulate(1L + 1L*x + 2L*y))
}

benchmark(replications = 1, order = "elapsed", 
    table = {res <- func_table(x,y)},
    find01  = {res <- func_find01(x,y)},
    find01B  = {res <- func_find01B(x,y)},
    find02  = {res <- func_find01B(xb,yb)},
    logical = {res <- func_logical(x,y)},
    logicalB1 = {res <- func_logical(xb,yb)},
    logicalB2 = {res <- func_logicalB(x,y)},

    logical3B1 = {res <- func_logical3(xb,yb)},
    logical3B2 = {res <- func_logical3B(x,y)},

    tabulate    = {res <- func_tabulate(x,y)},
    bigtabulate = {res <- func_bigtabulate(x,y)},
    bigtabulate2 = {res <- func_bigtabulate2(x1,y1)}
)

library(Rcpp)
library(inline)
doCrossTab <- cxxfunction(signature(x="integer", y = "integer"), body='
  Rcpp::IntegerVector Vx(x);
  Rcpp::IntegerVector Vy(y);
  Rcpp::IntegerVector V(3);
  for(int i = 0; i < Vx.length(); i++) {
    if( (Vx(i) == 1) & ( Vy(i) == 1) ){ V[0]++; } 
    else if( (Vx(i) == 1) & ( Vy(i) == 0) ){ V[1]++; } 
    else if( (Vx(i) == 0) & ( Vy(i) == 1) ){ V[2]++; } 
 }
  return( wrap(V));
  ', plugin="Rcpp")

   user  system elapsed 
 10.930   1.620  12.586 

N <- 1e8
x <- sample(c(T,F),N,replace=T)
y <- sample(c(T,F),N,replace=T)

func_logical  <- function(v1,v2){
    return(c(sum(v1 & v2), sum(v1 & !v2), sum(!v1 & v2), sum(!v1 & !v2)))
}


library(Rcpp)
library(inline)

doCrossTab1 <- cxxfunction(signature(x="integer", y = "integer"), body='
  Rcpp::LogicalVector Vx(x);
  Rcpp::LogicalVector Vy(y);
  Rcpp::IntegerVector V(4);

  V[0] = sum(Vx*Vy);
  V[1] = sum(Vx*!Vy);
  V[2] = sum(!Vx*Vy);
  V[3] = sum(!Vx*!Vy);
  return( wrap(V));
  '
, plugin="Rcpp")

system.time(doCrossTab1(x,y))

require(bit)
system.time(
{
xb <- as.bit(x)
yb <- as.bit(y)
func_logical(xb,yb)
})

> system.time(doCrossTab1(x,y))
   user  system elapsed 
  1.067   0.002   1.069 
> system.time(
+ {
+ xb <- as.bit(x)
+ yb <- as.bit(y)
+ func_logical(xb,yb)
+ })
   user  system elapsed 
  1.451   0.001   1.453 

doCrossTab2 <- cxxfunction(signature(x="integer", y = "integer"), body='
  Rcpp::LogicalVector Vx(x);
  Rcpp::LogicalVector Vy(y);
  Rcpp::IntegerVector V(4);
    V[0]=V[1]=V[2]=V[3]=0;
  LogicalVector::iterator itx = Vx.begin();
  LogicalVector::iterator ity = Vy.begin();
  while(itx!=Vx.end()){
    V[0] += (*itx)*(*ity);
    V[1] += (*itx)*(!*ity);
    V[2] += (!*itx)*(*ity);
    V[3] += (!*itx)*(!*ity);    
    itx++;
    ity++;
  }
  return( wrap(V));
  '
, plugin="Rcpp")

system.time(doCrossTab2(x,y))
#   user  system elapsed 
#  0.780   0.001   0.782