Nic*_*ick 2 r rcpp rcppparallel rcpparmadillo
由于我对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))
Run Code Online (Sandbox Code Playgroud)
我现在要完成以下操作:
Test1 <- function(){
for (i in 1:nrow(P)) {
Parent_Check[i,] <- apply(P, 1, function(x) all(x == P[i,]))
}
}
Test1()
Run Code Online (Sandbox Code Playgroud)
然后,我为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));
}
'
)
Run Code Online (Sandbox Code Playgroud)
使用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)
Run Code Online (Sandbox Code Playgroud)
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
Run Code Online (Sandbox Code Playgroud)
麻烦的是,all_C()比all()慢,所以我怀疑Test2()的慢速需要更好的all_C调用以及避免在上述示例中应用的方式。
我尝试使用此答案在Rcpp中重写Apply ,但是使用此Rcpp apply函数会使速度变慢。
关于如何使用Rcpp提高Test1()速度的任何想法?
正如评论中提到的那样,试图更快地实现目标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;
}
')
Run Code Online (Sandbox Code Playgroud)
原始实现:
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
}
Run Code Online (Sandbox Code Playgroud)
结果:
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
Run Code Online (Sandbox Code Playgroud)