# ==================================================================== # # TITLE # # Antimicrobial Resistance (AMR) Analysis # # # # SOURCE # # https://gitlab.com/msberends/AMR # # # # LICENCE # # (c) 2018-2020 Berends MS, Luz CF et al. # # # # This R package is free software; you can freely use and distribute # # it for both personal and commercial purposes under the terms of the # # GNU General Public License version 2.0 (GNU GPL-2), as published by # # the Free Software Foundation. # # # # We created this package for both routine data analysis and academic # # research and it was publicly released in the hope that it will be # # useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # # Visit our website for more info: https://msberends.gitlab.io/AMR. # # ==================================================================== # # taken from https://github.com/tidyverse/dplyr/blob/f306d8da8f27c2e6abbd3c70f219fef7ca61fbb5/R/progress.R # when it was still in the dplyr package progress_estimated <- function(n, min_time = 0) { Progress$new(n, min_time = min_time) } #' @importFrom R6 R6Class Progress <- R6::R6Class("Progress", public = list( n = NULL, i = 0, init_time = NULL, stopped = FALSE, stop_time = NULL, min_time = NULL, last_update = NULL, initialize = function(n, min_time = 0, ...) { self$n <- n self$min_time <- min_time self$begin() }, begin = function() { "Initialise timer. Call this before beginning timing." self$i <- 0 self$last_update <- self$init_time <- now() self$stopped <- FALSE self }, pause = function(x) { "Sleep for x seconds. Useful for testing." Sys.sleep(x) self }, width = function() { getOption("width") - nchar("|100% ~ 99.9 h remaining") - 2 }, tick = function() { "Process one element" if (self$stopped) return(self) if (self$i == self$n) stop("No more ticks") self$i <- self$i + 1 self }, stop = function() { if (self$stopped) return(self) self$stopped <- TRUE self$stop_time <- now() self }, print = function(...) { if (!isTRUE(getOption("dplyr.show_progress")) || # user sepecifies no progress !interactive() || # not an interactive session !is.null(getOption("knitr.in.progress"))) { # dplyr used within knitr document return(invisible(self)) } now_ <- now() if (now_ - self$init_time < self$min_time || now_ - self$last_update < 0.05) { return(invisible(self)) } self$last_update <- now_ if (self$stopped) { overall <- show_time(self$stop_time - self$init_time) if (self$i == self$n) { cat_line("Completed after ", overall) cat("\n") } else { cat_line("Killed after ", overall) cat("\n") } return(invisible(self)) } avg <- (now() - self$init_time) / self$i time_left <- (self$n - self$i) * avg nbars <- trunc(self$i / self$n * self$width()) cat_line( "|", str_rep("=", nbars), str_rep(" ", self$width() - nbars), "|", format(round(self$i / self$n * 100), width = 3), "% ", "~", show_time(time_left), " remaining" ) invisible(self) } ) ) cat_line <- function(...) { msg <- paste(..., sep = "", collapse = "") gap <- max(c(0, getOption("width") - nchar(msg, "width"))) cat("\r", msg, rep.int(" ", gap), sep = "") utils::flush.console() } str_rep <- function(x, i) { paste(rep.int(x, i), collapse = "") } 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") } } now <- function() proc.time()[[3]]