diff --git a/NEWS.md b/NEWS.md index a3af9b3b2..36f60429e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # cmdstanr 0.4.0.9000 +### Bug fixes + +* Fixed bug that caused stdour/stderr not being read at the end of +optimization. (#522) + +### New features + * Default directory changed to `.cmdstan` instead of `.cmdstanr` so that CmdStanPy and CmdStanR can use the same CmdStan installations. Using `.cmdstanr` will continue to be supported until version 1.0 but `install_cmdstan()` will now diff --git a/R/data.R b/R/data.R index 0d3a43bb8..57d50f688 100644 --- a/R/data.R +++ b/R/data.R @@ -243,10 +243,7 @@ process_fitted_params <- function(fitted_params) { } ) sampler_diagnostics <- tryCatch( - fitted_params$sampler_diagnostics(), - error = function(cond) { - NULL - } + fitted_params$sampler_diagnostics() ) paths <- draws_to_csv(draws, sampler_diagnostics) } else if (checkmate::test_r6(fitted_params, "CmdStanVB")) { diff --git a/R/install.R b/R/install.R index 8fdb6f3fb..eae3600df 100644 --- a/R/install.R +++ b/R/install.R @@ -154,7 +154,7 @@ install_cmdstan <- function(dir = NULL, cmdstan_make_local(dir = dir_cmdstan, cpp_options = cpp_options, append = TRUE) version <- read_cmdstan_version(dir_cmdstan) if (os_is_windows()) { - if (version >= "2.24" && R.version$major >= "4") { + if (version >= "2.24" && R.version$major >= "4" && !("PRECOMPILED_HEADERS" %in% toupper(names(cpp_options)))) { # cmdstan 2.24 can use precompiled headers with RTools 4.0 to speedup compiling cmdstan_make_local( dir = dir_cmdstan, @@ -371,36 +371,6 @@ build_cmdstan <- function(dir, ) } -# Removes files that are used to simplify switching to using threading, opencl or mpi. -clean_compile_helper_files <- function() { - # remove main_.*.o files and model_header_.*.hpp.gch files - files_to_remove <- c( - list.files( - path = file.path(cmdstan_path(), "src", "cmdstan"), - pattern = "main.*\\.o$", - full.names = TRUE - ), - list.files( - path = file.path(cmdstan_path(), "src", "cmdstan"), - pattern = "main.*\\.d$", - full.names = TRUE - ), - list.files( - path = file.path(cmdstan_path(), "stan", "src", "stan", "model"), - pattern = "model_header.*\\.hpp.gch$", - full.names = TRUE - ), - list.files( - path = file.path(cmdstan_path(), "stan", "src", "stan", "model"), - pattern = "model_header.*\\.d$", - full.names = TRUE - ) - ) - if (!is.null(files_to_remove)) { - file.remove(files_to_remove) - } -} - clean_cmdstan <- function(dir = cmdstan_path(), cores = getOption("mc.cores", 2), quiet = FALSE) { @@ -414,13 +384,12 @@ clean_cmdstan <- function(dir = cmdstan_path(), error_on_status = FALSE, stderr_callback = function(x, p) { if (quiet) message(x) } ) - clean_compile_helper_files() } build_example <- function(dir, cores, quiet, timeout) { processx::run( make_cmd(), - args = c(paste0("-j", cores), cmdstan_ext("examples/bernoulli/bernoulli")), + args = c(paste0("-j", cores), cmdstan_ext(file.path("examples", "bernoulli", "bernoulli"))), wd = dir, echo_cmd = is_verbose_mode(), echo = !quiet || is_verbose_mode(), diff --git a/R/model.R b/R/model.R index d8ca493d6..7777d3752 100644 --- a/R/model.R +++ b/R/model.R @@ -457,18 +457,7 @@ compile <- function(quiet = TRUE, } } - stancflags_val <- "" - if (!is.null(include_paths)) { - checkmate::assert_directory_exists(include_paths, access = "r") - include_paths <- absolute_path(include_paths) - include_paths <- paste0(include_paths, collapse = ",") - if (cmdstan_version() >= "2.24") { - include_paths_flag <- " --include-paths=" - } else { - include_paths_flag <- " --include_paths=" - } - stancflags_val <- paste0(stancflags_val, include_paths_flag, include_paths, " ") - } + stancflags_val <- include_paths_stanc3_args(include_paths) if (pedantic) { stanc_options[["warn-pedantic"]] <- TRUE @@ -491,7 +480,7 @@ compile <- function(quiet = TRUE, stanc_built_options <- c(stanc_built_options, paste0("--", option_name, "=", "'", stanc_options[[i]], "'")) } } - stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(stanc_built_options, collapse = " ")) + stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stanc_built_options, collapse = " ")) run_log <- processx::run( command = make_cmd(), args = c(tmp_exe, @@ -612,18 +601,7 @@ check_syntax <- function(pedantic = FALSE, stanc_options[["warn-pedantic"]] <- TRUE } - stancflags_val <- NULL - if (!is.null(include_paths)) { - checkmate::assert_directory_exists(include_paths, access = "r") - include_paths <- absolute_path(include_paths) - include_paths <- paste0(include_paths, collapse = ",") - if (cmdstan_version() >= "2.24") { - include_paths_flag <- " --include-paths=" - } else { - include_paths_flag <- " --include_paths=" - } - stancflags_val <- trimws(paste0(include_paths_flag, include_paths, " ")) - } + stancflags_val <- include_paths_stanc3_args(include_paths) if (is.null(stanc_options[["name"]])) { stanc_options[["name"]] <- paste0(self$model_name(), "_model") @@ -1394,3 +1372,19 @@ cpp_options_to_compile_flags <- function(cpp_options) { } cpp_built_options } + +include_paths_stanc3_args <- function(include_paths = NULL) { + stancflags <- NULL + if (!is.null(include_paths)) { + checkmate::assert_directory_exists(include_paths, access = "r") + include_paths <- absolute_path(include_paths) + include_paths <- paste0(include_paths, collapse = ",") + if (cmdstan_version() >= "2.24") { + include_paths_flag <- "--include-paths=" + } else { + include_paths_flag <- "--include_paths=" + } + stancflags <- paste0(stancflags, include_paths_flag, include_paths) + } + stancflags +} \ No newline at end of file diff --git a/R/run.R b/R/run.R index ca9df9072..630e79a31 100644 --- a/R/run.R +++ b/R/run.R @@ -364,10 +364,8 @@ check_target_exe <- function(exe) { procs$poll(0) for (chain_id in chains) { if (!procs$is_queued(chain_id)) { - output <- procs$get_proc(chain_id)$read_output_lines() - procs$process_output(output, chain_id) - error_output <- procs$get_proc(chain_id)$read_error_lines() - procs$process_error_output(error_output, chain_id) + procs$process_output(chain_id) + procs$process_error_output(chain_id) } } procs$set_active_procs(procs$num_alive()) @@ -424,10 +422,8 @@ CmdStanRun$set("private", name = "run_sample_", value = .run_sample) procs$poll(0) for (chain_id in chains) { if (!procs$is_queued(chain_id)) { - output <- procs$get_proc(chain_id)$read_output_lines() - procs$process_output(output, chain_id) - error_output <- procs$get_proc(chain_id)$read_error_lines() - procs$process_error_output(error_output, chain_id) + procs$process_output(chain_id) + procs$process_error_output(chain_id) } } procs$set_active_procs(procs$num_alive()) @@ -460,13 +456,13 @@ CmdStanRun$set("private", name = "run_generate_quantities_", value = .run_genera procs$wait(0.1) procs$poll(0) if (!procs$is_queued(id)) { - output <- procs$get_proc(id)$read_output_lines() - procs$process_output(output, id) - error_output <- procs$get_proc(id)$read_error_lines() - procs$process_error_output(error_output, id) + procs$process_output(id) + procs$process_error_output(id) } procs$set_active_procs(procs$num_alive()) } + procs$process_output(id) + procs$process_error_output(id) successful_fit <- FALSE if (self$method() == "optimize") { if (procs$proc_state(id = id) > 3) { @@ -651,10 +647,8 @@ CmdStanProcs <- R6::R6Class( if (self$is_still_working(id) && !self$is_queued(id) && !self$is_alive(id)) { # if the process just finished make sure we process all # input and mark the process finished - output <- self$get_proc(id)$read_output_lines() - self$process_output(output, id) - error_output <- self$get_proc(id)$read_error_lines() - self$process_error_output(error_output, id) + self$process_output(id) + self$process_error_output(id) self$mark_proc_stop(id) self$report_time(id) } @@ -723,7 +717,8 @@ CmdStanProcs <- R6::R6Class( (grepl("A method must be specified!", line, perl = TRUE)) || (grepl("is not a valid value for", line, perl = TRUE)) }, - process_error_output = function(err_out, id) { + process_error_output = function(id) { + err_out <- self$get_proc(id)$read_error_lines() if (length(err_out)) { for (err_line in err_out) { private$proc_output_[[id]] <- c(private$proc_output_[[id]], err_line) @@ -733,7 +728,8 @@ CmdStanProcs <- R6::R6Class( } } }, - process_output = function(out, id) { + process_output = function(id) { + out <- self$get_proc(id)$read_output_lines() if (length(out) == 0) { return(NULL) } @@ -809,7 +805,8 @@ CmdStanMCMCProcs <- R6::R6Class( classname = "CmdStanMCMCProcs", inherit = CmdStanProcs, public = list( - process_output = function(out, id) { + process_output = function(id) { + out <- self$get_proc(id)$read_output_lines() if (length(out) == 0) { return(invisible(NULL)) } @@ -843,7 +840,7 @@ CmdStanMCMCProcs <- R6::R6Class( next_state <- 3 } if (state < 3 && grepl("Elapsed Time:", line, perl = TRUE)) { - state <- 5 # 5 = end of samp+ling + state <- 5 # 5 = end of sampling next_state <- 5 } if (private$proc_state_[[id]] == 3 && @@ -968,7 +965,8 @@ CmdStanGQProcs <- R6::R6Class( } invisible(self) }, - process_output = function(out, id) { + process_output = function(id) { + out <- self$get_proc(id)$read_output_lines() if (length(out) == 0) { return(NULL) } diff --git a/R/utils.R b/R/utils.R index 0b48fbf34..33347ef55 100644 --- a/R/utils.R +++ b/R/utils.R @@ -60,9 +60,7 @@ is_rosetta2 <- function() { # Returns the type of make command to use to compile depending on the OS make_cmd <- function() { - # CmdStan 2.21 introduced TBB that requires mingw32-make on Windows - ver <- .cmdstanr$VERSION - if (os_is_windows() && (is.null(ver) || ver >= "2.21")) { + if (os_is_windows()) { "mingw32-make.exe" } else { "make" diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index b89592885..b3a3a4e9c 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -277,7 +277,7 @@ test_that("compiling stops on hyphens in stanc_options", { test_that("compiling works with only names in list", { skip_on_cran() stan_file <- testing_stan_file("bernoulli") - mod <- cmdstan_model(stan_file, stanc_options = list("warn-pedantic"), force_recompile = TRUE, quiet = FALSE) + mod <- cmdstan_model(stan_file, stanc_options = list("warn-pedantic"), force_recompile = TRUE) checkmate::expect_r6( mod, "CmdStanModel" @@ -461,3 +461,24 @@ test_that("cpp_options_to_compile_flags() works", { options = list() expect_equal(cpp_options_to_compile_flags(options), NULL) }) + +test_that("include_paths_stanc3_args() works", { + expect_equal(include_paths_stanc3_args(), NULL) + path_1 <- file.path(tempdir(), "folder1") + if (!dir.exists(path_1)) { + dir.create(path_1) + } + path_1 <- repair_path(path_1) + expect_equal(include_paths_stanc3_args(path_1), paste0("--include-paths=", path_1)) + path_2 <- file.path(tempdir(), "folder2") + if (!dir.exists(path_2)) { + dir.create(path_2) + } + path_2 <- repair_path(path_2) + expect_equal( + include_paths_stanc3_args(c(path_1, path_2)), + c( + paste0("--include-paths=", path_1, ",", path_2) + ) + ) +})