wd <- getwd()
setwd("../..")
source("include.r")
setwd(wd)

assert <- function(expr, comment=NULL)
{
  if(length(expr) > 1)
  {
    stop(paste("expression length is > 1:", paste(expr, collapse=" "), "call:", paste(sys.call(), collapse=", ")))
  }
  if(length(expr)==0 || is.na(expr) || !expr)
    stop(paste("assert failed: ", paste(sys.call(), collapse=" "), if(!is.null(comment)) comment))
}

assert.tables.equal <- function(t1, t2, comment=NULL, printdiffrows=FALSE, tolerance=0)
{
  failed <- FALSE
  msg <- NULL
  if(!is.data.frame(t1) && !is.matrix(t1)) {
    failed <- TRUE
    msg <- "t1 is not a matrix or data frame."
  }
  if(!failed && !is.data.frame(t2) && !is.matrix(t2)) {
    failed <- TRUE
    msg <- "t2 is not a matrix or data frame."
  }
  if(!failed && nrow(t1) != nrow(t2)) {
    failed <- TRUE
    msg <- paste("t1 has", nrow(t1), "rows, t2 has", nrow(t2))
  }

  if(!failed) {
    for(r in 1:nrow(t1)) {
      rfailed <- FALSE
      for(c in 1:ncol(t1)) {
        if(is.na(t1[r,c]) || is.na(t2[r,c])) {
          if(is.na(t1[r,c]) != is.na(t1[r,c])) {
            rfailed <- TRUE
          }
        } else {
          if(t1[r,c] != t2[r,c]) {
            t1val <- as.numeric(t1[r,c])
            t2val <- as.numeric(t2[r,c])
            if(is.na(t1val)
               || is.na(t2val)
               || abs(t1val - t2val) >= tolerance) {
              rfailed <- TRUE
            }
          }
        }
      }
      if(rfailed) {
        failed <- TRUE
        msg <- paste(msg, r)
      }
    }
    msg <- paste("The following rows are different:", msg, sep="")
  }

  if(failed) {
    stop(paste("assert.tables.equal failed: ",
               paste(sys.call(), collapse=" "),
               msg,
               "(comment:", if(!is.null(comment)) comment), ")")
  }
}

errors <- NULL
start.test <- function()
{
  errors <<- NULL
  cat ("----\n")
}

finish.test <- function()
{
  cat("\n----\n")
  cat(paste(length(errors), "tests run.\n"))
  failures <- 0
  for(i in 1:length(errors))
  {
    if(!as.logical(as.list(errors[[i]])$succeeded)) failures <- failures + 1
  }
  if(failures > 0)
  {
    cat(paste(failures, "failures.\n\n"))
    cat("Failures:\n")
    for(i in 1:length(errors))
    {
      errlist <- as.list(errors[[i]])
      if(!as.logical(errlist$succeeded))
      {
        cat(paste(i, ":", errlist$test.name, ":"), "\n")
        err <- errlist$error
        cat(errlist$error.message, "\n")
        cat(paste(errlist$error.call, collapse=","), "\n")
      }
    }
  } else {
    cat("TESTS SUCCEEDED\n")
  }

  return(failures)
}

run.test <- function(test.name)
{
  err <- NULL
  with.warnings.as.errors(tryCatch(eval(call(test.name)),
           error = function(e) {err <<- e }))
  if(!is.null(err))
    {
      testres <- list(c(test.name=test.name, succeeded=FALSE, error=err))
      class(testres) <- "testResult"
      errors <<- c(errors, testres)
      cat("F")
    }
  else
    {
      testres <- list(c(test.name=test.name, succeeded=TRUE))
      class(testres) <- "testResult"
      errors <<- c(errors, testres)
      cat(".")
    }
}

compare.diffex.files <- function(f1, f2, ...)
{
  t1 <<- read.delim(f1)
  t2 <<- read.delim(f2)

  # Throw away quotes in gene name column (Console and GUI versions of R write different quotes)
  t1[,2] <<- gsub("'", "", sub("\342\200\231", "", sub( "\342\200\230", "", as.character(t1[,2]))))  
  t2[,2] <<- gsub("'", "", sub("\342\200\231", "", sub( "\342\200\230", "", as.character(t2[,2]))))

  assert(nrow(t1) == nrow(t2), paste("rowcounts: t1:", nrow(t1), "t2:", nrow(t2)))
  assert(ncol(t1) == ncol(t2), paste("colcounts: t1:", ncol(t1), "t2:", ncol(t2)))
    
  msg <- paste("diffex files", f1, ",", f2, "not equal")
  assert.tables.equal(t1, t2, msg, T, ...)
}

compare.to.saved.vector <- function(vec, saved.vec.file, roundvec=NA)
{
  if(!is.na(roundvec))
    vec <- round(vec, roundvec)
  
  vec <<- vec
  saved.vec <<- scan(saved.vec.file, quiet=T)
  assert(all(round(vec,7)==round(saved.vec,7)))
}

save.vector <- function(vec, saved.vec.file, roundvec=NA, nsmall=0)
{
  if(!is.na(roundvec))
    vec <- round(vec, roundvec)

  write(format(vec, nsmall=nsmall), saved.vec.file)
}

update <- function(tid, progress, datalist)
{
  print(paste("update: ", round(100 * progress$current / progress$max, 2), "%"))
}

printmsg <- function(...)
{
  print(...)
}
  
expect.error <- function(expr) {
  err <- NULL
  tryCatch(expr, error=function(e) err <<- e)
  if (is.null(err))
    stop(paste("Expected an error but did not get one"))
  return(err)
}
