Added progress_time(), a textual progress bar with time-remaining esti...

R/progress.r

@@ -160,3 +160,140 @@ progress_win <- function(title = "plyr progress", ...) {
     term = function() close(win)
   )
 }
+
+#' Text progress bar with time.
+#'
+#' A textual progress bar that reports estimated time remaining
+#' 
+#' This progress bar displays a textual progress bar that works on all 
+#' platforms.  It displays the estimated time remaining and, when finished,
+#' total duration.
+#'
+#' @family progress bars
+#' @export
+#' @examples
+#' l_ply(1:100, function(x){Sys.sleep(.1)}, .progress = "time")
+progress_time <- function () 
+{
+  init_progress_time <- function (min = 0, max = 1, initial = 0){
+		.start <- proc.time()[3]
+		.last_update_time <- .start
+		.times <- NULL
+		.val <- initial
+		.last_val <- 0
+		.killed <- FALSE
+		.nb <- 0L
+		.pc <- 0L
+		width <- getOption("width")
+		width <- width - nchar('||100%  ~ 999.9 h remaining.')
+		width <- trunc(width)
+		if (max <= min){
+			stop("must have max > min")
+		}
+		msg = paste(
+			c(
+				"\r|"
+				, rep.int(" ", width)
+				, "|  0%"
+			)
+			, collapse = ''
+		)
+		cat(paste(msg,rep(' ',max(c(0,trunc(getOption("width")-nchar(msg))))),'\r'))
+		flush.console()
+		up <- function(value){
+			if (!is.finite(value) || value < min || value > max){
+				return()
+			}
+			.val <<- value
+			minutes = TRUE
+			nb <- round(width * (value - min)/(max - min))
+			pc <- round(100 * (value - min)/(max - min))
+			if (nb == .nb && pc == .pc){ 
+				return()
+			}
+			.nb <<- nb
+			.pc <<- pc
+			now = proc.time()[3]
+			time_since_last_update = now - .last_update_time
+			.last_update_time <<- now
+			.times <<- c(.times,(time_since_last_update)/(.val-.last_val))
+			time_left = round((max-value)*mean(.times),0)
+			unit = ' s'
+			if(time_left>60){
+				time_left = round((max-value)*mean(.times)/60,0)
+				unit = ' m'
+				if(time_left>60){
+					time_left = round((max-value)*mean(.times)/60/60,1)
+					unit = ' h'
+				}
+			}
+			msg = paste(
+				c(
+					"\r|"
+					, rep.int('=', nb)
+					, rep.int(" ", (width - nb))
+					, sprintf("|%3d%%", pc)
+					, '  ~ '
+					, time_left
+					, unit
+					, ' remaining.'
+				)
+				, collapse = ''
+			)
+			cat(paste(msg,rep(' ',max(c(0,trunc(getOption("width")-nchar(msg))))),'\r'))
+			flush.console()
+			.last_val <<- .val
+		}
+		getVal <- function() .val
+		kill <- function(){
+			if (!.killed) {
+				if(.pc == 100){
+					msg = paste(
+						c(
+							"\r|"
+							, rep.int('=', width)
+							, "|100%"
+						)
+						, collapse = ''
+					)
+					cat(paste(msg,rep(' ',max(c(0,trunc(getOption("width")-nchar(msg))))),'\r'))
+					msg = paste('Completed after',round(proc.time()[3]-.start),'seconds.')
+				}else{
+					if(.pc == 0){
+						msg = paste(
+							c(
+								"\r|"
+								, rep.int('=', width)
+								, "|100%"
+							)
+							, collapse = ''
+						)
+						cat(paste(msg,rep(' ',max(c(0,trunc(getOption("width")-nchar(msg))))),'\r'))
+						msg = paste('Completed after',round(proc.time()[3]-.start),'seconds.')
+					}else{
+						msg = paste('Killed after',round(proc.time()[3]-.start),'seconds.')
+					}
+				}
+				cat(paste('\n',msg,'\n'))
+				.killed <<- TRUE
+			}
+		}
+		if (initial > min){
+			up(initial)
+		}
+		structure(list(getVal = getVal, up = up, kill = kill), class = "txtProgressBar")
+	}
+	n <- 0
+	txt <- NULL
+	list(
+		init = function(x) {
+			txt <<- init_progress_time(max = x)
+			setTxtProgressBar(txt, 0)
+		}
+		, step = function() {
+			n <<- n + 1
+			setTxtProgressBar(txt, n)
+		}
+		, term = function() close(txt)
+	)
+}