Merge branch 'dev' into new_epi_outputs_function

.Rbuildignore

@@ -12,3 +12,4 @@ codecov.yml
 ^data-raw$
 ^doc$
 ^Meta$
+^touchstone$

.github/workflows/touchstone.yaml

@@ -0,0 +1,149 @@
+name: Continuous benchmarking
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.event.issue.number }}
+  cancel-in-progress: true
+
+on:
+  issue_comment:
+    types: ['created', 'edited']
+
+permissions:
+  contents: read
+  statuses: write
+  pull-requests: write
+
+env:
+  WORKFLOW_URL: ${{ github.server_url }}/${{ github.repository }}/actions/runs/${{ github.run_id }}
+
+  # This generally gives more consistent benchmarking results.
+  R_GC_MEM_GROW: 3
+
+jobs:
+  prepare:
+    # The other jobs all depend on this one succeeding. They'll implicitly get
+    # skipped as well if this condition is not met.
+    if: >
+      github.event.issue.pull_request &&
+      startsWith(github.event.comment.body, '/benchmark') && (
+        github.event.comment.author_association == 'OWNER' ||
+        github.event.comment.author_association == 'MEMBER' ||
+        github.event.comment.author_association == 'COLLABORATOR' 
+      )
+
+    runs-on: ubuntu-latest
+
+    outputs:
+      # The HEAD's sha is exported so we can update the status when the workflow
+      # completes.
+      head_sha: ${{ steps.metadata.outputs.result }}
+
+    steps:
+      - id: metadata
+        name: Fetch PR metadata
+        uses: actions/github-script@v7
+        with:
+          result-encoding: string
+          script: |
+            let pr = (await github.rest.pulls.get({
+              owner: context.repo.owner,
+              repo: context.repo.repo,
+              pull_number: context.issue.number
+            })).data;
+
+            return pr.head.sha;
+
+      - name: Set commit status as in progress
+        uses: actions/github-script@v7
+        env:
+          HEAD_SHA: ${{ steps.metadata.outputs.result }}
+        with:
+          script: |
+            github.rest.repos.createCommitStatus({
+              owner: context.repo.owner,
+              repo: context.repo.repo,
+              sha: process.env.HEAD_SHA,
+              state: "pending",
+              target_url: process.env.WORKFLOW_URL,
+              description: 'Benchmarking in progress...',
+              context: 'touchstone'
+            });
+
+  build:
+    needs: prepare
+
+    # This job run potentially untrusted code from the PR (albeit gated by a
+    # comment from a collaborator). We restrict the scope of the token as much
+    # as we can. We also need to be careful not to use any repository secrets
+    # as inputs to the job. The rest of the workflow only runs code from the
+    # master branch so isn't vulnerable to outsiders.
+    permissions:
+      contents: read
+
+    runs-on: ubuntu-22.04
+    env:
+      RSPM: "https://packagemanager.posit.co/cran/__linux__/jammy/2024-05-15"
+      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: lorenzwalthert/touchstone/actions/receive@main
+
+  comment:
+    needs: ['prepare', 'build']
+
+    if: always() && needs.prepare.result == 'success'
+
+    runs-on: ubuntu-latest
+    steps:
+      - name: Download benchmarking results
+        if: needs.build.result == 'success'
+        # Version number must match the one used by touchstone when uploading
+        uses: actions/download-artifact@v2
+        with:
+          name: pr
+
+      - name: Comment on PR
+        if: needs.build.result == 'success'
+        uses: actions/github-script@v7
+        with:
+          script: |
+            var fs = require('fs');
+            var body = fs.readFileSync('./info.txt').toString();
+            await github.rest.issues.createComment({
+              owner: context.repo.owner,
+              repo: context.repo.repo,
+              issue_number: context.issue.number,
+              body: body
+            });
+
+      - name: Update commit status
+        uses: actions/github-script@v7
+        env:
+          RESULT: ${{ needs.build.result }}
+          HEAD_SHA: ${{ needs.prepare.outputs.head_sha }}
+
+        with:
+          script: |
+            let description;
+            switch (process.env.RESULT) {
+              case "success":
+                description = 'Benchmarking succeeded!';
+                break;
+              case "cancelled":
+                description = 'Benchmarking was cancelled.';
+                break;
+              default:
+                description = 'Benchmarking failed!';
+                break;
+            }
+
+            github.rest.repos.createCommitStatus({
+              owner: context.repo.owner,
+              repo: context.repo.repo,
+              sha: process.env.HEAD_SHA,
+              state: process.env.RESULT == "success" ? "success" : "failure",
+              target_url: process.env.WORKFLOW_URL,
+              description: description,
+              context: 'touchstone'
+            });

R/processes.R

@@ -143,7 +143,7 @@ create_processes <- function(
   )
 
   # =========
-  # RTS,S EPI
+  # PEV EPI
   # =========
   if (!is.null(parameters$pev_epi_coverage)) {
     processes <- c(
@@ -260,7 +260,7 @@ create_processes <- function(
   if (parameters$spraying) {
     processes <- c(
       processes,
-      indoor_spraying(variables$spray_time, parameters, correlations)
+      indoor_spraying(variables$spray_time, renderer, parameters, correlations)
     )
   }
 

R/vector_control.R

@@ -102,10 +102,12 @@ prob_bitten <- function(
 #' `get_correlation_parameters`
 #'
 #' @param spray_time the variable for the time of spraying
+#' @param renderer model rendering object
 #' @param parameters the model parameters
 #' @param correlations correlation parameters
 #' @noRd
-indoor_spraying <- function(spray_time, parameters, correlations) {
+indoor_spraying <- function(spray_time, renderer, parameters, correlations) {
+  renderer$set_default('n_spray', 0)
   function(timestep) {
     matches <- timestep == parameters$spraying_timesteps
     if (any(matches)) {
@@ -116,6 +118,7 @@ indoor_spraying <- function(spray_time, parameters, correlations) {
         correlations
       ))
       spray_time$queue_update(timestep, target)
+      renderer$render('n_spray', length(target), timestep)
     }
   }
 }

tests/testthat/test-vector-control.R

@@ -201,9 +201,11 @@ test_that('indoor_spraying process sets spray_time correctly', {
     ms_gamma = matrix(c(-0.009, -0.009), nrow=2, ncol=1)
   )
   spray_time <- mock_double(rep(0, 4))
+  renderer <- individual::Render$new(timestep)
   correlations <- get_correlation_parameters(parameters)
   process <- indoor_spraying(
     spray_time,
+    renderer,
     parameters,
     correlations
   )

touchstone/.gitignore

@@ -0,0 +1,5 @@
+*
+!script.R
+!.gitignore
+!header.R
+!footer.R

touchstone/footer.R

@@ -0,0 +1,17 @@
+# 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
+# `benchmark_analyze` and should return the comment text as the last value.
+# See `?touchstone::pr_comment`
+
+documentation <- "https://lorenzwalthert.github.io/touchstone/articles/inference.html"
+
+# This is exported by the workflow itself
+workflow <- Sys.getenv("WORKFLOW_URL")
+
+glue::glue(
+  "\n\nFurther explanation regarding interpretation and",
+  " methodology can be found in the [documentation]({documentation}).",
+  "\nPlots and raw data are available as artifacts of",
+  " [the workflow run]({workflow})."
+)

touchstone/header.R

@@ -0,0 +1,14 @@
+# 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
+# `benchmark_analyze` and should return the comment text as the last value.
+# Available variables for glue substitution:
+# * ci: confidence interval
+# * branches: BASE and HEAD branches 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 {branches[1]}:\n"
+)

touchstone/script.R

@@ -0,0 +1,44 @@
+library(magrittr)
+
+touchstone::branch_install()
+
+touchstone::benchmark_run(
+  small_population = {
+    set.seed(123)
+    params <- malariasimulation::get_parameters(
+      overrides = list(human_population=1e4))
+    malariasimulation::run_simulation(10000, params)
+  },
+  n = 10
+)
+
+touchstone::benchmark_run(
+  large_population = {
+    set.seed(123)
+    params <- malariasimulation::get_parameters(
+      overrides = list(human_population=1e6))
+    malariasimulation::run_simulation(1000, params)
+  },
+  n = 4
+)
+
+touchstone::benchmark_analyze()
+
+# Overwrite the plots generated by touchstone with something more sensible.
+touchstone::benchmark_ls() %>%
+  dplyr::reframe(touchstone::benchmark_read(name, branch)) %>%
+  dplyr::mutate(branch=as.factor(branch), name=as.factor(name)) %>%
+  dplyr::group_by(name) %>%
+  dplyr::group_walk(function(data, key) {
+    ggplot2::ggplot(data, ggplot2::aes(y = branch, x = elapsed, color = branch)) +
+      ggplot2::geom_boxplot() +
+      ggplot2::geom_jitter(height = 0.2) +
+      ggplot2::guides(color="none") +
+      ggplot2::labs(x="Elapsed time", y="Branch") +
+      bench::scale_x_bench_time(base = NULL) +
+      ggplot2::ggtitle(key$name)
+
+    fs::path(touchstone::dir_touchstone(), "plots", key$name) %>%
+      fs::path_ext_set("png") %>%
+      ggplot2::ggsave(height=3)
+  })