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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
|
#' @title Create a progress bar with estimated time
#'
#' @description
#' Create a progress bar function that displays the estimated time till
#' completion and optional messages. Call the returned functions \code{set} or
#' \code{inc} during a loop to change the display.
#' Note that you are not allowed to decrease the value of the bar.
#' If you call these function without setting any of the arguments
#' the bar is simply redrawn with the current value.
#' For errorhandling use \code{error} and have a look at the example below.
#'
#' You can globally change the behavior of all bars by setting the option
#' \code{options(BBmisc.ProgressBar.style)} either to \dQuote{text} (the default)
#' or \dQuote{off}, which display no bars at all.
#'
#' You can globally change the width of all bars by setting the option
#' \code{options(BBmisc.ProgressBar.width)}. By default this is \code{getOption("width")}.
#'
#' You can globally set the stream where the output of the bar is directed by setting the option
#' \code{options(BBmisc.ProgressBar.stream)} either to \dQuote{stderr} (the default)
#' or \dQuote{stdout}. Note that using the latter will result in the bar being shown in
#' reports generated by Sweave or knitr, what you probably do not want.
#'
#' @param min [\code{numeric(1)}]\cr
#' Minimum value, default is 0.
#' @param max [\code{numeric(1)}]\cr
#' Maximum value, default is 100.
#' @param label [\code{character(1)}]\cr
#' Label shown in front of the progress bar.
#' Note that if you later set \code{msg} in the progress bar function,
#' the message will be left-padded to the length of this label, therefore
#' it should be at least as long as the longest message you want to display.
#' Default is \dQuote{}.
#' @param char [\code{character(1)}]\cr
#' A single character used to display progress in the bar.
#' Default is \sQuote{+}.
#' @param style [\code{character(1)}]\cr
#' Style of the progress bar. Default is set via options (see details).
#' @param width [\code{integer(1)}]\cr
#' Width of the progress bar. Default is set via options (see details).
#' @param stream [\code{character(1)}]\cr
#' Stream to use. Default is set via options (see details).
#' @return [\code{\link{ProgressBar}}]. A list with following functions:
#' \item{set [function(value, msg = label)]}{Set the bar to a value and possibly display a message instead of the label.}
#' \item{inc [function(value, msg = label)]}{Increase the bar and possibly display a message instead of the label.}
#' \item{kill [function(clear = FALSE)]}{Kill the bar so it cannot be used anymore. Cursor is moved to new line. You can also erase its display.}
#' \item{error [function(e)]}{Useful in \code{tryCatch} to properly display error messages below the bar. See the example.}
#' @export
#' @aliases ProgressBar
#' @examples
#' bar = makeProgressBar(max = 5, label = "test-bar")
#' for (i in 0:5) {
#' bar$set(i)
#' Sys.sleep(0.2)
#' }
#' bar = makeProgressBar(max = 5, label = "test-bar")
#' for (i in 1:5) {
#' bar$inc(1)
#' Sys.sleep(0.2)
#' }
#' # display errors properly (in next line)
#' \dontrun{
#' f = function(i) if (i>2) stop("foo")
#' bar = makeProgressBar(max = 5, label = "test-bar")
#' for (i in 1:5) {
#' tryCatch ({
#' f(i)
#' bar$set(i)
#' }, error = bar$error)
#' }
#' }
makeProgressBar = function(min = 0, max = 100, label = "", char = "+",
style = getOption("BBmisc.ProgressBar.style", "text"),
width = getOption("BBmisc.ProgressBar.width", getOption("width")),
stream = getOption("BBmisc.ProgressBar.stream", "stderr")) {
assertNumber(min)
assertNumber(max)
assertString(label)
assertChoice(style, c("text", "off"))
assertInt(width, lower = 30L)
assertChoice(stream, c("stderr", "stdout"))
if (style == "off")
return(structure(list(
set = function(value, msg = label) invisible(NULL),
inc = function(inc, msg = label) invisible(NULL),
kill = function(clear = FALSE) invisible(NULL),
error = function(e) stop(e)
), class = "ProgressBar"))
mycat = if (stream == "stdout")
function(...) cat(...)
else
function(...) cat(..., file = stderr())
## label |................................| xxx% (hh:mm:ss)
label.width = nchar(label)
bar.width = width - label.width - 21L
bar = rep(" ", bar.width)
start.time = as.integer(Sys.time())
delta = max - min
kill.line = "\r"
killed = FALSE
cur.value = min
draw = function(value, inc, msg) {
if (!missing(value) && !missing(inc))
stop("You must not set value and inc!")
else if (!missing(value))
assertNumber(value, lower = max(min, cur.value), upper = max)
else if (!missing(inc)) {
assertNumber(inc, lower = 0, upper = max - cur.value)
value = cur.value + inc
} else {
value = cur.value
}
if (!killed) {
# special case for min == max, weird "empty" bar, but might happen...
if (value == max)
rate = 1
else
rate = (value - min) / delta
bin = round(rate * bar.width)
bar[seq(bin)] <<- char
delta.time = as.integer(Sys.time()) - start.time
if (value == min)
rest.time = 0
else
rest.time = (max - value) * (delta.time / (value - min))
rest.time = splitTime(rest.time, "hours")
# as a precaution, so we can _always_ print in the progress bar cat
if (rest.time["hours"] > 99)
rest.time[] = 99
mycat(kill.line)
msg = sprintf(sprintf("%%%is", label.width), msg)
mycat(sprintf("%s |%s| %3i%% (%02i:%02i:%02i)", msg, collapse(bar, sep = ""), round(rate*100),
rest.time["hours"], rest.time["minutes"], rest.time["seconds"]))
if (value == max)
kill()
flush.console()
}
cur.value <<- value
}
clear = function(newline = TRUE) {
mycat(kill.line)
mycat(rep(" ", width))
if (newline)
mycat("\n")
}
kill = function(clear = FALSE) {
if (clear)
clear(newline = TRUE)
else
mycat("\n")
killed <<- TRUE
}
makeS3Obj("ProgressBar",
set = function(value, msg = label) draw(value = value, msg = msg),
inc = function(inc, msg = label) draw(inc = inc, msg = msg),
kill = kill,
error = function(e) {
kill(clear = FALSE)
stop(e)
}
)
}
|