doRNG/0000755000175100001440000000000014773145232011251 5ustar hornikusersdoRNG/tests/0000755000175100001440000000000013556341614012413 5ustar hornikusersdoRNG/tests/testthat/0000755000175100001440000000000014773145232014253 5ustar hornikusersdoRNG/tests/testthat/test-dorng.r0000644000175100001440000004072613760210061016521 0ustar hornikusers# Unit test for doRNG # # Author: Renaud Gaujoux # Creation: 28 Mar 2012 ############################################################################### context('dorng') #test.CMRGseed <- function(){ # # msg <- function(...) paste(.msg, ':', ...) # # # Unit tests # .msg <- "Call CMRGseed without argument" # rs <- .Random.seed # expect_identical( length(CMRGseed()), 7L, msg("Seed is of length 7") ) # expect_identical(rs, .Random.seed, msg("does not change .Random.seed")) # # .msg <- "Call CMRGseed with a single argument" # rs <- .Random.seed # expect_identical( length(CMRGseed(1)), 7L, msg("Seed is of length 7") ) # expect_identical(rs, .Random.seed, msg("does not change .Random.seed")) # expect_true( all(!is.na(CMRGseed(1))), msg("No NA in the returned seed") ) # #} checkRNG <- function(x, y, msg = NULL, ...){ expect_true(rng.equal(x, y), info = msg, ...) } # 1-length loop test_that("dorng1", { set.seed(1234) # needed to avoid weird behaviors in checks rng_seed <- RNGseq(n = 1, seed = 123, simplify = FALSE)[[1L]] set.seed(123) x <- foreach(i=1) %dorng% { runif(1) } y <- foreach(i=1, .options.RNG = 123) %dorng% { runif(1) } expect_identical(x, y) # check attributes on results result_attributes <- attributes(x) expect_true(setequal(names(result_attributes), c("rng", "doRNG_version")), info = "Result has all the expected attributes") expect_identical(result_attributes[["rng"]][[1L]], rng_seed, info = "Attribute 'rng' does not have the expected value") expect_identical(result_attributes[["doRNG_version"]], doRNGversion(), info = "Attribute 'doRNG_version' does not have the expected value") }) test_that("dorng", { test_dopar <- function(.msg, s.seq){ orng <- RNGseed() on.exit({ doRNGversion(NULL); RNGseed(orng); registerDoSEQ()} ) msg <- function(...) paste(.msg, ':', ...) noattr <- function(x){ attributes(x) <- NULL; x} # RNG restoration after %dorng% rng0 <- getRNG() foreach(i=1:4, .options.RNG = 123) %dorng% { runif(1) } checkRNG(rng0, msg = "RNG is restored after seeded %dorng%") # foreach(i=1:4) %dorng% { runif(1) } expect_identical(RNGtype(), RNGtype(rng0), info = "RNG kind is restored after unseeded %dorng%") # standard %dopar% loops are _not_ reproducible set.seed(1234) s1 <- foreach(i=1:4) %dopar% { runif(1) } set.seed(1234) s2 <- foreach(i=1:4) %dopar% { runif(1) } if( !missing(s.seq) ) expect_true( !identical(s1, s2), msg("Standard %dopar% loop is not reproducible")) # %dorng% loops ensure reproducibility local({ set.seed(1234) s1 <- foreach(i=1:4) %dorng% { runif(1) } runif(10) set.seed(1234) s2 <- foreach(i=1:4) %dorng% { runif(1) } expect_identical(s1, s2, msg("%dorng% loop is reproducible with set.seed")) # check RNG settings in result set.seed(1234) ref <- RNGseq(4) rngs <- attr(s1, 'rng') expect_true(!is.null(rngs), msg("Results contains RNG data")) expect_identical(rngs, ref, msg("Results contains whole sequence of RNG seeds")) }) # or local({ s1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } s2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } expect_identical(s1, s2, msg("%dorng% loop is reproducible with .options.RNG")) ref <- RNGseq(4, 1234) rngs <- attr(s1, 'rng') expect_true(!is.null(rngs), msg("Results of seed loop contains RNG data")) expect_identical(rngs, ref, msg("Results of seeded loop contains whole sequence of RNG seeds")) }) # check with unamed foreach arguments (issue #8) local({ on.exit( registerDoSEQ() ) registerDoRNG() set.seed(567) res <- foreach(a = 1:4, .combine = 'c') %dopar% {rnorm(1, mean = 0, sd = 1)} set.seed(567) res2 <- foreach(1:4, .combine = 'c') %dopar% {rnorm(1, mean = 0, sd = 1)} expect_identical(res, res2, info = "First argument named or unamed is equivalent") # set.seed(567) res <- foreach(a = 1:4, 1:2, .combine = 'c') %dopar% {rnorm(1, mean = 0, sd = 1)} set.seed(567) res2 <- foreach(1:4, 1:2, .combine = 'c') %dopar% {rnorm(1, mean = 0, sd = 1)} expect_identical(res, res2, info = "First argument named or unamed, with second unamed argument is equivalent") }) ## ## check extra arguments to .options.RNG # Normal RNG parameter is taken into account s.unif.noNk <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(5) } s.unif.wNk <- foreach(i=1:4, .options.RNG=list(1234, normal.kind="Ahrens-Dieter")) %dorng% { runif(5) } expect_identical(noattr(s.unif.noNk), noattr(s.unif.wNk) , msg("%dorng% loop (runif) with normal.kind in .options.RNG is identical as without")) s.norm.noNk <- foreach(i=1:4, .options.RNG=1234) %dorng% { rnorm(5) } s.norm.wNk <- foreach(i=1:4, .options.RNG=list(1234, normal.kind="Ahrens-Dieter")) %dorng% { rnorm(5) } expect_true(!isTRUE(all.equal(noattr(s.norm.noNk), noattr(s.norm.wNk))) , msg("%dorng% loop (rnorm) with normal.kind in .options.RNG is different as without")) # reproduce previous loop runif(10) s1 <- foreach(i=1:4) %dorng% { runif(5) } s2 <- foreach(i=1:4, .options.RNG=s1) %dorng% { runif(5) } expect_identical(s1, s2, "Seeding using .options.RNG={result from other loop} give identical results") # directly set sequence of seeds sL <- list(c(407,1:6), c(407,11:16), c(407,21:26), c(407, 31:36)) s1.L <- foreach(i=1:4, .options.RNG=sL) %dorng% { runif(5) } runif(10) s2.L <- foreach(i=1:4, .options.RNG=sL) %dorng% { runif(5) } expect_identical(s1.L, s2.L, "Seeding using .options.RNG=list twice give identical results") # directly set sequence of seeds as a matrix sM <- sapply(sL, identity) s1.M <- foreach(i=1:4, .options.RNG=sM) %dorng% { runif(5) } runif(10) s2.M <- foreach(i=1:4, .options.RNG=sM) %dorng% { runif(5) } expect_identical(s1.M, s2.M, "Seeding using .options.RNG=matrix twice give identical results") expect_identical(s1.M, s1.L, "Seeding using .options.RNG=matrix gives identical results as the same seed in list") # separate %dorng% loops are different set.seed(1234) rs1 <- .Random.seed s1 <- foreach(i=1:4) %dorng% { runif(1) } rs1_2 <- .Random.seed s2 <- foreach(i=1:4) %dorng% { runif(1) } expect_true( !identical(rs1, rs1_2), msg("unseed %dorng% loop changes .Random.seed")) expect_true( !identical(s1, s2), msg("two consecutive (unseeded) %dorng% loops are not identical")) expect_true( !identical(unlist(s1), unlist(s2)), msg("two consecutive (unseeded) %dorng% loops are not identical (values)")) # But the whole sequence of loops is reproducible set.seed(1234) s1.2 <- foreach(i=1:4) %dorng% { runif(1) } s2.2 <- foreach(i=1:4) %dorng% { runif(1) } expect_true( identical(s1, s1.2) && identical(s2, s2.2), msg("set.seed + two consecutive %dorng% loops are reproducible")) s <- list(s1, s2) if( !missing(s.seq) ) expect_identical(s, s.seq, msg("result is identical to sequential computation")) # check behaviour with set.seed set.seed(789) s1 <- foreach(i=1:6) %dorng%{ runif(1) } s2 <- foreach(i=1:6, .options.RNG=789) %dorng%{ runif(1) } expect_identical(s1, s2, "set.seed before %dorng% is identical to using .options.RNG") # current RNG is CRMG set.seed(789, "L'Ec") s1 <- foreach(i=1:6) %dorng%{ runif(1) } s2 <- foreach(i=1:6, .options.RNG=789) %dorng%{ runif(1) } expect_identical(s1, s2, "set.seed before %dorng% is identical to using .options.RNG, if current RNG is CRMG") s } orng <- RNGseed() on.exit({ doRNGversion(NULL); RNGseed(orng); registerDoSEQ()} ) library(doParallel) # Sequential computation registerDoSEQ() s.seq <- test_dopar("Sequential") # Multicore cluster if( .Platform$OS.type != 'windows'){ # Note: for some reason, running this test in RStudio fails when checking that the standard # %dopar% loop is not reproducible registerDoParallel(cores=2) s <- test_dopar("Multicore", s.seq) } # SNOW-like cluster cl <- makeCluster(2) on.exit( if( !is.null(cl) ) stopCluster(cl), add = TRUE) registerDoParallel(cl) test_dopar("SNOW-like cluster", s.seq) stopCluster(cl); cl <- NULL skip("doMPI test because doMPI::startMPIcluster hangs inexplicably") # Works with doMPI if( require(doMPI) ){ cl_mpi <- startMPIcluster(2) on.exit( if( !is.null(cl_mpi) ) closeCluster(cl_mpi), add = TRUE) registerDoMPI(cl_mpi) test_dopar("MPI cluster", s.seq) closeCluster(cl_mpi); cl_mpi <- NULL } }) test_that("registerDoRNG", { orng <- RNGseed() on.exit({ doRNGversion(NULL); RNGseed(orng); registerDoSEQ()} ) # RNG restoration after %dorng% over doSEQ registerDoSEQ() registerDoRNG() set.seed(123) rng0 <- getRNG() res1 <- foreach(i=1:4) %dorng% { runif(1) } expect_identical(RNGtype(), RNGtype(rng0), "RNG kind is restored after unseeded %dorng%") set.seed(123) res2 <- foreach(i=1:4) %dorng% { runif(1) } expect_identical(res1, res2, "%dorng% loop over doSEQ are reproducible") on.exit( if( !is.null(cl) ) stopCluster(cl), add = TRUE) library(doParallel) cl <- makeCluster(2) registerDoParallel(cl) # One can make existing %dopar% loops reproducible using %dorng% loops or registerDoRNG set.seed(1234) r1 <- foreach(i=1:4) %dorng% { runif(1) } registerDoRNG() set.seed(1234) r2 <- foreach(i=1:4) %dopar% { runif(1) } expect_identical(r1, r2, "registerDoRNG + set.seed: makes a %dopar% loop behave like a set.seed + %dorng% loop") stopCluster(cl); cl <- NULL # Registering another foreach backend disables doRNG cl2 <- makeCluster(2) on.exit( if( !is.null(cl2) ) stopCluster(cl2), add = TRUE) registerDoParallel(cl2) set.seed(1234) s1 <- foreach(i=1:4) %dopar% { runif(1) } set.seed(1234) s2 <- foreach(i=1:4) %dorng% { runif(1) } expect_true( !identical(s1, s2), "Registering another foreach backend disables doRNG") # doRNG is re-nabled by re-registering it registerDoRNG() set.seed(1234) r3 <- foreach(i=1:4) %dopar% { runif(1) } expect_identical(r2, r3, "doRNG is re-nabled by re-registering it") r4 <- foreach(i=1:4) %dopar% { runif(1) } # NB: the results are identical independently of the task scheduling # (r2 used 2 nodes, while r3 used 3 nodes) # Reproducibility of sequences of loops # pass seed to registerDoRNG runif(10) registerDoRNG(1234) r1 <- foreach(i=1:4) %dopar% { runif(1) } r2 <- foreach(i=1:4) %dopar% { runif(1) } registerDoRNG(1234) r3 <- foreach(i=1:4) %dopar% { runif(1) } r4 <- foreach(i=1:4) %dopar% { runif(1) } expect_identical(r3, r1, "registerDoRNG(1234) allow reproducing sequences of %dopar% loops (1)") expect_identical(r4, r2, "registerDoRNG(1234) allow reproducing sequences of %dopar% loops (2)") # use set.seed runif(10) registerDoRNG() set.seed(1234) s1 <- foreach(i=1:4) %dopar% { runif(1) } s2 <- foreach(i=1:4) %dopar% { runif(1) } set.seed(1234) s3 <- foreach(i=1:4) %dopar% { runif(1) } s4 <- foreach(i=1:4) %dopar% { runif(1) } expect_identical(s3, s1, "registerDoRNG + set.seed(1234) allow reproducing sequences of %dopar% loops (1)") expect_identical(s4, s2, "registerDoRNG + set.seed(1234) allow reproducing sequences of %dopar% loops (2)") runif(5) registerDoRNG() set.seed(1234) s5 <- foreach(i=1:4) %dopar% { runif(1) } s6 <- foreach(i=1:4) %dopar% { runif(1) } expect_identical(s5, r3, "registerDoRNG() + set.seed give same results as registerDoRNG(1234) (1)") expect_identical(s6, r4, "registerDoRNG() + set.seed give same results as registerDoRNG(1234) (2)") # argument `once=FALSE` reseed doRNG's seed at the beginning of each loop registerDoRNG(1234, once=FALSE) r1 <- foreach(i=1:4) %dopar% { runif(1) } r2 <- foreach(i=1:4) %dopar% { runif(1) } r3 <- foreach(i=1:4, .options.RNG=1234) %dopar% { runif(1) } expect_identical(r1, r2, "argument `once=FALSE` reseed doRNG's seed at the beginning of each loop") expect_identical(r1, r3, "argument `once=FALSE` reseed %dorng% loop as .options.RNG") # Once doRNG is registered the seed can also be passed as an option to %dopar% r1.2 <- foreach(i=1:4, .options.RNG=456) %dopar% { runif(1) } r2.2 <- foreach(i=1:4, .options.RNG=456) %dopar% { runif(1) } expect_identical(r1.2, r2.2, "Once doRNG is registered the seed can also be passed as an option to %dopar%") expect_true(!identical(r1.2, r1), "The seed passed as an option is really taken into account") }) # Test the use-case discussed in https://github.com/renozao/doRNG/issues/12 # Note: when run under RStudio, this test_that("Initial RNG state is properly handled", { # write script that loads the package being tested .run_test_script <- function(version){ pkg_path <- path.package("doRNG") lib_path <- dirname(pkg_path) # determine if the package is a development or installed package if( dir.exists(file.path(pkg_path, "Meta")) ) load_cmd <- sprintf("library(doRNG, lib = '%s')", lib_path) else load_cmd <- sprintf("devtools::load_all('%s')", pkg_path) # results are saved in a temporary .rds file (substitute backslashes with forward slash for Windows) tmp_res <- gsub("\\", "/", tempfile("rscript_res_", fileext = ".rds"), fixed = TRUE) on.exit( unlink(tmp_res) ) r_code <- paste0(collapse = "; ", c(load_cmd, if( !is.null(version) ) sprintf("doRNGversion('%s')", version), "r1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) }", "r2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) }", "r3 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) }", sprintf("saveRDS(list(r1 = r1, r2 = r2, r3 = r3), '%s')", tmp_res) ) ) # run code in an independent fresh session rscript <- file.path(R.home("bin"), "Rscript") system(sprintf('"%s" -e "%s"', rscript, r_code), ignore.stdout = TRUE, ignore.stderr = TRUE) # load result readRDS(tmp_res) } # pre-1.7.4: results are not-reproducible res <- .run_test_script("1.7.3") expect_true(is.list(res) && identical(names(res), paste0("r", 1:3))) expect_true(all(sapply(res, attr, 'doRNG_version') == "1.7.3"), info = "doRNG version is correctly stored") expect_true(!identical(res[["r1"]], res[["r2"]]), info = "Version pre-1.7.3: results 1 & 2 are not identical") expect_identical(res[["r3"]], res[["r2"]], info = "Version pre-1.7.3: results 2 & 3 are identical") # post-1.7.4: results are reproducible res <- .run_test_script("1.7.4") expect_true(is.list(res) && identical(names(res), paste0("r", 1:3))) expect_true(all(sapply(res, attr, 'doRNG_version') == "1.7.4"), info = "doRNG version is correctly stored") expect_identical(res[["r1"]], res[["r2"]], info = "Version 1.7.4: results 1 & 2 are identical") expect_identical(res[["r3"]], res[["r2"]], info = "Version 1.7.4: results 3 & 3 are identical") # current version: results are reproducible res <- .run_test_script(NULL) expect_true(is.list(res) && identical(names(res), paste0("r", 1:3))) expect_true(all(sapply(res, attr, 'doRNG_version') == doRNGversion()), info = "doRNG version is correctly stored") expect_identical(res[["r1"]], res[["r2"]], info = "Current version: results 1 & 2 are identical") expect_identical(res[["r3"]], res[["r2"]], info = "Current version: results 2 & 3 are identical") }) test_that("RNG warnings", { .local <- function(){ orng <- RNGseed() oo <- options() on.exit({ options(oo); doRNGversion(NULL); RNGseed(orng); registerDoSEQ()} ) registerDoSEQ() registerDoRNG() expect_warning(y <- foreach(x = 1:2) %dorng% { rnorm(1); x }, NA) options(doRNG.rng_change_warning_force = TRUE) expect_warning(y <- foreach(x = 1:2) %dorng% { rnorm(1); x }, "Foreach loop \\(doSEQ\\) .* changed .* RNG type") options(doRNG.rng_change_warning_force = NULL) on.exit( if( !is.null(cl) ) stopCluster(cl), add = TRUE) library(doParallel) cl <- makeCluster(2) registerDoParallel(cl) options(doRNG.rng_change_warning_force = TRUE) options(doRNG.rng_change_warning_skip = "doParallelSNOW") expect_warning(y <- foreach(x = 1:2) %dorng% { rnorm(1); x }, "Foreach loop \\(doParallelSNOW\\) .* changed .* RNG type") options(doRNG.rng_change_warning_force = NULL) expect_warning(y <- foreach(x = 1:2) %dorng% { rnorm(1); x }, NA) options(doRNG.rng_change_warning_skip = NULL) } .local() }) doRNG/tests/testthat/test-dorng-nonattached.r0000644000175100001440000000037214360231303020777 0ustar hornikuserscontext('dorng - foreach not attached') test_that("%dorng% works also when foreach is not attached", { `%dorng%` <- doRNG::`%dorng%` y <- foreach::foreach(x = 1:2) %dorng% { x } stopifnot(all.equal(y, list(1, 2), check.attributes = FALSE)) }) doRNG/tests/testthat/test-doRepro.r0000644000175100001440000000353013556341614017026 0ustar hornikusers# Unit tests for the package doRepro # # Author: renaud gaujoux # Creation: 30 Jun 2011 ############################################################################### context("Reproducibility") test_that('xapply', { skip("Development is not finished yet") .seed <- 1:6 n <- 3 expect_identical(xapply(1:n, .seed, function(i) i), 1:n, "Main argument is correctly passed") expect_identical(xapply(1:n, .seed, function(i, b){b}, b='a'), rep('a',n), "Other arguments are correctly passed (1)") expect_identical(xapply(1:n, .seed, function(i, b, c){c}, c='a'), rep('a',n), "Other arguments are correctly passed (2)") rngs <- sapply(RNGseq(n, .seed), RNGdigest) expect_identical(xapply(1:n, .seed, function(i){ RNGdigest() }), rngs, "RNG are correctly set") # check that the stream seed is restored rngs <- sapply(RNGseq(n-1, .seed), RNGdigest) res <- xapply(1:n, .seed, function(i){ RNGdigest() }) rngs <- cbind(rngs, RNGdigest()) expect_identical(res, rngs, "RNG are correctly set") # results are reproducible orng <- getRNG() res <- xapply(1:n, .seed, function(i) runif(i) ) expect_true( rng.equal(orng), "RNG is restored") expect_identical(res, xapply(1:n, .seed, function(i) runif(i) ), "Results are reproducible") expect_identical(sapply(res, length), 1:n, "Test results have correct dimension") }) test_that("reproduce", { skip("Development is not finished yet") .seed <- 1:6 n <- 3 p <- 5 rngs <- sapply(RNGseq(3, .seed), RNGdigest) expect_identical(reproduce(n, .seed, RNGdigest()), rngs, "RNG are correctly set") # results are reproducible orng <- getRNG() res <- reproduce(n, .seed, runif(p) ) expect_true( rng.equal(orng), "RNG is restored") expect_identical(res, reproduce(n, .seed, runif(p) ), "Results are reproducible") expect_identical(dim(res), as.integer(c(p,n)), "Test results have correct dimension") }) doRNG/tests/testthat.R0000644000175100001440000000006613556341614014400 0ustar hornikuserslibrary(testthat) library(doRNG) test_check("doRNG") doRNG/.Rinstignore0000644000175100001440000000002713556341614013554 0ustar hornikusersvignettes/cleveref.sty doRNG/MD50000644000175100001440000000166314773145232011567 0ustar hornikusers1d4f9de6343069e9e301b2ccd9e39c1b *DESCRIPTION 914736c637844ee4cc539cb363543c7a *NAMESPACE 8a66ba24ab8e03cee4fef43bf771e004 *NEWS.md c67a9d318dac7ce62b418bc2292e32e8 *R/doRNG-package.R 01bfea5d27934410581e132292d92ce4 *R/doRNG.R adaad203188938606a548fed7fb7982d *R/utils.R 00e481a40fea9fb88bdd71c6e39fd332 *demo/00Index 3c7f2a369c28a79e7b45d8b4b0cda2d6 *demo/doRNG.R df50a05cd6bae38ad219a7146f68d147 *inst/REFERENCES.bib 5df8e9c5632bc3bd8d52e50e9903d1c5 *man/doRNG-package.Rd 96ef81fe164e010f76c2501714e1c1ed *man/doRNGversion.Rd 595ea44f04e18cb25a2c4bd9334c5732 *man/grapes-dorng-grapes.Rd 7ef8b4537de4e040468b4cb6df8ad53b *man/infoDoRNG.Rd 9c95362f6151e58b5dd40bb5767643cc *man/registerDoRNG.Rd afa2c0e8da402461ed281edb4f4e20f7 *tests/testthat.R 7978c192923a6be825d7a6d4cb9f2cea *tests/testthat/test-doRepro.r 0bc30863de386f57746f7cdd31a24d3d *tests/testthat/test-dorng-nonattached.r 979bef80cc9c2ac61f77720925044b42 *tests/testthat/test-dorng.r doRNG/R/0000755000175100001440000000000014360256113011443 5ustar hornikusersdoRNG/R/utils.R0000644000175100001440000000054513612460574012741 0ustar hornikusers # from pkgmaker 0.31 ns_get <- function (x, ns = NULL, ...){ if (is.null(ns)) { ns <- gsub("^([^:]+)::.*", "\\1", x) x <- gsub(".*::([^:]+)$", "\\1", x) } if (!isNamespace(ns)) { ns <- tryCatch(asNamespace(ns), error = function(e) NULL) if (is.null(ns)) return() } get0(x, envir = ns, ...) }doRNG/R/doRNG-package.R0000644000175100001440000000500614360256113014131 0ustar hornikusers#' The \emph{doRNG} package provides functions to perform #' reproducible parallel foreach loops, using independent random streams #' as generated by L'Ecuyer's combined multiple-recursive generator \citep{Lecuyer1999}. #' It enables to easily convert standard %dopar% loops into fully reproducible loops, #' independently of the number of workers, the task scheduling strategy, #' or the chosen parallel environment and associated foreach backend. #' It has been tested with the following foreach backend: doMC, doSNOW, doMPI. #' #' @encoding UTF-8 #' @name doRNG-package #' @docType package #' @title Generic Reproducible Parallel Backend for foreach Loops #' @keywords package #' @seealso \code{\link{doRNG}}, \code{\link{RNGseq}} #' @bibliography ~/Documents/articles/library.bib #' @cite Lecuyer1999 #' #' @import stats rngtools foreach #' @examples #' #' # register parallel backend #' library(doParallel) #' cl <- makeCluster(2) #' registerDoParallel(cl) #' #' ## standard %dopar% loop are not reproducible #' set.seed(123) #' r1 <- foreach(i=1:4) %dopar%{ runif(1) } #' set.seed(123) #' r2 <- foreach(i=1:4) %dopar%{ runif(1) } #' identical(r1, r2) #' \dontshow{ stopifnot(!identical(r1, r2)) } #' #' ## %dorng% loops _are_ reproducible #' set.seed(123) #' r1 <- foreach(i=1:4) %dorng%{ runif(1) } #' set.seed(123) #' r2 <- foreach(i=1:4) %dorng%{ runif(1) } #' identical(r1, r2) #' \dontshow{ stopifnot(identical(r1, r2)) } #' #' # alternative way of seeding #' a1 <- foreach(i=1:4, .options.RNG=123) %dorng%{ runif(1) } #' a2 <- foreach(i=1:4, .options.RNG=123) %dorng%{ runif(1) } #' identical(a1, a2) && identical(a1, r1) #' \dontshow{ stopifnot(identical(a1, a2) && identical(a1, r1)) } #' #' ## sequences of %dorng% loops _are_ reproducible #' set.seed(123) #' s1 <- foreach(i=1:4) %dorng%{ runif(1) } #' s2 <- foreach(i=1:4) %dorng%{ runif(1) } #' identical(s1, r1) && !identical(s1, s2) #' \dontshow{ stopifnot(identical(s1, r1) && !identical(s1, s2)) } #' #' set.seed(123) #' s1.2 <- foreach(i=1:4) %dorng%{ runif(1) } #' s2.2 <- foreach(i=1:4) %dorng%{ runif(1) } #' identical(s1, s1.2) && identical(s2, s2.2) #' \dontshow{ stopifnot(identical(s1, s1.2) && identical(s2, s2.2)) } #' #' ## Non-invasive way of converting %dopar% loops into reproducible loops #' registerDoRNG(123) #' s3 <- foreach(i=1:4) %dopar%{ runif(1) } #' s4 <- foreach(i=1:4) %dopar%{ runif(1) } #' identical(s3, s1) && identical(s4, s2) #' \dontshow{ stopifnot(identical(s3, s1) && identical(s4, s2)) } #' #' stopCluster(cl) #' NULL `_PACKAGE` <- "doRNG" doRNG/R/doRNG.R0000644000175100001440000004621214360233461012545 0ustar hornikusers# Development of a dorng equivalent to dopar for reproducible loops # # Author: Renaud Gaujoux # Creation: 17 Aug 2011 ############################################################################### #library(foreach) # or-NULL operator (borrowed from Hadley Wickham) '%||%' <- function(x, y) if( !is.null(x) ) x else y #' @importFrom utils head .collapse <- function(x, n=length(x), sep=', '){ res <- paste(if( missing(n) ) x else head(x, n), collapse=', ') if( length(x) > n ) res <- paste(res, '...', sep=', ') res } #' Back Compatibility Option for doRNG #' #' Sets the behaviour of %dorng% foreach loops from a #' given version number. #' #' @section Behaviour changes in versions: #' #' \describe{ #' \item{1.4}{ The behaviour of \code{doRNGseed}, and therefore of #' `%dorng%` loops, changed in the case where the current RNG was #' L'Ecuyer-CMRG. #' Using \code{set.seed} before a non-seeded loop used not to be identical #' to seeding via \code{.options.RNG}. #' Another bug was that non-seeded loops would share most of their RNG seed! #' } #' \item{1.7.4}{Prior to this version, in the case where the RNG had not been called yet, #' the first seeded `%dorng%` loops would not give the identical results as #' subsequent loops despite using the same seed #' (see \url{https://github.com/renozao/doRNG/issues/12}). #' #' This has been fixed in version 1.7.4, where the RNG is called once (\code{sample(NA)}), #' whenever the .Random.seed is not found in global environment. #' } #' } #' #' @param x version number to switch to, or missing to get the currently #' active version number, or \code{NULL} to reset to the default behaviour, #' i.e. of the latest version. #' #' @return a character string #' If \code{x} is missing this function returns the version number from the #' current behaviour. #' If \code{x} is specified, the function returns the old value of the #' version number (invisible). #' #' @importFrom utils packageVersion #' @export #' @examples #' #' \dontshow{ registerDoSEQ() } #' #' ## Seeding when current RNG is L'Ecuyer-CMRG #' RNGkind("L'Ecuyer") #' #' doRNGversion("1.4") #' # in version >= 1.4 seeding behaviour changed to fix a bug #' set.seed(123) #' res <- foreach(i=1:3) %dorng% runif(1) #' res2 <- foreach(i=1:3) %dorng% runif(1) #' stopifnot( !identical(attr(res, 'rng')[2:3], attr(res2, 'rng')[1:2]) ) #' res3 <- foreach(i=1:3, .options.RNG=123) %dorng% runif(1) #' stopifnot( identical(res, res3) ) #' #' # buggy behaviour in version < 1.4 #' doRNGversion("1.3") #' res <- foreach(i=1:3) %dorng% runif(1) #' res2 <- foreach(i=1:3) %dorng% runif(1) #' stopifnot( identical(attr(res, 'rng')[2:3], attr(res2, 'rng')[1:2]) ) #' res3 <- foreach(i=1:3, .options.RNG=123) %dorng% runif(1) #' stopifnot( !identical(res, res3) ) #' #' # restore default RNG #' RNGkind("default") #' # restore to current doRNG version #' doRNGversion(NULL) #' doRNGversion <- local({ currentV <- "1.7.4" #as.character(packageVersion('doRNG')) cache <- currentV function(x){ if( missing(x) ) return(cache) if( is.null(x) ) x <- currentV # update cache and return old value old <- cache cache <<- x invisible(old) } }) #' @importFrom utils compareVersion checkRNGversion <- function(x){ compareVersion(doRNGversion(), x) } doRNGseq <- function(n, seed=NULL, ...){ # compute sequence using rngtools::RNGseq # library(rngtools) res <- RNGseq(n, seed, ..., version=if( checkRNGversion('1.4') >=0 ) 2 else 1, simplify = FALSE) } #' Getting Information About doRNG Foreach Backend #' #' \code{infoDoRNG} returns information about the doRNG backend, e.g., version, #' number of workers. #' It is not meant to be called by the user. #' #' #' @param data a list of data used by the backend #' @param item the data item requested, as a character string #' (e.g. 'name', 'workers', 'version') #' #' @return \code{infoDoRNG} returns the requested info (usually as a character #' string or a numeric value). #' #' @keywords internal #' @author Renaud Gaujoux #' infoDoRNG <- function (data, item) { switch(item , workers = data$backend$info(data$backend$data, "workers") , name = "doRNG" , version = "doRNG 1.7.3" , NULL) } #' @describeIn infoDoRNG implements the generic reproducible foreach backend. It should #' not be called directly by the user. #' #' @param obj a foreach description of the loop arguments #' @param ex the lopp expression #' @param envir the loop's evaluation environment #' @param data configuration data of the doRNG backend #' doRNG <- function (obj, ex, envir, data){ if( is.null(obj$options) ) obj$options <- list() if( !'RNG' %in% names(obj$options) ){ obj$options$RNG <- if( !data$once || data$nseed==0 ){ #message("doRNG backend - use seed ", if( data$once ) "only once" else "for every loop", ":") data$seed } else NULL } # data$nseed <- data$nseed + 1 # assign('data', data, pos=foreach:::.foreachGlobals) rngBackend <- getDoBackend() # increment number of calls to doRNG rngBackend$data$nseed <- rngBackend$data$nseed + 1 # directly register (temporarly) the computing backend on.exit({setDoBackend(rngBackend)}, add=TRUE) setDoBackend(rngBackend$data$backend) do.call(doRNG::`%dorng%`, list(obj, ex), envir = envir) } ##% Get/Sets the registered foreach backend's data getDoBackend <- function(){ # one has to get the complete set of backend data from within the foreach Namespace foreach_ns <- asNamespace('foreach') # .foreachGlobals <- get('.foreachGlobals', foreach_ns) .foreachGlobals <- ns_get('.foreachGlobals', foreach_ns) # getDoPar <- get('getDoPar', foreach_ns) getDoPar <- ns_get('getDoPar', foreach_ns) c(getDoPar() , info= if( exists("info", where = .foreachGlobals, inherits = FALSE) ) .foreachGlobals$info else function(data, item) NULL) } setDoBackend <- function(backend){ ob <- getDoBackend() do.call(setDoPar, backend) invisible(ob) } .getDoParName <- function(backend = getDoBackend(), version = FALSE) { if ( !is.null(backend[['info']]) ){ res <- backend[['info']](backend[['data']], "name") if( version ) paste0(res, '(', backend[['info']](backend[['data']], "version"), ')') res } } #' Reproducible Parallel Foreach Backend #' #' `%dorng%` is a foreach operator that provides an alternative operator #' `%dopar%`, which enable reproducible foreach loops to be performed. #' #' @param obj a foreach object as returned by a call to \code{\link{foreach}}. #' @param ex the \code{R} expression to evaluate. #' #' @return `%dorng%` returns the result of the foreach loop. See [foreach::%dopar%]. #' The whole sequence of RNG seeds is stored in the result object as an attribute. #' Use \code{attr(res, 'rng')} to retrieve it. #' #' @section Global options: #' #' These options are for advanced users that develop `foreach backends: #' #' * 'doRNG.rng_change_warning_skip': if set to a single logical `FALSE/TRUE`, it indicates #' whether a warning should be thrown if the RNG seed is changed by the registered #' parallel backend (default=FALSE). #' Set it to `TRUE` if you know that running your backend will change the RNG state and #' want to disable the warning. #' This option can also be set to a character vector that specifies the name(s) of the backend(s) #' for which the warning should be skipped. #' #' @importFrom iterators iter #' @export #' @usage obj \%dorng\% ex #' @seealso \code{\link{foreach}}, \code{\link[doParallel]{doParallel}} #' , \code{\link[doParallel]{registerDoParallel}}, \code{\link[doMPI]{doMPI}} #' @examples #' #' library(doParallel) #' cl <- makeCluster(2) #' registerDoParallel(cl) #' #' # standard %dopar% loops are _not_ reproducible #' set.seed(1234) #' s1 <- foreach(i=1:4) %dopar% { runif(1) } #' set.seed(1234) #' s2 <- foreach(i=1:4) %dopar% { runif(1) } #' identical(s1, s2) #' #' # single %dorng% loops are reproducible #' r1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' r2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' identical(r1, r2) #' # the sequence os RNG seed is stored as an attribute #' attr(r1, 'rng') #' #' # stop cluster #' stopCluster(cl) #' #' # More examples can be found in demo `doRNG` #' \dontrun{ #' demo('doRNG') #' } #' #' @demo Some features of the %dorng% foreach operator #' #' library(doRNG) #' library(doParallel) #' #' if( .Platform$OS.type == "unix" ){ #' registerDoParallel(2) #' #' # single %dorng% loops are reproducible #' r1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' r2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' identical(r1, r2) #' # the sequence os RNG seed is stored as an attribute #' attr(r1, 'rng') #' #' # sequences of %dorng% loops are reproducible #' set.seed(1234) #' s1 <- foreach(i=1:4) %dorng% { runif(1) } #' s2 <- foreach(i=1:4) %dorng% { runif(1) } #' # two consecutive (unseed) %dorng% loops are not identical #' identical(s1, s2) #' #' # But the whole sequence of loops is reproducible #' set.seed(1234) #' s1.2 <- foreach(i=1:4) %dorng% { runif(1) } #' s2.2 <- foreach(i=1:4) %dorng% { runif(1) } #' identical(s1, s1.2) && identical(s2, s2.2) #' # it gives the same result as with .options.RNG #' identical(r1, s1) #' #' } #' #' # Works with SNOW-like and MPI clusters #' # SNOW-like cluster #' cl <- makeCluster(2) #' registerDoParallel(cl) #' #' s1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' s2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' identical(s1, s2) #' #' stopCluster(cl) #' registerDoSEQ() #' #' # MPI cluster #' library(doMPI) #' cl <- startMPIcluster(2) #' registerDoMPI(cl) #' #' s1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' s2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' identical(s1, s2) #' #' closeCluster(cl) #' registerDoSEQ() #' #' `%dorng%` <- function(obj, ex){ #library(rngtools) # str(obj) # dump verbose messages if not in verbose mode verbose <- !is.null(obj$verbose) && obj$verbose if( !verbose ) message <- function(...) NULL # exit if nested or conditional loop if( any(c('xforeach', 'filteredforeach') %in% class(obj)) ) stop("nested/conditional foreach loops are not supported yet.\nSee the package's vignette for a work around.") # if an RNG seed is provided then setup random streams # and add the list of RNGs to use as an iterated arguments for %dopar% # library(parallel) N_elem <- length(as.list(iter(obj))) obj$argnames <- c(obj$argnames, '.doRNG.stream') obj$args$.doRNG.stream <- rep(NA_integer_, N_elem) # make sure the RNG seed is initialized by calling getRNG() if( is.null(RNGseed()) ){ if( checkRNGversion("1.7.4") >= 0 ){ message("NOTE -- .Random.seed is not initialized: sampling once to ensure reproducibility.") getRNG() }else{ warning(paste0(".Random.seed is not initialized: results might not be reproducible.\n ", "Update to doRNG version >= 1.7.4 to get a fix for this issue.")) } } ## # restore current RNG on exit if a seed is passed rngSeed <- if( !is.null(obj$options$RNG) ){ # setup current RNG restoration RNG.old <- RNGseed() on.exit({RNGseed(RNG.old)}, add=TRUE) # extract RNG setting from object if possible (do not resolve single seed) rngSeed <- getRNG(obj$options$RNG, num.ok=TRUE) %||% obj$options$RNG # ensure it is a list # NB: unnamed lists are sequences of seeds if( !is.list(rngSeed) || is.null(names(rngSeed)) ){ rngSeed <- list(rngSeed) } rngSeed } # message("* Seed specification: ", str_out(rngSeed, 6, total = length(rngSeed) > 6)) # generate a sequence of streams # print("before RNGseq") # showRNG() obj$args$.doRNG.stream <- do.call(doRNGseq, c(list(n=N_elem, verbose=obj$verbose), rngSeed)) # print("after RNGseq") # showRNG() #print(obj$args$.doRNG.stream) message("* Registered backend: ", .getDoParName(version = TRUE)) dp <- getDoParName() # directly register (temporarly) the computing backend if( !is.null(dp) && dp == 'doRNG' ){ rngBackend <- getDoBackend() message("* Registering computing backend: ", .getDoParName(rngBackend$data$backend, version = TRUE)) on.exit({ message("* Restoring previous backend: ", .getDoParName(rngBackend)) setDoBackend(rngBackend) }, add=TRUE) setDoBackend(rngBackend$data$backend) dp <- getDoParName() } ## SEPCIAL CASE FOR doSEQ or doMPI # TODO: figure out why doMPI draws once from the current RNG (must be linked # to using own code to setup L'Ecuyer RNG) # restore RNG settings as after RNGseq if doSEQ is the backend and no seed was passed if( is.null(obj$options$RNG) ){ RNG.old <- RNGseed() on.exit({ rng_type_changed <- !identical(RNGtype(), RNGtype(RNG.old)) warning_skip <- getOption("doRNG.rng_change_warning_skip", FALSE) force_warning <- getOption("doRNG.rng_change_warning_force", FALSE) known_changing_cases <- is.null(dp) || dp %in% c("doSEQ", "doMPI") || (is.logical(warning_skip) && !is.na(warning_skip) && warning_skip) || (is.character(warning_skip) && dp %in% warning_skip) if( known_changing_cases || rng_type_changed ){ if( force_warning || (rng_type_changed && !known_changing_cases) ){ warning(sprintf("Foreach loop (%s) had changed the current RNG type: RNG was restored to same type, next state", dp %||% "unknown")) }else{ message("* Detected known RNG side effect: ", dp) } message("* Restoring RNG as after RNG sequence generation") if( verbose ) showRNG(RNG.old, indent = " -") RNGseed(RNG.old) message("OK") } }, add=TRUE) } ## # export package doRNG if not already exported if( !('doRNG' %in% obj$packages) ) obj$packages <- c(obj$packages, 'doRNG') # append code to the loop expression to set the RNG ex <- as.call(list(as.name('{'), quote({rngtools::RNGseed(.doRNG.stream);}), substitute(ex))) # call the standard %dopar% operator res <- do.call(`%dopar%`, list(obj, ex), envir=parent.frame()) # add seed sequence as an attribute (skip this for NULL results) if( !is.null(res) ){ attr(res, 'rng') <- obj$args$.doRNG.stream attr(res, 'doRNG_version') <- doRNGversion() } # return result res } #' Registering doRNG for Persistent Reproducible Parallel Foreach Loops #' #' \code{registerDoRNG} registers the doRNG foreach backend. #' Subsequent `%dopar%` loops are then performed using the previously #' registered foreach backend, but are internally performed as [%dorng%] loops, #' making them fully reproducible. #' #' Briefly, the RNG is set, before each iteration, with seeds for L'Ecuyer's CMRG #' that overall generate a reproducible sequence of statistically independent #' random streams. #' #' Note that (re-)registering a foreach backend other than doRNG, after a call #' to \code{registerDoRNG} disables doRNG -- which then needs to be registered. #' #' @param seed a numerical seed to use (as a single or 6-length numerical value) #' @param once a logical to indicate if the RNG sequence should be seeded at the #' beginning of each loop or only at the first loop. #' #' @return The value returned by [foreach::setDoPar] #' #' @seealso [%dorng%] #' @export #' @examples #' #' library(doParallel) #' cl <- makeCluster(2) #' registerDoParallel(cl) #' #' # One can make reproducible loops using the %dorng% operator #' r1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } #' # or convert %dopar% loops using registerDoRNG #' registerDoRNG(1234) #' r2 <- foreach(i=1:4) %dopar% { runif(1) } #' identical(r1, r2) #' stopCluster(cl) #' #' # Registering another foreach backend disables doRNG #' cl <- makeCluster(2) #' registerDoParallel(cl) #' set.seed(1234) #' s1 <- foreach(i=1:4) %dopar% { runif(1) } #' set.seed(1234) #' s2 <- foreach(i=1:4) %dopar% { runif(1) } #' identical(s1, s2) #' \dontshow{ stopifnot(!identical(s1, s2)) } #' #' # doRNG is re-nabled by re-registering it #' registerDoRNG() #' set.seed(1234) #' r3 <- foreach(i=1:4) %dopar% { runif(1) } #' identical(r2, r3) #' # NB: the results are identical independently of the task scheduling #' # (r2 used 2 nodes, while r3 used 3 nodes) #' #' # argument `once=FALSE` reseeds doRNG's seed at the beginning of each loop #' registerDoRNG(1234, once=FALSE) #' r1 <- foreach(i=1:4) %dopar% { runif(1) } #' r2 <- foreach(i=1:4) %dopar% { runif(1) } #' identical(r1, r2) #' #' # Once doRNG is registered the seed can also be passed as an option to %dopar% #' r1.2 <- foreach(i=1:4, .options.RNG=456) %dopar% { runif(1) } #' r2.2 <- foreach(i=1:4, .options.RNG=456) %dopar% { runif(1) } #' identical(r1.2, r2.2) && !identical(r1.2, r1) #' \dontshow{ stopifnot(identical(r1.2, r2.2) && !identical(r1.2, r1)) } #' #' stopCluster(cl) #' registerDoRNG <- function(seed=NULL, once=TRUE){ backend <- getDoBackend() # use stored backend if registerDoRNG was called repeatedly if( identical(getDoParName(), 'doRNG') ) backend <- backend$data$backend # set the current RNG with seed immediately if only used once if( once && !is.null(seed) ){ if( !is.numeric(seed) || length(seed)!=1L ) stop("Invalid seed: must be a single numeric value.") set.seed(seed) seed <- NULL } setDoPar(doRNG, list(seed=seed, once=once, nseed=0, backend=backend), infoDoRNG) } ###% Reproducibly Apply a Function over a List or Vector ###% ###% @aliases xapply reproduce ###% ###% \code{reproduce} and \code{xapply} are a reproducible versions ###% of \code{\link{replicate}} and \code{\link{sapply}} respectively, ###% that ensures the reproducibility of the results, when stochastic computations ###% are involved. ###% ###% The reproducibility is achieved by using LEcuyer's RNG provided by R core ###% since R-2.14.0, to generate independent random streams ###% that are used as the random number generator for each replicate. ###% ###% @param n the number of replication as a single numeric (integer) ###% @param seed the main numerical seed used to initialize the sequence of random ###% streams ###% @param expr the expression (language object, usually a call) to evaluate repeatedly ###% @param simplify logical; should the result be simplified to a vector or ###% matrix if possible? ###% ###% ###% #reproduce <- function (n, expr, seed=NULL, simplify = TRUE){ # f <- eval.parent(substitute(function(...) expr)) # xapply(integer(n), seed, f, simplify = simplify) #} # #xapply <- function (X, FUN, seed=NULL, ..., simplify = TRUE, USE.NAMES = TRUE){ # # # generate a sequence of streams # .RNG.stream <- RNGseq(length(X), seed, packed=TRUE) # # # keep current RNG and restore it on exit (useful for the sequential backend doSEQ) # RNG.old <- rstream.RNG() # on.exit(rstream.RNG(RNG.old), add=TRUE) # # # append code to the loop expression to set the RNG # expr <- as.call(list(as.name('{'), # quote({doRNGseed(.rng);}), # quote(do.call(FUN, list(...))))) # # env <- environment(FUN) # f <- eval(substitute(function(.rng, ..., FUN) expr), env) # mapply(f, .RNG.stream, X, MoreArgs=c(list(...), FUN=FUN), # SIMPLIFY = simplify, USE.NAMES= USE.NAMES) #} doRNG/demo/0000755000175100001440000000000013556560424012177 5ustar hornikusersdoRNG/demo/00Index0000644000175100001440000000006413556341614013327 0ustar hornikusersdoRNG Some features of the %dorng% foreach operator doRNG/demo/doRNG.R0000644000175100001440000000257513556560424013304 0ustar hornikuserslibrary(doRNG) library(doParallel) if( .Platform$OS.type == "unix" ){ registerDoParallel(2) # single %dorng% loops are reproducible r1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } r2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } identical(r1, r2) # the sequence os RNG seed is stored as an attribute attr(r1, 'rng') # sequences of %dorng% loops are reproducible set.seed(1234) s1 <- foreach(i=1:4) %dorng% { runif(1) } s2 <- foreach(i=1:4) %dorng% { runif(1) } # two consecutive (unseed) %dorng% loops are not identical identical(s1, s2) # But the whole sequence of loops is reproducible set.seed(1234) s1.2 <- foreach(i=1:4) %dorng% { runif(1) } s2.2 <- foreach(i=1:4) %dorng% { runif(1) } identical(s1, s1.2) && identical(s2, s2.2) # it gives the same result as with .options.RNG identical(r1, s1) } # Works with SNOW-like and MPI clusters # SNOW-like cluster cl <- makeCluster(2) registerDoParallel(cl) s1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } s2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } identical(s1, s2) stopCluster(cl) registerDoSEQ() # MPI cluster library(doMPI) cl <- startMPIcluster(2) registerDoMPI(cl) s1 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } s2 <- foreach(i=1:4, .options.RNG=1234) %dorng% { runif(1) } identical(s1, s2) closeCluster(cl) registerDoSEQ() doRNG/NAMESPACE0000644000175100001440000000041613621322014012453 0ustar hornikusers# Generated by roxygen2: do not edit by hand export("%dorng%") export(doRNGversion) export(registerDoRNG) import(foreach) import(rngtools) import(stats) importFrom(iterators,iter) importFrom(utils,compareVersion) importFrom(utils,head) importFrom(utils,packageVersion) doRNG/NEWS.md0000644000175100001440000001072014360232665012346 0ustar hornikusers# Changes in version 1.8.4 There is no changes in this version, which was published to reclaim ownership and take the package out of ORPHANED state (issue #23). # Changes in version 1.8 ## Changes o Unit tests are now run through testthat o Minor fixes in man pages and README file o Now depends on rngtools >= 1.3 o The result list gains an attribute 'doRNG_version' that contains the version of doRNG that was used, based on doRNGversion(). NB: this is not necessarily the same as the version of the installed package. o Added the following global option 'doRNG.rng_change_warning_skip'. See ?`%dorng%` (issue #14). o Moved dependency on pkgmaker to Suggests to make installation lighter (issue #10). ## Bug fixes o Enabled running %dorng% loops within a package (incorporating the solution proposed by Elizabeth Byerly in PR#3) o Fixed error with NULL iteration results when setting 'rng' attribute (issue #9) o Fixed error when using unamed foreach arguments (issue #8) o Fixed non-reproducibility issue when the .Random.seed is not yet initialized, e.g., when the session starts and the RNG has not been used yet (issue #12) o Fixed runtime error when package is not attached (issue #13) # Changes in version 1.6.2 ## Bug fixes o Non reproducible %dorng% loop when doRNG is registered over doSEQ (Issue #1 reported by Brenton Kenkel). Actually due to %dorng% not restoring the RNG (to state + 1) when doRNG is registered over doSEQ. o %dorng% was not working properly on loops of length one (Issue #2) # Changes in version 1.6 ## Changes o doRNG now depends on the package pkgmaker (>= 0.20) ## Bug fixes o Check error due number of cores used. Now limited to 2 in examples, vignette and unit test. # Changes in version 1.5 ## Changes o doRNG now depends on the package pkgmaker (>= 0.9) o improved vignette o most of the general RNG utilities have been incorporated in a new package called rngtools. # Changes in version 1.4.1 ## Changes o when the current RNG was L'Ecuyer-CMRG, unseeded loops now use the current RNG stream as for the first stream in the RNG sequence and # Changes the current RNG to the next RNG stream of the last stream in the sequence. ## Bug fixes o fix error "'iter' not found" due to # Changes in foreach package dependencies -- that was announced by Rich Calaway. o loops seeded with set.seed and .options.RNG were not reproducible when current RNG was L'Ecuyer-CMRG (reported by Zhang Peng) o separate unseeded loops were sharing most of their streams, when current RNG was L'Ecuyer-CMRG the RNG seed. o nested/conditional loops were crashing with a bad error. They are still not supported but the error message is nicer and a work around has been added to the vignette (reported by Chanhee Yi and Zhang Peng). # Changes in version 1.2.3 ## Bug fixes o fixed error when running a %dorng% loop on a fresh session, with no parallel backend registered. ## Changes o improved vignette o added more unit tests o changed the name of the RNG attribute on result of %dorng% looops from 'RNG' to 'rng'. It now contains the whole sequence of RNG seeds, instead of only the first one. o RNGseq now accepts a list or a matrix describing the whole sequence of seeds. See vignette for more details. o %dorng% loops can be seeded with a complete sequence of seeds passed as a list, a matrix, or an object with attribute 'rng', e.g. the results of %dorng% loops. See vignette for more details. # Changes in version 1.2.2 ## Bug fixes o separate %dorng% loops were using the same seed. ## New features o add unit tests o first seed is set as an attribute of the loop's result ## Changes o function doRNGseed now returns the seed to use for the first iteration. o RNGseq now change the current RNG state if called with no seed specific. ## Defunct o removed function CMRGseed # Changes in version 1.2 ## Bug fixes o An error was thrown if using %dorng% loops before using any random generator. Thanks to Eric Lehmann for reporting this. ## Changes o add vignette o use package doParallel in examples # Changes in version 1.1 ## Changes o use R core RNG "L'Ecuyer-CMRG" and the parallel package, instead of the implementation provided by the rstream package. doRNG/inst/0000755000175100001440000000000014773135505012230 5ustar hornikusersdoRNG/inst/REFERENCES.bib0000644000175100001440000000713214360256116014324 0ustar hornikusers@Article{Hothorn2011, abstract = {Reproducible research is a concept of providing access to data and software along with published scientific findings. By means of some case studies from different disciplines, we will illustrate reasons why readers should be given the possibility to look at the data and software independently from the authors of the original publication. We report results of a survey comprising 100 papers recently published in Bioinformatics. The main finding is that authors of this journal share a culture of making data available. However, the number of papers where source code for simulation studies or analyzes is available is still rather limited.}, author = {Torsten Hothorn and Friedrich Leisch}, doi = {10.1093/bib/bbq084}, file = {::}, issn = {1477-4054}, journal = {Briefings in bioinformatics}, keywords = {reproducible research,software,statistical analyzes,sweave}, month = {jan}, pmid = {21278369}, title = {{Case studies in reproducibility.}}, url = {http://www.ncbi.nlm.nih.gov/pubmed/21278369}, year = {2011}, } @Misc{Stodden2011, author = {Victoria C Stodden}, booktitle = {AAAS Annual Meeting}, title = {{The Digitization of Science: Reproducibility and Interdisciplinary Knowledge Transfer}}, url = {http://aaas.confex.com/aaas/2011/webprogram/Session3166.html}, year = {2011}, } @Article{Ioannidis2008, abstract = {Given the complexity of microarray-based gene expression studies, guidelines encourage transparent design and public data availability. Several journals require public data deposition and several public databases exist. However, not all data are publicly available, and even when available, it is unknown whether the published results are reproducible by independent scientists. Here we evaluated the replication of data analyses in 18 articles on microarray-based gene expression profiling published in Nature Genetics in 20052006. One table or figure from each article was independently evaluated by two teams of analysts. We reproduced two analyses in principle and six partially or with some discrepancies; ten could not be reproduced. The main reason for failure to reproduce was data unavailability, and discrepancies were mostly due to incomplete data annotation or specification of data processing and analysis. Repeatability of published microarray studies is apparently limited. More strict publication rules enforcing public data availability and explicit description of data processing and analysis should be considered.}, author = {John P A Ioannidis and David B Allison and Catherine A Ball and Issa Coulibaly and Xiangqin Cui and Aed\'in C Culhane and Mario Falchi and Cesare Furlanello and Laurence Game and Giuseppe Jurman and Jon Mangion and Tapan Mehta and Michael Nitzberg and Grier P Page and Enrico Petretto and Vera {Van Noort}}, doi = {10.1038/ng.295}, issn = {10614036}, journal = {Nature Genetics}, number = {2}, pages = {149--155}, publisher = {Nature Publishing Group}, title = {{The reproducibility of lists of differentially expressed genes in microarray studies}}, url = {http://www.nature.com/doifinder/10.1038/ng.295}, volume = {41}, year = {2008}, } @Article{Lecuyer1999, author = {Pierre L'Ecuyer}, doi = {10.1287/opre.47.1.159}, file = {::}, issn = {0030-364X}, journal = {Operations Research}, month = {feb}, number = {1}, pages = {159--164}, title = {{Good Parameters and Implementations for Combined Multiple Recursive Random Number Generators}}, url = {http://www.jstor.org/stable/10.2307/222902 http://pubsonline.informs.org/doi/abs/10.1287/opre.47.1.159}, volume = {47}, year = {1999}, } doRNG/man/0000755000175100001440000000000014360256113012015 5ustar hornikusersdoRNG/man/registerDoRNG.Rd0000644000175100001440000000507414360233410014763 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/doRNG.R \name{registerDoRNG} \alias{registerDoRNG} \title{Registering doRNG for Persistent Reproducible Parallel Foreach Loops} \usage{ registerDoRNG(seed = NULL, once = TRUE) } \arguments{ \item{seed}{a numerical seed to use (as a single or 6-length numerical value)} \item{once}{a logical to indicate if the RNG sequence should be seeded at the beginning of each loop or only at the first loop.} } \value{ The value returned by \link[foreach:setDoPar]{foreach::setDoPar} } \description{ \code{registerDoRNG} registers the doRNG foreach backend. Subsequent \verb{\%dopar\%} loops are then performed using the previously registered foreach backend, but are internally performed as \link{\%dorng\%} loops, making them fully reproducible. } \details{ Briefly, the RNG is set, before each iteration, with seeds for L'Ecuyer's CMRG that overall generate a reproducible sequence of statistically independent random streams. Note that (re-)registering a foreach backend other than doRNG, after a call to \code{registerDoRNG} disables doRNG -- which then needs to be registered. } \examples{ library(doParallel) cl <- makeCluster(2) registerDoParallel(cl) # One can make reproducible loops using the \%dorng\% operator r1 <- foreach(i=1:4, .options.RNG=1234) \%dorng\% { runif(1) } # or convert \%dopar\% loops using registerDoRNG registerDoRNG(1234) r2 <- foreach(i=1:4) \%dopar\% { runif(1) } identical(r1, r2) stopCluster(cl) # Registering another foreach backend disables doRNG cl <- makeCluster(2) registerDoParallel(cl) set.seed(1234) s1 <- foreach(i=1:4) \%dopar\% { runif(1) } set.seed(1234) s2 <- foreach(i=1:4) \%dopar\% { runif(1) } identical(s1, s2) \dontshow{ stopifnot(!identical(s1, s2)) } # doRNG is re-nabled by re-registering it registerDoRNG() set.seed(1234) r3 <- foreach(i=1:4) \%dopar\% { runif(1) } identical(r2, r3) # NB: the results are identical independently of the task scheduling # (r2 used 2 nodes, while r3 used 3 nodes) # argument `once=FALSE` reseeds doRNG's seed at the beginning of each loop registerDoRNG(1234, once=FALSE) r1 <- foreach(i=1:4) \%dopar\% { runif(1) } r2 <- foreach(i=1:4) \%dopar\% { runif(1) } identical(r1, r2) # Once doRNG is registered the seed can also be passed as an option to \%dopar\% r1.2 <- foreach(i=1:4, .options.RNG=456) \%dopar\% { runif(1) } r2.2 <- foreach(i=1:4, .options.RNG=456) \%dopar\% { runif(1) } identical(r1.2, r2.2) && !identical(r1.2, r1) \dontshow{ stopifnot(identical(r1.2, r2.2) && !identical(r1.2, r1)) } stopCluster(cl) } \seealso{ \link{\%dorng\%} } doRNG/man/doRNG-package.Rd0000644000175100001440000000515614773135106014663 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/doRNG-package.R \docType{package} \encoding{UTF-8} \name{doRNG-package} \alias{doRNG-package} \title{Generic Reproducible Parallel Backend for foreach Loops} \description{ The \emph{doRNG} package provides functions to perform reproducible parallel foreach loops, using independent random streams as generated by L'Ecuyer's combined multiple-recursive generator (L'Ecuyer (1999)). It enables to easily convert standard \%dopar\% loops into fully reproducible loops, independently of the number of workers, the task scheduling strategy, or the chosen parallel environment and associated foreach backend. It has been tested with the following foreach backend: doMC, doSNOW, doMPI. } \examples{ # register parallel backend library(doParallel) cl <- makeCluster(2) registerDoParallel(cl) ## standard \%dopar\% loop are not reproducible set.seed(123) r1 <- foreach(i=1:4) \%dopar\%{ runif(1) } set.seed(123) r2 <- foreach(i=1:4) \%dopar\%{ runif(1) } identical(r1, r2) \dontshow{ stopifnot(!identical(r1, r2)) } ## \%dorng\% loops _are_ reproducible set.seed(123) r1 <- foreach(i=1:4) \%dorng\%{ runif(1) } set.seed(123) r2 <- foreach(i=1:4) \%dorng\%{ runif(1) } identical(r1, r2) \dontshow{ stopifnot(identical(r1, r2)) } # alternative way of seeding a1 <- foreach(i=1:4, .options.RNG=123) \%dorng\%{ runif(1) } a2 <- foreach(i=1:4, .options.RNG=123) \%dorng\%{ runif(1) } identical(a1, a2) && identical(a1, r1) \dontshow{ stopifnot(identical(a1, a2) && identical(a1, r1)) } ## sequences of \%dorng\% loops _are_ reproducible set.seed(123) s1 <- foreach(i=1:4) \%dorng\%{ runif(1) } s2 <- foreach(i=1:4) \%dorng\%{ runif(1) } identical(s1, r1) && !identical(s1, s2) \dontshow{ stopifnot(identical(s1, r1) && !identical(s1, s2)) } set.seed(123) s1.2 <- foreach(i=1:4) \%dorng\%{ runif(1) } s2.2 <- foreach(i=1:4) \%dorng\%{ runif(1) } identical(s1, s1.2) && identical(s2, s2.2) \dontshow{ stopifnot(identical(s1, s1.2) && identical(s2, s2.2)) } ## Non-invasive way of converting \%dopar\% loops into reproducible loops registerDoRNG(123) s3 <- foreach(i=1:4) \%dopar\%{ runif(1) } s4 <- foreach(i=1:4) \%dopar\%{ runif(1) } identical(s3, s1) && identical(s4, s2) \dontshow{ stopifnot(identical(s3, s1) && identical(s4, s2)) } stopCluster(cl) } \references{ L'Ecuyer P (1999). “Good Parameters and Implementations for Combined Multiple Recursive Random Number Generators.” _Operations Research_, *47*(1), 159-164. ISSN 0030-364X, doi:10.1287/opre.47.1.159 . } \seealso{ \code{\link{doRNG}}, \code{\link[rngtools]{RNGseq}} } \keyword{package} doRNG/man/grapes-dorng-grapes.Rd0000644000175100001440000000410614773136466016174 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/doRNG.R \name{\%dorng\%} \alias{\%dorng\%} \title{Reproducible Parallel Foreach Backend} \usage{ obj \%dorng\% ex } \arguments{ \item{obj}{a foreach object as returned by a call to \code{\link[foreach]{foreach}}.} \item{ex}{the \code{R} expression to evaluate.} } \value{ \verb{\%dorng\%} returns the result of the foreach loop. See \link[foreach:foreach]{foreach::\%dopar\%}. The whole sequence of RNG seeds is stored in the result object as an attribute. Use \code{attr(res, 'rng')} to retrieve it. } \description{ \verb{\%dorng\%} is a foreach operator that provides an alternative operator \verb{\%dopar\%}, which enable reproducible foreach loops to be performed. } \section{Global options}{ These options are for advanced users that develop `foreach backends: \itemize{ \item 'doRNG.rng_change_warning_skip': if set to a single logical \code{FALSE/TRUE}, it indicates whether a warning should be thrown if the RNG seed is changed by the registered parallel backend (default=FALSE). Set it to \code{TRUE} if you know that running your backend will change the RNG state and want to disable the warning. This option can also be set to a character vector that specifies the name(s) of the backend(s) for which the warning should be skipped. } } \examples{ library(doParallel) cl <- makeCluster(2) registerDoParallel(cl) # standard \%dopar\% loops are _not_ reproducible set.seed(1234) s1 <- foreach(i=1:4) \%dopar\% { runif(1) } set.seed(1234) s2 <- foreach(i=1:4) \%dopar\% { runif(1) } identical(s1, s2) # single \%dorng\% loops are reproducible r1 <- foreach(i=1:4, .options.RNG=1234) \%dorng\% { runif(1) } r2 <- foreach(i=1:4, .options.RNG=1234) \%dorng\% { runif(1) } identical(r1, r2) # the sequence os RNG seed is stored as an attribute attr(r1, 'rng') # stop cluster stopCluster(cl) # More examples can be found in demo `doRNG` \dontrun{ demo('doRNG') } } \seealso{ \code{\link[foreach]{foreach}}, \code{\link[doParallel]{doParallel}}, \code{\link[doParallel]{registerDoParallel}}, \code{\link[doMPI]{doMPI}} } doRNG/man/doRNGversion.Rd0000644000175100001440000000446614360233070014672 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/doRNG.R \name{doRNGversion} \alias{doRNGversion} \title{Back Compatibility Option for doRNG} \usage{ doRNGversion(x) } \arguments{ \item{x}{version number to switch to, or missing to get the currently active version number, or \code{NULL} to reset to the default behaviour, i.e. of the latest version.} } \value{ a character string If \code{x} is missing this function returns the version number from the current behaviour. If \code{x} is specified, the function returns the old value of the version number (invisible). } \description{ Sets the behaviour of \%dorng\% foreach loops from a given version number. } \section{Behaviour changes in versions}{ \describe{ \item{1.4}{ The behaviour of \code{doRNGseed}, and therefore of \verb{\%dorng\%} loops, changed in the case where the current RNG was L'Ecuyer-CMRG. Using \code{set.seed} before a non-seeded loop used not to be identical to seeding via \code{.options.RNG}. Another bug was that non-seeded loops would share most of their RNG seed! } \item{1.7.4}{Prior to this version, in the case where the RNG had not been called yet, the first seeded \verb{\%dorng\%} loops would not give the identical results as subsequent loops despite using the same seed (see \url{https://github.com/renozao/doRNG/issues/12}). This has been fixed in version 1.7.4, where the RNG is called once (\code{sample(NA)}), whenever the .Random.seed is not found in global environment. } } } \examples{ \dontshow{ registerDoSEQ() } ## Seeding when current RNG is L'Ecuyer-CMRG RNGkind("L'Ecuyer") doRNGversion("1.4") # in version >= 1.4 seeding behaviour changed to fix a bug set.seed(123) res <- foreach(i=1:3) \%dorng\% runif(1) res2 <- foreach(i=1:3) \%dorng\% runif(1) stopifnot( !identical(attr(res, 'rng')[2:3], attr(res2, 'rng')[1:2]) ) res3 <- foreach(i=1:3, .options.RNG=123) \%dorng\% runif(1) stopifnot( identical(res, res3) ) # buggy behaviour in version < 1.4 doRNGversion("1.3") res <- foreach(i=1:3) \%dorng\% runif(1) res2 <- foreach(i=1:3) \%dorng\% runif(1) stopifnot( identical(attr(res, 'rng')[2:3], attr(res2, 'rng')[1:2]) ) res3 <- foreach(i=1:3, .options.RNG=123) \%dorng\% runif(1) stopifnot( !identical(res, res3) ) # restore default RNG RNGkind("default") # restore to current doRNG version doRNGversion(NULL) } doRNG/man/infoDoRNG.Rd0000644000175100001440000000176514360232706014104 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/doRNG.R \name{infoDoRNG} \alias{infoDoRNG} \alias{doRNG} \title{Getting Information About doRNG Foreach Backend} \usage{ infoDoRNG(data, item) doRNG(obj, ex, envir, data) } \arguments{ \item{data}{configuration data of the doRNG backend} \item{item}{the data item requested, as a character string (e.g. 'name', 'workers', 'version')} \item{obj}{a foreach description of the loop arguments} \item{ex}{the lopp expression} \item{envir}{the loop's evaluation environment} } \value{ \code{infoDoRNG} returns the requested info (usually as a character string or a numeric value). } \description{ \code{infoDoRNG} returns information about the doRNG backend, e.g., version, number of workers. It is not meant to be called by the user. } \author{ Renaud Gaujoux } \keyword{internal} \section{Functions}{ \itemize{ \item \code{doRNG}: implements the generic reproducible foreach backend. It should not be called directly by the user. }} doRNG/DESCRIPTION0000644000175100001440000000233414773145232012761 0ustar hornikusersPackage: doRNG Type: Package Title: Generic Reproducible Parallel Backend for 'foreach' Loops Version: 1.8.6.2 Encoding: UTF-8 Authors@R: person("Renaud", "Gaujoux", email = "renozao@protonmail.com", role = c("aut", "cre")) Description: Provides functions to perform reproducible parallel foreach loops, using independent random streams as generated by L'Ecuyer's combined multiple-recursive generator [L'Ecuyer (1999), ]. It enables to easily convert standard '%dopar%' loops into fully reproducible loops, independently of the number of workers, the task scheduling strategy, or the chosen parallel environment and associated foreach backend. License: GPL (>= 2) LazyLoad: yes URL: https://renozao.github.io/doRNG/ BugReports: https://github.com/renozao/doRNG/issues Depends: R (>= 3.0.0), foreach, rngtools (>= 1.5) Imports: stats, utils, iterators Suggests: doParallel, doMPI, doRedis, rbenchmark, devtools, knitr, rbibutils (>= 1.3), testthat, covr RoxygenNote: 7.2.3 NeedsCompilation: no Packaged: 2025-04-02 04:32:01 UTC; hornik Author: Renaud Gaujoux [aut, cre] Maintainer: Renaud Gaujoux Repository: CRAN Date/Publication: 2025-04-02 05:26:50 UTC