如何加速R中的以下功能?

时间:2016-08-05 12:29:04

标签: r loops for-loop

我在R中编写了以下函数。我想迭代它,比如说50000次。我用了#34; sapply"在我的功能,但它在R.运行缓慢。我现在仍然工作约20小时,我不知道运行时间。有什么想法如何加快这个操作?感谢。

data=matrix(c(0.01132162,1,0.04056053,1,0.11676735,0,0.12029087,1,
           0.16197702,1,0.17190980,1,0.20386841,1,0.21251687,0,
           0.36536492,0,0.40256414,1),ncol=2,byrow=T)

 GIBS=function(data,a,b,beta,R)
    {
       m=length(R)
       n1=sum(data[,2]==1)
       n2=m-n1
       n=m+sum(R)
       N=c(n1,n2)
       R1=c(0,R)
       nstar=c()
       for(i in 1:m) nstar[i]=n-(i-1)-sum(R1[1:i])
       Z=c(data[1,1],data[2:m,1]-data[1:(m-1),1])
       f=function(x)
        {
          A=0
          for(i in 1:m) A=A+x^i*nstar[i]*Z[i]
          FR=1
          for(j in 1:2) FR=FR*(A+b[j])^(N[j]+a[j])
          return(x^(m*(m+1)/2)*exp(-beta*(x-1))/FR)
        }
      INT=integrate(f,1,Inf)$value
      SG=function(it)
       {
        uu=runif(1)
        g0=function(t) integrate(f,1,t)$value/INT-uu
        aa=5
        if(g0(1)>0) {while(g0(aa)>0) aa=aa+1} else {while(g0(aa)<0) aa=aa+1}
        ra=uniroot(g0,c(1,aa))$root
        A1=sum(ra^(1:m)*nstar*Z)
        rl1=rgamma(1,n1+a[1],A1+b[1])
        rl2=rgamma(1,n2+a[2],A1+b[2])
        return(c(ra,rl1,rl2))
      }
     return(colMeans(t(sapply(1:10000,SG,simplify = "array"))))
  }
########
BGI=matrix(NA,ncol=3,nrow=50000)
for(iter in 1:50000)
  {
    BGI[iter,]=GIBS(data,c(2,1.6),c(2,2),5,c(10,rep(0,9)))
    cat(iter, "of 50000\r") 
   flush.console()
 }

1 个答案:

答案 0 :(得分:0)

关于函数的更新版本,如果您需要多次迭代,我建议使用multicore/HPC functions来运行它。

以下是该功能原始版本的评论:

问题在于函数的这一部分(及其输入,f和数据对象):

integrate(f,1,Inf)

从表示

f行开始
FR=prod((A+b)^(N+a))

它提供了以下警告,这些警告会导致后续问题并且实际上是无限循环:

Warning messages:
1: In x^(1:m) : longer object length is not a multiple of shorter object length
2: In x^(1:m) * nstar :
  longer object length is not a multiple of shorter object length
3: In x^(1:m) * nstar * Z :
  longer object length is not a multiple of shorter object length
4: In A + b : longer object length is not a multiple of shorter object length
5: In N + a : longer object length is not a multiple of shorter object length
6: In x^(1:m) : longer object length is not a multiple of shorter object length
7: In x^(1:m) * nstar :
  longer object length is not a multiple of shorter object length
8: In x^(1:m) * nstar * Z :
  longer object length is not a multiple of shorter object length
9: In A + b : longer object length is not a multiple of shorter object length
10: In N + a : longer object length is not a multiple of shorter object length
11: In x^(1:m) : longer object length is not a multiple of shorter object length
12: In x^(1:m) * nstar :
  longer object length is not a multiple of shorter object length
13: In x^(1:m) * nstar * Z :
  longer object length is not a multiple of shorter object length
14: In A + b : longer object length is not a multiple of shorter object length
15: In N + a : longer object length is not a multiple of shorter object length

我不明白这个功能正在尝试完成什么,以便我可以帮助你解决它,但是如果你让那部分更清楚,我会尝试。