Optimise runtime for qbeta in R-CodePudding

Please see if there are ways to make the following run faster in R, most time spent on qbeta

numSim <- 1000
numDay <- 365*4
dailyFreq <- 288
maximumVolume <- 15
alphaParam    <- 20
betaParam     <- 30

t0 = Sys.time()
randomNumber <- matrix(runif(numSim * numDay * dailyFreq), ncol = numSim, byrow = FALSE)
t1 = Sys.time() 
t1 - t0
effect <- qbeta(randomNumber, alphaParam, betaParam) * maximumVolume
Sys.time() - t1

CodePudding user response：

As @Roland suggested, a possible solution is to split randomNumber and run the function in parallel. I am a fan of the library "future.apply" so I implemented a solution with it. Also, I do not like much the Sys.time() way to measure the running time, when using an interface like Rstudio it may generate errors. So I used another way to find the running time of the functions.

Notice that I also changed the variable "numSim" from 1000 to 50 to do a quick test.

library(future.apply)

numSim <- 50
numDay <- 365*4
dailyFreq <- 288
maximumVolume <- 15
alphaParam    <- 20
betaParam     <- 30


randomNumber <- matrix(runif(numSim * numDay * dailyFreq), ncol = numSim, byrow = FALSE)
system.time(effect1 <- qbeta(randomNumber, alphaParam, betaParam) * maximumVolume)

That gives:

   user  system elapsed 
 60.077   0.103  60.271

Then the parallel version with future_apply:

plan(multisession)
system.time(effect<-future_apply(randomNumber, 2, function(x, alphaParam, betaParam, maximumVolume){
 return(qbeta(x, alphaParam, betaParam)*maximumVolume)
   
}, alphaParam=alphaParam, betaParam=betaParam, maximumVolume=maximumVolume ) )

That gives:

   user  system elapsed 
  2.467   0.556  22.361

CodePudding user response：

Passing runif values to qbeta is just giving random beta variates (4.2e8 of them). You could just use rbeta:

effect1 <- matrix(rbeta(numSim*numDay*dailyFreq, alphaParam, betaParam)*maximumVolume, ncol = numSim)

It's ~14x faster on my machine:

library(microbenchmark)

numSim <- 10
numDay <- 365*4
dailyFreq <- 288
maximumVolume <- 15
alphaParam    <- 20
betaParam     <- 30

f1 <- function() {
  randomNumber <- matrix(runif(numSim * numDay * dailyFreq), ncol = numSim, byrow = FALSE)
  return(qbeta(randomNumber, alphaParam, betaParam)*maximumVolume)
}

f2 <- function() {
  return(matrix(rbeta(numSim*numDay*dailyFreq, alphaParam, betaParam)*maximumVolume, ncol = numSim))
}

microbenchmark(f1(), f2(), times = 10)

> microbenchmark(f1(), f2(), times = 10)
Unit: milliseconds
 expr        min         lq     mean     median         uq       max neval
 f1() 10630.2050 11207.2655 11236.32 11290.4811 11371.5236 11526.125    10
 f2()   764.2666   795.6046   803.63   802.5437   814.4193   839.147    10