我试图找到方程组的根。这是我正在使用的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
的方程。此代码需要一段时间才能找到根。我想知道有什么方法可以并行计算R中的repeat
函数吗?
函数fun_x1
和fun_x2
是嵌套积分。例如,fun_x1
的简化版本是
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)
}
答案 0 :(得分:0)
由于所提供的样本函数不完整(未定义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次迭代,但是这次它们以7s完成。这几乎比以前的版本快两倍,即几乎没有开销。但是,原始版本收敛速度更快,因此几乎一样快。 如果值得以较慢的收敛来提高并行执行的速度,则必须尝试使用实际功能。
顺便说一句,您是否检查过找到该通用根的更好算法?