Merge pull request #674 from lorenzwalthert/benchmarking

- Add benchmarking infra (#674).

Author: lorenzwalthert

.Rbuildignore

@@ -19,4 +19,5 @@ revdep
 ^tests/testmanual$
 ^\.pre-commit-config\.yaml$
 ^brew\-log$
-^\.github$
+^\.github/$
+^bench/$

.github/workflows/benchmarking.yaml

@@ -0,0 +1,61 @@
+on:
+  push:
+    branches:
+    - master
+  pull_request:
+    branches:
+    - master
+
+name: Continuous Benchmarks
+
+jobs:
+  build:
+    runs-on: macOS-latest
+    steps:
+      - name: Checkout repo
+        with:
+          fetch-depth: 0
+        uses: actions/checkout@master
+      - name: Ensure base branch is fetched
+        if: ${{ github.event_name == 'pull_request' }}
+        run: git branch $GITHUB_BASE_REF remotes/origin/$GITHUB_BASE_REF; git branch
+      - name: Setup R
+        uses: r-lib/actions/setup-r@master
+      - name: Query dependencies
+        run: |
+          install.packages('remotes')
+          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
+          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
+        shell: Rscript {0}
+
+      - name: Cache R packages
+        if: runner.os != 'Windows'
+        uses: actions/cache@v1
+        with:
+          path: ${{ env.R_LIBS_USER }}
+          key: ${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ hashFiles('.github/R-version') }}-1-
+
+      - name: Install dependencies
+        run: |
+          Rscript -e "install.packages(c('gert', 'ggplot2', 'purrr'))" -e "remotes::install_deps(dependencies = TRUE); remotes::install_github('r-lib/bench')"
+          R CMD INSTALL .
+      - name: Checkout benchmarking repo
+        uses: actions/checkout@v2
+        with:
+          repository: lorenzwalthert/here
+          ref: ca9c8e69c727def88d8ba1c8b85b0e0bcea87b3f
+          path: bench/sources/here
+      - name: Fetch existing benchmarks
+        run: Rscript -e 'rlang::with_handlers(bench::cb_fetch(), error = function(e) paste("Could not fetch benchmarks, skipping. The error was", conditionMessage(e)))'
+      - name: Run benchmarks
+        run: Rscript -e 'bench::cb_run()'
+      - name: Show benchmarks
+        run: git notes --ref benchmarks show
+      - uses: actions/upload-artifact@v2
+        with:
+          name: visual-benchmarks
+          path: bench/plots/
+      - name: Push benchmarks
+        if: ${{ github.event_name == 'push' }}
+        run: Rscript -e "bench::cb_push()"

.pre-commit-config.yaml

@@ -13,6 +13,7 @@ repos:
         exclude: >
           (?x)^(
           data/.*|
+          \.github/.*\.yaml|
           (.*/|)\.Rprofile|
           (.*/|)\.Renviron|
           (.*/|)\.gitignore|
@@ -35,6 +36,10 @@ repos:
     -   id: parsable-R
     -   id: no-browser-statement
     -   id: deps-in-desc
+        exclude: >
+          (?x)^(
+          bench/.*
+          )$
 -   repo: https://github.com/pre-commit/pre-commit-hooks
     rev: v3.2.0
     hooks:

bench/01-declarations.R

@@ -0,0 +1,39 @@
+#' Plot benchmarks against a base branch, if benchmarks there exist
+#'
+#' @param new_bm A new benchmark object.
+#' @param new_bm_label The label of the new benchmark used as a title.
+#' @param file The file path to write the plot.
+plot_against_base <- function(new_bm,
+                              new_bm_label = deparse(substitute(new_bm)),
+                              file = paste0("plots/", new_bm_label, ".pdf")) {
+  new_bm <- bench::as_bench_mark(new_bm)
+  new_bm$expression <- bench:::new_bench_expr(Sys.getenv("GITHUB_HEAD_REF"))
+  name <- unique(new_bm$name)
+  stopifnot(length(name) == 1)
+  branches <- gert::git_branch_list()
+  last_commit_base_branch <- branches[branches$name == Sys.getenv("GITHUB_BASE_REF"), "commit", drop = TRUE]
+  bm <- bench::cb_read()
+  commit_is_reference <- bm$commit_hash == last_commit_base_branch
+  if (any(commit_is_reference) && Sys.getenv("GITHUB_BASE_REF") != "") {
+    # if a pull request
+    reference <- bm[commit_is_reference, "benchmarks"][[1]][[1]]
+    if (nrow(reference) > 0 && "name" %in% names(reference)) {
+      reference <- reference %>%
+        dplyr::filter(.data$name %in% !!name)
+      reference$expression <- bench:::new_bench_expr(Sys.getenv("GITHUB_BASE_REF"))
+      new_bm <- dplyr::bind_rows(reference, new_bm)
+    }
+  }
+  new_bm$branch <- factor(new_bm$expression)
+  plot <- ggplot2::ggplot(new_bm) +
+    ggplot2::geom_boxplot(ggplot2::aes(
+      x = branch, ymin = p0,
+      ymax = p100, lower = p25,
+      middle = p50, upper = p75
+    ),
+    stat = "identity"
+    ) +
+    ggplot2::ggtitle(name)
+
+  ggplot2::ggsave(file, plot)
+}

bench/02-basic.R

@@ -0,0 +1,36 @@
+# drop all notes
+# git update-ref -d refs/notes/benchmarks
+
+library(styler)
+library(magrittr)
+path <- "sources/here"
+dir.create("plots")
+cache_clear(ask = FALSE)
+cache_activate()
+cache_info()
+
+marker <- purrr::partial(
+  bench::mark,
+  min_iterations = 20,
+  check = FALSE,
+  filter_gc = FALSE,
+  memory = TRUE # skip uncached first round
+)
+
+with_cache <- marker(
+  with_cache = {
+    style_pkg(path, filetype = c("R", "rmd"))
+  }
+)
+cache_info()
+gert::git_reset_hard(repo = path)
+cache_deactivate()
+
+without_cache <- marker(
+  without_cache = {
+    style_pkg(path, filetype = c("R", "rmd"))
+  }
+)
+latest_bm <- bench::cb_read()$benchmarks[[1]]
+split(latest_bm, latest_bm$name) %>%
+  purrr::imap(plot_against_base)