Вызов функции R cpp :: параллельно - PullRequest
2 голосов
/ 18 марта 2020

Я пытаюсь выполнить sh следующее:

У меня есть функция R, которую мне нужно вызывать в программе на C ++ (которая позже экспортируется в R). Я хотел бы выполнить эту функцию R параллельно, но пока я не смог этого сделать.

Вот пример, который работает , без параллелизма

library(ergm)
library(Rcpp)
r_func <- function(theta, nnodes=100) {
  y = network(nnodes, directed=F) 
  as.matrix(simulate(
    y ~ edges, 
    theta0=theta))
}

sourceCpp(code='
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]

using namespace Rcpp;

// [[Rcpp::export]]
std::vector<arma::mat> test_seq(double x) {
  std::vector<arma::mat> res(100);
  Function r_func_ = Environment::global_env()["r_func"];
  for (int i=0; i < 100; i++) {
    NumericVector out = r_func_(x);
    int n_nodes = 100;
    res[i] = arma::mat(out.begin(), n_nodes, n_nodes); 
  }
  return res;
}
')

Для того, чтобы все было сделано параллельно, моей первой попыткой было просто добавить #pragma omp parallel for перед основным l oop. Однако это произвело "R сессию прервано"

Другая вещь, которую я попытался, состояла в том, чтобы изменить функцию R, чтобы использовать параллелизм R следующим образом

library(Rcpp)
library(ergm)
library(doParallel)

r_func_par <- function(theta, nnodes=100) {
  cl <- makeCluster(4)
  registerDoParallel(cl)
  res = foreach(i = 1:100, .packages = c("ergm"),  
          .export = c("simulate", "network")) %dopar% { 
      y = network(nnodes, directed=F) 
      as.matrix(simulate(
        y ~ edges, 
        theta0=theta))
  }
  stopImplicitCluster()
  stopCluster(cl)
  res
}


sourceCpp(code='
#include <RcppArmadillo.h>
// [[Rcpp::depends(RcppArmadillo)]]

using namespace Rcpp;

// [[Rcpp::export]]
std::vector<arma::mat> test_seq(double x) {
  std::vector<arma::mat> res(100);
  Function r_func_par_ = Environment::global_env()["r_func_par"];
  Rcpp::List out = r_func_par(x);
  int n_nodes = 100;
  for (int i=0; i < 100; i++) {
    res[i] = arma::mat(Rcpp::as<Rcpp::NumericVector>(out[i]).begin(), n_nodes, n_nodes); 
  }
  return res;
}
')

В этом случае код просто зависает (очень долго) а потом R вылетает. Есть ли лучший способ получить это?

...