Skip to content

Instantly share code, notes, and snippets.

@goldingn
Last active May 21, 2018 00:50
Show Gist options
  • Save goldingn/e6521f4ed0fa1b6566b754950caaf518 to your computer and use it in GitHub Desktop.
Save goldingn/e6521f4ed0fa1b6566b754950caaf518 to your computer and use it in GitHub Desktop.
multiple progress bars on a single line, to be combined with parallel_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()
# }
#
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment