.packageName <- "SAGElyzer"
# A widget for taking inputs for getGEOSAGE.
#
# Copyright 2003, J. Zhang, all rights reserved
#

GEOSAGEWidget <- function(){
    on.exit(end())

    orgVar <- tclVar("human")
    targetVar <- tclVar(file.path(.path.package("SAGElyzer"), "temp"))
    urlVar <- tclVar("http://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?")
    END <- TRUE

    end <- function(){
        tkdestroy(base)
    }
    cancel <- function(){
        END <<- FALSE
        end()
    }
    getTargetDir <- function(){
        targetVar <- fileBrowser(nSelect = 1)
        writeList(targetEntry, targetVar, TRUE)
    }


    base <- tktoplevel()
    tktitle(base) <- "BioC SAGElyzer"

    label1 <- tklabel(base, text = "Organism")
    orgEntry <- tkentry(base, width = 15, textvariable = orgVar)
    tkgrid(label1, orgEntry, padx = 5)


    label2 <- tklabel(base, text = "Save To")
    targetFrame <- tkframe(base)
    targetEntry <- tkentry(targetFrame, width = 50, textvariable = targetVar)
    tkpack(targetEntry, side = "left", expand = TRUE, fill = "x")
    targetBut <- tkbutton(targetFrame, width = 6, text = "Browse",
                                            command = getTargetDir)
    tkpack(targetBut, side = "left")
    tkgrid(label2, targetFrame, padx = 5)

    label3 <- tklabel(base, text = "Source URL")
    urlEntry <- tkentry(base, width = 50, textvariable = urlVar)
    tkgrid(label3, urlEntry, padx = 5)

    tkgrid.configure(label1, label2, label3, sticky = "e")
    tkgrid.configure(orgEntry, targetFrame, urlEntry, sticky = "w")
    butFrame <- tkframe(base)
    cancelBut <- tkbutton(butFrame, text = "Cancel", width = 8,
                          command = cancel)
    endBut <- tkbutton(butFrame, text = "Continue", width = 8, command = end)
    tkpack(endBut, cancelBut, side = "left", padx = 20)
    tkgrid(butFrame, columnspan = 2, pady = 5)

    tkwait.window(base)

    if(END){
        return(list(organism = tclvalue(orgVar),
                targetDir = tclvalue(targetVar), url = tclvalue(urlVar)))
    }else{
        return(NULL)
    }
}

# This function provides the interface for users to select/input
# arguments for KNN
#
# items - a vector of character strings for the items to be picked
# from.
#
# Copyright 2002 J. Zhang, all rights reserved
#
KNNArgsWidget <- function (){

    args2Return <- list()

    columns <- NULL
    colIndex <- NULL
    indexInSel <- NULL
    text2 <- "Select item(s) from the list box on the left"
    targetTag <- tclVar()
    normValue <- tclVar()
    kValue <- tclVar()
    distValue <- tclVar()
    transValue <- tclVar()

    end <- function(){
        if(nchar(tclvalue(targetTag)) != 10){
            temp <- tkmessageBox(title = "Incorrect tag",
                                     message = paste("A target tag has",
                                     "to be set and of 10 characters"),
                                     icon = "warning", type = "ok")
        }else{
            args2Return[["targetSAGE"]] <<- toupper(tclvalue(targetTag))
            args2Return[["normalize"]] <<- tclvalue(normValue)
            if(length(columns) != 0 ){
                args2Return[["libs"]] <<- unique(names(libs[match(columns,
                                                                  libs)]))
            }else{
                args2Return[["libs"]] <<- "*"
            }
            args2Return[["k"]] <<- as.numeric(tclvalue(kValue))
            args2Return[["dist"]] <<- tclvalue(distValue)
            args2Return[["trans"]] <<- tclvalue(transValue)

            tkdestroy(base)
        }
    }
    cancel <- function(){
        args2Return <<- NULL
        tkdestroy(base)
    }

    # When a user double clicks a column name in the list box, put the
    # library name in the vector for selected SAGE libraries.
    colDClicked <- function(){
        column <- as.character(tkget(colView,(tkcurselection(colView))))
        columns <<- unique(c(columns, column))
        writeList(selectView, columns)
        tkconfigure(clearBut, state = "normal")
        tkconfigure(selectBut, state = "disabled")
    }
    # When a user single clicked a column name, remember that name and
    # activate the select button
    colSClicked <- function(){
        colIndex <<- unlist(strsplit(
                              as.character(tkcurselection(colView)), " "))
        tkconfigure(selectBut, state = "normal")
    }
    # When a user click the select button, put the selected column name
    # in the list box for selected columns
    selectCol <- function(){
        for(i in colIndex){
            columns <<- c(columns, as.character(tkget(colView, i)))
        }
        writeList(selectView, unique(columns))
        tkconfigure(selectBut, state = "disabled")
        tkconfigure(clearBut, state = "normal")
    }
    # Remember the column name when a name in the selected column names list
    # box is single clicked
    selSClick <- function(){
        indexInSel <<- unlist(strsplit(
                              as.character(tkcurselection(selectView)), " "))
        tkconfigure(remBut, state = "normal")
    }
    # Removes the selected column name from the list box for selected
    # column names
    dropSelCol <- function(){
        for(i in indexInSel){
            columns <<- columns[columns != as.character(tkget(selectView, i))]
        }
        writeList(selectView, unique(columns))
        tkconfigure(remBut, state = "disabled")
    }
    # Remove everything from the list box for selected column names
    clearSelCol <- function(){
        writeList(selectView, "")
        columns <<- NULL
        tkconfigure(clearBut, state = "disabled")
    }
    # Select all the libraries
    selectAllLibs <- function(){
        columns <<- as.vector(libs)
        writeList(selectView, columns, clear = TRUE)
        tkconfigure(clearBut, state = "normal")
    }
    # Get library column names from DB
    libs <- queryInfoDB(infoCol = "filename")
    # Get saved argument values to put in the corresponding widgets
    SAGELyzerArgs <- getSLyzerArgs()

    base <- tktoplevel()
    on.exit(tkdestroy(base))
    tktitle(base) <- "BioC SAGElyzer KNN"

    tkpack(tklabel(base, text = "SAGElyzer KNN arguments"), expand = FALSE,
           fill = "x", padx = 5, pady = 5)
    tagFrame <- tkframe(base)
    tkpack(tklabel(tagFrame, text = "Target tag"), side = "left",
           expand = FALSE, fill = "x")
    tagEntry <- tkentry(tagFrame, width = 15, textvariable = targetTag)
    tkpack(tagEntry, side = "left", expand = TRUE, fill = "x")
    if(SAGELyzerArgs[["targetSAGE"]] != ""){
        writeList(tagEntry, SAGELyzerArgs[["targetSAGE"]], clear = TRUE)
    }
    tkpack(tagFrame, expand = FALSE, fill = "x", padx = 5, pady = 5)

    argFrame <- tkframe(base)
    normLabel <- tklabel(argFrame, text = "Normalization")
    kLabel <- tklabel(argFrame, text = "k value")
    distLabel <- tklabel(argFrame, text = "Distance")
    transLabel <- tklabel(argFrame, text = "Trnsformation")
    normFrame <- tkframe(argFrame)
    kFrame <- tkframe(argFrame)
    distFrame <- tkframe(argFrame)
    transFrame <- tkframe(argFrame)
    dropdownList(normFrame, c("min", "max", "none"),
                              normValue, 15, SAGELyzerArgs[["normalize"]])
    dropdownList(kFrame, c(50, 100, 150, 200, 250, 300,
                                       400, 500, 1000, 2000), kValue,
                           15, SAGELyzerArgs[["k"]])
    dropdownList(distFrame, c("euclidean", "maximum", "manhattan",
                 "canberra", "correlation","binary"), distValue,
                              15, SAGELyzerArgs[["dist"]])
    dropdownList(transFrame, c("sqrt", "log10", "log2", "exp"),
                               transValue, 15, SAGELyzerArgs[["trans"]])
    tkgrid(normLabel, normFrame, kLabel, kFrame, padx = 5, pady = 4)
    tkgrid(distLabel, distFrame, transLabel, transFrame, padx = 5,
           pady = 4)
    tkgrid.configure(normLabel, kLabel, distLabel, transLabel, sticky = "e")
    tkgrid.configure(normFrame, kFrame, distFrame, transFrame, sticky = "w")
    tkpack(argFrame, expand = FALSE, fill = "x")

    # Lists for column names
    midFrame <- tkframe(base)
    text2Label <- tklabel(midFrame, text = text2, font = "Helvetica 12")
    tkgrid(text2Label, columnspan = 2, pady = 2)
    # Label for available SAGE libs
    leftFrame <- tkframe(midFrame)
    tkgrid(tklabel(leftFrame, text = "SAGE libraries",
                   font = "Helvetica 11"), columnspan = 2)
    # List box showing the available SAGE libs
    colFrame <- tkframe(leftFrame)
    colView <- makeViewer(colFrame, vWidth = 40, vHeight = 15,
                           hScroll = TRUE)
    tkbind(colView, "<Double-Button-1>", colDClicked)
    tkbind(colView, "<B1-ButtonRelease>", colSClicked)
    tkgrid(colFrame, columnspan = 2)
    selectAllBut <- tkbutton(leftFrame, text = "Select all >>", width = 12,
                             command = selectAllLibs)
    selectBut <- tkbutton(leftFrame, text = "Select >>", width = 12,
		      state = "disabled", command = selectCol)
    tkgrid(selectAllBut, selectBut, padx = 5)
    tkgrid.configure(selectAllBut, sticky = "e")
    tkgrid.configure(selectBut, sticky = "w")
    tkconfigure(colView, selectmode = "extended")
    # Put the list box for selected SAGE libs and the associated buttons
    rightFrame <- tkframe(base)
    label2 <- tklabel(rightFrame, text = "SAGE libraries picked",
                        font = "Helvetica 11")
    tkgrid(label2, columnspan = 2)
    selLFrame <- tkframe(rightFrame)
    selectView <- makeViewer(selLFrame, vWidth = 40, vHeight = 15,
                             hScroll = TRUE)
    if(length(SAGELyzerArgs[["libs"]]) > 1 ||
                                   SAGELyzerArgs[["libs"]] != "*"){
        columns <- libs[match(SAGELyzerArgs[["libs"]], names(libs))]
        columns <- unique(as.vector(columns))
        writeList(selectView, columns, clear = TRUE)
    }
    tkgrid(selLFrame, columnspan = 2, padx = 5)
    tkconfigure(selectView, selectmode = "extended")
    tkbind(selectView, "<B1-ButtonRelease>", selSClick)
    remBut <- tkbutton(rightFrame, text = "<< Remove", width = 12,
		      state = "disabled", command = dropSelCol)
    clearBut <- tkbutton(rightFrame, text = "Clear", width = 12,
		      state = "disabled", command = clearSelCol)
    tkgrid(remBut, clearBut, padx = 5)
    tkgrid.configure(remBut, sticky = "e")
    tkgrid.configure(clearBut, sticky = "w")

    tkgrid(leftFrame, rightFrame)
    tkpack(midFrame)

    # Put the end buttons
    butFrame <- tkframe(base)
    endBut <- tkbutton(butFrame, text = "Continue", width = 12,
                       command = end)
    cancelBut <- tkbutton(butFrame, text = "Cancel", width = 12,
                          command = cancel)
    tkgrid(endBut, cancelBut, padx = 10)
    tkpack(butFrame, pady = 5)

    writeList(colView, as.vector(libs))

    tkwait.window(base)

    return(args2Return)
}









SAGE4Unix <- function(){
    on.exit(end())

    setSLyzerArgs()

    end <- function(){
        tkdestroy(base)
    }
    getHelp <- function(){
        writeText(textBox, help, TRUE)
    }
    queryGEO <- function(){
#        tkconfigure(SAGEMenu, state = "disabled")
        writeText(textBox, "Getting libraries from GEO ...", TRUE)
        done <- SAGEFromGEO()
        writeText(textBox, done, FALSE)
#        tkconfigure(SAGEMenu, state = "normal")
    }
    mergeLibs <- function(){
#        tkconfigure(SAGEMenu, state = "disabled")
        writeText(textBox, "Merging SAGE libraries ...", TRUE)
        done <- procSAGE()
        writeText(textBox, done, FALSE)
#        tkconfigure(SAGEMenu, state = "normal")
    }
    runSAGELyzer <- function(){
#        tkconfigure(SAGEMenu, state = "disabled")
        writeText(textBox, "Calculating distances ...", TRUE)
        runSLyzer()
        writeText(textBox, "Done", FALSE)
#        tkconfigure(SAGEMenu, state = "normal")
    }
    findMapping <- function(){
#        tkconfigure(SAGEMenu, state = "disabled")
        writeText(textBox, "Mapping SAGE tags ...", TRUE)
        done <- mapSAGE2UG()
        writeText(textBox, done, FALSE)
#        tkconfigure(SAGEMenu, state = "normal")
    }

    base <- tktoplevel()
    tktitle(base) <- "BioC SAGElyzer"

    text <- paste("SAGElyzer: a package for the integration, analysis,",
                  "and annotation of expression data")
    help <- paste("Click the \"SAGElyzer\" menu bar to select executable",
                  "functions.")

    textBox <- tktext(base, width = 45, height = 10, wrap = "word")
    writeText(textBox, text, TRUE)
    tkpack(textBox, side = "top", padx = 10, pady = 5)

    endBut <- tkbutton(base, text = "Exit", width = 8, command = end)
    tkpack(endBut, side = "top", padx = 10, pady = 5)

    topMenu <- tkmenu(base)
    tkconfigure(base, menu = topMenu)

    SAGEMenu <- tkmenu(topMenu, tearoff = FALSE)
    # Set the menu for making connections to DB
    tkadd(SAGEMenu, "command", label = "DBConnecter", command = getDBArgs)
    # Set the menu for data integration
    mergerMenu <- tkmenu(SAGEMenu, tearoff = FALSE)
#    tkadd(mergerMenu, "command", label = "Connect to DB",
#          command = getCountsDBArgs)
    tkadd(mergerMenu, "command", label = "Get GEOSAGE", command =queryGEO)
    tkadd(mergerMenu, "command", label = "Integrate SAGE",
                                                 command = mergeLibs)
    tkadd(mergerMenu, "command", label = "Map SAGE", command = findMapping)
    tkadd(SAGEMenu, "cascade", label = "SAGEIntegrater", menu = mergerMenu)
    # Set the menu for SAGELyzer
    lyzerMenu <- tkmenu(SAGEMenu, tearoff = FALSE)
#    tkadd(lyzerMenu, "command", label = "Connect to DB",
#          command = getCountsDBArgs)
    tkadd(lyzerMenu, "command", label = "Set Target", command = getTag)
    tkadd(lyzerMenu, "command", label = "Select Libs", command = selectLibs)
    tkadd(lyzerMenu, "command", label = "Reset Defaults",
                                                 command = getDefaults)
    tkadd(lyzerMenu, "command", label = "Run", command = runSAGELyzer)
    tkadd(lyzerMenu, "command", label = "Get Lib Counts",
                                                 command = getLibCounts)
    tkadd(lyzerMenu, "command", label = "View Libs", command = mapLib2File)
    tkadd(lyzerMenu, "command", label = "Annotate Tags", command = linkTag2UG)
#    tkadd(lyzerMenu, "command", label = "Reset", command = setSLyzerArgs)
    tkadd(SAGEMenu, "cascade", label = "SAGELyzer", menu = lyzerMenu)
    # Set the menu for mapping SAGE data
#    mapperMenu <- tkmenu(SAGEMenu, tearoff = FALSE)
#    tkadd(mapperMenu, "command", label = "Connect to DB",
#          command = getMapDBArgs)
#    tkadd(mapperMenu, "command", label = "Annotate Tags",
#          command = linkTag2UG)
#    tkadd(SAGEMenu, "cascade", label = "SAGEMapper", menu = mapperMenu)

    tkadd(topMenu, "cascade", label = "SAGE", menu = SAGEMenu)
    tkadd(topMenu, "command", label = "Help", command = getHelp)

    tkwait.window(base)
}
# These functions processes the SAGE library data and find genes that
# are similar to a given SAGE tag based on specified criteria.
#
# Copyright 2002, J. Zhang. All rights reserved.
#

SAGELyzer <- function(dbArgs, targetSAGE, libs = "*", normalize = "min",
                      tagColName = "tag", k = 500, dist = "euclidean",
                      trans = "sqrt"){
    # genefinder of genefilter is needed
    require(genefilter) || stop("Library genefilter unavailable!")
    # Argument trans must be a function
    if( is.character(trans) )
        trans <- get(trans, mode="function")
    if( !is.function(trans) )
        stop("trans must be a function")
    # Distances of genes to the target gene will be keeped and
    # returned. k defines how many of the most similar genes will be kept
    distance <- NULL
    # Needs a target gene to work with
    if(missing(targetSAGE) || is.null(targetSAGE)){
         tkmessageBox(title = "Query error", message = paste("Target tage",
                     "is either null or missing!"),
                     icon = "warning", type = "ok")
         return(NULL)
    }else{
        # Get K nearest neighbours
        neighbors <- getKNN(dbArgs, targetSAGE, libs, tagColName,
                            normalize, k, dist, trans)
        return(neighbors)
    }
}

# Get counts for the target row across selected libraries
getTargetRow <- function (dbArgs, conn, libs, tagColName, targetSAGE,
                          what = "counts"){
    if(length(libs) > 1){
        columns <- paste(c(tagColName, libs), sep = "",collapse = ",")
    }else{
        columns <- libs
    }

    targetSQL <- paste("select ", paste(columns, sep = "",
                                        collapse = ","), " from ",
                       dbArgs[[what]], " where ", tagColName,
                       " = '", targetSAGE, "'", sep = "")
    targetLine <- executeQuery(targetSQL, conn)

    if(is.null(targetLine) || is.na(targetLine) ||
       nrow(targetLine) == 0){
        tkmessageBox(title = "Query error", message = paste("Target tage",
                     targetSAGE, "does not exist in the DB"),
                     icon = "warning", type = "ok")
        return(NULL)
    }else{
        return(targetLine)
    }
}

# This function gets the normalization factor
getNormFactor <- function(normalize = c("min", "max", "none"), libs){
    normalize <- match.arg(normalize)
    switch(normalize,
           none = return(NULL),
           min = NF <- queryInfoDB(infoCol = "minfactor"),
           max = NF <- queryInfoDB(infoCol = "maxfactor"),
           stop("Invalid argument for normalize. Must be min, max, or none"))
    if(libs[1] == "*"){
        return(NF)
    }else{
        return(NF[libs])
    }
}

# This function queries sageinfo table to get file name or
# normalization factor for each library coded as lib1, lib2, ...
queryInfoDB <- function(libCol = "libname",
                        infoCol = c("filename", "minfactor", "maxfactor")){
    infoCol <- match.arg(infoCol)
    dbArgs <- getSLyzerArgs()$dbArgs
    switch(infoCol,
           filename = ,
           minfactor = ,
           maxfactor = NFSQL <- paste("select ", libCol, ",", infoCol,
                                      " from ", dbArgs[["info"]]),
           stop("Invalid argument for factName"))
    conn <- makeConnection(dbArgs)
    info <- executeQuery(NFSQL, conn)
    temp <- info[,2]
    names(temp) <- info[,1]
#    closeConn(conn)
    return(temp)
}

## This function is not in use any more but is kept anyway in case.
#calNormFactor <- function(normalize, dbArgs, conn, libs, tagColName){
#    if(!is.na(match("*", libs))){
#        libs <- setdiff(getColNames(dbArgs, conn), tagColName)
#    }

#    libNNum <- NULL
    # Has to do it for each library as the table can be very large and
    # may not be feasible to select all libraries once and figure
    #out the number of entries for each
#    for(i in libs){
#        factSQL <- paste("select count(", i, ") from ", dbArgs[["tableName"]],
#                         " where ", i, " > 0", sep = "")
#        got <- executeQuery(factSQL, conn)
#        libNNum <- c(libNNum, i, unlist(got, use.name = FALSE))
#    }
#    libNNum <- matrix(libNNum, ncol = 2, byrow = TRUE)
#    if(normalize == "min"){
#        temp <- min(as.numeric(libNNum[,2]))
#    }else{
#        temp <- max(as.numeric(libNNum[,2]))
#    }
#    factor <- as.numeric(temp/as.numeric(libNNum[,2]))
#    names(factor) <- libNNum[,1]
#    return(factor)
#}

# Get the total number of rows from an existing database table.
getTotalRNum <- function(dbArgs, conn, tagColName, what = "counts"){
    rows <- executeQuery(paste("select count(", tagColName, ") from ",
                               dbArgs[[what]], sep = ""), conn)
    if(!is.null(rows))
        return(rows)
    else
        return(null)
}

# Get k nearest neighbours for the target SAGE
getKNN <- function(dbArgs, targetSAGE, libs, tagColName, normalize,
                   k, dist, trans, max = 10000){
    conn <- makeConnection(dbArgs)
    options(show.error.messages = FALSE)
    rowNum <- try(getTotalRNum(dbArgs, conn, tagColName))
    options(show.error.messages = TRUE)
    if(inherits(rowNum, "try-error")){
        clossConn(conn)
        print("Failed to get total row number from DB")
    }else{
        if(rowNum < max){
            options(show.error.messages = FALSE)
            neighbors <- try(noChunkKNN(dbArgs, conn, targetSAGE, libs,
                                    tagColName, normalize, k, dist, trans))
            options(show.error.messages = TRUE)
        }else{
            options(show.error.messages = FALSE)
            neighbors <- try(chunkKNN(dbArgs, conn, targetSAGE, libs,
                                      tagColName, normalize, k, dist,
                                      trans, rowNum, max = max))
            options(show.error.messages = TRUE)
        }
    }
#    closeConn(conn)
    if(inherits(neighbors, "try-error")){
        stop("Failed to find the k neighbors")
    }else{
        return(neighbors)
    }
}

# Do this if total number of rows is less than MAX
noChunkKNN <- function(dbArgs, conn, targetSAGE, libs, tagColName,
                       normalize, k, dist, trans){
    distance <- NULL
    # Get the normorlization factor
#    print("Calculating normalization factors")
    NF <- getNormFactor(normalize, libs)
    # Gets the values across libraries for the target SAGE
#    print("Getting libraries for the target SAGE tag")
    targetRow <- getTargetRow(dbArgs, conn, libs, tagColName,
                              targetSAGE)
    if(!is.null(targetRow)){
#        print("Calculating distances")
        knnSQL <- getSAGESQL(dbArgs, conn, targetSAGE, libs, tagColName,
                             what = "counts")
        dataRead <- executeQuery(knnSQL, conn)

        tempDist <- findNeighborTags(targetRow, dataRead, k, NF, dist, trans)
        # Sorts the distance from closest to farthest
        distance <- sort(c(distance, tempDist))
        # Trim distance values to the defined length k
        if(length(distance) > k){
            distance <- distance[1:k]
        }
        return(distance)
    }
}

# Do this if the total number of rows is greater than
chunkKNN <- function(dbArgs, conn, targetSAGE, libs, tagColName, normalize,
                     k, dist, trans, rowNum, max = 50000){

    # Distances of genes to the target gene will be keeped and
    # returned. k defines how many of the most similar genes will be kept
    distance <- NULL
    # Get the normorlization factor
#    print("Calculating normalization factors")
    NF <- getNormFactor(normalize, libs)
    # Gets the values across libraries for the target SAGE
#    print("Getting libraries for the target SAGE")
    targetRow <- getTargetRow(dbArgs, conn, libs, tagColName, targetSAGE)
    if(!is.null(targetRow)){
#        print("Calculating distances")
        executeQuery("begin", conn, TRUE)
        cursor <- "sageRows"
        knnSQL <- getSAGESQL(dbArgs, conn, targetSAGE, libs, tagColName,
                         chunk = TRUE, cursor = cursor, what = "counts")
        executeQuery(knnSQL, conn, TRUE)
        for(i in 1:ceiling(rowNum/max)[[1]]){
            dataRead <- executeQuery(paste("fetch forward", max, "in",
                                           cursor), conn, FALSE)
            # Chunking is normally less than ceiling(rowNum/MAX)[[1]]
            # due to the removal of 0 rows. Check here
            if(nrow(dataRead) == 0)
                break

            tempDist <- findNeighborTags(targetRow, dataRead, k, NF,
                                         dist, trans)
            distance <- sort(c(distance, tempDist))
            # Remove target tag
            distance <- distance[names(distance) != targetSAGE]
            # Trim distance values to the defined length k
            if(length(distance) > k){
                distance <- distance[1:k]
            }
        }
        executeQuery(paste("close", cursor), conn, TRUE)
        executeQuery("end", conn, TRUE)

        return(distance)
    }
}

# Get the distance of entries in the data from the target row
findNeighborTags <- function(targetRow, data, k, NF, dist, trans){

    # Append the target row to the end
    data <- rbind(data, targetRow)
#    data[(nrow(data) + 1),] <- unlist(targetRow, use.name = FALSE)
    # The first column is tag that is not needed for distance calculation
    temp <- as.matrix(data[, 2:ncol(data)])
    # Puts 0 if any of the cells in the matrix is NA
    temp[is.na(temp)] <- 0
    # Normalize the data with the normalization factor
    if(!is.null(NF)){
        # Data returned from db query are converted to character.
        # Convert to numeric now
        temp <- matrix(as.numeric(temp), ncol = ncol(temp), byrow = FALSE)
        temp <- sweep(temp, 2, NF, "/")
    }
    # Gets the distance and other variables using genefinder
    found <- genefinder(trans(temp), nrow(temp),
                        ifelse(nrow(temp) > k, k, nrow(temp)),
                        method = dist)
    # Extracts the distance
    tempDist <- as.numeric(found[[1]]$dists)
    # Gets the name for each distance
    names(tempDist) <- data[found[[1]]$indices,][[1]]

    return(tempDist)
}

# Get the SQL statement for the query to get data for required
# libraries excluding the target row and row with all 0s if ignorZeros
# = TRUE
getSAGESQL <- function(dbArgs, conn, targetSAGE, libs, tagColName,
                       chunk = FALSE, cursor = "sageRows",
                       ignorZeros = TRUE,
                       what = c("map", "counts", "info")){
    what <- match.arg(what)

    if(ignorZeros){
        if(!is.na(match("*", libs))){
            libs <- setdiff(getColNames(dbArgs, conn), tagColName)
        }
#        toAdd <- paste(" and (", paste(libs, sep = "", collapse = "+"),
#                           ") > 0", sep = "")
        # This will work for both numeric or character data type
        toAdd <- paste(" and (", paste(libs, "<> '0'",
                                       collapse = " or "), ")", sep = "")
    }

    if(length(libs) > 1){
        columns <- paste(c(tagColName, libs), sep = "",collapse = ",")
    }else{
        columns <- libs
    }

    switch(what,
           map = ,
           counts = ,
           info = sageSQL <- paste("select ", columns, " from ",
                                   dbArgs[[what]], " where ",
                                   tagColName, " <> '", targetSAGE, "'",
                                   toAdd, sep = ""),
           stop("Invalid argument for what"))
    if(chunk){
        sageSQL <- paste("declare", cursor, "cursor for", sageSQL)
    }
    return(sageSQL)
}

# Gets all the column names of a table
getColNames <- function(dbArgs, conn, what = "counts"){
    colSQL <- paste("select * from", dbArgs[[what]], "limit 1")
    colNames <- executeQuery(colSQL, conn, FALSE)
    return(names(colNames))
}










# Functions that download mapping information from LocusLink, process
# the data, and then map SAGE tags to LocusLink ids.
#
# Copyright 2002, J. Zhang. All rights reserved.
#

SAGEMapper <- function(tag2UG = TRUE, tagUrl =
    "ftp://ftp.ncbi.nih.gov/pub/sage/map/Hs/NlaIII/SAGEmap_tag_ug-rel.zip",
                       organism = "Hs", fromWeb = TRUE){

    # Always save data to the "data" directory
    targetPath <- file.path(.path.package("SAGElyzer"), "temp")
    if(fromWeb){
        # File dowloaded will be named the same as the source file
        tagFName <- file.path(targetPath, gsub("^.*/(.*)", "\\1", tagUrl))
        print("Downloading file")
        download.file(tagUrl, tagFName, method = "internal", quiet = TRUE)
        #unzipFile(tagFName)
        unzipFile(tagFName, where = targetPath,isgz = FALSE)
        tagFName <- getMapFileName()
    }else{
        tagFName <- tagUrl
    }
    print("Finding the mappings")
    if(tag2UG){
        # Maps SAGE tags to UniGene ids
        tagNUG <- doTag2UG(tagFName)
    }else{
        # Maps UniGene ids to SAGE tags
        tagNUG <- doUG2Tag(tagFName)
    }
    mapName <- file.path(targetPath, basename(tempfile("tagmap")))
    # Write to file for later use
    print("Writing data to database table")
    write.table(tagNUG, mapName, sep = "\t", quote = FALSE,
                col.names = FALSE, row.names = FALSE)
    # Write file to a DB table unsing copy which is efficient
    writeSAGE2DB(getSLyzerArgs()[["dbArgs"]], c("tag", "ug"),
                 "", "", fileName = mapName,
                 charNum = c(tag = 21, ug = 150), what = "map")
#    writeTagUGMap(mapName)
    unlink(mapName)
    if(.Platform$OS.type == "unix" && fromWeb){
         curDir <- getwd()
         setwd(targetPath)
         system(paste("chmod +x", organism))
         system(paste("rm -r", organism))
         setwd(curDir)
    }
}

#unzipFile <- function(fileName, where =
#                      file.path(.path.package("SAGElyzer"), "temp")){
#    curDir <- getwd()
#    setwd(where)
#    if(.Platform$OS.type == "unix"){
#        if(!is.null(getOption("unzip"))){
#            system(paste(getOption("unzip"), basename(fileName)))
#        }else{
#            stop("Can not find unzip in the path")
#        }
#    }else if(.Platform$OS.type == "windows"){
#        zip.unpack(fileName, getwd())
#    }else{
#        stop(paste("Do not know how to unzip file under", .Platform$OS.type))
#    }
#    setwd(curDir)
#}

doTag2UG <- function(fileName){
    dataRead <- read.table(fileName, sep = "\t",
                           header = FALSE, quote = "", comment.char =  "")
    dataRead <- cbind(as.vector(dataRead[,1]),
                      paste(dataRead[,2], dataRead[,3], sep = "."))
    return(dataRead)
}

doUG2Tag <- function(fileName, sep = "\t", header = FALSE){
    dataRead <- read.table(fileName, sep = "\t",
                           header = FALSE, quote = "", comment.char =  "")
    dataRead <- cbind(paste(dataRead[,2], dataRead[,3], sep = "."),
                      as.vector(dataRead[,1]))
    return(dataRead)
}

getMapFileName <- function(){
    return(file.path(.path.package("SAGElyzer"), "temp", "Hs",
    "NlaIII", "SAGEmap_tag_ug-rel"))
}

#writeTagUGMap <- function(fileName, dbArgs =
#                          getSLyzerArgs()[["dbArgs"]], what = "map"){

#    conn <- makeConnection(dbArgs)

#    if(tableExists(conn, dbArgs[[what]])){
#        executeQuery(paste("drop table", dbArgs[[what]]), conn, TRUE)
#    }

    # Create an empty table
#    newTableSQL <- paste("create table ", dbArgs[[what]], " ( ",
#                         getColSQL(c("tag", "ug"), 40, "tag", ""),
#                         "primary key(tag))")

#    executeQuery(newTableSQL, conn, TRUE)
    # Copy file to the table created
 #   writeSQL <- paste("copy ", dbArgs[[what]], " from '", fileName,
#                      "' using delimiters '\t'", sep = "")
#    executeQuery(writeSQL, conn, TRUE)

#    closeConn(conn)
#    writeSAGE2DB(dbArgs, c("tag", "ug"), "", "", fileName = fileName,
#                 charNum = c(tag = 21, ug = 150), what = what)
#}

# This widget is the main widget of SAGElyzer
#
# Copyright 2003, J. Zhang. All rights reserved.
#

SAGEWidget <- function(){

    DBSET <- FALSE

    makeCon <- function(){
        if(getDBArgs()){
            if(!DBSET){
                popTask()
            }
        }
    }

    popTask <- function(){
        DBSET <<- TRUE

        taskButs <- list()
        tasks <- getTasks()
        tkconfigure(taskList, state = "normal")
        for(task in 1:length(tasks)){
            fun <- function() {}
            body <- list(as.name("{"),
                         substitute(tasks[[i]](base, funcList, status),
                                    list(i = task)))
            body(fun) <- as.call(body)
            assign(paste("taskFun", task, sep = ""), fun)
            taskButs[[task]] <- tkbutton(base, width = 16, text =
                                         names(tasks)[task])
            tkbind(taskButs[[task]], "<B1-ButtonRelease>",
                   get(paste("taskFun", task, sep = "")))
            ## bind to tooltip
            tip <- function() {}
            body <- list(as.name("{"),
                         substitute(tooltip(i, taskButs[[j]]),
                                    list(i = getTaskTips(names(tasks)[task]),
                                         j = task)))
            body(tip) <- as.call(body)
#            assign(paste("tipFun", task, sep = ""), tip)
            tkbind(taskButs[[task]], "<Enter>", tip)
#                   get(paste("tipFun", task, sep = "")))
            tkwindow.create(taskList, "end",
                            window = taskButs[[task]])
            tkinsert(taskList, "end", "\n")
        }
        tkconfigure(taskList, state = "disabled")
    }

    quit <- function(){
        tkdestroy(base)
    }

    base <- tktoplevel()
    on.exit(tkdestroy(base))

    tktitle(base) <- "SAGElyzer"
    tkpack(tklabel(base, text = paste("Welcome to SAGElyzer,\n",
                         "Bioconductor's SAGE data management",
                         "and analysis tool")),
           expand = FALSE, fill = "x", pady = 10)
    mainFrame <- tkframe(base, borderwidth = 2, relief = "raised")
    dbFrame <- tkframe(mainFrame)
    tkpack(tklabel(dbFrame, text = "Connection to a database is required"),
           side = "left", expand = FALSE, fill = "x")
    dbBut <- tkbutton(dbFrame, text = "Connect", width = 8, command = makeCon)
    tkpack(dbBut, side = "left", expand = FALSE, fill = "x")
    tkpack(dbFrame, expand = FALSE, fill = "x", padx = 3, pady = 3)

    listFrame <- tkframe(mainFrame)
    taskFrame <- tkframe(listFrame)
    tkpack(tklabel(taskFrame, text = "Tasks"), expand = FALSE, fill = "x")
    # Tasks are jobs to be done (e. g. integrate data, do knn, ...)
    tasks <- getTasks()
    taskList <- makeViewer(taskFrame, vWidth = 20, vHeight = 18,
                           vScrol = TRUE, hScrol = FALSE, what = "text")
    tkconfigure(taskList, state = "disabled")
    tkpack(taskFrame, side = "left", expand = TRUE, fill = "both")
    funcFrame <- tkframe(listFrame)
    tkpack(tklabel(funcFrame, text = "Procedures"),
           expand = FALSE, fill = "x")
    funcList <- makeViewer(funcFrame, vWidth = 20, vHeight = 18,
                           vScrol = TRUE, hScrol = FALSE, what = "text")
    tkconfigure(funcList, state = "disabled")
    tkpack(funcFrame, side = "left", expand = TRUE, fill = "both")
    tkpack(listFrame, expand = TRUE, fill = "y")

    tkpack(mainFrame, expand = TRUE, fill = "both", padx = 5)

    endBut <- tkbutton(base, text = "Quit", width = 10, comman = quit)
    tkpack(endBut, expand = FALSE, padx = 5, pady = 5)

    status <- tkentry(base, state = "disabled", foreground = "red")
    tkpack(status, expand = FALSE, fill = "x")
    if(length(getSLyzerArgs()$dbArgs) > 1){
        popTask()
    }

    tkwait.window(base)

    return(invisible())
}


getTasks <- function(){
    return(list("Manage Data" = getDMProc, "knn" = getKNNProc))
}

getDMProc <- function(base, TBox, status){
    procs <- list("Get GEO SAGE" = SAGEFromGEO, "Integrate SAGE" =
                  procSAGE, "Map SAGE" = mapSAGE2UG)
    butsInTBox(base, TBox, status, procs, TRUE)
}

getKNNProc <- function(base, TBox, status){
    procs <- list("Set arguments" = setKNNArgs,
                  "Run knn" = runSLyzer,
                  "Get counts" = getLibCounts,
                  "Map SAGE" = linkTag2UG,
                  "Find neighbor genes" = findNG4Tag)
    butsInTBox(base, TBox, status, procs, TRUE)
}

butsInTBox <- function(base, TBox, status, butList, clear = FALSE){
    tkconfigure(TBox, state = "normal")
    if(clear){
        tkdelete(TBox, "0.0", "end")
    }
    procButs <- list()
    for(i in 1:length(butList)){
        fun <- function() {}
        body <- list(as.name("{"),
                     substitute(tkconfigure(status, state = "normal")),
                     substitute(writeList(status, paste("Running ",
                       "procedure \"", j, "\". Please wait.", sep = ""),
                       clear = TRUE), list(j = names(butList)[i])),
                     substitute(butList[[j]](), list(j = names(butList)[i])),
                     substitute(writeList(status, "", clear = TRUE)),
                     substitute(tkconfigure(status, state = "disabled")))
        body(fun) <- as.call(body)
        assign(paste("procFun", i, sep = ""), fun)
        procButs[[i]] <- tkbutton(base, width = 16, text = names(butList)[i])
        tkbind(procButs[[i]],  "<B1-ButtonRelease>",
               get(paste("procFun", i, sep = "")))

        tip <- function() {}
        body <- list(as.name("{"),
                     substitute(tooltip(j, procButs[[k]]),
                                list(j = getTaskTips(names(butList)[i]),
                                     k = i)))
        body(tip) <- as.call(body)
        assign(paste("tipFun", i, sep = ""), tip)
        tkbind(procButs[[i]], "<Enter>",
               get(paste("tipFun", i, sep = "")))

        tkwindow.create(TBox, "end", window = procButs[[i]])
        tkinsert(TBox, "end", "\n")
    }
    tkconfigure(TBox, state = "disabled")
}

getTaskTips <- function(task){
    load(file.path(.path.package("SAGElyzer"), "data", "SAGEToolTips.rda"))
    if(any(names(SAGEToolTips) == task)){
        return(SAGEToolTips[[task]])
    }else{
        stop("Unknown task name passed to getTaskTips")
    }
}

# This function makes a connection to a given database using the
# arguments passed as a list.
#
# args - a list containing the arguments presented as name and value
#        pairs. Valid element names include "dbname", "user", "password",
#        "host", "hostaddr", and "port".
# dbObj - a binding object for a given dbms (e. g. PgSQL() for postgreSQL).
#
# Copyright 2002, J. Zhang. All rights reserved.
#

# Make db connection under Unix
con4Win <- function(args){
#    require(RODBC) || stop("Package RODBC unavailable")
    return(odbcConnect(args[["DSN"]]))
}
# Make db connection under Unix
con4Unix <- function(args){
#    require(Rdbi) || stop("Package Rdbi unavailable")
    FORMAL <- c("host", "hostaddr", "port", "dbname", "user",
               "password", "dbObj")
    # filters out args not needed for making connection
    args <- args[intersect(names(args), FORMAL)]
    return(do.call("dbConnect", args))
}
# Make a connection to a database
makeConnection <- function(args){
    switch(.Platform$OS.type,
           "windows" = return(con4Win(args)),
           "unix" = return(con4Unix(args)),
           stop("Unknown OS system"))
}
# Execute a query
executeQuery <- function(sqlStat, conn, noReturn = FALSE){
    switch(.Platform$OS.type,
           "windows" = return(sqlQuery(conn, sqlStat)),
           "unix" = return(query4Unix(sqlStat, conn, noReturn)),
           stop("Unknown OS system"))
}
# Does query under Unix
query4Unix <- function(sqlStat, conn, noReturn = FALSE){
    queryResult <- dbSendQuery(conn, sqlStat)
    if(!noReturn){
        queryResult <- dbGetResult(queryResult)
        return(queryResult)
    }
}
# Close a connection
closeConn <- function(conn){
    options(show.error.messages = FALSE)
    switch(.Platform$OS.type,
           "windows" = try(odbcClose(conn)),
           "unix" = try(dbDisconnect(conn)),
           stop("Unknown OS system"))
    options(show.error.messages = TRUE)
}

tableExists <- function(conn, tableName){
    if(.Platform$OS.type == "windows"){
        options(show.error.messages = FALSE)
        tryMe <- try(odbcTableExists(conn, tableName))
        options(show.error.messages = TRUE)
        if(inherits(tryMe, "try-error")){
            return(FALSE)
        }else{
            return(TRUE)
        }
    }else{
        relNames <- dbListTables(conn)$relname
        if(is.element(tableName, relNames)){
            return(TRUE)
        }else{
            return(FALSE)
        }
    }
}
# These functions get the SAGE files from NCBI and save the files in
# the data directory by default or somewhere as defined by users.
#
# Copyright 2002, J. Zhang. All rights reserved.
#
getGEOSAGE <- function(organism = "human", targetDir = "", quiet = TRUE,
               url = "http://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?"){

    if(targetDir == "")
        targetDir <- file.path(.path.package("SAGElyzer"), "temp")

    fileNames <- getFileNames(organism, url)

    for(i in fileNames){
        if(!quiet){
            print(paste("Downloading file:", i))
        }
        geo <- GEO(url)
        geoData <- readData(geo, i)
        write.table(geoData, file =  file.path(targetDir,
                             paste(i, ".sage", sep = "")),
                    quote = FALSE, sep = "\t", row.names = FALSE,
                    col.names = FALSE)
    }
}

getFileNames <- function(organism, url){
    switch(tolower(organism),
           "human" = gpl <- "GPL4",
           "mouse" = gpl <- "GPL11",
           "rat" = gpl <- "GPL23",
           stop("The organism is not supported this time"))

    fullUrl <- paste(url, "acc=", gpl, "&form=text&&view=data", sep = "")
    ids <- getSampleId(fullUrl)

    return(ids)
}

getSampleId <- function(url){
    ids <- NULL
    con <- url(url, open = "r")
    idFile <- readLines(con)
    for(i in idFile){
        if(regexpr("^!Platform_sample", i) > 0)
            ids <- c(ids, gsub("^!Platform_sample_id = ", "", i))
    }
    return(ids)
}
# Not useful now
#parseSAGE <- function(inName, outName){

#    perlName <- file.path(.path.package("SAGElyzer"), "exec",
#                         "GEOSAGEParser.pl")
#    OST <- .Platform$OS.type
#    if (OST == "windows")
#        shell.exec(paste("perl", perlName, inName, outName))
#    else if (OST == "unix")
#        system(paste("perl", perlName, inName, outName))
#    else
#        stop("don't know how to run perl")
#}








# A widget for taking inputs for mergeSAGE.
#
# Copyright 2003, J. Zhang, all rights reserved
#

mapSAGEWidget <- function(){
    on.exit(end())

    tableVar <- tclVar("tagugmap")
    mapVar <- tclVar("TRUE")
    if(.Platform$OS.type == "unix"){
        urlVar <- tclVar(paste("ftp://ftp.ncbi.nih.gov/pub/sage/map/Hs/",
                           "NlaIII/SAGEmap_tag_ug-rel.zip", sep = ""))
    }else{
        urlVar <- ""
    }
    args <- NULL
    END <- TRUE
    end <- function(){
        if(END){
            tempArgs <- getSLyzerArgs()
            tempArgs$dbArgs$tableName <- tclvalue(tableVar)
            modSLyzerArgs("dbArgs", tempArgs$dbArgs)
            if(class(urlVar) == "tclVar"){
                urlVar <- tclvalue(urlVar)
            }
            if(class(mapVar) == "tclVar"){
                mapVar <- tclvalue(mapVar)
            }
            args <<- list(tag2UG = as.logical(mapVar),
                         tagUrl = urlVar)
        }
        tkdestroy(base)
    }
    cancel <- function(){
        END <<- FALSE
        end()
    }
    setDB <- function(){
        getDBArgs()
        tableVar <<- getSLyzerArgs()$dbArgs$tableName
        writeList(tableEntry, tableVar, TRUE)
    }
    getSrcData <- function(){
        urlVar <<- tclvalue(tkgetOpenFile())
        writeList(urlEntry, urlVar)
    }

    base <- tktoplevel()
    tktitle(base) <- "BioC SAGElyzer"

    label2 <- tklabel(base, text = "DB Table Name")
    tableFrame <- tkframe(base)
    tableEntry <- tkentry(tableFrame, width = 50, textvariable = tableVar)
    tkpack(tableEntry, side = "left", expand = TRUE, fill = "x")
    resetBut <- tkbutton(tableFrame, width = 8, text = "Reset",
                                                 command = setDB)
    tkpack(resetBut, side = "left")
    tkgrid(label2, tableFrame, padx = 5)

    label1 <- tklabel(base, text = "Map")
    mapFrame <- tkframe(base)
    trueRad <- tkradiobutton(mapFrame, text = "Tag to UG",
                             variable = mapVar, value = "TRUE")
    falseRad <- tkradiobutton(mapFrame, text = "UG to Tag",
                              variable = mapVar, value = "FALSE")
    tkpack(trueRad, falseRad, side = "left")
    tkgrid(label1, mapFrame, padx = 5)

    urlFrame <- tkframe(base)
    if(.Platform$OS.type == "windows"){
        urlText <- "Source data"
    }else{
        urlText <- "Source URL"
    }
    label3 <- tklabel(base, text = urlText)
    urlEntry <- tkentry(urlFrame, width = 50, textvariable = urlVar)
    urlBut <- tkbutton(urlFrame, width = 8, text = "browse",
                       command = getSrcData)
    tkpack(urlEntry, side = "left", expand = TRUE, fill = "x")
    tkpack(urlBut, side = "left", expand = FALSE)
    tkgrid(label3, urlFrame, padx = 5)

    tkgrid.configure(label1, label2, label3, sticky = "e")
    tkgrid.configure(tableFrame, mapFrame, urlFrame, sticky = "w")
    butFrame <- tkframe(base)
    endBut <- tkbutton(butFrame, text = "Continue", width = 8, command = end)
    cancelBut <- tkbutton(butFrame, text = "Cancel", width = 8,
                                                     command = cancel)
    tkpack(endBut, cancelBut, side = "left", padx = 20)
    tkgrid(butFrame, columnspan = 2, pady = 5)

    tkwait.window(base)

    return(args)
}
# These functions merge SAGE library files and write the merged data
# to a database table.
# libNames - a character string or a vector of character strings for
# the name of a directory where sage lib files are contained or for
# sage library files.
# infoName - a character string for the name of the file that keeps
# the mapping bettwen the original file names and a code in the form
# of "lib1", "lib2", ... . The mappings can be used to map table
# columns back to original file names when a database table is created
# using the merged file.
# isDir - a boolean to indicate whether libNames is only a string for
# the name of the directory where the original files are stored.
# skip - an integer for the number of top lines to be skiped from each
# SAGE library when reading the file.
# pattern - a character string for the pattern shared by all the original
# files to be merged. This argument is useful when only files with the given
# pattern will be merged.
#
# Copyright 2003, J. Zhang, all rights reserved.
#

mergeSAGE <- function(libNames, isDir = TRUE,  skip = 1, pattern = ".sage"){
    if(isDir){
        if(!missing(pattern)){
            fileNames <- list.files(path = libNames, pattern = pattern,
                          full.name = TRUE)
        }else{
            fileNames <- list.files(path = libNames, full.name = TRUE)
        }
    }else{
        fileNames <- libNames
    }
    path <- file.path(.path.package("SAGElyzer"), "temp")
    # Get the unique tags
    # print("Finding the unique tags")
    uniqTags <- getUniqTags(fileNames, skip = skip)
    uTagFile <- file.path(path, basename(tempfile("uTag")))
    write.table(uniqTags, uTagFile, quote = FALSE,
                sep = "\t", row.names = FALSE, col.names = FALSE)
    # Sort so that correct mappings between lib code and original lib
    # files can be obtained
    fileNames <- sort(fileNames)
    names(fileNames) <- paste("lib", 1:length(fileNames), sep = "")
    # Creating individual files each has count for each of the unique
    # tags using the original files. Tags missing from an original
    # file have a count of 0
    # print("Processing and merging files")
    writeSAGECounts(fileNames, uniqTags, skip)
    # A file name for the output file
    outName <-  file.path(path, "sage.merged")
    # Write the information data file
    infoName <- file.path(path, "sage.info")
    write.table(getLibInfo(fileNames), infoName, quote = FALSE,
                sep = "\t", row.names = FALSE, col.names = FALSE)

    if(.Platform$OS.type == "unix"){
        # Write to a file using unix command - paste
        system(paste(c("paste", uTagFile,
                       file.path(path, paste(names(fileNames),
                                       ".out", sep = "")), ">",
                                               outName), collapse = " "))
        writeSAGE4Unix(outName, infoName)
    }else if(.Platform$OS.type == "windows"){
        writeSAGE4Win(fileNames, uniqTags, infoName)
    }
    # Remove the temporary files
    file.remove(c(uTagFile, file.path(path, paste(names(fileNames),
                                       ".out", sep = ""))))
}

# This function returns a data frame with three columns for the database
# table column name, library file name, and count of number of rows for
# each SAGE library.
getLibInfo <- function(fileNames){

#    names(fileNames) <- paste("lib", 1:length(fileNames), sep = "")

    libinfo <- matrix(ncol = 4, nrow = length(fileNames))
    libinfo[,1] <- names(fileNames)
    libinfo[,2] <- basename(fileNames)
    libinfo[,3] <- calNormFact("min", getLibNNum(fileNames))
    libinfo[,4] <- calNormFact("max", getLibNNum(fileNames))

    return(libinfo)
}

# This function calculates the normalization factors for SAGE
# libraries. libNNum is a named vactor with the value being the number
# of row for each name.
calNormFact <- function(normalize = c("min", "max"), libNNum){

    normalize <- match.arg(normalize)
    switch(normalize,
           min = temp <- min(as.numeric(libNNum)),
           max = temp <- max(as.numeric(libNNum)),
           stop("Invalid argument for normalize"))

    return(signif(as.numeric(temp/as.numeric(libNNum)) ,4))
}

# This function calculates the number of rows for each of the files
# passed as an argument. Argument fileNames must be a named vector.
getLibNNum <- function(fileNames){
    getNum <- function(fileName){
        return(length(readLines(fileName)))
    }
    return(sapply(fileNames, getNum))
}

# This function reads SAGE libraries and extracts the unique tags from
# them.
# fileNames - a character string for sage library files.
# skip - an integer to indicate how many lines of each of the library
# files to be skiped.

getUniqTags <- function(fileNames, skip = 1, sep = "\t"){

    tagFromOne <- function(filename){
        temp <- read.table(filename, header = FALSE, skip = skip,
                           sep = sep, as.is = TRUE)
        return(temp[,1])
    }

    uniqueTags <- sapply(fileNames, tagFromOne)
    # Do it by steps to avoid memory problems in Windows
    uniqueTags <- unique(unlist(uniqueTags, use.names = FALSE))
    # Remove entries that are not of correct length
    # nchr <- sapply(uniqueTags, nchar)
    # nchr <- max(nchr[duplicated(nchr)])
    # uniqueTags <- uniqueTags[sapply(uniqueTags, nchar) == nchr]

    return(uniqueTags)
}

# This function reads in a vector of uniquie SAGE tags and maps counts
# from a SAGE library to the correct cell.
writeSAGE4Win <- function(fileNames, uniqTags, infoData, pace = 1000){

    path <- file.path(.path.package("SAGElyzer"), "temp")

    dbArgs <- getSLyzerArgs()$dbArgs
    conn <- makeConnection(dbArgs)
    if(tableExists(conn, dbArgs[["counts"]])){
        executeQuery(paste("drop table", dbArgs[["counts"]]), conn, TRUE)
    }
    infoFile <- read.table(infoData, header = FALSE, sep = "\t", as.is = TRUE)
    dbArgs <- getSLyzerArgs()$dbArgs
    colNames <- c("tag", infoFile[,1])
    keys <- "tag"
    intCols <- colNames[colNames != "tag"]
    # Create empty tables for counts
    newTableSQL <- paste("create table ", dbArgs[["counts"]], " (",
                         getColSQL(colNames, 21, "tag", infoFile[,1], "int4"),
                         "primary key(tag))", sep = "")
    executeQuery(newTableSQL, conn, TRUE)
    nrow <- length(uniqTags)
    begin <- 1
    end <- pace
    skip <- 0
    # Chop off a section from uniqTags, map file to tags, and write to file
    for(j in 1:floor(nrow/pace)){
        # Force a clean up
        temp <- mapFile2Tag(file.path(path, paste(names(fileNames),
                     ".out", sep = "")), uniqTags[begin:end], skip, pace)
        # Write to a table
        temp <- as.data.frame(temp)
        colnames(temp) <- colNames
        sqlSave(conn, temp, dbArgs[["counts"]], TRUE, FALSE, FALSE)

        begin <- end + 1
        skip <- end
        end <- (j + 1) * pace
    }
    temp <- mapFile2Tag(file.path(path, paste(names(fileNames),
               ".out", sep = "")), uniqTags[begin:length(uniqTags)],
                        skip, length(uniqTags) - skip)
    temp <- as.data.frame(temp)
    colnames(temp) <- colNames
    sqlSave(conn, temp, dbArgs[["counts"]], TRUE, FALSE, FALSE)
    temp <- NULL
    # Write info to table
    if(tableExists(conn, dbArgs[["info"]])){
        executeQuery(paste("drop table", dbArgs[["info"]]), conn, TRUE)
    }
    colNames <- c("libname", "filename", "minfactor", "maxfactor")
    intCols <- c("minfactor", "maxfactor")
    newTableSQL <- paste("create table ", dbArgs[["counts"]], " (",
                         getColSQL(colNames, 40, "libname",
                                   intCols, "float4"),
                         "primary key(libname))", sep = "")
    executeQuery(newTableSQL, conn, TRUE)
    temp <- read.table(infoData, sep = "\t", header = FALSE, as.is = TRUE)
    colnames(temp) <- colNames
    sqlSave(conn, temp, dbArgs[["info"]], TRUE, FALSE, FALSE)

#    closeConn(conn)
}

writeSAGE4Unix <- function(countData, infoData){

    infoFile <- read.table(infoData, header = FALSE, sep = "\t", as.is = TRUE)
    dbArgs <- getSLyzerArgs()$dbArgs
    # Write counts to table
    colNames <- c("tag", infoFile[,1])
    keys <- "tag"
    intCols <- colNames[colNames != "tag"]
    writeSAGE2DB(dbArgs, colNames, keys, intCols, countData, "counts")
    # Write info to table
    colNames <- c("libname", "filename", "minfactor", "maxfactor")
        keys <- "libname"
    intCols <- c("minfactor", "maxfactor")
    writeSAGE2DB(dbArgs, colNames, keys, intCols, infoData,
                     "info", charNum = 40, type = "float4")
}

# Map counts from each file to a chunk of unique tags
mapFile2Tag <- function(fileNames, tags, skip, n){
    mapOne <- function(filename){
        temp <- scan(filename, what = "", skip = skip, n = n,quiet = TRUE)
        return(temp)
    }

    mapped <- sapply(fileNames, mapOne)
    mapped <- matrix(unlist(mapped, use.names = FALSE), byrow = FALSE,
                     ncol = length(fileNames))
    mapped <- cbind(matrix(tags, ncol = 1), mapped)

    return(mapped)
}

# This function reads the library files, map counts to unique SAGE
# tags, and create files containg the counts only. Tags missing from
# the original files will have counts 0.
writeSAGECounts <- function(fileNames, uniqTags, skip, sep = "\t"){
#    outNames <- NULL
    # Process each library and write counts from a library to the
    # correct location
    for(i in 1:length(fileNames)){
        # Read in a library
        temp <- as.matrix(read.table(fileNames[i], header = FALSE,
                                 sep = sep, skip = skip, as.is = TRUE))

        # Match unique tags agaist the library
        out <- rep(0, length(uniqTags))
#        matched <- match(temp[,1], uniqTags)
        out[match(temp[,1], uniqTags)] <- gsub(" *", "", temp[,2])
        # Free memory
        temp = NULL
        gc()
        # Write to a file
        tempName <- file.path(.path.package("SAGElyzer"), "temp",
                              paste(names(fileNames)[i], ".out",
                                    sep = ""))
        write(out, ncol=1, file = tempName)
#        outNames <- c(outNames, tempName)
    }
#    return(outNames)
}










# A widget for taking inputs for mergeSAGE.
#
# Copyright 2003, J. Zhang, all rights reserved
#

mergeSAGEWidget <- function(){
    on.exit(end())

    libNameVar <- tclVar(file.path(.path.package("SAGElyzer"), "temp"))
    isDirVar <- tclVar("TRUE")
    skipVar <- tclVar("0")
    patternVar <- tclVar(".sage")
    args <- NULL
    END <- TRUE

    end <- function(){
        tkdestroy(base)
    }
    cancel <- function(){
        END <<- FALSE
        end()
    }
    getLibNames <- function(){
        libNameVar <- paste(fileBrowser(path =
                            file.path(.path.package("SAGElyzer"), "temp")),
                            sep = "", collapse = ";")
        writeList(libEntry, libNameVar, TRUE)
    }


    base <- tktoplevel()
    tktitle(base) <- "BioC SAGElyzer"

    label2 <- tklabel(base, text = "Library")
    libFrame <- tkframe(base)
    libEntry <- tkentry(libFrame, width = 50, textvariable = libNameVar)
    tkpack(libEntry, side = "left", expand = TRUE, fill = "x")
    browseBut <- tkbutton(libFrame, width = 6, text = "Browse",
                                                 command =getLibNames)
    tkpack(browseBut, side = "left")
    tkgrid(label2, libFrame, padx = 5)

    label1 <- tklabel(base, text = "Directory")
    dirFrame <- tkframe(base)
    trueRad <- tkradiobutton(dirFrame, text = "TRUE", variable = isDirVar,
                             value = "TRUE")
    falseRad <- tkradiobutton(dirFrame, text = "FALSE",
                              variable = isDirVar, value = "FALSE")
    tkpack(trueRad, falseRad, side = "left")
    tkgrid(label1, dirFrame, padx = 5)

    label3 <- tklabel(base, text = "Skip")
    skipEntry <- tkentry(base, width = 50, textvariable = skipVar)
    tkgrid(label3, skipEntry, padx = 5)

    label4 <- tklabel(base, text = "Pattern")
    patternEntry <- tkentry(base, width = 50, textvariable = patternVar)
    tkgrid(label4, patternEntry, padx = 5)

    tkgrid.configure(label1, label2, label3, label4, sticky = "e")
    tkgrid.configure(dirFrame, libFrame, skipEntry, patternEntry,
                                                         sticky = "w")
    butFrame <- tkframe(base)
    cancelBut <- tkbutton(butFrame, text = "Cancel", width = 8,
                          command = cancel)
    endBut <- tkbutton(butFrame, text = "Continue", width = 8, command = end)
    tkpack(endBut, cancelBut, side = "left", padx = 20)
    tkgrid(butFrame, columnspan = 2, pady = 5)

    tkwait.window(base)
    if(END){
        args <- list(libNames = unlist(strsplit(tclvalue(libNameVar), ";")),
                     isDir = as.logical(tclvalue(isDirVar)),
                     skip = as.numeric(tclvalue(skipVar)))
        if(!any(tclvalue(patternVar) == c("", "NULL", "null", "NA", "na"))){
            args[["pattern"]] <- tclvalue(patternVar)
        }
    }

    return(args)
}
# This function provides the interface for inputing query parameters
# for querying a table in a given database. Interface between R and
# the underlaying database management system is through Rdbi.
#
# args - a list containing the arguments presented as name and value
#        pairs. Valid element names include "dbname", "user", "password",
#        "host", "hostaddr", and "port".
# dbObj - a binding object for a given dbms (e. g. PgSQL() for postgreSQL).
#
# Copyright 2002 J. Zhang, all rights reserved
#
querySAGE <- function (args, dbObj = PgSQL()){

    on.exit(end())
    text1 <- paste("Select a table to query (database = ",
                                     args[["dbname"]], ").", sep = "")
    text2 <- "Select columns from the table"

    columns <- NULL
    colIndex <- NULL
    indexInSel <- NULL

    end <- function(){
        tkdestroy(base)
    }

    # When a table name in the list gets clicked, the name is shown in
    # the entry box besides the list box and all the column names of
    # the table shown in the list box below for selection
    tableSelected <- function(){
        tName <- tclvalue(tkget(tableView, tkcurselection(tableView)))
        writeList(tableName, tName)
        writeList(colView, names(getColumnNames(tName, args, dbObj)))
    }

    # When a user double clicks a column name in the list box, put the
    # library name in the vector for selected SAGE libraries.
    colDClicked <- function(){
        column <- as.character(tkget(colView,(tkcurselection(colView))))
        columns <<- unique(c(columns, column))
        writeList(selectView, columns)
        tkconfigure(clearBut, state = "normal")
        tkconfigure(selectBut, state = "disabled")
    }
    # When a user single clicked a column name, remember that name and
    # activate the select button
    colSClicked <- function(){
        colIndex <<- unlist(strsplit(tkcurselection(colView), " "))
        tkconfigure(selectBut, state = "normal")
    }
    # When a user click the select button, put the selected column name
    # in the list box for selected columns
    selectCol <- function(){
        for(i in colIndex){
            columns <<- c(columns, paste(as.character(tkget(tableName)),
                          ".", as.character(tkget(colView, i)), sep = ""))
        }
        writeList(selectView, unique(columns))
        tkconfigure(selectBut, state = "disabled")
        tkconfigure(clearBut, state = "normal")
    }
    # Remember the column name when a name in the selected column names list
    # box is single clicked
    selSClick <- function(){
        indexInSel <<- unlist(strsplit(tkcurselection(selectView), " "))
        tkconfigure(remBut, state = "normal")
    }
    # Removes the selected column name from the list box for selected
    # column names
    dropSelCol <- function(){
        for(i in indexInSel){
            columns <<- columns[columns != as.character(tkget(selectView, i))]
        }
        writeList(selectView, columns)
        tkconfigure(remBut, state = "disabled")
    }
    # Remove everything from the list box for selected column names
    clearSelCol <- function(){
        writeList(selectView, "")
        columns <<- NULL
        tkconfigure(clearBut, state = "disabled")
    }

    ## Set up the interface
    base <- tktoplevel()
    tktitle(base) <- "BioC Table Inputs Widget"

    # List of table names
    topFrame <- tkframe(base)
    text1Label <- tklabel(topFrame, text = text1, font = "Helvetica 12")
    tkgrid(text1Label, columnspan = 2, pady = 2)
    tableFrame <- tkframe(topFrame)
    tableView <- makeViewer(tableFrame, vWidth = 40, vHeight = 2,
                           hScroll = TRUE, what = "list")
    tkbind(tableView, "<B1-ButtonRelease>", tableSelected)
    nameFrame <- tkframe(topFrame)
    nameLabel <- tklabel(nameFrame, text = "Table selected")
    tableName <- tkentry(nameFrame, width = 40)
    tkpack(nameLabel, tableName)
    tkgrid(tableFrame, nameFrame, padx = 2)
    tkpack(topFrame, pady = 2)

    # Lists for column names
    midFrame <- tkframe(base)
    text2Label <- tklabel(midFrame, text = text2, font = "Helvetica 12")
    tkgrid(text2Label, columnspan = 2, pady = 2)
    # Label for available SAGE libs
    leftFrame <- tkframe(midFrame)
    label1 <- tklabel(leftFrame, text = "Columns in table",
                        font = "Helvetica 11")
    tkpack(label1)
    # List box showing the available SAGE libs
    colFrame <- tkframe(leftFrame)
    colView <- makeViewer(colFrame, vWidth = 40, vHeight = 15,
                           hScroll = TRUE)
    tkbind(colView, "<Double-Button-1>", colDClicked)
    tkbind(colView, "<B1-ButtonRelease>", colSClicked)
    tkpack(colFrame, padx = 5)
    selectBut <- tkbutton(leftFrame, text = "Select >>", width = 12,
		      state = "disabled", command = selectCol)
    tkpack(selectBut)
    tkconfigure(colView, selectmode = "extended")
    # Put the list box for selected SAGE libs and the associated buttons
    rightFrame <- tkframe(base)
    label2 <- tklabel(rightFrame, text = "Columns selected",
                        font = "Helvetica 11")
    tkgrid(label2, columnspan = 2)
    selLFrame <- tkframe(rightFrame)
    selectView <- makeViewer(selLFrame, vWidth = 40, vHeight = 15,
                             hScroll = TRUE)
    tkgrid(selLFrame, columnspan = 2, padx = 5)
    tkconfigure(selectView, selectmode = "extended")
    tkbind(selectView, "<B1-ButtonRelease>", selSClick)
    remBut <- tkbutton(rightFrame, text = "<< Remove", width = 12,
		      state = "disabled", command = dropSelCol)
    clearBut <- tkbutton(rightFrame, text = "Clear", width = 12,
		      state = "disabled", command = clearSelCol)
    tkgrid(remBut, clearBut)
    tkgrid.configure(remBut, sticky = "e")
    tkgrid.configure(clearBut, sticky = "w")

    tkgrid(leftFrame, rightFrame)
    tkpack(midFrame)

    # A text box for filters
    botFrame <- tkframe(base)
    filterLabel <- tklabel(botFrame, text = "Filter: ")
    filterTextFrame <- tkframe(botFrame)
    filterText <- makeViewer(filterTextFrame, vWidth = 70, vHeight = 2,
                           hScroll = FALSE, what = "text")
    tkpack(filterLabel, side = "left", anchor = "ne")
    tkpack(filterTextFrame, side = "left")
    tkpack(botFrame, pady = 2)

    # Put the end button
    endBut <- tkbutton(base, text = "Finish", width = 12, command = end)
    tkpack(endBut, pady = 5)

    writeList(tableView, unlist(getTableNames(args, dbObj)))

    tkwait.window(base)

    return(columns)
}

getTableNames <- function(args, dbObj){
    tableSQL <- "SELECT relname FROM pg_class WHERE relname !~'^pg_'"
    return(executeQuery(tableSQL, args, dbObj))
}

getColumnNames <- function(tableName, args, dbObj){
    columnSQL <- paste("SELECT * FROM ", tableName, " limit 1", sep = "")
    return(executeQuery(columnSQL, args, dbObj))
}










#selectLibs <- function(){
#    checkMe <- getSLyzerArgs()$dbArgs
#    if(missing(checkMe)){
#        showDBError()
#    }else{
#        libs <- queryInfoDB(infoCol = "filename")
#        picked <- pickItems(libs)
#        libs <- libs[match(picked, libs)]
#        modSLyzerArgs("libs", names(libs))
#    }
#}

ENV <- new.env(hash = TRUE)
getDBArgs <- function(){

    switch(.Platform$OS.type,
           "windows" = dbArgs <- getWinDBArgs(),
           "unix" = dbArgs <- getUnixDBArgs(),
           stop("Unknown operating system"))

    if(!is.null(dbArgs)){
        if(.Platform$OS.type == "unix"){
            if(is.null(dbArgs[["dbname"]]) || is.na(dbArgs[["dbname"]]) ||
               dbArgs[["dbname"]] == ""){
                temp <- tkmessageBox(title = "DB error",
                                     message = paste("Database name",
                                     "can not be null, na, or empty!"),
                                     icon = "warning", type = "ok")
                getDBArgs()
            }else{

                modSLyzerArgs("dbArgs", dbArgs)
            }
        }else{
            if(is.null(dbArgs[["DSN"]]) || is.na(dbArgs[["DSN"]]) ||
               dbArgs[["DSN"]] == ""){
                temp <- tkmessageBox(title = "DB error",
                                     message = paste("Database name",
                                     "can not be null, na, or empty!"),
                                     icon = "warning", type = "ok")
                getDBArgs()
            }else{
                modSLyzerArgs("dbArgs", dbArgs)
            }
        }
        options(show.error.messages = FALSE)
        tryMe <- try(makeConnection(dbArgs))
        options(show.error.messages = FALSE)
        if(inherits(tryMe, "try-error")){
            temp <- tkmessageBox(title = "DB error",
                                     message = paste("Connect connect",
                                     "to database because of", tryMe),
                                     icon = "warning", type = "ok")
            return(FALSE)
        }else{
            closeConn(tryMe)
            return(TRUE)
        }
    }
    return(FALSE)
}

getUnixDBArgs <- function(binding = "pg"){
    args <- list(dbObj = getBinding(binding))

    SAGELyzerArgs <- getSLyzerArgs()
    if(length(SAGELyzerArgs$dbArgs) == 1){
        temp <- argsWidget(list(Database = "", User = "",
                Password = "", Host = "localhost", Counts = "sagecounts",
                Info = "sageinfo", Map = "tagugmap"),
                defaultNames = c("Connect", "Cancel"),
                           inst = paste("Fill in blanks and use default",
                           "values for others if not sure"))
    }else{
        temp <- argsWidget(list(Database = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$dbname), "",
                                SAGELyzerArgs$dbArgs$dbname),
                                User = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$user), "",
                                SAGELyzerArgs$dbArgs$user),
                                Password = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$password), "",
                                SAGELyzerArgs$dbArgs$password),
                                Host = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$host), "",
                                        SAGELyzerArgs$dbArgs$host),
                                Counts = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$counts), "",
                                        SAGELyzerArgs$dbArgs$counts),
                                Info = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$info), "",
                                        SAGELyzerArgs$dbArgs$info),
                                Map = ifelse(
                                is.null(SAGELyzerArgs$dbArgs$map), "",
                                        SAGELyzerArgs$dbArgs$map)),
                                defaultNames = c("Connect", "Cancel"),
                            inst = paste("Fill in blanks and use default",
                           "values for others if not sure"))
    }
    if(!is.null(temp)){
        args[["dbname"]] <- temp[["Database"]]
        args[["user"]] <- temp[["User"]]
        args[["password"]] <- temp[["Password"]]
        args[["host"]] <- temp[["Host"]]
        args[["counts"]] <- temp[["Counts"]]
        args[["info"]] <- temp[["Info"]]
        args[["map"]] <- temp[["Map"]]
        return(args)
    }else{
        return(temp)
    }
}

# Get the correct binding. Only Postgres for now
getBinding <- function(binding = c("pg")){
    binding <- match.arg(binding)
    switch(binding,
           pg = return(PgSQL()),
           stop("Unknown argument for binding"))
}

getWinDBArgs <- function(){
    SAGELyzerArgs <- getSLyzerArgs()
    if(length(SAGELyzerArgs$dbArgs) == 1){
        return(argsWidget(list(DSN = "", counts = "sagecounts",
                               info = "sageinfo", map = "tagugmap"),
                          defaultNames = c("Connect", "Cancel"),
                          inst = paste("Fill in blanks and use default",
                          "values for others if not sure")))
    }else{
        return(argsWidget(list(DSN = ifelse(
                               is.null(SAGELyzerArgs$dbArgs["DSN"]), "",
                               SAGELyzerArgs$dbArgs["DSN"]),
                               counts = ifelse(
                               is.null(SAGELyzerArgs$dbArgs["counts"]), "",
                               SAGELyzerArgs$dbArgs["counts"]),
                               info = ifelse(
                               is.null(SAGELyzerArgs$dbArgs["info"]), "",
                               SAGELyzerArgs$dbArgs["info"]),
                               map = ifelse(
                               is.null(SAGELyzerArgs$dbArgs["map"]), "",
                               SAGELyzerArgs$dbArgs["map"])),
                          defaultNames = c("Connect", "Cancel"),
                           inst = paste("Fill in blanks and use default",
                           "values for others if not sure")))
    }
}

getTag <- function(){
    cancel <- FALSE
    temp <- toupper(unlist(argsWidget(list(TargetSAGE = "")),
                               use.names = FALSE))
    while(nchar(temp) != 10){
        if(tclvalue(tkmessageBox(
                     message = "Target must be 10 letters.\n Re-enter?",
                     icon = "error", type = "yesno")) == "yes"){
            temp <- toupper(unlist(argsWidget(list(TargetSAGE = "")),
                               use.names = FALSE))
        }else{
            cancel <- TRUE
            break
        }
    }
    if(!cancel){
        modSLyzerArgs("targetSAGE", temp)
    }
}

setKNNArgs <- function(){
    checkMe <- getSLyzerArgs()$dbArgs
    if(missing(checkMe)){
        showDBError()
    }else{
        args <- KNNArgsWidget()
        if(!is.null(args)){
            SAGELyzerArgs <- getSLyzerArgs()
            SAGELyzerArgs[["targetSAGE"]] <-  args[["targetSAGE"]]
            SAGELyzerArgs[["libs"]] <-  args[["libs"]]
            for(i in  c("normalize", "k", "dist", "trans")){
                SAGELyzerArgs[[i]] <- args[[i]]
            }
            writeSLyzerArgs(SAGELyzerArgs)
        }
    }
}

#getDefaults <- function(){
#    formalArgs <- formals(SAGELyzer)
#    argsNames <- c("tagColName", "normalize", "k", "dist", "trans")
#    dArgs <- argsWidget(list(TagName = formalArgs[["tagColName"]],
#                                normalize = formalArgs[["normalize"]],
#                                k = formalArgs[["k"]],
#                                distance = formalArgs[["dist"]],
#                                transform = formalArgs[["trans"]]),
#                        defaultNames = c("Set", "Cancel"))
#    SAGELyzerArgs <- getSLyzerArgs()
#    for(i in 1:length(dArgs)){
#        SAGELyzerArgs[[argsNames[[i]]]] <- dArgs[[i]]
#    }
#    writeSLyzerArgs(SAGELyzerArgs)
#}

getSLyzerArgs <- function(argName = "SAGELyzerArgs"){
    return(get(argName, ENV))
}

writeSLyzerArgs <- function(args, argName = "SAGELyzerArgs"){
    assign(argName, args, ENV)
}

modSLyzerArgs <- function(argName, value){
    SAGELyzerArgs <- getSLyzerArgs()
    SAGELyzerArgs[[argName]] <- value
    writeSLyzerArgs(SAGELyzerArgs)
}

setSLyzerArgs <- function(){
    writeSLyzerArgs(formals(SAGELyzer))
}

runSLyzer <- function(){
    # Just to make sure the status bar gets updated
    Sys.sleep(1)
    if(getSLyzerArgs()$targetSAGE == ""){
        tkmessageBox(title = "KNN Error",
                     message = paste("No target tag has been set yet.\n",
                                     "Use \"Set arguments\" to select",
                     "one"), icon = "warning", type = "ok")
        return(invisible())
    }else{
        args <- getSLyzerArgs()
        # This is not working although args is a list while the system
        # says no
        # knn <- do.call("SAGELyzer", args)

        # Do it this way instead
        knn <- SAGELyzer(dbArgs = args[["dbArgs"]],
                     targetSAGE = args[["targetSAGE"]],
                     libs = args[["libs"]], normalize = args[["normalize"]],
                     tagColName = args[["tagColName"]],
                     k = as.numeric(args[["k"]]),
                     dist = args[["dist"]], trans = args[["trans"]])
        if(!is.null(knn)){
            writeSAGEKNN(knn, args[["targetSAGE"]])
            tempData <- matrix(c(names(knn), knn), ncol = 2, byrow = FALSE)
            colnames(tempData) <- c("Tag", "Distance")
            dataViewer(tempData, paste("Target SAGE:", args[["targetSAGE"]]))
        }
    }
}

writeSAGEKNN <- function(knn, targetSAGE){
    assign("SAGEKNN", list(targetSAGE = targetSAGE, knn = knn),
           "package:SAGElyzer")
}

getSAGEKNN <- function(){
    knn <- get("SAGEKNN","package:SAGElyzer")
    return(knn)
}

getLibCounts <- function(){
    # Just to make sure the status bar gets updated
    Sys.sleep(1)
    options(show.error.messages = FALSE)
    knn <- try(getSAGEKNN())
    options(show.error.messages = FALSE)
    if(inherits(knn, "try-error")){
        tkmessageBox(title = "KNN Error",
                     message = paste("No counts are available.\n",
                     "You have not run knn yet"),
                     icon = "warning", type = "ok")
        return(invisible())
    }else{
        args <- getSLyzerArgs()

        if(is.na(match("*", args[["libs"]]))){
            args[["libs"]] <- c(args[["tagColName"]], args[["libs"]])
        }

        countsSQL <- paste("select ", paste(args[["libs"]], sep = "",
                                       collapse = ","), " from ",
                       args[["dbArgs"]][["counts"]], " where ",
                       args[["tagColName"]], " in('",
                       paste(names(knn$knn), sep = "", collapse = "','"),
                       "')", sep = "")
        conn <- makeConnection(args[["dbArgs"]])
        on.exit(closeConn(conn))
#        print("Querying the database")
        counts <- as.matrix(executeQuery(countsSQL, conn))
        # Make sure the target will be the firest row
        target <- getTargetRow(args[["dbArgs"]], conn,
                               setdiff(args[["libs"]], args[["tagColName"]]),
                               args[["tagColName"]], args[["targetSAGE"]])
        # Convert library code back to library name
        dataToShow <- rbind(as.matrix(target), counts)
        libs <- queryInfoDB(infoCol = "filename")
        colnames(dataToShow) <- as.vector(c("Tag", libs[
                     match(colnames(dataToShow)[2:ncol(dataToShow)],
                           names(libs))]))
        dataViewer(dataToShow)
    }
}

mapLib2File <- function(){
    checkMe <- getSLyzerArgs()$dbArgs
    if(missing(checkMe)){
        showDBError()
    }else{
        libs <- queryInfoDB(infoCol = "filename")
        libs <- cbind(names(libs), as.vector(libs))
        colnames(libs) <- c("DB Column Name", "File Name")
        dataViewer(cbind(names(libs), libs), save = FALSE)
    }
}

linkTag2UG <- function(){
    # Make sure the status bar gets updated
    Sys.sleep(1)
    options(show.error.messages = FALSE)
    knn <- try(getSAGEKNN()$knn)
    options(show.error.messages = FALSE)
    if(inherits(knn, "try-error")){
        tkmessageBox(title = "KNN Error",
                     message = paste("There is nothing to map.\n",
                     "You have not run knn yet"),
                     icon = "warning", type = "ok")
    }else{
        args <- getSLyzerArgs()
        linkSQL <- paste("select * from ", args[["dbArgs"]][["map"]],
                     " where ", args[["tagColName"]] , " in('",
                     paste(c(args[["targetSAGE"]],
                             names(knn)), sep = "",
                           collapse = "','"), "')", sep = "")
        conn <- makeConnection(args[["dbArgs"]])
        on.exit(closeConn(conn))
        mappings <- remapTagNUG(as.matrix(executeQuery(linkSQL, conn)))
        # closeConn(conn)
        url <- file.path(.path.package("SAGElyzer"), "temp", "tagUGMap.html")
        ll.htmlpage(mappings[,2], url, table.head = "UniGene ID",
                    othernames = mappings[,1],
                    title = paste("Tag-UniGene Mappings(Target = ",
                    args[["targetSAGE"]], ")", sep = ""), repository = "ug")

        browseURL(url)
    }
}
remapTagNUG <- function(mappings){
    equalized <- NULL
    equalATag <- function(row){
        ugs <- unlist(strsplit(mappings[row, 2], ";"),
                      use.names = FALSE)
        temp <- cbind(rep(mappings[row, 1], length(ugs)), ugs)
        if(is.null(equalized)){
            equalized <<- temp
        }else{
            equalized <<- rbind(equalized, temp)
        }
    }
    sapply(1:nrow(mappings), equalATag)
    return(equalized)
}

SAGEFromGEO <- function(){
    args <- GEOSAGEWidget()
    if(!is.null(args)){
        do.call("getGEOSAGE", args)
        return("Done")
    }else{
        return("Aborted")
    }
}

procSAGE <- function(){
    checkMe <- getSLyzerArgs()$dbArgs
    if(missing(checkMe)){
        showDBError()
    }else{
        args <- mergeSAGEWidget()
        # Pause to let the system redraw the screen
        Sys.sleep(1)
        if(!is.null(args)){
            merged <- do.call("mergeSAGE", args)
            return("Done")
        }else{
            return("Aborted")
        }
    }
}

mapSAGE2UG <- function(){
    checkMe <- getSLyzerArgs()$dbArgs
    if(missing(checkMe)){
        showDBError()
    }else{
        args <- mapSAGEWidget()
        if(!is.null(args)){
            if(.Platform$OS.type == "windows"){
                args[["fromWeb"]] <- FALSE
            }
            do.call("SAGEMapper", args)
            return("Done")
        }else{
            return("Aborted")
        }
    }
}

showDBError <- function(){
    tkmessageBox(title = "DB error", message = paste("You need to make a",
                 "DB connection using DBConnecter!"), icon = "warning",
                 type = "ok")
    return(invisible())
}

findNG4Tag <- function(){
    org <- argsWidget(list(Organism = "human"),
                      inst = paste("Enter an organism name"))
    if(is.null(org)){
        return(invisible())
    }
    if(!any(tolower(org) == c("human", "mouse", "rat"))){
         tkmessageBox(title = "Error",
                     message = paste("Organism name has to be either",
                     "human, mouse, or rat"),
                     icon = "warning", type = "ok")
    }else{
        Sys.sleep(1)
        options(show.error.messages = FALSE)
        knn <- try(getSAGEKNN()$knn)
        options(show.error.messages = FALSE)
        if(inherits(knn, "try-error")){
            tkmessageBox(title = "KNN Error",
                         message = paste("No target tags available.\n",
                         "You have not run knn yet"),
                         icon = "warning", type = "ok")
        }else{
            args <- getSLyzerArgs()
            linkSQL <- paste("select * from ", args[["dbArgs"]][["map"]],
                             " where ", args[["tagColName"]] , " in('",
                             paste(c(args[["targetSAGE"]],
                                     names(knn)), sep = "",
                                   collapse = "','"), "')", sep = "")
            conn <- makeConnection(args[["dbArgs"]])
            on.exit(closeConn(conn))
            mappings <- remapTagNUG(as.matrix(executeQuery(linkSQL, conn)))
            colnames(mappings) <- c("tag", "unigene")
            neighbors <- neighborGeneFinder(mappings, "unigene", org)
        }
    }
}
# This function takes a file name for the merged SAGE libraries data file and
# writes the data into a table in a database.

writeSAGE2DB <- function(dbArgs, colNames, keys = "", numCols = "",
                         fileName, what = c("counts", "map", "info"),
                         charNum = 20, type = "int4"){

    what <- match.arg(what)
    conn <- makeConnection(dbArgs)

    if(tableExists(conn, dbArgs[[what]])){
        executeQuery(paste("drop table", dbArgs[[what]]), conn, TRUE)
    }

    # Create an empty table
    newTableSQL <- paste("create table ", dbArgs[[what]], " ( ",
                         getColSQL(colNames, charNum, keys, numCols, type),
                         ifelse(keys == "", "",
                         paste(", primary key(", paste(keys, sep = "",
                         collapse = ","), ")", sep = "")), ")", sep = "")

    executeQuery(newTableSQL, conn, TRUE)
    if(.Platform$OS.type == "unix"){
        # Copy file to the table created
        writeSQL <- paste("copy ", dbArgs[[what]], " from '", fileName,
                          "' using delimiters '\t'", sep = "")
        executeQuery(writeSQL, conn, TRUE)
    }else{
        temp <- read.table(fileName, sep = "\t", header = FALSE,
                           as.is = TRUE)
        colnames(temp) <- colNames
        sqlSave(conn, temp, dbArgs[[what]], TRUE, FALSE, FALSE)
    }
#    closeConn(conn)
}

# Returns part of a SQL statement that set up the clumns of new table.
getColSQL <- function(colNames, charNum, keys, numCols, type){
    colSQL <- NULL
    for(i in colNames){
        if(any(keys == i)){
            toAdd <- "not null"
        }else{
            toAdd <- ""
        }
        if(any(numCols == i)){
            if(length(type) == 1){
                toAdd <- paste(type, "default 0")
            }else{
                toAdd <- paste(type[i], "default 0")
            }
        }else{
            if(length(charNum) == 1){
                temp <- charNum[1]
            }else{
                temp <- charNum[i]
            }
            toAdd <- paste("varchar(", temp, ") ", toAdd, sep = "")
        }
        if(is.null(colSQL)){
            colSQL <- paste(tolower(i), " ", toAdd, sep = "")
        }else{
            colSQL <- paste(colSQL, paste(tolower(i), " ", toAdd,
                                              sep = ""), sep = ",")
        }
    }
    return(colSQL)
}


.First.lib <- function(libname, pkgname, where) {
    require(AnnBuilder) || stop("Package annotate unavailable")
    require(genefilter) || stop("Package genefilter unavailable")
    require(annotate) || stop("Package annotate unavailable")
    if(.Platform$OS.type == "windows"){
        require(RODBC) || stop("package RODBC unavailable")
    }else if(.Platform$OS.type == "unix"){
        require(Rdbi) || stop("Package Rdbi unavailable")
        require(RdbiPgSQL) || stop("Package RdbiPgSQL unavailable")
    }

    if(interactive()){
        setSLyzerArgs()
        if(require(tcltk, quietly = TRUE)){
            require(tkWidgets) || stop("Package tkWidgets unavailable")
            SAGEWidget()
        }
    }


#    if(interactive()){
#        if(require(tcltk, quietly = TRUE)){
#            require(tkWidgets) || stop("Package tkWidgets unavailable")
#            if(.Platform$OS.type == "windows"){
#                require(Biobase) || stop("Package Biobase unavailable")
#                addVig2Menu("DBConnecter", "SAGE",
#                             itemAction = "getDBArgs()")
#                addVig2Menu("Get GEOSAGE", "SAGE/SAGEIntegrater",
#                                           itemAction = "SAGEFromGEO()")
#                addVig2Menu("Integrate SAGE", "SAGE/SAGEIntegrater",
#                                           itemAction = "procSAGE()")
#                addVig2Menu("Set Target", "SAGE/SAGELyzer",
#                                           itemAction = "getTag()")
#                addVig2Menu("Select Libs", "SAGE/SAGELyzer",
#                                           itemAction = "selectLibs()")
#                addVig2Menu("Reset Defaults", "SAGE/SAGELyzer",
#                                           itemAction = "getDefaults()")
#                addVig2Menu("Run", "SAGE/SAGELyzer",
#                                           itemAction = "runSLyzer()")
#                addVig2Menu("Get Lib Counts", "SAGE/SAGELyzer",
#                                           itemAction = "getLibCounts()")
#                addVig2Menu("View Libs", "SAGE/SAGELyzer",
#                                           itemAction = "mapLib2File()")
#                addVig2Menu("Map SAGE", "SAGE/SAGEIntegrater",
#                                           itemAction = "mapSAGE2UG()")
#                addVig2Menu("Annotate Tags", "SAGE/SAGELyzer",
#                                           itemAction = "linkTag2UG()")
#                addVig2Menu("Reset", "SAGE/SAGELyzer",
#                                           itemAction = "setSLyzerArgs()")
#            }else if(.Platform$OS.type == "unix" && interactive()){
#               SAGE4Unix()
#            }
#        }
#    }
}
