r-使用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调用，以及避免在上面的例子中应用的方法。

我试着用这个答案重写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