rngtools/0000755000175100001440000000000012306163023012133 5ustar hornikusersrngtools/inst/0000755000175100001440000000000012221274631013114 5ustar hornikusersrngtools/inst/tests/0000755000175100001440000000000012221274631014256 5ustar hornikusersrngtools/inst/tests/runit.format.r0000645000175100001440000000477112221274631017103 0ustar hornikusers# 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") } rngtools/inst/tests/runit.RNG.r0000645000175100001440000001135612221274631016236 0ustar hornikusers# 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") } } rngtools/inst/tests/runit.RNGseq.r0000645000175100001440000001427312221274631016750 0ustar hornikusers# 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") } rngtools/inst/doc/0000755000175100001440000000000012306071757013671 5ustar hornikusersrngtools/inst/doc/rngtools-unitTests.R0000644000175100001440000000041612306071757017664 0ustar hornikusers ## ----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 rngtools/inst/doc/rngtools-unitTests.Rnw0000644000175100001440000000524312306071757020234 0ustar hornikusers \documentclass[10pt]{article} %\VignetteDepends{knitr} %\VignetteIndexEntry{rngtools-unitTests} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \usepackage{vmargin} \setmargrb{0.75in}{0.75in}{0.75in}{0.75in} <>= 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} rngtools/inst/doc/rngtools-unitTests.pdf0000644000175100001440000030137512306071301020225 0ustar hornikusers%PDF-1.5 % 9 0 obj << /Length 907 /Filter /FlateDecode >> stream xVMs6W !|c>Iح8h֒k.Цڱ3D+T &t2JDfTD(]!,B2X%1J,u3=O1LP uiۖfrSn ԺiWaQ!Xqs$1+02`Ecr)O\Bov 0LGYo^d,$A!8(=41Lnj(f8rfا fun/+׌q1KBpl- 2&+:DDQɤ-D1ptʷqM: I_zIz/煡:D@J瑘 ⼞rrPϞ+qn>Fڧ!gmn%t]WuE0y0wԵvmi3c@, =:w=?0೿`?ց 6~@Է+RfWB_|:Fzcu ~o{%Y^U+t˲ֹcn]'Ad> stream xڵUo0~_ ծNR)_PS7D u]j{w|Y/.0Ċ,F-aSlE>FrIs> stream xڍT5 ҍtH7HwH, !!HIHw(%HJ( /g;sgyDw$/-1 92Hc?}i6WEv,N_d⎖pͲf[ݗ;p ;+nseL')ne,Qkg;Jvd:aȈ7% Ы|Nh3}FѺ_쫕LhE>~CRU>aUQ.1K)?bI7R/᢭ |FΚ%h}?Xϛnӻ`-5U3]B.I}M&XSp[RR(Ƴ2_oLݑ$=]N^zfe=K&TFZli?|'RtЛ:o@ N+ JOKU2:02 XL1Sx swVJVS ѩJ$4LCf6rn _Hòbt S##kB4\tѢϾn Z^C Ps3mznp>&dUvcHGp\d } '͞_ӖGðˊ$e<dgwq#xCa`$k?H$)e{<:lz" g*iUSf ZiՄ{M yAƞggvj(+/B@Y·,NvɶQ7EzE^w%pf oRD&-27Ou:[fK3Nʗ:Ÿ  h>׾R1K6d%*i+:WUif:yjC:hJ}?\^M] Z维2r|lM䪃-qcJRSFMEc?>oKrɄm^f jRKY /ɏ%_ӷ@wNfuOd<oO~v!Y%ek{%IWEm/6#d.Z*FΜ\9 =ӄFR)k< {uUYWpaz r M-us/j''dBF?|틁O FyH:R gvԫֈ$ИnMj֥+`amz9Q /-IE_Cgx\m{, -dsۙ.Eɟy;u?F[|;K5 -ɦB[Дk?ĠI{)NǙPRvɿeHcTj`P@l߈+ ~q0T|ci7 XqvMeEV3RGvl($`ݙdL\ɄμD@X:Rú PBcLsWax-9U6-[e֗e[iLttQ4S)kPh z)!U'mhw4Mr-%thP\|guEǾ2mKJ׮:tAyd'=ŵ 9l]=k-~.<,%Ʉc|Xn w`4hnUC:g"5_l kɗN'n h872?:Uk8sW3ڏ`=*vs5^Rm_#w'_'?eGOc=i<4eHC_+1 [S*K.HrmW n8Vw{#dHtM)!/lE/QZT;?uDK);>lj~v{Yqrm`k4߭ yU`줃Pj3V`V=$ߓyI]RpE+EosY/|&e笢s@s 6]:;ذ.4jƌ~'IAq?iQ8kP!䕮 GFE͌`i= z=*=`;joerI&,Y"})_dX=y{$AC{{`Ode6Ucu~^7;*O0كm݁5\mU xp܉ 3\]ffVT8xS>t+6 c.v *߂ƵsǨԱJs8GFT 8]S6A.*ߥF'&zRU%^e,:X%">ג hp,ưVJ%; ~LP R+<}Y(O'a(psSx*B98B KRMcZ[qó,NU+#^pi1 z|(L"~?:HNO 2u7e^ u5}_fm}/04&7+u3 H#M5x ӫ2ڎ2ӧ,,tuaBc AȐԣBE s^CVϊ}~~pbn Z\:sǑIsz[G?VFklhΓЉԫw0k_h ˼ܥãS:%q-{W{I' 檁h5/v##7!fd9pA)56 YTM6Nd*5]v%lQOqo8T+e$1_2Jj5 SsZ0gB@_K}ȏ ]g|uT냚+⍊2L2 ÀYPe(-{ŭi|VG'Ss]t=ԧ-I'ɉuž !方q8_8[5K.O4lAʌ ukD!:ZRD@*5%8xF}G#LX-r:qkg5߶U{Ddt/5K `frT^F=CӦוU?fZo;1AI96 l2 ' d|<}A` 4KۢʖQ1&:[;?u18R>sXoHg4'\L^7h33a互̗pdL]ꍯ]9(zw{["(*RdQѨb<=v*@z4"2̢h\m** 󾳏J>25Hw^񳹱3ǗuF+MEa?}qqʦj1[UyWbkZ[}~QB6#ū(LPr1{̽eMqN'N­mԱS6<| LՁɄ].ќgdQ "z`屙zkcR `ڷn֍oH"2tuxkq]Q{35%z2tSfd~S{"˫Z-F{>2s4yfQsq|! y_M*4G9໇xƾ(H:~g,t @: Iܤ$6Ĝ@ITKFPv{|DeLzJq,CzZa{J+:*1įٷX`@,أ4LEy3ooA':فFl{2(̡I|Q@MQiև쎽EA凵j<~2]̨nx1clku.ɏKN 4ml-_f%AHTݱdإ.`؈SOzMɎ f3p}虡 ߖQwx _CRǛNB򛢓źԳ/ӜSTUJӏyDQեuxqKv%dhk#5X}Yӭ8WP*Aˊ23l2  fi4hUœąH=HG@r{MG o$KǖiFnk)P3x=9_m&MzZ4-إfV"YI㏩]{a~Q8ML=MkVӕqP,VqqiMyXrdq{"|7UJi"bt %4Pӭh-)2 8o0BLûQsFh,y'LñCz?ox s\ bO8U~0[ifC+^~I$lݙo]|ڏGD+GeOYܝja&KYp 7ݽgwǓ>N*pk:3 FnԕZ_8-Y;ւO~N+` Ug]Puϼv=Xrˀvm J4<懗{X1oƖxjgӥ DT,Qsz=vLmǕ B$2/)S+OI]?1_'ur}cVa*[$5g+(+\+ƞ%Xʧ!¬,'oAZK8 |N6 WϷ*69UӮ*>2%,q4|5!眤~YK-Mqq=1!Oi#@H 쵝Jm"Œcj k `2\O/+rUmn g'rX6k7u=-ja^ ~V,Y0jxo>u".GrOi}"LuMҬj@TuDCF=T0\vϯ35XB{l.>="-ZhZ{d'9kfޑJ?2G}Q8K*UΤQ;|}g<4x%pdJ5S4&ऻHDU+SF]++o4;tOcI4٦ $ ^dT;W?HUp<>MDWeԌo\M>볏a^]=v|r>L&Rpq9HwB#Ƞ {V3P=UlJF̆1Q-5wWg5d>!&ozL*y}/$=-j/=R7F=,[^Q}&5* Oȡ7|'h̡C,&a^;\/^A2/ l !CSq״y@d,2_69@3_"+nmenRi2Zg$eO(QNHtp OjJBiv)5{ N筌?E8Vլ\S/aد\E|_r'{K {"aO6d.:7 dѐ@> §_lѲ27Y&D6<oWU1j%+Ԅ83fą7;lCnzt]K7Fhc6)6hd9r=ysvٕ)sqj}Һ'NAy]y3*^8+e endstream endobj 38 0 obj << /Length1 2039 /Length2 15477 /Length3 0 /Length 16724 /Filter /FlateDecode >> stream xڍp% ޱm۶v:FcFrp9*Uc1לkWȉTL L<Qyf&+ 9-o3_@cG=@ `aab01q' fneg8]E,,]?G)5t oj 8`jt *>KWWGFFc;g j:%@tv P0fi]0Z]>2̀΀rEG_r tgAdegPcptۛhlonleklg ae幘:[90X!.ۛ:]]Ohv/ƿno`neof37GFu{+'7!&l@W;'7+zZ2AC#Cpuv`fe 0ZXa?.1{?~Icm ~U%$hR_' @`c8?>/Z._4|4?: W'(8|2@13~b?XF$fkOQvsX yVYhffҮ!loa6ZHXy͔\M-=P@qap6]~)no`Ɒs>|?6 h\?Rp(Q_ (_qX* v7'i`1/b:~?t_ƿVB>J5wpsGſǙThտ@/'>b?1(Gǫmo 4G!V ǏrW?K8K(GkOZq3_(_ qh?#_,|^ tCUzMVLyCB;<&4ө}VܞSkSFĩ~ 5A')w<&t-Oc*:n$ŧW:}uo.CƅT1 8X6y@Cb>F^P"ǩ2XK>e?=rY2kT[WRx?[ I1j; \Ym"wiܳym^&FZFz4K-"O̻ELL:\yױ~W (K!! &Ӯp,Yō>SgFoQ*6C*1ʽwٗȊ٤%jF􂽬 .4; Ϣ'EB̎w*+E 0~:h<^U{DqGv(~+[5!=Wq'kCTڛ)y񠫐#,^,V܏S(%K SF,y8aHC6Hm^)@+Wp ⥽-~/QoQM?[g"]LgRrʬMbZŤ]l'VM|az=ڠd[b'Ӈ/)CxQ8V9K3pr, X9(iØDÀ-P7ĥ^)ԣPlM # 2@ 4LȸVPpBsÑiLO.,J-%F3"J,YxH'y\F־9(MM&df*q9ksj3/tg Lss]]-g)&xnJ--ԃ*/׶V?gY7柬 VMR 3s~w^؄oz[Nzllĺu/?Mq*oes}8`ιN#$8jڲ '#ԽtX>:"9]p^kTQY4j8l>U'am`'FpapdǗ(X-Mjeqҹ9W `{o%~ )ACy>Y%8P(iJ=6uweZM!X;5Jԣ+鰓,LAO5hrUnqJXœˉXlfY˰Psb^|G@3#;;,[WAi1$| (,ffDT3a/MBY(=E9\]mC 60e>kSӢϾ"*1\tҪbDn@Ess5vQݺ 9J:$͓Q)@~Vl.r%q|B ajU9C v ­l[x*e-H{ DhtP.eD5,}C+0Y_yxCŹ4M7.}wʼz{c"!E|lko^_L嗦%u^7t۽H@V($ Jn!2e@FZn H6ϢyLD$mtBFUȫr=lHrJMźu̱̰P(*ZB,g\- 3]̗a߃hN@eOJO&%@ n߾\Ɇ, I}lhQD^v%/O-~ɳTSr~͸Z5sWF{Cp|LxT! fY歵+L>s#B}5"|жATK_dhv.)}?nouivߏrD7IZ!%2a vvIxȄemfᢔnFF?wW;9I!of@7Z!o2ϿX;aNn;/ks,c[xC)U^ZRՌ`<̾wQP`)E*;dg -(["_oOuָZ˫sz=ǔ 25dJm1r܏u+5tdhD<\ezHKS容U{9>p~zbX2ZQfd"[4qxM@®L{>bC:) t`WPUWkjl 㪦@zQ:h6SA9-MkXڂSJl4S=I.Mt4>6Z|*զU4;e*^X 6gf'ߋՃv? JJfB?40<#2~ێ߽fg0|s=4$#x*4Z6me*:ؗvv.c5Fr 隹^3cBOއV7rơX~֣uG#BυQ~H ؇Ħ3 {FF q9P >_ R .6Tu0{IX|U)S01] q Y)U80ޏwkț׏ZQ5 D 6lq&ŢV&1Qta;$thJW?t_8)pF}|X{Y0'O*|,C]Jm~%g̀O>Ӣh"3LȬr"jC^Z!P̮|<;U!ýAWM%t F.mH0d1@LCRnJhۀܩb RawX'{ jFf55Ѿ|gRȻp\CLf7] oT9jڰ19+Xzab/d\dZ^ |8.8r~¨险yq%i J،ςKTm]S^]4#߮=WXQeSCҿ8hqsc\sj #K^suw1_g ,4^a3iQ<#ƈ ?8zk(ޘ kT,.D,=҆fRDp$eV%g/V-}|’~ưHn.*5 9r!񳺀!!GP'"n u{1?U[~%ýs̠f5@rniԽCѫ"Gُj\!⣥ca#Yu^rŰFCUV&"6qvk:J[t&EρV$jXGY? GC6'P[/95Q*ڌf;*]GN%%ϭaߥﺑ\Iq Z6{[^DN_K&; ǒnV_jIB)o=T5,2Ll['͙UEJt\5 ORӧp(8)K^>(e\Hrsݗ1XfAM:ZoH~G?:zF =YWbzKKjeWof֗I6vg_O^vRᠬt κivQ#pq&>O3"G8` HݝVŲO PjO;h ~;1_au-BĹw*syl'178a:TE^j8*H:\Adk3lvjh[rOBo Y@uǺw)^Z,f`Wi~D^|9(y_xW(~\) dSH7.$AĚ R_˒{anWŰuGwxqQ۴mcmQڂFn'*;DTҸ RK?];/ 4ATنީ*k6y ?b0ȂafjM,67@cmʓqwa@ɵm08Ғ $ ` fܔ*`/ #6VUV^Ptj P@LGrA/4w;-JpPJ'JPK=}TI+n\;'0lV~3G)ZTTSh!VOӬmA67|3/aL.-R?scBlO?\\0W%v8s{}͇,"|uq_0YGvB0NWee<L:aHE!85!BCU>USJ[r̭K*}VYn4;lSi'NiA{St o#x{Oh`jl_?ʨmw40=d3x jfݍ~D9`[m>qPa.R01q~0RCH>:55KOC>*}+x 桏_*D r5T̏?A>j0g֤ ښߔ'iI;x~Ja`n8ev(82C&e9hYLy2mF#rCٶJLtO7'DÉ<4dpP$__1i?v)e;Y)s׽zM.ۮ̉v%N*nU}Ae'pYf2hl{3{߿6 C>炉'ո_6Zz(S.ɴ/rE,MCq_(0S;47F);JfRVs}F1*%;'0po~ٝ1@@^{E4w='d)ip=UO4-[ĄYe7 k.Sȗ|§sX_76I\3{|9xe,]d˵E@˧,"4fqD_Dbvr\]A|ŗNֶ ' >pv%݋Ckp.H͝W8S~qY2`^WzbĪ0,SX/E&,.L&Y@b̓VGGeU3ȯT6qcm3 23BehWΡ/=}v0:ar&Sma^;0ҾbnM~?ߤ1]M%Lք%~ufnQwRX@rԙ4gƟѵ hw G,A'k1 אs^D%=kgT*g˰@D |-@0~3WQoR]J,GQh=|8ͫ*m|x]y&0 ,ê ofJk;.+6tʟT?׋~z&Pt,N%Vqy6wEHL^LQ6*ȷEB8ٴI+o4ae% #RKK_&}1vܪmd~V9@,뗞Eꄏ4<٦N!f$=O147]ٽ]BￇZ^Z.m OSV{܄ m6Qi>Y]&Ħ7uʋ$!tK**%Xi&19#8`-9R·;{XWq,)tW@ 9oEJ7.jհ|)t&bd#V"q50R fXpݚ5d)[sso(*pEgB28AֵY^~99>vcO76uNrf'ʃ~G0eNՄpP :!FߔC=;r aM2K&4,&_x砇 >ۋP8 : HCDдkr^m=K ϯ3ҧnrJHX ҵ|ɥk*ɀ.W49CkEu~RiBVs!8=F釗^o:2wMxR.t>"$U7*Ѽ<96U_3vuxtHY٤\(GKc5zDhDֲGM;FBU>id~U`>r"J#1;n"0B)@#Ci$>!DyDuю)%x䁛uNi\lLB?)g+p@p51YdBWH-N{K0N}rׁ>\+, YMp]y'HrH-C gc0N;:]ůn #NFZEl8~9`FPRȮɋlU~rFEk<-XH?Snh c:^/5-;nyX姴~YO9VPY~s:.t'%[ ,4 /))3:f Q*Hluܞ!|A[IwY5>Ts >(eI6!j0.c}]BSZ}bckcʇBDž,29}~DU[EL6Uݛn[=8ä ED?_^>h3> hnl}`opMpI\@Ϗ?kݚYRXFA05|ى]%:*sqGKYP7 &R^Oi& FC`84#q٩_:p&[[瘓Cd=K8u%%֒h L9s,hT_n'jP˚Xq4y֖و/ 뛏zNVhl_"`6}ɗcK_@Tta ņQ-k_-43Xk~/bGa.1vzx izEK\J8X-ł Y-JZЧ$q0H>4\i(a}:E \J˿6rev_O:6Uަdb#'hzdmD6 } WgY)czFIӬtX\\i@V^НCLCaAQ숬 \Z1Էnz!N3;I=% ..υ@hLv|wdN蟄TJȔ';ut*Zr;tׇ2Q-ŗRˠEqG0+./An&i[!'z琙6=&8b/`^Hc7;}ttrX-BϮ2i?3_+;}9L?e]Kk O\%NhuwIX'>(4B~VT'eF-^ӑ8qy4&k2|{^a/.kV ] K8¬qZ@lO NzBph*ܸTګ,6No\ydUJQi0 T ٟfMjIwu:>7 T끎wM (X% [&W`o-5;d$x8ꀥᓡ[1š5K!;7*` +>5ې4b6GM9)l%o71Y#Kę>Tґ&E{DktF;pӌjv?)4٤%3'.cT C +ɎȐ)ZXvyL*B6FqY6MMlzbЭkWFoG[S DmS3A8mxnQg. ߓ8S*[RB9p j7& msE?gܸ $".1yRZ& 2M66.mn<s8*ùJ#P_St;> &3 4 ~w/ =%vFSPC뒈6s! WRK:,(]}zO#{1*6 ,F,>[=F%:an܏F4@-_UDEтȐ(YO\8A2ZOQzlygOfnuT . U,VU Q =3GO==]VMW_?;cQwMY2{g=rd h_ɞ~)yUjcV/Ly@]/äN/w;f1Xl4BΦvћ\HDz,ʒ:ghaG +9U"}\piPns죻82G.z\ϖ*pwշ\Įy$CC2ideT47)ܬ|Ǽ8r qY+k)u`∀H:Om>Cbۉ?DX~nYOjͮwڦuWo5H#ܼs6)Y$xlS $q#7Vl HE,;jE=i2Qew*i>_dSl掂DFyCt4)tx`k+W{"reJɺU\{29ˠ&Iwk6egK9y"nq`pZ<׵N~':`i'P%D!%ՌIs]::>o\7bm_W[G3.3,`CE zA29 oI{޴h2(xΌSι^4Qu?эq,gV7nVͧRݣ: 9UhƢXkRМ%i(t>y7Ąspû/ …!W:A5 j!j?Oo3C/ź|V;d:zH%ntQ;l^P=!D.2ݭL'$γŀ`io*(RܩīfHЄ6׳Ƞ t|Ui[?{)-%d/! 1 K8/yR.1̲4BukC6|];ә/\X.KngL|5BW*r,0!]>թ.(%di좓6zYSɼ-kAU EsMĩ,%޶ZWߑAl:P@g.P6N!P+BNH-EG 1jHGg/i#r55vNN$SAb]Z*8+7S %bO Fq(;_Nfx^:p:X^;o''PdCJ8>p?>%we%>UHP>fp3ůC~y霝1JKN:2r:wW)Kj=,9D[ZBL5Wx(ђJB@.&kn%TM~u)^'|=?)zJ֫4WĦ!x}mʇ=u}ߺz&4եg"ݿ1wjÄn~ķT"О c˲7~A$;M,+\6U;OV3}ihY0h> stream xڍP\.Q9 '?dm"0, 5v@0'c =矝:APs$]`:PkG_&"dg/@w3+=`?G>^0rBp׿0A 3bi 'b'~l>`|=qv_N)E Y)U?rpxsعxAA?/QH'" 'dz ׿awUQ@^ypQoɹfCQ<2xdǭPqx Adj! !fV Qwp}A@>qz*:wJYp&qxy^51N  oџ7pju o7o.y - _ǀVNA>? / }ǹsWqlJzOqJ?fsvs 8]\8<*=!?f.pǪ=v?qa./8 u\HRoeKeaZw'Tg/%F~ڒeXڀږMv;dwAj *vm{Go][Vn%\G\|kymjXwe3Q:Lɞ9S?a%8vǛ%ș|Uc9.2\r!'7 F fKV"]*)Z̓tNl'=U5ƌ BdD"x?)+:P~PͩCg&g մ"NR#3l[E~~=l6F"k"K2Mn܉LYP΄=1bCcc^M[R ;,jKVJTI鹭܍Xo궿cdTa^ ~"*){/P@iF ݜp!L9$LlȨ(Qf%jHh|4Ki,OKe+9̀pJ_قu쟎Hb6@uwXc {_8l#=.}Ҁtk}b|.޾Gr;I !EH9B <X`I&i>d%ۤ~2 pe1أH}ݴ2 At^}$.%TjlނOG|4w'-}tn=ʌB?Y-hׯc/e{%P۱{ÕK[Jّ9,SC 0+ҩuEQ=x/a-9:W-d:¤igIwMOd ~ZTš:~tvT+, V9n&޲"I?YM5%7b]z$\aړz%Opc;#~&Llj=wnfߌU:!zTN, yuo\,jQ0nɹRtSj4T^Q| c)R)16W~#\)`bT ~,oه׼PF4|3a>w綤%܁e^nc;Ag¥K;WL639 j26!_&W9ģ<- JARG_k1$ZI5D> t9C_*)9S$da?wM5"ڕKV\C+l-v. S2)O&MUFx|K솽̲JtNBVo ƱQ ~:5NG7Mppވa͞fit2R&WmovJX8/'9;8.-m r4VΔ1ŹO=)D.ipk8TfqJ7%[*qWٔR s2~Ɗ`y|{ûARphMB%c,؞̒w{fLZy=ۀxMhQ;c!3ӴJဉ"jv'~դpZz}q1kl+%:sl󣔀DY{n?]9]&bb۰F֓\4;ZU2愶K5'!e<>V aJŢj|LE䛓v!A!jV0Դn37)56tyctU{.~Xh+!= GdIQn}_Vޯt (椁<ݳVgHx0֝;'yo}0um2/sPCIX~ʭiPd;0.t%ycQ%,$o/ٔלpUM7VG|ε[ 8=L:#};Sqh`ycf&m_u~U$@JX,ՄcPqYXt&??u7&ox|^ʫfk4_36o(k0b䞈F[_9 Oi- ug((})A+IFA-BOxz`]c*#˷}Q& lxHtn"^{t뼊̱^$H-5uFHy^@P:U/O"^0Sּu*,US>I\kbqٯj))x@Q?X?%3pAҹŎ"J|ƹiT@9R1[>/g a/b<4G$-~ t^ ]{۳_P"ڭ OAq22CbWڍ$X mMoOGġ$0"7=%]&–^MNc7^GTq]GFĻ>i #v>݀sda (srtÜUD.-2 Za^<$PwXncJCzso Oogm78veLڜ=c7Gӹ, JnNSi[OW(@o%CO@<8Խj$z̨ +ٲoijzWH/(Fˌ%Ƨwvǒ"}F{f$G=,M5bi- &?ɨGKP wc3%M gě'POɉݶ۶U]|\X·8:Nt;ݑo2}qbf9W*!m%诙^_EDFQ-x2gv~m6itBʼۇHTd ~j.b;mI"Oj/lvI4W\qگm0C"ҹs> ヾSDYc?5q㥧7C)ISY-k6 x2;|CkօhsZtÆ_LStDEXOS>rx 793DF>Awp} "d>/ _G-RLjXr]bD%_?Ȇi}NZq ]Ć^&/0I+^j[W15 1WriavKd+uiE݇U#^JJF~'Jvz?@O1=SPCa_mH>Я,7سraIJ&Z^r̸nKn{~vQx,;_p[T$KXPx-H rS|dj=.- J2%e/94H"nMxP7ECc( &I/669玍¼cKxbWq)!0Q7x#i9 1 .zE [*[A|}fU+")nU*xK1a7gɠ֡_,sɳSkGB 91rзS}!z[p5A]v&6JJfzeml.,3SFf;v1[z<R"΋˽v ԹkNYGN/(o AJJYkK ӚX,/$|m-\KƆ Bppa1CAr zBXN3.Q}0L{A ێgiF'_\T돣Iuʈ# go}=&W}AᇝN˩ahW.;礻5N8a IOrY{U(Qrǻ_HvNä+r Z7|ѕ_Xﶶ,bԜƴnoYtHڢ#] li{3\ZzGĸ[‚_MzO$QqA}jUM[I.6@Ͼ"a^q}5PU ۥ"#,%8~+;󎃗-zH OǼD gԬ)h[:/0*M#N&芊ٽK/4uU|6QWnUʨCfSLa{ 1Pж9 {JYr[ 5-YDVڃn\`B@ h$>IŷZhl#xqzLU??1v1kYLY(4\{@)hW=/Yz$^4q:Kο( " m_!kЎH@&~:|ݾ v:[@T(ZES9WHk=F8L9j />8t6Bže:qlFkad;u7M!bDďwƾM@p@:aJUzhuOcClFӯ4N=p,N#nXA2_ MgEVubl|eL_WZ_loٶM"'}>0$ț" BMJTycxEVY]cQ<4*mEM(ODvZWE,ͷO9+1j}O̯.#:eh-y`k赫9͹ g( FY3>j(EM VB?6d[2)Rp%ћJ*䔆?4:0ZBp*}0d)3! w4wڇ笩Qp1ҰfZ~Eh)Wv~V!@KmCP9߻e@bP6p9)\gdVxˏ{׻A6}i8J#aL]pVDa/">VC"W:4B {Q; I) x9[Jpj G oibBJ*=B +iö\1 $ v0z펾4_uP:'aIoXby,ӌ#Y\AY19W2W@//koq۸~\=s.6=Cl,%SIli78y"E=MB,MSfhTI /pPvb߾_;Ѥ&ھQ;U**ݩiE#֌Q6*L1T9^Srd t!۫z\CDMskytlZμÓfBBaU_kAIFz/;4{8Vj+GEo?k͆$Ѵ)PnPZ-`S6@K 9FNJm[e. bHx;ĭ=P^fʏFjnlfJsd5>͑Őw$eCٸ]5SnuiI/ K~*J2]=QewRCo0ZH24dGV7d:aߐo28>cu1 jZ*4(0)Qis`>YJM욊(Zo 3O7IlLm0֋9bIZ;CP("@j ̡zJ M^'py yU{gxC_k\S}P@A$)a(cx?܀65(WhzQWo8ɦ'Yi֣U[uQ`Ӳ*/1ڎ;tdT9%r>֏J*t&J4ƝGy̱~Q8nEe nEZ "D JԻV W^_lm:O'7Smuqe60 !O:PB:>oYq+*Tjǒp'S-QZ͸Abz#Vw& yN \&Ivں[L\ǻ0H: nDj pV]{Ŵ}5|b8p1;E%+LRe^֘3 9IfG-y ,l*mޤO P< 5-"]CW=/ +d1QdAdaO nJ `ZLDsv,jyi!!ΖCj؛zŒa;  :2SNjwW⩰R5U 6V_t:bum?l-kzԧMy@N:xN,r4~ȅ 3x*4.'sx|pɷ<oWu&&nJ(N7 m-ԾI#S$=et!QHҾkOԪPTsǒ"LY{鴲9L 1)A*g׏[4oT*A *mi.&yΆ9;*Bw9;=ȋN2nهӵ(_d *>輾 bۍW6$KXvK]/pId)~Sг"FE]ͣz Ih{ڮ+kiGE;WgH ڼh,ɤ[/6Jl.KLWXu!g}B_%[Zl&u殊T$s(){KDyBJ_R6oMLYw ^ 2wWotlu52ώp/ 4%\59+Gw6L fcy]kh!ȭmwojB?}8fB%|c3UB>ns.Ъ )*cmڛʭC=y[0MKAgT @,g3j7MhSRYWBgfq`fg*acQ4XGEOST@Z,đ52VZQc)v8tc,y˼M}*]XoDu;=O<+⯄oD#*˨QvrZ\%CW݋&fZR_XD8׌2w~>)Ba2@M %EF0ˣ`!؎5Y2rlL%3,RXkS b!*#"*}NKD|QW:Sbv\yDD~jѥRh)]oTIs}w6gF&xeV!_S@hf.ߵ4x$b3OV(UH 4Nu3#.ofl"䧅AS"n&}?@XaSnj6!-< z_!Rt%egHBf'6$9w0 N}%$±XaVT]k.ws1+xϮ|y eS1dg-P0}>_ A+&S$>caAf[# agqP^F RS!$mU4Ƞt*-8>T Gp昮syϔ'p(p URhEC^#`Ȯ)&^Tj.$NiZu8g;Eg/UHZ++dH+~_ĿH#IsaXq͑wͷ;3M<Wq4>ָLUMb٥ȲpƛĖ-7AD Y?ah Np㇓.@9E?z;A "0ay`lṓts}~=V;lQ;s!ec  U63 χ@S謋pr-7>'n i 'HH,o1!e悳/n'UѓYz齱Ek-TgQMelegݎ M8+N=1 T*`T3q<5h)Ըq03Y,ѣz#ZƨΜi@Im\3asӀPly'mޟsTet̕lDkG&߈F@cV|dEӗ7 6r. )Lx?s'B"(}H5uǾ}hL,>,ݙdpڵ 1=[0Ƀ}*3&? endstream endobj 42 0 obj << /Length1 1537 /Length2 7715 /Length3 0 /Length 8730 /Filter /FlateDecode >> stream xڍwTY5-nŊk!@ Rܵ⮅Zݥ-V)vf{WJ9< 65 "spqҪZ\bbҁ;B4c1A\ݠp?]!6K8U8 ppA 7$W U cr04jk~_f0 KHHw:@ [vm8 qW f;wwga ӓɍj+ nW5afXL;vm+pop!0  _PwV#8S_ɖ`0 l ;;f+ ~oa usK&Pgw7N7/_eOYf- wrݰ~O 7u=a>( k3PuA@e 7am@ x퀿x;C~;~8Ý6$ ~PoV[( f]^cн_<s;5 ` xBWjXB08@ g ?Ugǰ^7_\gNWM!9o7ot:zpd}W{ߡ?:Yb E8W;$a9F bu!nᾼ#рA_~;ܷӿֿ`j7A!^ r){z~+֯u~#>A w_{%!<?}:>oQtu@o/` :5;? }Q-ؓcsHtiS?gֵ qRz&`a]Tbg]=FDKfyf+ipd]7C*-[_ wr]x]^uݥS[U7c/tcM&&91Y'NƉrhذv_1Z~y9|\ۭˆh`Էd%i1͜JYQX3Jtf|쇔;0dvVxA1˽nj3mqҤ'~&? 0:{1S-J'Z>,~5YX(;K{Ámlw')CBCeq$\y4[)b1G[)^Ӹi8uWCq7%qЕq6Q5s/0rڑVx,.}Դi ?7 5Ef>7)/vWskRgNROz;ݑĐ]+7_Y ]%{vuӅTDdOI~O u r'+ J(k9/ ?VH.LGDXw!G㘈-#[Gxf'| d -VޯsxsE75P|So&k~O~&H_&\' n.T~xAg2Gʆ ?Q~6dHԠJ r*|z'%~{@,Us=&EE`׺NqM|9٬LRZd kAǘӇjWG1@/:ڴB s/z15s;Q}GH&γbo\h&%?(!:F] j;E韀jh_?+t1IQSI6vy_Y5sA A/gǯ89DV(0)[eff'ԟ}6Y]!칙h9-D]]]; pޔy *&_0 - ob:w^M嶂I=q4%^DOSLH#7k>AV#<Лea#+NۏL# 1QG9hǡ*ĩCnE)XHFwl+Ґtsl1_*Ђjf*Q ZcFi8,⌡ӹl_2Cq_B[Uu$1m$8`zMб"G}@=%ڸ/ ׍xF@rۛs ^$%z WJPp,*M~s$zQ"0k+w%\qBSpgZcp@ǖ3Co7$sfU7c1PRp^8g J?cl+F/uGen{C?Svn3||RlE?7Jǝ3eQ]|.f;`{אʌxD1pl>3~FBV_j~3Gsb~69a;Il6`.+c@0(5IEr^XBbSCT1 ]<"6ĎN1296a\9*؇}%r j۽ũQ'=p/:D6BmYIiC5}ŴGB[:TK5ѢA Z[^V96597,MXdV숢*6KWЅTƷX?7۵"݄|3.dD\Vb^[+]QŌTja%!U"k|GJI]g\DSx|]ěǍ [)[ȓ _J&z>}v\t YOγKw<Ĵ8w+x̤B,uPJUE5JTe(`_c`G`/@etޓvcle(\Ǻ@tMqO+F>Y1klgOO)ck?bHbZX?}_frZ9]CI蠽Ù\(jf/??j&kԼ3N\É} AqNo=ka#oƝ+GIgT yoƈh36= 6-*c=wesHoN}f(uf62iCsYo,vuK^km4,U+bP9rA΋'\`p 2)Q=kd_aW2.k;7ĥJVCf: 8mF KEmOUHMgQYc_R{])|dG$f)ld1R,(T析whȝgp?=X:& 13yTT{y5lg}"Tz&t~f֑&|R"^$蓶#]In+%Д>Ucv3ኙj0/KQ@ɠE(Z)?W*Х-ۡo5x?ʅNw`v!ҢvU|=mw,djt\2:Jtg-+x2&\)譁1xu輁m҃(H`؇NLJ8N,E*f|"Sݓ-AX}o?XBRY,U׬~ W1cX-ZA6Oik P_ 2Ρ]LL0]GԼP4S`iV*M*- S~ujLO$9=Nf6O>~.C,>4 31p-":=7Ꮓ]gi?Ȼ@*L=U#|o( ;?ʇ2>?T'7$BK.\ets ~LC& ڲcɺ~U]d[Nf&{%٢Fv ՝t{ꃅ3bIfOVӈD0 s!%oԦ;Uc4<_13~LP=*g49ܭQI 7]tl"Ԏrqh?56}{`ZV\ 9ߙ%gB'gMzf|lAsnR99;Հ!.„9وӏqtYrOCCw>Z8>?, cɺ6A _Dl]x;=z\:q䪍RsoQԬFgХ*Hq+"5ыKj6nZ]rL)iO€C$|~2 vz$~3fi)^qr5TB VLKs;mZVccM5^lcS69SfRI ߾Հ} Fvix>Nzh`HZ>RsV: 8~6:zBg28y-S:9$ZULih<.دp<h@ɸC*uXyYޥ~!CS|eӯr'YǠY|iP* Aŀ5S@d,݋ ƋbFW5GB~ip);Dfy("c\!O KzNBD{/^>+LPX6Q'G(Bs/KYY(`mьrz>~!N3&JB#uDٗd&U ŧ8y4+%i{ƛT;8Yfq9^כK8}淭ȣ|23Teba*Hx|'sNƵ\AQxHwAE4DvfPw}@ P[DTnXѺ싅Q=k{+)1aS]|3OWfqװ03!A zh>P&UtMd`Gy\i8&D^0ΫGY6d zMLфW"&h#pM2,vi {T`idXn1!&н(r~mT"QCJ;{9=X;sM+KA1;"{vϘ&USHLvI4 = poYdJ+CQȨqGO' gb4Yl!}&n.Sv8vn]\|2v& 3gV>H02,Z֜e3m'ptdEjgJ#MӘOőg]u[gXFͨD+9ϰ$6pT!AbN(ϰi d7^#aQw%ZHCX0sɷFOEbHQaFm{~(Q) }K֥I%zy ŇRqiKb`G֑~[5y?'"JmO6k; (&c;<34I؛," zcdL A[B)ejMĕU#` ] ؐEQ|>[Bg=oK' BNpB$xE'u>J| ~⇍@3߬d[}1t~v,\leI?g:I4Jyr߹_*KQ Y#  m<`A]߹5F$m<ٲb endstream endobj 44 0 obj << /Length1 1730 /Length2 10146 /Length3 0 /Length 11249 /Filter /FlateDecode >> stream xڍT. š-\[qwA$PܥiX^ܡ8Ŋ<3wf[Y+9پ -%$XlI%u~':-&fSN rvC!%Af'IM Ȼ\ O!E @ l PbC! tZI3?G#( :@ 0`6 'f / m`0GAvvwww636#  \@n K@cChڀ]k@`f l<]pXOrGOe?XdmC~_6:8A<kPQdyXf?]OfO 7Ȉ̞+; g#̅lGy*4R\O x'A?V`)X:kAN 94DȬA0r<,l0M?uX=[~н]@+#t ` A`?֟ ?S8}2z-K(eWgߔ `98|OwT WlXXATL0. }c៱7x?+3o<2Y?kbWF(A:?X d vu_Vfkv{,U0 ??=x2oT.?+]{zJ\:=X@-9N^'S s `g@aOWO7kx#'MoOIGG.@;}._'_T"q|+d tO<ryZ觢<ܡxoOozjYMC-~~|U-Nκ9" fx-}SIa0? " mF+T\7nl Q=8*d538x _KK a&FT_ բkCk2#?ӱ~-9bhDy6%$˫蕉 O F鷒_,yk$Fφ{F^:4zP],1 kv=5IXk~Z 6(c 7nގxDy@oKx]h 2?4#MBbJC+e[ucػPLsL9o RHv{Q1ֽ̎SOZ$qGcV ك|<v:[޷ZҸ 6 GpN|x߼V7fG)u!<L&"Ry=5i߶ՋDnbd -]t?ىd!A8q A>sc ;S{??OQƜ1nE$YRL]0"8}beZMgz.=ѰRNOv'GGaxhV:˃NG-h`H=0K'*me/hbW*aM!<]Lx{sq]cNJ 5^aFp6V`k?L7PE$`>]&Nx=;r"pdQKt3R,4tvaL B X̩ 'e5eq *gliXs¥(؟/mM} B7g:uȟe&ڹIx~~\V] |hg>~tكcNYmĨ;ckAt لU .F] x},| -iS)-ͷBれ^>`9+(6Ep |$2=ʒDoռVFQ͏7pnI{´lf[ !1J W;O7jO R^ŋdܤ+#p|0K'ԉ-&srs;`̶$Qdl E7;@Z`}AaNYm٬&^A(.mN{e"y]uz hdE4\,УDqyV#SQ҇?LX5$ W)xLI0q\ŕ_|mL}\ 8w9~lU7u^7!)S- 9Ѣ, #0ZV:D$&'<~$.mQ47+ iSfn؃\Ysĭ桱%6_ա;:gsی^I3t9:BK$8I!K0o{5Kz$]ǀtG1v$ze.љt6i|2ꬮ _L>[@QT%c6a> ڟFE{TӶ~eѢt8 N3`Hq#1׷SEg|y5̂ q Vd,ˀ#M[p3%_F7k5/7 †[$>~rtYtL0L+9c&CwyqT:4{چO ϭ‡֍_bd'|F}vT 1{Lw5ߐ{vO41flى%0{6=ڢiGDGJc(Xv?";#ѻY8红*s(RIksf3+ftKā}U݅ -eՃ#͏/2]oͤàWToOc1VmgCC2È@6l/mJm =-bG/=n( C kI/5QcKxi4 b7Fo \/WjB H75Hdщ_27}Z >~g&-q٪Wܙ5o'1QQd}Ļ9>,5oY%DE܄rޙmx*=aS&3H8&WF%Ydf/[1z!"[[[)JG:oLp&HF$KVbQ aΡ,RtZ/ar`Nz8鵵 f Sߢq]W#Bw;&f[x銤> sR_5&=^~ʁ JDVg("<Q+r1ެil~9PkxCiiA\F9-iXv?59l2®[ {Y4ؼ{t EŸ'PQ;Jd`\Tk鳉q6Np(e9T|׌'\Hwk-hnl\1yO4.h\i> "5aoy*AhVaPSѲ##a8P)^"<|̫e Gi&yK,6,^ArE;'g:j). ٖѶNt:;m~ l#pkd~Je"2O9!Ŵ>]@pt k " tC2<@_ݝBozV(TUiM&<sCT{i/ Ԩ'Q6OhNK?Fo j<  *5e+OevgFU!ny* f(KEY؋ΒZ8x]&Fx==#A_#Z;CJVH}7;ۨtRvD`^ TR[NW}!sg*φKAqN_L=9>Љ *ÄrF1bϡ{mze = 12ݰ`.z/uk#/lNotD?zv5|4D ucwosAGpFj"|Eษ\|CX >TIJhf ȃr8 Cj] ;2)7iFGޣomҀ]q =/2a*/sdpCI:T&|`/yT039KxOeuTrV,͛?:hyi=3'$YW4D{Dg^V&/e&P4"5ζpՃ6 c;trH`TZ9N]$.x/."bγvh #d6[fK)eʪ ^W_xkV*&·Vh=jTi fӧD:]ӎ:kpF)3.Êtˆpβ)WϷ 5Y=?(}HV%UGOi8#q}.D?CAD]\aMY /?}BY%}Zl-c-jXޯX;VupAOhEa?g|z<˰VYj2qi'{p0O.W%n{h`S[2eUf?Vr622H7o7F{NUl:Q 51@´d6n)ц-k1-G[8{[<-k YRM|O1< $4Z;;C;^es.7f5}P$ _FT0–y~YsҐZ?=ښ%ء$R!kh&SOG^}ǵ`ZaDxkE~񋖚C&vsDc|N+oNjm Y7Y>D _hL co-Wgfh x¹ N8 $#Yd}w&|Y>2=w.aE݀g/m!t1w {.Bi5nǝc~I$p3uh~O@@yɢ-j,BvΊ{\< Do*RE P<Ժ]2]'#/|`aS짟rOaCuqaJkbPPmc* ˹;oE$1H]wdօu p+p]p⢋IH``@G!&c J54Mpj+#JG&9Z4| M|*\ h56J/v>ϠbOZ{z&wWcx%Hg͓ ?0 N]ݝվKt?3>f/xP$cxL n! ~*q(p"ᢶ8vyU\C݌e%n?BW}j1!(A(\`a ߺ( $6Ix=j#{U.9|cWQz>7u!um;O'`LnMF:.8o[ =)@ NH VXڕ cEpIe%^1-99yH1]V.+LͿjr@cXm|'(U/~x,/o@&pp)w_GHhpOƦ^GZ]:_Igh4>G+20Q }8i#KC^\HEWyd nG)'QPa?}%'U9%'SJ䏼4 Ғ~pNZJ fMKdnaه9Kd3 Ro\Ū21t Z"tt7Qʕ#v:z\@GZt41eWMMHbblQ^;RojaIrhITofz"q*2RJ0j+"@aoyP׿/Q}Mi!\QXe XۓqnrY$՝aoQ%(y܎F.Q}8N\hgEYA}[[~?vJE8bK<(} ,TE JYlxLNK. Z7SvZh}MmW=FuޞH_|`Av7<ZLHB2uaK^ѶG"ŮDIPQbf+Ʊ}֙ $)<ō~Tň>{ԑvkkFC>bv;yT6ë́C}{3HiJU@ PCDB͙ؔZ{,l?h)6W]0ymy/A(Pȶ/_sdD*\3MJwm>'$dYrdnI-abW MV+i+zF=rm L%=j ScYsaS 7S5d/J/˳ H]{a wjl٩tj-|,lrPfxnG[(0*ºh ъ2oIAÌ*ZzH!BB4ڗ)+t @ӮIAe0g#-p\E( D `&.ڶ^Ad_.FU:rxymeER4 nScpyBcQ*怄dOqN5{<G g'~wW|vo[2Bo/lDӟgEzU( o޼J{oDE>ޫ!"nCpsZ<8{9UJSԳ hmI3W:&rრFKgg- d R V ctu(|=hЊ=4 9™^^ȢnO ӎpH}1ձ |m%{ę9w W16'鳪G]ci|qiDrMW/˭f$Ie`.޽_<QYTq&BT(u=ѥ'm!n}@ *wH/G3&bj_."4C&vA?FgJL<~Qf(v ,OwDCӓ@ЉGAD~/2@Oɦ^첵hP6'NI@2.hskY<иC4D|@GF;;}%U1/CELKGRL6Q`Xt(W5D{ڦZp*XIJW|TIq٨T#n*Z6W6ʁÎ9+fk+|'+M]ڕs$rD|lGL̀pFPN;4)FUChM3% Mm'{闆F >2w"C p&),f=A UYNm*^՜5 :JVk3oWQ3gZ0kVLǐLiJgU9[f'ÐYi٥ܬlXEj -Y׎= IkJ+Ÿ짞*P&ya\8Ÿ .niZS+y(vωR\v ת4I[ jj/ Qq0& ?3ېKɔ7e lsV*|%Yo^=>ыއWGGL>ӵ%G!梗'OU4܄b&6zDۄ"GF-/+k/u,G0~ H52ÖoN I?mWfo_HaW&w endstream endobj 46 0 obj << /Length1 1427 /Length2 6229 /Length3 0 /Length 7205 /Filter /FlateDecode >> stream xڍx4־ Z( {'zoA c3:kD{ Q# JH{}Ykw~9gf =D@@)E@a"cNa @@({@hMu}O8$Iĥ@0(7!P{:HEġt9:1u~pCx IIqEW Fth'+" !!0()eh7)!!oooA+J(P jE v&H0vr!`(c P ≰z0F=7(/_~AJ'W"w0A0#Դ>h~a xa) 074J(+ UHWW("?9w_?uA `{_4=݄L0wO Do# JPw$! pЀ" @{xBA;# A350#?'k[,jJJH$@@R @bqqQ@?f۪dD8 D(YA3o?!7y~+*ޑ']ap?=јAb&P3_yW ̈"s=Aཿ0jCCԀP}$ DÌs0-b&uU=%D јc A"!0 r$ Üf~Ql; B#!/;k>[^IEs>wVrWzh_M;?W9>w|AOnRF>Ku`M@`Q#I8.FdD ׊+ex拍.Ԧ6PrJΚ΀~׵؂}=bZ8b@^vˠMD;!a.K\aMۉ_,B/+4 ,{ ɏ|shKxLjTК7L񌙯&v:6}4/Nq(Fԥ‹M mʋ1&V`7M߉AVgCl4pWR&㚋Y %6 R!9Mh ~rrh"Zk})ܶbKQvpǸHV(trS&K_'!s=׾Gۛf *:xK"[( -fh_ ުn-GjLQ oquwx#IO/tY USKvZpeYԮiiS`:^0}+䋂([Jz fa|㴹:ۻ,gpyFR4^MaՆuk:;XiVT<歸/lҞREOIgu9}rɳ\@g28NZבn~:YLzUO0Sd}ƂW[N|o}*tjnG9ʮlߛҲL2TN+5Pq"#V%tMyo]Q=MYb9 9 ;c4bY5VEA֢`Whǫ'aܪs6^vFXdm%}Gf؜LJuWRx߇{ޑ]RtEmDb?K8E} JZxHSEɆ~)GMP8}%|仴Zk;b5Y"A/FqC+򞋞ݟ MeHKw6\eX}`9h2j3КBތj J\]f5 &9^ڛ_ 4b+NvieC(z%$KPX2^#J`<+{+=98?1FzsC /5L -w@}zj]- ]\ea}l(\m}E~{]Ot"K֋-3^2`jvFؓp!v#]\o{pkY҅ؗ"Q#M^exv L ʝ:0 ẔSWg .{~K+dP Fsu;xջs_>w36bp|fxu4򒾿PTbQ8j*6G[]㣦<|<oD:o (o]1pMʆ̩q),"\t-^|Q ORЇlafFxxyގ7F~S~suuxSʀ^,%36B߽Iܞ>eFE\j@#zmY7 $K ج^o5^Vr`0[ȷݕUqo4\PMۗVO'ioJ2<5F=+@]XzK#š*+ts-멭=hxWݘUqjL)B?ZPP҅!\#NPc{2ѷdPg*};hSbp X8IH_F {GWm7$n6V^ G?jKȌYd͐|\t1:q.h${{g}qf\E{G$I_<8䒙\ƃ 쀄ICxUEfG}+BƧ[+WȱQ#sd}lÚN@GC-o'n JPOz눵Mc(*JZzǓ;A>g [めcޤ68ޥ6+R[*K[z hg Ц7^Dl?HKB.kFs9s׮io# cpRk)Se/O%޹ܙI){IN*.,F6GÅ_(jZG9' j2*ܸHG4҇>J,㵉gJ⺄(`^r6, eu1O޾ޚKV7Ksnl|qas9"/vw8nM[Y-<˽Vy)ksz착TW5x_uy =QOs TBgsD <"[33X:}Y_ퟯdp뤫Q9_QГwGC"PL]uUmn<Trh t'z鋏Fi^'ʏ %6>jLF+'eC. [V[ | 8(4]-竢(n~u$[o ~|wH q~襺 ^?8΀ڄXGisy[$5x:^K֖$ vsǬ ߘF%G => 43ԕqA+tTM9GJ: NS{n9hBiDe=fh(/Ed qU.)ǠVCO=U"sSbH8%$ޗo{)AT䉇EK9rcBMM)^t\"dYXժS\مKqay'y W=\2^җ H{,yq]oh.4{jI>Uu<,8 8֧BQtS{=ijH?t<ŚگT\MI;O&zX͖㘢4nl`^/XZ Avmz9 ϔA|Q5(b<5-owJoZMF`/M: YN O\{6"[[z0B*\OtY=ܻv"F˪$31fyOI` Ȭ`:jwFyt;d-P퇷GJݒ3[4(k])y>u¯8bIe£LoO]%Lj-K979IȽ h~K6@C.=~(;M=Är%^ogF זꥱ=[Js;H9x'.151*Zzt=Q9܎ %YV[A@j߿2ې)xUxM06 "&lܲt1 _{s*w5w8${a/>{KUyvFϿ5չ2T$5Eo2/<"7 }Fm`,Ld2ߏ6AHˑ3$҂r8eΖT ڬ[e4\7Y+$``5EnZ\\q;`MM_9}^1SWAFխIoӸw6)zS  /X_pѨs܋e~9+RKSvˏ'8ZsBtX|ou֐#݃W_⧖Z̍شG<[t9^"̬h?xLcj3+fBjZ;'AStHY? '֝85d$znMxx4ŖJ|c`^؃L> ܛayN5Okzc'F=!Jbӌg +̃!\,4"PmĞS ߴGmݿolnjC|)uo/ԁc_wڍZ62?bOj[85%Dhj[ 4&ɚ{q32Aj ^z}VܓmA}IrTX8_ϼ:֘G*G%esLY=e.P6;+L,&p ,\5o,sQ^싺[>1R-i B|6+V˻>99"^ endstream endobj 48 0 obj << /Length1 1399 /Length2 6085 /Length3 0 /Length 7047 /Filter /FlateDecode >> stream xڍvTSk.ҫ4!${oR ! $"("(](MAQ{׺w333{m^.#SQe(BbE@<@UJIA q ^^38 QHPE XM QH,K˃eA 8$7AP>B0(wŗ (Ɉ(#`h# Ї`]`|EGaqJ!źˋy{{! v)(c]&0 ~@?̀38a CbH( j a?`?_gIWDp`# AHg 0b}" qà/ 9l E㈆c1@ E_i𧬎?58?v؟κ"QHNp$ 9 V 7QcsaR 9iiIqt 2Nx @`,^Q( p9ÑdǛaN>^{`xyAQH7?474?>OT *')@FV,7V#ItBP4R_#w^0?ʷI7d+K! O7n ApJB C-a&Y{"۫CW(Xcc4>0GG_ 0_|_>9?*|~`w]u# kĥ45&.% -oCx'W[%b 3/'ſ 8z|׿G9RLOB׆(y. /E&XuGHa>fjyC+M= gvCg ܬň09"D8FVP~@q) t}~Rb boHL`l%|~kд:ibKQ7l*}-jyàJ䌰E疗PQ*(W|r5a\RI*ZBZa+Y.^*h%9Y-;>G_MVmrQ6Y( %u EQӴ9aOT(%,wF{If"02kGY8H1̣,#mFP6yO=. z{ZDGYp;?->'@qa8bWb~rm c+7zR\[Z9upx}mS~&+n9K)HzZ=d"ݣ0O #fzUv؍e u jƞʾ丮VHhTM ,=H$d3~2pǧ: #ۗb(DjHnwh2~һHZV[9u}X=K5L0Pi !X~Pdܦe/J*<'`Y=͓I^f5X?*Ke88\>1RբMp;fac}\׺sƾ} }sL!Bqz} *u+uUsٳ$`wRnN:I R?Mbw^{) zNNSJPyd UӚk)#!|ږ-z])ᘔ\ϼl1H:٥rdEf5m&/ .S .i&y5)s~Aj#7\~c;;-qÞnlmk`b[q%Nk_z㜳71 M,[>iP 3@jR7uv<z/{N6gy4c1,UqR!R+ \ZP0DU%fdLLCsy ls?Aw}Q­G Ac}6畅UU?Ofx2mVӸ[AHmK$IJ>_wYyW!>a2R't,yWÒu_uW73yS  we[s`4njU)#̝O駖}7$X!2}a,dR%i fRpʼZSD/5-EԄ~d 9{۰^kvǭ0>46 gn] tN'۬א̕zr>%%e$v჌"qQg}/'iDmp=Li7roG0jL#\]Sy$_ uˤ~:QS *N5 Dd𔐸ȴ.9rAlH(=0H>ߜ0f#P7tmV5xnokb4,(kk}~(]{^r8¾0^7o|Yj/CeG{묫䓄c][r{ZrX,ݲ+hNgޱeX _H, Sn4F-T̬eC^ [fa;s+?SA H R2lD;W.- tU \{cnB셮c>"[\9a?KQg޻̻Ǐ>!&b~MDM11-V4K :;&`: 2UErhf 1yJ]m U( _rHJzWyeF2%ME,Z_~ZTp?F*s2U듢os|bV飭* \ݥbzPza ގX7e$UIPfY2Ao>̷"yZP^0~^lǪ_`ig.ֶciF:aiF%B#\`>^exYgCZ-|d$A{gdwέ4yąz_ǩef.4> Q\O+ ]3aJJ-/;;껛A.}d}>j҈\ [~'2tH%n^ޙ}6M>}'bҵUBtfU>alo|0eɝ$bN./~rKKXN/sAͿm˲hk׫|ˇHnϳO;im]+aԮjLK`/Mp#-)2GהdH*8[L:go]TgU@^[X@ʩ 'Z[ƇXMԯ;ղ;fiL¾}˼?fv& Hۧ>MAӪtwV|ߦuX}4<6ݡiW'Ρ}'2٪ɯMrrW^_qGC;9! ?LGV+/=„I2 P wȇIv[YW~j.J .)O &!zÕEk#j}aicXssѩs*׶}O4x_;*#mӉ:S8sSC*v$voy.e3w (_C̷gy3W.,c{Y!I'|lђ1'@o54 `zOF61ߖ%:!#&Xi`V 1JY4ǩP3˥yģ9kHn7$g5N;9U,\ltd+lQ6E&BZ<^yfT%rxDǛ]yֽhlyH@S_9"9,eQ$|DrAoڂ9 G;7rղ8.0; x 8mrhI[fer"NRVʛa)aӫC7 eT!v7?tmZp 2$|xSGtt]5,iTEl/MŽw5 9؉x.i_KW77£,j~`\EoL 1M _ ^)Z:7ԎJmҽ$ 픟ZJ9e$ ,qִJI(t P2C%H /M\ez'$,zJ$7L7nPsG`AQ}#C r?v9GYb:VQU޳u.D ޷+Z^Ϸ:Oքئ63*_S&[hvh%oakџQ- m*ؘs9^[7bmSʳߝwd+؀)cMIIOzʱ&5lz5uH}mi1_+τަoϤf{҂ޑzcn>:lB㠵Kknk #>J>|~#@ x93l0N RR8YɌra)MBIrFvmvɼ"o͔4s?pZ1=:_ʢ'10iqo9|sllLxT*գs&P8ԡV endstream endobj 50 0 obj << /Length1 2443 /Length2 17036 /Length3 0 /Length 18461 /Filter /FlateDecode >> stream xڌP #{ g .A]'\}ޢ i{{uwނDQA(nk SUea03123"RP#RA6X8 2QC' @ `eef23ց j21mm"v 3s'0?i,<<\ cC9hlhP5'5/+#Gz+ t:M 7S#"@X6`gP(mc,z?0lv6463q٘LAV@,=/CC+G[!lwq!%!s4v992:06٘Z[mO4ݝõu/2٘U (% X[ftp033s9_v,5x{LeA@DOGC " d0lGwt`O 3rm3ɋ+iSJaa[7'; xooK AG<)S[Je3, m PO_,WoW;[Ydx!g k:M@W+d!3 rMANO dTuuXrƖ;|X_F1c[V`` /V' xGMn6 W 0u@H99LBL"7I70L I7b0IFl&'qd#0of "n0oS|*;I7FZ"0o3t4AYhon%1u-gWW_flk9X[Ia2hbkee8 ` rwoopm]隂\O6w3a[-Zlm?d~v;?=vplkG8p@p\>.6w_2v2t4#w G8{?ml.@p\CVpP? w`W(1vv7B/m?Z~zʰ3?CD@Sp#0ԍ-F}-Ly\<ӊ8?w$TG@*lg !Me̍y+VWc4x~GiSd!R-_,EQ)!<-ƹ F+t q$[92UVN|r|mb^Y) \f+%QrZ&?͞i;*v5vG( xt9 Mz!t&r.QpKoeNj&t6XQR=A)3sJQ25H޻=fgzނQy<2kyD~f7R5jhFqͺigWdF̲h;SOfN/Nҽ̃L^wBoֆdfӬnV(5V|qW<sΟ{߭}x<<-.Y '8KGKhEQA%a:Pfuػ ]>-kRv?lfp"ٙ!%gϝu]zS2vY8MN '.Fԥ _%5m.B"~C#Ϻ(Z6u_|a {_)Zt6k0,5cw y\]G o8[4S#LV&oY&Wsr|qY{rk/ qH#hY\oX;ٙ 2:K>Uqy08b!8ȸ|/\_e#T؇Ƣumvk?ڕm>QnHZX{S џȦ+q;Efvُ| b"j*⨹]`*Z։]o[r_"ۙȖL7]N 2a^˃Q <ēnj =M|XMSR_X΍M5!3`SEATtA|WUuX{Z"/F㙇JdN`@|oeP0Zj:EO->Cjvp j0e:t%xiECG)=":*XB$*Tdibra*l(27p4#|_0ڛ'jϼ|7,)r]P+4(/J㩆%m6mJw^axrNh#!^ {]Pkk~^n s=QR6_V?rb/d`o%,BQߔj4ޔ~R*+b:VxQE0<& Ɠe9tI1`l=ͲsDe-<_elYqP'J06mn{%.aLjگfMlO>%blwFYNkmQ}e - YD`O} "Zr<["RSy` % @Yџ=Г+HÝ+d@mp07`ŧܐbdO )  }K(-3toKoǽ@y5>~ .^_6sf_v/p I}m߿z` ƿZD~`jLۗj&(75_m4+d<׺gzϭ: & [@qmޓ7FW*V.5WYMvcLyPܶTLy:5/L%Ğ]5><%w" ZZ{›=CZxR~;"7hH;K~Ål1ڱXO\)U#VM@>Ʉ~xՌ~C‹k4c]'g"HE߄5f ]t#b!DoNAq"#hM0 Sxd 4DB[0<+r\{8E  !W ~`P:t HbDG-7DCfQ9T1"? 2.[ 9H@ESНPt;O03ʐ3gE:+M#`FggQrǧށ^옱CmEcp}uZd Aä.=9{Sp'igC9@ϛ:61'URø5џCbwSpN8kRJkA1Ȼ3a!TWy_HRs""svuw]mr@dՀp|"c}a-?J$X'9W۴co˽i-fZࢮ]\Lmc+-|k~j"ߴrg권[;s>z+1k5NAg Sϩ;ς{Ϯ|@EW3Yx\l,Fev6}ᤤ,n8BOpFxa%~J9n#. -(,Q–'~HUTOqa?ef+lK+Hp߉S} | bl P2X͔pݓfN &*wHŎ3d@u]4 SW`7A}硋C)ȍm8XU*'JA]NN0`g*7s fhx~<ׄd/s$DN Ns+69B J5՞#ȋC,c'w_f|YYνG&4*(^ً6"H n)Hk Q9woÂ4a_)\2H$m_ WB^M9 41k~˰ڜ?G 51 }hC Aiೖhvt7cXXGJrPp8^&V}HXJ1bnc _MjbEU=f;oCTrrݖ|P MvK 8.]G nZJթ* αvn dC~R-ge%mYBqc6 @'e.3oFtz>C:pni^#j4C} PtEˠh@Z_rȼp-ɇ!ˉreg{Fr2 =leRvmm޻Ι^vEz( R=BZ!AOְJo]|:t9AFEN7, C3]SO?KR]oWqF=B .'sW!xF`Hӌ&KՏxӳsW3Я}c5h ES2U|k| p[;[`wT9n,1t6ITDy 6 %kwPGzgM=*ͱn.,[CLD*ۍ CQcApR.7ndڜwO@I?, W6]B42XӭR /%(/ O:-k߃_B~q͔n]KғIČzǔS<oU1n!V rT^[NM~[BROU =g/YG6ѫzɎ-Cz<{xFV5Ȏj5 zw~֝z|uQujj;/b(p^YTI19$N{ EIwl.-6!f9^ZӸIRA^VV// ҈H]tj$KTbR) Ts3kmrv9WxuH|Lr%0IMYQd!U{7zuL'TH2ܲr{/6nJX8P=T?@cwi|=aLS?V}}×,Aj8`Jp{C bkE1Oq&v E! 8s5eJiRv/pJE_75:^7f:V0XC>vFJL>330c;8 =!B3B]CĚN^~P`ͪ eY9 i^P.|o[Ҏ3e\#z .c qbQZ\EC3mr_䍄Ɔm$!xP`qпq¡;)xPOէaFC8[VY'8:2]VW~מ`Ix4/O7Q\LMޣXwpe'T瀛b[SlVF,H3L 3e5tWji}3+81:XB 2\m=n(ƈ䶅% X!ɛuB %L1Үs&:ي"-a.2 v12h&K,G ]BoGHMJfohǽo1eݴlwy:#NE}Hq[r3WtwA8 jW7'.i: ;'"ENu9&&a :omԏ4Pgi{Imp>%ᵽJ &s؇9b KG4dTu9 N|r索S»@I6Zӌ=/ ލzFcq~GZ~tViͥx,EॐÖ5 t-R>d qs+Ha^~ݑR\*aOK5nW1&4wV7Z飛~6Uxx+Pa*}3$u\#⏊l]w7*+R#Z26.\$Bd<)n5U<ɼTkIq\n]{FU(p.G]a):=,}5>땖@ \4QCTԤwAqn;:7;--R]~#,ER]|Uq!.LzTda;M?aؖf̲tjC=~b6b٥?DX/3f bk#mZДL[8 B6lemv|UNיn|28N^v<0!9/ȤaǺ9>Ө@BhnQ:>r6Y-MKRyj\j# җ5Ͳ${iu˫_eH>AxiM[#ڍԐĩA+; hn^ekK $U_ gI)h:xy<{pmOm!a_dA2,[7EU}VVF J#ƎhYp͞zruJ" rIi5rߣqΞSLˏ= ?.gG.\c_MHWn7jkxRaVbvx vJ7)Ϫ Wێçsu1z2_wI~ :?gR G|jK =UD<.Å$4g1IJM͓jK95*@fzXjOJ›^ w6k$axf ll Ɵ&^S2e'ULGn@ׇbbFV@9q;@y>PhcAkM:1&UɃCB_#)gUK]6!/9 84ml'Ϊu`T`hN/KL4rP1BjkCʥ#/s^?+ں E( ^ϛ/.u$0 D"DhwE"45N~eI$pYשqYk8,Y>q]ˡ."jL50>q(WثDbq 6OA B(AMPmZ\*ָbzf-p_d=(ʧ1ރZP2|:Khܼޞ]T27F y{tHxׇݩiUK2 iT^b1|b~, Na6RIѥг@-kV12eFђπ,rycߢ+Oqyx~ZWl/< ٍd|:XE/vM"ZRO!ˑXg:_۶,p1S:kRŖvpx'.m4VksG:~#kzA%|@!R zR-3+wvIqHיJȽu$ap֟1 9CGYoΒV} sr9}7:œ.Xͤ( BHrhf#oy#!G|w5S1deR 1))jwg 0hD{2ciU(׆KHg$A)'T@S$j]f5\dҍ u7'>!a'D>&+7nȗm8KG GbEQTA;2GuPˢd $(z  RS(J KBYh tү3}ҫ@R (rȺϝcFG) j]0m 5$EH%kjZ1{/JMԞRe-8 ni6[-_{ W͏iYXᗺVH8+ P;qfJ2>y MA4KsI$G.h%Ge~D@Ǹ&O-gABaϊ`GS8ou6.ϑܒD0-meN _T&Ξ7^Me*F/HElWew{f#5f|Ȩd8M`RzBfx17(;8i+|h7IO|1 ä"MqPh u.(}A nJwuR&`jdwyūŰ;3pDSadpK{sHӱow}+Gz!r!LHbiK tnk.CmŴ V>ihP?I&7jkQ`czdz?/3X'3jڍ)ō6 U#nw&.-9H}93HpBz *I- &b},BQ4W }38C%w 6xuzj> 7b./R.}ȊVRqu&a*"fkyf>2 ,PV i;KwK~O;yQ]d=*ELF7ad ki~͛*/AmQoE*Qә;]VzJ|^Ļ疂)R/rvJ5!KT3LҾ`X]:lB}FZv0RoҚC2D7`2..*ا">:"!0*bR7f0N0 ʋ =TR]vZm\NNBQ)D/֥ܘVE穐yD RW+yu[XŽkaPq:a8 ߂/7ɭ(S]R*Ѩ=d9Ta 0$ře%Q=(- |YSJ˜iah|^l:wJ͔Ml2эݔ$ Szg1uW)$J@`3:p:7G&L;=[xMF;^Ls1 5s'K1lv!>3׌m^'Z{Xy+ƇF J)\ ^z~W O1Sb'_=/vki nid 6xN (\n]o%VVCnTA}!((je" ՈK:Ċs~vpCBM92N4^=RŻ+taItS'\ѡ/w:Nc;++ -um}A'Kv'`V&l 2?&<ʯ$JUxX nw^s}FlhF7;~ @Ъ=s]bW5$ !X^$vi.{{Ǹ#-vIX MW[b0b/У)>}=G &3>Pwy9ɾs'ğn,gcNSbHrb+dsԆɆ?8I :vo҃Ox*aglHwow9R, 'S2sEzeugͨz$BQ[aisġ)o7(C w9 Ɂq+WmSJ<&S;D-Ӊ0 GKEM]]-wѰ*0!^Iݙ6$F{z. &[+-7LSBٖ=HZɰeZE3wǝ$/f*M75J񖔐(7WNa:u~*hHM?a ^5'/͡ ͸?Is ۈ`p2$#=B|Bأx'A``]sE)B;J>cTis5$3N5꨺6p B##t ٱЕiue?VݪMr}@Ne&3LE\%׿Z9>QI+`c-i S9|~pw^&Uffkقh$Ŷŷ,EGȇhv?㣻ZCBɄ1'~ʡ6:GI)UqtHEAg/fT w|!ܧjx$J%J=TqΚi 8N(`Qi/ ~Z .^;I6 ej6E\KipJlKM/lڅzĈ JC֢#c}7 h~A4UTό8";*6\7ӢQq%}*7?ng^Ƹã ߠnY;6,g8]rfȇWv +h3 8l&J' &DS,FWf3'y 9xEu'/끿\S,E<IJW􈚺&.rO6I,W aQv\x>8v1V6YB  $sOBh?%*#BR`PoFŞ4s Ц3^]t5K^CKơ .W0Нp\Crvlf]f! zr Tx8*G&T] tb"q.A?+dAHOq\aj4~)hšKJbQ2|k11em#Ta]ib_!Q(S;&Lݍ@HuUVpOȣ쁮ˑ <fpݤ`vHxLv(ߝ e@>Oz؞-v:]]#QO4x2DV97h?d^8rr^iP 9+!UxJLy=LBG h]菻 /FHv_F,GN q=.bj?Օd;Dje9 Ώը'ePҮ["#.S4W-߯S-3b'.%\lqNJ4}Vz?IJ꓃5B}zviҠ ' ,"Y嫍V>>Dd1\bNR?|&FꓨbptI__P"լizS]Ew~YU3)2ϟ9 PlYc:mn8!>h?x:a[~h^kS6"^Uy~UƸ/[1RqؑcpWnkwŕb;,dCs?BEN U&3ٯʱyMa[ffSi"6$>& `8 N9듻q>jm9ZIkA?q\vpkƒ &7هdJ 7~MňʐZd]l@]V|14H ':$D?b_ra^P`wPw 9_^|CIhiPKpY>!R5+76ţdGR!4qCzEڪqhA'W@-CJZ,y g^COl]19YBiДdʋ?P}HC?d$]搬V“&O*hXf /BA1blaWD-#URzċ[D,Ӧ-+b|[!y""%=2JZ ޮVZE}t;y:Skx]=szeX}!z7}VQ)ކy 8C .;Lۢ'/';iǨNOtXԟ.8%RL!]:wa~.㺰Gx;v&xi;xmgvsw.-G~B%3U ]17=t<$/ κzo؎NrdWjE1&h=anprݽ?ektrWE%Ӂ]t#mdUFԠoW)ʻ] pIwfDV?nM+y}pC!aG%:F˶36BVdL5zg-Q\eਚj[|䇎mH&ɗ Nc;L]S.O\u0uxy_r+e,2߂xN͠um+5*.Lco^nVK.wE6p`~cOCWYCiuNћQVh*D*tL-|c_{Ėeiți=` qtYoxJH4Yj=wFk" rYrKṺxs׍>fu0u-?Zh;2fVMG} w˟ *(QnK+}Ab(MlLzT7VT=M ^;I 6~c2bGp$Vkx2n}!.q]dݚz"&WKkٍ2u T?tGlazC$Ly&1mO0˶bn/VT '>x=J!hJ[R<+scLť'g@W~ׂ4J-aHzI2J2uXש_E1+5.n@.ÆDR+@Z}Mw m"#uF5D9Ӱ; >x.q Vf TτUXyO>o=)-Fb Qb5^b^AQ6T~mQ'9_uq&NR\T1_KěpSXH0T\-Z0PKC2/pO ^?\`IM]E8D|]MvcF1Ę6dccP6dF>Fi`.* *ט-ym{=ha<ۯRZƴ졯ETv /ӱ6m߼ldV襷sEѼ4OE 9 VZPTuY3mS zFN67W#c:X,$Ή5lbU=,/kM2LjWViViXE`T}ɹKw}107\tVR`p?|{i"==ZGGiN91]];s&[`wW껜"n^CY ]VQ?JZg10zaw4-r.um;`;PTaj ߡ@TiC0 1H˥$FyAhj껦hݿ_1$JŠ3xT8[^8CY׉(/oJy{c V5/Bjn>W5u>smǐsrxIy -A$%>Ɋ|\ѫE$fޑ<^ы\Eg_?6!|&/Wkd1QMqx!Bu7A|3<ScL2_mWnrOz)fx{dU \ќ 7F+w؇QTj]QTL4j $1=0Gݽtyӑ5& endstream endobj 52 0 obj << /Length1 1481 /Length2 2045 /Length3 0 /Length 2977 /Filter /FlateDecode >> stream xڍT 8Tk~ *. "˸Ai;cobHDJJEA%::%krRĔߤ??<{Z]k}ֻUWou6a^!0sv&SC (8UUgXq Ff#s^` `a~|& |;ő8UfseB: ALރ3APb=E%# B`.7*DZ 2S yʍq ClPH- X0S U͟$lȀ4m EA#&ӭ̝5g( X ):JzTcpne3g#}a3 hQl!$*=SOU,\tq/ A`,`ʰC1} ?C>bBߟ[ L!&"a|V #VO}o6D)I}SذC;#L5%= U0x۸0q~^) ah!0g'DF[uOj&YJh_~:Sp"hj[v)0RtH$Vwy(6)?:$&[Жz&MDCgK`eͦjNΕAa:o_N68$+oqxI/SL+B3բ uTbF'v\hDMbGViS|bG65{ׂ @/wY lOڤ?J Nmsss&0"vέ?MVrܵ~:x[RoPuDz_GlO='hDn5RlPrFY --`aᦌOX%(s&RjT(zvK7T_w(a;=3J2+U6$[7Eӛ46],vO'6b,r(jf[BǵާA^ ?Md(KA=9s;󕯏9*{}F7xck c9/}'s$=s baWin]YpR][gZ/I.p3QRb.<%8,7O] sCO(E˪gl;q1syJRRGDI;es$ߜ*nx2+4r5r<"εI{*iʋ;G\4쫥|p1+?y,:,!0b#]> endobj 2 0 obj << /Type /ObjStm /N 45 /First 335 /Length 2255 /Filter /FlateDecode >> stream xY[s~GrNsڪ\P xHtp%p~zF%/yи5=uO#`i3y%IL 4SưTPLif4-Z ceL)=s&fLZIi2i"oEH1M,P@L b}^1cQA:L2hfDiLHZ0Y,l&(B̘˜4̩E `*$r$sہ_@?ZX 8c^`xOg3Ə٣l:{:/'^ｇ?)_|/~4ŴXF|~^T|\TpL8-p3Xza)sL'cQVDgd\;tG\6 ;\'0'pN65XkBxDS%-K '5"&:㉄fz>'__kZwqVR?FX[=}5mTȭoH! bkRCji졏jHmjM= @UupA Gf#tq8lI׌7}qn#];a-$ćG RI6O Œ1Cӡ zzZF&5wbmM$:ﭖ$ !,;mPԦQJ;M6:PE`V28>kxQBCI2A4zc+E&;H+#mkZQ|yҬ r]')͟x412^j+YT?ꇐu ke51UMKqFQFހQx!*:=|'&ML8G}|^+|kIVÉ 'ރjL'^(V7x "u>)ӛIĀ L 2n9Qcx |lZ9xVvRBv =={zqCϥt>?S?N6S˶0%%|<̦hr~ 4$9o-v[L2@&ŧ:Q8[U|k^΋_7b>vO[2P¯n)?ys-p8 >FƋ뫷'  ,3z&{0v Vm0.*}G\ɾ-LN4;%˧^ֹ-4۬zmvJTg'`Gl¡cRJ^J~ 5)?CIx6Bd_+v^r\Nj sQǔ) l2zR'٫,$n{e1.x6/[n;'ϞΒTI>Myn/6716O&vKN:R'U8u ?'弪i ^ 2̀-ۊuYypӝmmJt+ ݦ[uO붡_6Ҟja6*쮺_z7bMu۵zwսӜf9]q?w5ۍ8nKk~)4)m7=FE uI WzRNiNTɚR0W֔kj.>l')QCxTzi-Pr177g":}՘_weS[߭w;ʑg7fҢ_VW f3#K endstream endobj 59 0 obj << /Type /XRef /Index [0 60] /Size 60 /W [1 3 1] /Root 57 0 R /Info 58 0 R /ID [<2B4C1C4A33D6D2E02EC65EF4C8DDE509> <2B4C1C4A33D6D2E02EC65EF4C8DDE509>] /Length 169 /Filter /FlateDecode >> stream x%MNk ʅH[Ö#2.$+;nY$)*Du Yc%#<@3xZizЇ#1pp02v/+jl},.wQWV?wmwQ7vDMjxs %G endstream endobj startxref 98650 %%EOF rngtools/tests/0000755000175100001440000000000012221274631013301 5ustar hornikusersrngtools/tests/doRUnit.R0000645000175100001440000000032412221274631015010 0ustar hornikusers# Run all unit tests in installed directory unitTests # # Author: Renaud Gaujoux ############################################################################### pkgmaker::utest('package:rngtools', quiet=FALSE) rngtools/NAMESPACE0000645000175100001440000000057312221274631013364 0ustar hornikusersexport(.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) rngtools/R/0000755000175100001440000000000012221274631012340 5ustar hornikusersrngtools/R/rngtools-package.r0000645000175100001440000000226212221274631015766 0ustar hornikusers#' 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 rngtools/R/format.R0000645000175100001440000001264212221274631013761 0ustar hornikusers# 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), ...) } rngtools/R/RNGseq.R0000645000175100001440000001574312221274631013635 0ustar hornikusers# 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 } rngtools/R/RNG.R0000645000175100001440000004547212221274631013126 0ustar hornikusers# 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)) } rngtools/vignettes/0000755000175100001440000000000012306071757014157 5ustar hornikusersrngtools/vignettes/rngtools-unitTests.Rnw0000644000175100001440000000524312306071301020503 0ustar hornikusers \documentclass[10pt]{article} %\VignetteDepends{knitr} %\VignetteIndexEntry{rngtools-unitTests} %\VignetteCompiler{knitr} %\VignetteEngine{knitr::knitr} \usepackage{vmargin} \setmargrb{0.75in}{0.75in}{0.75in}{0.75in} <>= 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} rngtools/README.md0000645000175100001440000000066212221273356013426 0ustar hornikusersrngtools ======== 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. rngtools/MD50000644000175100001440000000226112306163023012444 0ustar hornikusers2f38fe52d9b165b47c771ac2b0da0fbd *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 rngtools/build/0000755000175100001440000000000012306071757013246 5ustar hornikusersrngtools/build/vignette.rds0000644000175100001440000000032112306071757015601 0ustar hornikusersb```b`f@&0`b fd`abEy%9źy%!%zAyh0UaNAJ*l' V5 Y0/17nvԂԼ?4 iN,/AQU▙ 7$apq2݀a>9`~OMI,F(WJbI^ZP?nQrngtools/DESCRIPTION0000644000175100001440000000174712306163022013651 0ustar hornikusersPackage: rngtools Maintainer: Renaud Gaujoux 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 rngtools/man/0000755000175100001440000000000012221274631012712 5ustar hornikusersrngtools/man/RNGseed.Rd0000645000175100001440000000235512221274631014476 0ustar hornikusers\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)) } } rngtools/man/rngcmp.Rd0000645000175100001440000000133212221274631014467 0ustar hornikusers\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}. } rngtools/man/rng.Rd0000645000175100001440000001615212221274631013775 0ustar hornikusers\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} rngtools/man/RNGseq.Rd0000645000175100001440000000472512221274631014351 0ustar hornikusers\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}} } rngtools/man/RNGstr.Rd0000645000175100001440000000634512221274631014371 0ustar hornikusers\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) } rngtools/man/uchecks.Rd0000645000175100001440000000104612221274631014630 0ustar hornikusers\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) ) } rngtools/man/rngtools.Rd0000645000175100001440000000204112221274631015046 0ustar hornikusers\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() }