multiple progress bars on a single line, to be combined with parallel_progress.R

multiple_progress.R

# plotting multiple progress bars on the same line, as a precursor to running
# the progress bars in parallel

library (progress)
library (future)
library (R6)

new_connection <- function () {
  f <- tempfile()
  file.create(f)
  file(f, "r+")
}

# prep for multiple bars in the user session
prep_progress <- function (n_bars) {
  streams <- replicate(n_bars, new_connection(),
                       simplify = FALSE)
  info <- list(n_bars = n_bars,
               next_bar = 1,
               streams = streams)
  options(parallel_progress_info = info)
}

bar_width <- function () {
  
  terminal_width <- options()$width
  info <- options()$parallel_progress_info
  n_bars <- info$n_bars
  
  # a space between each bars, divide up the remainder and add 2 spaces to each
  total_width <- terminal_width - (n_bars - 1)
  bar_width <- total_width %/% n_bars
  bar_width - 2
  
}

next_stream <- function () {
  
  # get the next available connection from the parallel progress bar info, and
  # then increment the counter
  info <- options()$parallel_progress_info
  
  stream <- info$streams[[info$next_bar]]
  
  info$next_bar <- info$next_bar + 1
  options(parallel_progress_info = info)
  
  stream
  
}

# read the progress bar from a specific line
read_progress <- function (stream) {
  line <- suppressWarnings(readLines(stream))[2]
  if (is.na(line)) {
    line <- ""
  }
  line
}

# print the parallel progress bars to the terminal
parallel_render <- function () {
  info <- options()$parallel_progress_info
  lines <- vapply(info$streams,
                  read_progress,
                  FUN.VALUE = "")
  text <- paste(lines, collapse = "    ")
  empty_string <- paste0(rep("    ", info$n_bars - 1),
                         collapse = "")
  if (!identical(text, empty_string)) {
    cat("\r", text)
    flush.console()
    # need to move the cursor!
  }
}

# parallel progress bar class; the same as progress_bar, but without the stream
# or force arguments
ppb <- R6Class("parallel_progress_bar",
               inherit = progress::progress_bar,
               public = list(
                 initialize = function (format = "[:bar] :percent",
                                        total = 100,
                                        width = bar_width(),
                                        complete = "=",
                                        incomplete = "-",
                                        callback = function (self) {},
                                        clear = TRUE,
                                        show_after = 0.2) {
                   
                   super$initialize(format = format,
                                    total = total,
                                    width = width,
                                    stream = next_stream(),
                                    complete = complete,
                                    incomplete = incomplete,
                                    callback = callback,
                                    clear = clear,
                                    show_after = show_after,
                                    force = TRUE)
                   
                 }
               ))

parallel_progress_bar <- ppb

# # how to dispatch these sequentially to the futures?
# # can we add some sort of hook to the progress bar class, so that futures triggers the setup?
# 
# prep_progress(3)
# 
# # write a progress bar to a tempfile
# pbs <- replicate(3, parallel_progress_bar$new(show_after = 0),
#                  simplify = FALSE)
# 
# # loop through
# for (i in 1:100) {
#   for (pb in pbs)
#     pb$tick()
#   Sys.sleep(3 / 100)
#   parallel_render()
# }
#