From de7b348609644110f7e2d0dac46464981b93a0c4 Mon Sep 17 00:00:00 2001 From: gowerc Date: Fri, 10 Jan 2025 14:21:36 +0000 Subject: [PATCH] update to use on.exit --- R/utilities.R | 14 ++++++++------ tests/testthat/test-reproducibility.R | 4 ++-- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/utilities.R b/R/utilities.R index 5dd387fe..81c3e6b7 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -571,9 +571,14 @@ get_stan_model <- function() { # See https://github.com/insightsengineering/rbmi/issues/469 # Note that .Random.seed is only set if the seed has been set or if a random number # has been generated. - if (exists(".Random.seed")) { - current_seed_state <- .Random.seed - } + current_seed_state <- globalenv()$.Random.seed + on.exit({ + if (is.null(current_seed_state) && exists(".Random.seed", envir = globalenv())) { + rm(".Random.seed", envir = globalenv(), inherits = FALSE) + } else { + assign(".Random.seed", value = current_seed_state, envir = globalenv(), inherits = FALSE) + } + }) ensure_rstan() local_file <- file.path("inst", "stan", "MMRM.stan") @@ -600,9 +605,6 @@ get_stan_model <- function() { model_name = "rbmi_mmrm" ) - if (exists("current_seed_state")) { - .Random.seed <- current_seed_state - } return(model) } diff --git a/tests/testthat/test-reproducibility.R b/tests/testthat/test-reproducibility.R index adc09ecd..4532f6ca 100644 --- a/tests/testthat/test-reproducibility.R +++ b/tests/testthat/test-reproducibility.R @@ -175,8 +175,8 @@ test_that("Results are if model is recompiled", { ## Tidy up things that will never be the same: drawobj$formula <- NULL # Formulas contain environments specific to their build - drawobj$fit <- NULL # Bayes object has "fit" which contains a timestamp - anaobj$call <- NULL # Argument names are different (imputeobj2) + drawobj$fit <- NULL # Bayes object has "fit" which contains a timestamp + anaobj$call <- NULL # Argument names are different (imputeobj2) return(list( draws = drawobj,