use touchstone

.Rbuildignore

@@ -20,3 +20,5 @@
 ^simstudy\.code-workspace$
 ^codemeta\.json$
 ^paper$
+^touchstone$
+^bench$

.github/workflows/cancel.yaml

@@ -0,0 +1,14 @@
+# https://github.com/styfle/cancel-workflow-action
+name: Cancel
+on:
+  workflow_run:
+    workflows: ["Continuous Benchmarks (Comment)", "Continuous Benchmarks (Receive)", "code-coverage", "pkgdown", "R-CMD-check"] # list by name as in `name:` of the workflow file
+    types:
+      - requested
+jobs:
+  cancel:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: styfle/[email protected]
+      with:
+        workflow_id: ${{ github.event.workflow.id }}

.github/workflows/touchstone-comment.yaml

@@ -0,0 +1,52 @@
+name: Continuous Benchmarks (Comment)
+
+# read-write repo token
+# access to secrets
+on:
+  workflow_run:
+    workflows: ["Continuous Benchmarks (Receive)"]
+    types:
+      - completed
+
+jobs:
+  upload:
+    runs-on: ubuntu-latest
+    if: >
+      ${{ github.event.workflow_run.event == 'pull_request' &&
+      github.event.workflow_run.conclusion == 'success' }}
+    steps:
+      - name: 'Download artifact'
+        uses: actions/[email protected]
+        with:
+          script: |
+            var artifacts = await github.actions.listWorkflowRunArtifacts({
+               owner: context.repo.owner,
+               repo: context.repo.repo,
+               run_id: ${{github.event.workflow_run.id }},
+            });
+            var matchArtifact = artifacts.data.artifacts.filter((artifact) => {
+              return artifact.name == "pr"
+            })[0];
+            var download = await github.actions.downloadArtifact({
+               owner: context.repo.owner,
+               repo: context.repo.repo,
+               artifact_id: matchArtifact.id,
+               archive_format: 'zip',
+            });
+            var fs = require('fs');
+            fs.writeFileSync('${{github.workspace}}/pr.zip', Buffer.from(download.data));
+      - run: unzip pr.zip
+      - name: 'Comment on PR'
+        uses: actions/github-script@v3
+        with:
+          github-token: ${{ secrets.GITHUB_TOKEN }}
+          script: |
+            var fs = require('fs');
+            var issue_number = Number(fs.readFileSync('./NR'));
+            var body = fs.readFileSync('./info.txt').toString();
+            await github.issues.createComment({
+              owner: context.repo.owner,
+              repo: context.repo.repo,
+              issue_number: issue_number,
+              body: body
+            });

.github/workflows/touchstone-receive.yaml

@@ -0,0 +1,95 @@
+name: Continuous Benchmarks (Receive)
+on: pull_request
+jobs:
+  prepare:
+    runs-on: ubuntu-latest
+    outputs:
+      config: ${{ steps.read_touchstone_config.outputs.config }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v2
+        with:
+           fetch-depth: 0
+
+      - id: read_touchstone_config
+        run: |
+          content=`cat ./touchstone/config.json`
+          # the following lines are only required for multi line json
+          content="${content//'%'/'%25'}"
+          content="${content//$'\n'/'%0A'}"
+          content="${content//$'\r'/'%0D'}"
+          # end of optional handling for multi line json
+          echo "::set-output name=config::$content"
+  build:
+    needs: prepare
+    runs-on: ${{ matrix.config.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - ${{ fromJson(needs.prepare.outputs.config) }}
+    env:
+      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      RSPM: ${{ matrix.config.rspm }}
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v2
+        with:
+           fetch-depth: 0
+      - name: Set up git user
+        run: |
+          git config --local user.name "GitHub Actions"
+          git config --local user.email "[email protected]"
+      - name: Ensure base branch is fetched
+        run: |
+          git checkout -b $GITHUB_HEAD_REF # this is current ref. This is required for naming.
+          git branch $GITHUB_BASE_REF remotes/origin/$GITHUB_BASE_REF
+      - name: Setup R
+        uses: r-lib/actions/setup-r@master
+      - name: Setup dependencies
+        uses: r-lib/actions/setup-r-dependencies@master
+        with:
+          cache-version: 1
+          extra-packages: |
+            lorenzwalthert/touchstone
+            ggplot2
+            dplyr
+            gert
+      - name: Remove global installation
+        run: | 
+          pkg <- basename(getwd())
+          if (pkg %in% rownames(installed.packages())) {
+            remove.packages(pkg)
+            cat('removed package ', pkg, '.', sep = "")
+          }
+        shell: Rscript {0}
+      - name: Checkout benchmarking repo
+        if: ${{ matrix.config.benchmarking_repo != ''}}
+        uses: actions/checkout@v2
+        with:
+          repository: ${{ matrix.config.benchmarking_repo }}
+          ref: ${{ matrix.config.benchmarking_ref }}
+          path: ${{ matrix.config.benchmarking_path }}
+      - name: Run benchmarks
+        run: Rscript -e 'touchstone::run_script("touchstone/script.R")'
+      - name: Save PR number
+        run: |
+          echo ${{ github.event.number }} > ./touchstone/pr-comment/NR
+      - uses: actions/upload-artifact@v2
+        with:
+          name: visual-benchmarks
+          path: touchstone/plots/
+      - uses: actions/upload-artifact@v1
+        with:
+          name: results
+          path: touchstone/pr-comment
+      - uses: actions/download-artifact@v1
+        with:
+          name: results
+      - name: comment PR
+        run: cat touchstone/pr-comment/info.txt
+      - uses: actions/upload-artifact@v2
+        with:
+          name: pr
+          path: touchstone/pr-comment/

bench/define.R

@@ -0,0 +1,87 @@
+def_all_dists <- function() {
+    def <- defData(varname = "age", dist = "uniformInt", formula = "22;75")
+    def <- defData(def, varname = "rating", dist = "uniform", formula = "0;10")
+    def <- defData(def,
+        varname = "female", dist = "binary",
+        formula = "-2 + age * 0.1", link = "logit"
+    )
+    def <- defData(def,
+        varname = "baseDBP", dist = "normal",
+        formula = 70, variance = 40
+    )
+    def <- defData(def,
+        varname = "nClasses", dist = "noZeroPoisson", formula = 3
+    )
+    def <- defData(def,
+        varname = "visits", dist = "poisson",
+        formula = "1.5 - 0.2 * age + 0.5 * female", link = "log"
+    )
+    def <- defData(def,
+        varname = "Y0", dist = "normal", formula = 10, variance = 1
+    )
+    def <- defData(def,
+        varname = "Y1", dist = "normal", formula = "Y0 + 5 + 5",
+        variance = 1
+    )
+    def <- defData(def,
+        varname = "deterministic", dist = "nonrandom", formula = "25 + age"
+    )
+    def <- defData(def,
+        varname = "binom", dist = "binomial", formula = .4,
+        variance = 10
+    )
+    def <- defData(def,
+        varname = "cat", dist = "categorical", formula = genCatFormula(n = 5),
+        variance = "a;b;c;d;e"
+    )
+    def <- defData(def,
+        varname = "exp", dist = "exponential", formula = "42"
+    )
+
+    def <- defData(def,
+        varname = "gamma", dist = "gamma", formula = "exp/age",
+        variance = 1
+    )
+
+    def <- defData(def,
+        varname = "mix", dist = "mixture",
+        formula = genMixFormula(
+            c("age", "exp", "Y1", "baseDBP"),
+            c(0.3, .2, .4, .1)
+        )
+    )
+
+    def <- defData(def,
+        varname = "negBin", dist = "negBinomial", formula = "Y0 + 10 + 5",
+        variance = 1
+    )
+    def <- defData(def,
+        varname = "beta", dist = "beta", formula = .6,
+        variance = .5
+    )
+
+    def
+}
+
+def_short <- function() {
+    def <- defData(varname = "age", dist = "uniformInt", formula = "22;75")
+    def <- defData(def, varname = "rating", dist = "uniform", formula = "0;10")
+    def <- defData(def,
+        varname = "female", dist = "binary",
+        formula = "-2 + age * 0.1", link = "logit"
+    )
+    def <- defData(def,
+        varname = "baseDBP", dist = "normal",
+        formula = 70, variance = 40
+    )
+    def <- defData(def,
+        varname = "deterministic", dist = "nonrandom", formula = "25 + age"
+    )
+    def <- defData(def,
+        varname = "cat", dist = "categorical", formula = genCatFormula(n = 5),
+        variance = "a;b;c;d;e"
+    )
+
+
+    def
+}

touchstone/.gitignore

@@ -0,0 +1,6 @@
+*
+!script.R
+!config.json
+!.gitignore
+!header.R
+!footer.R

touchstone/config.json

@@ -0,0 +1,5 @@
+{
+  "os": "ubuntu-20.04",
+  "r": "4.1.1",
+  "rspm": "https://packagemanager.rstudio.com/all/__linux__/focal/291"
+}

touchstone/footer.R

@@ -0,0 +1,10 @@
+# You can modify the PR comment footer here. You can use github markdown e.g.
+# emojis like :tada:.
+# This file will be parsed and evaluate within the context of
+# `benchmarks_analyze` and should return the comment text as the last value.
+# See `?touchstone::pr_comment`
+link <- "https://lorenzwalthert.github.io/touchstone/articles/inference.html"
+glue::glue(
+  "\nFurther explanation regarding interpretation and",
+  " methodology can be found in the [documentation]({link})."
+)

touchstone/header.R

@@ -0,0 +1,13 @@
+# You can modify the PR comment header here. You can use github markdown e.g.
+# emojis like :tada:.
+# This file will be parsed and evaluate within the context of
+# `benchmarks_analyze` and should return the comment text as the last value.
+# Available variables for glue substitution:
+# * ci: confidence interval
+# * refs: BASE and HEAD refs benchmarked against each other.
+# See `?touchstone::pr_comment`
+glue::glue(
+  "This is how benchmark results would change (along with a",
+  " {100 * ci}% confidence interval in relative change) if ",
+  "{system2('git', c('rev-parse', 'HEAD'), stdout = TRUE)} is merged into {refs[1]}:\n"
+)