Add param seed to build_articles() (r-lib#2354)

Ensures reproducible RNG, reducing noise in final HTML output.

NEWS.md

@@ -10,6 +10,10 @@
 * Remove redundant entries in the documentation index when multiple explicit `@usage` tags are provided (@klmr, #2302)
 * The article index now sorts vignettes and non-vignette articles alphabetically by their filename (literally, their `basename()`), by default (@jennybc, #2253).
 * Add Catalan translation (@jmaspons, #2333)
+* Set RNG seed before building articles by default. Use `build_articles(seed = NULL)` for the old (unreproducible) behaviour. (@salim-b, #2354).
+* Set RNG seed for htmlwidgets IDs. This reduces noise in final HTML output,
+  both for articles and examples in the reference that contain htmlwidgets
+  (@salim-b, #2294, #2354).
 * Set RNG seed for htmlwidgets IDs. This reduces noise in pkgdown reference HTML output when examples generate htmlwidgets (@salim-b, #2294).
 * Fix BS5 navbar template to get `navbar.type: dark` to work with bslib 0.6+ / Bootstrap 5.3+ (@tanho63, #2388)
 * Allow detection of quarto `.qmd` articles and let them be processed using the [`quarto`](https://cran.r-project.org/web/packages/quarto/index.html) vignette builder (@rcannood, #2404).

R/build-articles.R

@@ -163,12 +163,15 @@
 #'   pandoc. This is useful when debugging.
 #' @param lazy If `TRUE`, will only re-build article if input file has been
 #'   modified more recently than the output file.
+#' @param seed Seed used to initialize random number generation in order to
+#'   make article output reproducible. An integer scalar or `NULL` for no seed.
 #' @param preview If `TRUE`, or `is.na(preview) && interactive()`, will preview
 #'   freshly generated section in browser.
 #' @export
 build_articles <- function(pkg = ".",
                            quiet = TRUE,
                            lazy = TRUE,
+                           seed = 1014L,
                            override = list(),
                            preview = NA) {
   pkg <- section_init(pkg, depth = 1L, override = override)
@@ -181,10 +184,12 @@ build_articles <- function(pkg = ".",
 
   build_articles_index(pkg)
   purrr::walk(
-    pkg$vignettes$name, build_article,
+    pkg$vignettes$name,
+    build_article,
     pkg = pkg,
-    quiet = quiet,
-    lazy = lazy
+    lazy = lazy,
+    seed = seed,
+    quiet = quiet
   )
 
   preview_site(pkg, "articles", preview = preview)
@@ -196,10 +201,12 @@ build_articles <- function(pkg = ".",
 #'   relative to `vignettes/` without extension, or `index` or `README`.
 #' @param data Additional data to pass on to template.
 build_article <- function(name,
-                           pkg = ".",
-                           data = list(),
-                           lazy = FALSE,
-                           quiet = TRUE) {
+                          pkg = ".",
+                          data = list(),
+                          lazy = FALSE,
+                          seed = 1014L,
+                          quiet = TRUE) {
+
   pkg <- as_pkgdown(pkg)
 
   # Look up in pkg vignette data - this allows convenient automatic
@@ -285,6 +292,7 @@ build_article <- function(name,
     output = output_file,
     output_format = format,
     output_options = options,
+    seed = seed,
     quiet = quiet
   )
 }

R/build-reference.R

@@ -139,8 +139,6 @@
 #'   rapidly prototype. It is set to `FALSE` by [build_site()].
 #' @param run_dont_run Run examples that are surrounded in \\dontrun?
 #' @param examples Run examples?
-#' @param seed Seed used to initialize random number generation so that
-#'   examples are reproducible.
 #' @param devel Determines how code is loaded in order to run examples.
 #'   If `TRUE` (the default), assumes you are in a live development
 #'   environment, and loads source package with [pkgload::load_all()].
@@ -153,7 +151,7 @@ build_reference <- function(pkg = ".",
                             lazy = TRUE,
                             examples = TRUE,
                             run_dont_run = FALSE,
-                            seed = 1014,
+                            seed = 1014L,
                             override = list(),
                             preview = NA,
                             devel = TRUE,
@@ -210,7 +208,7 @@ copy_figures <- function(pkg) {
   }
 }
 
-examples_env <- function(pkg, seed = 1014, devel = TRUE, envir = parent.frame()) {
+examples_env <- function(pkg, seed = 1014L, devel = TRUE, envir = parent.frame()) {
   # Re-loading pkgdown while it's running causes weird behaviour with
   # the context cache
   if (isTRUE(devel) && !(pkg$package %in% c("pkgdown", "rprojroot"))) {

R/build.R

@@ -317,7 +317,7 @@
 build_site <- function(pkg = ".",
                        examples = TRUE,
                        run_dont_run = FALSE,
-                       seed = 1014,
+                       seed = 1014L,
                        lazy = FALSE,
                        override = list(),
                        preview = NA,
@@ -375,7 +375,7 @@ build_site <- function(pkg = ".",
 build_site_external <- function(pkg = ".",
                                 examples = TRUE,
                                 run_dont_run = FALSE,
-                                seed = 1014,
+                                seed = 1014L,
                                 lazy = FALSE,
                                 override = list(),
                                 preview = NA,
@@ -417,7 +417,7 @@ build_site_external <- function(pkg = ".",
 build_site_local <- function(pkg = ".",
                              examples = TRUE,
                              run_dont_run = FALSE,
-                             seed = 1014,
+                             seed = 1014L,
                              lazy = FALSE,
                              override = list(),
                              preview = NA,

R/rmarkdown.R

@@ -1,7 +1,7 @@
 #' Render RMarkdown document in a fresh session
 #'
 #' @noRd
-render_rmarkdown <- function(pkg, input, output, ..., copy_images = TRUE, quiet = TRUE) {
+render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images = TRUE, quiet = TRUE) {
 
   input_path <- path_abs(input, pkg$src_path)
   output_path <- path_abs(output, pkg$dst_path)
@@ -20,13 +20,26 @@ render_rmarkdown <- function(pkg, input, output, ..., copy_images = TRUE, quiet
     intermediates_dir = tempdir(),
     encoding = "UTF-8",
     envir = globalenv(),
+    seed = seed,
     ...,
     quiet = quiet
   )
 
   path <- tryCatch(
     callr::r_safe(
-      function(...) rmarkdown::render(...),
+      function(seed, envir, ...) {
+        if (!is.null(seed)) {
+          # since envir is copied from the parent fn into callr::r_safe(),
+          # set.seed() sets the seed in the wrong global env and we have to
+          # manually copy it over
+          set.seed(seed)
+          envir$.Random.seed <- .GlobalEnv$.Random.seed
+          if (requireNamespace("htmlwidgets", quietly = TRUE)) {
+            htmlwidgets::setWidgetIdSeed(seed)
+          }
+        }
+        rmarkdown::render(envir = envir, ...)
+      },
       args = args,
       show = !quiet,
       env = c(

tests/testthat/_snaps/build-articles.md

@@ -121,3 +121,10 @@
       Reading vignettes/html-deps.Rmd
       Writing articles/html-deps.html
 
+# output is reproducible by default, i.e. 'seed' is respected
+
+    Code
+      cat(output)
+    Output
+      ## [1] 0.080750138 0.834333037 0.600760886 0.157208442 0.007399441
+

tests/testthat/assets/articles/vignettes/random.Rmd

@@ -0,0 +1,7 @@
+---
+title: "Random"
+---
+
+```{r, repro}
+runif(5L)
+```

tests/testthat/test-build-articles.R

@@ -215,3 +215,16 @@ test_that("check doesn't include getting started vignette", {
 
   expect_error(data_articles_index(pkg), NA)
 })
+
+test_that("output is reproducible by default, i.e. 'seed' is respected", {
+  pkg <- local_pkgdown_site(test_path("assets/articles"))
+  suppressMessages(build_article(pkg = pkg, name = "random"))
+
+  output <- xml2::read_html(file.path(pkg$dst_path, "articles/random.html")) %>%
+    rvest::html_node("div.contents > pre") %>%
+    rvest::html_text() %>%
+    # replace line feeds with whitespace to make output platform independent
+    gsub("\r", "", .)
+
+  expect_snapshot(cat(output))
+})

tests/testthat/test-check.R

@@ -14,7 +14,7 @@ test_that("fails if article index incomplete", {
   pkg <- local_pkgdown_site(test_path("assets/articles"), meta = "
     articles:
      - title: Title
-       contents: [starts_with('html'), standard, toc-false, widget]
+       contents: [starts_with('html'), random, standard, toc-false, widget]
   ")
   expect_snapshot(check_pkgdown(pkg), error = TRUE)
 })

vignettes/test/widgets.Rmd

@@ -14,11 +14,6 @@ knitr::opts_chunk$set(
 Test spacing above widget.
 
 ```{r, echo=FALSE}
-# set seed for reproducible widget id
-if (requireNamespace("htmlwidgets", quietly = TRUE)) {
-  htmlwidgets::setWidgetIdSeed(42)
-}
-
 path1 <- tempfile()
 writeLines(letters, path1)
 path2 <- tempfile()