File: makeProgressBar.R

package info (click to toggle)
r-cran-bbmisc 1.13.1-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 1,256 kB
  • sloc: ansic: 176; sh: 9; makefile: 5
file content (166 lines) | stat: -rw-r--r-- 6,295 bytes parent folder | download
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)
    }
  )
}