Add tar_seed_set()

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)

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
 

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)
 }
 

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()
       }

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

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) {

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

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,

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()
+}

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`,

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.

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)
 #' })
 #' }

_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:

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)

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]])
+      }
+    }
+  }
+})