diff --git a/NEWS.md b/NEWS.md index 2f942ccc..1bae0243 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,9 @@ keywords (@VisruthSK, #1154) set to `TRUE` for an entire R session via new global options. (#1159) * `cmdstan_model()` no longer fails when `MAKEFLAGS` enables directory-printing output while reading `STANCFLAGS` from `make`. (#1163) +* `laplace()` no longer overwrites the internally generated optimizer CSV when +`mode = NULL` and `output_basename` is supplied. The internally generated +optimizer CSV now uses the filename `-mode-1.csv`. * CmdStanModel objects created using `compile_model_methods = TRUE` that are then saved and reloaded no longer error in model fitting methods. Model methods diff --git a/R/model.R b/R/model.R index 0359678a..f432ccdb 100644 --- a/R/model.R +++ b/R/model.R @@ -1622,6 +1622,10 @@ laplace <- function(data = NULL, } } else { # mode = NULL, run optimize() checkmate::assert_list(opt_args, any.missing = FALSE, names = "unique", null.ok = TRUE) + mode_output_basename <- output_basename + if (!is.null(mode_output_basename)) { + mode_output_basename <- paste0(mode_output_basename, "-mode") + } args <- list( data = data, seed = seed, @@ -1629,7 +1633,7 @@ laplace <- function(data = NULL, init = init, save_latent_dynamics = FALSE, output_dir = output_dir, - output_basename = output_basename, + output_basename = mode_output_basename, sig_figs = sig_figs, threads = threads, opencl_ids = opencl_ids, diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index 6799c0f9..7c9d6edb 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -1,9 +1,5 @@ skip_if(os_is_macos()) -file_that_exists <- withr::local_tempfile(pattern = "placeholder_exists") -file.create(file_that_exists) -file_that_doesnt_exist <- withr::local_tempfile(pattern = "placeholder_doesnt_exist") - w_path <- function(f) { x <- sapply(f, function(fi) wsl_safe_path(absolute_path(fi))) names(x) <- NULL @@ -36,7 +32,16 @@ namespace bernoulli_external_model_namespace }" test_that("cmdstan_model works with user_header with mock", { + file_that_exists <- withr::local_tempfile(pattern = "placeholder_exists") + file_that_doesnt_exist <- withr::local_tempfile(pattern = "placeholder_doesnt_exist") tmpfile <- withr::local_tempfile(lines = hpp, fileext = ".hpp") + file.create(file_that_exists) + header_mtime <- Sys.time() + # On GHA Windows/R 4.1 files created close together sometimes compared equal + # and skipped the mocked recompile, so set the header mtime to be in the past + # and ensure the exe mtime is newer + Sys.setFileTime(file_that_exists, header_mtime - 10) + Sys.setFileTime(tmpfile, header_mtime) with_mocked_cli( compile_ret = list(status = 0), @@ -64,7 +69,10 @@ test_that("cmdstan_model works with user_header with mock", { ) # Check recompilation upon changing header + exe_mtime <- header_mtime + 10 + # Mocked compile does not create the executable that real compilation writes. file.create(file_that_exists) + Sys.setFileTime(file_that_exists, exe_mtime) with_mocked_cli( compile_ret = list(status = 0), info_ret = list(), @@ -73,7 +81,8 @@ test_that("cmdstan_model works with user_header with mock", { }) ) - Sys.setFileTime(tmpfile, Sys.time() + 1) # touch file to trigger recompile + header_mtime <- exe_mtime + 10 + Sys.setFileTime(tmpfile, header_mtime) # touch file to trigger recompile with_mocked_cli( compile_ret = list(status = 0), info_ret = list(), @@ -82,8 +91,9 @@ test_that("cmdstan_model works with user_header with mock", { }) ) - # mock does not automatically update file mtime - Sys.setFileTime(mod$exe_file(), Sys.time() + 1) # touch file to trigger recompile + # Mocked compile does not create the executable that real compilation writes. + file.create(mod$exe_file()) + Sys.setFileTime(mod$exe_file(), header_mtime + 10) # make exe newer than header # Alternative spec of user header with_mocked_cli( diff --git a/tests/testthat/test-model-laplace.R b/tests/testthat/test-model-laplace.R index 961883c8..3d4def90 100644 --- a/tests/testthat/test-model-laplace.R +++ b/tests/testthat/test-model-laplace.R @@ -62,6 +62,28 @@ test_that("laplace() runs when all arguments specified validly", { expect_s3_class(fit2, "CmdStanLaplace") }) +test_that("laplace() avoids output_basename conflict with internal optimize()", { + output_dir <- withr::local_tempdir("laplace-output-basename") + + utils::capture.output( + fit <- mod$laplace( + data = data_list, + seed = 123, + refresh = 0, + output_dir = output_dir, + output_basename = "custom-laplace", + draws = 10 + ) + ) + + expect_equal(basename(fit$output_files()), "custom-laplace-1.csv") + expect_equal(basename(fit$mode()$output_files()), "custom-laplace-mode-1.csv") + expect_setequal( + list.files(output_dir, pattern = "\\.csv$"), + c("custom-laplace-1.csv", "custom-laplace-mode-1.csv") + ) +}) + test_that("laplace() all valid 'mode' inputs give same results", { utils::capture.output({ mode <- mod$optimize(data = data_list, jacobian = TRUE, seed = 100, refresh = 0)