Merge pull request rstudio#1768 from rstudio/wch-fix-with-private-seed

Fix withPrivateSeed

Author: jcheng5

DESCRIPTION

@@ -64,7 +64,7 @@ Depends:
     methods
 Imports:
     utils,
-    httpuv (>= 1.3.3),
+    httpuv (>= 1.3.5),
     mime (>= 0.3),
     jsonlite (>= 0.9.16),
     xtable,

NEWS.md

@@ -39,6 +39,8 @@ shiny 1.0.3.9001
 
 * Fixed [#1755](https://github.com/rstudio/shiny/issues/1755): dynamic htmlwidgets sent the path of the package on the server to the client. ([#1756](https://github.com/rstudio/shiny/pull/1756))
 
+* Fixed [#1763](https://github.com/rstudio/shiny/issues/1763): Shiny's private random stream leaked out into the main random stream. ([#1768](https://github.com/rstudio/shiny/pull/1768))
+
 ### Library updates
 
 

R/globals.R

@@ -5,7 +5,7 @@
   # R's lazy-loading package scheme causes the private seed to be cached in the
   # package itself, making our PRNG completely deterministic. This line resets
   # the private seed during load.
-  withPrivateSeed(reinitializeSeed())
+  withPrivateSeed(set.seed(NULL))
 }
 
 .onAttach <- function(libname, pkgname) {

R/utils.R

@@ -43,53 +43,43 @@ repeatable <- function(rngfunc, seed = stats::runif(1, 0, .Machine$integer.max))
   }
 }
 
-# Temporarily set x in env to value, evaluate expr, and
-# then restore x to its original state
-withTemporary <- function(env, x, value, expr, unset = FALSE) {
-
-  if (exists(x, envir = env, inherits = FALSE)) {
-    oldValue <- get(x, envir = env, inherits = FALSE)
-    on.exit(
-      assign(x, oldValue, envir = env, inherits = FALSE),
-      add = TRUE)
+.globals$ownSeed <- NULL
+# Evaluate an expression using Shiny's own private stream of
+# randomness (not affected by set.seed).
+withPrivateSeed <- function(expr) {
+  # Save the old seed if present.
+  if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) {
+    hasOrigSeed <- TRUE
+    origSeed <- .GlobalEnv$.Random.seed
   } else {
-    on.exit(
-      rm(list = x, envir = env, inherits = FALSE),
-      add = TRUE
-    )
+    hasOrigSeed <- FALSE
   }
 
-  if (!missing(value) && !isTRUE(unset))
-    assign(x, value, envir = env, inherits = FALSE)
-  else {
-    if (exists(x, envir = env, inherits = FALSE))
-      rm(list = x, envir = env, inherits = FALSE)
+  # Swap in the private seed.
+  if (is.null(.globals$ownSeed)) {
+    if (hasOrigSeed) {
+      # Move old seed out of the way if present.
+      rm(.Random.seed, envir = .GlobalEnv, inherits = FALSE)
+    }
+  } else {
+    .GlobalEnv$.Random.seed <- .globals$ownSeed
   }
-  force(expr)
-}
 
-.globals$ownSeed <- NULL
-# Evaluate an expression using Shiny's own private stream of
-# randomness (not affected by set.seed).
-withPrivateSeed <- function(expr) {
-  withTemporary(.GlobalEnv, ".Random.seed",
-    .globals$ownSeed, unset=is.null(.globals$ownSeed), {
-      tryCatch({
-        expr
-      }, finally = {
-        .globals$ownSeed <- getExists('.Random.seed', 'numeric', globalenv())
-      })
+  # On exit, save the modified private seed, and put the old seed back.
+  on.exit({
+    .globals$ownSeed <- .GlobalEnv$.Random.seed
+
+    if (hasOrigSeed) {
+      .GlobalEnv$.Random.seed <- origSeed
+    } else {
+      rm(.Random.seed, envir = .GlobalEnv, inherits = FALSE)
     }
-  )
-}
+    # Need to call this to make sure that the value of .Random.seed gets put
+    # into R's internal RNG state. (Issue #1763)
+    httpuv::getRNGState()
+  })
 
-# a homemade version of set.seed(NULL) for backward compatibility with R 2.15.x
-reinitializeSeed <- if (getRversion() >= '3.0.0') {
-  function() set.seed(NULL)
-} else function() {
-  if (exists('.Random.seed', globalenv()))
-    rm(list = '.Random.seed', pos = globalenv())
-  stats::runif(1)  # generate any random numbers so R can reinitialize the seed
+  expr
 }
 
 # Version of runif that runs with private seed

tests/testthat/test-utils.R

@@ -52,6 +52,27 @@ test_that("Setting the private seed explicitly results in identical values", {
   expect_identical(id7, id8)
 })
 
+test_that("Private and 'public' random streams are independent and work the same", {
+  set.seed(0)
+  public <- c(runif(1), runif(1), runif(1))
+  withPrivateSeed(set.seed(0))
+  private <- c(withPrivateSeed(runif(1)), withPrivateSeed(runif(1)), withPrivateSeed(runif(1)))
+  expect_identical(public, private)
+
+  # Interleaved calls to runif() with private and public streams
+  set.seed(0)
+  withPrivateSeed(set.seed(0))
+  public  <- numeric()
+  private <- numeric()
+  public[1]  <- runif(1)
+  private[1] <- withPrivateSeed(runif(1))
+  private[2] <- withPrivateSeed(runif(1))
+  public[2]  <- runif(1)
+  public[3]  <- runif(1)
+  private[3] <- withPrivateSeed(runif(1))
+  expect_identical(public, private)
+})
+
 test_that("need() works as expected", {
 
   # These are all falsy