Как преобразовать функцию R в функцию C ++, используя Rcpp? - PullRequest
0 голосов
/ 01 ноября 2018

Я определил следующую функцию:

pij = function(vec){
  out = vec %*% t(vec)
  diag(out) = NA
  out = sum(out, na.rm = T)
  return(out)
}

где vec - вектор, например vec = rnorm(10^4,0,1).

Я хотел бы знать, как эта функция может быть написана на C ++ с использованием пакета Rcpp.

Ответы [ 3 ]

0 голосов
/ 01 ноября 2018

Вот лучшая, более прямолинейная версия, в которой C ++ немного выигрывает:

// [[Rcpp::depends(RcppArmadillo)]]

#include <RcppArmadillo.h>

// [[Rcpp::export]]
double pij_cpp(const arma::vec & v) {
  arma::mat m = v * v.t();
  m.diag().zeros();
  double s = arma::as_scalar(arma::accu(m));
  return(s);
}

/*** R
library(rbenchmark)
set.seed(123)

pij <- function(vec){
  out <- vec %*% t(vec)
  diag(out) <- NA
  out <- sum(out, na.rm = T)
}

x <- rnorm(1000)

## make sure they are the same
all.equal(pij(x), pij_cpp(x))

## benchmark
benchmark(R=pij(x), Cpp=pij_cpp(x))
*/

На моей машине C ++ впереди:

R> sourceCpp("~/git/so-r/53105055/answer.cpp")

R> library(rbenchmark)

R> set.seed(123)

R> pij <- function(vec){
+   out <- vec %*% t(vec)
+   diag(out) <- NA
+   out <- sum(out, na.rm = T)
+ }

R> x <- rnorm(1000)

R> ## make sure they are the same
R> all.equal(pij(x), pij_cpp(x))
[1] TRUE

R> ## benchmark
R> benchmark(R=pij(x), Cpp=pij_cpp(x))
  test replications elapsed relative user.self sys.self user.child sys.child
2  Cpp          100   0.127    1.000     0.283    0.356          0         0
1    R          100   0.583    4.591     2.607    4.011          0         0
R>

Большой вывод ... что вы посмотрели не на ту проблему. Ваша функция R уже сильно векторизован и вызывает в основном скомпилированный код, так что выиграть было не так уж много.

0 голосов
/ 02 ноября 2018

Я бы предложил сначала подумать о математике, стоящей за этой проблемой. Для вектора v вы пытаетесь вычислить

sum_{i=1}^{N-1} sum_{j=i+1}^{N} 2 * v_i * v_j

Вы можете сделать это, сначала создав матрицу v_i * v_j, но это может быть дорого, если v велико. Так что проще реализовать двойную сумму непосредственно в C ++:

#include <Rcpp.h>
// [[Rcpp::export]]
double pij_cpp(Rcpp::NumericVector vec) {
  double out{0.0};
  int N = vec.size();
  for (int i = 0; i < N; ++i) {
    for (int j = i + 1; j < N; ++j) {
      out += 2 * vec[i] * vec[j];
    }
  }
  return out;
}

Однако формулу выше можно изменить:

2 * sum_{i=1}^{N-1} v_i * sum_{j=i+1}^{N} v_j

, который позволяет нам избавиться от двойной петли, начиная с верхнего конца и переходя к нижнему:

#include <Rcpp.h>
// [[Rcpp::export]]
double pij_opt(Rcpp::NumericVector vec) {
  double out{0.0};
  double sum{0.0};
  int N = vec.size();
  for (int i = N -1; i > 0; --i) {
    sum += vec[i];
    out += sum * vec[i-1];
  }
  return 2 * out;
}

Мы можем сравнить эти версии с вашим кодом R и версией на основе Armadillo для вектора длины 10^4:

> bench::mark(pij(vec), pij_cpp(vec), pij_opt(vec), pij_arma(vec))
# A tibble: 4 x 14
  expression     min    mean  median     max `itr/sec` mem_alloc  n_gc n_itr total_time result
  <chr>      <bch:t> <bch:t> <bch:t> <bch:t>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list>
1 pij(vec)   716.4ms 716.4ms 716.4ms 716.4ms      1.40    1.49GB     1     1      716ms <dbl …
2 pij_cpp(v…  59.9ms  61.4ms  61.5ms  62.3ms     16.3     2.49KB     0     9      552ms <dbl …
3 pij_opt(v…  14.2µs  15.6µs  14.9µs 864.5µs  64072.      2.49KB     0 10000      156ms <dbl …
4 pij_arma(… 834.5ms 834.5ms 834.5ms 834.5ms      1.20    2.49KB     0     1      834ms <dbl …
# ... with 3 more variables: memory <list>, time <list>, gc <list>

R и Armadillo примерно на одном уровне (и, вероятно, ограничены распределением памяти). Первая версия C ++ быстрее в 10 раз, вторая в 50000 раз!

Полный код:

// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>

// [[Rcpp::export]]
double pij_arma(arma::vec vec) {
  arma::mat out = vec * vec.t();
  out.diag().zeros();
  return arma::accu(out);
}

// [[Rcpp::export]]
double pij_cpp(Rcpp::NumericVector vec) {
  double out{0.0};
  int N = vec.size();
  for (int i = 0; i < N; ++i) {
    for (int j = i + 1; j < N; ++j) {
      out += 2 * vec[i] * vec[j];
    }
  }
  return out;
}

// [[Rcpp::export]]
double pij_opt(Rcpp::NumericVector vec) {
  double out{0.0};
  double sum{0.0};
  int N = vec.size();
  for (int i = N -1; i > 0; --i) {
    sum += vec[i];
    out += sum * vec[i-1];
  }
  return 2 * out;
}


/*** R
pij = function(vec){
  out = vec %*% t(vec)
  diag(out) = NA
  out = sum(out, na.rm = T)
  return(out)
}


set.seed(42)
vec = rnorm(10^4,0,1)
pij(vec)

bench::mark(pij(vec), pij_cpp(vec), pij_opt(vec), pij_arma(vec))
*/

Для полноты: это действительно вопрос алгоритма, так что даже цикл for в R быстрее, чем pij_cpp:

pij_opt_r <- function(vec) {
  out <- 0
  sum <- 0
  N <- length(vec)
  for (i in seq.int(from = N, to = 2, by = -1)) {
    sum <- sum + vec[i]
    out <- out + sum * vec[i-1]
  }
  2 * out
}

Использование векторизованных функций в R еще быстрее, но все же не так быстро, как pij_opt:

pij_opt_r2 <- function(vec) {
  N <- length(vec)
  vec <- rev(vec)
  sums <- cumsum(vec)
  2 * sum(vec[2:N] * sums[1:N-1])
}

Полный тест:

> bench::mark(pij(vec), pij_cpp(vec), pij_opt(vec), pij_opt_r(vec), pij_opt_r2(vec), pij_arma(vec))
# A tibble: 6 x 14
  expression     min     mean   median     max `itr/sec` mem_alloc  n_gc n_itr total_time result
  <chr>      <bch:t> <bch:tm> <bch:tm> <bch:t>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list>
1 pij(vec)   733.6ms  733.6ms  733.6ms 733.6ms      1.36    1.49GB     1     1      734ms <dbl …
2 pij_cpp(v…    60ms  61.41ms  60.84ms  64.2ms     16.3     2.49KB     0     9      553ms <dbl …
3 pij_opt(v…  14.2µs  15.83µs  15.35µs 750.1µs  63164.      2.49KB     0 10000      158ms <dbl …
4 pij_opt_r… 981.1µs   1.04ms   1.02ms   1.5ms    960.     119.2KB     0   480      500ms <dbl …
5 pij_opt_r…   157µs 272.95µs 241.57µs  66.3ms   3664.    547.28KB     1  1832      500ms <dbl …
6 pij_arma(… 878.4ms 878.38ms 878.38ms 878.4ms      1.14    2.49KB     0     1      878ms <dbl …
# ... with 3 more variables: memory <list>, time <list>, gc <list>
0 голосов
/ 01 ноября 2018

Вот решение, которое я нашел:

library(Rcpp)
library(inline)

rcpp_inc = "using namespace Rcpp;
using namespace arma;"

src = "
vec vec1 = as<vec>(vecin);
mat out = vec1*trans(vec1);
out.diag().zeros();

return(wrap(accu(out)));
"
pij_rcpp = cxxfunction(signature(vecin="numeric"), src, plugin='RcppArmadillo', rcpp_inc)

Однако, это медленнее, чем функция, написанная на R. Например, если я запустил этот пример,

set.seed(1)
x = runif(1e4)
system.time({pij_r(x)}) 
system.time({pij_rcpp(x)})

Я получаю, что истекший период составляет 1,101 для pij_r и 1,332 для pij_rcpp.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...