Nothing
#############################################################################
## ##
## Test routines used for all rstream classes ##
## ##
#############################################################################
## Remark -------------------------------------------------------------------
## This file only defines test routines but does not execute any test.
## It should be loaded by the test files:
## source ("test_routines.R")
## The default test parameters can be overwritten.
## Test Parameters ----------------------------------------------------------
## API
if (!exists("samplesize")) samplesize <- 1e4
if (!exists("streamname")) streamname <- "testname"
## Goodness-of-Fit tests
if (!exists("chi2.samplesize")) chi2.samplesize <- 1e6
if (!exists("alpha")) alpha <- 1.e-3
## Load library -------------------------------------------------------------
library(rstream)
## Test API of package ------------------------------------------------------
rstream.check.API <- function (
type, # type (class) of stream
..., # optional args for new(...)
t_sample=TRUE,
t_reset=TRUE,
t_clone=TRUE,
t_pack=TRUE,
t_name=TRUE,
t_anti=TRUE,
t_incp=TRUE,
t_print=TRUE ) {
## Create a stream ..................................................
s <- new (type, name=streamname, ...)
## Print ............................................................
print(s)
## Sample ...........................................................
x <- rstream.sample(s,samplesize)
if (length(x) != samplesize)
stop("sample.rstream failed:1")
## Reset ............................................................
rstream.reset(s)
y <- rstream.sample(s,samplesize)
if (!identical(all.equal(x, y), TRUE))
stop("reset failed:1")
## Sample: r ........................................................
rstream.reset(s)
y <- r(s,samplesize)
if (!identical(all.equal(x, y), TRUE))
stop("r failed:1")
## Name ............................................................
if (streamname != rstream.name(s))
stop("name failed:1")
xyzname <- paste("xyz","streamname",sep="")
rstream.name(s) <- xyzname
if (xyzname != rstream.name(s))
stop("name failed:2")
rstream.name(s) <- streamname ## restore stream
## Antithetic variables .............................................
rstream.reset(s)
state <- store_state(s)
if(rstream.antithetic(s))
stop("antithetic must be FALSE at default:1")
rstream.reset(s)
rstream.antithetic(s) <- TRUE
if(!rstream.antithetic(s))
stop("antithetic must be TRUE now:2")
if(!comp_states(state, store_state(s), anti=TRUE))
stop("antithetic failed:3")
rstream.reset(s)
rstream.antithetic(s) <- FALSE
if(rstream.antithetic(s))
stop("antithetic must be FALSE now:4")
if(!comp_states(state, store_state(s)))
stop("antithetic failed:5")
## from now on rstream.antithetic(s) == TRUE
rstream.antithetic(s) <- TRUE
rstream.reset(s)
state <- store_state(s)
## Incprecision .....................................................
if(rstream.incprecision(s))
stop("incprecision must be FALSE at default:1")
if (t_incp) {
rstream.incprecision(s) <- TRUE
if(!rstream.incprecision(s))
stop("incprecision must be TRUE now:2")
rstream.incprecision(s) <- FALSE
if(rstream.incprecision(s))
stop("incprecision must be FALSE now:3")
rstream.reset(s)
if(!comp_states(state, store_state(s)))
stop("incprecision failed:4") }
## Clone ............................................................
rstream.reset(s)
clone <- rstream.clone(s)
if (rstream.name(clone) != paste(streamname,".",sep=""))
stop("name of clone failed:1")
if(!comp_states(state, store_state(clone),clone=TRUE))
stop("cloning failed:2")
rstream.reset(s)
rstream.reset(clone)
rstream.sample(clone,1)
rstream.antithetic(clone) <- FALSE
if (t_incp) rstream.incprecision(clone) <- TRUE
if(!comp_states(state, store_state(s)))
stop("cloned object not independent:3")
## Pack/unpack ......................................................
rstream.reset(s)
rstream.packed(s)
if(rstream.packed(s))
stop("packed must be FALSE at default:1")
rstream.packed(s) <- TRUE
print(s)
if(!rstream.packed(s))
stop("packed must be TRUE now:2")
dup <- s
rstream.packed(s) <- FALSE
if(!comp_states(state, store_state(s)))
stop("packing failed:3")
rstream.packed(dup) <- FALSE
if(!comp_states(state, store_state(dup)))
stop("packing failed:4")
## "<-" .............................................................
copy <- s
rstream.reset(copy)
if(!comp_states(state, store_state(copy)))
stop("\"<-\" failed:1")
rstream.reset(s)
rstream.name(copy) <- "karl"
rstream.antithetic(copy) <- FALSE
if (t_incp) rstream.incprecision(copy) <- TRUE
if(comp_states(state, store_state(s)))
stop("\"<-\" failed:2")
rstream.reset(copy)
state1 <- store_state(s)
rstream.reset(copy)
if(!comp_states(state1, store_state(s)))
stop("\"<-\" failed:3")
}
## Test interface rstream <-> R RNG -----------------------------------------
rstream.check.setRNG <- function (
type, # type (class) of stream
...) { # optional args for new(...)
## Create a stream ..................................................
s <- new (type, name=streamname, ...)
## make a working copy
sc <- rstream.clone(s)
## set RNG
rstream.RNG(s)
## s und runif() should produce the same sequence
x <- rstream.sample(sc, samplesize)
y <- runif(samplesize)
if (!identical(all.equal(x, y), TRUE))
stop("set RNG failed: 1")
## try again
## (required as we had a bug in all pre-1.3 versions!)
rstream.RNG(s)
y <- runif(samplesize)
if (!identical(all.equal(x, y), TRUE))
stop("set RNG failed: 2")
## get RNG
sr <- rstream.RNG()
x <- rstream.sample(sr, samplesize)
rstream.antithetic(sr) <- TRUE # this must not influence runif()
y <- runif(samplesize)
if (!identical(all.equal(x, y), TRUE))
stop("set RNG failed: 3")
}
## Store state of generator in list -----------------------------------------
store_state <- function(stream) {
## make empty list
state <- list()
## store data about stream
state$name <- rstream.name(stream)
state$anti <- rstream.antithetic(stream)
state$incp <- rstream.incprecision(stream)
## for getting information about the internal state we use a sample
## (we cannot store these data directly since the structure of
## generators is too different).
## Moreover, we also want to check whether the generator works
## correctly
state$samp <- rstream.sample(stream, samplesize)
## return state
state
} # end of store_state()
## Compare state of generator (stored in list) ------------------------------
comp_states <- function(stateA, stateB, anti=FALSE, clone=FALSE) {
## if 'anti' is TRUE then the antithetic flags in stateA and stateB
## must be different. Otherwise they must coincide.
if (anti) {
stateB$anti <- !stateB$anti
stateB$samp <- (1 - stateB$samp) }
## if 'clone' is TRUE then we must add a period '.' to the name.
if (clone)
stateA$name <- paste(stateA$name,".",sep="")
## return result (TRUE if equal, FALSE if they differ)
return (identical(all.equal(stateA, stateB), TRUE))
} # end of comp_states()
## --- Function for running chi^2 goodness-of-fit test ----------------------
rstream.check.chi2 <- function (type, ...) {
## Run a chi^2 test and evaluate p-value.
##
## type ... type (class) of stream
## ... ... optional args for new(...)
##
for (i in 1:2) {
## -- run test
pval <- rstream.check.chi2.run(type, ...)
## -- check p-value
if (pval > alpha) { # test passed
message("Chi2 test PASSed with p-value=",signif(pval))
break
}
else {
if (i<1.5)
warning("Chi2 test failed once with p-value=",signif(pval)," --> Try again")
else
stop("chi2 test FAILED! p-value=",signif(pval), call.=FALSE)
}
}
} ## --- end of rstream.check.chi2() ---
## ..........................................................................
rstream.check.chi2.run <- function (type, ...) {
## Run a chi^2 test and evaluate p-value.
##
## type ... type (class) of stream
## ... ... optional args for new(...)
##
## -- Create a stream
s <- new (type, ...)
print(s)
## -- Draw sample
u <- rstream.sample(s,chi2.samplesize)
if (length(u) != chi2.samplesize)
stop("chi2: sample.rstream failed")
## -- make histogram of with equalsized bins (classified data)
nbins <- as.integer(sqrt(chi2.samplesize))
breaks <- (0:nbins)/nbins
h <- hist(u,plot=F,breaks=breaks)$count
## -- run unur.chiq.test
pval <- chisq.test(h)$p.value
## -- return p-value
pval
} ## --- end of rstream.check.chi2.run() ---
#############################################################################
## #
## Auxiliary routines #
## #
#############################################################################
## Test whether there is an error -------------------------------------------
iserror <- function (expr) { is(try(expr), "try-error") }
## -- End -------------------------------------------------------------------
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.