progress-benchmark.Rmd

---
title: "cli progress bar benchmark"
author: "Gábor Csárdi"
date: "`r Sys.Date()`"
output:
  rmarkdown::html_document:
    toc: true
    toc_depth: 2
editor_options:
  markdown:
    wrap: sentence
---

```{r, setup, include = FALSE, cache = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  out.width = "100%",
  cache = TRUE
)
```

# Introduction

We make sure that the timer is not `TRUE`, by setting it to ten hours.

```{r library, cache = FALSE}
library(cli)
# 10 hours
cli:::cli_tick_set(10 * 60 * 60 * 1000)
cli_tick_reset()
`__cli_update_due`
```

# R benchmarks

## The timer

```{r timer}
fun <- function() NULL
ben_st <- bench::mark(
  `__cli_update_due`,
  fun(),
  .Call(ccli_tick_reset),
  interactive(),
  check = FALSE
)
ben_st
```

```{r timer2}
ben_st2 <- bench::mark(
  if (`__cli_update_due`) foobar()
)
ben_st2
```

## `cli_progress_along()`

```{r tick-along}
seq <- 1:100000
ta <- cli_progress_along(seq)
bench::mark(seq[[1]], ta[[1]])
```

### `for` loop

This is the baseline:

```{r tick-along-for-f0}
f0 <- function(n = 1e5) {
  x <- 0
  seq <- 1:n
  for (i in seq) {
    x <- x + i %% 2
  }
  x
}
```

With progress bars:

```{r tick-along-for-f}
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:


```{r tick-along-for-bench}
ben_taf <- bench::mark(f0(), fp())
ben_taf
(ben_taf$median[2] - ben_taf$median[1]) / 1e5
```

```{r tick-along-for-bench2}
ben_taf2 <- bench::mark(f0(1e6), fp(1e6))
ben_taf2
(ben_taf2$median[2] - ben_taf2$median[1]) / 1e6
```

```{r tick-along-for-bench3}
ben_taf3 <- bench::mark(f0(1e7), fp(1e7))
ben_taf3
(ben_taf3$median[2] - ben_taf3$median[1]) / 1e7
```

```{r tick-along-for-bench4}
ben_taf4 <- bench::mark(f0(1e8), fp(1e8))
ben_taf4
(ben_taf4$median[2] - ben_taf4$median[1]) / 1e8
```

### Mapping with `lapply()`

This is the baseline:

```{r tick-along-map-f0}
f0 <- function(n = 1e5) {
  seq <- 1:n
  ret <- lapply(seq, function(x) {
    x %% 2
  })
  invisible(ret)
}
```

With an index vector:

```{r tick-along-map-f01}
f01 <- function(n = 1e5) {
  seq <- 1:n
  ret <- lapply(seq_along(seq), function(i) {
    seq[[i]] %% 2
  })
  invisible(ret)
}
```

With progress bars:

```{r tick-along-map-f}
fp <- function(n = 1e5) {
  seq <- 1:n
  ret <- lapply(cli_progress_along(seq), function(i) {
    seq[[i]] %% 2
  })
  invisible(ret)
}
```
Overhead per iteration:

```{r tick-along-map-bench}
ben_tam <- bench::mark(f0(), f01(), fp())
ben_tam
(ben_tam$median[3] - ben_tam$median[1]) / 1e5
```

```{r tick-along-map-bench2}
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
```

### Mapping with purrr

This is the baseline:

```{r tick-along-purrr-f0}
f0 <- function(n = 1e5) {
  seq <- 1:n
  ret <- purrr::map(seq, function(x) {
    x %% 2
  })
  invisible(ret)
}
```

With index vector:

```{r tick-along-purrr-f01}
f01 <- function(n = 1e5) {
  seq <- 1:n
  ret <- purrr::map(seq_along(seq), function(i) {
    seq[[i]] %% 2
  })
  invisible(ret)
}
```

With progress bars:

```{r tick-along-purrr-f}
fp <- function(n = 1e5) {
  seq <- 1:n
  ret <- purrr::map(cli_progress_along(seq), function(i) {
    seq[[i]] %% 2
  })
  invisible(ret)
}
```

Overhead per iteration:

```{r tick-along-purrr-bench}
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
```

```{r tick-along-purrr-bench2}
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()`

```{r ticking-f0}
f0 <- function(n = 1e5) {
  i <- 0
  x <- 0 
  while (i < n) {
    x <- x + i %% 2
    i <- i + 1
  }
  x
}
```

```{r ticking-fp}
fp <- function(n = 1e5) {
  i <- 0
  x <- 0 
  while (ticking(i < n)) {
    x <- x + i %% 2
    i <- i + 1
  }
  x
}
```

```{r ticking}
ben_tk <- bench::mark(f0(), fp())
ben_tk
(ben_tk$median[2] - ben_tk$median[1]) / 1e5
```

## Traditional API

```{r api-f0}
f0 <- function(n = 1e5) {
  x <- 0
  for (i in 1:n) {
    x <- x + i %% 2
  }
  x
}
```

```{r api-fp}
fp <- function(n = 1e5) {
  cli_progress_bar(total = n)
  x <- 0
  for (i in 1:n) {
    x <- x + i %% 2
    cli_progress_update()
  }
  x
}
```

```{r api-fpfast}
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
}
```

```{r api}
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
```

```{r api2}
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
```

# C benchmarks

Baseline function:

```c
SEXP test_baseline() {
  int i;
  int res = 0;
  for (i = 0; i < 2000000000; i++) {
    res += i % 2;
  }
  return ScalarInteger(res);
}
```

Switch + modulo check:

```c
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:

```c
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);
}
```

```c
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);
}
```

```{r capi}
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
```

# Display update

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.

## Iterator with a bar

```{r update-prep-total}
cli_progress_bar(total = 100000)
bench::mark(cli_progress_update(force = TRUE), max_iterations = 10000)
cli_progress_done()
```

## Iterator without a bar

```{r update-prep-nototal}
cli_progress_bar(total = NA)
bench::mark(cli_progress_update(force = TRUE), max_iterations = 10000)
cli_progress_done()
```