mirror of https://github.com/msberends/AMR.git
143 lines
6.3 KiB
R
143 lines
6.3 KiB
R
|
# ==================================================================== #
|
||
|
|
# 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]]
|