tests/dse2tst4.R

In EvalEst: Dynamic Systems Estimation - Extensions

if(!require("stats"))   stop("this test requires stats.")
if(!require("EvalEst"))  stop("this test requires EvalEst.")
if(!require("setRNG"))stop("this test requires setRNG.")
 #x11()
  outfile <- tempfile("lite.out", tmpdir = tempdir(), fileext = ".ps")
  postscript(file=outfile,  paper="letter", horizontal=FALSE, onefile=TRUE)
             # width=6, height=8, pointsize=10,
   Sys.info()
   DSEversion()
   random.number.test() 




dse4.function.tests <- function(verbose=TRUE, synopsis=TRUE, 
		fuzz.small=1e-14, fuzz.large=1e-7, graphics=TRUE)
{max.error <- 0
 data("eg1.DSE.data.diff", package="dse")
 
 if (synopsis & !verbose) cat("All dse4 tests ...") 
 if (verbose) cat("dse4 test 1 ... ")
  z <- stripMine(eg1.DSE.data.diff, essential.data=c(1,2),
                   estimation.methods=list(estVARXls=list(max.lag=3)))
  ok <- is.forecastCovEstimatorsWRTdata.subsets(z)
  all.ok <-  ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed!\n") }

  if (verbose) cat("dse4 test 2 ... ")
  z1 <- z$multi.model[[
       selectForecastCov(z, select.cov.best=1, verbose=FALSE)$selection.index[2]]]
  subdata <- TSdata(output=outputData(eg1.DSE.data.diff, series=1:3))
  z2 <- estimateModels(subdata, estimation.sample =182, quiet = TRUE, 
           estimation.methods = list(estVARXls=list(max.lag=3)))
  outputData(subdata) <- outputData(subdata)[1:182,,drop=FALSE]
#  inputData(subdata)  <- inputData(subdata) [1:182,,drop=FALSE] not in subdata
  z3 <- estVARXls(subdata, max.lag=3)
  # Had to add fuzz=1e-15 in next two, default =0 no longer worked April 2012 
  # with R-2.15.0 on 32 bit Ubunti (with new BLAS recently installed).
  ok <-      testEqual(z2$multi.model[[1]],z3$model, fuzz=1e-15)
  ok <- ok & testEqual(z2$multi.model[[1]],  z1, fuzz=1e-15)
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed!\n") }

  if (verbose) cat("dse4 test 3 ... ")
  cat("skipping test 4 (requires stepwise).")
  if (FALSE) 
 {
   all.data <- TSdata(input=eg1.DSE.data.diff$output, 
                   output=eg1.DSE.data.diff$input )
   umodel <- build.input.models(all.data, max.lag=2)
   umodel <- build.diagonal.model(umodel)
   z  <- TSdata(output=outputData(all.data), 
                input=inputData(all.data, series=1:2))
	# previously ??input=inputData(extract(all.data, outputs=1, inputs=1:2)))
  ymodel <- estVARXls(z, max.lag=3)$model 
  z <- ymodel$C
  ymodel$C <- array(0, c(dim(z)[1:2], nseriesOutput(umodel))) 
  ymodel$C[1:(dim(z)[1]), 1:(dim(z)[2]), 1:(dim(z)[3])] <- z 
  sim.data <- genMineData(umodel, ymodel,
    rng= list(kind="default",seed=c(21,46,16,12, 51, 2, 31, 8, 42, 60, 7, 3)) )
  m.step <- mineStepwise(sim.data, method="backward", plot.=FALSE)
  error <- max(abs(m.step$stepwise$rss[c(1,27)] -
                c(5.65168201726030333e+01, 3.06441399376576440e+06)))
  # previously  c(47.537312899054931847,   4088283.2706551752053)))
  ok <- fuzz.large > error
  if (!ok) max.error <- max(error, max.error)
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed!\n") }
 }

  if (graphics)
   {ok <- dse4.graphics.tests(verbose=verbose, pause=FALSE)
    all.ok <- all.ok & ok 
   }

  if (synopsis) 
    {if (verbose) cat("All dse4 tests completed")
     if (all.ok) cat(" OK\n")
     else    
       {cat(", some FAILED!")
        if(max.error > fuzz.small)
            cat(" max. error magnitude= ", max.error,")")
        cat("\n")
       }
    }
  if (all.ok) invisible(TRUE)  else stop("FAILED")
}

dse4.graphics.tests <- function(verbose=TRUE, synopsis=TRUE)
{ if (synopsis & !verbose) cat("dse4 graphics tests ...")
  if (verbose) cat("  dse4 graphics test 1 ...")

  # If no device is active then write to postscript file 
  if ( dev.cur() == 1 )
      {postscript(file="zot.postscript.test.ps",width=6,height=6,pointsize=10,
                   onefile=FALSE, print.it=FALSE, append=FALSE)
       on.exit((function()
             {dev.off(); synchronize(1); rm("zot.postscript.test.ps")})())
      }

  z <- stripMine(eg1.DSE.data.diff, essential.data=c(1,2),
                   estimation.methods=list(estVARXls=list(max.lag=3)))
  zz <- tfplot(z)

  if (verbose) cat("ok\n")

  if (synopsis) 
    {if (verbose) cat("All dse4 graphics tests completed\n")
     else cat("completed\n")
    }
      
  invisible(TRUE)
}



   dse4.function.tests(verbose=TRUE, graphics=FALSE) 
   dse4.graphics.tests(verbose=TRUE)  #     test 3 needs stepwise

unlink(outfile)