From 36dd459490805a662ce138eec994c8274dfc7d7f Mon Sep 17 00:00:00 2001
From: wlandau <will.landau@gmail.com>
Date: Thu, 12 Oct 2023 11:39:39 -0400
Subject: [PATCH] Add tar_seed_set()

---
 NAMESPACE                           |  1 +
 NEWS.md                             |  2 +-
 R/class_build.R                     |  9 +-------
 R/class_crew.R                      |  4 +---
 R/class_pattern.R                   |  9 +-------
 R/class_workspace.R                 |  2 +-
 R/tar_meta.R                        |  2 +-
 R/tar_seed.R                        |  2 +-
 R/tar_seed_set.R                    | 31 +++++++++++++++++++++++++
 R/tar_target.R                      |  4 ++--
 R/tar_target_raw.R                  |  4 ++--
 R/tar_workspace.R                   |  5 +++--
 R/utils_seed.R                      | 11 ---------
 _pkgdown.yml                        |  6 ++++-
 man/tar_meta.Rd                     |  2 +-
 man/tar_seed.Rd                     |  2 +-
 man/tar_seed_set.Rd                 | 35 +++++++++++++++++++++++++++++
 man/tar_target.Rd                   |  4 ++--
 man/tar_target_raw.Rd               |  4 ++--
 man/tar_workspace.Rd                |  5 +++--
 tests/testthat/test-class_command.R |  7 +-----
 tests/testthat/test-tar_seed_set.R  | 24 ++++++++++++++++++++
 22 files changed, 120 insertions(+), 55 deletions(-)
 create mode 100644 R/tar_seed_set.R
 delete mode 100644 R/utils_seed.R
 create mode 100644 man/tar_seed_set.Rd
 create mode 100644 tests/testthat/test-tar_seed_set.R

diff --git a/NAMESPACE b/NAMESPACE
index f1ed1eb87..51c1a10ef 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -474,6 +474,7 @@ export(tar_resources_url)
 export(tar_runtime_object)
 export(tar_script)
 export(tar_seed)
+export(tar_seed_set)
 export(tar_sitrep)
 export(tar_skipped)
 export(tar_source)
diff --git a/NEWS.md b/NEWS.md
index 2a2b83006..c936e8f06 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,6 @@
 # targets 1.3.2.9000 (development)
 
-* Extra safeguard in the `crew` algorithm to opt back into the default RNG kind.
+* Add function `tar_seed_set()` which sets a seed and the default RNG algorithms.
 
 # targets 1.3.2
 
diff --git a/R/class_build.R b/R/class_build.R
index a293d7c00..794898aee 100644
--- a/R/class_build.R
+++ b/R/class_build.R
@@ -62,14 +62,7 @@ build_new <- function(object = NULL, metrics = NULL) {
 
 build_run_expr <- function(expr, envir, seed, packages, library) {
   load_packages(packages = packages, library = library)
-  if (!anyNA(seed)) {
-    # Borrowed from https://github.com/r-lib/withr/blob/main/R/seed.R
-    # under the MIT license. See the NOTICE file
-    # in the targets package source.
-    old_seed <- .GlobalEnv[[".Random.seed"]]
-    set.seed(seed)
-    on.exit(restore_seed(old_seed), add = TRUE)
-  }
+  tar_seed_set(seed = seed)
   build_eval_fce17be7(expr, envir)
 }
 
diff --git a/R/class_crew.R b/R/class_crew.R
index 1ad32e5f5..5d1757aac 100644
--- a/R/class_crew.R
+++ b/R/class_crew.R
@@ -176,9 +176,7 @@ crew_class <- R6::R6Class(
           name = name,
           controller = resources$controller,
           scale = TRUE,
-          seconds_timeout = resources$seconds_timeout,
-          seed = 0L,
-          algorithm = "default"
+          seconds_timeout = resources$seconds_timeout
         )
         self$backoff_requeue$reset()
       }
diff --git a/R/class_pattern.R b/R/class_pattern.R
index 64d0d0587..7d608fe24 100644
--- a/R/class_pattern.R
+++ b/R/class_pattern.R
@@ -369,14 +369,7 @@ pattern_produce_grid <- function(
   seed,
   methods = dynamic_methods
 ) {
-  if (!anyNA(seed)) {
-    # Borrowed from https://github.com/r-lib/withr/blob/main/R/seed.R
-    # under the MIT license. See the NOTICE file
-    # in the targets package source.
-    old_seed <- .GlobalEnv[[".Random.seed"]]
-    set.seed(seed)
-    on.exit(restore_seed(old_seed))
-  }
+  tar_seed_set(seed)
   out <- eval(pattern, envir = niblings, enclos = dynamic_methods$self)
   rownames(out) <- NULL
   out
diff --git a/R/class_workspace.R b/R/class_workspace.R
index 037cd3709..1c40a4f60 100644
--- a/R/class_workspace.R
+++ b/R/class_workspace.R
@@ -43,7 +43,7 @@ workspace_load_packages <- function(workspace) {
 }
 
 workspace_set_seed <- function(workspace) {
-  set.seed(workspace$target$command$seed)
+  tar_seed_set(workspace$target$command$seed)
 }
 
 workspace_validate <- function(workspace) {
diff --git a/R/tar_meta.R b/R/tar_meta.R
index 75758ccf6..82e5a9391 100644
--- a/R/tar_meta.R
+++ b/R/tar_meta.R
@@ -79,7 +79,7 @@
 #'     and no two targets in the same pipeline share the same seed.
 #'     (Even dynamic branches have different names and thus different seeds.)
 #'     You can recover the seed of a completed target
-#'     with `tar_meta(your_target, seed)` and run `set.seed()`
+#'     with `tar_meta(your_target, seed)` and run [tar_seed_set()]
 #'     on the result to locally recreate the target's initial RNG state.
 #'   * `path`: A list column of paths to target data. Usually, each element
 #'     is a single path, but there could be multiple paths per target
diff --git a/R/tar_seed.R b/R/tar_seed.R
index e4c8398f4..79874033d 100644
--- a/R/tar_seed.R
+++ b/R/tar_seed.R
@@ -11,7 +11,7 @@
 #'   (Even dynamic branches have different names and thus different seeds.)
 #'   You can retrieve the seed of a completed target
 #'   with `tar_meta(your_target, seed)`
-#'   and run `set.seed()` on the result to locally
+#'   and run [tar_seed_set()] on the result to locally
 #'   recreate the target's initial RNG state.
 #' @return Integer of length 1. If invoked inside a `targets` pipeline,
 #'   the return value is the seed of the target currently running,
diff --git a/R/tar_seed_set.R b/R/tar_seed_set.R
new file mode 100644
index 000000000..49535f5b3
--- /dev/null
+++ b/R/tar_seed_set.R
@@ -0,0 +1,31 @@
+#' @title Set a seed to run a target.
+#' @export
+#' @family seeds
+#' @description `targets` generates its own target-specific seeds
+#'   using [tar_seed_create()]. Use [tar_seed_set()] to set one of
+#'   these seeds in R.
+#' @details [tar_seed_set()] gives the user-supplied `seed` to
+#'   `set.seed()` and sets arguments `kind = "default"`,
+#'   `normal.kind = "default"`, and `sample.kind = "default"`.
+#' @return `NULL` (invisibly).
+#' @param seed Integer of length 1, value of the seed to set
+#'   with `set.seed()`.
+#' @examples
+#' seed <- tar_seed_create()
+#' seed
+#' sample(10)
+#' tar_seed_set(seed)
+#' sample(10)
+#' tar_seed_set(seed)
+#' sample(10)
+tar_seed_set <- function(seed) {
+  if (!is.null(seed) && !anyNA(seed)) {
+    set.seed(
+      seed = seed,
+      kind = "default",
+      normal.kind = "default",
+      sample.kind = "default"
+    )
+  }
+  invisible()
+}
diff --git a/R/tar_target.R b/R/tar_target.R
index 70472659b..af6661573 100644
--- a/R/tar_target.R
+++ b/R/tar_target.R
@@ -173,8 +173,8 @@
 #'   and no two targets in the same pipeline share the same seed.
 #'   (Even dynamic branches have different names and thus different seeds.)
 #'   You can recover the seed of a completed target
-#'   with `tar_meta(your_target, seed)` and run `set.seed()` on the result
-#'   to locally recreate the target's initial RNG state.
+#'   with `tar_meta(your_target, seed)` and run [tar_seed_set()]
+#'   on the result to locally recreate the target's initial RNG state.
 #' @param command R code to run the target.
 #' @param pattern Language to define branching for a target.
 #'   For example, in a pipeline with numeric vector targets `x` and `y`,
diff --git a/R/tar_target_raw.R b/R/tar_target_raw.R
index 4c4464d63..0ae737933 100644
--- a/R/tar_target_raw.R
+++ b/R/tar_target_raw.R
@@ -27,8 +27,8 @@
 #'   and no two targets in the same pipeline share the same seed.
 #'   (Even dynamic branches have different names and thus different seeds.)
 #'   You can recover the seed of a completed target
-#'   with `tar_meta(your_target, seed)` and run `set.seed()` on the result
-#'   to locally recreate the target's initial RNG state.
+#'   with `tar_meta(your_target, seed)` and run [tar_seed_set()]
+#'   on the result to locally recreate the target's initial RNG state.
 #' @param command Similar to the `command` argument of [`tar_target()`] except
 #'   the object must already be an expression instead of
 #'   informally quoted code.
diff --git a/R/tar_workspace.R b/R/tar_workspace.R
index b93e2a87c..8c765ebd3 100644
--- a/R/tar_workspace.R
+++ b/R/tar_workspace.R
@@ -18,7 +18,7 @@
 #'   workspace where the error happened. These objects include
 #'   the global objects at the time [tar_make()] was called and the
 #'   dependency targets. The random number generator seed for the
-#'   target is also assigned with `set.seed()`.
+#'   target is also assigned with [tar_seed_set()].
 #' @inheritParams tar_validate
 #' @param name Symbol, name of the target whose workspace to read.
 #' @param envir Environment in which to put the objects.
@@ -46,7 +46,8 @@
 #' tar_workspace(y)
 #' exists("x") # Should be TRUE.
 #' print(x) # "loaded"
-#' # Should be different: tar_workspace() runs set.seed(tar_meta(y, seed)$seed)
+#' # Should be different: tar_workspace() runs
+#' # tar_seed_set(tar_meta(y, seed)$seed)
 #' tail(.Random.seed)
 #' })
 #' }
diff --git a/R/utils_seed.R b/R/utils_seed.R
deleted file mode 100644
index b3b8ce385..000000000
--- a/R/utils_seed.R
+++ /dev/null
@@ -1,11 +0,0 @@
-# Borrowed from https://github.com/r-lib/withr/blob/main/R/seed.R
-# under the MIT license. See the NOTICE file in the targets package source.
-restore_seed <- function(old_seed) {
-  if_any(
-    is.null(old_seed), {
-      set.seed(seed = NULL)
-      rm(list = ".Random.seed", envir = .GlobalEnv)
-    },
-    assign(x = ".Random.seed", value = old_seed, envir = .GlobalEnv)
-  )
-}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 65ab1f2c9..16644b228 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -155,6 +155,11 @@ reference:
   - '`tar_interactive`'
   - '`tar_noninteractive`'
   - '`tar_toggle`'
+- title: Pseudo-random number generation
+  contents:
+  '`tar_seed_create`'
+  '`tar_seed_get`'
+  '`tar_seed_set`'
 - title: Utilities
   contents:
   - '`tar_active`'
@@ -169,7 +174,6 @@ reference:
   - '`tar_path_script_support`'
   - '`tar_path_store`'
   - '`tar_path_target`'
-  - '`tar_seed`'
   - '`tar_source`'
 - title: Extending targets
   contents:
diff --git a/man/tar_meta.Rd b/man/tar_meta.Rd
index f419ffd62..f27351e69 100644
--- a/man/tar_meta.Rd
+++ b/man/tar_meta.Rd
@@ -42,7 +42,7 @@ running the same pipeline should get the same results,
 and no two targets in the same pipeline share the same seed.
 (Even dynamic branches have different names and thus different seeds.)
 You can recover the seed of a completed target
-with \code{tar_meta(your_target, seed)} and run \code{set.seed()}
+with \code{tar_meta(your_target, seed)} and run \code{\link[=tar_seed_set]{tar_seed_set()}}
 on the result to locally recreate the target's initial RNG state.
 \item \code{path}: A list column of paths to target data. Usually, each element
 is a single path, but there could be multiple paths per target
diff --git a/man/tar_seed.Rd b/man/tar_seed.Rd
index 14d021c6a..7466293bb 100644
--- a/man/tar_seed.Rd
+++ b/man/tar_seed.Rd
@@ -31,7 +31,7 @@ and no two targets in the same pipeline share the same seed.
 (Even dynamic branches have different names and thus different seeds.)
 You can retrieve the seed of a completed target
 with \code{tar_meta(your_target, seed)}
-and run \code{set.seed()} on the result to locally
+and run \code{\link[=tar_seed_set]{tar_seed_set()}} on the result to locally
 recreate the target's initial RNG state.
 }
 \examples{
diff --git a/man/tar_seed_set.Rd b/man/tar_seed_set.Rd
new file mode 100644
index 000000000..1786a909b
--- /dev/null
+++ b/man/tar_seed_set.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tar_seed_set.R
+\name{tar_seed_set}
+\alias{tar_seed_set}
+\title{Set a seed to run a target.}
+\usage{
+tar_seed_set(seed)
+}
+\arguments{
+\item{seed}{Integer of length 1, value of the seed to set
+with \code{set.seed()}.}
+}
+\value{
+\code{NULL} (invisibly).
+}
+\description{
+\code{targets} generates its own target-specific seeds
+using \code{\link[=tar_seed_create]{tar_seed_create()}}. Use \code{\link[=tar_seed_set]{tar_seed_set()}} to set one of
+these seeds in R.
+}
+\details{
+\code{\link[=tar_seed_set]{tar_seed_set()}} gives the user-supplied \code{seed} to
+\code{set.seed()} and sets arguments \code{kind = "default"},
+\code{normal.kind = "default"}, and \code{sample.kind = "default"}.
+}
+\examples{
+seed <- tar_seed_create()
+seed
+sample(10)
+tar_seed_set(seed)
+sample(10)
+tar_seed_set(seed)
+sample(10)
+}
+\concept{seeds}
diff --git a/man/tar_target.Rd b/man/tar_target.Rd
index edccc10c1..68a051c33 100644
--- a/man/tar_target.Rd
+++ b/man/tar_target.Rd
@@ -39,8 +39,8 @@ running the same pipeline should get the same results,
 and no two targets in the same pipeline share the same seed.
 (Even dynamic branches have different names and thus different seeds.)
 You can recover the seed of a completed target
-with \code{tar_meta(your_target, seed)} and run \code{set.seed()} on the result
-to locally recreate the target's initial RNG state.}
+with \code{tar_meta(your_target, seed)} and run \code{\link[=tar_seed_set]{tar_seed_set()}}
+on the result to locally recreate the target's initial RNG state.}
 
 \item{command}{R code to run the target.}
 
diff --git a/man/tar_target_raw.Rd b/man/tar_target_raw.Rd
index ec6ea42ae..40eaf6419 100644
--- a/man/tar_target_raw.Rd
+++ b/man/tar_target_raw.Rd
@@ -40,8 +40,8 @@ running the same pipeline should get the same results,
 and no two targets in the same pipeline share the same seed.
 (Even dynamic branches have different names and thus different seeds.)
 You can recover the seed of a completed target
-with \code{tar_meta(your_target, seed)} and run \code{set.seed()} on the result
-to locally recreate the target's initial RNG state.}
+with \code{tar_meta(your_target, seed)} and run \code{\link[=tar_seed_set]{tar_seed_set()}}
+on the result to locally recreate the target's initial RNG state.}
 
 \item{command}{Similar to the \code{command} argument of \code{\link[=tar_target]{tar_target()}} except
 the object must already be an expression instead of
diff --git a/man/tar_workspace.Rd b/man/tar_workspace.Rd
index 382acc09b..60a5257a6 100644
--- a/man/tar_workspace.Rd
+++ b/man/tar_workspace.Rd
@@ -52,7 +52,7 @@ into the environment (\code{envir} argument) in order to replicate the
 workspace where the error happened. These objects include
 the global objects at the time \code{\link[=tar_make]{tar_make()}} was called and the
 dependency targets. The random number generator seed for the
-target is also assigned with \code{set.seed()}.
+target is also assigned with \code{\link[=tar_seed_set]{tar_seed_set()}}.
 }
 \description{
 Load the packages, workspace, and random number generator seed
@@ -87,7 +87,8 @@ tail(.Random.seed) # for comparison to the RNG state after tar_workspace(y)
 tar_workspace(y)
 exists("x") # Should be TRUE.
 print(x) # "loaded"
-# Should be different: tar_workspace() runs set.seed(tar_meta(y, seed)$seed)
+# Should be different: tar_workspace() runs
+# tar_seed_set(tar_meta(y, seed)$seed)
 tail(.Random.seed)
 })
 }
diff --git a/tests/testthat/test-class_command.R b/tests/testthat/test-class_command.R
index 15b288942..c1fd810b9 100644
--- a/tests/testthat/test-class_command.R
+++ b/tests/testthat/test-class_command.R
@@ -26,12 +26,7 @@ tar_test("command$produce_build() uses seed", {
   x <- command_init(expr = quote(sample.int(1e9, 1L)))
   x$seed <- 0L
   sample_with_seed <- function(seed) {
-    # Borrowed from https://github.com/r-lib/withr/blob/main/R/seed.R
-    # under the MIT license. See the NOTICE file
-    # in the targets package source.
-    old_seed <- .GlobalEnv[[".Random.seed"]]
-    set.seed(seed)
-    on.exit(restore_seed(old_seed))
+    tar_seed_set(seed)
     sample.int(1e9, 1L)
   }
   exp0 <- sample_with_seed(0L)
diff --git a/tests/testthat/test-tar_seed_set.R b/tests/testthat/test-tar_seed_set.R
new file mode 100644
index 000000000..97174caa2
--- /dev/null
+++ b/tests/testthat/test-tar_seed_set.R
@@ -0,0 +1,24 @@
+tar_test("tar_seed_set()", {
+  out <- list()
+  tar_seed_set(0L)
+  out[[1L]] <- runif(n = 1L)
+  tar_seed_set(NA)
+  out[[2L]] <- runif(n = 1L)
+  tar_seed_set(NULL)
+  out[[3L]] <- runif(n = 1L)
+  tar_seed_set(2L)
+  out[[4L]] <- runif(n = 1L)
+  tar_seed_set(2L)
+  out[[5L]] <- runif(n = 1L)
+  tar_seed_set(3L)
+  out[[6L]] <- runif(n = 1L)
+  expect_equal(out[[4L]], out[[5L]])
+  out[[5L]] <- NULL
+  for (i in seq_len(5L)) {
+    for (j in seq_len(5L)) {
+      if (i != j) {
+        expect_false(out[[i]] == out[[j]])
+      }
+    }
+  }
+})