knitr::opts_chunk$set( collapse = TRUE, comment = "#>", out.width = "100%", cache = TRUE )
We make sure that the timer is not TRUE
, by setting it to ten hours.
library(cli) # 10 hours cli:::cli_tick_set(10 * 60 * 60 * 1000) cli_tick_reset() `__cli_update_due`
fun <- function() NULL ben_st <- bench::mark( `__cli_update_due`, fun(), .Call(ccli_tick_reset), interactive(), check = FALSE ) ben_st
ben_st2 <- bench::mark( if (`__cli_update_due`) foobar() ) ben_st2
cli_progress_along()
seq <- 1:100000 ta <- cli_progress_along(seq) bench::mark(seq[[1]], ta[[1]])
for
loopThis is the baseline:
f0 <- function(n = 1e5) { x <- 0 seq <- 1:n for (i in seq) { x <- x + i %% 2 } x }
With progress bars:
fp <- function(n = 1e5) { x <- 0 seq <- 1:n for (i in cli_progress_along(seq)) { x <- x + seq[[i]] %% 2 } x }
Overhead per iteration:
ben_taf <- bench::mark(f0(), fp()) ben_taf (ben_taf$median[2] - ben_taf$median[1]) / 1e5
ben_taf2 <- bench::mark(f0(1e6), fp(1e6)) ben_taf2 (ben_taf2$median[2] - ben_taf2$median[1]) / 1e6
ben_taf3 <- bench::mark(f0(1e7), fp(1e7)) ben_taf3 (ben_taf3$median[2] - ben_taf3$median[1]) / 1e7
ben_taf4 <- bench::mark(f0(1e8), fp(1e8)) ben_taf4 (ben_taf4$median[2] - ben_taf4$median[1]) / 1e8
lapply()
This is the baseline:
f0 <- function(n = 1e5) { seq <- 1:n ret <- lapply(seq, function(x) { x %% 2 }) invisible(ret) }
With an index vector:
f01 <- function(n = 1e5) { seq <- 1:n ret <- lapply(seq_along(seq), function(i) { seq[[i]] %% 2 }) invisible(ret) }
With progress bars:
fp <- function(n = 1e5) { seq <- 1:n ret <- lapply(cli_progress_along(seq), function(i) { seq[[i]] %% 2 }) invisible(ret) }
Overhead per iteration:
ben_tam <- bench::mark(f0(), f01(), fp()) ben_tam (ben_tam$median[3] - ben_tam$median[1]) / 1e5
ben_tam2 <- bench::mark(f0(1e6), f01(1e6), fp(1e6)) ben_tam2 (ben_tam2$median[3] - ben_tam2$median[1]) / 1e6 (ben_tam2$median[3] - ben_tam2$median[2]) / 1e6
This is the baseline:
f0 <- function(n = 1e5) { seq <- 1:n ret <- purrr::map(seq, function(x) { x %% 2 }) invisible(ret) }
With index vector:
f01 <- function(n = 1e5) { seq <- 1:n ret <- purrr::map(seq_along(seq), function(i) { seq[[i]] %% 2 }) invisible(ret) }
With progress bars:
fp <- function(n = 1e5) { seq <- 1:n ret <- purrr::map(cli_progress_along(seq), function(i) { seq[[i]] %% 2 }) invisible(ret) }
Overhead per iteration:
ben_pur <- bench::mark(f0(), f01(), fp()) ben_pur (ben_pur$median[3] - ben_pur$median[1]) / 1e5 (ben_pur$median[3] - ben_pur$median[2]) / 1e5
ben_pur2 <- bench::mark(f0(1e6), f01(1e6), fp(1e6)) ben_pur2 (ben_pur2$median[3] - ben_pur2$median[1]) / 1e6 (ben_pur2$median[3] - ben_pur2$median[2]) / 1e6
ticking()
f0 <- function(n = 1e5) { i <- 0 x <- 0 while (i < n) { x <- x + i %% 2 i <- i + 1 } x }
fp <- function(n = 1e5) { i <- 0 x <- 0 while (ticking(i < n)) { x <- x + i %% 2 i <- i + 1 } x }
ben_tk <- bench::mark(f0(), fp()) ben_tk (ben_tk$median[2] - ben_tk$median[1]) / 1e5
f0 <- function(n = 1e5) { x <- 0 for (i in 1:n) { x <- x + i %% 2 } x }
fp <- function(n = 1e5) { cli_progress_bar(total = n) x <- 0 for (i in 1:n) { x <- x + i %% 2 cli_progress_update() } x }
ff <- function(n = 1e5) { cli_progress_bar(total = n) x <- 0 for (i in 1:n) { x <- x + i %% 2 if (`__cli_update_due`) cli_progress_update() } x }
ben_api <- bench::mark(f0(), ff(), fp()) ben_api (ben_api$median[3] - ben_api$median[1]) / 1e5 (ben_api$median[2] - ben_api$median[1]) / 1e5
ben_api2 <- bench::mark(f0(1e6), ff(1e6), fp(1e6)) ben_api2 (ben_api2$median[3] - ben_api2$median[1]) / 1e6 (ben_api2$median[2] - ben_api2$median[1]) / 1e6
Baseline function:
SEXP test_baseline() { int i; int res = 0; for (i = 0; i < 2000000000; i++) { res += i % 2; } return ScalarInteger(res); }
Switch + modulo check:
SEXP test_modulo(SEXP progress) { int i; int res = 0; int progress_ = LOGICAL(progress)[0]; for (i = 0; i < 2000000000; i++) { if (i % 10000 == 0 && progress_) cli_progress_set(R_NilValue, i); res += i % 2; } return ScalarInteger(res); }
cli progress bar API:
SEXP test_cli() { int i; int res = 0; SEXP bar = PROTECT(cli_progress_bar(2000000000, NULL)); for (i = 0; i < 2000000000; i++) { if (CLI_SHOULD_TICK) cli_progress_set(bar, i); res += i % 2; } cli_progress_done(bar); UNPROTECT(1); return ScalarInteger(res); }
SEXP test_cli_unroll() { int i = 0; int res = 0; SEXP bar = PROTECT(cli_progress_bar(2000000000, NULL)); int s, final, step = 2000000000 / 100000; for (s = 0; s < 100000; s++) { if (CLI_SHOULD_TICK) cli_progress_set(bar, i); final = (s + 1) * step; for (i = s * step; i < final; i++) { res += i % 2; } } cli_progress_done(bar); UNPROTECT(1); return ScalarInteger(res); }
library(progresstest) ben_c <- bench::mark( test_baseline(), test_modulo(), test_cli(), test_cli_unroll() ) ben_c (ben_c$median[3] - ben_c$median[1]) / 2000000000
We only update the display a fixed number of times per second. (Currently maximum five times per second.)
Let's measure how long a single update takes.
cli_progress_bar(total = 100000) bench::mark(cli_progress_update(force = TRUE), max_iterations = 10000) cli_progress_done()
cli_progress_bar(total = NA) bench::mark(cli_progress_update(force = TRUE), max_iterations = 10000) cli_progress_done()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.