update to use on.exit

insightsengineering · Jan 10, 2025 · de7b348 · de7b348
1 parent 4d2a39e
commit de7b348
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 8 deletions.
diff --git 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
@@ -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,