对于如何测试R代码的运行效率，首先可能想到的就是proc.time()以及system.time()了。
我们来看代码：
> ptm <- proc.time() > for (i in 1:50) mad(stats::runif(500)) > proc.time() - ptm user system elapsed 0.022 0.002 0.038 > system.time(for(i in 1:100) mad(runif(1000))) user system elapsed 0.025 0.002 0.028 |
这两个函数都只适合测试一整块代码的运行效率。
还有可以想到的工具应该就是rbenchmark了。
> random.array = function(rows, cols, dist=rnorm) + array(dist(rows*cols), c(rows, cols)) > random.replicate = function(rows, cols, dist=rnorm) + replicate(cols, dist(rows)) > benchmark(replications=rep(100, 3), + random.array(100, 100), + random.array(100, 100), + columns=c('test', 'elapsed', 'replications')) test elapsed replications 1 random.array(100, 100) 0.093 100 2 random.array(100, 100) 0.094 100 3 random.array(100, 100) 0.093 100 4 random.array(100, 100) 0.096 100 5 random.array(100, 100) 0.092 100 6 random.array(100, 100) 0.093 100 |
rbenchmark比较适合比较不同块代码之间的执行效率。
如果你写了一个函数，你想查看每一行代码的运行效率，那可能之前的函数都不十分合适。为此，我写了一段代码，用于查看多行代码每行的执行效率，以提高在开发过程中查找执行瓶颈的效率。
###################################################### #by Jianhong Ou @ umassmed @ quiworld @ Oct 18, 2013 ###################################################### FST_TIMER_ELAPSED <- proc.time() FST_TIMER_EXPR <- list(start="start") counter <- function(){ function(expr, value, ok, visible){ FST_TIMER_ELAPSED <- get("FST_TIMER_ELAPSED", envir=.GlobalEnv) FST_TIMER_ELAPSED <- rbind(FST_TIMER_ELAPSED, proc.time()) assign("FST_TIMER_ELAPSED", FST_TIMER_ELAPSED, envir=.GlobalEnv) assign("FST_TIMER_EXPR", c(get("FST_TIMER_EXPR", envir=.GlobalEnv), expr), envir=.GlobalEnv) return(TRUE) } } h <- taskCallbackManager() h$add(counter(), name="timeCounter") ################## start code to be tested ################## rep=random.replicate(100, 100) arr=random.array(100, 100) ################## end code to be tested ################## removeTaskCallback("R-taskCallbackManager") FST_TIMER_ELAPSED[2:nrow(FST_TIMER_ELAPSED),1:3] <- FST_TIMER_ELAPSED[2:nrow(FST_TIMER_ELAPSED),1:3] - FST_TIMER_ELAPSED[1:(nrow(FST_TIMER_ELAPSED)-1), 1:3] FST_TIMER_ELAPSED[1, 1:3] <- c(0,0,0) FST_TIMER_ELAPSED FST_TIMER_EXPR cbind(as.data.frame(FST_TIMER_ELAPSED[,1:3]), as.character(FST_TIMER_EXPR)) |
方法2
###################################################### #by Jianhong Ou @ umassmed @ quiworld @ Oct 18, 2013 ###################################################### FST_TIMER_ELAPSED <- proc.time() counter <- function(){ function(expr, value, ok, visible){ FST_TIMER_ELAPSED.old <- get("FST_TIMER_ELAPSED", envir=.GlobalEnv) FST_TIMER_ELAPSED.new <- proc.time() elapsed <- FST_TIMER_ELAPSED.new - FST_TIMER_ELAPSED.old assign("FST_TIMER_ELAPSED", FST_TIMER_ELAPSED.new, envir=.GlobalEnv) print(elapsed) return(TRUE) } } h <- taskCallbackManager() h$add(counter(), name="timeCounter") ################## start code to be tested ################## rep=random.replicate(100, 100) arr=random.array(100, 100) |
方法3
###################################################### #by Jianhong Ou @ umassmed @ qiubio @ May 11, 2016 ###################################################### options("FST_TIMER_ELAPSED"=proc.time()[3L]) counter <- function(){ function(expr, value, ok, visible){ pt <- function(s){ h <- floor(s/3600) m <- floor((s - 3600*h)/60) ss <- floor(s - 3600 * h - 60*m) s <- formatC(floor((s - 3600 * h - 60*m - ss)*1000), width=3, flag=0) paste(h, m, ss, s, sep=":") } FST_TIMER_ELAPSED.new <- proc.time()[3L] FST_TIMER_ELAPSED.old <- getOption("FST_TIMER_ELAPSED") elapsed <- FST_TIMER_ELAPSED.new - FST_TIMER_ELAPSED.old options("FST_TIMER_ELAPSED"=proc.time()[3L]) options("prompt"=paste(format(Sys.time(), "%H:%M:%S"), pt(elapsed), "> ")) return(TRUE) } } h <- taskCallbackManager() h$add(counter(), name="timeCounter") ################## start code to be tested ################## rep=random.replicate(100, 100) arr=random.array(100, 100) |
