Question

我使用这个sapply函数：

set.seed(1)
data<-matrix(runif(1000000,0,1),1000000,2)

sapply(seq(0.0025, 0.9975, by=0.005), function (x) qbeta(x, data$a, data$b))

由于数据可以有1行，因此可能需要很长时间。 a和b是唯一的随机值。

如何改善表现？是从每一行中查找参数需要花费时间，还是只是不可避免？我已经尝试过并行版本，它会缩短时间，但仍然很慢。

一些结果（我在38k行上做了这个）：

> system.time(matrix(qbeta(rep(seq(0.0025, 0.9975, by=0.005),each=nrow(data)),data$a, data$b),nrow=nrow(data)))
   user  system elapsed 
  34.53    0.00   34.53 
> system.time(sapply(seq(0.0025, 0.9975, by=0.005), function (x) qbeta(x, data$a, data$b)))
   user  system elapsed 
  34.22    0.00   34.21

这是我的并行代码：

steps<-seq(0.0025, 0.9975, by=0.005)

qbeta.func <- function(x, data) {
  return(qbeta(x, data$a, data$b) * data$value)
}

cl <- makeCluster(rep("localhost",4), type = "SOCK")
t1 <- Sys.time()
data <- parSapply(cl, steps, qbeta.func, data)#
stopCluster(cl)
#data <- data[1:20,1:20]

Answer 1

您可以在不使用sapply的情况下获取结果，因为qbeta已经过矢量化。我们重复网格值nrow(df)次。最后，您获得一个matrix，其行qbeta的值为data的相应行。注意：考虑到大量的时间，这可能会很慢。除非你并行化或使用更强大的PC，否则不要认为你可以从这里大大加快速度。试试吧：

res<-matrix(qbeta(rep(seq(0.0025, 0.9975, by=0.005),
            each=nrow(data)),data$a, data$b),
            nrow=nrow(data))

修改

我将在这里做一个简单的并行示例。我们使用doParallel包。我们将data data.frame拆分为一个块列表，然后我们为每个块调用上面的行。从一开始：

#create the data (just 10000 rows) set.seed(1) data<-as.data.frame(matrix(runif(10000,0,1),10000,2,dimnames=list(NULL,letters[1:2]))) #split in 10 1000 rows chunks dataSplit<-split(data,(seq_len(nrow(data))-1)%/%1000) #define the function to make the qbeta calculation qbetaVec<-function(grid,values) matrix(qbeta(rep(grid,each=nrow(values)),values$a,values$b),nrow=nrow(values)) #define the grid grid<-seq(0.0025, 0.9975, by=0.005) #full calculation system.time(res<-qbetaVec(grid,data)) # user system elapsed #5.103 0.007 5.115 #now we parallelize library(doParallel) #set the number of clusters cl <- makeCluster(8) registerDoParallel(cl) #now the calculation with foreach and dopar system.time(res2<-foreach(i=1:10) %dopar% qbetaVec(grid,dataSplit[[i]])) # user system elapsed # 0.026 0.019 1.404 #now we put all together res3<-do.call(rbind,res2) identical(res3,res) #[1] TRUE

提高模拟qbeta值的sapply函数的性能

1 个答案: