如何用 Rcpp 加速这个 R 函数?

how to speed up this R function with Rcpp?

我想在 R 中用循环写出很多文本文件,但我不知道如何用 Rcpp 加速它? 测试数据和R函数如下:

mywrite<- function(data,dataid){
  for(i in unique(dataid$id)) {
    yearid=data[["year"]][i==data[["id"]]]
    for(yr in yearid) {
      fname=paste(i,sprintf("%03d",yr%%1000),sep=".")
      write.table(dataid[i,],file=fname,row.names=FALSE,col.names=FALSE)
      write.table(subset(data,year==yr&id==i),file=fname,row.names=FALSE,col.names=FALSE,append=TRUE)
    }
  }
}

data=data.frame(id=rep(1:5,4),year=rep(1991:2000,2),x=rep(1,40),y=rep(1,40))
dataid=data.frame(id=1:5,lat=31:35,lon=101:105)
mywrite(data,dataid)

PS:用R写出这样的30000个文本文件大约需要50分钟,而用FORTRAN只需要10分钟。

通过消除循环中的所有冗余 subseting 并改用拆分应用策略,我获得了 4 倍的加速:

mywrite2<- function(data,dataid){
  by(data, interaction(data$year, data$id), function(x){
             i <- x$id[1]
             yr <- x$year[1]
             fname=paste(i,sprintf("%03d.2",yr%%1000),sep=".")
             write.table(dataid[i,],file=fname,row.names=FALSE,col.names=FALSE)
             write.table(x, file=fname, row.names=FALSE, col.names=FALSE, append=TRUE) 
          })
}


> require(microbenchmark)
> microbenchmark(
+ mywrite(data,dataid)
+ ,
+ mywrite2(data,dataid)
+ )
Unit: milliseconds
                   expr       min         lq        mean     median         uq        max neval
  mywrite(data, dataid) 76.613679 77.4709100 78.86304895 78.0260815 78.7791595 128.463443   100
 mywrite2(data, dataid) 18.894828 19.1707455 20.12820819 19.4053135 21.2940880  23.101325   100

这可能会在您的 Fortran 代码中得到它,不需要 Rcpp。