From 5fb5f9b6d964798d95ad1d16efc50bffe97eb4c2 Mon Sep 17 00:00:00 2001 From: Brock Date: Wed, 18 Dec 2024 08:17:10 +0100 Subject: [PATCH] move exe file path resolution to separate function --- R/model.R | 77 ++++++++++++++++++++++++------------------------------- 1 file changed, 33 insertions(+), 44 deletions(-) diff --git a/R/model.R b/R/model.R index 8475327e..e9e3c780 100644 --- a/R/model.R +++ b/R/model.R @@ -275,25 +275,9 @@ CmdStanModel <- R6::R6Class( if (!is.null(stan_file) && compile) { self$compile(...) } else { - # set exe path, same logic as in compile - if(!is.null(private$dir_)){ - dir <- repair_path(absolute_path(private$dir_)) - assert_dir_exists(dir, access = "rw") - if (length(self$exe_file()) != 0) { - self$exe_file(file.path(dir, basename(self$exe_file()))) - } - } - if (length(self$exe_file()) == 0) { - if (is.null(private$dir_)) { - exe_base <- self$stan_file() - } else { - exe_base <- file.path(private$dir_, basename(self$stan_file())) - } - self$exe_file(cmdstan_ext(strip_ext(exe_base))) - if (dir.exists(self$exe_file())) { - stop("There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again.", call. = FALSE) - } - } + # resolve exe path with dir + exe <- resolve_exe_path(args$dir, private$dir_, self$exe_file(), self$stan_file()) + self$exe_file(exe) # exe_info is updated inside the compile method (if compile command is run) self$exe_info(update = TRUE) @@ -593,18 +577,6 @@ compile <- function(quiet = TRUE, include_paths <- private$precompile_include_paths_ } private$include_paths_ <- include_paths - if (is.null(dir) && !is.null(private$dir_)) { - dir <- absolute_path(private$dir_) - } else if (!is.null(dir)) { - dir <- absolute_path(dir) - } - if (!is.null(dir)) { - dir <- repair_path(dir) - assert_dir_exists(dir, access = "rw") - if (length(self$exe_file()) != 0) { - private$exe_file_ <- file.path(dir, basename(self$exe_file())) - } - } # temporary deprecation warnings if (isTRUE(threads)) { @@ -617,19 +589,7 @@ compile <- function(quiet = TRUE, warning("'compile_hessian_method' is deprecated. The hessian method is compiled with all models.") } - if (length(self$exe_file()) == 0) { - if (is.null(dir)) { - exe_base <- self$stan_file() - } else { - exe_base <- file.path(dir, basename(self$stan_file())) - } - exe <- cmdstan_ext(strip_ext(exe_base)) - if (dir.exists(exe)) { - stop("There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again.", call. = FALSE) - } - } else { - exe <- self$exe_file() - } + exe <- resolve_exe_path(dir, private$dir_, self$exe_file(), self$stan_file()) # Resolve stanc and cpp options if (pedantic) { @@ -2621,3 +2581,32 @@ model_compile_info_legacy <- function(exe_file) { } info } + +resolve_exe_path <- function(dir = NULL, private_dir = NULL, self_exe_file = NULL, self_stan_file = NULL) { + if (is.null(dir) && !is.null(private_dir)) { + dir <- absolute_path(private_dir) + } else if (!is.null(dir)) { + dir <- absolute_path(dir) + } + if (!is.null(dir)) { + dir <- repair_path(dir) + assert_dir_exists(dir, access = "rw") + if (length(self_exe_file) != 0) { + self_exe_file <- file.path(dir, basename(self_exe_file)) + } + } + if (length(self_exe_file) == 0) { + if (is.null(dir)) { + exe_base <- self_stan_file + } else { + exe_base <- file.path(dir, basename(self_stan_file)) + } + exe <- cmdstan_ext(strip_ext(exe_base)) + if (dir.exists(exe)) { + stop("There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again.", call. = FALSE) + } + } else { + exe <- self_exe_file + } + exe +} \ No newline at end of file