Permalink
Browse files

Implement progress_time. Closes #78

  • Loading branch information...
1 parent 5a6ab78 commit 1506ec191a3cbbaeea471f02996e5f0b680791eb @hadley committed Oct 8, 2012
Showing with 90 additions and 0 deletions.
  1. +2 −0 NEWS
  2. +88 −0 R/progress-time.r
View
@@ -1,6 +1,8 @@
Version 1.7.1.99
------------------------------------------------------------------------------
+* new `progress_time` function that estimates the amount of time remaining before the job is completed. (Thanks to Mike Lawrence, #78)
+
* `colwise`, `numcolwise` and `catcolwise` now all accept additional arguments in .... (Thanks to Stavros Macrakis, #62)
* `rbind.fill` now stops if inputs are not data frames. (Fixes #51)
View
@@ -0,0 +1,88 @@
+#' Text progress bar with time.
+#'
+#' A textual progress bar that estimates time remaining. It displays the
+#' estimated time remaining and, when finished, total duration.
+#'
+#' @family progress bars
+#' @export
+#' @examples
+#' l_ply(1:100, function(x) Sys.sleep(.01), .progress = "time")
+progress_time <- function() {
+ n <- 0
+ txt <- NULL
+ list(
+ init = function(x) {
+ txt <<- txtTimerBar(x)
+ setTxtProgressBar(txt, 0)
+ },
+ step = function() {
+ n <<- n + 1
+ setTxtProgressBar(txt, n)
+ },
+ term = function() close(txt)
+ )
+}
+
+txtTimerBar <- function(n = 1) {
+ start <- .last_update_time <- proc.time()[3]
+ times <- numeric(n)
+ value <- NULL
+
+ killed <- FALSE
+
+ width <- getOption("width") - nchar('||100% ~ 999.9 h remaining.')
+
+ update <- function(i) {
+ if (i == 0) return()
+
+ value <<- i
+ times[i] <- proc.time()[3] - start
+
+ avg <- times[i] / i
+ time_left <- (n - i) * avg
+
+ nbars <- trunc(i / n * width)
+
+ cat_line("|", str_rep("=", nbars), str_rep(" ", width - nbars), "|",
+ format(i / n * 100, width = 3), "% ~", show_time(time_left), " remaining")
+ }
+ getVal <- function() value
+ kill <- function(){
+ if (killed) return()
+ killed <<- TRUE
+
+ if (value == n) {
+ cat_line("|", str_rep("=", width), "|100%")
+ cat("Completed after", show_time(proc.time()[3] - start), "\n")
+ } else {
+ cat("Killed after", show_time(proc.time()[3] - start), "\n")
+ }
+ }
+
+ cat_line("|", str_rep(" ", width), "| 0%")
+
+ structure(
+ list(getVal = getVal, up = update, kill = kill),
+ class = "txtProgressBar")
+}
+
+show_time <- function(x) {
+ if (x < 60) {
+ paste(round(x), "s")
+ } else if (x < 60 * 60) {
+ paste(round(x / 60), "m")
+ } else {
+ paste(round(x / (60 * 60)), "h")
+ }
+}
+
+cat_line <- function(...) {
+ msg <- paste(..., sep = "", collapse = "")
+ gap <- max(c(0, getOption("width") - nchar(msg, "width")))
+ cat("\r", msg, rep.int(" ", gap), sep = "")
+ flush.console()
+}
+
+str_rep <- function(x, i) {
+ paste(rep.int(x, i), collapse = "")
+}

0 comments on commit 1506ec1

Please sign in to comment.