Threading

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: treepplr
 Title: R Interface to TreePPL
-Version: 0.14.0
+Version: 0.15.0
 Authors@R: 
     person("Mariana", "P Braga", , "mpiresbr@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-1253-2536"))
@@ -16,6 +16,7 @@ Depends:
 Imports: 
     assertthat,
     digest,
+    future,
     methods,
     jsonlite,
     tidytree,

NAMESPACE

@@ -2,6 +2,8 @@
 
 export(TPPLC_VERSION)
 export(tp_compile)
+export(tp_compile_methods)
+export(tp_compile_options)
 export(tp_data)
 export(tp_installing_treeppl)
 export(tp_json_to_phylo)
@@ -13,6 +15,7 @@ export(tp_parse_mcmc)
 export(tp_parse_smc)
 export(tp_phylo_to_tpjson)
 export(tp_run)
+export(tp_runtime_options)
 export(tp_smc_convergence)
 export(tp_tempdir)
 export(tp_treeppl_json)

R/data.R

@@ -2,6 +2,7 @@
 
 
 
+
 #' Import data for TreePPL program
 #'
 #' @description

R/model.R

@@ -17,11 +17,12 @@ tpplcCompileOptions <- c(
   "static-delay"
 )
 
-#' Options that can be passed to TreePPL compiler
+#' Methods to [treepplr::tp_compile()]
 #'
-#' @returns A data frame with the output from the compiler's help <tpplc --help>
+#' @returns  A data frame with methods that can be passed to [treepplr::tp_compile()]
 #'
-tp_compile_options <- function() {
+#' @export
+tp_compile_methods <- function() {
   tpplc_path <- tp_installing_treeppl()
   # treeppl options
   cmd_opt <- system2(
@@ -33,11 +34,63 @@ tp_compile_options <- function() {
 
   # Preparing the output #
 
-  # find the line containing "Options:"
-  x <- which(cmd_opt == "Options:")
+  # find the line between str_begin and str_end
+  x <- which(cmd_opt == "Inference methods:")
+
   # extract everything after that line
   cmd_opt <- cmd_opt[(x + 1):length(cmd_opt)]
   cmd_opt <- trimws(cmd_opt)
+  cmd_opt <- strsplit(cmd_opt, " ", perl = TRUE)
+
+
+  opt_tab <- do.call(rbind, lapply(cmd_opt, function(x) {
+    # if there is no description, make it NA
+    data.frame(
+      argument = x[2],
+      description = trimws(paste(x[-2:-1], collapse = " ")),
+      stringsAsFactors = FALSE
+    )
+  }))
+
+  return(opt_tab)
+}
+
+#' Options to [treepplr::tp_compile()]
+#'
+#' @returns  A data frame with options that can be passed to [treepplr::tp_compile()]
+#'
+#' @export
+tp_compile_options <- function() {
+  tp_find_options("Compile options:", "Runtime options:")
+}
+
+#' Options to [treepplr::tp_run()]
+#'
+#' @returns  A data frame with options that can be passed to [treepplr::tp_run()]
+#'
+#' @export
+tp_runtime_options <- function() {
+  tp_find_options("Runtime options:", "Inference methods:")
+}
+
+tp_find_options <- function(str_begin, str_end) {
+  tpplc_path <- tp_installing_treeppl()
+  # treeppl options
+  cmd_opt <- system2(
+    command = tpplc_path,
+    args = "--help",
+    env = "LD_LIBRARY_PATH= ",
+    stdout = TRUE
+  )
+
+  # Preparing the output #
+
+  # find the line between str_begin and str_end
+  x <- which(cmd_opt == str_begin)
+  y <- which(cmd_opt == str_end)
+  # extract everything after that line
+  cmd_opt <- cmd_opt[(x + 1):(y - 2)]
+  cmd_opt <- trimws(cmd_opt)
   cmd_opt <- strsplit(cmd_opt, " {2,}", perl = TRUE)
 
   opt_tab <- do.call(rbind, lapply(cmd_opt, function(x) {
@@ -73,19 +126,18 @@ list_to_options <- function(user_list) {
   options
 }
 
-#' Convert options to a proper string of flags, e.g., `_` to `-`,
-#' adding `--` in the beginning, spaces between things, etc.
+#Convert options to a proper string of flags, e.g., `_` to `-`,
+#adding `--` in the beginning, spaces between things, etc.
 options_to_string <- function(options) {
   args_str <- c()
   if (length(options) != 0) {
     vec <- c()
-    args_vec <- unlist(options)
-    for (i in seq_along(args_vec)) {
-      if (!is.logical(args_vec[[i]])) {
-        str <- paste0("--", names(args_vec[i]), " ", args_vec[[i]])
+    for (i in seq_along(options)) {
+      if (!is.logical(options[[i]])) {
+        str <- paste0("--", names(options[i]), " ", options[[i]])
       } else {
-        if (args_vec[[i]]) {
-          str <- paste0("--", names(args_vec[i]))
+        if (options[[i]]) {
+          str <- paste0("--", names(options[i]))
         }
       }
       vec <- c(vec, str)
@@ -98,15 +150,15 @@ options_to_string <- function(options) {
 #' TreePPL model template
 #'
 #' @description
-#' `tp_modelT` template for TreePPL code carrying all the informations necessary
+#' `sampler_T` template for TreePPL code carrying all the informations necessary
 #' for compiling and running this model efficently
 
-compiled_model_Template <-
-  setRefClass(
-    "compiled_model_Template",
+sampler_T <-
+  methods::setRefClass(
+    "sampler_T",
     fields = list(
       exe_path = "character",
-      path = "character",
+      model_path = "character",
       compile_options = "list"
     )
   )
@@ -117,20 +169,8 @@ compiled_model_Template <-
 #' `compilation` compile a TreePPL model and create inference machinery to be
 #' used by [treepplr::tp_run].
 #'
-#' @param model One of tree options:
-#'   * The full path of the model file that contains the TreePPL code, OR
-#'   * A string with the name of a model supported by treepplr
-#' (see [treepplr::tp_model_library()]), OR
-#'   * A string containing the entire TreePPL code.
-#' @param method Inference method to be used. See tp_compile_options()
-#' for all supported methods.
-#' @param iterations The number of MCMC iterations to be run.
-#' @param particles The number of SMC particles to be run.
-#' @param dir The directory where you want to save the executable. Default is
-#' [base::tempdir()]
-#' @param output Complete path to the compiled TreePPL program that will be
-#' created. Default is dir/<name of the model object>.exe
-#' @param ... See tp_compile_options() for all supported arguments.
+#' @param path [base::character] to a treppl model
+#' @param args_str [base::character] of options for treeppl compiler
 #'
 #' @return The path for the compiled TreePPL program.
 
@@ -140,13 +180,13 @@ compilation <- function(path, args_str) {
   dir_path <- tp_tempdir()
 
   # output
-  output_path <- paste0(dir_path, digest::digest(paste(path,args_str), "sha256"), ".exe")
+  output_path <- paste0(dir_path, digest::digest(paste(path, args_str), "sha256"), ".exe")
 
-  options <- paste("--output", output_path, args_str)
+  options <- paste(args_str, "--output", output_path)
 
   # Preparing the command line program
   tpplc_path <- tp_installing_treeppl()
-  command <- paste(tpplc_path, path, options)
+  command <- paste(tpplc_path, options, path)
 
   # Compile program
   # Empty LD_LIBRARY_PATH from R_env for this command specifically
@@ -167,7 +207,6 @@ compilation <- function(path, args_str) {
 #' @export
 #'
 tp_write_model <- function(model, model_file_name = "tmp_model_file") {
-
   path <- paste0(tp_tempdir(), model_file_name, ".tppl")
   cat(model, file = path)
 
@@ -177,16 +216,19 @@ tp_write_model <- function(model, model_file_name = "tmp_model_file") {
 #' Create a TreePPL model
 #'
 #' @description
-#' `tp_compile` takes TreePPL model and prepares it to be used by
+#' `tp_compile` takes TreePPL model and create a sampler to be used by
 #' [treepplr::tp_run()].
 #'
 #' @param model One of tree options:
 #'   * The full path of the model file that contains the TreePPL code, OR
 #'   * A string with the name of a model supported by treepplr
 #' (see [treepplr::tp_model_library()]), OR
 #'   * A string containing the entire TreePPL code.
+#' @param method Inference method to be used. See [treepplr::tp_compile_methods()]
+#' for all supported methods.
+#' @param ... See [treepplr::tp_compile_options()] for all supported arguments.
 #'
-#' @return compiled_model from a compiled_model_Template
+#' @return sampler from a sampler_T
 #' @export
 
 tp_compile <- function(model, method = "mcmc", ...) {
@@ -212,12 +254,12 @@ tp_compile <- function(model, method = "mcmc", ...) {
       model_path <- tp_write_model(model)
     }
   }
-  m <- new("compiled_model_Template", path = model_path)
-  user_list <- append(tp_list(...), list(method = method))
+  sampler <- methods::new("sampler_T", model_path = model_path)
+  user_list <- append(list(method = method), tp_list(...))
   tmp <- list_to_options(user_list)
 
-  m$compile_options <- tmp[["compile"]]
+  sampler$compile_options <- tmp[["compile"]]
   full_options = append(tmp[["compile"]], tmp[["runtime"]])
-  m$exe_path <- compilation(m$path, options_to_string(full_options))
-  return(m)
+  sampler$exe_path <- compilation(sampler$model_path, options_to_string(full_options))
+  return(sampler)
 }

R/post_treatment.R

@@ -106,7 +106,7 @@ tp_parse_mcmc <- function(treeppl_out) {
 #' @param treeppl_out a character vector giving the TreePPL json output
 #' produced by [tp_run].
 #'
-#' @return A list (n = n_runs) of data frames with the output from inference
+#' @return A list (n = sweeps) of data frames with the output from inference
 #' in TreePPL under the host repertoire evolution model.
 #' @export
 

R/run.R

@@ -3,15 +3,17 @@
 #' @description
 #' Run TreePPL and return output.
 #'
-#' @param compiled_model a [base::character] with the full path to the compiled model
-#' outputted by [treepplr::tp_compile].
+#' @param sampler a [treepplr::sampler_T] outputted by [treepplr::tp_compile].
 #' @param data a [base::character] with the full path to the data file in TreePPL
 #' JSON format (as outputted by [treepplr::tp_data]).
 #' @param dir a [base::character] with the full path to the directory where you
 #' want to save the output. Default is [base::tempdir()].
 #' @param out_file_name a [base::character] with the name of the output file in
 #' JSON format. Default is "out".
-#' @param ... See [treepplr::tp_run_options] for all supported arguments.
+#' @param n_runs a [base::numeric] giving the numbers of sweeps(SMC)/runs(MCMC).
+#' @param n_processes a [base::numeric], number of parallel processes to use.
+#' Can't be superior to n_runs.
+#' @param ... See [treepplr::tp_runtime_options] for all supported arguments.
 #'
 #'
 #' @return A list of TreePPL output in parsed JSON format.
@@ -27,7 +29,7 @@
 #' data_path <- tp_data(data_input = "coin")
 #'
 #' # run TreePPL
-#' result <- tp_run(exe_path, data_path, sweeps = 2)
+#' result <- tp_run(exe_path, data_path, n_runs = 2)
 #'
 #'
 #' # When using MCMC
@@ -38,20 +40,30 @@
 #' data_path <- tp_data(data_input = "coin")
 #'
 #' # run TreePPL
-#' result <- tp_run(exe_path, data_path, n_runs = 2)
+#' result <- tp_run(exe_path, data_path)
 #' }
 
-tp_run <- function(compiled_model,
+tp_run <- function(sampler,
                    data,
                    dir = NULL,
                    out_file_name = "out",
+                   n_runs = 1,
+                   n_processes = 3,
                    ...) {
+
   if (is.null(dir)) {
     dir_path <- tp_tempdir()
   } else {
     dir_path <- dir
   }
 
+  listFiles <- list.files(path = dir_path,
+                          pattern = out_file_name,
+                          full.names = TRUE)
+  if(length(listFiles) != 0) {
+    file.remove(listFiles)
+  }
+
   output_path <- paste0(dir_path, out_file_name, ".json")
 
   #If a list have multiple time the same key
@@ -60,26 +72,42 @@ tp_run <- function(compiled_model,
   #> lis <- list(method = "mcmc", method = "smc")
   #> lis[["method"]] => "mcmc"
   # So the user list have priority
-  options <- list_to_options(tp_list(...))
+  tpplc_options <- list_to_options(tp_list(...))
 
-  if(length(options[["compile"]]) != 0) {
+  if (length(tpplc_options[["compile"]]) != 0) {
     stop("Can't give compile time options here")
   }
-
   # Empty LD_LIBRARY_PATH from R_env for this command specifically
   # due to conflict with internal env from treeppl self container
   command <- paste(
     "LD_LIBRARY_PATH= ",
-    compiled_model$exe_path,
+    sampler$exe_path,
     data,
-    options_to_string(options[["runtime"]]),
+    options_to_string(tpplc_options[["runtime"]]),
     paste(">", output_path)
   )
-  system(command)
 
-  # simple parsing
-  #### change this? ####
-  json_out <- readLines(output_path) |>
+  if (n_runs > 1) {
+    if (n_processes > n_runs) {
+      warning("n_processes reduce to be equal to n_runs.")
+      n_processes <- n_runs
+    }
+    future::plan(future::multisession, workers = n_processes)
+    future.apply::future_sapply(
+      1:n_runs,
+      FUN = function(i) {
+        system(paste0(command, i))
+      }
+    )
+  } else {
+    system(command)
+  }
+
+  listFiles <- list.files(path = dir_path,
+                          pattern = out_file_name,
+                          full.names = TRUE)
+
+  json_out <- readr::read_lines(listFiles) |>
     lapply(jsonlite::fromJSON, simplifyVector = FALSE)
 
   return(json_out)

R/utils.R

@@ -153,6 +153,7 @@ sep <- function() {
 #' @return A list of model names.
 #' @export
 tp_model_library <- function() {
+  tp_installing_treeppl()
   # make sure you get the appropriate version if you have more than one treeppl folder in the tmp
   fd <- list.files("/tmp",
                    pattern = paste0("treeppl-", TPPLC_VERSION),
@@ -194,6 +195,7 @@ tp_find <- function(model_name, ext) {
       full.names = TRUE
     )
   } else {
+    tp_installing_treeppl()
     fd <- list.files("/tmp",
                      pattern = paste0("treeppl-", TPPLC_VERSION),
                      full.names = TRUE)