/
options.R
366 lines (302 loc) · 11.2 KB
/
options.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
# Default chdir is null and will be set at the first call of the function
OPTS_SLURM <- new.env(parent = emptyenv())
OPTS_R <- new.env(parent = emptyenv())
OPTS_PREAMBLE <- new.env(parent = emptyenv())
.opts_slurmR <- function() {
rm(list = ls(envir = OPTS_SLURM, all.names = TRUE), envir = OPTS_SLURM)
rm(list = ls(envir = OPTS_R, all.names = TRUE), envir = OPTS_R)
rm(list = ls(envir = OPTS_PREAMBLE, all.names = TRUE), envir = OPTS_PREAMBLE)
OPTS_R$tmp_path <- NULL
OPTS_SLURM$`job-name` <- NULL
OPTS_R$debug <- FALSE
OPTS_R$cmd <- "sbatch"
OPTS_R$verbose <- FALSE
OPTS_PREAMBLE$dat <- NULL
# JOB PATH -------------------------------------------------------------------
# Function to set job path
set_tmp_path <- function(path = Sys.getenv("SLURMR_TMP_PATH", getwd())) {
if (is.null(path))
path <- Sys.getenv("SLURMR_TMP_PATH", getwd())
# Path normalization and assignment
path <- normalizePath(path)
OPTS_R$tmp_path <- path
invisible()
}
# Function to get the path
get_tmp_path <- function() {
if (!length(OPTS_R$tmp_path))
OPTS_R$tmp_path <- "" # getwd()
OPTS_R$tmp_path
}
attr(set_tmp_path, "desc") <- "Sets the tempfile path for I/O"
attr(get_tmp_path, "desc") <- "Retrieves tempfile path for I/O"
# JOB NAME -------------------------------------------------------------------
set_job_name <- function(name) {
if (!length(name))
stop("The `name` cannot be NULL", call. = FALSE)
else if (name == "")
stop(
"`name` must be a meaningful name. Cannot be \"\" (empty).",
call. = FALSE
)
fn <- sprintf("%s/%s", get_tmp_path(), name)
OPTS_SLURM$`job-name` <- name
invisible()
}
get_job_name <- function(check = TRUE) {
if (!length(OPTS_SLURM$`job-name`))
OPTS_SLURM$`job-name` <- random_job_name()
OPTS_SLURM$`job-name`
}
attr(set_job_name, "desc") <- paste(
"Changes the job-name. When changing the name of the job the function will",
"check whether the folder chdir/job-name is empty or not. If empty/not",
"created it will create it, otherwise it will delete its contents (if",
"`overwrite = TRUE``, else it will return with an Error).")
attr(get_job_name, "desc") <- "Returns the current value of `job-name`."
# Generalized set/get function -----------------------------------------------
set_opts <- function(...) {
dots <- list(...)
# Checking if one or more have already set
test <- names(dots)[which(names(dots) %in% c('job-name', "chdir"))]
if (length(test))
warning("The following options can be set via `opts_slurmR$set_*`: `",
paste0(test, collapse="`, `"), "`.", call. = FALSE)
Map(
function(x., value.) {
if (!length(value.))
rm(list = x., envir = OPTS_SLURM)
else
assign(x=x., value=value., envir = OPTS_SLURM)
},
x. = names(dots), value. = unname(dots)
)
invisible()
}
# Getting Slurm options
get_opts_job <- function(...) {
dots <- list(...)
opts <- as.list(OPTS_SLURM)
opts <- opts[!sapply(opts, is.null)]
if (!length(dots)) {
return(opts)
}
dots <- unlist(dots)
if (any(!is.character(dots)))
stop("`...` only receives characters.", call. = FALSE)
opts[intersect(dots, names(opts))]
}
# Getting R options
get_opts_r <- function(...) {
dots <- list(...)
if (!length(dots))
return(as.list(OPTS_R))
dots <- unlist(dots)
if (any(!is.character(dots)))
stop("`...` only receives characters.", call. = FALSE)
as.list(OPTS_R)[intersect(dots, names(OPTS_R))]
}
attr(set_opts, "desc") <- "A generic function to set options."
attr(get_opts_r, "desc") <- "A generic function to retrieve options in R."
attr(get_opts_job, "desc") <- "A generic function to retrieve options for the job (Slurm)."
get_preamble <- function() {
return(OPTS_PREAMBLE$dat)
}
set_preamble <- function(...) {
OPTS_PREAMBLE$dat <- c(OPTS_PREAMBLE$dat, unlist(list(...)))
invisible()
}
attr(set_preamble, "desc") <- paste(
"Sets \"preamble\" to the RScript call. For example, it could be used for loading",
"modules, setting env variables, etc., needed during the R session. Options are",
"passed as characters."
)
attr(get_preamble, "desc") <- paste(
"Returns the preamble, e.g., module loads, environment variable definitions, etc.,",
"that will be included in sbatch submissions."
)
# Debugging and Verbose ------------------------------------------------------
debug_on <- function() {
OPTS_R$debug <- TRUE
OPTS_R$cmd <- "sh"
OPTS_R$verbose <- TRUE
message("Debug mode is now active. Which means that jobs will be called via",
" `sh` and not `sbatch`. You can de-activate debug mode by calling",
" opts_slurmR$debug_off(). Notice that only 1/njobs will be submitted",
", so not all the data will be processed.")
invisible()
}
debug_off <- function() {
OPTS_R$debug <- FALSE
OPTS_R$cmd <- "sbatch"
OPTS_R$verbose <- FALSE
invisible()
}
verbose_on <- function() {
OPTS_R$verbose <- TRUE
invisible()
}
verbose_off <- function() {
OPTS_R$verbose <- FALSE
invisible()
}
attr(debug_on, "desc") <- paste(
"Activates the debugging mode. When active, jobs will be submitted using sh",
"and not sbatch. Also, only a single chunk of the data will be processed."
)
attr(debug_off, "desc") <- "Deactivates the debugging mode."
attr(verbose_on, "desc") <- paste(
"Deactivates the verbose mode. When ON, sbatch prints the Rscript and batch",
"files on screen so that the user knows what will be submitted to Slurm.")
attr(verbose_off, "desc") <- "Deactivates the verbose mode."
# Final structure ------------------------------------------------------------
structure(list2env(
list(
set_tmp_path = set_tmp_path,
get_tmp_path = get_tmp_path,
set_job_name = set_job_name,
get_job_name = get_job_name,
set_opts = set_opts,
get_opts_job = get_opts_job,
get_opts_r = get_opts_r,
set_preamble = set_preamble,
get_preamble = get_preamble,
debug_on = debug_on,
debug_off = debug_off,
get_debug = structure(
function() OPTS_R$debug, desc="Returns TRUE of debug mode is on"),
verbose_on = verbose_on,
verbose_off = verbose_off,
get_verbose = structure(
function() OPTS_R$verbose, desc="Returns TRUE if verbose mode is on."),
get_cmd = structure(
function() OPTS_R$cmd,
desc = "If debug mode is active, then it returns `sh`, otherwise `sbatch`"
),
reset = structure(
function() {
.opts_slurmR()
opts_slurmR$set_tmp_path()
invisible()
},
desc = "Resets the options to the original state."
)
)
), class = "opts_slurmR")
}
#' Get and set default options for `sbatch` and `slurmR` internals
#'
#' Most of the functions in the `slurmR` package use `tmp_path` and `job-name`
#' options to write and submit jobs to **Slurm**. These options have global
#' defaults that are set and retrieved using `opts_slurmR`. These options
#' also include SBATCH options and things to do before calling RScript,
#' e.g., loading modules on an HPC cluster.
#'
#' Whatever the path specified on `tmp_path`, all nodes should have access to it.
#' Moreover, it is recommended to use a path located in a high-performing drive.
#' See for example [disk staging](https://en.wikipedia.org/w/index.php?title=Disk_staging&oldid=908353920).
#'
#' The `tmp_path` directory is only created at the time that one of the functions
#' needs to I/O files. Job creation calls like [Slurm_EvalQ] and [Slurm_lapply]
#' do such.
#'
#' The "preamble" options can be specified if, for example, the current cluster
#' needs to load R, a compiler, or other programs via a `module` command.
#'
#' @details Current supported options are:
#'
#' Debugging mode
#'
#' - `debug_on : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$debug_on, "desc")}
#'
#' - `debug_off : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$debug_off, "desc")}
#'
#' - `get_debug : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_debug, "desc")}
#'
#' Verbose mode
#'
#' - `verbose_on : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$verbose_on, "desc")}
#'
#' - `verbose_off : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$verbose_off, "desc")}
#'
#' - `get_verbose : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_verbose, "desc")}
#'
#' Slurm options
#'
#' - `set_tmp_path : function (path, recursive = TRUE)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$set_tmp_path, "desc")}
#'
#' - `get_tmp_path : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_tmp_path, "desc")}
#'
#' - `set_job_name : function (path, check = TRUE, overwrite = TRUE)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$set_job_name, "desc")}.
#'
#' - `get_job_name : function (check = TRUE)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_job_name, "desc")}
#'
#' - `set_preamble : function (...)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$set_preamble, "desc")}
#'
#' - `get_preamble : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_preamble, "desc")}
#'
#'
#' Other options
#'
#' - `get_cmd : function ()` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_cmd, "desc")}
#'
#' For general set/retrieve options
#'
#' - `set_opts : function (...)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$set_opts, "desc")}
#'
#' - `get_opts_job : function (...)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_opts_job, "desc")}
#'
#' - `get_opts_r : function (...)` \Sexpr[stage=build]{attr(slurmR::opts_slurmR$get_opts_r, "desc")}
#'
#'
#' Nuke
#'
#' - While reloading the package should reset all the options, if needed, the user
#' can also use the function `opts_slurmR$reset()`.
#'
#' @examples
#'
#' # Common setup
#' \dontrun{
#' opts_slurmR$set_tmp_path("/staging/pdt/vegayon")
#' opts_slurmR$set_job_name("simulations-1")
#' opts_slurm$set_opts(partition="thomas", account="lc_pdt")
#' opts_slurm$set_preamble("module load gcc")# if needed
#' }
#'
#' @export
opts_slurmR <- .opts_slurmR()
#' Fill options for slurm using slurmr's defaults (if any)
#' @noRd
#'
coalesce_slurm_options <- function(x, y = opts_slurmR$get_opts_job()) {
for (i in names(y)) {
if (i %in% names(x))
next
x[[i]] <- y[[i]]
}
return(x)
}
#' @export
print.opts_slurmR <- function(x, ...) {
options_printer <- function(x) {
cat(sprintf(" %-12s: %s", names(x), as.character(x)), sep="\n")
}
cat("\nOptions for sbatch (Slurm workflow):\n")
options_printer(x$get_opts_job())
cat("\nPreamble:\n")
if (length(x$get_preamble())) {
cat(paste(" ", x$get_preamble(), collapse="\n"), "\n")
} else {
cat(" n/a\n")
}
cat("\nOther options (R workflow):\n")
options_printer(x$get_opts_r())
cat("\nTo get and set options for Slurm jobs creation use (see ?opts_slurmR):\n\n")
print(utils::ls.str(x))
if(x$get_debug())
cat("Debugging mode is currently active, which means that `sbatch` will use `sh`",
" instead (to deactivate it use opts_slurmR$debug_off()).\n")
else cat("\n")
invisible(x)
}