.packageName <- "marrayTools"
###########################################################################
# Date : September 19, 2002
# Modify : April 14, 2003
#
# Runs on R 1.5.1 and above
#
# This file contains wrapper functions for GenePix files
## source("~/Projects/maTools/R/gpWrap.R")
## source("~/Projects/maTools/R/maAnalysis.R")
###########################################################################

###########################################################################
## This is a wrapper function specifially to generate diagnostic plots and
## quality file for every genepix files in the current working directory

gpTools <- function(fnames,
                    path=".",
                    galfile,
                    bg=TRUE,
                    plot=TRUE,
                    quality=TRUE,
                    fill = TRUE,
                    raw = FALSE,
                    echo=TRUE,
                    ...)
  {
    ## SetUP QualityInfo:
    QualityInfo <- c("file","Date","Pmt",
                     "Flaginfo.-75","Flaginfo.-50","Flaginfo.0", "RS2N.Median", "GS2N.Median",
                     "CtlA.Empty.Median", "CtlA.Negative.Median","CtlA.Positive.Median",
                     "CtlM.Empty.Median", "CtlM.Negative.Median",  "CtlM.Positive.Median", 
                     "CtlA.probes.Min.","CtlA.probes.1st Qu.","CtlA.probes.Median",
                     "CtlA.probes.3rd Qu.","CtlA.probes.Max.",
                     "CtlM.probes.Min.","CtlM.probes.1st Qu.","CtlM.probes.Median",
                     "CtlM.probes.3rd Qu.","CtlM.probes.Max.",
                     "CTLNum.Empty","CTLNum.Negative","CTLNum.Positive","CTLNum.probes",
                     "Layout1","Layout.GridR","Layout.GridC","Layout.SpotR","Layout.SpotC")
    
    opt <- list(...)
    normM <- normA <- NULL
    if(missing(fnames)) fnames <- dir(path, pattern="*\\.gpr$")
    if(missing(galfile))
      {
        tmp <- dir(path, pattern="*\\.gal$")
        ifelse(length(tmp)==0, galfile <- fnames[1], galfile <- tmp)
      }

   
    if(quality) Q.res <- NULL
    if(raw) rawdata <- new("marrayRaw")
    
    for(i in fnames)
      {
        args <- maDotsMatch(opt, formals(args("read.Galfile")))
        core.info <- do.call("read.Galfile", c(list(i), list(path), args))
        maControls(core.info$layout) <- maGenControls(core.info$gnames)
        defs <- list(path=path,  name.W="Flags",
                     name.Gf = "F532 Median",
                     name.Rf = "F635 Median",                               
                     layout = core.info$layout,
                     gnames=core.info$gnames,
                     fill=T, quote="")
        args <- maDotsMatch( maDotsMatch(opt, defs), formals(args("read.GenePix")))
##        args <- maDotsMatch(c(defs, opt), formals(args("read.GenePix")))
        coredata <- do.call("read.GenePix", c(list(i), defs))

        if(raw)
          {
            if(length(maGf(rawdata)) == 0)
              rawdata <- coredata
            else
              {
                maGf(rawdata) <- cbind(maGf(rawdata), maGf(coredata))
                maRf(rawdata) <- cbind(maRf(rawdata), maRf(coredata))
                maGb(rawdata) <- cbind(maGb(rawdata), maGb(coredata))
                maRb(rawdata) <- cbind(maRb(rawdata), maRb(coredata))
                maW(rawdata) <- cbind(maW(rawdata), maW(coredata))
              }
          }
        
        if(!bg){
          nbgdata <- coredata
          slot(nbgdata, "maGb") <- matrix(0,0,0)
          slot(nbgdata, "maRb") <- matrix(0,0,0)
          data <- nbgdata; rm(nbgdata, coredata)
          fileM <- "normMnbg.xls"
          fileA <- "normAnbg.xls"
          fileMA <- "normMAnbg.xls"
          fileQ <- "qualityNbg.xls"
        }
        else
          {
            data <- coredata
            rm(coredata)
            fileM <- "normM.xls"
            fileA <- "normA.xls"
            fileMA <- "normMA.xls"
            fileQ <- "quality.xls"
          }
        gc()

        ## Number of missing values
        missingvalues <- (sum(is.na(maM(data)[,1]))/maNspots(data))


        ## Diagnostic Plots
        if(plot){
          if(echo) cat("Generating ...");
          if(table(maW(data))["0"] / maNspots(data) > 0.45)
            {
              maDiagnPlots(data, save=TRUE); if(echo) cat("Done. \n")
            } else
          cat("Plot Failed: Percentage of good spots are", table(maW(data))["0"] / maNspots(data), "\n")
        }

        ## Quality
        if(quality){
          if(echo) cat("Calculating quality info ...")
          tmp <- maQualityMain(data, path=path, output=TRUE)
          Q.res <- cbind(Q.res, unlist(tmp)[QualityInfo])
          if(echo) cat("Done. \n")
        }

        ## Normalization
        if(!raw){
          defs <- list(norm="p")
          args <- maDotsMatch(maDotsDefaults(opt, defs), formals(args("maNorm")))
          if(missingvalues < 0.7)
            {
              normdata <- do.call("maNorm", c(list(data),args))
              normM <- cbind(normM, maM(normdata))
              normA <- cbind(normA, maA(normdata))
            } else
          {
            cat("Normalization Failed: Percentage of missing values are", missingvalues, "\n")
            cat("Use Median normalization instead. \n")
            args$norm <- "m"
            normdata <- do.call("maNorm", c(list(data),args))
            normM <- cbind(normM, maM(normdata))
            normA <- cbind(normA, maA(normdata))
          }
        } ## Normalization
      } ## loop through different files

   
    ## Clean up plots 
    if(plot){ 
      dir.create("DiagnPlots")
      if(!length(dir(pattern="^Plot"))==0)
        {
          file.copy(dir(pattern="^Plot"), "DiagnPlots", overwrite=TRUE)
          file.remove(dir(pattern="^Plot"))
        }
    }

     
    ## Writing Quality
    if(quality){
##      indtmp <- c(1, grep("Flag", rownames(Q.res)),
##                  grep("Mean", rownames(Q.res)),  2:nrow(Q.res))
##      write.table(cbind(rownames(Q.res[indtmp,]), Q.res[indtmp,]),
##                  file=fileQ, col.names=FALSE, row.names=FALSE, quote=F, sep="\t")
      write.table(Q.res, file=fileQ, col.names=FALSE, row.names=TRUE, quote=FALSE, sep="\t")
      if(echo) print(paste("Write to file", fileQ))
      dir.create("QualityXLS")
      file.copy(dir(pattern="^Q\\."), "QualityXLS", overwrite=TRUE)
      file.remove(dir(pattern="^Q\\."))
      assign("QualityXLS", Q.res, envir=.GlobalEnv)
    }

    ## Writing M (Normalization)
    if(!raw){
      if(echo) cat("Assuming all data comes from the same print-run \n")
      if(echo) cat("Reading Gal file ...")
      args <- maDotsMatch(c(opt, path=path), formals(args("read.Galfile")))
      info <- do.call("read.Galfile", c(list(galfile), list(path), args))
      maControls(info$layout) <- maGenControls(info$gnames)
      if(echo) cat("done \n ")
      
      colnames(normM)<- colnames(normA) <- fnames
      normarray <- new("marrayNorm", maA=normA, maM=normM,
                       maLayout=info$layout,
                       maGnames=info$gnames)

      ## Writing M
      write.xls(cbind(maGeneTable(normarray), round(normM, 5)), file=fileM)
      if(echo) print(paste("Write to file", fileM))
      ## Writing A
      write.xls(cbind(maGeneTable(normarray), round(normA, 5)), file=fileA)
      if(echo) print(paste("Write to file", fileA))
      
      ## Writing M and A into one file
      ind <- as.vector(rbind(1:length(fnames), (1:length(fnames)) + length(fnames)))
      tmp <- round(cbind(normM, normA), 5)[,ind]
      write.xls(cbind(maGeneTable(normarray), tmp), file=fileMA)
      if(echo) print(paste("Write to file", fileMA))
    }
    
    if(raw)
      return(rawdata)
    if(!raw)
      return(normarray)
  }

##################################################################
## END OF FILE
##################################################################
###################################################################
##
## Date: October 11, 2002
## 
## source("~/Projects/maTools/R/maAnnotate.R")
## 
###################################################################

##########################################################################
## Widget for html page

mapGeneInfo <- function(widget=FALSE, Gnames, Name="pubmed", ID="genbank", ACC="SMDacc",  ...)
  {
    if(widget)
      {
        res <- widget.mapGeneInfo(Gnames)
        return(res)
      }
    else
      {
        opt <- list(...)
        base <- matrix(c("Grid", "Spot", "Row", "Column", "Block",
                         "cood", "cood", "cood", "cood", "cood"), ncol=2)
        rownames(base) <- c("Grid", "Spot", "Row", "Column", "Block")
        newinfo <- rbind(c("Name", Name),
                         c("ID", ID),
                         c("ACC", ACC))
        rownames(newinfo) <- c("Name", "ID", "ACC")
        return(rbind(newinfo, cbind(names(opt), unlist(opt)),base))
      }
  }

widget.mapGeneInfo <- function(Gnames)
  {
    print("widget")
    startfun <- function()
      {
        print("The URL choices are:")
        print(names(URLstring))
      }
    
    require(tcltk)
    require(tkWidgets)
    switch(data.class(Gnames),
           marrayNorm = headings <- colnames(maInfo(maGnames(Gnames))),
           marrayRaw= headings <- colnames(maInfo(maGnames(Gnames))),
           data.frame = headings <- colnames(Gnames),
           headings <- colnames(Gnames)
           )
    
    headings <- headings[-unique(c(grep("Grid", headings),
                                   grep("Spot", headings),
                                   grep("Row", headings),
                                   grep("Column", headings),
                                   grep("Block", headings)))]

    wlist <- list()
    for(hvalue in headings)
      {
        test <- list(Name=hvalue, Value=hvalue,
                     toText=function(x) paste(x,collapse = ","),
                     fromText=NULL, canEdit=TRUE, buttonFun = NULL,
                     buttonText = "Choices")
        wlist <- c(wlist, list(test))
      }
    names(wlist) <- headings
    widget1 <- list(wList = wlist,
                    preFun = startfun)
    res <- widgetRender(widget1, "Map Gene Names")

    resValues <- values.Widget(res)
    base <- matrix(c("Grid", "Spot", "Row", "Column", "Block",
                     "cood", "cood", "cood", "cood", "cood"), ncol=2)
    for(i in 1:length(resValues))
      base <- rbind(base, c(resValues[[i]]$Entry, resValues[[i]]$Value))
    return(base)
  }


##########################################################################
htmlPage <- function(genelist,
                     filename="GeneList.html",
                     geneNames=Gnames,
                     mapURL=SFGL,
                     othernames,
                     title,
                     table.head,
                     table.center=TRUE,
                     disp=c("browser", "file")[1])
{
  switch(class(geneNames),
         data.frame= data <- geneNames,
         marrayRaw = data <- maGeneTable(geneNames),
         marrayNorm = data <- maGeneTable(geneNames),
         marrayInfo = data <- maInfo(geneNames),
         matrix = data <- data.frame(geneNames),
         data <- geneNames)

  if(missing(othernames))
    restable <- data[genelist,] else
  restable <- cbind(data, othernames)[genelist,]
  
  args <- list(filename = filename, mapURL = mapURL,
               table.center = table.center,disp = disp)
  if(!missing(title)) args <- c(args, list(title=title))
  if(!missing(table.head)) args <- c(args, list(table.head=table.head))
  do.call("table2html", c(list(restable), args))
  return()
}

##ll.htmlpage <- function(genelist, filename, title, othernames, table.head, 
##                        table.center = TRUE) 
##  {
##    restable <- cbind(LocusLink = genelist, othernames)
##    args <- list(table.center=table.center)
##    if(!missing(filename)) args <- c(args, list(filename="GeneList.html"))
##    if(!missing(title)) args <- c(args, list(title=title))
##    if(!missing(table.head)) args <- c(args, list(table.head=table.head))
##    do.call("table2html", c(list(restable), args))
##    return()
##  }
                        

#####################################################
## Base Function
##
tablegen <-  function(input)
  {
    HTwrap <-   function (x, tag = "TD") {
      paste("<", tag, ">", x, "</", tag, ">", sep = "")}
    
    HTwrap.matrix <- function(input)
      {
        output <- ""
        for (nm in 1:ncol(input))
          output <- paste(output, HTwrap(input[,nm]), sep = "")
        return(output)
      }

    HTwrap.list <- function(input)
      {
        output <- ""
        for (nm in 1:length(input))
          output <- paste(output, HTwrap(input[[nm]]), sep = "")
        return(output)
      }
    
    switch(data.class(input),
           vector = output <- HTwrap(input),
           matrix = output <- HTwrap.matrix(input),
           list = output <- HTwrap.list(input),
           output <- HTwrap(input)
           )
    return(output)
  }


opVersionID <- function(opID)
  {
    code <- unlist(lapply(strsplit(as.vector(opID), split=""),
                          function(x){paste(x[1:2], collapse="")}))
    tmp <- table(code)
    code2 <- names(tmp)[tmp==max(tmp)]
    switch(code2,
           M2 = res <- "operonm2",
           M0 = res <- "operonm1",
           H2 = res <- "operonh2",
           H0 = res <- "operonh1"
           )
    return(res)
  }


gsubAnchor <-function (id, urlString) 
{
  test <-  function(x){
    if(!is.na(x))
      res <- gsub(pattern="UNIQID", replacement=x, urlString)
    else
      res <- x
    return(res)
  }
  paste("<A HREF=", sapply(as.character(id), test), ">", id, "</A>", sep = "")
}
#####################################################
## Table 2 HTML
## Date: Feb 16, 2003
table2html <- function (restable, filename = "GeneList.html",
                        mapURL = SFGL, title, table.head, table.center = TRUE, 
                        disp = c("browser", "file")[1]) 
{

  HTwrap <- function(x, tag = "TD") {
    paste("<", tag, ">", x, "</", tag, ">", sep = "")
  }
  
  outfile <- file(filename, "w")
  cat("<html>", file = outfile)
  cat(HTwrap(HTwrap("BioConductor Gene Listing", tag = "TITLE"), 
             tag = "head"), file = outfile)
  cat("<body bgcolor=\"#FFFFEF\">", "<H1 ALIGN=CENTER > BioConductor Gene Listing </H1>", 
      file = outfile, sep = "\n")
  if (!missing(title)) 
    cat("<CENTER><H1 ALIGN=\"CENTER\">", title, " </H1></CENTER>\n", 
        file = outfile, sep = "\n")
  if (table.center) 
    cat("<CENTER> \n", file = outfile)
  cat("<TABLE BORDER=4>", file = outfile, sep = "\n")
  if (!missing(table.head)) {
    headout <- paste("<TH>", table.head, "</TH>")
    cat("<TR>", headout, "</TR>", file = outfile, sep = "\n")
  }
  if (is.null(mapURL)) 
    mapURL <- widget.mapGeneInfo(restable)

  oldGnamesID <- colnames(restable)
  GnamesID <- rep("none", length(oldGnamesID))
  for (i in 1:nrow(mapURL))
    GnamesID[grep(mapURL[i, 1], oldGnamesID)] <- mapURL[i,2]
  
  if (sum(GnamesID == "operon") != 0) 
    GnamesID[grep("operon", GnamesID)] <- opVersionID(restable[1:100, grep("operon", GnamesID)])
  mainTable <- Headings <- NULL
  
  for (i in 1:length(GnamesID)) {
    info <- GnamesID[i]
    x <- as.vector(restable[, i])
    if(!is.null(class(x))) if(class(x) == "numeric") x <- round(x, 2)
    if ((info != "") | is.null(info)) {
      switch(info, cood = mainTable <- paste(mainTable, HTwrap(x), sep = ""),
             none = mainTable <- paste(mainTable,  HTwrap(x), sep = ""),
             mainTable <- paste(mainTable,
                                HTwrap(gsubAnchor(x, urlString = URLstring[[info]])), sep = ""))
    }
    Headings <- c(Headings, colnames(restable)[i])
  }
  
  cat(paste(HTwrap(Headings), collapse = ""), file = outfile)
  cat("\n", file = outfile)
  cat(HTwrap(mainTable, tag = "TR"), file = outfile, sep = "\n")
  cat("</TABLE>", "</body>", "</html>", sep = "\n", file = outfile)
  if (table.center) 
    cat("</CENTER> \n", file = outfile)
  close(outfile)

  if (disp == "browser") 
    browseURL(paste("file://", getwd(), filename, sep = "/"))
  ##  openBrowser(paste("file://", getwd(), filename, sep = "/"))
  return()
}



###################################################################
## predefine info
URLstring <- list(
 pubmed = "http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?cmd=Search&db=PubMed&term=UNIQID",
 locuslink = "http://www.ncbi.nlm.nih.gov/LocusLink/LocRpt.cgi?l=UNIQID",
 riken = "http://read.gsc.riken.go.jp/chipinfo.php?defkey=&chiprearrayid=UNIQID",
 SMDclid = "http://genome-www4.stanford.edu/cgi-bin/SMD/source/sourceResult?option=CloneID&criteria1=IMAGE:UNIQID&choice=cDNA",
 SMDacc = "http://genome-www4.stanford.edu/cgi-bin/SMD/source/sourceResult?option=Number&criteria=UNIQID&choice=Gene",
 operonh2 = "http://oparray.operon.com/human2/index.php?single_query=UNIQID",
 operonh1 = "http://oparray.operon.com/~operon/human/index.php?single_query=UNIQID",
 operonm2 = "http://oparray.operon.com/mouse2/index.php?single_query=UNIQID",
 operonm1 = "http://oparray.operon.com/~operon/mouse/index.php?single_query=UNIQID",
 operonST="http://sandlertest.ucsf.edu/NOMAD/nomad-cgi/query_annot.pl?UNIQID",
 genbank ="http://www.ncbi.nlm.nih.gov/entrez/viewer.fcgi?DB=nucleotide&val=UNIQID",
 unigeneMm="http://www.ncbi.nlm.nih.gov/UniGene/clust.cgi?ORG=Mm&CID=UNIQID",
 unigeneHS="http://www.ncbi.nlm.nih.gov/UniGene/clust.cgi?ORG=Hs&CID=UNIQID")
                  

SFGL <- mapGeneInfo(ID="operonST",
                    ACC="SMDacc",
                    LocusLink="locuslink",
                    Cluster="unigeneMm",
                    LOCUSLINK="locuslink",
                    GenBank="genbank",
                    Name="none")

UCBFGL <- mapGeneInfo(ID="riken",
                      ACC="SMDacc")

###################################################################
maQuality <- function(mraw, path=".")
  {
    res <- NULL
    for(i in 1:ncol(maM(mraw)))
      res <- cbind(res, unlist(maQualityMain(mraw[,i], path=path)))
    return(res)
  }

maQualityMain <- function(mraw, path=".", fname, output=FALSE)
  {
    data <- mraw[,1]

    if(missing(fname))
      f <- colnames(maGf(data)) 
    tmp <- unlist(strsplit(f, "\\."))
    ifelse(length(maGb(data))!=0, bg <- "Q", bg <- "Q.nbg")
    fstart <- paste(tmp[-length(tmp)], collapse=".")
    fname <- paste(bg, fstart, "xls", sep=".")

    ## info
    Date <- PMT <- NULL
    tmp <- readLines(file.path(path,f), n=40)    
    
    if(length(grep("DateTime", tmp)) != 0)
      Date <- gsub("\"", "",strsplit(tmp[grep("DateTime", tmp)], split="=")[[1]][2])

    if(length(grep("PMT", tmp)) != 0)
      {
        PMT1 <- gsub("\"", "",strsplit(tmp[grep("PMT", tmp)], split="=")[[1]][2])
        PMT <- gsub("\t", ",", PMT1)
      }
    
    ## Flag Info
    if(length(maW(data)) != 0)
      {
        tmp <- table(maW(data))
        Flaginfo <- round(100*tmp/maNspots(data), 2)
      }
    else
      {
        Flaginfo <- NULL
      }

    ## S 2 N
    ifelse(length(maRb(data))!=0 , RS2N <- as.vector(log(maRf(data) / maRb(data),2)),
           RS2N <- as.vector(log(maRf(data),2)))
    RS2Ninfo <- summary(RS2N)[1:6]

    ifelse(length(maGb(data))!=0 , GS2N <- as.vector(log(maGf(data) / maGb(data),2)),
           GS2N <- as.vector(log(maGf(data),2)))
    GS2Ninfo <- summary(GS2N)[1:6]

    ## Control Spots
    A <- split(maA(data),  maControls(data))
    CtlA <- lapply(A, function(x){summary(x)[1:6]})
    CTLNum <- table(maControls(data))
    
    M <- split(maM(data),  maControls(data))
    CtlM <- lapply(M, function(x){summary(x)[1:6]})

    ## Spatial Effects

    ## Reuslts
    res <- list(file = f,
                Date = Date,
                Pmt =  PMT,
                Layout = c(maNspots(data),
                  GridR = maNgr(data),
                  GridC = maNgc(data),
                  SpotR = maNsr(data),
                  SpotC = maNsc(data)),
                Flaginfo = Flaginfo,
                RS2N = RS2Ninfo,
                GS2N = GS2Ninfo,
                CTLNum = CTLNum,
                CtlA = CtlA,
                CtlM = CtlM)
    if(output) write.list(res, file=fname)
    return(res)
  }
###########################################################################
## Date : October 25, 2002
##
## source("~/Projects/maTools/R/maRankGenes.R")
##
###########################################################################

maSelectGnames <- function(statdata,
                           crit1=50,
                           crit2=crit1,
                           sub=TRUE,
                           selectstat,
                           operate=c("intersect", "union"))
  {
    operate.list <- function(x, operate)
      {
        res <- x[[1]]
        for(i in 2:length(x))
          res <- do.call(operate, list(res, x[[i]]))
        return(res)
      }
    
    gene.ID <- function(x)
      {
        x$gnames
      }

    if(is.integer(sub))
      {
        tmp <- rep(FALSE, nrow(statdata))
        tmp[sub] <- TRUE
        sub <- tmp
      }

    if(missing(selectstat)) selectstat <- 1:ncol(statdata)
    Gnames <- 1:nrow(statdata)
    
    list.id <- list()
    for(i in selectstat)
      {
        switch(data.class(statdata),
                           matrix = headings <- colnames(statdata)[i],
                           data.frame = headings <-  dimnames(statdata)[[2]][i],
                           headings <- colnames(statdata)[i]
                           )
        if(headings == "bayesFun"){
          list.id <- c(list.id,
                       list(gene.ID(stat.gnames(statdata[sub,i],
                                                Gnames[sub], crit=crit1))))
        }
        else
          {
            tmp1 <- gene.ID(stat.gnames(statdata[sub,i], Gnames[sub], crit=crit1)) 
            tmp2 <- gene.ID(stat.gnames(-(statdata[sub,i]), Gnames[sub], crit=crit2)) 
            list.id <- c(list.id, list(c(tmp1, tmp2)))
          }
      }
    finalid <- operate.list(list.id, operate)
    return(finalid)
  }



###################################################################
## Select values based on intensities binning
###################################################################
stat.confband.text <-
function (M, A, crit1 = 0.025, crit2 = crit1, nclass = 5)
{
    if (crit1 >= 1)
        crit1 <- crit1/length.na(M)
    if (crit2 >= 1)
        crit2 <- crit2/length.na(M)
    txtA <- (rep(FALSE, length(A)))
    Abin <- quantile.na(A, probs = seq(0, nclass, 1)/nclass)
    for (i in 1:nclass) {
        tmpind <- (Abin[i] <= A) & (A < Abin[i + 1])
        xtmp <- M
        xtmp[!tmpind] <- NA
        n1 <- sum.na(tmpind)
        cutoff <- quantile.na(xtmp, probs = c(crit1, (1 - crit2)))
        vals <- ((xtmp < cutoff[1]) | (xtmp > cutoff[2]))
        txtA[vals] <- TRUE
    }
    res <- c(1:length(txtA))[txtA]
    tmp <- res[rev(order(M[res]))]
    return(tmp)
}


###########################################################################
# Statistics for Microarray Analysis
# Exploratory analysis - Mainly preprocessing.
#
# Date : August 9, 2000
# Last update : May 17, 2001
#
# History:
#   May 17, 2001: Fix to norm.scale.func
#   March, 19: Splitting Rarray in to smaller files.  
#              Including Comments at the start of each function.
#   Nov, 20: Change the argument on plot.mva...it's not usable otherwise.
#            Bug fix ma.func
#   Nov, 13: Ben's Bug fix on stat.ma
#   Nov, 10: Change data structure from matrix to list of matrix.  
#   Sept, 28: Bug fix: ma.func
#
# Authors: Sandrine Dudoit and Yee Hwa (Jean) Yang.
##########################################################################


##########################################################################
#  stat.gnames
#  History:  
#     March 19, 2001:  remove infinite values from the ordering.
#
##########################################################################

stat.gnames<-function(x, gnames, crit=50)
{
    ind <- is.infinite(x)
    x <- x[!ind]
    if (crit < 1) {
        which <- rev(order.na(x, na.last = FALSE))[1:(round(length(x) * 
            crit))]
        if (sum(is.na(x)) > (length(x) - round(length(x) * crit))) 
            warning("NA exists under your selection criteria")
    }
    if (crit >= 1) {
        which <- rev(order.na(x, na.last = FALSE))[1:crit]
        if (sum(is.na(x)) > (length(x) - crit)) 
            warning("NA exists under your selection criteria")
    }
    if (is.matrix(gnames) | is.data.frame(gnames)) 
      {
	gnames <- gnames[!ind, ]
        res <- list(gnames = gnames[which, ], t = x[which])
      }
    if (is.vector(gnames)) 
      {
	gnames <- gnames[!ind]
        res <- list(gnames = gnames[which], t = x[which])
      }
    res
}


##########################################################################
#                                End of file
##########################################################################
###########################################################################
# Statistics for Microarray Analysis
##########################################################################

######################################################
# Wrapper for BioC
######################################################

maBayesian <- function(mraw, ...)
  {
    if(require(limma))
      {
        switch(data.class(mraw),
               exprSet = M <- exprs(mraw),
               marrayRaw = M <- maM(mraw),
               marrayNorm = M <- maM(mraw),
               M <- mraw
               )
        opt <- list(...)
        args <- maDotsMatch(c(list(M=M), opt), formals(args("lm.series")))
        fit <- do.call("lm.series", args)
        args <- maDotsMatch(c(list(fit=fit), opt), formals(args("ebayes")))
        eb <- do.call("ebayes", args)
        return(eb)
      }
    else
      stop("Need to install package limma")
  }

###############################################################################
## NA's
###########################################################################
# Statistics for Microarray Analysis
# Function dealing with NA's
#
# Date : March 19, 2001
#
# Authors: Sandrine Dudoit and Yee Hwa (Jean) Yang.
##########################################################################

##########################################################################
# Basic statistics functions that are able to handle missing values
##########################################################################

########################################################################/**
# \name{na}
#
# \alias{log.na}
# \alias{sum.na}
# \alias{mean.na}
# \alias{var.na}
# \alias{cor.na}
# \alias{quantile.na}
# \alias{length.na}
# \alias{order.na}
# \alias{scale.na}
# \alias{prod.na}
#
# \title{Basic Statistical Functions for Handling Missing Values}
#
# \description{
# Basic statistical functions for handling missing values or NA. \cr
# In \code{log.na}, \code{sum.na}, \code{mean.na} and \code{var.na},
# \code{quantile.na}, \code{length.na}, missing values are omitted
# from the calculation. \cr
# The function \code{cor.na} calls \code{cor} with the argument
# \code{use="pairwise.complete.obs"}. \cr
# The function \code{order.na} only handles vector arguments and not
# lists.  However, it gives the option of omitting the NAs
# (\code{na.last=NA}), of placing the NAs at the start of the ordered
# vector (\code{na.last=F}) or at the end (\code{na.last=T}). \cr
# The function \code{scale.na} is a modified version of
# \code{\link{scale}} which allows NAs in the variance calculation. If
# \code{scale = T}, the function \code{f} in \code{scale.na} uses
# \code{var.na} to perform the variance calculation.
# The function \code{prod.na} is similar to the \code{\link{prod}}
# function with \code{na.rm=TRUE}. This function returns the product of
# all the values present in its arguments, omitting any missing values.
# }
#
# \author{
#   Yee Hwa Yang, \email{yeehwa@stat.berkeley.edu} \cr
#   Sandrine Dudoit, \email{sandrine@stat.berkeley.edu}
# }
#
# \seealso{\code{\link{log}}, \code{\link{sum}}, \code{\link{mean}},
#   \code{\link{var}}, \code{\link{cor}}, \code{\link{order}},
#   \code{\link{scale}}, \code{link{prod}}.}
#
# \keyword{log, sum, mean, variance, correlation, order, scale,
# product, missing values, NA.}
#
#*/#########################################################################


mean.na <- function(x,...)
{
        mean(x[!(is.na(x) | is.infinite(x))])
}

 var.na <- function(x)
{
        res <- NA
        tmp <- !(is.na(x) | is.infinite(x))
        if(sum(tmp) > 1)
                res <- var(x[tmp])
        res
}

cor.na <- function(x)
{
  cor(x, use="pairwise.complete.obs")
}

sum.na <- function(x)
{
        res <- NA
        tmp <- !(is.na(x) | is.infinite(x))
        if(sum(tmp) > 0)
                res <- sum(x[tmp])
        res
}


length.na <- function(x, ...)
{
   tmp <- !(is.na(x) | is.infinite(x))
   length(x[tmp],...)
 }

log.na <- function(x, ...)
{
  log(ifelse(x > 0, x, NA), ...)
}


quantile.na <- function(x, ...)
 {
   tmp <- !(is.na(x) | is.infinite(x))
   quantile(x[tmp],...)
 }

order.na <- function (x, na.last = TRUE)
{
    y <- order(x)
    n <- sum(is.na(x))
    tmp <- (length(x) - n + 1):length(x)
    if (!is.na(na.last)) {
        if (na.last)
            res <- y
        if (!na.last)
          {
            if(n == 0)
              res <- y
            else
              res <- c(y[tmp], y[-tmp])
          }
      }
    if (is.na(na.last)) {
        warning("NA's discarded")
        res <- y[-tmp]
    }
    res
}

scale.na<-function(x, center = TRUE, scale = TRUE)
{
  x <- as.matrix(x)
  nc <- ncol(x)

  if (is.logical(center)) {
     if (center)
       x <- sweep(x, 2, applyy(x, 2, mean, na.rm=TRUE))
    }
  else if (is.numeric(center) && (length(center) == nc))
    x <- sweep(x, 2, center)
  else
    stop("Length of center must equal the number of columns of x")

  if (is.logical(scale)) {
    if (scale) {
      f <- function(v) {
        sqrt(var.na(v))
      }
      x <- sweep(x, 2, apply(x, 2, f), "/")
    }
    }
  else if (is.numeric(scale) && length(scale) == nc)
    x <- sweep(x, 2, scale, "/")
  else
    stop("Length of scale must equal the number of columns of x")
    x
}

prod.na <- function (x)
{
  prod(x[!(is.na(x) | is.infinite(x))])
}


rm.na <- function(x)
  {
    ind <- is.na(x) | is.nan(x) | is.infinite(x)
    return(x[!ind])
  }


##########################################################################
#                                End of file
##########################################################################





###################################################################
## Examples
## library(marrayInput)
## data(swirl)
## findID("fb24a09", swirl, ID="ID")
## findID("geno1", swirl)
###################################################################

findID <-
  function(text,
           Gnames=gnames,
           ID = "Name")
{
  switch(data.class(Gnames),
         exprSet = G <- phenoData(Gnames),
         marrayRaw = G <- maGeneTable(Gnames),
         marrayNorm = G <-maGeneTable(Gnames),
         marrayInfo = G <- maInfo(Gnames),
         G <- Gnames
         )
  ind <- grep(ID, colnames(G))
  y <- as.vector(G[,ind])
  x <- grep(text, y)
  return(x)
}

###########################################################################
## Date : October 11, 2002
##
## Modified from Sandrine's Code
##
## source("~/Projects/maTools/R/maStat.R")
##
## Sandrine Test this  
## X <- matrix(rnorm(1000, 10), nc=10)
## Y <- sample(1:2,ncol(X),replace=TRUE)
## maStat(X, funNames=c("bayesFun", "meanFun"))
## maStat(X, funNames=c("bayesFun", "meanFun"), y=Y)
###########################################################################


##################################################################
## Widget Wrapper
##

widget.Stat <- function(expr, outputName="statres", funNames,... )
  {
    LABELFONT <- "Helvetica 12"
    BUTWIDTH <- 10
    BUTTONLAST <- NULL
    CANCEL <- FALSE
    END <- FALSE
    if(missing(funNames))
      FunctionLists <- c("bayesFun", "meanFun", "ttestFun", "numNAFun")
    else
      FunctionLists <- funNames
    
    require(tcltk) || stop("tcltk support is absent")
    
    cancel <- function() {
      CANCEL <<- TRUE
      tkdestroy(base)
    }

    calculate <- function(...)
      {
        newname <- outputName
        funNames <- c()
        for(i in FunctionLists)
          {
            check <- eval(parse(text=tclvalue(i)))
            if(check == '1') funNames <- c(funNames, i)
          }
        res <<- maStat(expr, funNames = funNames, ...)
        write.xls(res, paste(newname, "xls", sep="."))
        assign(newname, res, envir = .GlobalEnv)
        cat(paste("\n Finish calculation, results:", newname, "\n", sep=""))
        tkdestroy(base)
        return()
      }
    
    base <- tktoplevel()
    tkwm.title(base, "Calculation")
    mainfrm <- tkframe(base, borderwidth=2)
    
    ## Buttons
    buttonfr <- tkframe(base)
    for(n in FunctionLists)
      tkpack(buttonfr,
             tkcheckbutton(buttonfr, text=n, variable=n),
             anchor='w')
    tkpack(buttonfr)
        
    butFrame <- tkframe(base)
    cancelBut <- tkbutton(butFrame, text = "Cancel", width = BUTWIDTH, 
                          command = cancel)
    calBut <- tkbutton(butFrame, text = "Calculate", width = BUTWIDTH, 
                       command = calculate)
    tkgrid(calBut, cancelBut)
    tkpack(butFrame)
    tkwait.window(base)
    return(invisible())
  }  

###########################################################################
## Wrapper function
##
##

maStat <- function(expr, funNames, ...)
  {

    switch(data.class(expr),
           exprSet = M <- exprs(expr),
           marrayRaw = M <- maM(expr),
           marrayNorm = M <- maM(expr),
           M <- expr
           )

    opt <- list(...)
    res <- resNames <- c()
    
    if(!class(funNames) == "list")
      {
        print(funNames)
          for(fun in funNames)
          {
            argsfun <- maDotsMatch(opt, formals(args(fun)))
            if(is.null(argsfun))  test <- eval(call(fun))
            if(!is.null(argsfun))  test <- eval(call(fun), argsfun)
            tmp <- test(M)
            ifelse(is.null(colnames(tmp)), tmp2 <- fun, tmp2 <- colnames(tmp))
            resNames <- c(resNames, tmp2)
            res <- cbind(res, tmp)
            colnames(res) <- resNames
          }
      }

    if(class(funNames) == "list")
      for(i in 1:length(funNames))
        {
          tmp <- eval(funNames[[i]])(M)
          ifelse(is.null(colnames(tmp)),
                 tmp2 <- ifelse(is.null(names(funNames)[i]), i, names(funNames)[i]),
                 tmp2 <- colnames(tmp))
          resNames <- c(resNames, tmp2)
          res <- cbind(res, tmp)
          colnames(res) <- resNames
        }
      
    return(res)
  }

###########################################################################
##
## this is filterfunc in genefilter library
## maStatFun <- function (...)
## {
##    flist <- list(...)
##    if (length(flist) == 1 && is.list(flist[[1]]))
##        flist <- flist[[1]]
##    f <- function(x) {
##	fval <- NULL
##        for (fun in flist) {
##            fval <- cbind(fval,fun(x))
##      }
##    }
##    class(f) <- "filterfun"
##    return(f)
## }

###########################################################################
## Functions that calculates various statistics
##
bayesFun <- function(...)
{
  ## take only matrix
  function(M) {
    res <- maBayesian(M, ...)
    return(res$lods)
  }
}

meanFun <- function(y=NULL,
                    na.rm = TRUE)
{
  function(M) {
    meansub <- function(x, y=NULL, na.rm=TRUE)
      {
        if (na.rm) {
          ind <- is.na(x) | is.nan(x) | is.infinite(x)
          x <- x[!ind]
          y <- y[!ind]
        }
        ifelse(is.null(y),
               res <- mean(x),
               res <- diff(unlist(lapply(split(x,y), mean))))
        names(res)<- "Mean"
        return(res)
      }
    switch(data.class(M),
           matrix = apply(M, 1, meansub, y=y, na.rm=na.rm),
           list = unlist(lapply(M, meansub, y=y, na.rm=na.rm)),
           meansub(M, y=y, na.rm=na.rm)
           )
  }
}

ttestFun <- function(y=NULL,
                      var.equal = FALSE,
                      alternative =c("two.sided", "less", "greater"),
                      na.rm = TRUE
                      )
{
  function(M) {
    ttestsub <- function(x, y=NULL,
                      var.equal = FALSE,
                      alternative =c("two.sided", "less", "greater"),
                      na.rm=TRUE)
      {
        if (na.rm) {
          ind <- is.na(x) | is.nan(x) | is.infinite(x)
          x <- x[!ind]
          y <- y[!ind]
        }
        if(length(x) == 0)
          {
            res <- rep(NA, 4)
            names(res) <- c("statistic","estimate","parameter","p.value")
          }
        else
          {
            ifelse(is.null(y),
                   res <- t.test(x, var.equal=var.equal, alternative=alternative),
                   res <- t.test(x ~ y, var.equal=var.equal, alternative=alternative))
            res<-unlist(res[c("statistic","estimate","parameter","p.value")])
            if(is.null(y))
              names(res) <- c("statistic","estimate","parameter","p.value")
            if(!is.null(y))
              names(res) <- c("statistic","estimate group1","estimate group2","parameter","p.value")
          }
	return(res)
      }
    switch(data.class(M),
           matrix = t(apply(M, 1, ttestsub, y=y, var.equal=var.equal,
             alternative=alternative, na.rm==na.rm)),
           list = unlist(lapply(M, ttestsub,  y=y, var.equal=var.equal,
             alternative=alternative, na.rm==na.rm)),
           ttestsub(M,  y=y, var.equal=var.equal,
                    alternative=alternative, na.rm==na.rm)
           )
  }
}
         
numNAFun <- function()
  {
    function(M)
      {
        switch(data.class(M),
               matrix = apply(M, 1, function(x)sum(is.na(x))),
               list = unlist(lapply(M, function(x)sum(is.na(x)))),
               sum(is.na(M))
               )
      }
  }
###########################################################################
# Date : September 19, 2002
# Modify : October, 14, 2002
#
# Runs on R 1.5.1 and above
#
# This file contains wrapper functions for analysis
#
# source("~/Projects/maTools/R/maWrap.R")
#
###########################################################################

widget.TwoSamples <- function(output=TRUE)
  {
    wlist <- list()
    targetfile <- list(Name="Target File", Value=".txt",
                       toText=function(x) paste(x,collapse = ","),
                       fromText=NULL, canEdit=TRUE, buttonFun = fileBrowser,
                       buttonText = "Browse")
    inputdata <- list(Name="Normalized data", Value="data",
                     toText=function(x) paste(x,collapse = ","),
                     fromText=NULL, canEdit=TRUE, buttonFun = NULL,
                     buttonText = NULL)
    info <- c("Trt", "Ctl", "targetID", "slidesID", "dyesID", "NumID")
    infoValues <- c("Trt", "Ctl", "TargetName", "Slides", "Dyes", "5")

    for(i in 1:length(info))
      {
        test <- list(Name=info[i], Value=infoValues[i],
                     toText=function(x) paste(x,collapse = ","),
                     fromText=NULL, canEdit=TRUE, buttonFun = NULL,
                     buttonText = NULL)
        wlist <- c(wlist, list(test))
      }
    names(wlist) <- info
    widget1 <- list(wList = c(targetfile=list(targetfile), inputdata=list(inputdata), wlist))
    res <- widgetRender(widget1, "Two Samples Adjustment")
    resValues <- values.Widget(res)

    args <- list()
    argsName <- c()
    for(i in 1:length(resValues))
      {
        argsName <- c(argsName, resValues[[i]]$Entry)
        args <-  c(args, list(resValues[[i]]$Value))
      }
    names(args) <- argsName
    args$inputdata <- eval(as.name(args$inputdata))
    names(args)[names(args) == "inputdata"] <- "normdata"
    names(args)[names(args) == "NumID"] <- "RedID"
    outdata <- do.call("maTwoSamples", c(args, list(output=output)))
    return(outdata)
  }

maTwoSamples <- function(targetfile,
                         normdata,
                         Trt,
                         Ctl,
                         targetID="TargetName",
                         slidesID="Slides",
                         dyesID="Dyes",
                         RedID=5,
                         path=".",
                         output=TRUE)
  {
    ## normdata is an marrayNorm objects
     dyeflip <- function(x)
      {
        if(!setequal(as.vector(unique(x[,targetID])), c(Trt, Ctl)))
          res <- NULL
        else
          {
            id <- c(1,2)[as.vector(x[,targetID])==Trt]
            if((as.vector(x[id, dyesID])== RedID))
              res <- 1
            if((as.vector(x[id, dyesID])!= RedID))
              res <- -1
          }
        return(res)
      }

     if(missing(normdata)) normdata <- gpTools()

     target <- maInfo(read.marrayInfo(targetfile))

     dyetype <- unique(target[,"Dyes"])
     if(length(dyetype) !=2)
       stop("Error: More than 2 types of dyes")
     
     if(missing(Trt))    Trt <- as.vector(target[1,targetID])
     if(missing(Ctl))    Ctl <- as.vector(target[2,targetID])
     
     sorttarget <- split(target, target[,slidesID])
     dyeswitch <- unlist(lapply(sorttarget, dyeflip))

     switchM <- switchA <- newtarget <- NULL
     fnames <- colnames(maM(normdata))
     for(i in names(dyeswitch))
       {
         M <- maM(normdata)[,fnames == i]
         A <- maA(normdata)[,fnames == i]
         dyeflip <- dyeswitch[names(dyeswitch)==i]
         switchM <- cbind(switchM, M*dyeflip)
         switchA <- cbind(switchA, A)
         id <- as.vector(target[,slidesID]) == i
         newtarget <- rbind(newtarget, data.frame(t(unlist(apply(target[id,], 2, unique)))))
       }
     rownames(newtarget) <-  as.character(c(1:dim(newtarget)[1]))
     newdata <- normdata
     colnames(switchM) <- colnames(switchA) <- names(dyeswitch)
     slot(newdata, "maM") <- switchM
     slot(newdata, "maA") <- switchA
     
     maTargets(newdata) <- new("marrayInfo",
                               maLabels = as.vector(newtarget[,1]),maInfo = newtarget,
                               maNotes="Generate from maTwoSamples")
     fname <- paste(Trt,"over",Ctl, ".xls", sep="") 
     if(output) write.xls(cbind(maGeneTable(newdata), round(switchM, 5)), file=fname)
     print(paste("Write to file", fname, "\n", sep=" "))
     
     return(newdata)
   }





##################################################################
## END OF FILE
##################################################################
###########################################################################
# Date : September 19, 2002
# Modify : October, 18, 2002
#
# Runs on R 1.5.1 and above
#
# This file contains wrapper functions for Spot files
#
# source("~/Projects/maTools/R/spotWrap.R")
###########################################################################

###########################################################################
## This is a wrapper function specifially to generate diagnostic plots and
## quality file for every genepix files in the current working directory

spotTools <- function(fnames,
                      path=".",
                      galfile,
                      bg=TRUE,
                      plot=TRUE,
                      quality=TRUE,
                      fill=TURE,
                      raw=FALSE,
                      echo=TRUE,
                      ...)
  {
    opt <- list(...)
    normM <- normA <- NULL
    if(missing(fnames)) fnames <- dir(path, pattern="*\\.spot$")
    if(missing(galfile))
      {
        tmp <- dir(path, pattern="*\\.gal$")
        ifelse(length(tmp)==0, galfile <- fnames[1], galfile <- tmp)
      }

    if(echo) cat("Reading Gal file ...")
    args <- maDotsMatch(c(opt, galfile=galfile, path=path), formals(args("read.Galfile")))
    info <- do.call("read.Galfile", args)
    maControls(info$layout) <- maGenControls(info$gnames)
    if(echo) cat("done \n ")
    
    if(quality) Q.res <- NULL
    if(raw) rawdata <- new("marrayRaw")
    
    for(i in fnames)
      {
        defs <- list(fnames =i, path=path,  name.W="circularity",
                     layout = info$layout,
                     gnames=info$gnames,
                     fill=TRUE, quote="")
        args <- maDotsMatch(c(defs, opt), formals(args("read.Spot")))
        coredata <- do.call("read.Spot", args)
        tmp <- maW(coredata) 
        maW(coredata) <- apply(tmp >= 1, 2, as.numeric)
        if(raw)
          {
            if(length(maGf(rawdata)) == 0)
               rawdata <- coredata
            else
              {
                maGf(rawdata) <- cbind(maGf(rawdata), maGf(coredata))
                maRf(rawdata) <- cbind(maRf(rawdata), maRf(coredata))
                maGb(rawdata) <- cbind(maGb(rawdata), maGb(coredata))
                maRb(rawdata) <- cbind(maRb(rawdata), maRb(coredata))
                maW(rawdata) <- cbind(maW(rawdata), maW(coredata))
              }
          }
        if(!bg){
          nbgdata <- coredata
          slot(nbgdata, "maGb") <- matrix(0,0,0)
          slot(nbgdata, "maRb") <- matrix(0,0,0)
          data <- nbgdata; rm(nbgdata, coredata)
          fileM <- "normMnbg.xls"
          fileA <- "normAnbg.xls"
          fileMA <- "normMAnbg.xls"
          fileQ <- "qualityNbg.xls"
        }
        else
          {
            data <- coredata
            rm(coredata)
            fileM <- "normM.xls"
            fileA <- "normA.xls"
            fileMA <- "normMA.xls"
            fileQ <- "quality.xls"
          }
        gc()
        
        ## Diagnostic Plots
        if(plot){
          if(echo) cat("Generating ...");
          maDiagnPlots(data, save=TRUE)
          }
        
        ## Quality
        if(quality){
          if(echo) cat("Calculating quality info ...")
          tmp <- maQualityMain(data, path=path, output=TRUE)
          Q.res <- cbind(Q.res, unlist(tmp))
          if(echo) cat("Done \n")
        }

        ## Normalization
        if(!raw){
          defs <- list(norm="p")
          args <- maDotsMatch(maDotsDefaults(opt, defs), formals(args("maNorm")))
          normdata <- do.call("maNorm", c(list(data),args))
          normM <- cbind(normM, maM(normdata))
          normA <- cbind(normA, maA(normdata))
        }
      }


    ## Clean up plots
    if(plot){
      dir.create("DiagnPlots")
      file.copy(dir(pattern="^Plot"), "DiagnPlots", overwrite=TRUE)
      file.remove(dir(pattern="^Plot"))
    }
    
    ## Writing Quality
    if(quality){
      indtmp <- c(1, grep("Flag", rownames(Q.res)),
                  grep("Mean", rownames(Q.res)),  2:nrow(Q.res))
      write.table(cbind(rownames(Q.res[indtmp,]), Q.res[indtmp,]),
                  file=fileQ, col.names=FALSE, row.names=FALSE, quote=F, se="\t")
      if(echo) print(paste("Write to file", fileQ))
      dir.create("QualityXLS")
      file.copy(dir(pattern="^Q\\."), "QualityXLS", overwrite=TRUE)
      file.remove(dir(pattern="^Q\\."))
      assign("QualityXLS", Q.res, envir=.GlobalEnv)
    }


    ## For Normalization
    if(!raw){
      colnames(normM)<- colnames(normA) <- fnames
      normarray <- new("marrayNorm", maA=normA, maM=normM,
                       maLayout=info$layout,
                       maGnames=info$gnames)
      ## Writing M
      write.xls(cbind(maGeneTable(normarray), round(normM, 5)), file=fileM)
      if(echo) print(paste("Write to file", fileM))
      ## Writing A
      write.xls(cbind(maGeneTable(normarray), round(normA, 5)), file=fileA)
      if(echo) print(paste("Write to file", fileA))
      ## Writing M and A into one file
      ind <- as.vector(rbind(1:length(fnames), (1:length(fnames)) + length(fnames)))
      tmp <- round(cbind(normM, normA), 5)[,ind]
      write.xls(cbind(maGeneTable(normarray), tmp), file=fileMA)
      if(echo) print(paste("Write to file", fileMA))
    }
    
    if(raw)
      return(rawdata)
    if(!raw)
      return(normarray)
  }

##################################################################
## END OF FILE
##################################################################
.First.lib <- function(libname, pkgname, where)
{
  require("Biobase") || stop("Biobase needed")
  require("marrayNorm")  || stop("marrayNorm needed")
  require("annotate") || stop("annotate needed")
  require("genefilter") || stop("genefilter needed")

  if(!exists(".crazydetachmarrayTools",env=.GlobalEnv)){
    detach(package:marrayTools)
    assign(".crazydetachmarrayTools",1,env=.GlobalEnv);
    library(marrayTools)
  }
}
