[med-svn] [r-cran-rngtools] 01/01: Imported Upstream version 1.2.4
Alba Crespi
albac-guest at moszumanska.debian.org
Sun Jul 3 21:06:11 UTC 2016
This is an automated email from the git hooks/post-receive script.
albac-guest pushed a commit to branch master
in repository r-cran-rngtools.
commit 25cb50251f7a26f8f29d0e1e26730df01f96523b
Author: Alba Crespi <alba.crespi at ed.ac.uk>
Date: Sun Jul 3 23:02:11 2016 +0200
Imported Upstream version 1.2.4
---
DESCRIPTION | 24 ++
MD5 | 23 ++
NAMESPACE | 23 ++
R/RNG.R | 639 +++++++++++++++++++++++++++++++++++++++
R/RNGseq.R | 206 +++++++++++++
R/format.R | 208 +++++++++++++
R/rngtools-package.r | 56 ++++
README.md | 12 +
build/vignette.rds | Bin 0 -> 209 bytes
inst/doc/rngtools-unitTests.R | 9 +
inst/doc/rngtools-unitTests.Rnw | 80 +++++
inst/doc/rngtools-unitTests.pdf | Bin 0 -> 99069 bytes
inst/tests/runit.RNG.r | 133 ++++++++
inst/tests/runit.RNGseq.r | 162 ++++++++++
inst/tests/runit.format.r | 103 +++++++
man/RNGseed.Rd | 60 ++++
man/RNGseq.Rd | 95 ++++++
man/RNGstr.Rd | 121 ++++++++
man/rng.Rd | 238 +++++++++++++++
man/rngcmp.Rd | 31 ++
man/rngtools.Rd | 53 ++++
man/uchecks.Rd | 26 ++
tests/doRUnit.R | 6 +
vignettes/rngtools-unitTests.Rnw | 80 +++++
24 files changed, 2388 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..bb75d7c
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,24 @@
+Package: rngtools
+Maintainer: Renaud Gaujoux <renaud at tx.technion.ac.il>
+Author: Renaud Gaujoux
+Version: 1.2.4
+License: GPL-3
+Title: Utility functions for working with Random Number Generators
+Description: This package contains a set of functions for working with
+ Random Number Generators (RNGs). In particular, it defines a generic
+ S4 framework for getting/setting the current RNG, or RNG data
+ that are embedded into objects for reproducibility.
+ Notably, convenient default methods greatly facilitate the way current
+ RNG settings can be changed.
+URL: https://renozao.github.io/rngtools
+BugReports: http://github.com/renozao/rngtools/issues
+SCM: github:renozao, r-forge
+Depends: R (>= 3.0.0), methods, pkgmaker (>= 0.20)
+Imports: stringr, digest
+Suggests: parallel, RUnit, knitr
+Collate: 'rngtools-package.r' 'format.R' 'RNG.R' 'RNGseq.R'
+VignetteBuilder: knitr
+Packaged: 2014-03-06 13:11:11 UTC; renaud
+NeedsCompilation: no
+Repository: CRAN
+Date/Publication: 2014-03-06 22:18:10
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..8edc212
--- /dev/null
+++ b/MD5
@@ -0,0 +1,23 @@
+2f38fe52d9b165b47c771ac2b0da0fbd *DESCRIPTION
+b9a32980e99ce9c025b0597ae8b58717 *NAMESPACE
+5adf706c7f033e4df1be28d4fd68d680 *R/RNG.R
+ecbc598f29702d10d8efb3fb0495fe28 *R/RNGseq.R
+fec46586c69d62db5fb1e13bb125cd50 *R/format.R
+e2029dcfc0a3f91647cdd34d4ced1929 *R/rngtools-package.r
+3820488e613033e8bb5b526227147be1 *README.md
+219cf9f7d2b662dfa2a9308817d7e83f *build/vignette.rds
+6118ae7b86de4110717f8213518e5a88 *inst/doc/rngtools-unitTests.R
+640605f55fb05c3bc722bfc2dff10326 *inst/doc/rngtools-unitTests.Rnw
+9b0719669b75e46cedb037f2b3849193 *inst/doc/rngtools-unitTests.pdf
+2fe79852860623ebee42ac6f3d09d8f4 *inst/tests/runit.RNG.r
+43a4b97ff6a6ab8eb0bc055a1296a297 *inst/tests/runit.RNGseq.r
+454f088e424ec986386a05df67547d74 *inst/tests/runit.format.r
+58c623d5812709cb7a229db09e28a33b *man/RNGseed.Rd
+da7c8a7b2d6775dd9ae91c984e074b74 *man/RNGseq.Rd
+c3b8aac92c0b78e95d09a7f182c9d131 *man/RNGstr.Rd
+f3ed281a3d6a2486f077e3ae82d7d053 *man/rng.Rd
+29055b8d1c2295715232370351928602 *man/rngcmp.Rd
+5309ae8b9c73e02166f9800e41165144 *man/rngtools.Rd
+6e57687d6148e44975f7e448a8635dd1 *man/uchecks.Rd
+1b0d4ec95a873e5554708f9c20ca1e70 *tests/doRUnit.R
+640605f55fb05c3bc722bfc2dff10326 *vignettes/rngtools-unitTests.Rnw
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..0dc79ce
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,23 @@
+export(.getRNG)
+export(.setRNG)
+export(RNGdigest)
+export(RNGinfo)
+export(RNGrecovery)
+export(RNGseed)
+export(RNGseq)
+export(RNGseq_seed)
+export(RNGstr)
+export(RNGtype)
+export(checkRNG)
+export(getRNG)
+export(getRNG1)
+export(hasRNG)
+export(nextRNG)
+export(rng.equal)
+export(rng1.equal)
+export(setRNG)
+export(showRNG)
+import(digest)
+import(methods)
+import(pkgmaker)
+import(stringr)
diff --git a/R/RNG.R b/R/RNG.R
new file mode 100644
index 0000000..0c04900
--- /dev/null
+++ b/R/RNG.R
@@ -0,0 +1,639 @@
+# Copyright (C) 2009-2012 Renaud Gaujoux
+#
+# This file is part of the rngtools package for R.
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+#
+# Creation: 08 Nov 2011
+###############################################################################
+
+library(pkgmaker)
+
+###% Returns all the libraries that provides a user-supplied RNG
+###%
+###% The library that provides the wrapper hooks for the management multiple
+###% user-supplied RNG is removed from the output list.
+###%
+RNGlibs <- function(n=0, full=FALSE, hook="user_unif_rand", unlist=TRUE){
+ dlls <- getLoadedDLLs()
+ res <- lapply(dlls, function(d){
+ dname <- d[['name']]
+ if( dname=='' )
+ return(NA)
+
+ symb.unif_rand <- RNGlib(PACKAGE=dname, hook=hook)
+ if( is.null(symb.unif_rand) )
+ NA
+ else
+ symb.unif_rand
+ })
+
+ res <- res[!is.na(res)]
+ if( !full )
+ res <- names(res)
+
+ # limit the results if requested
+ if( n>0 )
+ res <- tail(res, n)
+
+ # return result
+ if( unlist && length(res) == 1 )
+ res[[1]]
+ else
+ res
+}
+
+###% Returns the library that provides the current user-supplied RNG hooks.
+###%
+###% This is the library that is first called by runif when using setting RNG
+###% kind to "user-supplied".
+###% In general this will be rstream, except if a package providing the RNG hook
+###% 'user_unif_rand' is loaded after rstream, and no call to RNGkind or getRNG
+###% were done thereafter.
+###%
+###% @return an object of class NativeSymbolInfo or NULL if no hook were found
+###%
+RNGlib <- function(PACKAGE='', full=FALSE, hook="user_unif_rand", ...){
+
+ if( !missing(PACKAGE) )
+ full = TRUE
+ if( !missing(hook) )
+ hook <- match.arg(hook, c('user_unif_rand', 'user_unif_init', 'user_unif_nseed', 'user_unif_seedloc'))
+
+ # lookup for the hook "user_unif_rand" in all the loaded libraries
+ symb.unif_rand <- try( getNativeSymbolInfo(hook, PACKAGE=PACKAGE, ...), silent=TRUE)
+ if( is(symb.unif_rand, 'try-error') ){
+
+ if( !full ) '' else NULL
+
+ }else if( PACKAGE=='' && is.null(symb.unif_rand$package) ){
+ #special case for MS Windows when PACKAGE is not specified: if two
+ # RNGlibs are loaded, the first one is seen, not the last one as on Unix
+ libs <- RNGlibs(full=TRUE, unlist=FALSE, hook=hook)
+ w <- which(sapply(libs, function(l) identical(l$address, symb.unif_rand$address)))
+
+ # returns full info or just the name
+ if( full ) libs[[w]]
+ else names(libs)[w]
+
+ }else if( full ) symb.unif_rand
+ else symb.unif_rand$package[['name']]
+}
+
+###% Returns the package that provides the current RNG managed by rstream
+###%
+###% It returns the name of the package to which are currently passed the RNG
+###% calls (runif, set.seed).
+###% This is either 'base' if core RNG is in use (e.g. Mersenne-Twister, Marsaglia-Multicarry, etc...)
+###% or the package that provides the actual RNG hooks called by the rstream
+###% wrapper hooks. This one was set either explicitly via RNGkind or implicitly
+###% when rstream was first loaded. In this latter case, the provider was identified
+###% at loading time as 'base' if core RNGs were in use or as the package that was
+###% providing the RNG hook 'user_unif_rand' if the RNG in used was "user-supplied".
+###%
+RNGprovider <- function(kind=RNGkind(), user.supplied=FALSE){
+
+ if( kind[1L] == 'user-supplied' || user.supplied ) RNGlib()
+ else 'base'
+}
+
+#' Directly Getting or Setting the RNG Seed
+#'
+#' \code{RNGseed} directly gets/sets the current RNG seed \code{.Random.seed}.
+#' It can typically be used to backup and restore the RNG state on exit of
+#' functions, enabling local RNG changes.
+#'
+#' @param seed an RNG seed, i.e. an integer vector.
+#' No validity check is performed, so it \strong{must} be a
+#' valid seed.
+#'
+#' @return invisibly the current RNG seed when called with no arguments,
+#' or the -- old -- value of the seed before changing it to
+#' \code{seed}.
+#'
+#' @export
+#' @examples
+#'
+#' # get current seed
+#' RNGseed()
+#' # directly set seed
+#' old <- RNGseed(c(401L, 1L, 1L))
+#' # show old/new seed description
+#' showRNG(old)
+#' showRNG()
+#'
+#' # set bad seed
+#' RNGseed(2:3)
+#' try( showRNG() )
+#' # recover from bad state
+#' RNGrecovery()
+#' showRNG()
+#'
+#' # example of backup/restore of RNG in functions
+#' f <- function(){
+#' orng <- RNGseed()
+#' on.exit(RNGseed(orng))
+#' RNGkind('Marsaglia')
+#' runif(10)
+#' }
+#'
+#' sample(NA)
+#' s <- .Random.seed
+#' f()
+#' identical(s, .Random.seed)
+#' \dontshow{ stopifnot(identical(s, .Random.seed)) }
+#'
+RNGseed <- function(seed){
+
+ res <- if( missing(seed) ){
+ if( exists('.Random.seed', where = .GlobalEnv) )
+ get('.Random.seed', envir = .GlobalEnv)
+ }else if( is.null(seed) ){
+ if( exists('.Random.seed', where = .GlobalEnv) )
+ rm('.Random.seed', envir = .GlobalEnv)
+ }else{
+ old <- RNGseed()
+ assign('.Random.seed', seed, envir = .GlobalEnv)
+ old
+ }
+ invisible(res)
+}
+
+#' \code{RNGrecovery} recovers from a broken state of \code{.Random.seed},
+#' and reset the RNG settings to defaults.
+#'
+#' @export
+#' @rdname RNGseed
+RNGrecovery <- function(){
+ s <- as.integer(c(401,0,0))
+ assign(".Random.seed", s, envir=.GlobalEnv)
+ RNGkind("default", "default")
+}
+
+.getRNGattribute <- function(object){
+ if( .hasSlot(object, 'rng') ) slot(object, 'rng')
+ else if( .hasSlot(object, 'rng.seed') ) slot(object, 'rng.seed') # for back compatibility
+ else if( !is.null(attr(object, 'rng')) ) attr(object, 'rng')
+ else if( is.list(object) ){ # compatibility with package setRNG
+ if( !is.null(object[['rng']]) ) object[['rng']]
+ else if( is.list(object[['noise']]) && !is.null(object[['noise']][['rng']]) )
+ object[['noise']][['rng']]
+ }else NULL
+}
+
+#' Getting/Setting RNGs
+#'
+#' \code{getRNG} returns the Random Number Generator (RNG) settings used for
+#' computing an object, using a suitable \code{.getRNG} S4 method to extract
+#' these settings.
+#' For example, in the case of objects that result from multiple model fits,
+#' it would return the RNG settings used to compute the best fit.
+#'
+#' This function handles single number RNG specifications in the following way:
+#' \describe{
+#' \item{integers}{Return them unchanged, considering them as encoded RNG kind
+#' specification (see \code{\link{RNG}}). No validity check is performed.}
+#' \item{real numbers}{If \code{num.ok=TRUE} return them unchanged.
+#' Otherwise, consider them as (pre-)seeds and pass them to \code{\link{set.seed}}
+#' to get a proper RNG seed.
+#' Hence calling \code{getRNG(1234)} is equivalent to \code{set.seed(1234); getRNG()}
+#' (See examples).
+#' }
+#' }
+#'
+#' @param object an R object from which RNG settings can be extracted, e.g. an
+#' integer vector containing a suitable value for \code{.Random.seed} or embedded
+#' RNG data, e.g., in S3/S4 slot \code{rng} or \code{rng$noise}.
+#' @param ... extra arguments to allow extension and passed to a suitable S4 method
+#' \code{.getRNG} or \code{.setRNG}.
+#' @param num.ok logical that indicates if single numeric (not integer) RNG data should be
+#' considered as a valid RNG seed (\code{TRUE}) or passed to \code{\link{set.seed}}
+#' into a proper RNG seed (\code{FALSE}) (See details and examples).
+#' @param extract logical that indicates if embedded RNG data should be looked for and
+#' extracted (\code{TRUE}) or if the object itself should be considered as an
+#' RNG specification.
+#' @param recursive logical that indicates if embedded RNG data should be extracted
+#' recursively (\code{TRUE}) or only once (\code{FASE}).
+#'
+#' @return \code{getRNG}, \code{getRNG1}, \code{nextRNG} and \code{setRNG}
+#' usually return an integer vector of length > 2L, like \code{\link{.Random.seed}}.
+#'
+#' \code{getRNG} and \code{getRNG1} return \code{NULL} if no RNG data was found.
+#'
+#' @rdname rng
+#' @seealso \code{\link{.Random.seed}}, \code{\link{showRNG}}
+#' @export
+#'
+#' @examples
+#' # get current RNG settings
+#' s <- getRNG()
+#' head(s)
+#' showRNG(s)
+#'
+#' # get RNG from a given single numeric seed
+#' s1234 <- getRNG(1234)
+#' head(s1234)
+#' showRNG(s1234)
+#' # this is identical to the RNG seed as after set.seed()
+#' set.seed(1234)
+#' identical(s1234, .Random.seed)
+#' # but if num.ok=TRUE the object is returned unchanged
+#' getRNG(1234, num.ok=TRUE)
+#'
+#' # single integer RNG data = encoded kind
+#' head(getRNG(1L))
+#'
+#' # embedded RNG data
+#' s <- getRNG(list(1L, rng=1234))
+#' identical(s, s1234)
+#'
+getRNG <- function(object, ..., num.ok=FALSE, extract=TRUE, recursive=TRUE){
+
+ if( missing(object) || is.null(object) ) return( .getRNG() )
+
+ # use RNG data from object if available
+ if( extract && !is.null(rng <- .getRNGattribute(object)) ){
+ if( recursive && hasRNG(rng) ) getRNG(rng, ..., num.ok=num.ok)
+ else rng
+ }else if( isNumber(object) ){
+ if( num.ok && isReal(object) ) object
+ else if( isInteger(object) ) object
+ else nextRNG(object, ...) # return RNG as if after setting seed
+ }else .getRNG(object, ...) # call S4 method on object
+
+}
+
+#' \code{hasRNG} tells if an object has embedded RNG data.
+#' @export
+#' @rdname rng
+#'
+#' @examples
+#' # test for embedded RNG data
+#' hasRNG(1)
+#' hasRNG( structure(1, rng=1:3) )
+#' hasRNG( list(1, 2, 3) )
+#' hasRNG( list(1, 2, 3, rng=1:3) )
+#' hasRNG( list(1, 2, 3, noise=list(1:3, rng=1)) )
+#'
+hasRNG <- function(object){
+ !is.null(.getRNGattribute(object))
+}
+
+#' \code{.getRNG} is an S4 generic that extract RNG settings from a variety of
+#' object types.
+#' Its methods define the workhorse functions that are called by \code{getRNG}.
+#'
+#' @rdname rng
+#' @inline
+#' @export
+setGeneric('.getRNG', function(object, ...) standardGeneric('.getRNG') )
+#' Default method that tries to extract RNG information from \code{object}, by
+#' looking sequentially to a slot named \code{'rng'}, a slot named \code{'rng.seed'}
+#' or an attribute names \code{'rng'}.
+#'
+#' It returns \code{NULL} if no RNG data was found.
+setMethod('.getRNG', 'ANY',
+ function(object, ...){
+ .getRNGattribute(object)
+ }
+)
+#' Returns the current RNG settings.
+setMethod('.getRNG', 'missing',
+ function(object){
+
+ # return current value of .Random.seed
+ # ensuring it exists first
+ if( !exists('.Random.seed', envir = .GlobalEnv) )
+ sample(NA)
+
+ return( get('.Random.seed', envir = .GlobalEnv) )
+
+ }
+)
+
+#' Method for S3 objects, that aims at reproducing the behaviour of the function
+#' \code{getRNG} of the package \code{getRNG}.
+#'
+#' It sequentially looks for RNG data in elements \code{'rng'}, \code{noise$rng}
+#' if element \code{'noise'} exists and is a \code{list}, or in attribute \code{'rng'}.
+#'
+setMethod('.getRNG', 'list',
+ function(object){
+ # lookup for some specific elements
+ if( !is.null(object$rng) ) object$rng
+ else if( is.list(object$noise) ) object$noise$rng
+ else attr(object, 'rng')
+ }
+)
+#setMethod('.getRNG', 'rstream',
+# function(object){
+# object
+# }
+#)
+#' Method for numeric vectors, which returns the object itself, coerced into an integer
+#' vector if necessary, as it is assumed to already represent a value for
+#' \code{\link{.Random.seed}}.
+#'
+setMethod('.getRNG', 'numeric',
+ function(object, ...){
+ as.integer(object)
+ }
+)
+
+#' \code{getRNG1} is an S4 generic that returns the \strong{initial} RNG settings
+#' used for computing an object.
+#' For example, in the case of results from multiple model fies, it would
+#' return the RNG settings used to compute the \emph{first} fit.
+#'
+#' \code{getRNG1} is defined to provide separate access to the RNG settings as
+#' they were at the very beginning of a whole computation, which might differ
+#' from the RNG settings returned by \code{getRNG}, that allows to reproduce the
+#' result only.
+#'
+#' Think of a sequence of separate computations, from which only one result is
+#' used for the result (e.g. the one that maximises a likelihood):
+#' \code{getRNG1} would return the RNG settings to reproduce the complete sequence
+#' of computations, while \code{getRNG} would return the RNG settings necessary to
+#' reproduce only the computation whose result has maximum likelihood.
+#'
+#' @rdname rng
+#' @export
+#' @inline
+#'
+setGeneric('getRNG1', function(object, ...) standardGeneric('getRNG1') )
+#' Default method that is identical to \code{getRNG(object, ...)}.
+setMethod('getRNG1', 'ANY',
+ function(object, ...){
+ getRNG(object, ...)
+ }
+)
+
+#' \code{nextRNG} returns the RNG settings as they would be after seeding with
+#' \code{object}.
+#'
+#' @param ndraw number of draws to perform before returning the RNG seed.
+#'
+#' @rdname rng
+#' @export
+#' @examples
+#' head(nextRNG())
+#' head(nextRNG(1234))
+#' head(nextRNG(1234, ndraw=10))
+#'
+nextRNG <- function(object, ..., ndraw=0L){
+
+ # get/restore .Random.seed on.exit
+ orseed <- RNGseed()
+ on.exit(RNGseed(orseed))
+
+ # return next state of current RNG if object is missing
+ if( missing(object) ){
+ runif(1)
+ return( getRNG() )
+ }
+
+ # extract RNG from object
+ rng <- .getRNGattribute(object)
+ if( !is.null(rng) ){
+ on.exit()
+ return( nextRNG(rng, ...) )
+ }
+
+ # only work for numeric seeds
+ if( !is.numeric(object) )
+ stop("Invalid seed: expecting a numeric seed.")
+
+ # set RNG
+ .setRNG(object, ...)
+
+ # perform some draws
+ if( ndraw > 0 ){
+ if( !isNumber(ndraw) )
+ stop("Invalid value in argument `ndraw`: single numeric value expected.")
+ runif(ndraw)
+ }
+ # return new RNG settings
+ res <- RNGseed()
+ res
+}
+
+.collapse <- function(x, sep=', ', n=7L){
+
+ res <- paste(head(x, n), collapse=', ')
+ if( length(x) > n )
+ res <- paste(res, '...', sep=', ')
+ res
+}
+
+#' \code{setRNG} set the current RNG with a seed,
+#' using a suitable \code{.setRNG} method to set these settings.
+#'
+#' @param check logical that indicates if only valid RNG kinds should be
+#' accepted, or if invalid values should just throw a warning.
+#' Note that this argument is used only on R >= 3.0.2.
+#'
+#' @return \code{setRNG} invisibly returns the old RNG settings as
+#' they were before changing them.
+#'
+#' @export
+#' @rdname rng
+#' @examples
+#'
+#' obj <- list(x=1000, rng=123)
+#' setRNG(obj)
+#' rng <- getRNG()
+#' runif(10)
+#' set.seed(123)
+#' rng.equal(rng)
+#'
+setRNG <- function(object, ..., verbose=FALSE, check = TRUE){
+
+ # do nothing if null
+ if( is.null(object) ) return()
+
+ # use RNG data from object if available
+ rng <- getRNG(object, ...)
+ if( !is.null(rng) && !identical(rng, object) ) return( setRNG(rng, ...) )
+
+ # get/restore .Random.seed on.exit in case of errors
+ orseed <- getRNG()
+ on.exit({
+ message("Restoring RNG settings probably due to an error in setRNG")
+ RNGseed(orseed)
+ })
+
+ # call S4 method on object
+ # check validity of the seed
+ tryCatch(.setRNG(object, ...)
+ , warning = function(err){
+ if( check && testRversion('> 3.0.1')
+ && grepl("\\.Random\\.seed.* is not a valid", err$message) ){
+ stop("setRNG - Invalid RNG kind [", str_out(object), "]: "
+ , err$message, '.'
+ , call.=FALSE)
+ }else{
+ warning(err)
+ }
+ }
+ )
+
+ # cancel RNG restoration
+ on.exit()
+ if( verbose ) showRNG()
+
+ invisible(orseed)
+}
+
+#' \code{.setRNG} is an S4 generic that sets the current RNG settings, from a
+#' variety of specifications.
+#' Its methods define the workhorse functions that are called by \code{setRNG}.
+#'
+#' @inline
+#' @rdname rng
+#' @export
+setGeneric('.setRNG', function(object, ...) standardGeneric('.setRNG') )
+#' Sets the RNG to kind \code{object}, assuming is a valid RNG kind:
+#' it is equivalent to \code{RNGkind(object, ...}.
+#' All arguments in \code{...} are passed to \code{\link{RNGkind}}.
+#'
+#' @param verbose a logical that indicates if the new RNG settings should
+#' be displayed.
+#'
+#' @examples
+#' # set RNG kind
+#' old <- setRNG('Marsaglia')
+#' # restore
+#' setRNG(old)
+setMethod('.setRNG', 'character',
+ function(object, ...){
+ if( length(object) == 1L )
+ RNGkind(kind=object, ...)
+ else
+ RNGkind(kind=object[1L], normal.kind=object[2L])
+ }
+)
+
+#' Sets the RNG settings using \code{object} directly the new value for
+#' \code{.Random.seed} or to initialise it with \code{\link{set.seed}}.
+#'
+#' @examples
+#'
+#' # directly set .Random.seed
+#' rng <- getRNG()
+#' r <- runif(10)
+#' setRNG(rng)
+#' rng.equal(rng)
+#'
+#' # initialise from a single number (<=> set.seed)
+#' setRNG(123)
+#' rng <- getRNG()
+#' runif(10)
+#' set.seed(123)
+#' rng.equal(rng)
+#'
+setMethod('.setRNG', 'numeric',
+ function(object, ...){
+
+ if( length(object) == 1L ){
+ if( is.integer(object) ){ # set kind and draw once to fix seed
+ RNGseed(object)
+ # check validity of the seed
+ tryCatch(runif(1)
+ , error = function(err){
+ stop("setRNG - Invalid RNG kind [", object, "]: "
+ , err$message, '.'
+ , call.=FALSE)
+ }
+ )
+ RNGseed()
+ }else{ # pass to set.seed
+ set.seed(object, ...)
+ }
+ }else{
+ seed <- as.integer(object)
+ RNGseed(seed)
+ # check validity of the seed
+ tryCatch(runif(1)
+ , error=function(err){
+ stop("setRNG - Invalid numeric seed ["
+ , .collapse(seed, n=5), "]: ", err$message, '.'
+ , call.=FALSE)
+ }
+ )
+ RNGseed(seed)
+ }
+ }
+)
+
+#' \code{RNGdigest} computes a hash from the RNG settings associated with an
+#' object.
+#'
+#' @import digest
+#' @rdname RNGstr
+#' @export
+#'
+#' @examples
+#' # compute digest hash from RNG settings
+#' RNGdigest()
+#' RNGdigest(1234)
+#' # no validity check is performed
+#' RNGdigest(2:3)
+#'
+RNGdigest <- function(object=getRNG()){
+
+ x <- object
+ object <- getRNG(x)
+
+ # exit if no RNG was extracted
+ if( is.null(object) ){
+ warning("Found no embedded RNG data in object [", class(x),"]: returned NULL digest [", digest(NULL), '].')
+ return(digest(NULL)) # TODO: return NULL
+ }
+
+ digest(object)
+
+}
+
+#' Comparing RNG Settings
+#'
+#' \code{rng.equal} compares the RNG settings associated with two objects.
+#'
+#' These functions return \code{TRUE} if the RNG settings are identical,
+#' and \code{FALSE} otherwise.
+#' The comparison is made between the hashes returned by \code{RNGdigest}.
+#'
+#' @param x objects from which RNG settings are extracted
+#' @param y object from which RNG settings are extracted
+#'
+#' @return \code{rng.equal} and \code{rng.equal1} return a \code{TRUE} or
+#' \code{FALSE}.
+#'
+#' @rdname rngcmp
+#' @export
+rng.equal <- function(x, y){
+ if( missing(y) )
+ y <- getRNG()
+ identical(RNGdigest(x), RNGdigest(y))
+}
+
+#' \code{rng1.equal} tests whether two objects have identical
+#' \strong{initial} RNG settings.
+#'
+#' @rdname rngcmp
+#' @export
+rng1.equal <- function(x, y){
+ if( missing(y) )
+ y <- getRNG()
+ rng.equal(getRNG1(x), getRNG1(y))
+}
diff --git a/R/RNGseq.R b/R/RNGseq.R
new file mode 100644
index 0000000..78f18d2
--- /dev/null
+++ b/R/RNGseq.R
@@ -0,0 +1,206 @@
+# Generate a sequence of RNGs suitable for parallel computation
+# using L'Ecuyer's RNG
+#
+# Author: Renaud Gaujoux
+###############################################################################
+
+# or-NULL operator (borrowed from Hadley Wickham)
+'%||%' <- function(x, y) if( !is.null(x) ) x else y
+
+#' Generate Sequence of Random Streams
+#'
+#' Create a given number of seeds for L'Ecuyer's RNG, that can be used to seed
+#' parallel computation, making them fully reproducible.
+#'
+#' This ensures complete reproducibility of the set of run.
+#' The streams are created using L'Ecuyer's RNG, implemented in R core since
+#' version 2.14.0 under the name \code{"L'Ecuyer-CMRG"} (see \code{\link{RNG}}).
+#'
+#' Generating a sequence without specifying a seed uses a single draw of the
+#' current RNG. The generation of a sequence using seed (a single or 6-length
+#' numeric) a should not affect the current RNG state.
+#'
+#' @param n Number of streams to be created
+#' @param seed seed specification used to initialise the set of streams
+#' using \code{\link{RNGseq_seed}}.
+#' @param simplify a logical that specifies if sequences of length 1 should be
+#' unlisted and returned as a single vector.
+#' @param ... extra arguments passed to \code{\link{RNGseq_seed}}.
+#'
+#' @return a list of integer vectors (or a single integer vector if
+#' \code{n=1} and \code{unlist=TRUE}).
+#'
+#' @export
+#' @examples
+#'
+#' RNGseq(3)
+#' RNGseq(3)
+#' RNGseq(3, seed=123)
+#' # or identically
+#' set.seed(123)
+#' identical(RNGseq(3), RNGseq(3, seed=123))
+#' \dontshow{
+#' set.seed(123)
+#' stopifnot( identical(RNGseq(3), RNGseq(3, seed=123)) )
+#' }
+#'
+#' RNGseq(3, seed=1:6, verbose=TRUE)
+#' # select Normal kind
+#' RNGseq(3, seed=123, normal.kind="Ahrens")
+#'
+RNGseq <- function(n, seed=NULL, ..., simplify=TRUE, version=2){
+
+ library(parallel)
+ # check parameters
+ if( n <= 0 )
+ stop("NMF::createStream - invalid value for 'n' [positive value expected]")
+
+ # extract RNG setting from object if possible
+ if( !is.null(seed) ) seed <- getRNG(seed, num.ok=TRUE) %||% seed
+
+ # convert matrix into a list of seed
+ if( is.matrix(seed) )
+ seed <- lapply(seq(ncol(seed)), function(i) seed[,i])
+
+ # if already a sequence of seeds: use directly
+ #print(seed)
+ if( is.list(seed) ){
+ # check length
+ if( length(seed) > n ){
+ warning("Reference seed sequence is longer than the required number of seed: only using the ", n, " first seeds.")
+ seed <- seed[1:n]
+ }else if( length(seed) < n )
+ stop("Reference seed sequence is shorter [",length(seed),"] than the required number of seed [", n, "].")
+
+ res <- lapply(seed, as.integer)
+ }else{ # otherwise: get initial seed for the CMRG stream sequence
+
+ orng <- RNGseed()
+ .s <- RNGseq_seed(seed, ..., version=version)
+
+ res <- lapply(1:n, function(i){
+ if( i == 1 ) .s
+ else .s <<- nextRNGStream(.s)
+ })
+
+ # if not seeded and current RNG is L'Ecuyer-CMRG => move to stream after last stream
+ if( is.null(seed) && RNGkind()[1L] == "L'Ecuyer-CMRG" && version>=2 ){
+ # ensure old normal kind is used
+ RNGseed(c(orng[1L], nextRNGStream(.s)[2:7]))
+ }
+ }
+
+ # return list or single RNG
+ if( n==1 && simplify )
+ res[[1]]
+ else
+ res
+
+}
+
+#' \code{RNGseq_seed} generates the -- next -- random seed used as the first seed in
+#' the sequence generated by \code{\link{RNGseq}}.
+#'
+#' @param normal.kind Type of Normal random generator. See \code{\link{RNG}}.
+#' @param verbose logical to toggle verbose messages
+#' @param version version of the function to use, to reproduce old behaviours.
+#' Version 1 had a bug which made the generated stream sequences share most of their
+#' seeds (!), as well as being not equivalent to calling \code{set.seed(seed); RNGseq_seed(NULL)}.
+#' Version 2 fixes this bug.
+#'
+#' @return a 7-length numeric vector.
+#' @seealso \code{\link{RNGseq}}
+#'
+#' @rdname RNGseq
+#' @export
+#' @examples
+#'
+#' ## generate a seed for RNGseq
+#' # random
+#' RNGseq_seed()
+#' RNGseq_seed()
+#' RNGseq_seed(NULL)
+#' # fixed
+#' RNGseq_seed(1)
+#' RNGseq_seed(1:6)
+#'
+#' # `RNGseq_seed(1)` is identical to
+#' set.seed(1)
+#' s <- RNGseq_seed()
+#' identical(s, RNGseq_seed(1))
+#' \dontshow{ stopifnot(identical(s, RNGseq_seed(1))) }
+#'
+RNGseq_seed <- function(seed=NULL, normal.kind=NULL, verbose=FALSE, version=2){
+
+ # retrieve current seed
+ orng <- RNGseed()
+ # setup RNG restoration in case of an error
+ on.exit({
+ RNGseed(orng)
+ if( verbose ) message("# Restoring RNG: ", paste(RNGkind(), collapse=' - '), ' [', .collapse(orng), ']')
+ })
+
+ rkind_not_CMRG <- RNGkind()[1L] != "L'Ecuyer-CMRG"
+
+ if( verbose ) message("# Original RNG: ", paste(RNGkind(), collapse=' - '), ' [', .collapse(orng), ']')
+ # seed with numeric seed
+ if( is.numeric(seed) ){
+ if( length(seed) == 1L ){
+
+ if( verbose ) message("# Generate RNGstream random seed from ", seed, " ... ", appendLF=FALSE)
+ if( version<2 || rkind_not_CMRG ){ # behaviour prior 1.4
+ set.seed(seed)
+ RNGkind(kind="L'Ecuyer-CMRG", normal.kind=normal.kind)
+ }else{ # fix seed after switching to CMRG: ensure result independence from the current RNG
+ set.seed(seed, kind="L'Ecuyer-CMRG", normal.kind=normal.kind)
+ }
+ if( verbose ) message("OK")
+ }
+ else if( length(seed) == 6L ){
+ if( verbose ) message("# Directly use 6-long seed: ", paste(seed, collapse=', '), " ... ", appendLF=FALSE)
+ RNGkind("L'Ecuyer-CMRG", normal.kind=normal.kind)
+ s <- RNGseed()
+ s[2:7] <- as.integer(seed)
+ RNGseed(s)
+ if( verbose ) message("OK")
+ }else if ( length(seed) == 7L ){
+ if( seed[1] %% 100 != 7L )
+ stop("RNGseq_seed - Invalid 7-long numeric seed: RNG code should be '7', i.e. of type \"L'Ecuyer-CMRG\"")
+ if( verbose ) message("# Directly use CMRG seed: ", paste(seed, collapse=', '), " ... ", appendLF=FALSE)
+ RNGseed(seed)
+ if( verbose ) message("OK")
+ }else
+ stop("RNGseq_seed - Invalid numeric seed: should be a numeric of length 1, 6 or 7")
+ }else if( is.null(seed) ){
+ if( rkind_not_CMRG ){ # seed with random seed
+
+ # draw once from the current calling RNG to ensure different seeds
+ # for separate loops, but to ensure identical results as with set.seed
+ # one must still use the current RNG before changing RNG kind
+ runif(1)
+ orng1 <- RNGseed()
+ RNGseed(orng)
+ orng <- orng1
+
+ if( verbose ) message("# Generate random RNGstream seed: ", appendLF=FALSE)
+ RNGkind(kind="L'Ecuyer", normal.kind=normal.kind)
+ if( verbose ) message("OK")
+ }else{ # seed with next RNG stream
+ if( version < 2 ){
+ on.exit() # cancel RNG restoration
+ s <- nextRNGStream(orng)
+ if( verbose ) message("# Use next active RNG stream: ", .collapse(s[2:7]))
+ RNGseed(s)
+ }else{
+ # only change normal kind if necessary and use current stream state
+ if( !is.null(normal.kind) ) RNGkind(normal.kind=normal.kind)
+ if( verbose ) message("# Use current active RNG stream: ", .collapse(RNGseed()[2:7]))
+ }
+ }
+ }else
+ stop("RNGseq_seed - Invalid seed value: should be a numeric or NULL")
+
+ s <- RNGseed()
+ if( verbose ) message("# Seed RNGkind is: ", paste(RNGkind(), collapse=' - '), ' [', .collapse(s), ']')
+ s
+}
diff --git a/R/format.R b/R/format.R
new file mode 100644
index 0000000..5b9f620
--- /dev/null
+++ b/R/format.R
@@ -0,0 +1,208 @@
+# RNG formatting functions
+#
+# Author: Renaud Gaujouc
+###############################################################################
+
+#' Formatting RNG Information
+#'
+#' These functions retrieve/prints formated information about RNGs.
+#'
+#' All functions can retrieve can be called with objects that are -- valid --
+#' RNG seeds or contain embedded RNG data, but none of them change the current
+#' RNG setting.
+#' To effectively change the current settings on should use \code{\link{setRNG}}.
+#'
+#' \code{RNGstr} returns a description of an RNG seed as a single character string.
+#'
+#' \code{RNGstr} formats seeds by collapsing them in a comma separated string.
+#' By default, seeds that contain more than 7L integers, have their 3 first values
+#' collapsed plus a digest hash of the complete seed.
+#'
+#' @param object RNG seed (i.e. an integer vector), or an object that contains
+#' embedded RNG data.
+#' For \code{RNGtype} this must be either a valid RNG seed or a single integer that
+#' must be a valid encoded RNG kind (see \code{\link{RNGkind}}).
+#' @param n maximum length for a seed to be showed in full.
+#' If the seed has length greater than \code{n}, then only the first three elements
+#' are shown and a digest hash of the complete seed is appended to the string.
+#'
+#' @return a single character string
+#'
+#' @export
+#' @examples
+#'
+#' # default is a 626-long integer
+#' RNGstr()
+#' # what would be the seed after seeding with set.seed(1234)
+#' RNGstr(1234)
+#' # another RNG (short seed)
+#' RNGstr(c(401L, 1L, 1L))
+#' # no validity check is performed
+#' RNGstr(2:3)
+#'
+RNGstr <- function(object, n=7L, ...){
+
+ if( missing(object) ){
+ rp <- RNGprovider()
+ rs <- getRNG()
+ if( rp == 'base' || length(rs) > 1L )
+ object <- rs
+ else
+ return( "Unknown" )
+ }
+
+ # extract seed from object
+ seed <- getRNG(object, ...)
+ if( is.null(seed) ) 'NULL'
+ else if( is.numeric(seed) ){
+ if( length(seed) > n ){
+ paste(str_out(seed, 3L), str_c('[', digest(seed), ']'))
+ }else{
+ str_out(seed, Inf)
+ }
+ }
+ else
+ paste(class(seed), ' [', digest(seed), ']', sep='')
+}
+
+#' \code{RNGtype} extract the kinds of RNG and Normal RNG.
+#'
+#' \code{RNGtype} returns the same type of values as \code{RNGkind()} (character strings),
+#' except that it can extract the RNG settings from an object.
+#' If \code{object} is missing it returns the kinds of the current RNG settings,
+#' i.e. it is identical to \code{RNGkind()}.
+#'
+#' @param provider logical that indicates if the library that provides the RNG
+#' should also be returned as a third element.
+#'
+#' @return \code{RNGtype} returns a 2 or 3-long character vector.
+#'
+#' @export
+#' @rdname RNGstr
+#'
+#' @examples
+#'
+#' # get RNG type
+#' RNGtype()
+#' RNGtype(provider=TRUE)
+#' RNGtype(1:3)
+#'
+#' # type from encoded RNG kind
+#' RNGtype(107L)
+#' # this is different from the following which treats 107 as a seed for set.seed
+#' RNGtype(107)
+#'
+RNGtype <- function(object, ..., provider=FALSE){
+
+ res <-
+ if( missing(object) ){
+ RNGkind()
+ }else{
+ old <- RNGseed()
+
+ # extract RNG data
+ rng <- getRNG(object, ...)
+ if( is.null(rng) ){
+ warning("Could not find embedded RNG data in ", deparse(substitute(object)), "."
+ , " Returned current type.")
+ }
+ # setup restoration
+ on.exit( RNGseed(old) )
+ setRNG(rng)
+ RNGkind()
+ }
+
+ # determine provider if requested
+ if( provider ){
+ prov <- RNGprovider(res)
+ res <- c(res, prov)
+ }
+ # return result
+ res
+}
+
+#' \code{showRNG} displays human readable information about RNG settings.
+#' If \code{object} is missing it displays information about the current RNG.
+#'
+#' @param indent character string to use as indentation prefix in the output
+#' from \code{showRNG}.
+#'
+#' @export
+#' @rdname RNGstr
+#'
+#' @examples
+#' showRNG()
+#' # as after set.seed(1234)
+#' showRNG(1234)
+#' showRNG()
+#' set.seed(1234)
+#' showRNG()
+#' # direct seeding
+#' showRNG(1:3)
+#' # this does not change the current RNG
+#' showRNG()
+#' showRNG(provider=TRUE)
+#'
+showRNG <- function(object=getRNG(), indent='#', ...){
+
+ # get kind
+ tryCatch(suppressMessages(info <- RNGtype(object, ...))
+ , error = function(e){
+ stop("Could not show RNG due to error: ", conditionMessage(e))
+ }
+ )
+ # show information
+ cat(indent, "RNG kind: ", paste(info[1:2], collapse=" / ")
+ , if( length(info) > 2L ) paste('[', info[3L], ']', sep='')
+ , "\n")
+ cat(indent, "RNG state:", RNGstr(object), "\n")
+}
+
+#' \code{RNGinfo} is equivalent to \code{RNGtype} but returns a named
+#' list instead of an unnamed character vector.
+#'
+#' @param ... extra arguments passed to \code{RNGtype}.
+#'
+#' @export
+#' @rdname RNGstr
+#'
+#' @examples
+#' # get info as a list
+#' RNGinfo()
+#' RNGinfo(provider=TRUE)
+#' # from encoded RNG kind
+#' RNGinfo(107)
+#'
+RNGinfo <- function(object=getRNG(), ...){
+
+ # get type
+ kind <- RNGtype(object, ...)
+ n <- c('kind', 'normal', 'provider')
+ as.list(setNames(kind, n[1:length(kind)]))
+
+}
+
+
+#' Checking RNG Differences in Unit Tests
+#'
+#' \code{checkRNG} checks if two objects have the same RNG
+#' settings and should be used in unit tests, e.g., with the \pkg{RUnit}
+#' package.
+#'
+#' @param x,y objects from which RNG settings are extracted.
+#' @param ... extra arguments passed to \code{\link{rng.equal}}.
+#'
+#' @export
+#' @rdname uchecks
+#' @examples
+#'
+#' # check for differences in RNG
+#' set.seed(123)
+#' checkRNG(123)
+#' try( checkRNG(123, 123) )
+#' try( checkRNG(123, 1:3) )
+#'
+checkRNG <- function(x, y=getRNG(), ...){
+ requireRUnit()
+ checkTrue(rng.equal(x, y), ...)
+}
diff --git a/R/rngtools-package.r b/R/rngtools-package.r
new file mode 100644
index 0000000..cc92751
--- /dev/null
+++ b/R/rngtools-package.r
@@ -0,0 +1,56 @@
+#' Utility functions for working with Random Number Generators
+#'
+#' This package contains a set of functions for working with
+#' Random Number Generators (RNGs). In particular, it defines a generic
+#' S4 framework for getting/setting the current RNG, or RNG data
+#' that are embedded into objects for reproducibility.
+#'
+#' Notably, convenient default methods greatly facilitate the way current
+#' RNG settings can be changed.
+#'
+#' @name rngtools
+#' @docType package
+#'
+#' @import stringr
+#' @import digest
+#' @import methods
+#' @import pkgmaker
+#'
+#' @examples
+#'
+#' showRNG()
+#' s <- getRNG()
+#' RNGstr(s)
+#' RNGtype(s)
+#'
+#' # get what would be the RNG seed after set.seed
+#' s <- nextRNG(1234)
+#' showRNG(s)
+#' showRNG( nextRNG(1234, ndraw=10) )
+#'
+#' # change of RNG kind
+#' showRNG()
+#' k <- RNGkind()
+#' k[2L] <- 'Ahrens'
+#' try( RNGkind(k) )
+#' setRNG(k)
+#' showRNG()
+#' # set encoded kind
+#' setRNG(501L)
+#' showRNG()
+#'
+#' # use as set seed
+#' setRNG(1234)
+#' showRNG()
+#' r <- getRNG()
+#'
+#' # extract embedded RNG specifications
+#' runif(10)
+#' setRNG(list(1, rng=1234))
+#' rng.equal(r)
+#'
+#' # restore default RNG (e.g., after errors)
+#' RNGrecovery()
+#' showRNG()
+#'
+NULL
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..f0f210f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,12 @@
+rngtools
+========
+
+R package - Utility functions for working with Random Number Generators
+
+This package contains a set of functions for working with
+Random Number Generators (RNGs). In particular, it defines a generic
+S4 framework for getting/setting the current RNG, or RNG data
+that are embedded into objects for reproducibility.
+
+Notably, convenient default methods greatly facilitate the way current
+RNG settings can be changed.
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..dd85a43
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/inst/doc/rngtools-unitTests.R b/inst/doc/rngtools-unitTests.R
new file mode 100644
index 0000000..e66beab
--- /dev/null
+++ b/inst/doc/rngtools-unitTests.R
@@ -0,0 +1,9 @@
+
+## ----setup, include=FALSE------------------------------------------------
+pkg <- 'rngtools'
+require( pkg, character.only=TRUE )
+prettyVersion <- packageDescription(pkg)$Version
+prettyDate <- format(Sys.Date(), '%B %e, %Y')
+authors <- packageDescription(pkg)$Author
+
+
diff --git a/inst/doc/rngtools-unitTests.Rnw b/inst/doc/rngtools-unitTests.Rnw
new file mode 100644
index 0000000..ff4e04d
--- /dev/null
+++ b/inst/doc/rngtools-unitTests.Rnw
@@ -0,0 +1,80 @@
+
+\documentclass[10pt]{article}
+%\VignetteDepends{knitr}
+%\VignetteIndexEntry{rngtools-unitTests}
+%\VignetteCompiler{knitr}
+%\VignetteEngine{knitr::knitr}
+\usepackage{vmargin}
+\setmargrb{0.75in}{0.75in}{0.75in}{0.75in}
+
+<<setup, include=FALSE>>=
+pkg <- 'rngtools'
+require( pkg, character.only=TRUE )
+prettyVersion <- packageDescription(pkg)$Version
+prettyDate <- format(Sys.Date(), '%B %e, %Y')
+authors <- packageDescription(pkg)$Author
+@
+
+\usepackage[colorlinks]{hyperref}
+\author{\Sexpr{authors}}
+\title{\texttt{\Sexpr{pkg}}: Unit testing results\footnote{Vignette computed on Thu Mar 6 11:45:50 2014}}
+\date{\texttt{\Sexpr{pkg}} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}}
+\begin{document}
+\maketitle
+
+\section{Details}
+\begin{verbatim}
+
+RUNIT TEST PROTOCOL -- Thu Mar 6 11:45:50 2014
+***********************************************
+Number of test functions: 6
+Number of errors: 0
+Number of failures: 0
+
+
+1 Test Suite :
+package:rngtools - 6 test functions, 0 errors, 0 failures
+
+
+
+Details
+***************************
+Test Suite: package:rngtools
+Test function regexp: ^test.
+Test file regexp: ^runit.*.[rR]$
+Involved directory:
+/tmp/Rpkglib_51e6234a85cc/rngtools/tests
+---------------------------
+Test file: /tmp/Rpkglib_51e6234a85cc/rngtools/tests/runit.format.r
+test.RNGdigest: (30 checks) ... OK (0.01 seconds)
+test.RNGtype: (22 checks) ... OK (0.01 seconds)
+---------------------------
+Test file: /tmp/Rpkglib_51e6234a85cc/rngtools/tests/runit.RNG.r
+test.getRNG: (18 checks) ... OK (0 seconds)
+test.setRNG: (34 checks) ... OK (0.01 seconds)
+---------------------------
+Test file: /tmp/Rpkglib_51e6234a85cc/rngtools/tests/runit.RNGseq.r
+test.RNGseq: (51 checks) ... OK (0.01 seconds)
+test.RNGseq_seed: (75 checks) ... OK (0 seconds)
+
+Total execution time
+***************************
+ user system elapsed
+ 0.234 0.001 0.234
+
+\end{verbatim}
+
+\section*{Session Information}
+\begin{itemize}\raggedright
+ \item R Under development (unstable) (2014-03-02 r65102), \verb|x86_64-unknown-linux-gnu|
+ \item Locale: \verb|LC_CTYPE=en_US.UTF-8|, \verb|LC_NUMERIC=C|, \verb|LC_TIME=en_US.UTF-8|, \verb|LC_COLLATE=en_US.UTF-8|, \verb|LC_MONETARY=en_US.UTF-8|, \verb|LC_MESSAGES=en_US.UTF-8|, \verb|LC_PAPER=en_US.UTF-8|, \verb|LC_NAME=C|, \verb|LC_ADDRESS=C|, \verb|LC_TELEPHONE=C|, \verb|LC_MEASUREMENT=en_US.UTF-8|, \verb|LC_IDENTIFICATION=C|
+ \item Base packages: base, datasets, graphics, grDevices, methods,
+ parallel, stats, utils
+ \item Other packages: pkgmaker~0.20, registry~0.2, rngtools~1.2.4,
+ RUnit~0.4.26, stringr~0.6.2
+ \item Loaded via a namespace (and not attached): codetools~0.2-8,
+ digest~0.6.4, tools~3.1.0, xtable~1.7-1
+\end{itemize}
+
+\end{document}
+
diff --git a/inst/doc/rngtools-unitTests.pdf b/inst/doc/rngtools-unitTests.pdf
new file mode 100644
index 0000000..15f40de
Binary files /dev/null and b/inst/doc/rngtools-unitTests.pdf differ
diff --git a/inst/tests/runit.RNG.r b/inst/tests/runit.RNG.r
new file mode 100644
index 0000000..fddb18e
--- /dev/null
+++ b/inst/tests/runit.RNG.r
@@ -0,0 +1,133 @@
+# Unit test for getRNG
+#
+# Author: Renaud Gaujoux
+###############################################################################
+
+library(stringr)
+
+test.getRNG <- function(){
+
+ RNGkind('default', 'default')
+ on.exit( RNGrecovery() )
+
+ checker <- function(x, y, ..., msg=NULL, drawRNG=TRUE){
+
+ if( drawRNG ) runif(10)
+ fn <- getRNG
+ oldRNG <- RNGseed()
+ if( !missing(x) ){
+ d <- fn(x, ...)
+ cl <- str_c(class(x), '(', length(x), ')')
+ }else{
+ d <- fn()
+ cl <- 'MISSING'
+ }
+ newRNG <- RNGseed()
+ .msg <- function(x) paste(cl, ':', x, '[', msg, ']')
+ checkIdentical(oldRNG, newRNG, .msg("does not change RNG"))
+ checkIdentical(d, y, .msg("result is correct") )
+ }
+
+ set.seed(123456)
+ seed123456 <- .Random.seed
+ checker(, seed123456, msg="No arguments: returns .Random.seed", drawRNG=FALSE)
+ checker(123456, seed123456, msg="Single numeric argument: returns .Random.seed as it would be after setting the seed")
+ checker(123456, 123456, num.ok=TRUE, msg="Single numeric argument + num.ok: returns argument unchanged")
+ checker(.Random.seed, .Random.seed, msg="Integer seed argument: returns its argument unchanged")
+ checker(as.numeric(.Random.seed), .Random.seed, msg="Numeric seed argument: returns its argument as an integer vector")
+ checker(2:3, 2:3, msg="Integer INVALID seed vector argument: returns its argument unchanged")
+ checker(c(2,3), c(2L,3L), msg="Numeric INVALID seed vector argument: returns its argument as an integer vector")
+ checker(1L, 1L, msg="Single integer = Encoded RNG kind: returns it unchanged")
+ checker(1000L, 1000L, msg="Invalid single integer = Encoded RNG kind: returns it unchanged")
+
+}
+
+test.setRNG <- function(){
+
+ RNGkind('default', 'default')
+ on.exit( RNGrecovery() )
+
+ checker <- function(x, y, tset, drawRNG=TRUE){
+
+ on.exit( RNGrecovery() )
+
+ if( drawRNG ) runif(10)
+ oldRNG <- RNGseed()
+ d <- force(x)
+ newRNG <- RNGseed()
+
+ msg <- function(x, ...) paste(tset, ':', ...)
+ checkTrue(!identical(oldRNG, newRNG), msg("changes RNG"))
+ checkIdentical(getRNG(), y, msg("RNG is correctly set") )
+ checkIdentical(d, oldRNG, msg("returns old RNG") )
+ }
+
+ set.seed(123456)
+ refseed <- .Random.seed
+ checker(setRNG(123456), refseed, "Single numeric: sets current RNG with seed")
+
+ # setting kind with a character string
+ set.seed(123)
+ RNGkind('Mar')
+ refseed <- .Random.seed
+ RNGrecovery()
+ set.seed(123)
+ checker(setRNG('Mar'), refseed, "Single character: change RNG kind", drawRNG=FALSE)
+
+ # setting kind with a character string
+ set.seed(123)
+ RNGkind('Mar', 'Ahrens')
+ refseed <- .Random.seed
+ RNGrecovery()
+ set.seed(123)
+ checker(setRNG('Mar', 'Ahrens'), refseed, "Two character strings: change RNG kind and normal kind", drawRNG=FALSE)
+ RNGrecovery()
+ set.seed(123)
+ checker(setRNG(c('Mar', 'Ahrens')), refseed, "2-long character vector: change RNG kind and normal kind", drawRNG=FALSE)
+
+ # setting kind
+ set.seed(123456, kind='Mar')
+ refseed <- .Random.seed
+ checker(setRNG(123456, kind='Mar'), refseed, "Single numeric + kind: change RNG kind + set seed")
+
+ # setting Nkind
+ set.seed(123456, normal.kind='Ahrens')
+ refseed <- .Random.seed
+ checker(setRNG(123456, normal.kind='Ahrens'), refseed
+ , "Single numeric + normal.kind: change RNG normal kind + set seed")
+
+ # setting kind and Nkind
+ set.seed(123456, kind='Mar', normal.kind='Ahrens')
+ refseed <- .Random.seed
+ checker(setRNG(123456, kind='Mar', normal.kind='Ahrens'), refseed
+ , "Single numeric + kind + normal.kind: change RNG all kinds + set seed")
+
+ # with seed length > 1
+ refseed <- as.integer(c(201, 0, 0))
+ checker(setRNG(refseed), refseed, "numeric vector: directly set seed")
+
+ refseed <- .Random.seed
+ checkException( setRNG(2:3), "numeric vector: throws an error if invalid value for .Random.seed")
+ checkIdentical( .Random.seed, refseed, ".Random.seed is not changed in case of an error in setRNG")
+
+ oldRNG <- getRNG()
+ checkException(setRNG(1234L), "Error with invalid integer seed")
+ checkIdentical(oldRNG, getRNG(), "RNG still valid after error")
+ checkException(setRNG(123L), "Error with invalid RNG kind")
+ checkIdentical(oldRNG, getRNG(), "RNG still valid after error")
+
+ # changes in R >= 3.0.2: invalid seeds only throw warning
+ if( testRversion('> 3.0.1') ){
+ oldRNG <- getRNG()
+ checkWarning(setRNG(1234L, check = FALSE), "\\.Random\\.seed.* is not .* valid"
+ , "Invalid integer kind: Warning only if check = FALSE")
+ checkIdentical(1234L, getRNG(), "RNG has new invalid integer value")
+ setRNG(oldRNG)
+ checkWarning(setRNG(123L, check = FALSE), "\\.Random\\.seed.* is not .* valid"
+ , "Invalid kind: Warning only if check = FALSE")
+ checkIdentical(123L, getRNG(), "RNG has new invalid RNG kind")
+
+ }
+
+}
+
diff --git a/inst/tests/runit.RNGseq.r b/inst/tests/runit.RNGseq.r
new file mode 100644
index 0000000..674012e
--- /dev/null
+++ b/inst/tests/runit.RNGseq.r
@@ -0,0 +1,162 @@
+# Unit tets for RNGseq
+#
+# Author: Renaud Gaujoux
+###############################################################################
+
+library(parallel)
+
+test.RNGseq_seed <- function(){
+
+ # actual testing function
+ .test_loc <- function(.msg, ..., .change=FALSE){
+ msg <- function(...) paste(.msg, ':', ...)
+ os <- RNGseed()
+ on.exit(RNGseed(os))
+ s <- RNGseq_seed(...)
+ checkTrue(length(s) == 7L && s[1] %% 100 == 7L, msg("RNGseq_seed returns a value of .Random.seed for L'Ecuyer-CMRG"))
+ checkIdentical(RNGseed()[1], os[1], msg("RNGseq_seed does not change the type of RNG"))
+
+ if( !.change ) checkIdentical(RNGseed(), os, msg("RNGseq_seed does not change the value of .Random.seed"))
+ else checkTrue( !identical(RNGseed(), os), msg("RNGseq_seed changes the value of .Random.seed"))
+ s
+ }
+
+ # test in two RNG settings: default and L'Ecuyer
+ .test <- function(.msg, ..., ss=NULL, .change=FALSE, Dchange=.change, Lchange=.change){
+ os <- RNGseed()
+ on.exit(RNGseed(os))
+
+ # default RNG
+ RNGkind('default')
+ if( !is.null(ss) ) set.seed(ss)
+ s1 <- .test_loc(paste(.msg, '- default'), ..., .change=Dchange)
+
+ RNGkind("L'Ecuyer")
+ if( !is.null(ss) ) set.seed(ss)
+ s2 <- .test_loc(paste(.msg, "- CMRG"), ..., .change=Lchange)
+
+ list(s1, s2)
+ }
+
+ os <- RNGseed()
+ on.exit(RNGseed(os))
+
+ RNGkind('default', 'default')
+
+ # test different arguments
+ s1 <- .test("seed=missing", ss=1, Dchange=TRUE, Lchange=FALSE)
+ runif(10)
+ s2 <- .test("seed=NULL", NULL, ss=1, Dchange=TRUE, Lchange=FALSE)
+ checkIdentical(s1, s2, "set.seed(1) + seed=missing and seed=NULL return identical results")
+
+ # doRNG seed with single numeric
+ runif(10)
+ s3 <- .test("seed=single numeric", 1)
+ checkIdentical(s1[[1]], s3[[1]], "v1.4 - set.seed(1) + seed=missing and seed=1 return identical results when current RNG is NOT CMRG")
+ checkIdentical(s1[[2]], s3[[2]], "v1.4 - set.seed(1) + seed=missing and seed=1 return identical results when current RNG is CMRG")
+ checkTrue( !identical(s1[[1]], s1[[2]]), "v1.4 - set.seed(1) + seed=missing return NON identical results in different RNG settings")
+ checkTrue( !identical(s3[[1]], s3[[2]]), "v1.4 - seed=num return NON identical results in different RNG settings")
+
+ # version < 1.4
+# doRNGversion("1.3.9999")
+ s1 <- .test("v1.3 - seed=missing", ss=1, Dchange=TRUE, Lchange=TRUE, version=1)
+ s3 <- .test("v1.3 - seed=single numeric", 1, version=1)
+ checkIdentical(s1[[1]], s3[[1]], "v1.3 - set.seed(1) + seed=missing and seed=1 return identical results when current RNG is NOT CMRG")
+ checkTrue( !identical(s1[[2]], s3[[2]]), "v1.3 - set.seed(1) + seed=missing and seed=1 return NON identical results when current RNG is CMRG")
+ checkTrue( !identical(s1[[1]], s1[[2]]), "v1.3 - set.seed(1) + seed=missing return NON identical results in different RNG settings")
+ checkTrue( !identical(s3[[1]], s3[[2]]), "v1.4 - seed=num return NON identical results in different RNG settings")
+# doRNGversion(NULL)
+ ##
+
+ .test("seed=single integer", 10L)
+ # directly set doRNG seed with a 6-length
+ .test("seed=6-length integer", 1:6)
+ .test("seed=6-length numeric", as.numeric(1:6))
+ s <- 1:6
+ checkIdentical(RNGseq_seed(s)[2:7], s, "RNGseq_seed(6-length) returns stream to the given value")
+ # directly set doRNG seed with a full 7-length .Random.seed
+ .test("seed=7-length integer", c(407L,1:6))
+ .test("seed=7-length numeric", as.numeric(c(107L,1:6)))
+ s <- c(407L,1:6)
+ checkIdentical(RNGseq_seed(s), s, "RNGseq_seed(7-length) returns complete seed with the given value")
+
+ # errors
+ os <- RNGseed()
+ checkException(RNGseq_seed(NA), "seed=NA throws an exception")
+ checkIdentical(os, RNGseed(), "RNGseq_seed(NA) does not change the value of .Random.seed [error]")
+
+ # Current CMRG is L'Ecuyer
+ RNGkind("L'Ecuyer")
+ set.seed(456)
+ s <- RNGseed()
+ r <- RNGseq_seed(NULL)
+ checkIdentical(s, r, "Current is CMRG: seed=NULL return current stream")
+ runif(10)
+ checkIdentical(s, RNGseq_seed(456), "Current is CMRG: seed=numeric return stream seeded with value")
+
+}
+
+test.RNGseq <- function(){
+
+ os <- RNGseed()
+ on.exit(RNGseed(os))
+
+ # actual testing function
+ .test_loc <- function(.msg, n, ..., .list=TRUE, .change=FALSE){
+ msg <- function(...) paste(.msg, ':', ...)
+ os <- RNGseed()
+ on.exit(RNGseed(os))
+
+ s <- RNGseq(n, ...)
+
+ if( !.change ) checkIdentical(RNGseed(), os, msg("the value of .Random.seed is not changed"))
+ else checkTrue( !identical(RNGseed(), os), msg("the value of .Random.seed does change"))
+
+ if( .list ) checkTrue(is.list(s), msg("result is a list"))
+ else{
+ checkTrue(is.integer(s), msg("result is an integer vector"))
+ s <- list(s)
+ }
+
+ checkTrue(length(s) == n, msg("result has correct length"))
+ checkTrue(all(sapply(s, length) == 7L), msg("each element has length 7"))
+ checkTrue(all(sapply(s, function(x) x[1] %% 100) == 7L), msg("each element has correct RNG kind"))
+ s
+ }
+
+ .test <- function(msg, n, ...){
+ set.seed(1)
+ s1 <- .test_loc(paste(msg, '- no seed'), n, ..., .change=TRUE)
+ runif(1)
+ s2 <- .test_loc(paste(msg, '- seed=1'), n, 1, ..., .change=FALSE)
+ #checkIdentical(s1, s2, paste(msg, " - set.seed(1) + no seed is identical to seed=1"))
+ .test_loc(paste(msg, '- seed=1:6'), n, 1:6, ...)
+ }
+ .test("n=1", 1, .list=FALSE)
+ .test("n=2", 2)
+ .test("n=5", 5)
+
+ # with full list
+ s <- RNGseq(3)
+ checkIdentical(RNGseq(length(s), s), s, "If passing a complete list: returns the list itself")
+ s3 <- RNGseq(5)
+ s <- structure(s, rng=s3)
+ checkIdentical(RNGseq(length(s3), s), s3, "If passing a complete list in rng S3 slot: returns the complete slot")
+ #
+
+ # Current RNG is CMRG
+ set.seed(456, "L'Ec")
+ s <- .Random.seed
+ ref <- list(s, nextRNGStream(s), nextRNGStream(nextRNGStream(s)))
+ rs <- RNGseq(3, 456)
+ checkIdentical(rs, ref, "Current RNG is CMRG: RNGseq(n, num) returns RNG streams that start with stream as set.seed")
+ checkIdentical(s, .Random.seed, "Current RNG is CMRG: RNGseq(n, num) did not change random seed")
+
+ runif(10)
+ s <- .Random.seed
+ ref <- list(s, nextRNGStream(s), nextRNGStream(nextRNGStream(s)))
+ rs2 <- RNGseq(3)
+ checkIdentical(rs2, ref, "Current RNG is CMRG: RNGseq(n) returns RNG streams that start with current stream")
+ checkIdentical(.Random.seed, nextRNGStream(tail(rs2,1)[[1]]), "Current RNG is CMRG: RNGseq(n) changes current random seed to next stream of last stream in sequence")
+
+}
diff --git a/inst/tests/runit.format.r b/inst/tests/runit.format.r
new file mode 100644
index 0000000..7e94f91
--- /dev/null
+++ b/inst/tests/runit.format.r
@@ -0,0 +1,103 @@
+# Unit tests for RNG formatting functions
+#
+# Author: Renaud Gaujoux
+###############################################################################
+
+library(stringr)
+library(pkgmaker)
+
+checkFun <- function(fn, name){
+
+ function(x, ...){
+
+ oldRNG <- RNGseed()
+ if( !missing(x) ){
+ d <- fn(x)
+ obj <- getRNG(x)
+ cl <- class(x)
+ }else{
+ d <- fn()
+ obj <- getRNG()
+ cl <- 'MISSING'
+ }
+ newRNG <- RNGseed()
+ msg <- function(x, ...) paste(name, '-', cl, ':', x, '[', ..., ']')
+ checkIdentical(oldRNG, newRNG, msg("does not change RNG", ...))
+
+ #
+ checkTrue( isString(d), msg("result is a character string", ...))
+ checkIdentical(d, fn(obj), msg("digest is from the RNG setting", ...))
+
+ }
+}
+
+test.RNGdigest <- function(){
+
+ RNGkind('default', 'default')
+ on.exit( RNGrecovery() )
+
+ fn <- c('RNGdigest', 'RNGstr')
+ sapply(fn, function(f){
+ fn <- getFunction(f, where='package:rngtools')
+ checker <- checkFun(fn, f)
+
+ checker()
+ checker(1234)
+ checker(1:3, 'Valid seed')
+ checker(2:3, 'Invalid seed')
+ x <- list(10, rng=c(401L, 1L, 1L))
+ checker(x, 'list with rng slot')
+
+ })
+ TRUE
+}
+
+checkRNGtype <- function(x, ..., expL=2L){
+
+ fn <- RNGtype
+ oldRNG <- getRNG()
+ if( !missing(x) ){
+ d <- fn(x)
+ obj <- getRNG(x)
+ cl <- str_c(class(x), '(', length(x), ')')
+ }else{
+ d <- fn()
+ obj <- getRNG()
+ cl <- 'MISSING'
+ }
+ newRNG <- getRNG()
+ msg <- function(x, ...) paste(cl, ':', x, '[', ..., ']')
+ checkIdentical(oldRNG, newRNG, msg("does not change RNG", ...))
+
+ #
+ checkTrue( is.character(d), msg("result is a character vector", ...) )
+ checkIdentical( length(d), expL, msg("result has correct length (", expL, ")", ...) )
+
+}
+
+test.RNGtype <- function(){
+
+ RNGkind('default', 'default')
+ on.exit( RNGrecovery() )
+ checker <- checkRNGtype
+
+ checker()
+ checker(1234, 'Valid single numeric seed')
+ checker(1:3, 'Valid seed')
+ checker(402L, 'Valid encoded kind')
+ checkTrue( !identical(RNGtype(402), RNGtype(402L)), "Single integer and real number does not give the same result")
+ x <- list(10, rng=c(401L, 1L, 1L))
+ checker(x, 'list with rng slot')
+
+ # errors
+ oldRNG <- getRNG()
+ checkException(RNGtype(2:3), "Error with invalid length seed")
+ checkIdentical(oldRNG, getRNG(), "RNG still valid after error")
+ #
+
+ oldRNG <- getRNG()
+ checkException(RNGtype(123L), "Error with invalid RNG kind")
+ checkIdentical(oldRNG, getRNG(), "RNG still valid after error")
+ checkException(RNGtype(1234L), "Error with invalid RNG integer")
+ checkIdentical(oldRNG, getRNG(), "RNG still valid after error")
+}
diff --git a/man/RNGseed.Rd b/man/RNGseed.Rd
new file mode 100644
index 0000000..cef8b03
--- /dev/null
+++ b/man/RNGseed.Rd
@@ -0,0 +1,60 @@
+\name{RNGseed}
+\alias{RNGrecovery}
+\alias{RNGseed}
+\title{Directly Getting or Setting the RNG Seed}
+\usage{
+ RNGseed(seed)
+
+ RNGrecovery()
+}
+\arguments{
+ \item{seed}{an RNG seed, i.e. an integer vector. No
+ validity check is performed, so it \strong{must} be a
+ valid seed.}
+}
+\value{
+ invisibly the current RNG seed when called with no
+ arguments, or the -- old -- value of the seed before
+ changing it to \code{seed}.
+}
+\description{
+ \code{RNGseed} directly gets/sets the current RNG seed
+ \code{.Random.seed}. It can typically be used to backup
+ and restore the RNG state on exit of functions, enabling
+ local RNG changes.
+
+ \code{RNGrecovery} recovers from a broken state of
+ \code{.Random.seed}, and reset the RNG settings to
+ defaults.
+}
+\examples{
+# get current seed
+RNGseed()
+# directly set seed
+old <- RNGseed(c(401L, 1L, 1L))
+# show old/new seed description
+showRNG(old)
+showRNG()
+
+# set bad seed
+RNGseed(2:3)
+try( showRNG() )
+# recover from bad state
+RNGrecovery()
+showRNG()
+
+# example of backup/restore of RNG in functions
+f <- function(){
+ orng <- RNGseed()
+ on.exit(RNGseed(orng))
+ RNGkind('Marsaglia')
+ runif(10)
+}
+
+sample(NA)
+s <- .Random.seed
+f()
+identical(s, .Random.seed)
+\dontshow{ stopifnot(identical(s, .Random.seed)) }
+}
+
diff --git a/man/RNGseq.Rd b/man/RNGseq.Rd
new file mode 100644
index 0000000..c9f6e62
--- /dev/null
+++ b/man/RNGseq.Rd
@@ -0,0 +1,95 @@
+\name{RNGseq}
+\alias{RNGseq}
+\alias{RNGseq_seed}
+\title{Generate Sequence of Random Streams}
+\usage{
+ RNGseq(n, seed = NULL, ..., simplify = TRUE, version = 2)
+
+ RNGseq_seed(seed = NULL, normal.kind = NULL,
+ verbose = FALSE, version = 2)
+}
+\arguments{
+ \item{n}{Number of streams to be created}
+
+ \item{seed}{seed specification used to initialise the set
+ of streams using \code{\link{RNGseq_seed}}.}
+
+ \item{simplify}{a logical that specifies if sequences of
+ length 1 should be unlisted and returned as a single
+ vector.}
+
+ \item{...}{extra arguments passed to
+ \code{\link{RNGseq_seed}}.}
+
+ \item{normal.kind}{Type of Normal random generator. See
+ \code{\link{RNG}}.}
+
+ \item{verbose}{logical to toggle verbose messages}
+
+ \item{version}{version of the function to use, to
+ reproduce old behaviours. Version 1 had a bug which made
+ the generated stream sequences share most of their seeds
+ (!), as well as being not equivalent to calling
+ \code{set.seed(seed); RNGseq_seed(NULL)}. Version 2 fixes
+ this bug.}
+}
+\value{
+ a list of integer vectors (or a single integer vector if
+ \code{n=1} and \code{unlist=TRUE}).
+
+ a 7-length numeric vector.
+}
+\description{
+ Create a given number of seeds for L'Ecuyer's RNG, that
+ can be used to seed parallel computation, making them
+ fully reproducible.
+
+ \code{RNGseq_seed} generates the -- next -- random seed
+ used as the first seed in the sequence generated by
+ \code{\link{RNGseq}}.
+}
+\details{
+ This ensures complete reproducibility of the set of run.
+ The streams are created using L'Ecuyer's RNG, implemented
+ in R core since version 2.14.0 under the name
+ \code{"L'Ecuyer-CMRG"} (see \code{\link{RNG}}).
+
+ Generating a sequence without specifying a seed uses a
+ single draw of the current RNG. The generation of a
+ sequence using seed (a single or 6-length numeric) a
+ should not affect the current RNG state.
+}
+\examples{
+RNGseq(3)
+RNGseq(3)
+RNGseq(3, seed=123)
+# or identically
+set.seed(123)
+identical(RNGseq(3), RNGseq(3, seed=123))
+\dontshow{
+set.seed(123)
+stopifnot( identical(RNGseq(3), RNGseq(3, seed=123)) )
+}
+
+RNGseq(3, seed=1:6, verbose=TRUE)
+# select Normal kind
+RNGseq(3, seed=123, normal.kind="Ahrens")
+## generate a seed for RNGseq
+# random
+RNGseq_seed()
+RNGseq_seed()
+RNGseq_seed(NULL)
+# fixed
+RNGseq_seed(1)
+RNGseq_seed(1:6)
+
+# `RNGseq_seed(1)` is identical to
+set.seed(1)
+s <- RNGseq_seed()
+identical(s, RNGseq_seed(1))
+\dontshow{ stopifnot(identical(s, RNGseq_seed(1))) }
+}
+\seealso{
+ \code{\link{RNGseq}}
+}
+
diff --git a/man/RNGstr.Rd b/man/RNGstr.Rd
new file mode 100644
index 0000000..cdc975a
--- /dev/null
+++ b/man/RNGstr.Rd
@@ -0,0 +1,121 @@
+\name{RNGstr}
+\alias{RNGdigest}
+\alias{RNGinfo}
+\alias{RNGstr}
+\alias{RNGtype}
+\alias{showRNG}
+\title{Formatting RNG Information}
+\usage{
+ RNGstr(object, n = 7L, ...)
+
+ RNGtype(object, ..., provider = FALSE)
+
+ showRNG(object = getRNG(), indent = "#", ...)
+
+ RNGinfo(object = getRNG(), ...)
+
+ RNGdigest(object = getRNG())
+}
+\arguments{
+ \item{object}{RNG seed (i.e. an integer vector), or an
+ object that contains embedded RNG data. For
+ \code{RNGtype} this must be either a valid RNG seed or a
+ single integer that must be a valid encoded RNG kind (see
+ \code{\link{RNGkind}}).}
+
+ \item{n}{maximum length for a seed to be showed in full.
+ If the seed has length greater than \code{n}, then only
+ the first three elements are shown and a digest hash of
+ the complete seed is appended to the string.}
+
+ \item{provider}{logical that indicates if the library
+ that provides the RNG should also be returned as a third
+ element.}
+
+ \item{indent}{character string to use as indentation
+ prefix in the output from \code{showRNG}.}
+
+ \item{...}{extra arguments passed to \code{RNGtype}.}
+}
+\value{
+ a single character string
+
+ \code{RNGtype} returns a 2 or 3-long character vector.
+}
+\description{
+ These functions retrieve/prints formated information
+ about RNGs.
+
+ \code{RNGtype} returns the same type of values as
+ \code{RNGkind()} (character strings), except that it can
+ extract the RNG settings from an object. If \code{object}
+ is missing it returns the kinds of the current RNG
+ settings, i.e. it is identical to \code{RNGkind()}.
+
+ \code{showRNG} displays human readable information about
+ RNG settings. If \code{object} is missing it displays
+ information about the current RNG.
+
+ \code{RNGinfo} is equivalent to \code{RNGtype} but
+ returns a named list instead of an unnamed character
+ vector.
+
+ \code{RNGdigest} computes a hash from the RNG settings
+ associated with an object.
+}
+\details{
+ All functions can retrieve can be called with objects
+ that are -- valid -- RNG seeds or contain embedded RNG
+ data, but none of them change the current RNG setting. To
+ effectively change the current settings on should use
+ \code{\link{setRNG}}.
+
+ \code{RNGstr} returns a description of an RNG seed as a
+ single character string.
+
+ \code{RNGstr} formats seeds by collapsing them in a comma
+ separated string. By default, seeds that contain more
+ than 7L integers, have their 3 first values collapsed
+ plus a digest hash of the complete seed.
+}
+\examples{
+# default is a 626-long integer
+RNGstr()
+# what would be the seed after seeding with set.seed(1234)
+RNGstr(1234)
+# another RNG (short seed)
+RNGstr(c(401L, 1L, 1L))
+# no validity check is performed
+RNGstr(2:3)
+# get RNG type
+RNGtype()
+RNGtype(provider=TRUE)
+RNGtype(1:3)
+
+# type from encoded RNG kind
+RNGtype(107L)
+# this is different from the following which treats 107 as a seed for set.seed
+RNGtype(107)
+showRNG()
+# as after set.seed(1234)
+showRNG(1234)
+showRNG()
+set.seed(1234)
+showRNG()
+# direct seeding
+showRNG(1:3)
+# this does not change the current RNG
+showRNG()
+showRNG(provider=TRUE)
+# get info as a list
+RNGinfo()
+RNGinfo(provider=TRUE)
+# from encoded RNG kind
+RNGinfo(107)
+# compute digest hash from RNG settings
+RNGdigest()
+RNGdigest(1234)
+# no validity check is performed
+RNGdigest(2:3)
+}
+
diff --git a/man/rng.Rd b/man/rng.Rd
new file mode 100644
index 0000000..4d5d7e6
--- /dev/null
+++ b/man/rng.Rd
@@ -0,0 +1,238 @@
+\docType{methods}
+\name{getRNG}
+\alias{getRNG}
+\alias{.getRNG}
+\alias{getRNG1}
+\alias{getRNG1,ANY-method}
+\alias{getRNG1-methods}
+\alias{.getRNG,ANY-method}
+\alias{.getRNG,list-method}
+\alias{.getRNG-methods}
+\alias{.getRNG,missing-method}
+\alias{.getRNG,numeric-method}
+\alias{hasRNG}
+\alias{nextRNG}
+\alias{setRNG}
+\alias{.setRNG}
+\alias{.setRNG,character-method}
+\alias{.setRNG-methods}
+\alias{.setRNG,numeric-method}
+\title{Getting/Setting RNGs}
+\usage{
+ getRNG(object, ..., num.ok = FALSE, extract = TRUE,
+ recursive = TRUE)
+
+ hasRNG(object)
+
+ .getRNG(object, ...)
+
+ getRNG1(object, ...)
+
+ nextRNG(object, ..., ndraw = 0L)
+
+ setRNG(object, ..., verbose = FALSE, check = TRUE)
+
+ .setRNG(object, ...)
+}
+\arguments{
+ \item{object}{an R object from which RNG settings can be
+ extracted, e.g. an integer vector containing a suitable
+ value for \code{.Random.seed} or embedded RNG data, e.g.,
+ in S3/S4 slot \code{rng} or \code{rng$noise}.}
+
+ \item{...}{extra arguments to allow extension and passed
+ to a suitable S4 method \code{.getRNG} or
+ \code{.setRNG}.}
+
+ \item{num.ok}{logical that indicates if single numeric
+ (not integer) RNG data should be considered as a valid
+ RNG seed (\code{TRUE}) or passed to
+ \code{\link{set.seed}} into a proper RNG seed
+ (\code{FALSE}) (See details and examples).}
+
+ \item{extract}{logical that indicates if embedded RNG
+ data should be looked for and extracted (\code{TRUE}) or
+ if the object itself should be considered as an RNG
+ specification.}
+
+ \item{recursive}{logical that indicates if embedded RNG
+ data should be extracted recursively (\code{TRUE}) or
+ only once (\code{FASE}).}
+
+ \item{ndraw}{number of draws to perform before returning
+ the RNG seed.}
+
+ \item{check}{logical that indicates if only valid RNG
+ kinds should be accepted, or if invalid values should
+ just throw a warning. Note that this argument is used
+ only on R >= 3.0.2.}
+
+ \item{verbose}{a logical that indicates if the new RNG
+ settings should be displayed.}
+}
+\value{
+ \code{getRNG}, \code{getRNG1}, \code{nextRNG} and
+ \code{setRNG} usually return an integer vector of length
+ > 2L, like \code{\link{.Random.seed}}.
+
+ \code{getRNG} and \code{getRNG1} return \code{NULL} if no
+ RNG data was found.
+
+ \code{setRNG} invisibly returns the old RNG settings as
+ they were before changing them.
+}
+\description{
+ \code{getRNG} returns the Random Number Generator (RNG)
+ settings used for computing an object, using a suitable
+ \code{.getRNG} S4 method to extract these settings. For
+ example, in the case of objects that result from multiple
+ model fits, it would return the RNG settings used to
+ compute the best fit.
+
+ \code{hasRNG} tells if an object has embedded RNG data.
+
+ \code{.getRNG} is an S4 generic that extract RNG settings
+ from a variety of object types. Its methods define the
+ workhorse functions that are called by \code{getRNG}.
+
+ \code{getRNG1} is defined to provide separate access to
+ the RNG settings as they were at the very beginning of a
+ whole computation, which might differ from the RNG
+ settings returned by \code{getRNG}, that allows to
+ reproduce the result only.
+
+ \code{nextRNG} returns the RNG settings as they would be
+ after seeding with \code{object}.
+
+ \code{setRNG} set the current RNG with a seed, using a
+ suitable \code{.setRNG} method to set these settings.
+
+ \code{.setRNG} is an S4 generic that sets the current RNG
+ settings, from a variety of specifications. Its methods
+ define the workhorse functions that are called by
+ \code{setRNG}.
+}
+\details{
+ This function handles single number RNG specifications in
+ the following way: \describe{ \item{integers}{Return them
+ unchanged, considering them as encoded RNG kind
+ specification (see \code{\link{RNG}}). No validity check
+ is performed.} \item{real numbers}{If \code{num.ok=TRUE}
+ return them unchanged. Otherwise, consider them as
+ (pre-)seeds and pass them to \code{\link{set.seed}} to
+ get a proper RNG seed. Hence calling \code{getRNG(1234)}
+ is equivalent to \code{set.seed(1234); getRNG()} (See
+ examples). } }
+
+ Think of a sequence of separate computations, from which
+ only one result is used for the result (e.g. the one that
+ maximises a likelihood): \code{getRNG1} would return the
+ RNG settings to reproduce the complete sequence of
+ computations, while \code{getRNG} would return the RNG
+ settings necessary to reproduce only the computation
+ whose result has maximum likelihood.
+}
+\section{Methods}{
+ \describe{
+
+ \item{.getRNG}{\code{signature(object = "ANY")}: Default
+ method that tries to extract RNG information from
+ \code{object}, by looking sequentially to a slot named
+ \code{'rng'}, a slot named \code{'rng.seed'} or an
+ attribute names \code{'rng'}.
+
+ It returns \code{NULL} if no RNG data was found. }
+
+ \item{.getRNG}{\code{signature(object = "missing")}:
+ Returns the current RNG settings. }
+
+ \item{.getRNG}{\code{signature(object = "list")}: Method
+ for S3 objects, that aims at reproducing the behaviour of
+ the function \code{getRNG} of the package \code{getRNG}.
+
+ It sequentially looks for RNG data in elements
+ \code{'rng'}, \code{noise$rng} if element \code{'noise'}
+ exists and is a \code{list}, or in attribute
+ \code{'rng'}. }
+
+ \item{.getRNG}{\code{signature(object = "numeric")}:
+ Method for numeric vectors, which returns the object
+ itself, coerced into an integer vector if necessary, as
+ it is assumed to already represent a value for
+ \code{\link{.Random.seed}}. }
+
+ \item{getRNG1}{\code{signature(object = "ANY")}: Default
+ method that is identical to \code{getRNG(object, ...)}. }
+
+ \item{.setRNG}{\code{signature(object = "character")}:
+ Sets the RNG to kind \code{object}, assuming is a valid
+ RNG kind: it is equivalent to \code{RNGkind(object, ...}.
+ All arguments in \code{...} are passed to
+ \code{\link{RNGkind}}. }
+
+ \item{.setRNG}{\code{signature(object = "numeric")}: Sets
+ the RNG settings using \code{object} directly the new
+ value for \code{.Random.seed} or to initialise it with
+ \code{\link{set.seed}}. }
+
+ }
+}
+\examples{
+# get current RNG settings
+s <- getRNG()
+head(s)
+showRNG(s)
+
+# get RNG from a given single numeric seed
+s1234 <- getRNG(1234)
+head(s1234)
+showRNG(s1234)
+# this is identical to the RNG seed as after set.seed()
+set.seed(1234)
+identical(s1234, .Random.seed)
+# but if num.ok=TRUE the object is returned unchanged
+getRNG(1234, num.ok=TRUE)
+
+# single integer RNG data = encoded kind
+head(getRNG(1L))
+
+# embedded RNG data
+s <- getRNG(list(1L, rng=1234))
+identical(s, s1234)
+# test for embedded RNG data
+hasRNG(1)
+hasRNG( structure(1, rng=1:3) )
+hasRNG( list(1, 2, 3) )
+hasRNG( list(1, 2, 3, rng=1:3) )
+hasRNG( list(1, 2, 3, noise=list(1:3, rng=1)) )
+head(nextRNG())
+head(nextRNG(1234))
+head(nextRNG(1234, ndraw=10))
+obj <- list(x=1000, rng=123)
+setRNG(obj)
+rng <- getRNG()
+runif(10)
+set.seed(123)
+rng.equal(rng)
+# set RNG kind
+old <- setRNG('Marsaglia')
+# restore
+setRNG(old)
+# directly set .Random.seed
+rng <- getRNG()
+r <- runif(10)
+setRNG(rng)
+rng.equal(rng)
+
+# initialise from a single number (<=> set.seed)
+setRNG(123)
+rng <- getRNG()
+runif(10)
+set.seed(123)
+rng.equal(rng)
+}
+\seealso{
+ \code{\link{.Random.seed}}, \code{\link{showRNG}}
+}
+\keyword{methods}
+
diff --git a/man/rngcmp.Rd b/man/rngcmp.Rd
new file mode 100644
index 0000000..073c618
--- /dev/null
+++ b/man/rngcmp.Rd
@@ -0,0 +1,31 @@
+\name{rng.equal}
+\alias{rng1.equal}
+\alias{rng.equal}
+\title{Comparing RNG Settings}
+\usage{
+ rng.equal(x, y)
+
+ rng1.equal(x, y)
+}
+\arguments{
+ \item{x}{objects from which RNG settings are extracted}
+
+ \item{y}{object from which RNG settings are extracted}
+}
+\value{
+ \code{rng.equal} and \code{rng.equal1} return a
+ \code{TRUE} or \code{FALSE}.
+}
+\description{
+ \code{rng.equal} compares the RNG settings associated
+ with two objects.
+
+ \code{rng1.equal} tests whether two objects have
+ identical \strong{initial} RNG settings.
+}
+\details{
+ These functions return \code{TRUE} if the RNG settings
+ are identical, and \code{FALSE} otherwise. The comparison
+ is made between the hashes returned by \code{RNGdigest}.
+}
+
diff --git a/man/rngtools.Rd b/man/rngtools.Rd
new file mode 100644
index 0000000..804da22
--- /dev/null
+++ b/man/rngtools.Rd
@@ -0,0 +1,53 @@
+\docType{package}
+\name{rngtools}
+\alias{rngtools}
+\alias{rngtools-package}
+\title{Utility functions for working with Random Number Generators}
+\description{
+ This package contains a set of functions for working with
+ Random Number Generators (RNGs). In particular, it
+ defines a generic S4 framework for getting/setting the
+ current RNG, or RNG data that are embedded into objects
+ for reproducibility.
+}
+\details{
+ Notably, convenient default methods greatly facilitate
+ the way current RNG settings can be changed.
+}
+\examples{
+showRNG()
+s <- getRNG()
+RNGstr(s)
+RNGtype(s)
+
+# get what would be the RNG seed after set.seed
+s <- nextRNG(1234)
+showRNG(s)
+showRNG( nextRNG(1234, ndraw=10) )
+
+# change of RNG kind
+showRNG()
+k <- RNGkind()
+k[2L] <- 'Ahrens'
+try( RNGkind(k) )
+setRNG(k)
+showRNG()
+# set encoded kind
+setRNG(501L)
+showRNG()
+
+# use as set seed
+setRNG(1234)
+showRNG()
+r <- getRNG()
+
+# extract embedded RNG specifications
+runif(10)
+setRNG(list(1, rng=1234))
+rng.equal(r)
+
+# restore default RNG (e.g., after errors)
+RNGrecovery()
+showRNG()
+}
+
diff --git a/man/uchecks.Rd b/man/uchecks.Rd
new file mode 100644
index 0000000..0a9dd81
--- /dev/null
+++ b/man/uchecks.Rd
@@ -0,0 +1,26 @@
+\name{checkRNG}
+\alias{checkRNG}
+\title{Checking RNG Differences in Unit Tests}
+\usage{
+ checkRNG(x, y = getRNG(), ...)
+}
+\arguments{
+ \item{x,y}{objects from which RNG settings are
+ extracted.}
+
+ \item{...}{extra arguments passed to
+ \code{\link{rng.equal}}.}
+}
+\description{
+ \code{checkRNG} checks if two objects have the same RNG
+ settings and should be used in unit tests, e.g., with the
+ \pkg{RUnit} package.
+}
+\examples{
+# check for differences in RNG
+set.seed(123)
+checkRNG(123)
+try( checkRNG(123, 123) )
+try( checkRNG(123, 1:3) )
+}
+
diff --git a/tests/doRUnit.R b/tests/doRUnit.R
new file mode 100644
index 0000000..6b7e198
--- /dev/null
+++ b/tests/doRUnit.R
@@ -0,0 +1,6 @@
+# Run all unit tests in installed directory unitTests
+#
+# Author: Renaud Gaujoux
+###############################################################################
+
+pkgmaker::utest('package:rngtools', quiet=FALSE)
diff --git a/vignettes/rngtools-unitTests.Rnw b/vignettes/rngtools-unitTests.Rnw
new file mode 100644
index 0000000..ff4e04d
--- /dev/null
+++ b/vignettes/rngtools-unitTests.Rnw
@@ -0,0 +1,80 @@
+
+\documentclass[10pt]{article}
+%\VignetteDepends{knitr}
+%\VignetteIndexEntry{rngtools-unitTests}
+%\VignetteCompiler{knitr}
+%\VignetteEngine{knitr::knitr}
+\usepackage{vmargin}
+\setmargrb{0.75in}{0.75in}{0.75in}{0.75in}
+
+<<setup, include=FALSE>>=
+pkg <- 'rngtools'
+require( pkg, character.only=TRUE )
+prettyVersion <- packageDescription(pkg)$Version
+prettyDate <- format(Sys.Date(), '%B %e, %Y')
+authors <- packageDescription(pkg)$Author
+@
+
+\usepackage[colorlinks]{hyperref}
+\author{\Sexpr{authors}}
+\title{\texttt{\Sexpr{pkg}}: Unit testing results\footnote{Vignette computed on Thu Mar 6 11:45:50 2014}}
+\date{\texttt{\Sexpr{pkg}} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}}
+\begin{document}
+\maketitle
+
+\section{Details}
+\begin{verbatim}
+
+RUNIT TEST PROTOCOL -- Thu Mar 6 11:45:50 2014
+***********************************************
+Number of test functions: 6
+Number of errors: 0
+Number of failures: 0
+
+
+1 Test Suite :
+package:rngtools - 6 test functions, 0 errors, 0 failures
+
+
+
+Details
+***************************
+Test Suite: package:rngtools
+Test function regexp: ^test.
+Test file regexp: ^runit.*.[rR]$
+Involved directory:
+/tmp/Rpkglib_51e6234a85cc/rngtools/tests
+---------------------------
+Test file: /tmp/Rpkglib_51e6234a85cc/rngtools/tests/runit.format.r
+test.RNGdigest: (30 checks) ... OK (0.01 seconds)
+test.RNGtype: (22 checks) ... OK (0.01 seconds)
+---------------------------
+Test file: /tmp/Rpkglib_51e6234a85cc/rngtools/tests/runit.RNG.r
+test.getRNG: (18 checks) ... OK (0 seconds)
+test.setRNG: (34 checks) ... OK (0.01 seconds)
+---------------------------
+Test file: /tmp/Rpkglib_51e6234a85cc/rngtools/tests/runit.RNGseq.r
+test.RNGseq: (51 checks) ... OK (0.01 seconds)
+test.RNGseq_seed: (75 checks) ... OK (0 seconds)
+
+Total execution time
+***************************
+ user system elapsed
+ 0.234 0.001 0.234
+
+\end{verbatim}
+
+\section*{Session Information}
+\begin{itemize}\raggedright
+ \item R Under development (unstable) (2014-03-02 r65102), \verb|x86_64-unknown-linux-gnu|
+ \item Locale: \verb|LC_CTYPE=en_US.UTF-8|, \verb|LC_NUMERIC=C|, \verb|LC_TIME=en_US.UTF-8|, \verb|LC_COLLATE=en_US.UTF-8|, \verb|LC_MONETARY=en_US.UTF-8|, \verb|LC_MESSAGES=en_US.UTF-8|, \verb|LC_PAPER=en_US.UTF-8|, \verb|LC_NAME=C|, \verb|LC_ADDRESS=C|, \verb|LC_TELEPHONE=C|, \verb|LC_MEASUREMENT=en_US.UTF-8|, \verb|LC_IDENTIFICATION=C|
+ \item Base packages: base, datasets, graphics, grDevices, methods,
+ parallel, stats, utils
+ \item Other packages: pkgmaker~0.20, registry~0.2, rngtools~1.2.4,
+ RUnit~0.4.26, stringr~0.6.2
+ \item Loaded via a namespace (and not attached): codetools~0.2-8,
+ digest~0.6.4, tools~3.1.0, xtable~1.7-1
+\end{itemize}
+
+\end{document}
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-rngtools.git
More information about the debian-med-commit
mailing list