如何在R中并行计算重复循环？

ssaha 发表于 Dev

萨哈

我试图找到方程组的根。这是我正在使用的R代码：

x1 <- 0
x2 <- 0
counter <- 0
eps <- 0.000001
repeat {
       x1_old<-x1
       x2_old<-x2
       counter <- counter + 1
       res<-uniroot(fun_x1,c(0,5),tol = 0.000001)
       x1<-res$root

       res_o<-uniroot(fun_x2,c(0,5),tol = 0.000001)
       x2 <- res_o$root

       print(c(counter,x1,x2,x1_old,x2_old))
       if (abs(sum(c(x1,x2)-c(x1_old,x2_old))) < eps)
          break
     }

这里fun_x1和fun_x2是两个方程都涉及x1和x2。此代码需要一段时间才能找到根。我想知道有什么方法可以repeat在R中并行计算此函数吗？

函数fun_x1和fun_x2是嵌套积分。例如，fun_x1is的简化版本，

fun_x1<-function(x1)
{
  s<-7

  f123_uv<-function(u)
  {
    f123_inner<-function(v)
    {
      prob_23_v<-(exp(-(integrate(fun1,0,v-u)$value*x1+integrate(fun2,0,v-u)$value*x2)))*fun1(v-u)*x1
    }         
  }

  p_123<-integrate(Vectorize(f123_uv),0,s)$value
  return(p_123)
}

拉尔夫·斯塔伯纳

由于所提供的样本函数不完整（fun1未定义），因此我使用了一些琐碎的函数，但是sleep调用了一些繁重的计算来进行模拟：

s <- 0.1
fun_x1 <- function(x1) {
  Sys.sleep(s)
  2 + 0.5 * x2 -x1
}
fun_x2 <- function(x2) {
  Sys.sleep(s)
  3 + 0.25 * x1 -x2
}

作为基准，我们将调用您的代码：

eps <- 0.000001

t1 <- Sys.time()
x1 <- 0
x2 <- 0
counter <- 0
repeat {
  x1_old<-x1
  x2_old<-x2
  counter <- counter + 1
  res<-uniroot(fun_x1,c(0,5),tol = 0.000001)
  x1<-res$root

  res_o<-uniroot(fun_x2,c(0,5),tol = 0.000001)
  x2 <- res_o$root

  if (abs(sum(c(x1,x2)-c(x1_old,x2_old))) < eps) {
    print(c(counter,x1,x2,x1_old,x2_old))
    break
  }
}
#> [1] 10  4  4  4  4
t2 <- Sys.time()
print(t2 -t1)
#> Time difference of 8.089114 secs

在这里，需要8秒钟的10次迭代来找到公共根。但是，由于每个步骤都取决于上一步的结果，因此无法并行执行。我们可以通过首先找到两个根，然后更新x1和来解开这一点x2。问题是这种收敛速度较慢：

t1 <- Sys.time()
x1 <- 0
x2 <- 0
counter <- 0
repeat {
  x1_old<-x1
  x2_old<-x2
  counter <- counter + 1
  res<-uniroot(fun_x1,c(0,5),tol = 0.000001)
  res_o<-uniroot(fun_x2,c(0,5),tol = 0.000001)

  x1<-res$root
  x2 <- res_o$root

  if (abs(sum(c(x1,x2)-c(x1_old,x2_old))) < eps) {
    print(c(counter,x1,x2,x1_old,x2_old))
    break
  }
}
#> [1] 16.000000  4.000000  4.000000  3.999999  4.000000
t2 <- Sys.time()
print(t2 -t1)
#> Time difference of 12.91926 secs

对于我的示例函数，现在需要将近13秒的时间进行16次迭代。但是，这种形式可以并行化，因为我们可以使用future包并行计算两个根：

library(future)
plan("multiprocess")

t1 <- Sys.time()
x1 <- 0
x2 <- 0
counter <- 0
repeat {
  x1_old<-x1
  x2_old<-x2
  counter <- counter + 1
  res %<-% uniroot(fun_x1,c(0,5),tol = 0.000001)
  res_o <- uniroot(fun_x2,c(0,5),tol = 0.000001)

  x1 <- res$root
  x2 <- res_o$root

  if (abs(sum(c(x1,x2)-c(x1_old,x2_old))) < eps) {
    print(c(counter,x1,x2,x1_old,x2_old))
    break
  }
}
#> [1] 16.000000  4.000000  4.000000  3.999999  4.000000
t2 <- Sys.time()
print(t2 -t1)
#> Time difference of 7.139439 secs

它仍然需要16次迭代，但是这次它们是在7秒内完成的。这几乎比以前的版本快两倍，即几乎没有开销。但是，原始版本收敛速度更快，因此几乎一样快。如果值得以较慢的收敛来提高并行执行的速度，则必须尝试使用实际功能。

顺便说一句，您是否检查过没有更好的算法来找到该公共根？

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。