[使用Rcpp无法更快地获取all（）

Question

由于我对Rcpp有点陌生，所以我可能在这里缺少窍门。

让我们创建两个矩阵：

library(Rcpp)
library(microbenchmark)

P <- matrix(0, 200,500)
for(i in 1:500) P[,i] <- rep(rep(sample(0:1), 2), 25)
Parent_Check <- matrix(0, nrow(P), nrow(P))

我现在要完成以下操作：

Test1 <- function(){
  for (i in 1:nrow(P)) {
    Parent_Check[i,] <- apply(P, 1, function(x) all(x == P[i,]))
  }

}
Test1()

然后我为all（）创建了一个Rcpp版本，希望提高速度，定义为：

Rcpp::cppFunction(

'bool all_C(LogicalVector x) {
  // Note the use of is_true to return a bool type.
  return is_true(all(x == TRUE));
 }
'  
)

使用all_C检查速度，事实证明速度较慢：

Test2 <- function(){
  for (i in 1:nrow(P)) {
    Parent_Check[i,] <- apply(P, 1, function(x) all_C(x == P[i,]))
  }
  Parent_Check
}

microbenchmark::microbenchmark(Test1(), Test2(), times = 10)

    expr      min       lq     mean   median       uq      max neval
 Test1() 467.9671 471.1590 488.1784 479.4830 485.4755 578.5338    10
 Test2() 544.6561 552.7025 587.8888 570.4416 641.1202 657.7581    10

问题是，all_C（）比all（）慢，所以我怀疑Test2（）的慢速需要更好的all_C调用以及避免在上面的示例中应用的方法。

我尝试使用this answer重写Rcpp中的apply，但是使用此Rcpp apply函数会使速度变慢。

关于如何使用Rcpp提高Test1（）速度的任何想法？

Answer 1

正如评论中提到的那样，试图获得更快的all()可能在这里没有帮助。相反，您可能希望将循环移入C ++。这样做还可以为您提供更多的控制权：例如，您可以避免始终比较行中的所有元素，而可以将第一个不相等的元素短路。

这是我对更快的解决方案的看法：

Rcpp::cppFunction('
// For all rows, check if it is equal to all other rows
LogicalMatrix f2(const NumericMatrix& x) {
  size_t n = x.rows();
  size_t p = x.cols();
  LogicalMatrix result(n, n);

  for (size_t i = 0; i < n; i++) {
    for (size_t j = 0; j < i; j++) {
      bool rows_equal = true;

      for (size_t k = 0; k < p; k++) {
        if (x(i, k) != x(j, k)) {
          rows_equal = false;
          break;
        }
      }

      result(i, j) = rows_equal;
      result(j, i) = rows_equal;
    }
    result(i, i) = true;
  }

  return result;
}
')

原始实现：

set.seed(4)

P <- matrix(0, 200,500)
for(i in 1:500) P[,i] <- rep(rep(sample(0:1), 2), 25)

f1 <- function(P) {
  Parent_Check <- matrix(0, nrow(P), nrow(P))
  for (i in 1:nrow(P)) {
    Parent_Check[i,] <- apply(P, 1, function(x) all(x == P[i,]))
  }
  Parent_Check
}

结果：

bench::mark(f1(P), f2(P) * 1)
#> Warning: Some expressions had a GC in every iteration; so filtering is
#> disabled.
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 f1(P)      736.18ms 736.18ms      1.36     697MB    27.2 
#> 2 f2(P) * 1    6.37ms   6.95ms    134.       471KB     1.96

^{由reprex package（v0.3.0）在2019-11-06创建}