1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
#' RNG version
#'
#' Change the RNG version and restore it afterwards.
#'
#' `with_rng_version()` runs the code with the specified RNG version and
#' resets it afterwards.
#'
#' `local_rng_version()` changes the RNG version for the caller
#' execution environment.
#'
#' @template with
#' @param version `[character(1)]` an R version number, e.g.
#' `"3.5.0"`, to switch to the RNG this version of R uses.
#' See [RNGversion()].
#'
#' @seealso [RNGversion()], [RNGkind()], [with_seed()].
#' @export
#' @examples
#' RNGkind()
#' with_rng_version("3.0.0", RNGkind())
#' with_rng_version("1.6.0", RNGkind())
#'
#' with_rng_version("3.0.0",
#' with_seed(42, sample(1:100, 3)))
#'
#' with_rng_version("1.6.0",
#' with_seed(42, sample(1:100, 3)))
#'
#' RNGkind()
#'
with_rng_version <- function(version, code) {
old <- RNGkind()
on.exit(restore_rng_kind(old), add = TRUE)
suppressWarnings(RNGversion(version))
code
}
#' @rdname with_rng_version
#' @param .local_envir The environment to apply the change to.
#' @export
#' @examples
#' fun1 <- function() {
#' local_rng_version("3.0.0")
#' with_seed(42, sample(1:100, 3))
#' }
#'
#' fun2 <- function() {
#' local_rng_version("1.6.0")
#' with_seed(42, sample(1:100, 3))
#' }
#'
#' RNGkind()
#' fun1()
#' fun2()
#' RNGkind()
local_rng_version <- function(version, .local_envir = parent.frame()) {
old <- RNGkind()
defer(restore_rng_kind(old), envir = .local_envir)
suppressWarnings(RNGversion(version))
old
}
restore_rng_kind <- function(kind) {
# Silence static analysis linting about `RNGkind()` signature on old
# R versions
RNGkind <- get("RNGkind")
RNGkind(kind[[1]], normal.kind = kind[[2]])
# Within a `local_rng_version("3.5.0")`, we restore to `"Rounding"`,
# which causes a warning. See https://github.com/r-lib/withr/issues/167
sample_kind <- kind[[3]]
if (identical(sample_kind, "Rounding")) {
suppressWarnings(
RNGkind(sample.kind = sample_kind)
)
} else {
RNGkind(sample.kind = sample_kind)
}
NULL
}
|
