From 848c49201fb0ecd6d05f86105ce7a7901702e1f1 Mon Sep 17 00:00:00 2001 From: foersterst Date: Sun, 15 Mar 2026 08:07:28 +0100 Subject: [PATCH 01/15] added tp_compile_options() --- R/compile.R | 61 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 56 insertions(+), 5 deletions(-) diff --git a/R/compile.R b/R/compile.R index fe41425..04743a6 100644 --- a/R/compile.R +++ b/R/compile.R @@ -1,18 +1,69 @@ #' Options that can be passed to TreePPL compiler #' -#' @returns A string with the output from the compiler's help +#' @returns A data frame with the output from the compiler's 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", 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 From cdb5b14a6bf4a2706df90f4cd397074165e58185 Mon Sep 17 00:00:00 2001 From: foersterst Date: Tue, 17 Mar 2026 12:56:46 +0200 Subject: [PATCH 02/15] try to prepare treppl in temp on load --- R/compile.R | 4 ++++ R/utils.R | 31 +++++++++++++++++++++++++++++++ man/tp_compile_options.Rd | 7 ++++++- 3 files changed, 41 insertions(+), 1 deletion(-) diff --git a/R/compile.R b/R/compile.R index 04743a6..b453d93 100644 --- a/R/compile.R +++ b/R/compile.R @@ -2,6 +2,10 @@ #' #' @returns A data frame with the output from the compiler's help #' +#' @examples +#' a <- tp_compile_options() +#' view(a) +#' tp_compile_options <- function() { # Path to self contained # diff --git a/R/utils.R b/R/utils.R index 26aa1f5..807fcc6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -181,3 +181,34 @@ tp_find_data <- function(model_name) { intern = T) } + +# Prepare TreePPL in temp +prep_temp <- function() { + if (Sys.info()["sysname"] == "Windows") { + "tpplc" + } else if (Sys.info()["sysname"] == "Linux") { + path_sc <- system.file("treeppl-linux", package = "treepplr") + } else { + path_sc <- system.file("treeppl-mac", package = "treepplr") + } + + # check if treeppl is in the tmp and untar to tmp if it isn't + ft <- list.files("/tmp", full.names = TRUE) + ff <- ft[grepl("treeppl-", ft)] + + if (length(ff) == 0) { + utils::untar( + list.files( + path = path_sc, + full.names = TRUE + ), + exdir = "/tmp" + ) + } +} + +# Prepare TreePPL in temp every time the package is loaded +.onLoad <- function(libname, pkgname) { + prep_temp() +} + diff --git a/man/tp_compile_options.Rd b/man/tp_compile_options.Rd index dce5d89..5d252d2 100644 --- a/man/tp_compile_options.Rd +++ b/man/tp_compile_options.Rd @@ -7,8 +7,13 @@ tp_compile_options() } \value{ -A string with the output from the compiler's help +A data frame with the output from the compiler's help } \description{ Options that can be passed to TreePPL compiler } +\examples{ +a <- tp_compile_options() +view(a) + +} From 13e78f0bbfef5e40528355d40111aa9bed440e71 Mon Sep 17 00:00:00 2001 From: foersterst Date: Tue, 17 Mar 2026 13:31:23 +0200 Subject: [PATCH 03/15] fix to .onLoad --- R/utils.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 807fcc6..05f4ae7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -209,6 +209,16 @@ prep_temp <- function() { # Prepare TreePPL in temp every time the package is loaded .onLoad <- function(libname, pkgname) { - prep_temp() + if (Sys.info()["sysname"] == "Windows") { + "tpplc" + } else if (Sys.info()["sysname"] == "Linux") { + path_sc <- system.file("treeppl-linux", package = "treepplr") + } else { + path_sc <- system.file("treeppl-mac", package = "treepplr") + } + + if (path_sc == "") { + prep_temp() + } } From d3f86ae08664348ecc2eeefb126a02fde223bced Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Wed, 25 Mar 2026 15:05:19 +0100 Subject: [PATCH 04/15] Change in the gestion of TreePPL distribution --- DESCRIPTION | 4 +- NAMESPACE | 1 + R/compile.R | 7 ++- R/run.R | 20 +++---- R/utils.R | 103 +++++++++++++++++----------------- R/zzz.R | 11 ++++ inst/treeppl-linux/.gitignore | 4 -- inst/treeppl-mac/.gitignore | 4 -- man/tp_compile_options.Rd | 2 +- man/tp_installing_treeppl.Rd | 19 +++++++ man/tp_run.Rd | 4 +- vignettes/coin-example.Rmd | 1 + vignettes/crbd-example.Rmd | 1 + vignettes/treepplr.Rmd | 1 + 14 files changed, 102 insertions(+), 80 deletions(-) create mode 100644 R/zzz.R delete mode 100644 inst/treeppl-linux/.gitignore delete mode 100644 inst/treeppl-mac/.gitignore create mode 100644 man/tp_installing_treeppl.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 225793d..78095b2 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index 1f00e18..9e513f4 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/compile.R b/R/compile.R index 04743a6..648623a 100644 --- a/R/compile.R +++ b/R/compile.R @@ -35,9 +35,10 @@ tp_compile_options <- function() { ff <- ft[grepl("treeppl-", ft)] # command - path_cmd <- paste0(ff, "//tpplc") + path_cmd <- paste0(ff, "/tpplc") # treeppl options - cmd_opt <- system2(command = path_cmd, args = "--help", stdout = TRUE) + cmd_opt <- system2(command = path_cmd, args = "--help", + env= "LD_LIBRARY_PATH= MCORE_LIBS=", stdout = TRUE) # Preparing the output # @@ -144,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 diff --git a/R/run.R b/R/run.R index bb1323e..9968fdb 100644 --- a/R/run.R +++ b/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) diff --git a/R/utils.R b/R/utils.R index 26aa1f5..5fb2074 100644 --- a/R/utils.R +++ b/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)) } diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..bcbaf36 --- /dev/null +++ b/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" +} diff --git a/inst/treeppl-linux/.gitignore b/inst/treeppl-linux/.gitignore deleted file mode 100644 index 5e7d273..0000000 --- a/inst/treeppl-linux/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -# Ignore everything in this directory -* -# Except this file -!.gitignore diff --git a/inst/treeppl-mac/.gitignore b/inst/treeppl-mac/.gitignore deleted file mode 100644 index 5e7d273..0000000 --- a/inst/treeppl-mac/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -# Ignore everything in this directory -* -# Except this file -!.gitignore diff --git a/man/tp_compile_options.Rd b/man/tp_compile_options.Rd index dce5d89..f1affa5 100644 --- a/man/tp_compile_options.Rd +++ b/man/tp_compile_options.Rd @@ -7,7 +7,7 @@ tp_compile_options() } \value{ -A string with the output from the compiler's help +A data frame with the output from the compiler's help } \description{ Options that can be passed to TreePPL compiler diff --git a/man/tp_installing_treeppl.Rd b/man/tp_installing_treeppl.Rd new file mode 100644 index 0000000..0fda729 --- /dev/null +++ b/man/tp_installing_treeppl.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{tp_installing_treeppl} +\alias{tp_installing_treeppl} +\title{Platform-dependent treeppl self-contained installation} +\usage{ +tp_installing_treeppl(download = TRUE) +} +\arguments{ +\item{download}{Will download the associate tpplc version in the dir next +to your local treepplr installation if not present.} +} +\value{ +The path for TreePPL compiler. +} +\description{ +\code{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. +} diff --git a/man/tp_run.Rd b/man/tp_run.Rd index c00624c..2053bfa 100644 --- a/man/tp_run.Rd +++ b/man/tp_run.Rd @@ -7,8 +7,8 @@ tp_run( compiled_model, data, - n_runs = NULL, - n_sweeps = NULL, + n_runs = 1, + n_sweeps = 1, dir = NULL, out_file_name = "out", ... diff --git a/vignettes/coin-example.Rmd b/vignettes/coin-example.Rmd index 908db1e..75078dc 100644 --- a/vignettes/coin-example.Rmd +++ b/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) ``` diff --git a/vignettes/crbd-example.Rmd b/vignettes/crbd-example.Rmd index 5c80c16..22ac417 100644 --- a/vignettes/crbd-example.Rmd +++ b/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} diff --git a/vignettes/treepplr.Rmd b/vignettes/treepplr.Rmd index 212267f..57ecad6 100644 --- a/vignettes/treepplr.Rmd +++ b/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 From fc84d48b4552c8ce820c0d2021583b392cac29e6 Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Thu, 26 Mar 2026 14:02:43 +0100 Subject: [PATCH 05/15] minor change on the loading system --- R/utils.R | 42 +++++++++++++++++------------------ R/zzz.R | 1 + README.md | 8 +++++++ tests/testthat/test-compile.R | 14 +++++++----- tests/testthat/test-data.R | 7 +++--- vignettes/coin-example.Rmd | 1 - vignettes/crbd-example.Rmd | 1 - vignettes/treepplr.Rmd | 1 - 8 files changed, 42 insertions(+), 33 deletions(-) diff --git a/R/utils.R b/R/utils.R index 5fb2074..05a60cd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -29,9 +29,11 @@ tp_installing_treeppl <- function(download = TRUE) { 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") + if (length(path_treeppl) != 0) { + message("TreePPL initialisation ...please wait...") + utils::untar(path_treeppl, exdir="/tmp", verbose = FALSE) + message("TreePPL initialisation : Done") + } } } tpplc_path @@ -128,10 +130,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 @@ -156,25 +158,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] - - suppressWarnings(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) - suppressWarnings(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)) } diff --git a/R/zzz.R b/R/zzz.R index bcbaf36..37aacd4 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -8,4 +8,5 @@ .onLoad <- function(libname, pkgname){ TPPLC_VERSION <<- "0.3" + tp_installing_treeppl(FALSE) } diff --git a/README.md b/README.md index 384f34b..e4c7454 100644 --- a/README.md +++ b/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. diff --git a/tests/testthat/test-compile.R b/tests/testthat/test-compile.R index 26e125e..88f0bdd 100644 --- a/tests/testthat/test-compile.R +++ b/tests/testthat/test-compile.R @@ -34,10 +34,11 @@ test_that("Test-compile_2a : tp_model model name", { model <- treepplr::tp_model("coin") - version <- list.files("/tmp", pattern = "treeppl", full.names = FALSE) - version <- sort(version, decreasing = TRUE)[1] + version <- list.files("/tmp", + pattern = paste0("treeppl-", TPPLC_VERSION), + full.names = TRUE) - model_right = system(paste0("find /tmp/", version," -name coin.tppl"), + model_right = system(paste0("find ", version," -name coin.tppl"), intern = T) names(model_right) <- "coin" @@ -49,10 +50,11 @@ test_that("Test-compile_2a : tp_model model name", { test_that("Test-compile_2b : tp_model model path ", { cat("\tTest-compile_2b : tp_model\n") - version <- list.files("/tmp", pattern = "treeppl", full.names = FALSE) - version <- sort(version, decreasing = TRUE)[1] + version <- list.files("/tmp", + pattern = paste0("treeppl-", TPPLC_VERSION), + full.names = TRUE) - model_right = system(paste0("find /tmp/", version," -name coin.tppl"), + model_right = system(paste0("find ", version," -name coin.tppl"), intern = T) model <- treepplr::tp_model(model_right) names(model_right) <- "custom_model" diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index ec66b3a..ff7069c 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -8,10 +8,11 @@ cat(crayon::yellow("\nTest-data : Import and convert data.\n")) test_that("Test-data_1a : tp_data name", { cat("\tTest-data_1a \n") - version <- list.files("/tmp", pattern = "treeppl", full.names = FALSE) - version <- sort(version, decreasing = TRUE)[1] + version <- list.files("/tmp", + pattern = paste0("treeppl-", TPPLC_VERSION), + full.names = TRUE) - data_right <- system(paste0("find /tmp/", version," -name testdata_coin.json"), + data_right <- system(paste0("find ", version," -name testdata_coin.json"), intern = T) data <- treepplr::tp_data("coin") diff --git a/vignettes/coin-example.Rmd b/vignettes/coin-example.Rmd index 75078dc..908db1e 100644 --- a/vignettes/coin-example.Rmd +++ b/vignettes/coin-example.Rmd @@ -32,7 +32,6 @@ First load the required R packages: ```{r setup} library(treepplr) -treepplr::tp_installing_treeppl() library(dplyr) library(ggplot2) ``` diff --git a/vignettes/crbd-example.Rmd b/vignettes/crbd-example.Rmd index 22ac417..5c80c16 100644 --- a/vignettes/crbd-example.Rmd +++ b/vignettes/crbd-example.Rmd @@ -22,7 +22,6 @@ options(rmarkdown.html_vignette.check_title = FALSE) ```{r setup} library(treepplr) -treepplr::tp_installing_treeppl() ``` ```{r, eval = FALSE} diff --git a/vignettes/treepplr.Rmd b/vignettes/treepplr.Rmd index 57ecad6..212267f 100644 --- a/vignettes/treepplr.Rmd +++ b/vignettes/treepplr.Rmd @@ -23,7 +23,6 @@ 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 From 835aae602197da345d2ea0687ba93dcc19f90782 Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Fri, 27 Mar 2026 15:21:17 +0100 Subject: [PATCH 06/15] Minor correction after code review --- NAMESPACE | 1 + R/compile.R | 37 +++---------------------------------- R/utils.R | 16 +++++++++++++--- R/zzz.R | 6 ++++-- 4 files changed, 21 insertions(+), 39 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 9e513f4..faac3ff 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(TPPLC_VERSION) export(tp_compile) export(tp_data) export(tp_expected_input) diff --git a/R/compile.R b/R/compile.R index 648623a..b38f7a7 100644 --- a/R/compile.R +++ b/R/compile.R @@ -4,40 +4,9 @@ #' tp_compile_options <- function() { - # 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") - } - - # 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") + tpplc_path <- tp_installing_treeppl() # treeppl options - cmd_opt <- system2(command = path_cmd, args = "--help", + cmd_opt <- system2(command = tpplc_path, args = "--help", env= "LD_LIBRARY_PATH= MCORE_LIBS=", stdout = TRUE) # Preparing the output # @@ -145,7 +114,7 @@ tp_compile <- function(model, options <- paste("--output", output_path, args_str) # Preparing the command line program - tpplc_path <- tp_installing_treeppl() #### move this? TV : Perfect place + tpplc_path <- tp_installing_treeppl() command <- paste(tpplc_path, model_file_name, musts, options) # Compile program diff --git a/R/utils.R b/R/utils.R index 05a60cd..0597a25 100644 --- a/R/utils.R +++ b/R/utils.R @@ -6,9 +6,12 @@ #' @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) { +tp_installing_treeppl <- function(download = TRUE, keep_previous = FALSE) { if (Sys.getenv("TPPLC") != "") { tpplc_path <- Sys.getenv("TPPLC") } else{ @@ -24,7 +27,7 @@ tp_installing_treeppl <- function(download = TRUE) { tpplc_path <- paste0("/tmp/treeppl-",TPPLC_VERSION,"/tpplc") if(!file.exists(tpplc_path)) { if(download && length(path_treeppl) == 0) { - tag <- tp_fp_fetch() + tag <- tp_fp_fetch(keep_previous) path_treeppl <- list.files(path = paste0(.libPaths()[1], "/treeppl/", TPPLC_VERSION), full.names = TRUE) @@ -40,7 +43,7 @@ tp_installing_treeppl <- function(download = TRUE) { } # Fetch the associate version of TreePPL if needed -tp_fp_fetch <- function() { +tp_fp_fetch <- function(keep_previous = FALSE) { if (Sys.info()["sysname"] == "Windows") { # no self container for Windows, need to install it manually "-1" @@ -61,8 +64,15 @@ tp_fp_fetch <- function() { full.names = TRUE) # download file if file_name is empty if (length(file_name) == 0) { + 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 diff --git a/R/zzz.R b/R/zzz.R index 37aacd4..18ca431 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -6,7 +6,9 @@ #version <- repo_info[[1]]$tag_name ################## +#'@export +TPPLC_VERSION <- "0.3" + .onLoad <- function(libname, pkgname){ - TPPLC_VERSION <<- "0.3" - tp_installing_treeppl(FALSE) + tp_installing_treeppl(download = FALSE) } From e1056135d93504c2fb7ee97853698d8fc38c3e47 Mon Sep 17 00:00:00 2001 From: foersterst Date: Thu, 16 Apr 2026 15:53:34 +0200 Subject: [PATCH 07/15] Mac fix for tp_find() --- R/utils.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/R/utils.R b/R/utils.R index b2ab6cd..85c1f6b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -166,6 +166,18 @@ tp_model_library <- function() { } +# 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) +} + + # Find model for model_name tp_find_model <- function(model_name) { tp_find(model_name, ".tppl") @@ -176,18 +188,6 @@ tp_find_data <- function(model_name) { tp_find(model_name, ".json") } -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) - - res <- list.files(version, - full.names = TRUE, - recursive = TRUE, - pattern = paste0(model_name, ext)) -} - # Prepare TreePPL in temp prep_temp <- function() { From 3f780238d860701f7c3f3d49768bea8e8e1c5380 Mon Sep 17 00:00:00 2001 From: Tim Virgoulay Date: Thu, 16 Apr 2026 16:46:01 +0200 Subject: [PATCH 08/15] Remove TreePPL preparation functions Removed unused functions related to TreePPL preparation. --- R/utils.R | 42 ------------------------------------------ 1 file changed, 42 deletions(-) diff --git a/R/utils.R b/R/utils.R index 85c1f6b..d99b2fa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -187,45 +187,3 @@ tp_find_model <- function(model_name) { tp_find_data <- function(model_name) { tp_find(model_name, ".json") } - - -# Prepare TreePPL in temp -prep_temp <- function() { - if (Sys.info()["sysname"] == "Windows") { - "tpplc" - } else if (Sys.info()["sysname"] == "Linux") { - path_sc <- system.file("treeppl-linux", package = "treepplr") - } else { - path_sc <- system.file("treeppl-mac", package = "treepplr") - } - - # check if treeppl is in the tmp and untar to tmp if it isn't - ft <- list.files("/tmp", full.names = TRUE) - ff <- ft[grepl("treeppl-", ft)] - - if (length(ff) == 0) { - utils::untar( - list.files( - path = path_sc, - full.names = TRUE - ), - exdir = "/tmp" - ) - } -} - -# Prepare TreePPL in temp every time the package is loaded -.onLoad <- function(libname, pkgname) { - if (Sys.info()["sysname"] == "Windows") { - "tpplc" - } else if (Sys.info()["sysname"] == "Linux") { - path_sc <- system.file("treeppl-linux", package = "treepplr") - } else { - path_sc <- system.file("treeppl-mac", package = "treepplr") - } - - if (path_sc == "") { - prep_temp() - } -} - From a1be14928ef8a6fbf429e63e353750a6f14fd22a Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Thu, 16 Apr 2026 17:21:50 +0200 Subject: [PATCH 09/15] Cleaning project --- R/compile.R | 2 ++ man/tp_compile_options.Rd | 2 ++ man/tp_installing_treeppl.Rd | 5 ++++- 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/R/compile.R b/R/compile.R index c5d0f62..6a8622f 100644 --- a/R/compile.R +++ b/R/compile.R @@ -3,8 +3,10 @@ #' @returns A data frame with the output from the compiler's help #' #' @examples +#' \dontrun{ #' a <- tp_compile_options() #' view(a) +#' } #' tp_compile_options <- function() { diff --git a/man/tp_compile_options.Rd b/man/tp_compile_options.Rd index 5d252d2..c3f8f7d 100644 --- a/man/tp_compile_options.Rd +++ b/man/tp_compile_options.Rd @@ -13,7 +13,9 @@ A data frame with the output from the compiler's help Options that can be passed to TreePPL compiler } \examples{ +\dontrun{ a <- tp_compile_options() view(a) +} } diff --git a/man/tp_installing_treeppl.Rd b/man/tp_installing_treeppl.Rd index 0fda729..10220f6 100644 --- a/man/tp_installing_treeppl.Rd +++ b/man/tp_installing_treeppl.Rd @@ -4,11 +4,14 @@ \alias{tp_installing_treeppl} \title{Platform-dependent treeppl self-contained installation} \usage{ -tp_installing_treeppl(download = TRUE) +tp_installing_treeppl(download = TRUE, keep_previous = FALSE) } \arguments{ \item{download}{Will download the associate tpplc version in the dir next to your local treepplr installation if not present.} + +\item{keep_previous}{Will download the associate tpplc version in the dir next +to your local treepplr installation if not present.} } \value{ The path for TreePPL compiler. From d137bed3efddd596c069adcd4b7548d72271be15 Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Mon, 20 Apr 2026 15:53:01 +0200 Subject: [PATCH 10/15] correction for test suite --- R/compile.R | 10 ++-------- R/run.R | 2 +- 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/R/compile.R b/R/compile.R index 6a8622f..a27bacf 100644 --- a/R/compile.R +++ b/R/compile.R @@ -2,18 +2,12 @@ #' #' @returns A data frame with the output from the compiler's help #' -#' @examples -#' \dontrun{ -#' a <- tp_compile_options() -#' view(a) -#' } -#' tp_compile_options <- function() { tpplc_path <- tp_installing_treeppl() # treeppl options cmd_opt <- system2(command = tpplc_path, args = "--help", - env= "LD_LIBRARY_PATH= MCORE_LIBS=", stdout = TRUE) + env= "LD_LIBRARY_PATH= ", stdout = TRUE) # Preparing the output # @@ -126,7 +120,7 @@ tp_compile <- function(model, # 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) } diff --git a/R/run.R b/R/run.R index 9968fdb..9926bf1 100644 --- a/R/run.R +++ b/R/run.R @@ -90,7 +90,7 @@ 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, From 6e3b1e3405a898e8b832aa64390925c825d5a987 Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Mon, 8 Jun 2026 16:18:46 +0200 Subject: [PATCH 11/15] v0.13.0 : New architecture, need others things, see TODO on WIKI --- .Rbuildignore | 2 + .gitignore | 1 + DESCRIPTION | 5 +- NAMESPACE | 4 +- R/compile.R | 197 ---------------------- R/data.R | 92 ++--------- R/model.R | 234 +++++++++++++++++++++++++++ R/run.R | 67 +++----- R/utils.R | 46 ++++-- R/zzz.R | 2 +- man/compilation.Rd | 39 +++++ man/compiled_model_Template-class.Rd | 12 ++ man/options_to_string.Rd | 13 ++ man/tp_compile.Rd | 35 +--- man/tp_compile_options.Rd | 9 +- man/tp_data.Rd | 2 +- man/tp_expected_input.Rd | 17 -- man/tp_list.Rd | 2 +- man/tp_model.Rd | 24 --- man/tp_phylo_to_tpjson.Rd | 2 +- man/tp_phylo_to_tppl_tree.Rd | 2 +- man/tp_run.Rd | 18 +-- man/tp_run_options.Rd | 14 -- man/tp_tempdir.Rd | 4 +- man/tp_write_data.Rd | 2 +- man/tp_write_model.Rd | 2 +- man/treepplr-package.Rd | 5 + tests/testthat/test-compile.R | 96 ----------- tests/testthat/test-data.R | 52 +++--- tests/testthat/test-model.R | 82 ++++++++++ tests/testthat/test-run.R | 16 +- vignettes/coin-example.Rmd | 2 +- vignettes/crbd-example.Rmd | 2 +- 33 files changed, 520 insertions(+), 582 deletions(-) delete mode 100644 R/compile.R create mode 100644 R/model.R create mode 100644 man/compilation.Rd create mode 100644 man/compiled_model_Template-class.Rd create mode 100644 man/options_to_string.Rd delete mode 100644 man/tp_expected_input.Rd delete mode 100644 man/tp_model.Rd delete mode 100644 man/tp_run_options.Rd delete mode 100644 tests/testthat/test-compile.R create mode 100644 tests/testthat/test-model.R diff --git a/.Rbuildignore b/.Rbuildignore index 918c763..85c4b83 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,3 +5,5 @@ ^docs$ ^pkgdown$ ^\.github$ +^\.positai$ +^\.claude$ diff --git a/.gitignore b/.gitignore index 0857a69..45b0189 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ inst/doc docs save.txt .Rhistory +.positai diff --git a/DESCRIPTION b/DESCRIPTION index 78095b2..f376295 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: treepplr Title: R Interface to TreePPL -Version: 0.12.0 +Version: 0.13.0 Authors@R: person("Mariana", "P Braga", , "mpiresbr@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-1253-2536")) @@ -8,7 +8,6 @@ Description: This package in an interface for using TreePPL programs. License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.3 URL: https://github.com/treeppl/treepplr, http://treeppl.org/treepplr/ BugReports: https://github.com/treeppl/treepplr/issues @@ -16,6 +15,7 @@ Depends: R (>= 4.1.0) Imports: assertthat, + digest, methods, jsonlite, tidytree, @@ -44,3 +44,4 @@ Remotes: github::maribraga/evolnets, bioc::ggtree, bioc::treeio +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index faac3ff..b0de17e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,18 +3,16 @@ export(TPPLC_VERSION) export(tp_compile) export(tp_data) -export(tp_expected_input) export(tp_installing_treeppl) export(tp_json_to_phylo) +export(tp_list) export(tp_map_tree) -export(tp_model) export(tp_model_library) export(tp_parse_host_rep) export(tp_parse_mcmc) export(tp_parse_smc) export(tp_phylo_to_tpjson) export(tp_run) -export(tp_run_options) export(tp_smc_convergence) export(tp_tempdir) export(tp_treeppl_json) diff --git a/R/compile.R b/R/compile.R deleted file mode 100644 index a27bacf..0000000 --- a/R/compile.R +++ /dev/null @@ -1,197 +0,0 @@ -#' Options that can be passed to TreePPL compiler -#' -#' @returns A data frame with the output from the compiler's help -#' -tp_compile_options <- function() { - - 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 -#' `tp_compile` 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/.exe -#' @param ... See tp_compile_options() for all supported arguments. -#' -#' @return The path for the compiled TreePPL program. -#' @export - -tp_compile <- function(model, - method, - iterations = NULL, - particles = NULL, - dir = NULL, - output = NULL, - ...) { - - options(scipen=999) - - if(is.null(dir)){ - dir_path <- tp_tempdir() - } else { - dir_path <- dir - } - - # check path, find or write model - model_file_name <- tp_model(model) - - musts <- paste("-m", method) - - if(is.null(iterations) & is.null(particles)){ - stop("If using MCMC, please choose number of iterations. - If using SMC, please choose number of particles.") - } - - if(!is.null(iterations)){ - musts <- paste(musts, "--particles", iterations) - } - - if(!is.null(particles)){ - musts <- paste(musts, "--particles", particles) - } - - # create string with other options to tpplc - args_list <- list(...) - args_vec <- unlist(args_list) - - vec <- c() - for(i in seq_along(args_vec)) { - str <- paste0("--", names(args_vec[i]), " ", args_vec[[i]]) - vec <- c(vec, str) - } - - args_str <- paste(vec, collapse = " ") - - # output - if(is.null(output)){ - output_path <- paste0(dir_path, names(model_file_name), ".exe") - } else { - output_path <- output - } - - options <- paste("--output", output_path, args_str) - - # Preparing the command line program - 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= ", command)) - - return(output_path) -} - - - -#' Import a TreePPL model -#' -#' @description -#' `tp_model` takes TreePPL code and prepares it to be used by -#' [treepplr::tp_compile()]. -#' -#' @param model_input 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. -#' -#' @return The path to the TreePPL model file -#' @export -tp_model <- function(model_input) { - - if (!assertthat::is.string(model_input)){ - stop("Input has to be a sring.") - } - - res <- try(file.exists(model_input), silent = TRUE) - - # If path exists, it's all good - if (!is(res,"try-error") && res) { - model_path <- model_input - # name the model - if (is.null(names(model_path))){ - names(model_path) <- "custom_model" - } - - # If path doesn't exist - } else { - # It can be a model name in the library - res_lib <- try(tp_find_model(model_input), silent = TRUE) - # model_input has the name of a known model - if (!is(res_lib,"try-error") && length(res_lib) != 0) { - model_path <- res_lib - names(model_path) <- model_input - # OR model_input contains the model - #### (needs to be verified as an appropriate model later) #### - } else { - model_path <- tp_write_model(model_input) - names(model_path) <- "custom_model" - } - } - return(model_path) -} - - - - -#' Write out a custom model to tp_tempdir() -#' -#' @param model A string containing the entire TreePPL code. -#' @param model_file_name An optional name to the file created -#' -#' @returns The path to the file created -#' @export -#' -tp_write_model <- function(model, model_file_name = "tmp_model_file") { - - path <- paste0(tp_tempdir(), model_file_name, ".tppl") - cat(model, file = path) - - return(path) - -} - diff --git a/R/data.R b/R/data.R index 47fd0e5..46a7d07 100644 --- a/R/data.R +++ b/R/data.R @@ -1,17 +1,4 @@ -#' List expected input variables for a model -#' -#' @param model A TreePPL model -#' -#' @returns The expected input data for a given TreePPL model. -#' @export -#' -tp_expected_input <- function(model) { - - #### under development here and in treeppl #### - -} - #' Import data for TreePPL program @@ -50,19 +37,18 @@ tp_expected_input <- function(model) { #' input #' } #' -tp_data <- function(data_input, data_file_name = "tmp_data_file", dir = tp_tempdir()) { - +tp_data <- function(data_input, + data_file_name = "tmp_data_file", + dir = tp_tempdir()) { #### TODO data inputs have to be named as it is expected in the model #### if (assertthat::is.string(data_input)) { - if (grepl("\\.(fasta|fas|nexus|nex)$", data_input, ignore.case = TRUE)) { data <- read_aln(data_input) data_list <- tp_list(list(data)) data_path <- tp_write_data(data_list, data_file_name, dir) } else { - res_lib <- tp_find_data(data_input) # model_input has the name of a known model @@ -76,7 +62,6 @@ tp_data <- function(data_input, data_file_name = "tmp_data_file", dir = tp_tempd # OR data_input is a list (or a structured list) } else if (is.list(data_input)) { - # flatten the list data_list <- tp_list(data_input) # write json with input data @@ -90,7 +75,6 @@ tp_data <- function(data_input, data_file_name = "tmp_data_file", dir = tp_tempd } - #' Write data to file #' #' @param data_list A named list of data input @@ -101,45 +85,17 @@ tp_data <- function(data_input, data_file_name = "tmp_data_file", dir = tp_tempd #' @returns The path to the created file #' #' @export -tp_write_data <- function(data_list, data_file_name = "tmp_data_file", dir = tp_tempdir()) { - - input_json <- jsonlite::toJSON(data_list, auto_unbox=TRUE) +tp_write_data <- function(data_list, + data_file_name = "tmp_data_file", + dir = tp_tempdir()) { + input_json <- jsonlite::toJSON(data_list, auto_unbox = TRUE) path <- paste0(dir, data_file_name, ".json") write(input_json, file = path) return(path) - } - -#' Create a flat list -#' -#' @description -#' `tp_list` takes a variable number of arguments and returns a list. -#' -#' @param ... Variadic arguments (see details). -#' -#' @details -#' This function takes a variable number of arguments, so that users can pass as -#' arguments either independent lists, or a single structured -#' list of list (name_arg = value_arg). -#' -#' @return A list. -tp_list <- function(...) { - dotlist <- list(...) - - if (length(dotlist) == 1L && is.list(dotlist[[1]])) { - dotlist <- dotlist[[1]] - } - - dotlist -} - - - # UTILS: Data conversion - - ## Sequence data # Read alignment in FASTA or NEXUS (for tree inference) @@ -212,7 +168,6 @@ read_aln <- function(file) { } } - ## Phylogenetic trees #' Convert phylo obj to TreePPL tree @@ -233,7 +188,6 @@ read_aln <- function(file) { #' #' @export tp_phylo_to_tpjson <- function(phylo_tree, age = "") { - name <- "tree" root_tree <- tp_phylo_to_tppl_tree(phylo_tree) @@ -293,7 +247,7 @@ tp_phylo_to_tppl_tree <- function(phylo_tree) { } } } - list(root_index,tree) + list(root_index, tree) } #' Calculate age in a tppl_tree @@ -396,8 +350,6 @@ rec_tree_list <- function(tree, row_index) { pjs_list } - - #' Convert TreePPL multi-line JSON to R phylo/multiPhylo object with associated #' weights #' @@ -415,11 +367,9 @@ rec_tree_list <- function(tree, row_index) { #' $weights: A numeric vector of sample weights. #' @export tp_json_to_phylo <- function(json_out) { - res <- try(file.exists(json_out), silent = TRUE) # If path exists, import output from file if (!is(res, "try-error") && res) { - ## Read lines and parse each line as a separate JSON object raw_lines <- readLines(json_out, warn = FALSE) @@ -427,7 +377,8 @@ tp_json_to_phylo <- function(json_out) { raw_lines <- raw_lines[raw_lines != ""] json_list <- lapply(raw_lines, function(x) { - jsonlite::fromJSON(x, simplifyVector = FALSE)}) + jsonlite::fromJSON(x, simplifyVector = FALSE) + }) # If path doesn't exist, then it should be a list } else if (is.list(json_out)) { @@ -438,12 +389,10 @@ tp_json_to_phylo <- function(json_out) { ## Process each tree in the list newick_strings <- sapply(json_list, function(sweep) { - # loop over all particles within the sweep samples <- sweep$samples sweep_string <- sapply(samples, function(particle) { - # Extract the root age root_data <- particle[[1]]$`__data__` root_age <- root_data$age @@ -466,7 +415,6 @@ tp_json_to_phylo <- function(json_out) { # 5. Get weight for each tree nweight_matrix <- sapply(json_list, function(sweep) { - nconst <- sweep$normConst logweights <- unlist(sweep$weights) log_nw <- nconst + logweights @@ -479,11 +427,9 @@ tp_json_to_phylo <- function(json_out) { return(list(trees = trees, weights = norm_weights)) } - # 2. Recursive function to build Newick string # 'parent_age' is passed down from the caller build_newick_node <- function(node, parent_age) { - type <- node[["__constructor__"]] data <- node[["__data__"]] @@ -494,7 +440,7 @@ build_newick_node <- function(node, parent_age) { # Rule: Leaf branch length is the age of its parent node len <- parent_age - if (is.null(data$label)){ + if (is.null(data$label)) { label <- data$index } else { label <- data$label @@ -517,15 +463,16 @@ build_newick_node <- function(node, parent_age) { } } - # Function to ladderize tree and correct tip label sequence -ladderize_tree <- function(tree, temp_file = "temp", orientation = "left"){ - if(file.exists(paste0("./", temp_file))){ +ladderize_tree <- function(tree, + temp_file = "temp", + orientation = "left") { + if (file.exists(paste0("./", temp_file))) { stop("The chosen temporary file exists! Please choose an other temp_file name") } - if(orientation == "left"){ + if (orientation == "left") { right <- FALSE - }else{ + } else{ right <- TRUE } tree_temp <- ape::ladderize(tree, right = right) @@ -534,8 +481,3 @@ ladderize_tree <- function(tree, temp_file = "temp", orientation = "left"){ file.remove(paste0("./", temp_file, ".tre")) return(tree_lad) } - - - - - diff --git a/R/model.R b/R/model.R new file mode 100644 index 0000000..6f8c574 --- /dev/null +++ b/R/model.R @@ -0,0 +1,234 @@ +#TODO : Automatic extraction from tpplc --help (sorted) +#The goal is to let the compiler do most of the work +#This list only exist to avoid to recompilate if not needed +tpplcCompileOptions <- c( + "align", + "cps", + "drift", + "dynamic-delay", + "incremental-printing", + "kernel", + "method", + "pigeons", + "pigeons-no-global", + "pigeons-explore-steps", + "prune ", + "resample", + "static-delay" +) + +#' Options that can be passed to TreePPL compiler +#' +#' @returns A data frame with the output from the compiler's help +#' +tp_compile_options <- function() { + 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) +} + +#Separation between compile and over options (can be runtime or mistake, +#that the compiler to determine) +list_to_options <- function(user_list) { + options <- list(compile = list(), runtime = list()) + if (length(user_list) != 0) { + for (name in tpplcCompileOptions) { + options[["compile"]][[name]] <- user_list[[name]] + } + for (name in names(user_list)) { + if (is.null(options[["compile"]][[name]])) { + options[["runtime"]][[name]] <- user_list[[name]] + } + } + } + options +} + +#' 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]]) + } else { + if (args_vec[[i]]) { + str <- paste0("--", names(args_vec[i])) + } + } + vec <- c(vec, str) + } + args_str <- paste(vec, collapse = " ") + } + args_str +} + +#' TreePPL model template +#' +#' @description +#' `tp_modelT` template for TreePPL code carrying all the informations necessary +#' for compiling and running this model efficently + +compiled_model_Template <- + setRefClass( + "compiled_model_Template", + fields = list( + exe_list = "list", + path = "character", + default_options = "list" + ), + methods = list( + ###################### + get_exe = function(options) { + str_options <- options_to_string(options) + exe <- exe_list[[paste(path,str_options)]] + if (is.null(exe)) { + exe <- compilation(path, str_options) + exe_list[[str_options]] <<- exe + } + exe + } + ) + ) + +#' Compile a TreePPL model and create inference machinery +#' +#' @description +#' `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/.exe +#' @param ... See tp_compile_options() for all supported arguments. +#' +#' @return The path for the compiled TreePPL program. + +compilation <- function(path, args_str) { + options(scipen = 999) + + dir_path <- tp_tempdir() + + # output + output_path <- paste0(dir_path, digest::digest(paste(path,args_str), "sha256"), ".exe") + + options <- paste("--output", output_path, args_str) + + # Preparing the command line program + tpplc_path <- tp_installing_treeppl() + command <- paste(tpplc_path, path, options) + + # Compile program + # Empty LD_LIBRARY_PATH from R_env for this command specifically + # due to conflict with internal env from treeppl self-contained + res <- system(paste0("LD_LIBRARY_PATH= ", command), intern = FALSE) + if (res == 1L) { + stop("Compilation failed") + } + return(output_path) +} + +#' Write out a custom model to tp_tempdir() +#' +#' @param model A string containing the entire TreePPL code. +#' @param model_file_name An optional name to the file created +#' +#' @returns The path to the file created +#' @export +#' +tp_write_model <- function(model, model_file_name = "tmp_model_file") { + + path <- paste0(tp_tempdir(), model_file_name, ".tppl") + cat(model, file = path) + + return(path) +} + +#' Create a TreePPL model +#' +#' @description +#' `tp_compile` takes TreePPL model and prepares it 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. +#' +#' @return compiled_model from a compiled_model_Template +#' @export + +tp_compile <- function(model, method = "mcmc", ...) { + if (!assertthat::is.string(model)) { + stop("Input has to be a sring.") + } + + res <- try(file.exists(model), silent = TRUE) + + # If path exists, it's all good + if (!is(res, "try-error") && res) { + model_path <- model + # If path doesn't exist + } else { + # It can be a model name in the library + res_lib <- try(tp_find_model(model), silent = TRUE) + # model has the name of a known model + if (!is(res_lib, "try-error") && length(res_lib) != 0) { + model_path <- res_lib + # OR model contains the model + #### (needs to be verified as an appropriate model later) #### + } else { + model_path <- tp_write_model(model) + } + } + m <- new("compiled_model_Template", path = model_path) + user_list <- append(tp_list(...), list(method = method)) + tmp <- list_to_options(user_list) + + m$default_options <- tmp + m$get_exe(tmp[["compile"]]) + return(m) +} diff --git a/R/run.R b/R/run.R index 9926bf1..5e0b15a 100644 --- a/R/run.R +++ b/R/run.R @@ -1,18 +1,3 @@ -#' Options that can be passed to a TreePPL program -#' -#' @returns A string with the output from the executable's help -#' @export -#' -tp_run_options <- function() { - - #### under development here and in treeppl #### - - # text from treeppl executable --help - return() - -} - - #' Run a TreePPL program #' #' @description @@ -22,8 +7,6 @@ tp_run_options <- function() { #' 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 n_runs When using MCMC, a [base::integer] giving the number of runs to be done. -#' @param n_sweeps When using SMC, a [base::integer] giving the number of SMC sweeps to be done. #' @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 @@ -44,7 +27,7 @@ tp_run_options <- function() { #' data_path <- tp_data(data_input = "coin") #' #' # run TreePPL -#' result <- tp_run(exe_path, data_path, n_sweeps = 2) +#' result <- tp_run(exe_path, data_path, sweeps = 2) #' #' #' # When using MCMC @@ -60,27 +43,10 @@ tp_run_options <- function() { tp_run <- function(compiled_model, data, - n_runs = 1, - n_sweeps = 1, dir = NULL, out_file_name = "out", ...) { - - if(is.null(n_runs) & is.null(n_sweeps)){ - stop("At least one of n_runs and n_sweeps needs to be passed") - } - - #n_string <- "" - #if(!is.null(n_runs)){ - #### change to --iterations when it's fixed in treeppl #### - #n_string <- paste0(n_string, "--sweeps ", n_runs, " ") - #} - - #if(!is.null(n_sweeps)){ - #n_string <- paste0(n_string, "--sweeps ", n_sweeps, " ") - #} - - if(is.null(dir)){ + if (is.null(dir)) { dir_path <- tp_tempdir() } else { dir_path <- dir @@ -88,14 +54,28 @@ tp_run <- function(compiled_model, output_path <- paste0(dir_path, out_file_name, ".json") + #If a list have multiple time the same key + # list[[key]] will return the first key + # Exemple + #> lis <- list(method = "mcmc", method = "smc") + #> lis[["method"]] => "mcmc" + # So the user list have priority + options <- + list_to_options(append( + tp_list(...), + append(compiled_model$default_options[["compile"]], + compiled_model$default_options[["runtime"]]) + )) + # 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, - data, - #n_string, - paste(">", output_path) - ) + command <- paste( + "LD_LIBRARY_PATH= ", + compiled_model$get_exe(options[["compile"]]), + data, + options_to_string(options[["runtime"]]), + paste(">", output_path) + ) system(command) # simple parsing @@ -105,6 +85,3 @@ tp_run <- function(compiled_model, return(json_out) } - - - diff --git a/R/utils.R b/R/utils.R index d99b2fa..ff5dbde 100644 --- a/R/utils.R +++ b/R/utils.R @@ -131,7 +131,6 @@ sep <- function() { .Platform$file.sep } - #' Model names supported by treepplr #' #' @description Provides a list of all models in the TreePPL model library. @@ -162,22 +161,27 @@ tp_model_library <- function() { rs <- rs[order(rs$category, rs$model_name, decreasing = FALSE), ] rownames(rs) <- NULL rs - } - # 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) + version <- unlist(strsplit(Sys.getenv("MCORE_LIBS"), "treeppl="))[2] + if (!is.na(version)) { + version <- list.files(version, pattern = "lib", full.names = TRUE) + version <- list.files(version, pattern = "models", full.names = TRUE) + # path to the required model + fd <- list.files(path = version, pattern = paste0(model_name, ext), recursive = TRUE, full.names = TRUE) + } else { + 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) } - # Find model for model_name tp_find_model <- function(model_name) { tp_find(model_name, ".tppl") @@ -187,3 +191,27 @@ tp_find_model <- function(model_name) { tp_find_data <- function(model_name) { tp_find(model_name, ".json") } + +#' Create a flat list +#' +#' @description +#' `tp_list` takes a variable number of arguments and returns a list. +#' +#' @param ... Variadic arguments (see details). +#' +#' @details +#' This function takes a variable number of arguments, so that users can pass as +#' arguments either independent lists, or a single structured +#' list of list (name_arg = value_arg). +#' +#' @return A list. +#' @export +tp_list <- function(...) { + dotlist <- list(...) + + if (length(dotlist) == 1L && is.list(dotlist[[1]])) { + dotlist <- dotlist[[1]] + } + + dotlist +} diff --git a/R/zzz.R b/R/zzz.R index 18ca431..c94b4a5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -7,7 +7,7 @@ ################## #'@export -TPPLC_VERSION <- "0.3" +TPPLC_VERSION <- "0.3.1" .onLoad <- function(libname, pkgname){ tp_installing_treeppl(download = FALSE) diff --git a/man/compilation.Rd b/man/compilation.Rd new file mode 100644 index 0000000..3b4c31d --- /dev/null +++ b/man/compilation.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{compilation} +\alias{compilation} +\title{Compile a TreePPL model and create inference machinery} +\usage{ +compilation(path, args_str) +} +\arguments{ +\item{model}{One of tree options: +\itemize{ +\item The full path of the model file that contains the TreePPL code, OR +\item A string with the name of a model supported by treepplr +(see \code{\link[=tp_model_library]{tp_model_library()}}), OR +\item A string containing the entire TreePPL code. +}} + +\item{method}{Inference method to be used. See tp_compile_options() +for all supported methods.} + +\item{iterations}{The number of MCMC iterations to be run.} + +\item{particles}{The number of SMC particles to be run.} + +\item{dir}{The directory where you want to save the executable. Default is +\code{\link[base:tempdir]{base::tempdir()}}} + +\item{output}{Complete path to the compiled TreePPL program that will be +created. Default is dir/\if{html}{\out{}}.exe} + +\item{...}{See tp_compile_options() for all supported arguments.} +} +\value{ +The path for the compiled TreePPL program. +} +\description{ +\code{compilation} compile a TreePPL model and create inference machinery to be +used by \link{tp_run}. +} diff --git a/man/compiled_model_Template-class.Rd b/man/compiled_model_Template-class.Rd new file mode 100644 index 0000000..f2ff692 --- /dev/null +++ b/man/compiled_model_Template-class.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\docType{class} +\name{compiled_model_Template-class} +\alias{compiled_model_Template-class} +\alias{compiled_model_Template} +\title{TreePPL model template} +\description{ +\code{tp_modelT} template for TreePPL code carrying all the informations necessary +for compiling and running this model efficently +} + diff --git a/man/options_to_string.Rd b/man/options_to_string.Rd new file mode 100644 index 0000000..3a2d299 --- /dev/null +++ b/man/options_to_string.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model.R +\name{options_to_string} +\alias{options_to_string} +\title{Convert options to a proper string of flags, e.g., \verb{_} to \code{-}, +adding \verb{--} in the beginning, spaces between things, etc.} +\usage{ +options_to_string(options) +} +\description{ +Convert options to a proper string of flags, e.g., \verb{_} to \code{-}, +adding \verb{--} in the beginning, spaces between things, etc. +} diff --git a/man/tp_compile.Rd b/man/tp_compile.Rd index 922289a..1799a58 100644 --- a/man/tp_compile.Rd +++ b/man/tp_compile.Rd @@ -1,18 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/compile.R +% Please edit documentation in R/model.R \name{tp_compile} \alias{tp_compile} -\title{Compile a TreePPL model and create inference machinery} +\title{Create a TreePPL model} \usage{ -tp_compile( - model, - method, - iterations = NULL, - particles = NULL, - dir = NULL, - output = NULL, - ... -) +tp_compile(model, method = "mcmc", ...) } \arguments{ \item{model}{One of tree options: @@ -22,26 +14,11 @@ tp_compile( (see \code{\link[=tp_model_library]{tp_model_library()}}), OR \item A string containing the entire TreePPL code. }} - -\item{method}{Inference method to be used. See tp_compile_options() -for all supported methods.} - -\item{iterations}{The number of MCMC iterations to be run.} - -\item{particles}{The number of SMC particles to be run.} - -\item{dir}{The directory where you want to save the executable. Default is -\code{\link[base:tempfile]{base::tempdir()}}} - -\item{output}{Complete path to the compiled TreePPL program that will be -created. Default is dir/\if{html}{\out{}}.exe} - -\item{...}{See tp_compile_options() for all supported arguments.} } \value{ -The path for the compiled TreePPL program. +compiled_model from a compiled_model_Template } \description{ -\code{tp_compile} compile a TreePPL model and create inference machinery to be -used by \link{tp_run}. +\code{tp_compile} takes TreePPL model and prepares it to be used by +\code{\link[=tp_run]{tp_run()}}. } diff --git a/man/tp_compile_options.Rd b/man/tp_compile_options.Rd index c3f8f7d..78c691f 100644 --- a/man/tp_compile_options.Rd +++ b/man/tp_compile_options.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/compile.R +% Please edit documentation in R/model.R \name{tp_compile_options} \alias{tp_compile_options} \title{Options that can be passed to TreePPL compiler} @@ -12,10 +12,3 @@ A data frame with the output from the compiler's help \description{ Options that can be passed to TreePPL compiler } -\examples{ -\dontrun{ -a <- tp_compile_options() -view(a) -} - -} diff --git a/man/tp_data.Rd b/man/tp_data.Rd index b02c9a4..ca79893 100644 --- a/man/tp_data.Rd +++ b/man/tp_data.Rd @@ -20,7 +20,7 @@ or nexus (.nexus, .nex) format, OR is the name of a model from the TreePPL library.} \item{dir}{The directory where you want to save the data file in JSON format. -Default is \code{\link[base:tempfile]{base::tempdir()}}. Ignored if \code{data_input} is the name of a model +Default is \code{\link[base:tempdir]{base::tempdir()}}. Ignored if \code{data_input} is the name of a model from the TreePPL library.} } \value{ diff --git a/man/tp_expected_input.Rd b/man/tp_expected_input.Rd deleted file mode 100644 index a312c05..0000000 --- a/man/tp_expected_input.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\name{tp_expected_input} -\alias{tp_expected_input} -\title{List expected input variables for a model} -\usage{ -tp_expected_input(model) -} -\arguments{ -\item{model}{A TreePPL model} -} -\value{ -The expected input data for a given TreePPL model. -} -\description{ -List expected input variables for a model -} diff --git a/man/tp_list.Rd b/man/tp_list.Rd index f6d953e..398c14d 100644 --- a/man/tp_list.Rd +++ b/man/tp_list.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R +% Please edit documentation in R/utils.R \name{tp_list} \alias{tp_list} \title{Create a flat list} diff --git a/man/tp_model.Rd b/man/tp_model.Rd deleted file mode 100644 index 7d9183e..0000000 --- a/man/tp_model.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/compile.R -\name{tp_model} -\alias{tp_model} -\title{Import a TreePPL model} -\usage{ -tp_model(model_input) -} -\arguments{ -\item{model_input}{One of tree options: -\itemize{ -\item The full path of the model file that contains the TreePPL code, OR -\item A string with the name of a model supported by treepplr -(see \code{\link[=tp_model_library]{tp_model_library()}}), OR -\item A string containing the entire TreePPL code. -}} -} -\value{ -The path to the TreePPL model file -} -\description{ -\code{tp_model} takes TreePPL code and prepares it to be used by -\code{\link[=tp_compile]{tp_compile()}}. -} diff --git a/man/tp_phylo_to_tpjson.Rd b/man/tp_phylo_to_tpjson.Rd index bad16bb..9ece977 100644 --- a/man/tp_phylo_to_tpjson.Rd +++ b/man/tp_phylo_to_tpjson.Rd @@ -7,7 +7,7 @@ tp_phylo_to_tpjson(phylo_tree, age = "") } \arguments{ -\item{phylo_tree}{an object of class \link[ape:read.tree]{ape::phylo}.} +\item{phylo_tree}{an object of class \link[ape:phylo]{ape::phylo}.} \item{age}{a string that determines the way the age of the nodes are calculated (default "branch-length"). diff --git a/man/tp_phylo_to_tppl_tree.Rd b/man/tp_phylo_to_tppl_tree.Rd index 08427d6..75ea790 100644 --- a/man/tp_phylo_to_tppl_tree.Rd +++ b/man/tp_phylo_to_tppl_tree.Rd @@ -7,7 +7,7 @@ tp_phylo_to_tppl_tree(phylo_tree) } \arguments{ -\item{phylo_tree}{an object of class \link[ape:read.tree]{ape::phylo}.} +\item{phylo_tree}{an object of class \link[ape:phylo]{ape::phylo}.} } \value{ A pair (root index, tppl_tree) diff --git a/man/tp_run.Rd b/man/tp_run.Rd index 2053bfa..38dffbf 100644 --- a/man/tp_run.Rd +++ b/man/tp_run.Rd @@ -4,15 +4,7 @@ \alias{tp_run} \title{Run a TreePPL program} \usage{ -tp_run( - compiled_model, - data, - n_runs = 1, - n_sweeps = 1, - dir = NULL, - out_file_name = "out", - ... -) +tp_run(compiled_model, data, dir = NULL, out_file_name = "out", ...) } \arguments{ \item{compiled_model}{a \link[base:character]{base::character} with the full path to the compiled model @@ -21,12 +13,8 @@ outputted by \link{tp_compile}.} \item{data}{a \link[base:character]{base::character} with the full path to the data file in TreePPL JSON format (as outputted by \link{tp_data}).} -\item{n_runs}{When using MCMC, a \link[base:integer]{base::integer} giving the number of runs to be done.} - -\item{n_sweeps}{When using SMC, a \link[base:integer]{base::integer} giving the number of SMC sweeps to be done.} - \item{dir}{a \link[base:character]{base::character} with the full path to the directory where you -want to save the output. Default is \code{\link[base:tempfile]{base::tempdir()}}.} +want to save the output. Default is \code{\link[base:tempdir]{base::tempdir()}}.} \item{out_file_name}{a \link[base:character]{base::character} with the name of the output file in JSON format. Default is "out".} @@ -49,7 +37,7 @@ exe_path <- tp_compile(model = "coin", method = "smc-bpf", particles = 2000) data_path <- tp_data(data_input = "coin") # run TreePPL -result <- tp_run(exe_path, data_path, n_sweeps = 2) +result <- tp_run(exe_path, data_path, sweeps = 2) # When using MCMC diff --git a/man/tp_run_options.Rd b/man/tp_run_options.Rd deleted file mode 100644 index f31b7d4..0000000 --- a/man/tp_run_options.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run.R -\name{tp_run_options} -\alias{tp_run_options} -\title{Options that can be passed to a TreePPL program} -\usage{ -tp_run_options() -} -\value{ -A string with the output from the executable's help -} -\description{ -Options that can be passed to a TreePPL program -} diff --git a/man/tp_tempdir.Rd b/man/tp_tempdir.Rd index be02268..05577fb 100644 --- a/man/tp_tempdir.Rd +++ b/man/tp_tempdir.Rd @@ -7,14 +7,14 @@ tp_tempdir(temp_dir = NULL, sep = NULL, sub = NULL) } \arguments{ -\item{temp_dir}{NULL, or a path to be used; if NULL, R's \link[base:tempfile]{base::tempdir} +\item{temp_dir}{NULL, or a path to be used; if NULL, R's \link[base:tempdir]{base::tempdir} is used.} \item{sep}{Better ignored; non-default values are passed to \link[base:normalizePath]{base::normalizePath}.} \item{sub}{Extension for defining a sub-directory within the directory -defined by \link[base:tempfile]{base::tempdir}.} +defined by \link[base:tempdir]{base::tempdir}.} } \value{ Normalized path with system-dependent terminal separator. diff --git a/man/tp_write_data.Rd b/man/tp_write_data.Rd index 19bde93..de7cfe3 100644 --- a/man/tp_write_data.Rd +++ b/man/tp_write_data.Rd @@ -12,7 +12,7 @@ tp_write_data(data_list, data_file_name = "tmp_data_file", dir = tp_tempdir()) \item{data_file_name}{An optional name for the file created} \item{dir}{The directory where you want to save the data file in JSON format. -Default is \code{\link[base:tempfile]{base::tempdir()}}.} +Default is \code{\link[base:tempdir]{base::tempdir()}}.} } \value{ The path to the created file diff --git a/man/tp_write_model.Rd b/man/tp_write_model.Rd index a7c07a5..a539c64 100644 --- a/man/tp_write_model.Rd +++ b/man/tp_write_model.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/compile.R +% Please edit documentation in R/model.R \name{tp_write_model} \alias{tp_write_model} \title{Write out a custom model to tp_tempdir()} diff --git a/man/treepplr-package.Rd b/man/treepplr-package.Rd index 725ac45..108d026 100644 --- a/man/treepplr-package.Rd +++ b/man/treepplr-package.Rd @@ -20,5 +20,10 @@ Useful links: \author{ \strong{Maintainer}: Mariana P Braga \email{mpiresbr@gmail.com} (\href{https://orcid.org/0000-0002-1253-2536}{ORCID}) +Authors: +\itemize{ + \item Mariana P Braga \email{mpiresbr@gmail.com} (\href{https://orcid.org/0000-0002-1253-2536}{ORCID}) +} + } \keyword{internal} diff --git a/tests/testthat/test-compile.R b/tests/testthat/test-compile.R deleted file mode 100644 index 88f0bdd..0000000 --- a/tests/testthat/test-compile.R +++ /dev/null @@ -1,96 +0,0 @@ -temp_dir <- treepplr::tp_tempdir(temp_dir = NULL) -setwd(temp_dir) -require(testthat) -require(crayon) - -cat(crayon::yellow("\nTest-compile : Compilation.\n")) - - -test_that("Test-compile_1a : tp_compile SMC", { - cat("\tTest-compile_1a : tp_compile SMC \n") - - model <- treepplr::tp_model("coin") - - treepplr::tp_compile(model, method = "smc-bpf", particles = 10) - - expect_no_error(readBin(paste0(temp_dir, "coin.exe"), "raw", 10e6)) -}) - - -test_that("Test-compile_1b : tp_compile MCMC", { - cat("\tTest-compile_1b : tp_compile MCMC \n") - - model_right <- treepplr::tp_model("coin") - - treepplr::tp_compile(model_right, method = "mcmc-lightweight", iterations = 10) - - expect_no_error(readBin(paste0(temp_dir, "coin.exe"), "raw", 10e6)) - -}) - - -test_that("Test-compile_2a : tp_model model name", { - cat("\tTest-compile_2a : tp_model\n") - - model <- treepplr::tp_model("coin") - - version <- list.files("/tmp", - pattern = paste0("treeppl-", TPPLC_VERSION), - full.names = TRUE) - - model_right = system(paste0("find ", version," -name coin.tppl"), - intern = T) - - names(model_right) <- "coin" - - expect_equal(model, model_right) -}) - - -test_that("Test-compile_2b : tp_model model path ", { - cat("\tTest-compile_2b : tp_model\n") - - version <- list.files("/tmp", - pattern = paste0("treeppl-", TPPLC_VERSION), - full.names = TRUE) - - model_right = system(paste0("find ", version," -name coin.tppl"), - intern = T) - model <- treepplr::tp_model(model_right) - names(model_right) <- "custom_model" - - expect_equal(model, model_right) -}) - - -test_that("Test-compile_3a : tp_write path", { - cat("\tTest-compile_3a : tp_write\n") - - path <- treepplr::tp_write_model("T : bla bla bla") - expect_true(file.exists(path)) - -}) - - -test_that("Test-compile_3b : tp_write content", { - cat("\tTest-compile_3b : tp_write\n") - - content_right <- "M : bla bla bla" - path <- treepplr::tp_write_model(content_right) - - content <- readLines(path, warn = FALSE) - expect_equal(content_right, content) - -}) - - -test_that("Test-compile_4 : tp_model model string ", { - cat("\tTest-compile_4 : tp_model\n") - - model_string <- "S : bla bla bla" - model <- treepplr::tp_model(model_string) - model_right <- paste0(temp_dir, "tmp_model_file.tppl") - names(model_right) <- "custom_model" - - expect_equal(model, model_right) -}) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index ff7069c..5a7fc5c 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -12,43 +12,41 @@ test_that("Test-data_1a : tp_data name", { pattern = paste0("treeppl-", TPPLC_VERSION), full.names = TRUE) - data_right <- system(paste0("find ", version," -name testdata_coin.json"), - intern = T) + data_right <- system(paste0("find ", version, " -name testdata_coin.json"), intern = T) data <- treepplr::tp_data("coin") expect_equal(data, data_right) - }) - test_that("Test-data_1b : tp_data content", { cat("\tTest-data_1b \n") data_right <- - tp_list(coinflips = - c( - TRUE, - TRUE, - TRUE, - FALSE, - TRUE, - FALSE, - FALSE, - TRUE, - TRUE, - FALSE, - FALSE, - FALSE, - TRUE, - FALSE, - TRUE, - FALSE, - FALSE, - TRUE, - FALSE, - FALSE - ) + tp_list( + coinflips = + c( + TRUE, + TRUE, + TRUE, + FALSE, + TRUE, + FALSE, + FALSE, + TRUE, + TRUE, + FALSE, + FALSE, + FALSE, + TRUE, + FALSE, + TRUE, + FALSE, + FALSE, + TRUE, + FALSE, + FALSE + ) ) path <- treepplr::tp_data("coin") diff --git a/tests/testthat/test-model.R b/tests/testthat/test-model.R new file mode 100644 index 0000000..3839f4b --- /dev/null +++ b/tests/testthat/test-model.R @@ -0,0 +1,82 @@ +temp_dir <- treepplr::tp_tempdir(temp_dir = NULL) +setwd(temp_dir) +require(testthat) +require(crayon) + +#These tests are made for the interactions with the self-contain TreePPL + +cat(crayon::yellow("\nTest-model : Compilation and modification of the options.\n")) + +test_that("Test-model_1a : tp_compile MCMC", { + cat("\tTest-model_1a : tp_compile MCMC \n") + + model <- treepplr::tp_compile("coin") + + expect_no_error(readBin(model$exe_list[["--method mcmc"]], "raw", 10e6)) + +}) + +test_that("Test-model_1b : tp_compile method SMC", { + cat("\tTest-model_1b : tp_compile method SMC \n") + + model <- treepplr::tp_compile("coin", method = "smc-bpf") + + expect_no_error(readBin(model$exe_list[["--method smc-bpf"]], "raw", 10e6)) +}) + +test_that("Test-model_2a : tp_compile model name", { + cat("\tTest-model_2a : tp_compile\n") + + model <- treepplr::tp_compile("coin") + + version <- list.files("/tmp", + pattern = paste0("treeppl-", TPPLC_VERSION), + full.names = TRUE) + + model_right = system(paste0("find ", version, " -name coin.tppl"), intern = T) + + expect_equal(model$path, model_right) +}) + +test_that("Test-model_2b : tp_compile model path ", { + cat("\tTest-model_2b : tp_compile\n") + + version <- list.files("/tmp", + pattern = paste0("treeppl-", TPPLC_VERSION), + full.names = TRUE) + + model_right = system(paste0("find ", version, " -name coin.tppl"), intern = T) + model <- treepplr::tp_compile(model_right) + + expect_equal(model$path, model_right) +}) + +test_that("Test-model_3a : tp_write path", { + cat("\tTest-model_3a : tp_write\n") + + path <- treepplr::tp_write_model("model function bla() => Int {let bla = 1; return bla;}") + expect_true(file.exists(path)) +}) + + +test_that("Test-model_3b : tp_write content", { + cat("\tTest-model_3b : tp_write\n") + + content_right <- "model function bli() => Int {let bli = 2; return bli;}" + path <- treepplr::tp_write_model(content_right) + + content <- readLines(path, warn = FALSE) + expect_equal(content_right, content) + +}) + + +test_that("Test-model_4 : tp_compile model string ", { + cat("\tTest-model_4 : tp_compile\n") + + model_string <- "model function blo() => Int {let blo = 3; return blo;}" + model <- treepplr::tp_compile(model_string) + model_right <- paste0(temp_dir, "tmp_model_file.tppl") + + expect_equal(model$path, model_right) +}) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index 55aa6a7..a9c708e 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -8,26 +8,22 @@ cat(crayon::yellow("\nTest-run : Running TreePPL.\n")) test_that("Test-run_1a : tp_run", { cat("\tTest-run_1a : tp_run \n") - model <- treepplr::tp_model("coin") - exe <- treepplr::tp_compile(model, method = "smc-bpf", particles = 2) + compiled_model <- treepplr::tp_compile("coin", method = "smc-bpf", particles = 2) data <- treepplr::tp_data("coin") - treepplr::tp_run(exe, data, n_sweeps = 1) + result <- treepplr::tp_run(compiled_model, data, sweeps = 1) - expect_no_error(readBin(paste0(temp_dir, "out.json"), "raw", 10e6)) + expect_equal(2, length(result[[1]]$samples)) }) - test_that("Test-run_1a : tp_run custom name", { cat("\tTest-run_1a : tp_run \n") - model <- treepplr::tp_model("coin") - exe <- treepplr::tp_compile(model, method = "smc-bpf", particles = 2) + compiled_model <- treepplr::tp_compile("coin", method = "smc-bpf", particles = 2) data <- treepplr::tp_data("coin") - treepplr::tp_run(exe, data, n_sweeps = 1, out_file_name = "test_out") - - expect_no_error(readBin(paste0(temp_dir, "test_out.json"), "raw", 10e6)) + result <-treepplr::tp_run(compiled_model, data, sweeps = 1, out_file_name = "test_out", particles = 5) + expect_equal(5, length(result[[1]]$samples)) }) diff --git a/vignettes/coin-example.Rmd b/vignettes/coin-example.Rmd index 908db1e..5ce8836 100644 --- a/vignettes/coin-example.Rmd +++ b/vignettes/coin-example.Rmd @@ -178,7 +178,7 @@ This is done using the `tp_run` function. Let's run 10 sweeps (10 SMC runs, if you wish). ```{r, eval=FALSE} -output_list <- tp_run(compiled_model = exe_path, data = data, n_sweeps = 10) +output_list <- tp_run(compiled_model = exe_path, data = data, sweeps = 10) ``` ```{r, echo=FALSE} diff --git a/vignettes/crbd-example.Rmd b/vignettes/crbd-example.Rmd index 5c80c16..e93827d 100644 --- a/vignettes/crbd-example.Rmd +++ b/vignettes/crbd-example.Rmd @@ -28,7 +28,7 @@ library(treepplr) exe_path <- tp_compile("crbd", "smc-apf", particles = 5000) data_path <- tp_data("crbd") -output_list <- tp_run(exe_path, data_path, n_sweeps = 4) +output_list <- tp_run(exe_path, data_path, sweeps = 4) ``` ```{r, echo = FALSE} From 6af8becfab2302237e45f422d12adae3f9637204 Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Mon, 8 Jun 2026 17:59:44 +0200 Subject: [PATCH 12/15] Small mistake on get_exe --- R/model.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/model.R b/R/model.R index 6f8c574..b226677 100644 --- a/R/model.R +++ b/R/model.R @@ -113,7 +113,7 @@ compiled_model_Template <- ###################### get_exe = function(options) { str_options <- options_to_string(options) - exe <- exe_list[[paste(path,str_options)]] + exe <- exe_list[[str_options]] if (is.null(exe)) { exe <- compilation(path, str_options) exe_list[[str_options]] <<- exe From 8bf7c26352f92a385589ce83bba3a5ff00d580fa Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Thu, 11 Jun 2026 17:32:43 +0200 Subject: [PATCH 13/15] change internal exe handling one object = one ee --- DESCRIPTION | 2 +- R/model.R | 23 +++------ R/run.R | 13 +++-- R/utils.R | 97 ++++++++++++++++++++++++------------- tests/testthat/test-model.R | 4 +- 5 files changed, 78 insertions(+), 61 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f376295..89d7622 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: treepplr Title: R Interface to TreePPL -Version: 0.13.0 +Version: 0.14.0 Authors@R: person("Mariana", "P Braga", , "mpiresbr@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-1253-2536")) diff --git a/R/model.R b/R/model.R index b226677..176955b 100644 --- a/R/model.R +++ b/R/model.R @@ -105,21 +105,9 @@ compiled_model_Template <- setRefClass( "compiled_model_Template", fields = list( - exe_list = "list", + exe_path = "character", path = "character", - default_options = "list" - ), - methods = list( - ###################### - get_exe = function(options) { - str_options <- options_to_string(options) - exe <- exe_list[[str_options]] - if (is.null(exe)) { - exe <- compilation(path, str_options) - exe_list[[str_options]] <<- exe - } - exe - } + compile_options = "list" ) ) @@ -203,7 +191,7 @@ tp_write_model <- function(model, model_file_name = "tmp_model_file") { tp_compile <- function(model, method = "mcmc", ...) { if (!assertthat::is.string(model)) { - stop("Input has to be a sring.") + stop("Input has to be a string.") } res <- try(file.exists(model), silent = TRUE) @@ -228,7 +216,8 @@ tp_compile <- function(model, method = "mcmc", ...) { user_list <- append(tp_list(...), list(method = method)) tmp <- list_to_options(user_list) - m$default_options <- tmp - m$get_exe(tmp[["compile"]]) + m$compile_options <- tmp[["compile"]] + full_options = append(tmp[["compile"]], tmp[["runtime"]]) + m$exe_path <- compilation(m$path, options_to_string(full_options)) return(m) } diff --git a/R/run.R b/R/run.R index 5e0b15a..c14d1f2 100644 --- a/R/run.R +++ b/R/run.R @@ -60,18 +60,17 @@ tp_run <- function(compiled_model, #> lis <- list(method = "mcmc", method = "smc") #> lis[["method"]] => "mcmc" # So the user list have priority - options <- - list_to_options(append( - tp_list(...), - append(compiled_model$default_options[["compile"]], - compiled_model$default_options[["runtime"]]) - )) + options <- list_to_options(tp_list(...)) + + if(length(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$get_exe(options[["compile"]]), + compiled_model$exe_path, data, options_to_string(options[["runtime"]]), paste(">", output_path) diff --git a/R/utils.R b/R/utils.R index ff5dbde..74dfb4b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -11,7 +11,8 @@ #' #' @return The path for TreePPL compiler. #' @export -tp_installing_treeppl <- function(download = TRUE, keep_previous = FALSE) { +tp_installing_treeppl <- function(download = TRUE, + keep_previous = FALSE) { if (Sys.getenv("TPPLC") != "") { tpplc_path <- Sys.getenv("TPPLC") } else{ @@ -20,21 +21,25 @@ tp_installing_treeppl <- function(download = TRUE, keep_previous = FALSE) { "tpplc" } else { path_treeppl <- - list.files(path = paste0(.libPaths()[1], "/treeppl/", TPPLC_VERSION), - full.names = TRUE) + list.files( + path = paste0(.libPaths()[1], "/treeppl/", TPPLC_VERSION), + full.names = TRUE + ) } # Test if tpplc is already here - tpplc_path <- paste0("/tmp/treeppl-",TPPLC_VERSION,"/tpplc") - if(!file.exists(tpplc_path)) { - if(download && length(path_treeppl) == 0) { + tpplc_path <- paste0("/tmp/treeppl-", TPPLC_VERSION, "/tpplc") + if (!file.exists(tpplc_path)) { + 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) + 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) + utils::untar(path_treeppl, exdir = "/tmp", verbose = FALSE) message("TreePPL initialisation : Done") } } @@ -51,41 +56,51 @@ tp_fp_fetch <- function(keep_previous = FALSE) { # Check for Linux if (Sys.info()["sysname"] == "Linux") { # assets[[2]] because releases are in alphabetical order (1 = Mac, 2 = Linux) - name <- paste0("treeppl-",TPPLC_VERSION,"-x86_64-linux.tar.gz") + name <- paste0("treeppl-", TPPLC_VERSION, "-x86_64-linux.tar.gz") } else { - name <- paste0("treeppl-",TPPLC_VERSION,"-aarch64-darwin.tar.gz") + name <- paste0("treeppl-", TPPLC_VERSION, "-aarch64-darwin.tar.gz") } - url <- paste0("https://github.com/treeppl/treeppl/releases/download/v", - TPPLC_VERSION,"/",name) + 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) + 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) { - if(!keep_previous) { + 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) + 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) + 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) + system( + paste("mkdir", version_dir), + ignore.stdout = TRUE, + ignore.stderr = TRUE + ) # download fn <- paste(version_dir, name, sep = "/") - curl::curl_download( - url, - destfile = fn, - quiet = FALSE - ) + curl::curl_download(url, destfile = fn, quiet = FALSE) } } TPPLC_VERSION @@ -138,7 +153,6 @@ sep <- function() { #' @return A list of model names. #' @export tp_model_library <- function() { - # 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), @@ -148,7 +162,10 @@ tp_model_library <- function() { # add the rest of the path fd <- paste0(fd, "/lib/mcore/treeppl/models") # model names - mn <- list.files(fd, full.names = TRUE, recursive = TRUE, pattern = "\\.tppl$") + mn <- list.files(fd, + full.names = TRUE, + recursive = TRUE, + pattern = "\\.tppl$") subcategory <- grepl(".*models/([^/]+)/([^/]+)/([^/]+)\\.tppl$", mn) no_sub <- mn[!subcategory] @@ -171,13 +188,25 @@ tp_find <- function(model_name, ext) { version <- list.files(version, pattern = "lib", full.names = TRUE) version <- list.files(version, pattern = "models", full.names = TRUE) # path to the required model - fd <- list.files(path = version, pattern = paste0(model_name, ext), recursive = TRUE, full.names = TRUE) + fd <- list.files( + path = version, + pattern = paste0(model_name, ext), + recursive = TRUE, + full.names = TRUE + ) } else { - fd <- list.files("/tmp", pattern = paste0("treeppl-", TPPLC_VERSION), full.names = TRUE) + 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) + fd <- list.files( + path = fd, + pattern = paste0(model_name, ext), + recursive = TRUE, + full.names = TRUE + ) } return(fd) } diff --git a/tests/testthat/test-model.R b/tests/testthat/test-model.R index 3839f4b..7c6798e 100644 --- a/tests/testthat/test-model.R +++ b/tests/testthat/test-model.R @@ -12,7 +12,7 @@ test_that("Test-model_1a : tp_compile MCMC", { model <- treepplr::tp_compile("coin") - expect_no_error(readBin(model$exe_list[["--method mcmc"]], "raw", 10e6)) + expect_no_error(readBin(model$exe_path, "raw", 10e6)) }) @@ -21,7 +21,7 @@ test_that("Test-model_1b : tp_compile method SMC", { model <- treepplr::tp_compile("coin", method = "smc-bpf") - expect_no_error(readBin(model$exe_list[["--method smc-bpf"]], "raw", 10e6)) + expect_no_error(readBin(model$exe_path, "raw", 10e6)) }) test_that("Test-model_2a : tp_compile model name", { From 9b51cd1135bac02d4900a218bc64f8beb072c42c Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Mon, 6 Jul 2026 11:52:40 +0200 Subject: [PATCH 14/15] Update treeppl self-contain v0.4 --- DESCRIPTION | 1 + R/data.R | 2 +- R/zzz.R | 2 +- vignettes/coin-example.Rmd | 7 ++++--- 4 files changed, 7 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 89d7622..e30b375 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,6 +36,7 @@ Suggests: evolnets (>= 0.0.0.9000), treeio (>= 1.32.0), rmarkdown, + readr, pandoc, dplyr VignetteBuilder: knitr diff --git a/R/data.R b/R/data.R index 46a7d07..50d1c28 100644 --- a/R/data.R +++ b/R/data.R @@ -1,6 +1,7 @@ + #' Import data for TreePPL program #' #' @description @@ -66,7 +67,6 @@ tp_data <- function(data_input, data_list <- tp_list(data_input) # write json with input data data_path <- tp_write_data(data_list, data_file_name, dir) - } else { stop("Unknow R type (not a valid path, known data model, or list") } diff --git a/R/zzz.R b/R/zzz.R index c94b4a5..e89b8ce 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -7,7 +7,7 @@ ################## #'@export -TPPLC_VERSION <- "0.3.1" +TPPLC_VERSION <- "0.4" .onLoad <- function(libname, pkgname){ tp_installing_treeppl(download = FALSE) diff --git a/vignettes/coin-example.Rmd b/vignettes/coin-example.Rmd index 5ce8836..7a0198f 100644 --- a/vignettes/coin-example.Rmd +++ b/vignettes/coin-example.Rmd @@ -34,6 +34,7 @@ First load the required R packages: library(treepplr) library(dplyr) library(ggplot2) +library(readr) ``` ## Understanding the coin model @@ -44,11 +45,11 @@ can find all available models and some information about them [here](https://tre If you want to look at the TreePPL code here in R, you can use the following functions: ```{r, eval = FALSE} -model_path <- tp_model("coin") +model_path <- tp_compile("coin") ``` ```{r, eval=FALSE} -readr::read_file(model_path) +readr::read_file(model_path$path) ``` The main part of the model is defined in a function called `coinModel`: @@ -130,7 +131,7 @@ Now let's compile the model to en executable that also contains the necessary ma to run the chosen inference method. ```{r, eval = FALSE} -exe_path <- tp_compile(model = "coin", method = "smc-bpf", particles = 1000) +exe_path <- tp_compile(model = "coin", method = "smc-bpf", particles = 5000) ``` ## Data From 332a0ce734e8cc4c4ec1c3c0f1f112a5eb6152f3 Mon Sep 17 00:00:00 2001 From: ThimotheeV Date: Mon, 6 Jul 2026 14:32:52 +0200 Subject: [PATCH 15/15] Test can now handle local treePPL installation --- R/utils.R | 1 - tests/testthat/test-data.R | 26 ++++++++++++++++++++------ tests/testthat/test-model.R | 12 ++++++------ tests/testthat/test-run.R | 8 ++++---- 4 files changed, 30 insertions(+), 17 deletions(-) diff --git a/R/utils.R b/R/utils.R index 74dfb4b..67bd4d0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -185,7 +185,6 @@ tp_find <- function(model_name, ext) { # path to the model library version <- unlist(strsplit(Sys.getenv("MCORE_LIBS"), "treeppl="))[2] if (!is.na(version)) { - version <- list.files(version, pattern = "lib", full.names = TRUE) version <- list.files(version, pattern = "models", full.names = TRUE) # path to the required model fd <- list.files( diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 5a7fc5c..d162ab4 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -8,15 +8,29 @@ cat(crayon::yellow("\nTest-data : Import and convert data.\n")) test_that("Test-data_1a : tp_data name", { cat("\tTest-data_1a \n") - version <- list.files("/tmp", - pattern = paste0("treeppl-", TPPLC_VERSION), - full.names = TRUE) + version <- list.files("/tmp", + pattern = paste0("treeppl-", TPPLC_VERSION), + full.names = TRUE) + data_right <- system(paste0("find ", version, " -name testdata_coin.json"), intern = T) - data_right <- system(paste0("find ", version, " -name testdata_coin.json"), intern = T) + data <- treepplr::tp_data("coin") - data <- treepplr::tp_data("coin") + expect_equal(readr::read_file(data), readr::read_file(data_right)) +}) + +test_that("Test-data_1a_bis : tp_data name", { + cat("\tTest-data_1a_bis (local installed version) \n") + + version <- unlist(strsplit(Sys.getenv("MCORE_LIBS"), "treeppl="))[2] + if (!is.na(version)) { + data_right <- system(paste0("find ", version, " -name testdata_coin.json"), intern = T) + + data <- treepplr::tp_data("coin") - expect_equal(data, data_right) + expect_equal(readr::read_file(data), readr::read_file(data_right)) + } else { + expect_true(TRUE) + } }) test_that("Test-data_1b : tp_data content", { diff --git a/tests/testthat/test-model.R b/tests/testthat/test-model.R index 7c6798e..caafdb0 100644 --- a/tests/testthat/test-model.R +++ b/tests/testthat/test-model.R @@ -10,7 +10,7 @@ cat(crayon::yellow("\nTest-model : Compilation and modification of the options.\ test_that("Test-model_1a : tp_compile MCMC", { cat("\tTest-model_1a : tp_compile MCMC \n") - model <- treepplr::tp_compile("coin") + model <- treepplr::tp_compile("crbd") expect_no_error(readBin(model$exe_path, "raw", 10e6)) @@ -19,7 +19,7 @@ test_that("Test-model_1a : tp_compile MCMC", { test_that("Test-model_1b : tp_compile method SMC", { cat("\tTest-model_1b : tp_compile method SMC \n") - model <- treepplr::tp_compile("coin", method = "smc-bpf") + model <- treepplr::tp_compile("crbd", method = "smc-bpf") expect_no_error(readBin(model$exe_path, "raw", 10e6)) }) @@ -27,15 +27,15 @@ test_that("Test-model_1b : tp_compile method SMC", { test_that("Test-model_2a : tp_compile model name", { cat("\tTest-model_2a : tp_compile\n") - model <- treepplr::tp_compile("coin") + model <- treepplr::tp_compile("crbd") version <- list.files("/tmp", pattern = paste0("treeppl-", TPPLC_VERSION), full.names = TRUE) - model_right = system(paste0("find ", version, " -name coin.tppl"), intern = T) + model_right = system(paste0("find ", version, " -name crbd.tppl"), intern = T) - expect_equal(model$path, model_right) + expect_equal(readr::read_file(model$path), readr::read_file(model_right)) }) test_that("Test-model_2b : tp_compile model path ", { @@ -45,7 +45,7 @@ test_that("Test-model_2b : tp_compile model path ", { pattern = paste0("treeppl-", TPPLC_VERSION), full.names = TRUE) - model_right = system(paste0("find ", version, " -name coin.tppl"), intern = T) + model_right = system(paste0("find ", version, " -name crbd.tppl"), intern = T) model <- treepplr::tp_compile(model_right) expect_equal(model$path, model_right) diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index a9c708e..c9b83da 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -8,8 +8,8 @@ cat(crayon::yellow("\nTest-run : Running TreePPL.\n")) test_that("Test-run_1a : tp_run", { cat("\tTest-run_1a : tp_run \n") - compiled_model <- treepplr::tp_compile("coin", method = "smc-bpf", particles = 2) - data <- treepplr::tp_data("coin") + compiled_model <- treepplr::tp_compile("crbd", method = "smc-apf", particles = 2) + data <- treepplr::tp_data("crbd") result <- treepplr::tp_run(compiled_model, data, sweeps = 1) @@ -20,8 +20,8 @@ test_that("Test-run_1a : tp_run", { test_that("Test-run_1a : tp_run custom name", { cat("\tTest-run_1a : tp_run \n") - compiled_model <- treepplr::tp_compile("coin", method = "smc-bpf", particles = 2) - data <- treepplr::tp_data("coin") + compiled_model <- treepplr::tp_compile("crbd", method = "smc-apf", particles = 2) + data <- treepplr::tp_data("crbd") result <-treepplr::tp_run(compiled_model, data, sweeps = 1, out_file_name = "test_out", particles = 5)