tests/dse2tst2.R

In dse: Dynamic Systems Estimation (Time Series Package)

  require("stats")
  require("dse") 
 #x11()
  dir <- tempdir()
  postscript(file=paste(dir,"/lite.out.ps", sep=""),  paper="letter",
      horizontal=FALSE, onefile=TRUE)
             # width=6, height=8, pointsize=10,
   Sys.info()
   DSEversion()
   setRNG::random.number.test() 




EvalEst.function.tests <- function(verbose=TRUE, synopsis=TRUE,
    fuzz.small=1e-14, fuzz.large=1e-8, graphics=TRUE)
{max.error <- NA
 data("eg1.DSE.data.diff", package="dse")
 
 if (synopsis & !verbose) cat("All EvalEst tests ...") 
 if (verbose) cat("EvalEst test 0 ... ")
  z <- eg1.DSE.data.diff
  z$input <- NULL
  mod1 <- TSmodel(estVARXar(z, re.add.means=FALSE, warn=FALSE))
  ok <- is.TSmodel(mod1)
  all.ok <- ok 
  if (verbose)  {if (ok) cat("ok\n") else  cat("failed!\n") }

  if (verbose) cat("EvalEst test 1 ... ")
  z <- estBlackBox1(eg1.DSE.data.diff, verbose=FALSE, max.lag=2)
  error <- max(abs(z$estimates$like[1]+4025.943051342767))
  ok <- is.TSestModel(z) &  (fuzz.large > error )
  if (!ok) {if (is.na(max.error)) max.error <- error
            else max.error <- max(error, max.error)}
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed! error = ", error,")\n") }

  if (verbose) cat("EvalEst test 2 ... ")
  z <- estWtVariables(eg1.DSE.data.diff, c(1,10,10),
                        estimation="estVARXls")
  error <- max(abs(z$estimates$like[1]+4125.05572604540066)) 
  ok <- is.TSestModel(z) &   (fuzz.large > error)
  if (!ok) {if (is.na(max.error)) max.error <- error
            else max.error <- max(error, max.error)}
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed! error = ", error,")\n") }

  if (verbose) cat("EvalEst test 3 ... ")
  z <- estSSMittnik(eg1.DSE.data.diff, max.lag=2, n=3)
  error <- max(abs(z$estimates$like[1]+3794.0394069904219))
  ok <- is.SS(z$model) &   (fuzz.large > error )
  if (!ok) {if (is.na(max.error)) max.error <- error
            else max.error <- max(error, max.error)}
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed! error = ", error,")\n") }

  if (verbose) cat("EvalEst test 4 ... ")
  z <- l( MittnikReduction(z, criterion="taic", verbose=FALSE), 
         eg1.DSE.data.diff)
  error <- max(abs(z$estimates$like[1]+3795.6760513068380)) 
  ok <- is.SS(z$model)  &  (fuzz.large > error )
  if (!ok) {if (is.na(max.error)) max.error <- error
            else max.error <- max(error, max.error)}
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed! error = ", error,")\n") }

  modSS<-z

  if (verbose) cat("EvalEst test 5 ... ")
  z <- featherForecasts( modSS,  from.periods=c(250,300))
  error <- max(abs
       (c(z$featherForecasts[[1]][286,],z$featherForecasts[[2]][336,])
       -c(-0.00092229286770808757701, -0.0086020067525247358164, 
           0.0043454851777852505565,  -0.0066741302949233430319,
          -0.0089398331205012854933,   0.0021769124280658046222)))
# 10* for change from svd to La.svd (but values not changed)
  ok <- 10*fuzz.small > error
  if (!ok) {if (is.na(max.error)) max.error <- error
            else max.error <- max(error, max.error)}
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed! error = ", error,")\n") }

  if (verbose) cat("EvalEst test 6 ... ")
  # previously end=c(1969,6) when .diff data had wrong start date
  outputData(modSS$data) <- tfwindow(outputData(modSS), end=c(1969,7))
  # it should be possible to do the following instead, but tsp seems to
  # sometimes get mixed up in forecast and cause System terminating: bad address
  # outputData(modSS$data) <- outputData(modSS$data)[1:100,]
  z <- forecast(modSS, percent=c(90,100,110))

# previously 136 below
  error <- max(abs(
    c(z$forecast[[1]][36,],z$forecast[[2]][36,], z$forecast[[3]][36,])
     -c(-0.00310702417651131587, -0.00604105559321206804,0.00214657444656118738,
      -0.00345224972784219028, -0.00671228396225603124,0.00238508249578931863,
      -0.00379747527917305948, -0.00738351233129999531,0.00262359054501745074)))
# 10* for change from svd to La.svd (but values not changed)
  ok <- 10*fuzz.small > error
  if (!ok) {if (is.na(max.error)) max.error <- error
            else max.error <- max(error, max.error)}
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed! error = ", error,")\n") }

if (graphics) 
 {if (verbose) cat("EvalEst test 7 (graphics) ... ")
  ok <- EvalEst.graphics.tests(verbose=verbose, pause=TRUE)
  all.ok <- all.ok & ok 
  if (verbose) {if (ok) cat("ok\n") else cat("failed!\n") }
 }

  if (synopsis) 
    {if (verbose) cat("All EvalEst 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")
}

EvalEst.graphics.tests <- function(verbose=TRUE, synopsis=TRUE)
{# graphics tests do not do any value comparisons
  if (synopsis & !verbose) cat("EvalEst graphics tests ...")
  
 data("eg1.DSE.data.diff", package="dse")
 
 if (verbose) cat("  EvalEst 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")})())
      }

  data <- eg1.DSE.data.diff
  mod1 <- TSmodel(estVARXls(data,max.lag=3))
  modSS <- l(toSS(mod1),data)

  z <- featherForecasts( modSS,  from.periods=c(230,250))
  tfplot(z, start=c(1980,1))
  if (verbose) cat("ok\n")

  if (verbose) cat("  EvalEst graphics test 2 ...")
  z <- forecast(modSS, percent=c(90,100,110))
  tfplot(z, start=c(1985,1))
  if (verbose) cat("ok\n")

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

  invisible(TRUE)
}



   EvalEst.function.tests(verbose=TRUE, graphics=FALSE)  
   EvalEst.graphics.tests(verbose=TRUE)

unlink(dir, recursive=TRUE)