calling an Rcpp::Function in parallel

Viewed 459

I'm trying to accomplish the following:

I have an R function that I need to call within a C++ program (which is later exported to R). I would want to execute this R function in parallel, but so far I have not been able to do so.

Here is an example which is working, without parallelism

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;
}
')

In order to get things done in parallel, my first try was to simply add a #pragma omp parallel for before the main loop. However this produced an "R session aborted"

Another thing I tried was to modify the R function, to exploit R's parallelism like this

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;
}
')

In this case instead, the code just hangs (for a very long time) and then R crashes. Is there a better way to obtain this?

0 Answers
Related