1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#' Progression Handler: Progress Reported as the Size of a File on the File System
#'
#' @inheritParams make_progression_handler
#'
#' @param file (character) A filename.
#'
#' @param \ldots Additional arguments passed to [make_progression_handler()].
#'
#' @examples
#' \donttest{\dontrun{
#' handlers(handler_filesize(file = "myscript.progress"))
#' with_progress(y <- slow_sum(1:100))
#' print(y)
#' }}
#'
#' @details
#' This progression handler reports progress by updating the size of a file
#' on the file system. This provides a convenient way for an R script running
#' in batch mode to report on the progress such that the user can peek at the
#' file size (by default in 0-100 bytes) to assess the amount of the progress
#' made, e.g. `ls -l -- *.progress`.
#' If the \file{*.progress} file is accessible via for instance SSH, SFTP,
#' FTPS, HTTPS, etc., then progress can be assessed from a remote location.
#'
#' @importFrom utils file_test
#' @export
handler_filesize <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", enable = getOption("progressr.enable", TRUE), ...) {
reporter <- local({
set_file_size <- function(config, state, progression, message = state$message) {
## Troubleshoot https://github.com/futureverse/progressr/issues/168
stop_if_not(
length(config$max_steps) == 1L, is.numeric(config$max_steps),
!is.na(config$max_steps), is.finite(config$max_steps),
config$max_steps >= 0
)
ratio <- if (config$max_steps == 0) 1 else state$step / config$max_steps
size <- round(100 * ratio)
current_size <- file.size(file)
if (is.na(current_size)) file.create(file, showWarnings = FALSE)
if (size == 0L) return()
if (progression$amount == 0) return()
head <- sprintf("%g/%g: ", state$step, config$max_steps)
nhead <- nchar(head)
tail <- sprintf(" [%d%%]", round(100 * ratio))
ntail <- nchar(tail)
mid <- paste0(message, "")
nmid <- nchar(mid)
padding <- size - (nhead + nmid + ntail)
if (padding <= 0) {
msg <- paste(head, mid, tail, sep = "")
if (padding < 0) msg <- substring(msg, first = 1L, last = size)
} else if (padding > 0) {
mid <- paste(c(mid, " ", rep(".", times = padding - 1L)), collapse = "")
msg <- paste(head, mid, tail, sep = "")
}
cat(file = file, append = FALSE, msg)
}
list(
initiate = function(config, state, progression, ...) {
if (!state$enabled) return()
set_file_size(config = config, state = state, progression = progression)
},
interrupt = function(config, state, progression, ...) {
if (!state$enabled) return()
msg <- conditionMessage(progression)
set_file_size(config = config, state = state, progression = progression, message = msg)
},
update = function(config, state, progression, ...) {
if (!state$enabled) return()
set_file_size(config = config, state = state, progression = progression)
},
finish = function(config, state, progression, ...) {
if (!state$enabled) return()
if (config$clear) {
if (file_test("-f", file)) file.remove(file)
} else {
set_file_size(config = config, state = state, progression = progression)
}
}
)
})
make_progression_handler("filesize", reporter, intrusiveness = intrusiveness, target = target, enable = enable, ...)
}
|
