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

@@ -1,8 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+export(TPPLC_VERSION)
 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,39 @@
 #' 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 ####
-
-  # text from tpplc --help
-  return()
-
+  tpplc_path <- tp_installing_treeppl()
+  # treeppl options
+  cmd_opt <- system2(command = tpplc_path, 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 +114,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()
   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,96 @@
-# 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.
+#'
+#' @param keep_previous 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, keep_previous = FALSE) {
   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(keep_previous)
+        path_treeppl <-
+          list.files(path = paste0(.libPaths()[1], "/treeppl/", TPPLC_VERSION),
+                     full.names = TRUE)
+      }
+      if (length(path_treeppl) != 0) {
+        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
-tp_fp_fetch <- function() {
+# Fetch the associate version of TreePPL if needed
+tp_fp_fetch <- function(keep_previous = FALSE) {
   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))
+      if(!keep_previous) {
+
+      }
+      # create destination folder if treeppl dir doesn't exist
+      dest_folder <- paste0(.libPaths()[1], "/treeppl")
+      if(!keep_previous) {
+        system(paste("rm -rf", dest_folder), ignore.stdout = FALSE,
+               ignore.stderr = FALSE)
+      }
+      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
@@ -131,10 +140,10 @@ sep <- function() {
 #' @export
 tp_model_library <- function() {
 
-  # take whatever treeppl version is in the tmp
-  fd <- list.files("/tmp", pattern = "treeppl", full.names = TRUE)
-  # make sure you get the most recent version if you have more than one treeppl folder in the tmp
-  fd <- sort(fd, decreasing = TRUE)[1]
+  # 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),
+                   full.names = TRUE)
   # go to the right treeppl folder, whatever it is called
   fd <- list.files(fd, pattern = "treeppl", full.names = TRUE)
   # add the rest of the path
@@ -159,25 +168,23 @@ tp_model_library <- function() {
 
 # Find model for model_name
 tp_find_model <- function(model_name) {
-
-  # take whatever treeppl version is in the tmp
-  version <- list.files("/tmp", pattern = "treeppl", full.names = FALSE)
-  # 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)
+  tp_find(model_name, ".tppl")
 }
 
 # Find data for model_name
 tp_find_data <- function(model_name) {
+  tp_find(model_name, ".json")
+}
 
-  # take whatever treeppl version is in the tmp
-  version <- list.files("/tmp", pattern = "treeppl", full.names = FALSE)
-  # 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]
+tp_find <- function(model_name, ext) {
+  # make sure you get the appropriate version if you have more than one treeppl folder in the tmp
+  version <- list.files("/tmp",
+                   pattern = paste0("treeppl-", TPPLC_VERSION),
+                   full.names = TRUE)
 
-  system(paste0("find /tmp/", version ," -name testdata_", model_name, ".json"),
-         intern = T)
+  res <- list.files(version,
+                    full.names = TRUE,
+                    recursive = TRUE,
+                    pattern = paste0(model_name, ext))
 }
 

R/zzz.R

@@ -0,0 +1,14 @@
+#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
+##################
+
+#'@export
+TPPLC_VERSION <- "0.3"
+
+.onLoad <- function(libname, pkgname){
+  tp_installing_treeppl(download =  FALSE)
+}

README.md

@@ -32,6 +32,14 @@ This will only install the R package. The TreePPL compiler will not be downloade
 
 ```
 [xx%] Downloaded xxxxxx bytes...
+TreePPL initialisation ...please wait...
+TreePPL initialisation : Done
+```
+
+But you can force this download and installation
+
+```
+treepplr::tp_installing_treeppl()
 ```
 
 In subsequent analyses, the TreePPL compiler will be called directly, skipping this step.