r - 将局部环境的随机性与全局 R 过程隔离

Question

我们可以使用 set.seed()在 R 中设置一个随机种子，这具有全局效果。这是一个最小的例子来说明我的目标:

set.seed(0)
runif(1)
# [1] 0.8966972

set.seed(0)
f <- function() {
  # I do not want this random number to be affected by the global seed
  runif(1)
}
f()
# [1] 0.8966972

基本上，我希望能够避免全局随机种子(即 .Random.seed )在本地环境(例如 R 函数)中的影响，以便我可以实现某种用户无法控制的随机性。例如，即使用户有 set.seed() ，他每次调用这个函数还是会得到不同的输出。

现在有两种实现方式。第一个依赖于set.seed(NULL)每次我想获得一些随机数时，让 R 重新初始化随机种子:

createUniqueId <- function(bytes) {
  withPrivateSeed(
    paste(as.hexmode(sample(256, bytes, replace = TRUE) - 1), collapse = "")
  )
}
withPrivateSeed <- function(expr, seed = NULL) {
  oldSeed <- if (exists('.Random.seed', envir = .GlobalEnv, inherits = FALSE)) {
    get('.Random.seed', envir = .GlobalEnv, inherits = FALSE)
  }
  if (!is.null(oldSeed)) {
    on.exit(assign('.Random.seed', oldSeed, envir = .GlobalEnv), add = TRUE)
  }
  set.seed(seed)
  expr
}

您可以看到即使我将种子设置为 0，我也会得到不同的 id 字符串，并且全局随机数流仍然可重现:

> set.seed(0)
> runif(3)
[1] 0.8966972 0.2655087 0.3721239
> createUniqueId(4)
[1] "83a18600"
> runif(3)
[1] 0.5728534 0.9082078 0.2016819

> set.seed(0)
> runif(3)  # same
[1] 0.8966972 0.2655087 0.3721239
> createUniqueId(4)  # different
[1] "77cb3d91"
> runif(3)
[1] 0.5728534 0.9082078 0.2016819

> set.seed(0)
> runif(3)
[1] 0.8966972 0.2655087 0.3721239
> createUniqueId(4)
[1] "c41d61d8"
> runif(3)
[1] 0.5728534 0.9082078 0.2016819

第二个实现可以找到here在 Github 上。比较复杂，基本思想是:

在包启动期间使用 set.seed(NULL) 初始化随机种子(在 .onLoad() 中)

将随机种子存储在单独的环境中 ( .globals$ownSeed )

每次我们想要生成随机数时:

将本地种子分配给全局随机种子

生成随机数

将新的全局种子(由于步骤 2 已更改)分配给本地种子

将全局种子恢复到其原始值

现在我的问题是这两种方法在理论上是否等效。第一种方法的随机性依赖于 createUniqueId() 时的当前时间和进程 ID。被调用，第二种方法似乎依赖于加载包时的时间和进程 ID。对于第一种方法，是否有可能两次调用 createUniqueId()在同一个 R 进程中完全同时发生，以便它们返回相同的 id 字符串？

更新

在下面的回答中，Robert Krzyzanowski 提供了一些经验证据表明 set.seed(NULL)可能会导致严重的 ID 冲突。我做了一个 simple visualization为了它:

createGlobalUniqueId <- function(bytes) {
  paste(as.hexmode(sample(256, bytes, replace = TRUE) - 1), collapse = "")
}
n <- 10000
length(unique(replicate(n, createGlobalUniqueId(5))))
length(unique(x <- replicate(n, createUniqueId(5))))
# denote duplicated values by 1, and unique ones by 0
png('rng-time.png', width = 4000, height = 400)
par(mar = c(4, 4, .1, .1), xaxs = 'i')
plot(1:n, duplicated(x), type = 'l')
dev.off()

当线到达图的顶部时，这意味着生成了重复值。但是，请注意这些重复项不会连续出现，即 any(x[-1] == x[-n])通常是 FALSE .可能存在与系统时间相关联的重复模式。由于我对基于时间的随机种子的工作原理缺乏了解，我无法进一步调查，但您可以查看相关的 C 源代码片段 here和 here .

Answer 1

我认为在你的函数中只有一个独立的 RNG 会很好，它不受全局种子的影响，但会有自己的种子。原来，randtoolbox 提供了这个功能:

library(randtoolbox)
replicate(3, {
  set.seed(1)
  c(runif(1), WELL(3), runif(1))
})   
#            [,1]      [,2]      [,3]
#[1,] 0.265508663 0.2655087 0.2655087
#[2,] 0.481195594 0.3999952 0.9474923
#[3,] 0.003865934 0.6596869 0.4684255
#[4,] 0.484556709 0.9923884 0.1153879
#[5,] 0.372123900 0.3721239 0.3721239

顶行和底行受种子影响，而中间行是“真正随机的”。

基于此，这是您的功能的实现:

sample_WELL <- function(n, size=n) {
  findInterval(WELL(size), 0:n/n)
}

createUniqueId_WELL <- function(bytes) {
  paste(as.hexmode(sample_WELL(256, bytes) - 1), collapse = "")
}

length(unique(replicate(10000, createUniqueId_WELL(5))))
#[1] 10000

# independency on the seed: 
set.seed(1)
x <- replicate(100, createGlobalUniqueId(5))
x_WELL <- replicate(100, createUniqueId_WELL(5))
set.seed(1)
y <- replicate(100, createGlobalUniqueId(5))
y_WELL <- replicate(100, createUniqueId_WELL(5))
sum(x==y)
#[1] 100
sum(x_WELL==y_WELL)
#[1] 0

编辑

要理解为什么我们会得到重复的键，我们应该看看调用 set.seed(NULL) 时会发生什么。所有与 RNG 相关的代码都是用 C 编写的，因此我们应该直接转到 svn.r-project.org/R/trunk/src/main/RNG.c 并引用函数 do_setseed 。如果 seed = NULL 那么显然 TimeToSeed 被调用。有一条评论指出它应该位于 datetime.c 中，但是，它可以在 svn.r-project.org/R/trunk/src/main/times.c 中找到。

导航 R 源可能很困难，所以我在这里粘贴函数:

/* For RNG.c, main.c, mkdtemp.c */
attribute_hidden
unsigned int TimeToSeed(void)
{
    unsigned int seed, pid = getpid();
#if defined(HAVE_CLOCK_GETTIME) && defined(CLOCK_REALTIME)
    {
    struct timespec tp;
    clock_gettime(CLOCK_REALTIME, &tp);
    seed = (unsigned int)(((uint_least64_t) tp.tv_nsec << 16) ^ tp.tv_sec);
    }
#elif defined(HAVE_GETTIMEOFDAY)
    {
    struct timeval tv;
    gettimeofday (&tv, NULL);
    seed = (unsigned int)(((uint_least64_t) tv.tv_usec << 16) ^ tv.tv_sec);
    }
#else
    /* C89, so must work */
    seed = (Int32) time(NULL);
#endif
    seed ^= (pid <<16);
    return seed;
}

所以每次我们调用 set.seed(NULL) 时，R 都会执行以下步骤:

以秒和纳秒为单位获取当前时间(如果可能，#if defined 块中的平台依赖性)

将位移位应用于纳秒和位“异或”结果与秒

将位移位应用于 pid 并将其与之前的结果进行位“异或”

将结果设置为新种子

好吧，现在很明显，当结果种子发生碰撞时，我们得到了重复的值。我的猜测是当两次调用在 1 秒内发生时会发生这种情况，因此 tv_sec 是恒定的。为了确认这一点，我引入了一个滞后:

createUniqueIdWithLag <- function(bytes, lag) {
  Sys.sleep(lag)
  createUniqueId(bytes)
}
lags <- 1 / 10 ^ (1:5)
sapply(lags, function(x) length(unique(replicate(n, createUniqueIdWithLag(5, x)))))
[1] 1000 1000  996  992  990

令人困惑的是，即使与纳秒相比，延迟相当可观，我们仍然会发生碰撞!然后让我们进一步挖掘它，我为种子编写了一个“调试模拟器”:

emulate_seed <- function() {
  tv <- as.numeric(system('echo $(($(date +%s%N)))', intern = TRUE))
  pid <- Sys.getpid()
  tv_nsec <- tv %% 1e9
  tv_sec <- tv %/% 1e9
  seed <- bitwXor(bitwShiftL(tv_nsec, 16), tv_sec)
  seed <- bitwXor(bitwShiftL(pid, 16), seed)
  c(seed, tv_nsec, tv_sec, pid)
}

z <- replicate(1000, emulate_seed())
sapply(1:4, function(i) length(unique(z[i, ])))
# unique seeds, nanosecs, secs, pids:
#[1]  941 1000   36    1

这真的很令人困惑:纳秒都是唯一的，这并不能保证最终种子的唯一性。为了证明这种效果，这里有一个副本:

#            [,1]        [,2] 
#[1,] -1654969360 -1654969360
#[2,]   135644672   962643456
#[3,]  1397894128  1397894128 
#[4,]        2057        2057
bitwShiftL(135644672, 16)
#[1] -973078528
bitwShiftL(962643456, 16)
#[1] -973078528

最后一点:这两个数字的二进制表示和移位是

00001000000101011100011000000000 << 16 => 1100011000000000 + 16 zeroes
00111001011000001100011000000000 << 16 => 1100011000000000 + 16 zeroes

所以是的，这确实是一次不必要的碰撞。

好吧，毕竟说了这么多，最后的结论是:set.seed(NULL) 易受高负载影响，在处理多个连续调用时不保证不发生冲突!