Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

V2.5.x #47

Merged
merged 5 commits into from
Oct 25, 2024
Merged

V2.5.x #47

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
12a155b
fix futures
AdrienLeGuillou Oct 23, 2024
388a248
fix merge scenarios locally as well
AdrienLeGuillou Oct 23, 2024
8f952fe
add ellipsis to netsim_scenario for compat
AdrienLeGuillou Oct 25, 2024
d043915
fix save_pattern swf
AdrienLeGuillou Oct 25, 2024
87cc3d7
update docs
AdrienLeGuillou Oct 25, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: EpiModelHPC
Version: 2.2.0
Date: 2023-11-10
Version: 2.5.0
Date: 2024-10-18
Title: EpiModel Extensions for High-Performance Computing
Description: Extension package to EpiModel to run large-scale stochastic network
models on modern high-performance computing systems. Functionality provided to
Expand All @@ -16,7 +16,7 @@ URL: http://epimodel.org/, http://epimodel.github.io/EpiModelHPC/
BugReports: https://github.com/EpiModel/EpiModelHPC/issues
Depends:
R (>= 4.1),
EpiModel (>= 2.2.0)
EpiModel (>= 2.5.0)
Imports:
dplyr,
tidyr,
Expand All @@ -42,6 +42,6 @@ Remotes:
github::EpiModel/slurmworkflow,
github::EpiModel/swfcalib
VignetteBuilder: knitr
RoxygenNote: 7.2.3
RoxygenNote: 7.3.2
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
3 changes: 1 addition & 2 deletions R/EpiModelHPC-package.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,6 @@
#' @importFrom utils read.table read.csv write.csv
#' @importFrom stringr str_pad
#' @importFrom rlang .data
#' @docType package
#' @keywords package
#'
NULL
"_PACKAGE"
94 changes: 23 additions & 71 deletions R/netsim_scenarios.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,12 @@
step_tmpl_netsim_scenarios <- function(path_to_x, param, init, control,
scenarios_list, n_rep, n_cores,
output_dir, libraries = NULL,
save_pattern = "simple",
setup_lines = NULL,
max_array_size = NULL) {
max_array_size = NULL, ...) {
p_list <- netsim_scenarios_setup(
path_to_x, param, init, control,
scenarios_list, n_rep, n_cores,
output_dir, libraries, save_pattern
output_dir, libraries
)

slurmworkflow::step_tmpl_map(
Expand Down Expand Up @@ -51,20 +50,19 @@ step_tmpl_netsim_scenarios <- function(path_to_x, param, init, control,
#'
#' @param scenarios_list A list of scenarios to be run. Produced by the
#' \code{EpiModel::create_scenario_list} function
#' @param ... for compatibility reasons
#'
#' @inheritParams netsim_run_one_scenario
#' @inheritParams make_save_elements
#' @inheritSection netsim_run_one_scenario Checkpointing
#'
#' @export
netsim_scenarios <- function(path_to_x, param, init, control,
scenarios_list, n_rep, n_cores,
output_dir, libraries = NULL,
save_pattern = "simple") {
output_dir, libraries = NULL, ...) {
p_list <- netsim_scenarios_setup(
path_to_x, param, init, control,
scenarios_list, n_rep, n_cores,
output_dir, libraries, save_pattern
output_dir, libraries
)

for (i in seq_along(p_list$scenarios_list)) {
Expand All @@ -81,7 +79,7 @@ netsim_scenarios <- function(path_to_x, param, init, control,
#' @return a list of arguments for `netsim_run_one_scenario`
netsim_scenarios_setup <- function(path_to_x, param, init, control,
scenarios_list, n_rep, n_cores,
output_dir, libraries, save_pattern) {
output_dir, libraries) {
libraries <- c("slurmworkflow", "EpiModelHPC", libraries)
if (is.null(scenarios_list)) {
scenarios_list <- data.frame(.at = 0, .scenario.id = "empty_scenario")
Expand All @@ -92,10 +90,6 @@ netsim_scenarios_setup <- function(path_to_x, param, init, control,
batchs_list <- rep(seq_len(n_batch), length(scenarios_list))
scenarios_list <- rep(scenarios_list, each = n_batch)

raw_output <- !is.null(control[["raw.output"]]) && control[["raw.output"]]
save_all <- "all" %in% save_pattern || raw_output
save_elts <- if (save_all) character() else make_save_elements(save_pattern)

list(
scenarios_list = scenarios_list,
batchs_list = batchs_list,
Expand All @@ -108,45 +102,11 @@ netsim_scenarios_setup <- function(path_to_x, param, init, control,
output_dir = output_dir,
n_batch = n_batch,
n_rep = n_rep,
n_cores = n_cores,
save_all = save_all,
save_elements = save_elts
n_cores = n_cores
)
)
}

#' Create the `save_elements` vector for `netsim_run_one_scenario`
#'
#' Helper function to create the `save_elements` character vector according to
#' the `save_pattern`.
#'
#' @param save_pattern A character vector of what should be kept in the final
#' `netsim` objects. It can contain the names of the elements as well as:
#' "simple" (defautlt) to only keep "epi", "param" and "control"; "restart" to
#' get the elements required to restart from such file; "all" to not trim the
#' object at all. `c("simple", "el.cuml")` is an example of a valid pattern to
#' save "epi", "param", "control" and "el.cuml". If `control$raw.output` is
#' `TRUE`, this parameter has no effect and the full result is saved.
make_save_elements <- function(save_pattern) {
save_elements <- save_pattern
if ("simple" %in% save_pattern) {
save_elements <- union(save_elements, c("param", "epi", "control"))
save_elements <- setdiff(save_elements, "simple")
}
if ("restart" %in% save_pattern) {
need_restart <- c(
"param", "control", "epi",
"nwparam", "attr", "temp", "net_attr",
"el", "el.cuml", "_last_unique_id",
"coef.form", "num.nw", "el", "network"
)
save_elements <- union(save_elements, need_restart)
save_elements <- setdiff(save_elements, "restart")
}

save_elements
}

#' Run one `netsim` call with a scenario and saves the results deterministically
#'
#' This inner function is called by `netsim_scenarios` and
Expand All @@ -163,10 +123,6 @@ make_save_elements <- function(save_pattern) {
#' @param output_dir The folder where the simulation files are to be stored.
#' @param libraries A character vector containing the name of the libraries
#' required for the model to run. (e.g. EpiModelHIV or EpiModelCOVID)
#' @param save_all A flag instructing to save the result of the
#' `EpiModel::netsim` call as is if TRUE.
#' @param save_elements A character vector of elements to keep from the
#' `netsim` object if `save_all` is `FALSE`
#' @inheritParams EpiModel::netsim
#'
#' @section Checkpointing:
Expand All @@ -176,8 +132,7 @@ make_save_elements <- function(save_pattern) {
netsim_run_one_scenario <- function(scenario, batch_num,
path_to_x, param, init, control,
libraries, output_dir,
n_batch, n_rep, n_cores,
save_all, save_elements) {
n_batch, n_rep, n_cores) {
est <- readRDS(path_to_x)
start_time <- Sys.time()
lapply(libraries, function(l) library(l, character.only = TRUE))
Expand All @@ -203,16 +158,6 @@ netsim_run_one_scenario <- function(scenario, batch_num,
print(paste0("Batch number: ", batch_num, " / ", n_batch))
sim <- EpiModel::netsim(est, param_sc, init, control)

if (!save_all) {
print(paste0(
"Triming simulation in file to keep only: `",
paste0(save_elements, collapse = "`, `"),
"`"
))
remove_elts <- setdiff(names(sim), save_elements)
sim[remove_elts] <- NULL
}

file_name <- paste0("sim__", scenario[["id"]], "__", batch_num, ".rds")
print(paste0("Saving simulation in file: ", file_name))
saveRDS(sim, fs::path(output_dir, file_name))
Expand Down Expand Up @@ -272,8 +217,10 @@ merge_netsim_scenarios <- function(sim_dir, output_dir,
truncate.at = NULL) {

if (!fs::dir_exists(output_dir)) fs::dir_create(output_dir)
batches_infos <- EpiModelHPC::get_scenarios_batches_infos(sim_dir)
batches_infos <- get_scenarios_batches_infos(sim_dir)

oopts <- options(future.globals.maxSize = Inf)
on.exit(options(oopts))
future.apply::future_lapply(
unique(batches_infos$scenario_name),
function(scenario) {
Expand Down Expand Up @@ -307,7 +254,8 @@ merge_netsim_scenarios <- function(sim_dir, output_dir,
fs::path(output_dir, paste0("merged__", scenario, ".rds"))
)
}
})
}
)
}

#' Step Template to Create a Single Sim File per Scenarios Using the Files From
Expand Down Expand Up @@ -336,8 +284,6 @@ step_tmpl_merge_netsim_scenarios <- function(sim_dir, output_dir,
keep.nwstats, keep.other, param.error, keep.diss.stats,
truncate.at, n_cores) {
future::plan("multicore", workers = n_cores)
oopts <- options(future.globals.maxSize = Inf)
on.exit(options(oopts))
EpiModelHPC::merge_netsim_scenarios(
sim_dir, output_dir,
keep.transmat, keep.network, keep.nwstats, keep.other, keep.diss.stats,
Expand Down Expand Up @@ -372,14 +318,16 @@ merge_netsim_scenarios_tibble <- function(sim_dir, output_dir, steps_to_keep,
cols = dplyr::everything()) {
expr <- rlang::enquo(cols)
if (!fs::dir_exists(output_dir)) fs::dir_create(output_dir)
batches_infos <- EpiModelHPC::get_scenarios_batches_infos(sim_dir)
batches_infos <- get_scenarios_batches_infos(sim_dir)

for (scenario in unique(batches_infos$scenario_name)) {
scenario_infos <- dplyr::filter(
batches_infos,
.data$scenario_name == scenario
)

oopts <- options(future.globals.maxSize = Inf)
on.exit(options(oopts))
df_list <- future.apply::future_lapply(
seq_len(nrow(scenario_infos)),
function(i) {
Expand Down Expand Up @@ -422,8 +370,6 @@ step_tmpl_merge_netsim_scenarios_tibble <- function(
setup_lines = NULL) {
merge_fun <- function(sim_dir, output_dir, steps_to_keep, cols, n_cores) {
future::plan("multicore", workers = n_cores)
oopts <- options(future.globals.maxSize = Inf)
on.exit(options(oopts))
EpiModelHPC::merge_netsim_scenarios_tibble(
sim_dir = sim_dir,
output_dir = output_dir,
Expand All @@ -434,7 +380,13 @@ step_tmpl_merge_netsim_scenarios_tibble <- function(

slurmworkflow::step_tmpl_do_call(
what = merge_fun,
args = list(sim_dir, output_dir, steps_to_keep, rlang::enquo(cols), n_cores),
args = list(
sim_dir,
output_dir,
steps_to_keep,
rlang::enquo(cols),
n_cores
),
setup_lines = setup_lines
)
}
Expand Down
23 changes: 12 additions & 11 deletions R/swfcalib_helpers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,11 @@
netsim_run_swfcalib_scenario <- function(calib_object, batch_num,
path_to_x, param, init, control,
libraries, output_dir,
n_batch, n_rep, n_cores,
save_all, save_elements) {
n_batch, n_rep, n_cores) {
scenario <- make_calibrated_scenario(calib_object)
netsim_run_one_scenario(
scenario, batch_num, path_to_x, param, init, control,
libraries, output_dir, n_batch, n_rep, n_cores, save_all, save_elements
libraries, output_dir, n_batch, n_rep, n_cores
)
}

Expand All @@ -30,12 +29,12 @@ make_calibrated_scenario <- function(calib_object) {
#' @inheritParams netsim_scenarios_setup
netsim_swfcalib_output_setup <- function(path_to_x, param, init, control,
calib_object, n_rep, n_cores,
output_dir, libraries, save_pattern) {
output_dir, libraries) {
scenarios_list <- NULL
p_list <- netsim_scenarios_setup(
path_to_x, param, init, control,
scenarios_list, n_rep, n_cores,
output_dir, libraries, save_pattern
output_dir, libraries
)
p_list$scenarios_list <- NULL
p_list$MoreArgs$calib_object <- calib_object
Expand All @@ -55,13 +54,12 @@ netsim_swfcalib_output_setup <- function(path_to_x, param, init, control,
step_tmpl_netsim_swfcalib_output <- function(path_to_x, param, init, control,
calib_object, n_rep, n_cores,
output_dir, libraries = NULL,
save_pattern = "restart",
setup_lines = NULL,
max_array_size = NULL) {
p_list <- netsim_swfcalib_output_setup(
path_to_x, param, init, control,
calib_object, n_rep, n_cores,
output_dir, libraries, save_pattern
output_dir, libraries
)

slurmworkflow::step_tmpl_map(
Expand All @@ -85,18 +83,21 @@ step_tmpl_netsim_swfcalib_output <- function(path_to_x, param, init, control,
#' @export
netsim_swfcalib_output <- function(path_to_x, param, init, control,
calib_object, n_rep, n_cores,
output_dir, libraries = NULL,
save_pattern = "simple") {
output_dir, libraries = NULL) {
p_list <- netsim_swfcalib_output_setup(
path_to_x, param, init, control,
calib_object, n_rep, n_cores,
output_dir, libraries, save_pattern
output_dir, libraries
)

for (i in seq_along(p_list$batchs_list)) {
args <- list(p_list$batchs_list[[i]])
args <- c(args, p_list$MoreArgs)
callr::r(do.call, args = list(netsim_run_swfcalib_scenario, args), show = TRUE)
callr::r(
do.call,
args = list(netsim_run_swfcalib_scenario, args),
show = TRUE
)
}
}

Expand Down
13 changes: 13 additions & 0 deletions man/EpiModelHPC-package.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

21 changes: 0 additions & 21 deletions man/make_save_elements.Rd
View file
Open in desktop

This file was deleted.

10 changes: 1 addition & 9 deletions man/netsim_run_one_scenario.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
Loading