使用 R 或 RCpp 计算矩阵中有多少行全部为 TRUE 的最快方法是什么?

What is the fastest way to calculate how many rows in a matrix are all TRUE using R or RCpp?

剧情简介

我想找到最快的方法来计算一个子集的次数 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.

更新: 添加了一些有助于解决问题的解决方案...不过,另一个数量级会很好。

我们可以通过对 select 列使用整数向量而不是字符向量来提高速度。使用此方法,不会在后台发生名称匹配或使用任何属性。我们将尝试 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

在这里更新我当前的解决方案:

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