source("testfunctions.r")
wd <- getwd()
setwd("../..")
source("odp.r")
source("util.r")
setwd(wd)

test.static.1 <- function() { with.warnings.as.errors(test.static.1.int()) }
test.static.2 <- function() { with.warnings.as.errors(test.static.2.int()) }
test.lr0 <- function() { with.warnings.as.errors(test.lr0.int()) }

#########################################################################
## Test 1 for statex()
##
## Runs statex() on the brca_small dataset.
## Compares the results to previously saved results.
## If the test is successful, the function returns.
## If the test is unsuccessful, the function raises an error condition
## using stop().
#########################################################################
test.static.1.int <- function() {
           
  data <- readexpr.func("../../data/brca_small.txt")
  grp <- c( 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2 )

  lr <- NULL
  p <- NULL

  results.statex <<- statex(dat=data$exprs, grp=grp,
                            match=NULL, B=90, seed=232)
  p <- results.statex$p
  lr <- results.statex$lr
  lr0 <- results.statex$lr0

  compare.to.saved.vector(lr, "data/expected_static1_lr.txt", roundvec = 7)
  compare.to.saved.vector(lr0, "data/expected_static1_lr0.txt", roundvec = 7)
  
  results.q <<- calc.qvalues(p, "static", data$exprs, "smoother", seq(0, 0.95, by=0.05), chunks=results.statex$chunks)

  assert(sum(names(results.q) != c("pi0", "qobj", "q")) == 0, "results list missing some items")
  assert(round(results.q$pi0,4) == 0.4615)
  
  results <<- order.results(lr, p, results.q$q, data$exprs, data$geneNames, "q", 0.1)

  fname <- "tmpresults_static1.txt"
  expected.fname <- "data/expected_static1.txt"
  savediffexresults.func(fname, results$psig.ord, results$genesig.ord, results$qsig.ord)

  compare.diffex.files(fname, expected.fname, tolerance=0.000011)

  ## Test order.results with a maxnumsig smaller than default # of significant genes
  maxnumsig <- 50
  actualsig <- 48
  results.max <<- order.results(lr, p, results.q$q, data$exprs, data$geneNames, "q", 0.1,
                                maxnumsig=maxnumsig)
  assert(!is.null(results.max$newalpha))
  assert(results.max$newalpha < 0.1)
  assert(results.max$nsig == actualsig)
  assert(all(results.max$psig.ord == results$psig.ord[1:actualsig]))
  assert(all(results.max$qsig.ord== results$qsig.ord[1:actualsig]))
  assert(all(results.max$genesig.ord== results$genesig.ord[1:actualsig]))
  assert(all(results.max$datasig.ord== results$datasig.ord[1:actualsig,]))
  assert(all(results.max$datasig.m== results$datasig.m[1:actualsig,]))
  assert(all(results.max$geneNames.ord == results$geneNames.ord))
  assert(sum(results.q$q <= results.max$newalpha) == actualsig)
  assert(results.max$qsig.ord[actualsig] == results.max$newalpha)
  assert(all(results.max$qsig.ord <= results.max$newalpha))
  
  ## Test order.results again with a p-value cutoff
  maxnumsig <- 60
  actualsig <- 60
  results.max <<- order.results(lr, p, results.q$q, data$exprs, data$geneNames, "p", 0.05,
                                maxnumsig=maxnumsig)
  assert(!is.null(results.max$newalpha))
  assert(results.max$newalpha < 0.1)
  assert(results.max$nsig == actualsig)
  assert(all(results.max$psig.ord == results$psig.ord[1:actualsig]))
  assert(all(results.max$qsig.ord== results$qsig.ord[1:actualsig]))
  assert(all(results.max$genesig.ord== results$genesig.ord[1:actualsig]))
  assert(all(results.max$datasig.ord== results$datasig.ord[1:actualsig,]))
  assert(all(results.max$datasig.m== results$datasig.m[1:actualsig,]))
  assert(all(results.max$geneNames.ord == results$geneNames.ord))
  assert(sum(results.statex$p <= results.max$newalpha) == actualsig)
  assert(results.max$psig.ord[actualsig] == results.max$newalpha)
  assert(all(results.max$psig.ord <= results.max$newalpha))
}

#########################################################################
## Test 2 for statex()
##
## Runs statex() on the sim_match dataset.
## Compares the results to previously saved results.
## If the test is successful, the function returns.
## If the test is unsuccessful, the function raises an error condition
## using stop().
#########################################################################
test.static.2.int <- function() {
           
  data <- readexpr.func("../../data/sim_match.txt")
  grp <- c( 2, 2, 2, 2, 2, 1, 1, 1, 1, 1 )
  match <- c( 1, 2, 3, 4, 5, 1, 2, 3, 4, 5 )
  
  lr <- NULL
  p <- NULL

  results.statex <<- statex(dat=data$exprs, grp=grp, match=match,
                            B=100, seed=45, printmsg=function(msg){})
  p <- results.statex$p
  lr <- results.statex$lr
  lr0 <- results.statex$lr0

  results <<- calc.qvalues(p, "static", data$exprs, "smoother", seq(0, 0.95, by=0.05), chunks=results.statex$chunks)

  assert(sum(names(results) != c("pi0", "qobj", "q")) == 0, "results list missing some items")
  assert(round(results$pi0,4) == 0.9649)
  
  results <<- order.results(lr, p, results$q, data$exprs, data$geneNames, "p", 0.1)

  fname <- "tmpresults_static3.txt"
  expected.fname <- "data/expected_static3.txt"
  savediffexresults.func(fname, results$psig.ord, results$genesig.ord, results$qsig.ord)

  compare.diffex.files(fname, expected.fname)
}

test.outofmemory.1.int <- function()
{
  ## Create huge dataset.
  seed <- 123
  rows=200
  cols=300000
  grp = c(rep(1,cols%/%2), rep(2, cols %/% 2 + cols %% 2))
  
  exprData <- matrix(rep(1, rows*cols), nrow=rows)

  err <<- expect.error(results.statex <<- statex(dat=exprData, grp=grp,
                                                 match=NULL, B=1, seed=seed))
  
}

