Implement progress_time. Closes #78

NEWS

@@ -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)

R/progress-time.r

@@ -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 = "")
+}