diff --git a/R/utils.R b/R/utils.R index 964dc930..718b6ddd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -889,11 +889,11 @@ prep_fun_cpp <- function(fun_start, fun_end, model_lines) { fun_body <- gsub("std::ostream\\*\\s*pstream__\\s*=\\s*nullptr", "", fun_body) if (grepl("(stan::rng_t|boost::ecuyer1988)", fun_body)) { if (cmdstan_version() < "2.35.0") { - fun_body <- gsub("boost::ecuyer1988&\\s*base_rng__", "SEXP base_rng_ptr", fun_body) + fun_body <- gsub("boost::ecuyer1988&\\s*base_rng__", "SEXP base_rng_ptr, SEXP seed", fun_body) } else { - fun_body <- gsub("stan::rng_t&\\s*base_rng__", "SEXP base_rng_ptr", fun_body) + fun_body <- gsub("stan::rng_t&\\s*base_rng__", "SEXP base_rng_ptr, SEXP seed", fun_body) } - rng_seed <- "Rcpp::XPtr base_rng(base_rng_ptr);base_rng->seed(get_seed());" + rng_seed <- "Rcpp::XPtr base_rng(base_rng_ptr);base_rng->seed(Rcpp::as(seed));" fun_body <- gsub("return", paste(rng_seed, "return"), fun_body) fun_body <- gsub("base_rng__,", "*(base_rng.get()),", fun_body, fixed = TRUE) } @@ -957,6 +957,9 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) { fundef <- get(fun, envir = fun_env) funargs <- formals(fundef) funargs$base_rng_ptr <- env$rng_ptr + # To allow for exported RNG functions to respect the R 'set.seed()' call, + # we need to derive a seed deterministically from the current RNG state + funargs$seed <- quote(sample.int(.Machine$integer.max, 1)) formals(fundef) <- funargs assign(fun, fundef, envir = fun_env) } @@ -1003,9 +1006,3 @@ expose_stan_functions <- function(function_env, global = FALSE, verbose = FALSE) } invisible(NULL) } - -# To allow for exported RNG functions to respect the R 'set.seed()' call, -# we need to derive a seed deterministically from the current RNG state -get_seed <- function() { - sample.int(.Machine$integer.max, 1) -} diff --git a/inst/include/stan_rng.hpp b/inst/include/stan_rng.hpp index dd36218f..8dc55dde 100644 --- a/inst/include/stan_rng.hpp +++ b/inst/include/stan_rng.hpp @@ -15,13 +15,4 @@ namespace stan { } #endif -// To ensure that exported RNG functions respect changes to R's RNG state, -// we need to deterministically set the seed of the RNG used by the exported -// functions. -int get_seed() { - Rcpp::Environment pkg = Rcpp::Environment::namespace_env("cmdstanr"); - Rcpp::Function f = pkg["get_seed"]; - return Rcpp::as(f()); -} - #endif