我认为在函数内有一个独立的 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
Edit
要理解为什么我们会得到重复的键，我们应该看看当我们调用时会发生什么set.seed(NULL)。所有RNG相关的代码都是用C编写的，所以我们应该直接进入svn.r-project.org/R/trunk/src/main/RNG.c http://svn.r-project.org/R/trunk/src/main/RNG.c并参考函数do_setseed. If seed = NULL然后清楚地TimeToSeed叫做。有一条评论指出它应该位于 datetime.c 中，但是，它可以在svn.r-project.org/R/trunk/src/main/times.c http://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 blocks)
- 将位移位应用于纳秒并将位“异或”结果与秒
- 对 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)容易受到高负载的影响，并且在处理多个连续调用时不保证不发生冲突！
