TreePPL managment

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: treepplr
 Title: R Interface to TreePPL
-Version: 0.11.0
+Version: 0.12.0
 Authors@R: 
     person("Mariana", "P Braga", , "mpiresbr@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-1253-2536"))
@@ -20,9 +20,7 @@ Imports:
     jsonlite,
     tidytree,
     utils,
-    gh,
     curl,
-    cli,
     bnpsd,
     rlang,
     phangorn

NAMESPACE

@@ -3,6 +3,7 @@
 export(tp_compile)
 export(tp_data)
 export(tp_expected_input)
+export(tp_installing_treeppl)
 export(tp_json_to_phylo)
 export(tp_map_tree)
 export(tp_model)

R/compile.R

@@ -1,18 +1,70 @@
 #' Options that can be passed to TreePPL compiler
 #'
-#' @returns A string with the output from the compiler's help <tpplc --help>
+#' @returns A data frame with the output from the compiler's help <tpplc --help>
 #'
 tp_compile_options <- function() {
 
-  #### under development ####
+  # Path to self contained #
+  if (Sys.info()["sysname"] == "Windows") {
+    # No self container for Windows, need to install it manually
+    "tpplc"
+  } else if (Sys.info()["sysname"] == "Linux") {
+    path_sc <- system.file("treeppl-linux", package = "treepplr")
+  } else {
+    # Mac OS have lots of different names
+    path_sc <- system.file("treeppl-mac", package = "treepplr")
+  }
 
-  # text from tpplc --help
-  return()
+  # check if treeppl is in the tmp
+  ft <- list.files("/tmp", full.names = TRUE)
+  ff <- ft[grepl("treeppl-", ft)]
+
+  # untar to tmp
+  if (length(ff) == 0) {
+    utils::untar(
+      list.files(
+        path = path_sc,
+        full.names = TRUE
+      ),
+      exdir = "/tmp"
+    )
+  }
 
+  # keep the path (this will also work if the 'if' statement above fails)
+  ft <- list.files("/tmp", full.names = TRUE)
+  ff <- ft[grepl("treeppl-", ft)]
+
+  # command
+  path_cmd <- paste0(ff, "/tpplc")
+  # treeppl options
+  cmd_opt <- system2(command = path_cmd, args = "--help",
+                     env= "LD_LIBRARY_PATH= MCORE_LIBS=", stdout = TRUE)
+
+  # Preparing the output #
+
+  # find the line containing "Options:"
+  x <- which(cmd_opt == "Options:")
+  # extract everything after that line
+  cmd_opt <- cmd_opt[(x + 1):length(cmd_opt)]
+  cmd_opt <- trimws(cmd_opt)
+  cmd_opt <- strsplit(cmd_opt, " {2,}", perl = TRUE)
+
+  opt_tab <- do.call(rbind, lapply(cmd_opt, function(x) {
+    # if there is no description, make it NA
+    if (length(x) == 1) x <- c(x, NA)
+    data.frame(
+      argument = x[1],
+      description = x[2],
+      stringsAsFactors = FALSE
+    )
+  }))
+
+  # fix arguments (delete everything that comes after the first space)
+  opt_tab$argument <- sub(" .*", "", opt_tab$argument)
+  return(opt_tab)
 }
 
 
-
 #' Compile a TreePPL model and create inference machinery
 #'
 #' @description
@@ -93,7 +145,7 @@ tp_compile <- function(model,
   options <- paste("--output", output_path, args_str)
 
   # Preparing the command line program
-  tpplc_path <- installing_treeppl()   #### move this? ####
+  tpplc_path <- tp_installing_treeppl()   #### move this? TV : Perfect place
   command <- paste(tpplc_path, model_file_name, musts, options)
 
   # Compile program

R/run.R

@@ -60,8 +60,8 @@ tp_run_options <- function() {
 
 tp_run <- function(compiled_model,
                    data,
-                   n_runs = NULL,
-                   n_sweeps = NULL,
+                   n_runs = 1,
+                   n_sweeps = 1,
                    dir = NULL,
                    out_file_name = "out",
                    ...) {
@@ -70,15 +70,15 @@ tp_run <- function(compiled_model,
     stop("At least one of n_runs and n_sweeps needs to be passed")
   }
 
-  n_string <- ""
-  if(!is.null(n_runs)){
+  #n_string <- ""
+  #if(!is.null(n_runs)){
     #### change to --iterations when it's fixed in treeppl ####
-    n_string <- paste0(n_string, "--sweeps ", n_runs, " ")
-  }
+    #n_string <- paste0(n_string, "--sweeps ", n_runs, " ")
+  #}
 
-  if(!is.null(n_sweeps)){
-    n_string <- paste0(n_string, "--sweeps ", n_sweeps, " ")
-  }
+  #if(!is.null(n_sweeps)){
+    #n_string <- paste0(n_string, "--sweeps ", n_sweeps, " ")
+  #}
 
   if(is.null(dir)){
     dir_path <- tp_tempdir()
@@ -93,7 +93,7 @@ tp_run <- function(compiled_model,
   command <- paste("LD_LIBRARY_PATH= MCORE_LIBS=",
                    compiled_model,
                    data,
-                   n_string,
+                   #n_string,
                    paste(">", output_path)
                    )
   system(command)

R/utils.R

@@ -1,87 +1,84 @@
-# Platform-dependent treeppl self-contained installation
-installing_treeppl <- function() {
-
+#' Platform-dependent treeppl self-contained installation
+#' @description
+#' `tp_installing_treeppl` will search for the local version tpplc associate
+#' with the package. Will download it if it's not detected on the computer.
+#'
+#' @param download Will download the associate tpplc version in the dir next
+#' to your local treepplr installation if not present.
+#'
+#' @return The path for TreePPL compiler.
+#' @export
+tp_installing_treeppl <- function(download = TRUE) {
   if (Sys.getenv("TPPLC") != "") {
     tpplc_path <- Sys.getenv("TPPLC")
   } else{
-
-    tag <- tp_fp_fetch()
     if (Sys.info()['sysname'] == "Windows") {
       # No self container for Windows, need to install it manually
       "tpplc"
-    } else if(Sys.info()['sysname'] == "Linux") {
-      path <- system.file("treeppl-linux", package = "treepplr")
-      file_name <- paste0("treeppl-",substring(tag, 2))
-    } else {#Mac OS have a lot of different name
-      path <- system.file("treeppl-mac", package = "treepplr")
-      file_name <- paste0("treeppl-",substring(tag, 2))
+    } else {
+      path_treeppl <-
+        list.files(path = paste0(.libPaths()[1], "/treeppl/", TPPLC_VERSION),
+                   full.names = TRUE)
     }
     # Test if tpplc is already here
-    tpplc_path <- paste0("/tmp/",file_name,"/tpplc")
+    tpplc_path <- paste0("/tmp/treeppl-",TPPLC_VERSION,"/tpplc")
     if(!file.exists(tpplc_path)) {
-      utils::untar(list.files(path=path, full.names=TRUE),
-                   exdir="/tmp")
+      if(download && length(path_treeppl) == 0) {
+        tag <- tp_fp_fetch()
+        path_treeppl <-
+          list.files(path = paste0(.libPaths()[1], "/treeppl/", TPPLC_VERSION),
+                     full.names = TRUE)
+      }
+      message("TreePPL initialisation ...please wait...")
+      utils::untar(path_treeppl, exdir="/tmp", verbose = FALSE)
+      message("TreePPL initialisation : Done")
     }
   }
   tpplc_path
 }
 
-
-# Fetch the latest version of treeppl
+# Fetch the associate version of TreePPL if needed
 tp_fp_fetch <- function() {
   if (Sys.info()["sysname"] == "Windows") {
     # no self container for Windows, need to install it manually
-    0.0
+    "-1"
   } else {
-    # get repo info
-    repo_info <- gh::gh("GET /repos/treeppl/treeppl/releases")
     # Check for Linux
     if (Sys.info()["sysname"] == "Linux") {
       # assets[[2]] because releases are in alphabetical order (1 = Mac, 2 = Linux)
-      asset <- repo_info[[1]]$assets[[2]]
-      folder_name <- "treeppl-linux"
+      name <- paste0("treeppl-",TPPLC_VERSION,"-x86_64-linux.tar.gz")
     } else {
-      asset <- repo_info[[1]]$assets[[1]]
-      folder_name <- "treeppl-mac"
+      name <- paste0("treeppl-",TPPLC_VERSION,"-aarch64-darwin.tar.gz")
     }
 
-    # online hash
-    online_hash <- asset$digest
-    # local hash
-    file_name <- list.files(path = system.file(folder_name, package = "treepplr"), full.names = TRUE)
+    url <- paste0("https://github.com/treeppl/treeppl/releases/download/v",
+                  TPPLC_VERSION,"/",name)
+    # local repository
+    file_name <- list.files(path = paste0(.libPaths()[1], "/treeppl/",
+                                          TPPLC_VERSION),
+                            full.names = TRUE)
     # download file if file_name is empty
     if (length(file_name) == 0) {
-      # create destination folder
-      dest_folder <- paste(system.file(package = "treepplr"), folder_name, sep = "/")
-      system(paste("mkdir", dest_folder))
+      # create destination folder if treeppl dir doesn't exist
+      dest_folder <- paste0(.libPaths()[1], "/treeppl")
+      system(paste("mkdir", dest_folder), ignore.stdout = FALSE,
+             ignore.stderr = FALSE)
+      # create destination folder if version dir doesn't exist
+      version_dir <- paste(dest_folder, TPPLC_VERSION, sep = "/")
+      system(paste("mkdir", version_dir), ignore.stdout = TRUE,
+             ignore.stderr = TRUE)
       # download
-      fn <- paste(dest_folder, asset$name, sep = "/")
+      fn <- paste(version_dir, name, sep = "/")
       curl::curl_download(
-        asset$browser_download_url,
+        url,
         destfile = fn,
         quiet = FALSE
       )
-    } else {
-      local_hash <- paste0("sha256:", cli::hash_file_sha256(file_name))
-      # compare local and online hash and download the file if they differ
-      if (!identical(local_hash, online_hash)) {
-        # remove old file
-        file.remove(file_name)
-        # download
-        fn <- paste(system.file(package = "treepplr"), folder_name, asset$name, sep = "/")
-        curl::curl_download(
-          asset$browser_download_url,
-          destfile = fn,
-          quiet = FALSE
-        )
-      }
     }
   }
-  repo_info[[1]]$tag_name
+  TPPLC_VERSION
 }
 
-
-
 #' Temporary directory for running treeppl
 #'
 #' @description
@@ -165,8 +162,8 @@ tp_find_model <- function(model_name) {
   # make sure you get the most recent version if you have more than one treeppl folder in the tmp
   version <- sort(version, decreasing = TRUE)[1]
 
-  res <- system(paste0("find /tmp/", version," -name ", model_name, ".tppl"),
-         intern = T, ignore.stderr = TRUE)
+  suppressWarnings(res <- system(paste0("find /tmp/", version," -name ", model_name, ".tppl"),
+         intern = T, ignore.stderr = TRUE))
 }
 
 # Find data for model_name
@@ -177,7 +174,7 @@ tp_find_data <- function(model_name) {
   # make sure you get the most recent version if you have more than one treeppl folder in the tmp
   version <- sort(version, decreasing = TRUE)[1]
 
-  system(paste0("find /tmp/", version ," -name testdata_", model_name, ".json"),
-         intern = T)
+  suppressWarnings(system(paste0("find /tmp/", version ," -name testdata_", model_name, ".json"),
+         intern = T))
 }
 

R/zzz.R

@@ -0,0 +1,11 @@
+#The goal of this file is to performing task at the loading of the package
+
+######Version Change ##########
+####Use to pull the tag of the last version of TreePPL release on the following function
+#repo_info <- gh::gh("GET /repos/treeppl/treeppl/releases")
+#version <- repo_info[[1]]$tag_name
+##################
+
+.onLoad <- function(libname, pkgname){
+  TPPLC_VERSION <<- "0.3"
+}

vignettes/coin-example.Rmd

@@ -32,6 +32,7 @@ First load the required R packages:
 
 ```{r setup}
 library(treepplr)
+treepplr::tp_installing_treeppl()
 library(dplyr)
 library(ggplot2)
 ```

vignettes/crbd-example.Rmd

@@ -22,6 +22,7 @@ options(rmarkdown.html_vignette.check_title = FALSE)
 
 ```{r setup}
 library(treepplr)
+treepplr::tp_installing_treeppl()
 ```
 
 ```{r, eval = FALSE}

vignettes/treepplr.Rmd

@@ -23,6 +23,7 @@ options(rmarkdown.html_vignette.check_title = FALSE)
 
 ```{r setup, echo=FALSE}
 library(treepplr)
+treepplr::tp_installing_treeppl()
 ```
 
 `treepplr` is an interface for using the TreePPL program. All functions start