使用 R 或 RCpp 计算矩阵中有多少行都是 TRUE 的最快方法是什么？

Question

概要

我想找到最快的方法来计算一个子集的多少次 由vec 从逻辑矩阵定义的列是all TRUE:

小例子：

mlgl <- structure(c(FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, 
                    FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, 
                    FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, 
                    TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, 
                    FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, 
                    FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, 
                    TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, 
                    FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE), .Dim = c(15L, 5L
                    ), .Dimnames = list(NULL, c("l1", "l2", "l3", "l4", "l5")))
mlgl
#>          l1    l2    l3    l4    l5
#>  [1,] FALSE FALSE FALSE FALSE FALSE
#>  [2,]  TRUE FALSE FALSE FALSE  TRUE
#>  [3,] FALSE  TRUE FALSE FALSE FALSE
#>  [4,] FALSE FALSE  TRUE FALSE FALSE
#>  [5,]  TRUE  TRUE FALSE FALSE  TRUE
#>  [6,]  TRUE FALSE  TRUE FALSE  TRUE
#>  [7,]  TRUE FALSE FALSE  TRUE  TRUE
#>  [8,] FALSE  TRUE  TRUE FALSE FALSE
#>  [9,] FALSE  TRUE FALSE  TRUE FALSE
#> [10,] FALSE FALSE  TRUE  TRUE FALSE
#> [11,]  TRUE  TRUE  TRUE FALSE  TRUE
#> [12,]  TRUE  TRUE FALSE  TRUE  TRUE
#> [13,]  TRUE FALSE  TRUE  TRUE  TRUE
#> [14,] FALSE  TRUE  TRUE  TRUE FALSE
#> [15,]  TRUE  TRUE  TRUE  TRUE  TRUE

一个向量子集，由vec定义：

vec <- c("l1", "l3")

我想知道vec 中的所有变量是TRUE 的多少倍。为了 这个 vec 的预期答案是 4（第 6、11、13 和 15 行）。最快的 我能想到的方法是：

sum(rowSums(mlgl[,vec]) == length(vec))
#> [1] 4

compiler::cpmfun 对这些都没有帮助：

microbenchmark(
  sum(apply(mlgl[, vec], 1, all)), 
  sum(rowSums(mlgl[,vec]) == length(vec)),
  unit = "eps"
  )
#> Unit: evaluations per second
#>                                      expr       min       lq     mean
#>           sum(apply(mlgl[, vec], 1, all))  4416.649 14013.85 13696.17
#>  sum(rowSums(mlgl[, vec]) == length(vec)) 27348.557 63477.96 67712.96
#>    median       uq      max neval cld
#>  14210.30 14397.81 14766.03   100  a 
#>  65017.46 75503.08 81175.42   100   b

我希望有一些替代解决方案或建议做得更好 这在 R 或 RCpp 中。

更新：添加了一些有助于解决问题的解决方案...不过，再提高一个数量级就好了。

Answer 1

我们可以通过使用整数向量而不是字符向量来选择列来提高速度。使用此方法，不会在后台发生名称匹配或使用任何属性。我们会试试fmatch() 和match()。

以下标记为integer 的行仅显示了单独使用整数向量的速度。

library(fastmatch)
microbenchmark(
    fmatch  = sum(rowSums(mlgl[, fmatch(vec, colnames(mlgl))]) == length(vec)),
    match   = sum(rowSums(mlgl[, match(vec, colnames(mlgl))]) == length(vec)),
    integer = sum(rowSums(mlgl[, c(1L, 3L)]) == length(vec)),
    unit = "eps"
 )
# Unit: evaluations per second
#     expr      min       lq     mean   median       uq      max neval
#   fmatch 16146.74 49468.25 50143.24 50823.34 52064.45 54404.00   100
#    match 45108.03 58503.55 59741.99 59724.68 61135.91 64930.85   100
#  integer 41023.96 80411.72 81827.19 83004.78 85429.93 88944.23   100

实际上我们似乎根本不需要加载 fastmatch，因为 match() 做得更好。总的来说，使用整数向量代替字符名称匹配肯定会提高速度。

我相信很快就会发布一个不错的快速 Rcpp 答案。

更新：这里还有一种使用which()和length()的方法也很好。

microbenchmark(
    which = length(which(rowSums(mlgl[, vec]) == length(vec))),
    unit = "eps"
)
# Unit: evaluations per second
#   expr      min       lq     mean   median      uq     max neval
#  which 26816.12 81502.91 81858.62 83156.76 84566.6 87850.3   100

Answer 2

在此处更新我当前的解决方案：

mlgl <- structure(c(FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, 
                    FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, 
                    FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, 
                    TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, 
                    FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, 
                    FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, 
                    TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, 
                    FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE), .Dim = c(15L, 5L
                    ), .Dimnames = list(NULL, c("l1", "l2", "l3", "l4", "l5")))
vec <- c("l1", "l3")

初始解决方案

initial <- function() {
  sum(rowSums(mlgl[,vec]) == length(vec))
}

.Internal(...sol'n（这是不允许的）

current <- function() {
  sml <- mlgl[,vec]
  dims <- dim(sml)
  sum(.Internal(rowSums(sml, dims[1], dims[2], FALSE)) == dims[2])
}

因此我尝试使用 c++ 进行简单的解决方案：

Rcpp::cppFunction('int cpp_sum_trues(LogicalMatrix x) {
  int nrow = x.nrow(), ncol = x.ncol();
  int out = 0;

  for (int i = 0; i < nrow; i++) {
    int total = 0;
    for (int j = 0; j < ncol; j++) {
      total += x(i, j);
    }
    if (total == ncol) {
      out += 1;
    }
  }
  return out;
}')
a_cpp_soln <- function() {
  sml <- mlgl[,vec]
  cpp_sum_trues(sml)
}

时间安排：

microbenchmark(initial(), current(), a_cpp_soln(), times = 1e3, unit = "eps")
#> Unit: evaluations per second
#>          expr      min        lq      mean    median        uq       max
#>     initial() 13468.01  69223.31  70388.61  71622.98  74239.05  81652.65
#>     current() 22163.12 161407.47 168268.59 169319.34 180619.56 211595.43
#>  a_cpp_soln() 28041.84 140007.02 151792.51 152288.15 167841.56 186950.83
#>  neval cld
#>   1000 a  
#>   1000   c
#>   1000  b