1# Unit test for getRNG 2# 3# Author: Renaud Gaujoux 4############################################################################### 5 6context("Get/Set RNG") 7 8test_that('getRNG', { 9 10 RNGkind_default() 11 on.exit( RNGrecovery() ) 12 13 checker <- function(x, y, ..., msg=NULL, drawRNG=TRUE){ 14 15 if( drawRNG ) runif(10) 16 fn <- getRNG 17 oldRNG <- RNGseed() 18 if( !missing(x) ){ 19 d <- fn(x, ...) 20 cl <- paste0(class(x), '(', length(x), ')') 21 }else{ 22 d <- fn() 23 cl <- 'MISSING' 24 } 25 newRNG <- RNGseed() 26 .msg <- function(x) paste(cl, ':', x, '[', msg, ']') 27 expect_identical(oldRNG, newRNG, .msg("does not change RNG")) 28 expect_identical(d, y, .msg("result is correct") ) 29 } 30 31 set.seed(123456) 32 seed123456 <- .Random.seed 33 checker(, seed123456, msg="No arguments: returns .Random.seed", drawRNG=FALSE) 34 checker(123456, seed123456, msg="Single numeric argument: returns .Random.seed as it would be after setting the seed") 35 checker(123456, 123456, num.ok=TRUE, msg="Single numeric argument + num.ok: returns argument unchanged") 36 checker(.Random.seed, .Random.seed, msg="Integer seed argument: returns its argument unchanged") 37 checker(as.numeric(.Random.seed), .Random.seed, msg="Numeric seed argument: returns its argument as an integer vector") 38 checker(2:3, 2:3, msg="Integer INVALID seed vector argument: returns its argument unchanged") 39 checker(c(2,3), c(2L,3L), msg="Numeric INVALID seed vector argument: returns its argument as an integer vector") 40 checker(1L, 1L, msg="Single integer = Encoded RNG kind: returns it unchanged") 41 checker(1000L, 1000L, msg="Invalid single integer = Encoded RNG kind: returns it unchanged") 42 43}) 44 45test_that('setRNG', { 46 47 RNGkind_default() 48 on.exit( RNGrecovery() ) 49 50 checker <- function(x, y, tset, drawRNG=TRUE){ 51 52 on.exit( RNGrecovery() ) 53 54 if( drawRNG ) runif(10) 55 oldRNG <- RNGseed() 56 d <- force(x) 57 newRNG <- RNGseed() 58 59 msg <- function(x, ...) paste(tset, ':', ...) 60 expect_true(!identical(oldRNG, newRNG), msg("changes RNG")) 61 expect_identical(getRNG(), y, msg("RNG is correctly set") ) 62 expect_identical(d, oldRNG, msg("returns old RNG") ) 63 } 64 65 set.seed(123456) 66 refseed <- .Random.seed 67 checker(setRNG(123456), refseed, "Single numeric: sets current RNG with seed") 68 69 # setting kind with a character string 70 set.seed(123) 71 RNGkind('Mar') 72 refseed <- .Random.seed 73 RNGrecovery() 74 set.seed(123) 75 checker(setRNG('Mar'), refseed, "Single character: change RNG kind", drawRNG=FALSE) 76 77 # setting kind with a character string 78 set.seed(123) 79 RNGkind('Mar', 'Ahrens') 80 refseed <- .Random.seed 81 RNGrecovery() 82 set.seed(123) 83 checker(setRNG('Mar', 'Ahrens'), refseed, "Two character strings: change RNG kind and normal kind", drawRNG=FALSE) 84 RNGrecovery() 85 set.seed(123) 86 checker(setRNG(c('Mar', 'Ahrens')), refseed, "2-long character vector: change RNG kind and normal kind", drawRNG=FALSE) 87 88 # setting kind 89 set.seed(123456, kind='Mar') 90 refseed <- .Random.seed 91 checker(setRNG(123456, kind='Mar'), refseed, "Single numeric + kind: change RNG kind + set seed") 92 93 # setting Nkind 94 set.seed(123456, normal.kind='Ahrens') 95 refseed <- .Random.seed 96 checker(setRNG(123456, normal.kind='Ahrens'), refseed 97 , "Single numeric + normal.kind: change RNG normal kind + set seed") 98 99 # setting kind and Nkind 100 set.seed(123456, kind='Mar', normal.kind='Ahrens') 101 refseed <- .Random.seed 102 checker(setRNG(123456, kind='Mar', normal.kind='Ahrens'), refseed 103 , "Single numeric + kind + normal.kind: change RNG all kinds + set seed") 104 105 # with seed length > 1 106 refseed <- as.integer(c(201, 0, 0)) 107 checker(setRNG(refseed), refseed, "numeric vector: directly set seed") 108 109 refseed <- .Random.seed 110 expect_error( setRNG(2:3), info = "numeric vector: throws an error if invalid value for .Random.seed") 111 expect_identical( .Random.seed, refseed, ".Random.seed is not changed in case of an error in setRNG") 112 113 oldRNG <- getRNG() 114 expect_error(setRNG(1234L), info = "Error with invalid integer seed") 115 expect_identical(oldRNG, getRNG(), "RNG still valid after error") 116 expect_error(setRNG(123L), info = "Error with invalid RNG kind") 117 expect_identical(oldRNG, getRNG(), "RNG still valid after error") 118 119 # changes in R >= 3.0.2: invalid seeds only throw warning 120 if( testRversion('> 3.0.1') ){ 121 oldRNG <- getRNG() 122 expect_warning(setRNG(1234L, check = FALSE), "\\.Random\\.seed.* is not .* valid" 123 , info = "Invalid integer kind: Warning if check = FALSE") 124 expect_identical(oldRNG, getRNG(), "RNG keep old value") 125 RNGrecovery() 126 oldRNG <- getRNG() 127 expect_warning(setRNG(123L, check = FALSE), "\\.Random\\.seed.* is not .* valid" 128 , info = "Invalid kind: Warning if check = FALSE") 129 expect_identical(oldRNG, getRNG(), "RNG keep old value") 130 131 } 132 133}) 134 135