-
Notifications
You must be signed in to change notification settings - Fork 7
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add continuous benchmarking scripts (#207)
* Add touchstone infrastructure, WIP #197 * Add benchmarking setup and script, WIP #197 * Update OS, R version, RSPM source
- Loading branch information
1 parent
f037395
commit 1dc22d7
Showing
5 changed files
with
119 additions
and
28 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -4,3 +4,4 @@ | |
!.gitignore | ||
!header.R | ||
!footer.R | ||
!setup*.R |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,5 @@ | ||
{ | ||
"os": "ubuntu-22.04", | ||
"r": "4.4.0", | ||
"https://packagemanager.rstudio.com/all/__linux__/jammy/latest" | ||
"rspm": "https://packagemanager.rstudio.com/all/__linux__/jammy/latest" | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,30 +1,71 @@ | ||
# see `help(run_script, package = 'touchstone')` on how to run this | ||
# interactively | ||
|
||
# TODO OPTIONAL Add directories you want to be available in this file or during the | ||
# benchmarks. | ||
# TODO OPTIONAL Add directories you want to be available in this file or during | ||
# the benchmarks. | ||
# touchstone::pin_assets("some/dir") | ||
|
||
# installs branches to benchmark | ||
touchstone::branch_install() | ||
|
||
# benchmark a function call from your package (two calls per branch) | ||
#### Simple final size calculation on uniform population #### | ||
# run for 1000 values of R0 | ||
# using iterative solver | ||
touchstone::benchmark_run( | ||
# expr_before_benchmark = source("dir/data.R"), #<-- TODO OTPIONAL setup before benchmark | ||
random_test = yourpkg::f(), #<- TODO put the call you want to benchmark here | ||
n = 2 | ||
expr_before_benchmark = { | ||
source("touchstone/setup.R") | ||
}, | ||
default_iterative = { | ||
lapply(r0_samples, final_size, solver = "iterative") | ||
}, | ||
n = 100 | ||
) | ||
|
||
# TODO OPTIONAL benchmark any R expression (six calls per branch) | ||
# touchstone::benchmark_run( | ||
# more = { | ||
# if (TRUE) { | ||
# y <- yourpkg::f2(x = 3) | ||
# } | ||
# }, #<- TODO put the call you want to benchmark here | ||
# n = 6 | ||
# ) | ||
# using newton solver | ||
touchstone::benchmark_run( | ||
expr_before_benchmark = { | ||
source("touchstone/setup.R") | ||
}, | ||
default_newton = { | ||
lapply(r0_samples, final_size, solver = "newton") | ||
}, | ||
n = 100 | ||
) | ||
|
||
#### Final size calculation on heterogeneous population #### | ||
# run for 1000 values of R0 | ||
# using iterative solver | ||
touchstone::benchmark_run( | ||
expr_before_benchmark = { | ||
source("touchstone/setup.R") | ||
}, | ||
complex_iterative = { | ||
lapply( | ||
r0_samples, final_size, | ||
contact_matrix = contact_matrix, | ||
demography_vector = demography_vector, | ||
susceptibility = susceptibility, | ||
p_susceptibility = p_susceptibility, | ||
solver = "iterative" | ||
) | ||
}, | ||
n = 100 | ||
) | ||
|
||
# create artifacts used downstream in the GitHub Action | ||
touchstone::benchmark_analyze() | ||
# using newton solver | ||
touchstone::benchmark_run( | ||
expr_before_benchmark = { | ||
source("touchstone/setup.R") | ||
}, | ||
complex_newton = { | ||
lapply( | ||
r0_samples, final_size, | ||
contact_matrix = contact_matrix, | ||
demography_vector = demography_vector, | ||
susceptibility = susceptibility, | ||
p_susceptibility = p_susceptibility, | ||
solver = "newton" | ||
) | ||
}, | ||
n = 100 | ||
) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,46 @@ | ||
library(finalsize) | ||
library("socialmixr") | ||
library("withr") | ||
|
||
#### Set up population characteristics #### | ||
# load contact and population data from socialmixr::polymod | ||
polymod <- socialmixr::polymod | ||
contact_data <- socialmixr::contact_matrix( | ||
polymod, | ||
countries = "United Kingdom", | ||
age.limits = seq(0, 80, 10), # final age bin is 70+ | ||
symmetric = TRUE | ||
) | ||
|
||
# get the contact matrix and demography data | ||
contact_matrix <- t(contact_data$matrix) | ||
demography_vector <- contact_data$demography$population | ||
|
||
# scale the contact matrix so the largest eigenvalue is 1.0 | ||
contact_matrix <- contact_matrix / max(Re(eigen(contact_matrix)$values)) | ||
|
||
# divide each row of the contact matrix by the corresponding demography | ||
contact_matrix <- contact_matrix / demography_vector | ||
|
||
n_demo_grps <- length(demography_vector) | ||
|
||
# get 1000 R0 samples | ||
r0_mean <- 1.5 | ||
r0_sd <- 0.01 | ||
samples <- 1000 | ||
r0_samples <- withr::with_seed(1, rnorm(1000, r0_mean, r0_sd)) | ||
|
||
# define susceptibility values for age groups, greater for older ages | ||
susc_variable <- matrix( | ||
data = seq_along(demography_vector) / length(demography_vector) | ||
) | ||
susceptibility <- cbind( | ||
susc_variable, susc_variable * 0.8, susc_variable * 0.6, | ||
susc_variable * 0.5 | ||
) | ||
|
||
# define proportion of each demographic group in each susceptibility group | ||
# assume uniform distribution | ||
n_demo_grps <- nrow(contact_matrix) | ||
p_susceptibility <- matrix(1.0, nrow = n_demo_grps, ncol = ncol(susceptibility)) | ||
p_susceptibility <- p_susceptibility / rowSums(p_susceptibility) |