Skip to content
Open
4 changes: 1 addition & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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"))
Expand All @@ -20,9 +20,7 @@ Imports:
jsonlite,
tidytree,
utils,
gh,
curl,
cli,
bnpsd,
rlang,
phangorn
Expand Down
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -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)
Expand Down
39 changes: 30 additions & 9 deletions R/compile.R
Original file line number Diff line number Diff line change
@@ -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= ", 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
Expand Down Expand Up @@ -93,13 +114,13 @@ 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
# Empty LD_LIBRARY_PATH from R_env for this command specifically
# due to conflict with internal env from treeppl self-contained
system(paste0("LD_LIBRARY_PATH= MCORE_LIBS= ", command))
system(paste0("LD_LIBRARY_PATH= ", command))

return(output_path)
}
Expand Down
22 changes: 11 additions & 11 deletions R/run.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
...) {
Expand All @@ -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()
Expand All @@ -90,10 +90,10 @@ tp_run <- function(compiled_model,

# 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= MCORE_LIBS=",
command <- paste("LD_LIBRARY_PATH= ",
compiled_model,
data,
n_string,
#n_string,
paste(">", output_path)
)
system(command)
Expand Down
148 changes: 77 additions & 71 deletions R/utils.R
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand All @@ -157,27 +166,24 @@ tp_model_library <- function() {
}


# Find model for model_name
tp_find_model <- function(model_name) {
# Function to find the path of model and data files based on a model name and extension
tp_find <- function(model_name, ext) {
# path to the model library
fd <- list.files("/tmp", pattern = paste0("treeppl-", TPPLC_VERSION), full.names = TRUE)
fd <- list.files(fd, pattern = "treeppl", full.names = TRUE)
fd <- paste0(fd, "/lib/mcore/treeppl/models")
# path to the required model
fd <- list.files(path = fd, pattern = paste0(model_name, ext), recursive = TRUE, full.names = TRUE)
return(fd)
}

# 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)
# Find model for model_name
tp_find_model <- function(model_name) {
tp_find(model_name, ".tppl")
}

# Find data for model_name
tp_find_data <- 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]

system(paste0("find /tmp/", version ," -name testdata_", model_name, ".json"),
intern = T)
tp_find(model_name, ".json")
}

14 changes: 14 additions & 0 deletions R/zzz.R
Original file line number Diff line number Diff line change
@@ -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)
}
8 changes: 8 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.
4 changes: 0 additions & 4 deletions inst/treeppl-linux/.gitignore

This file was deleted.

4 changes: 0 additions & 4 deletions inst/treeppl-mac/.gitignore

This file was deleted.

9 changes: 8 additions & 1 deletion man/tp_compile_options.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
Loading