Не получить все () быстрее с помощью Rcpp - PullRequest
Новая
       110

Не получить все () быстрее с помощью Rcpp

1 голос
/ 06 ноября 2019

Поскольку я немного новичок в 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()

Затем я создал версию 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, используя этот ответ , но использование этой функции применения Rcpp делает его еще медленнее.

Любые идеи о том, как улучшить скорость Test1 ()используя Rcpp?

1 Ответ

4 голосов
/ 06 ноября 2019

Как уже упоминалось в комментариях, попытка получить более быстрый 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
...