tests/varlist.R

In simsalapar: Tools for Simulation Studies in Parallel

require("simsalapar")

## as long as R <= 3.0.1 is possible:
source(system.file("xtraR/assertErr-etc.R", package="simsalapar", mustWork=TRUE))

vli <- varlist(
    ## replications
    ## suposed to be 500, choosen 2 here for performance purposes
    n.sim=list(expr=quote(N[sim]),type="N", value=1),
    ## sample size
    n = list(type="grid", value = c(50,100)),
    ## Beta
    beta = list(type="grid",value=list(beta1=0:1, beta2=c(3,5), beta3=c(1,10))),
    # Method
    method = list(type="grid",value=list(g1= function(x,y) x+y)),
    # formula
    formula = list(type="frozen", value= y~x.1+x.2+x.3+x.4+x.5),
    ## outlier locations
    kstep = list(type="inner",value=seq(0,100,by=20))
    )
vl <- vli
vl $ kstep $type <- "grid"

ws <- warnings()
##-> Warning should end in " :..method"
stopifnot(inherits(ws, "warnings"),
	  grepl("method", sub(".*:", "",
			      names(ws)[[1]])))## wrongly had "beta"

## now works without error:
toLatex(vl, label = "tab:var", caption = "varlist 'vl' - regression")
## TODO MM: 1) formula  2) extra "," in  "function (x, y) , x + y"


doNil <- function(...) rpois(3, lambda=10)

doNamed <- function(...) setNames(rpois(4, lambda=10), LETTERS[1:4])

doMatr	 <- function(...) matrix(rpois(6, lambda=10), 2,3)
doMat.wrong <- function(n, method, beta, kstep, formula)
    matrix(rpois(6, lambda=10), length(kstep), 11)
doMat.i	 <- function(n, method, beta, kstep, formula)
    matrix(rpois(6, lambda=10), 11, length(kstep))

doMat.n <- function(...)
    matrix(rpois(6, lambda=10), 2,3,
	   dimnames=list(paste0("r", 1:2), paste0("C.",1:3)))
doMat.in <- function(n, method, beta, kstep, formula) {
    nr <- length(kstep)
    matrix(rpois(6, lambda=10), 2, nr,
	   dimnames=list(paste0("r", 1:2), paste0("C.",1:nr)))
}

doArr1 <- function(...) array(rpois(7, lambda=10), 7)
doArr1n <- function(...) array(rpois(7, lambda=10), 7, dimnames=list(letters[1:7]))
doArr1.i <- function(n, method, beta, kstep, formula) {
    n <- length(kstep); array(rpois(n, lambda=10), n) }
doArr3n <- function(...)
  array(rpois(24, lambda=10), c(3,4,2), dimnames=
	list(letters[1:3],paste0("d",1:4), paste0("D",1:2)))

doArr3 <- function(...) array(rpois(24, lambda=10), c(3,4,2))
doArr3.n <- function(...)
    array(rpois(30, lambda=10), c(3,5,2), dimnames=
	  list(letters[1:3],NULL, paste0("D",1:2)))
doArr3.i <- function(n, method, beta, kstep, formula)  {
    n <- length(kstep)
    array(rpois(2*4*n, lambda=10), c(2,4,n)) }

##' basic structural check or do*Apply() result 'array-list' {as made by mkAL() }
chkArray <- function(res) {
    stopifnot(is.list(res), !is.null(d <- dim(res)), prod(d) == length(res))
    v1 <- res[[1]]$value

    val   <- getArray(res) # array of values
    err   <- getArray(res, "error") # array of error indicators
    pwarn <- getArray(res, "warning") # array of warning indicators
    time  <- getArray(res, "time") # array of user times in ms
    Dim <- function(x) if(is.null(d <- dim(x))) length(x) else d
    stopifnot(is.numeric(val),
	      all.equal(c(Dim(v1), dim(err)), dim(val), tol=0),
	      identical(dim(err), dim(pwarn)),
	      identical(dim(err), dim(time)))
}

###--------- n.sim missing ( = 1 ) : -----------------------------------------

## 1. "Nil": unnamed vector ------------------------------
chkArray(ra1   <- doLapply(vl, seed="seq", sfile=NULL, doOne= doNil))
## 2. "Named": *named* vector ------------------------------ had bug
chkArray(raN   <- doLapply(vl, seed="seq", sfile=NULL, doOne= doNamed))
## 3. Arrays (including matrices)
##   1D
chkArray(raA1  <- doLapply(vl, seed="seq", sfile=NULL, doOne= doArr1))
chkArray(raA1n <- doLapply(vl, seed="seq", sfile=NULL, doOne= doArr1n))
chkArray(raA1.i<- doLapply(vli,seed="seq", sfile=NULL, doOne= doArr1.i))
##   2D
chkArray(raM   <- doLapply(vl, seed="seq", sfile=NULL, doOne= doMatr))
chkArray(raM.  <- doLapply(vl, seed="seq", sfile=NULL, doOne= doMat.n))
assertError(doLapply(vli,seed="seq", sfile=NULL, doOne= doMat.wrong))
chkArray(raM.i <- doLapply(vli,seed="seq", sfile=NULL, doOne= doMat.i))
chkArray(raMin <- doLapply(vli,seed="seq", sfile=NULL, doOne= doMat.in))

##   3D
chkArray(raA3  <- doLapply(vl, seed="seq", sfile=NULL, doOne= doArr3))
chkArray(raA3n <- doLapply(vl, seed="seq", sfile=NULL, doOne= doArr3n))
chkArray(raA3n.<- doLapply(vl, seed="seq", sfile=NULL, doOne= doArr3.n))
chkArray(raA3.i<- doLapply(vli,seed="seq", sfile=NULL, doOne= doArr3.i))

###--------- n.sim = 3 : -----------------------------------------
vl3 <- set.n.sim(vl, 3)

## 1. "Nil": unnamed vector ------------------------------
chkArray(sa1   <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doNil))
## 2. "Named": *named* vector ------------------------------ had bug
chkArray(saN   <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doNamed))
## 3. Arrays (including matrices)
##   1D
chkArray(saA1  <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doArr1))
chkArray(saA1n <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doArr1n))
##   2D
chkArray(saM   <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doMatr))
chkArray(saM.  <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doMat.n))
##   3D
chkArray(saA3  <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doArr3))
chkArray(saA3n <- doLapply(vl3, seed="seq", sfile=NULL, doOne= doArr3n))
chkArray(saA3n.<- doLapply(vl3, seed="seq", sfile=NULL, doOne= doArr3.n))