Распараллелить функцию, использующую внешние указатели (XPtr)

Этот вопрос не является дубликатом ни этого, ни этот, посвященный функциям, возвращающим внешние указатели.

Вот в чем проблема. Нижеследующий код Rcpp определяет две функции, одна из которых создает XPtr, а другая может работать с XPtr.

#include <Rcpp.h>
using namespace Rcpp;

//[[Rcpp::export]]
SEXP f(int n) {
  std::vector<int> * v = new std::vector<int>;

  for(int i = 0; i < n; i++)
    v->push_back(i);

  XPtr< std::vector<int> > p(v, true);
  return p;
}

//[[Rcpp::export]]
int g(XPtr< std::vector<int> > p, int i) {
  return (*p)[i];

И он отлично работает:

> x <- f(100)
> g(x, 45)
[1] 45

Попробуем распараллелить вызовы g. Это работает:

require(parallel)
test1 <- function(a) {
  cl <- makeForkCluster(nnodes=2)
  r <- parLapply(cl, 1:5, function(i) g(a,i) )
  stopCluster(cl)
  return(r)
}

Ожидаемое поведение:

> unlist( test1(x) )
[1] 1 2 3 4 5

Но это не работает:

test2 <- function(a) {
  cl <- makeForkCluster(nnodes=2)

  p <- g(a, 0)
  r <- parLapply(cl, 1:5, function(i) g(a,i) )
  stopCluster(cl)
  return(r)
}

Неожиданное поведение:

> test2(x)
Error in checkForRemoteErrors(val) : 
  2 nodes produced errors; first error: external pointer is not valid

Проблема, похоже, возникает из-за того, что внешний указатель используется один раз в функции перед вызовом подчиненных устройств в кластере. Чем объясняется такое поведение и есть ли обходной путь? Спасибо заранее.


r rcpp rparallel
person Elvis    schedule 05.02.2019    source источник

Ответы (1)


arrow_upward
4
arrow_downward

В начале вашей функции a — это обещание, т.е. что-то, что говорит оценить определенное выражение в определенной среде. Когда вы обращаетесь к переменной, вычисляется выражение, поэтому теперь a является указателем, и этот указатель специфичен для конкретного экземпляра R. Вы можете посмотреть на это, используя pryr::promise_info:

test2 <- function(a) {
  cl <- makeForkCluster(nnodes = 2)
  print(pryr::promise_info(a))
  p <- g(a, 0)
  print(pryr::promise_info(a))
  stopCluster(cl)
  return(r)
}

Выход:

$code
x

$env
<environment: R_GlobalEnv>

$evaled
[1] FALSE

$value
NULL

$code
x

$env
NULL

$evaled
[1] TRUE

$value
<pointer: 0x565295e3a410>

Один из способов - использовать eval(substitute(a)):

test2 <- function(a) {
  cl <- makeForkCluster(nnodes = 2)
  print(pryr::promise_info(a))
  p <- g(eval(substitute(a)), 0)
  print(pryr::promise_info(a))
  r <- parLapply(cl, 1:5, function(i) g(a,i) )
  stopCluster(cl)
  return(r)
}

Я уверен, что есть лучшие способы. Мне все еще немного чужда нестандартная оценка...

person Ralf Stubner    schedule 05.02.2019
comment
Отличный ответ, спасибо!! Я не знал pryr::promise_info, который, безусловно, окажется полезным в других ситуациях (у меня есть другие проблемы того же характера с вызовами вложенных функций...). Прежде чем задать вопрос, я попробовал несколько вещей, таких как get(deparse(substitute(a))), но я не подумал eval... - person Elvis; 05.02.2019
comment
пожалуйста, взгляните на этот новый вопрос: stackoverflow.com/questions/54764144 - person Elvis; 19.02.2019