init starting to pull out helper functions from misc project areas

Author: dpastoor

.Rbuildignore

@@ -0,0 +1,3 @@
+^slurmtools\.Rproj$
+^\.Rproj\.user$
+^LICENSE\.md$

.gitignore

@@ -0,0 +1 @@
+.Rproj.user

DESCRIPTION

@@ -0,0 +1,16 @@
+Package: slurmtools
+Title: slurm tooling 
+Version: 0.0.0.9000
+Authors@R: 
+    person("Devin", "Pastoor", , "[email protected]", role = c("aut", "cre"))
+Description: What the package does (one paragraph).
+License: GPL (>= 3)
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+Imports: 
+    brio,
+    fs,
+    processx,
+    rlang,
+    whisker

LICENSE.md

@@ -0,0 +1,4 @@
+# Generated by roxygen2: do not edit by hand
+
+export(get_slurm_partitions)
+export(submit_nonmem_model)

NAMESPACE

@@ -0,0 +1,30 @@
+# this will take the raw string and return the partitions such that the default one will be first
+# and will have the asterisk removed
+process_slurm_partitions <- function(ps){
+  partitions <- strsplit(ps, "\n")[[1]]
+  all_partitions <- gsub("'", "", partitions)
+  is_default_partition <- grepl('\\*$', x = all_partitions, )
+  default_partition <- gsub(x = all_partitions[is_default_partition], pattern = "\\*$", replacement = "")
+  # delete the default partition then lets put it at the beginning so it can be selected that way
+  all_partitions <- all_partitions[-is_default_partition]
+  c(default_partition, all_partitions)
+}
+
+#' get slurm partitions for the given cluster
+#' @export
+get_slurm_partitions <- function() {
+  sinfobin <- Sys.which("sinfo")
+  if (!nzchar(sinfobin)) {
+    rlang::abort("could not find sinfo binary")
+  }
+  res <- processx::run(sinfobin, c("--format='%P'", "--noheader"), )
+  if (res$status != 0) {
+    stderrout <- sprintf("failed to get partition info with info: \n\n stdout: %s\n\n stderr: %s", res$stdout, res$stderr)
+    rlang::abort(stderrout)
+  }
+  # this will be a line separated list of partitions with an extra * for the default partition
+  # for example it'll look something like
+  # "'cpu2mem4gb*'\n'cpu4mem32gb'\n'cpu8mem64gb'\n'cpu2mem8gb'\n'cpu4mem16gb'\n'cpu16mem128gb'\n'cpu8mem32gb'\n'cpu16mem64gb'\n'cpu32mem128gb'\n"
+  process_slurm_partitions(res$stdout)
+}
+

R/get-partitions.R

@@ -0,0 +1,85 @@
+#' submit a nonmem model to slurm in parallel
+#' @param .mod a path to a model or a bbi nonmem model object
+#' @param partition name of the partition to submit the model
+#' @param ncpu number of cpus to run the model against
+#' @param overwrite whether to overwrite existing model results
+#' @param dry_run return the command that would have been invoked, without invoking
+#' @param ... arguments to pass to processx::run
+#' @param slurm_job_template_path path to slurm job template
+#' @param submission_root directory to track job submission scripts and output
+#' @param bbi_config_path path to bbi config file
+#' @export
+submit_nonmem_model <-
+  function(.mod,
+           partition = getOption('slurmtools.partitions'),
+           ncpu = 4,
+           overwrite = FALSE,
+           dry_run = FALSE,
+           ...,
+           slurm_job_template_path = getOption('slurmtools.slurm_job_template_path'),
+           submission_root = getOption('slurmtools.submission_root'),
+           bbi_config_path = getOption('slurmtools.bbi_config_path'),
+           slurm_template_opts = list()) {
+    if (is.null(partition)) {
+      rlang::abort("no partition selected")
+    }
+    partition <- match.arg(partition)
+    if (!inherits(.mod, "bbi_nonmem_model") &&
+        !fs::file_exists(.mod)) {
+      stop(
+        "please provide a bbi_nonmem_model created via read_model/new_model, or a path to the model file"
+      )
+    }
+    if (!inherits(.mod, "bbi_nonmem_model")) {
+      # its a file path that exists so lets convert that into the structure bbi
+      # provides for now
+      .mod <- list(absolute_model_path = fs::path_abs(.mod))
+    }
+    parallel <- if (ncpu > 1) {
+      TRUE
+    } else {
+      FALSE
+    }
+
+    if (!fs::is_absolute_path(bbi_config_path)) {
+      rlang::abort(sprintf("bbi_config_path must be absolute, not %s", bbi_config_path))
+    }
+    if (!fs::file_exists(slurm_job_template_path)) {
+      rlang::abort(sprintf("slurm job template path not valid: `%s`", slurm_job_template_path))
+    }
+    if (overwrite && fs::dir_exists(.mod$absolute_model_path)) {
+      fs::dir_delete(.mod$absolute_model_path)
+    }
+    template_script <-
+      withr::with_dir(dirname(.mod$absolute_model_path), {
+        tmpl <- brio::read_file(slurm_job_template_path)
+        whisker::whisker.render(
+          tmpl,
+          list(
+            partition = partition,
+            parallel = parallel,
+            ncpu = ncpu,
+            job_name = sprintf("nonmem-run-%s", basename(.mod$absolute_model_path)),
+            bbi_exe_path = Sys.which("bbi"),
+            bbi_config_path = bbi_config_path,
+            model_path = .mod$absolute_model_path
+          )
+        )
+      })
+    script_file_path <-
+        file.path(submission_root, sprintf("%s.sh", basename(.mod$absolute_model_path)))
+    if (!dry_run) {
+      if (!fs::dir_exists(submission_root)) {
+        fs::dir_create(submission_root)
+      }
+      brio::write_file(template_script, script_file_path)
+      fs::file_chmod(script_file_path, "0755")
+    }
+    cmd <- list(cmd = "sbatch", args = script_file_path, template_script = template_script, partition = partition)
+    if (dry_run) {
+      return(cmd)
+    }
+    withr::with_dir(submission_root, {
+      processx::run(cmd$cmd, cmd$args, ...)
+    })
+  }

R/submit-model.R

@@ -0,0 +1,22 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+LineEndingConversion: Posix
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace