1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
# timing utilities for ff and bit
# (c) 2012 Jens Oehlschlägel
# Licence: GPL2
# Provided 'as is', use at your own risk
# Created: 2012-05-28
#' Adaptive timer
#'
#' Repeats timing expr until minSec is reached
#'
#'
#' @param expr Valid expression to be timed.
#' @param gcFirst Logical - should a garbage collection be performed
#' immediately before the timing? Default is \code{TRUE}.
#' @param minSec number of seconds to repeat at least
#' @param envir the environment in which to evaluate \code{expr} (by default
#' the calling frame)
#' @return A object of class \code{"proc_time"}: see \code{\link{proc.time}}
#' for details.
#' @author Jens Oehlschlägel <Jens.Oehlschlaegel@@truecluster.com>
#' @seealso \code{\link{system.time}}
#' @keywords utilities
#' @examples
#'
#' system.time(1+1)
#' repeat.time(1+1)
#' system.time(sort(runif(1e6)))
#' repeat.time(sort(runif(1e6)))
#'
#' @export
repeat.time <- function (expr, gcFirst = TRUE, minSec=0.5, envir=parent.frame())
{
ppt <- function(y) {
if (!is.na(y[4L]))
y[1L] <- y[1L] + y[4L]
if (!is.na(y[5L]))
y[2L] <- y[2L] + y[5L]
y[1L:3L]
}
if (!exists("proc.time"))
return(rep(NA_real_, 5L))
if (gcFirst)
gc(FALSE)
time <- proc.time()
on.exit(cat("Timing stopped at:", ppt(proc.time() - time),
"\n"))
r <- 0L
while((proc.time()[3]-time[3]) < minSec){
r <- r + 1L
eval(substitute(expr), envir=envir)
}
new.time <- proc.time()
on.exit()
structure((new.time - time)/r, class = "proc_time")
}
|
