I thought it would be nice to have just an independent RNG inside your function, that is not affected by the global seed, but would have its own seed. Turns out, randtoolbox
offers this functionality:
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
Top and bottom rows are affected by the seed, whereas middle ones are "truly random".
Based on that, here's the implementation of your function:
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
To understand why we get duplicated keys, we should take a look what happens when we call set.seed(NULL)
. All RNG-related code is written in C, so we should go directly to svn.r-project.org/R/trunk/src/main/RNG.c and refer to the function do_setseed
. If seed = NULL
then clearly TimeToSeed
is called. There's a comment that states it should be located in datetime.c, however, it can be found in svn.r-project.org/R/trunk/src/main/times.c.
Navigating the R source can be difficult, so I'm pasting the function here:
/* 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;
}
So each time we call set.seed(NULL)
, R does these steps:
- Takes current time in seconds and nanoseconds (if possible, platform dependency here in
#if defined
blocks) - Applies bit shift to nanoseconds and bit 'xor'es result with seconds
- Applies bit shift to pid and bit 'xor'es it with the previous result
- Sets the result as a new seed
Well, now it's almost obvious that we get duplicated values when the resulting seeds collide. My guess is this happens when two calls fall within 1 second, so that tv_sec is constant. To confirm that, I'm introducing a lag:
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
What's confusing is that even the lag is substantial compared to nanoseconds, we still get collisions! Let's dig it further then, I wrote a "debugging emulator" for the seed:
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
That is really confusing: nanoseconds are all unique, and that does not guarantee uniqueness of the final seed. To demonstrate that effect, here's one of the duplicates:
# [,1] [,2]
#[1,] -1654969360 -1654969360
#[2,] 135644672 962643456
#[3,] 1397894128 1397894128
#[4,] 2057 2057
bitwShiftL(135644672, 16)
#[1] -973078528
bitwShiftL(962643456, 16)
#[1] -973078528
The final note: the binary representation of these two numbers and the shift is
00001000000101011100011000000000 << 16 => 1100011000000000 + 16 zeroes
00111001011000001100011000000000 << 16 => 1100011000000000 + 16 zeroes
So yes, this is really an unwanted collision.
Well, after all that, the final conclusion is: set.seed(NULL)
is vulnerable to high load and does not guarantee the absence of collisions when dealing with multiple consecutive calls!