R/cytofkit_GUI.R

Defines functions cytofkit_GUI launchShinyAPP_GUI opendir getParameters_GUI fixedLogicleParameters_GUI

Documented in cytofkit_GUI fixedLogicleParameters_GUI getParameters_GUI launchShinyAPP_GUI

#' Function for launching the user friendly GUI client for \code{cytofkit-package}
#' 
#' This GUI provides an easy way to apply \code{cytofkit} package. 
#' Main parameters for running 'cytofkit' main function were integrated in this GUI, 
#' and each parameter has a help button to show the instructions. 
#' The \code{cytofkit} analysis will be automatically started after submitting.
#' 
#' @author Hao Chen
#' @return the GUI for \code{cytofkit-package}
#' @import tcltk
#' @export
#' @seealso \code{\link{cytofkit-package}}, \code{\link{cytofkit}}
#' @references \url{http://signbioinfo.github.io/cytofkit/}
#' @examples
#' #cytofkit_GUI()  # remove the hash symbol to run
cytofkit_GUI <- function() {
    
    ##--------------------------##
    ## parameter initialization ##
    ##--------------------------##
    
    fcsFiles <- ""
    cur_dir <- getwd()
    mergeMethods <- c("all", "min", "ceil", "fixed")
    transformMethods <- c("autoLgcl", "cytofAsinh", "logicle", "none")
    vizMethods <- c("pca", "isomap", "tsne", "NULL")
    clusterMethods <- c("Rphenograph", "ClusterX", "DensVM", "FlowSOM", "NULL")
    progressionMethods <- c("diffusionmap", "isomap", "NULL")
    fixedLgclParas = c(l_w = 0.5, l_t = 500000, l_m = 4.5, l_a = 0)
    
    rawFCSdir <- tclVar(cur_dir)
    fcsFile <- tclVar("")
    resDir <- tclVar(cur_dir)
    projectName <- tclVar("cytofkit")
    mergeMethod <- tclVar("ceil")
    fixedNum <- tclVar("5000")
    markers <- tclVar("")
    transformMethod <- tclVar("autoLgcl")
    progressionMethod <- tclVar("NULL")
    Rphenograph_k <- tclVar("30")
    tsne_perp <- tclVar("30")
    tsne_maxIter <- tclVar("1000")
    FlowSOM_k <- tclVar("40")
    seed <- tclVar("42")
    
    # logicle parameters
    l_w <- tclVar(fixedLgclParas[1])
    l_t <- tclVar(fixedLgclParas[2])
    l_m <- tclVar(fixedLgclParas[3])
    l_a <- tclVar(fixedLgclParas[4])
    
    clusterSelect <- c()
    i <- 1
    while (i <= length(clusterMethods)) {
        aux <- paste("clusterSelect", i, sep = "")
        clusterSelect <- c(clusterSelect, as.character(aux))
        tclvalue(clusterSelect[i]) <- "0"
        i <- i + 1
    }
    tclvalue(clusterSelect[1]) <- "1"  # default Rphenograph
    
    vizSelect <- c()
    i <- 1
    while (i <= length(vizMethods)) {
        aux <- paste("vizSelect", i, sep = "")
        vizSelect <- c(vizSelect, as.character(aux))
        tclvalue(vizSelect[i]) <- "0"
        i <- i + 1
    }
    tclvalue(vizSelect[3]) <- "1"  # default tsne 
    
    ret_var <- tclVar("")
    
    ##-------------------##
    ##  button functions ##
    ##-------------------##
    
    highCell_warning <- function() {
        #potentially_slow_methods <- c("all", "DensVM", "isomap")
        #if(any(potentially_slow_methods) %in% para){}
        tkmessageBox(title = "Warning",
                     message = "Please note that using the options DensVM or isomap with more than 10,000 cells will be very slow!")
    }
    
    reset_rawFCS_dir <- function() {
        rawFCS_dir <- ""
        rawFCS_dir <- tclvalue(tkchooseDirectory(title = "Choose your rawFCS direcetory ..."))
        if (rawFCS_dir != "") {
            tclvalue(rawFCSdir) <- rawFCS_dir
            tclvalue(resDir) <- rawFCS_dir
        }
    }
    
    reset_res_dir <- function() {
        res_dir <- ""
        res_dir <- tclvalue(tkchooseDirectory(title = "Choose your result directory ..."))
        if (res_dir != "") {
            tclvalue(resDir) <- res_dir
        }
    }
    
    reset_fcs_data <- function() {
        fnames <- ""
        fnames <- tk_choose.files(default = paste(tclvalue(rawFCSdir), 
            "fcs", sep = .Platform$file.sep), caption = "Select FCS files", 
            multi = TRUE, filters = matrix(c("{fcs files}", "{.fcs}"), 
                1, 2), index = 1)
        if (length(fnames) >= 1) {
            fnames <- fnames[!(grepl(paste0(.Platform$file.sep, 
                "fcs$"), fnames))]  # remove empty .fcs files
            tclvalue(fcsFile) <- paste(fnames, collapse = "}{")
        }
    }
    
    reset_para_data <- function() {
        
        if (tclvalue(fcsFile) == "" && tclvalue(rawFCSdir) == "") {
            tkmessageBox(title = "cytofkit: an Integrated Mass Cytometry Data Analysis Pipeline", 
                message = "Please input your \"rawFCSdirectory\" or \"fcsFile\".", 
                icon = "info", type = "ok")
        }
        if (tclvalue(fcsFile) != "") {
            fcsFiles <- strsplit(tclvalue(fcsFile), "}{", fixed = TRUE)[[1]]
        }
        fcsDir <- tclvalue(rawFCSdir)
        selectMarkers <- getParameters_GUI(fcsFiles, fcsDir)
        
        if (length(selectMarkers) > 0) {
            tclvalue(markers) <- paste(selectMarkers, collapse = "}{")
        }
    }
    
    reset_num2null <- function() {
        tclvalue(fixedNum) <- "NULL"
    }
    
    method_all_warning <- function(){
        reset_num2null()
        highCell_warning()
    }
    
    reset_num2any <- function() {
        tclvalue(fixedNum) <- "5000"
    }
    
    rawFCSdir_help <- function() {
        tkmessageBox(title = "rawFCSdir", message = "The directory that contains fcs files.", 
            icon = "info", type = "ok")
    }
    
    fcsFile_help <- function() {
        tkmessageBox(title = "fcsFiles", message = "The fcs files to be analyzed. One or multiple fcs files are allowed. When multiple fcs files are selected, cells from each fcs file are combined for analysis.", 
            icon = "info", type = "ok")
    }
    
    para_help <- function() {
        tkmessageBox(title = "markers", message = "Select the list of makers to be used for analysis.", 
            icon = "info", type = "ok")
    }
    
    projectName_help <- function() {
        tkmessageBox(title = "projectName", message = "A prefix that will be added to the names of result files.", 
            icon = "info", type = "ok")
    }
    
    mergeMethod_help <- function() {
        tkmessageBox(title = "mergeMethod", message = "When multiple fcs files are selected, cell expression data can be merged using one of the four different methods including \"ceil\",\"all\", \"min\",\"fixed\". \n\n\"ceil\" (the default option): up to a fixed number (specified by fixedNum) of cells are sampled without replacement from each fcs file and combined for analysis. \n\n\"all\": all cells from each fcs file are combined for analysis. \n\n\"min\": The minimum number of cells among all the selected fcs files are sampled from each fcs file and combined for analysis. \n\n\"fixed\": a fixed num (specified by fixedNum) of cells are sampled (with replacement when the total number of cell is less than fixedNum) from each fcs file and combined for analysis.", 
            icon = "info", type = "ok")
    }
    
    fixedNum_help <- function() {
        tkmessageBox(title = "fixedNum", message = "Up to fixedNum of cells from each fcs file are used for analysis.", 
            icon = "info", type = "ok")
    }
    
    rPk_help <- function() {
        tkmessageBox(title = "Rphenograph K", message = "Number of nearest neighbours to pass to Rphenograph.", 
                     icon = "info", type = "ok")
    }
    
    fSk_help <- function() {
        tkmessageBox(title = "FlowSOM K", message = "Number of clusters for meta clustering in FlowSOM.", 
                     icon = "info", type = "ok")
    }
    
    transformMethod_help <- function() {
        tkmessageBox(title = "transformationMethod", message = "Data Transformation method, including \"cytofAsinh\"(Customized Asinh transformation for CyTOF data), \"autoLgcl\"(automatic logicle transformation for CyTOF data), \"logicle\"(customize your own parameters for logicle transformation) and \"none\"(if your data is already transformed).", 
            icon = "info", type = "ok")
    }
    
    cluster_help <- function() {
        tkmessageBox(title = "clusterMethods", message = "The method(s) for clustering, including \"DensVM\", \"ClusterX\", \"Rphenograph\", and \"FlowSOM\". \n\nIf \"NULL\" was selected, no clustering will be performed.", 
            icon = "info", type = "ok")
    }
    
    visualizationMethods_help <- function() {
        tkmessageBox(title = "visualizationMethods", message = "The method(s) used for visualizing the clustering results, multiple selections are allowed. Including \"pca\", \"isomap\", \"tsne\". \n\nWARNING: \"tsne\" is the default selection, \"isomap\" may take long time.", 
            icon = "info", type = "ok")
    }
    
    progressionMethod_help <- function() {
        tkmessageBox(title = "progressionMethod", message = "The method used for cellular progression analysis including \"diffusion map\" and \"isomap\"\n\nIf \"NULL\" was selected, no progression estimation will be performed.", 
                     icon = "info", type = "ok")
    }
    
    resDir_help <- function() {
        tkmessageBox(title = "resDir", message = "The directory where result files will be generated", 
            icon = "info", type = "ok")
    }
    
    reset <- function() {
        tclvalue(rawFCSdir) = cur_dir
        tclvalue(fcsFile) = ""
        tclvalue(resDir) = cur_dir
        tclvalue(projectName) = "cytofkit"
        tclvalue(mergeMethod) = mergeMethods[3]
        tclvalue(fixedNum) = "5000"
        tclvalue(markers) = ""
        tclvalue(transformMethod) = "autoLgcl"
        tclvalue(clusterSelect[1]) = "0"
        tclvalue(clusterSelect[2]) = "1"
        tclvalue(clusterSelect[3]) = "0"
        tclvalue(clusterSelect[4]) = "0"
        tclvalue(vizSelect[1]) <- "0"
        tclvalue(vizSelect[2]) <- "0"
        tclvalue(vizSelect[3]) <- "1"
        tclvalue(progressionMethod) <- "NULL"
        tclvalue(Rphenograph_k) <- "30"
        tclvalue(FlowSOM_k) <- "40"
        tclvalue(tsne_perp) <- "30"
        tclvalue(tsne_maxIter) <- "1000"
        tclvalue(seed) <- "42"
    }
    
    submit <- function() {
        has_error = FALSE
        if (tclvalue(markers) == "") {
            tkmessageBox(title = "cytofkit: an Integrated Analysis Pipeline for Mass Cytometry Data", 
                message = "Please select the markers for your analysis.", 
                icon = "info", type = "ok")
            has_error = TRUE
        }
        
        if (has_error == FALSE) {
            tclvalue(ret_var) <- "OK"
            tkdestroy(tt)
        }
    }
    
    quit <- function() {
        tkdestroy(tt)
    }
    
    
    ##----------------##
    ##  build the GUI ##
    ##--------------- ##
    
    ## head line
    tt <- tktoplevel(borderwidth = 20)
    tkwm.title(tt, "cytofkit: an Integrated Analysis Pipeline for Mass Cytometry Data")
    
    if(.Platform$OS.type == "windows"){
        box_length <- 63
    }else{
        box_length <- 55 
    }
    cell_width <- 3
    bt_width <- 8
    #hb_width <- 8
    
    imgfile <- system.file("extdata", "help.png", package = "cytofkit")
    image1 <- tclVar()
    tkimage.create("photo", image1, file = imgfile)
    image2 <- tclVar()
    tkimage.create("photo", image2)
    tcl(image2, "copy", image1, subsample = 6)
    
    ## rawFCSdir
    rawFCSdir_label <- tklabel(tt, text = "Raw FCS Directory :")
    rawFCSdir_entry <- tkentry(tt, textvariable = rawFCSdir, width = box_length)
    rawFCSdir_button <- tkbutton(tt, text = " Choose... ", width = bt_width, command = reset_rawFCS_dir)
    rawFCSdir_hBut <- tkbutton(tt, image = image2, command = rawFCSdir_help)
    
    ## resDir
    resDir_label <- tklabel(tt, text = "Result Directory :")
    resDir_entry <- tkentry(tt, textvariable = resDir, width = box_length)
    resDir_button <- tkbutton(tt, text = " Choose... ", width = bt_width, 
        command = reset_res_dir)
    resDir_hBut <- tkbutton(tt, image = image2, command = resDir_help)
    
    ## fcsFiles
    fcsFile_label <- tklabel(tt, text = "FCS File(s) :")
    fcsFile_entry <- tkentry(tt, textvariable = fcsFile, width = box_length)
    fcsFile_button <- tkbutton(tt, text = " Select... ", width = bt_width, 
        command = reset_fcs_data)
    fcsFile_hBut <- tkbutton(tt, image = image2, command = fcsFile_help)
    
    ## markers
    markers_label <- tklabel(tt, text = "Markers :")
    markers_entry <- tkentry(tt, textvariable = markers, width = box_length)
    markers_button <- tkbutton(tt, text = " Select... ", width = bt_width, 
        command = reset_para_data)
    markers_hBut <- tkbutton(tt, image = image2, command = para_help)
    
    ## projectName
    projectName_label <- tklabel(tt, text = "Project Name :")
    projectName_entry <- tkentry(tt, textvariable = projectName, width = box_length)
    projectName_hBut <- tkbutton(tt, image = image2, command = projectName_help)
    
    ## mergeMethod && fixedNum
    mergeMethod_label <- tklabel(tt, text = "Merge Method :")
    mergeMethod_hBut <- tkbutton(tt, image = image2, command = mergeMethod_help)
    merge_method_rbuts <- tkframe(tt)
    tkpack(tklabel(merge_method_rbuts, text = ""), side = "left")
    tkpack(tkradiobutton(merge_method_rbuts, text = mergeMethods[1], 
        variable = mergeMethod, value = mergeMethods[1], command = method_all_warning), 
        side = "left")
    tkpack(tkradiobutton(merge_method_rbuts, text = mergeMethods[2], 
        variable = mergeMethod, value = mergeMethods[2], command = reset_num2null), 
        side = "left")
    tkpack(tkradiobutton(merge_method_rbuts, text = mergeMethods[3], 
        variable = mergeMethod, value = mergeMethods[3], command = reset_num2any), 
        side = "left")
    tkpack(tkradiobutton(merge_method_rbuts, text = mergeMethods[4], 
        variable = mergeMethod, value = mergeMethods[4], command = reset_num2any), 
        side = "left")
    tkpack(tkentry(merge_method_rbuts, textvariable = fixedNum, 
                   width = 9), side = "right")
    tkpack(tklabel(merge_method_rbuts, text = "Fixed Number :"), 
        side = "right")
    tkpack(tklabel(merge_method_rbuts, text = "                 "), 
        side = "left")
    fixedNum_hBut <- tkbutton(tt, image = image2, command = fixedNum_help)
    
    ## transformMethod
    transformMethod_label <- tklabel(tt, text = "Transformation Method :")
    transformMethod_hBut <- tkbutton(tt, image = image2,
        command = transformMethod_help)
    transformMethod_rbuts <- tkframe(tt)
    tkpack(tklabel(transformMethod_rbuts, text = ""), side = "left")
    tkpack(tkradiobutton(transformMethod_rbuts, text = transformMethods[1], 
        variable = transformMethod, value = transformMethods[1]), side = "left")
    tkpack(tkradiobutton(transformMethod_rbuts, text = transformMethods[2],
        variable = transformMethod, value = transformMethods[2]), side = "left")
    tkpack(tkradiobutton(transformMethod_rbuts, text = "Fixedlogicle",
        command = function(){ 
            fixedLgclParas <- fixedLogicleParameters_GUI(fixedLgclParas) 
            tclvalue(l_w) <- fixedLgclParas[1] 
            tclvalue(l_t) <- fixedLgclParas[2] 
            tclvalue(l_m) <- fixedLgclParas[3] 
            tclvalue(l_a) <- fixedLgclParas[4] 
            },
        variable = transformMethod, value = transformMethods[3]), side = "left")
    tkpack(tkradiobutton(transformMethod_rbuts, text = transformMethods[4],
        variable = transformMethod, value = transformMethods[4]), side = "left")
    
    ## cluster method
    cluster_label <- tklabel(tt, text = "Cluster Method(s) :")
    cluster_hBut <- tkbutton(tt, image = image2, command = cluster_help)
    
    clusterMethods_cbuts <- tkframe(tt)
    tkpack(tklabel(clusterMethods_cbuts, text = ""), side = "left")
    tkpack(tkcheckbutton(clusterMethods_cbuts, text = clusterMethods[1], 
                         variable = eval(clusterSelect[1])), side = "left")
    tkpack(tkcheckbutton(clusterMethods_cbuts, text = clusterMethods[2], 
                         variable = eval(clusterSelect[2])), side = "left")
    tkpack(tkcheckbutton(clusterMethods_cbuts, text = clusterMethods[3], 
                         variable = eval(clusterSelect[3]), command = highCell_warning), side = "left")
    tkpack(tkcheckbutton(clusterMethods_cbuts, text = clusterMethods[4], 
                         variable = eval(clusterSelect[4])), side = "left")
    tkpack(tkcheckbutton(clusterMethods_cbuts, text = clusterMethods[5], 
                         variable = eval(clusterSelect[5])), side = "left")
    
    ## cluster param (Rphenograph_k and FlowSOM_k)
    rphenoK_label <- tklabel(tt, text = "Rphenograph_k:")
    rphenoK_hBut <- tkbutton(tt, image = image2, command = rPk_help)
    cluster_Param <- tkframe(tt)
    tkpack(tklabel(cluster_Param, text = " "), side = "left")
    tkpack(tkentry(cluster_Param, textvariable = Rphenograph_k, width = 4), side = "left")
    tkpack(tklabel(cluster_Param, text = "                 "), side = "left")
    tkpack(tklabel(cluster_Param, text = "tsne Perplexity"), side = "left")
    tkpack(tkentry(cluster_Param, textvariable = tsne_perp, width = 4), side = "left")
    tkpack(tklabel(cluster_Param, text = "tsne Max Iterations"), side = "left")
    tkpack(tkentry(cluster_Param, textvariable = tsne_maxIter, width = 4), side = "left")
    tkpack(tkbutton(cluster_Param, image = image2, command = fSk_help), side = "right")
    tkpack(tkentry(cluster_Param, textvariable = FlowSOM_k, width = 4), side = "right")
    tkpack(tklabel(cluster_Param, text = "FlowSOM_k:"), side = "right")
    
    ## visualizationMethods
    visualizationMethods_label <- tklabel(tt, text = "Visualization Method(s) :")
    visualizationMethods_hBut <- tkbutton(tt, image = image2,
        command = visualizationMethods_help)
    visualizationMethods_cbuts <- tkframe(tt)
    tkpack(tklabel(visualizationMethods_cbuts, text = ""), side = "left")
    tkpack(tkcheckbutton(visualizationMethods_cbuts, text = vizMethods[1],
                         variable = eval(vizSelect[1])), side = "left")
    tkpack(tkcheckbutton(visualizationMethods_cbuts, text = vizMethods[2],
                         variable = eval(vizSelect[2]), command = highCell_warning), side = "left")
    tkpack(tkcheckbutton(visualizationMethods_cbuts, text = vizMethods[3],
                         variable = eval(vizSelect[3])), side = "left")
    tkpack(tkcheckbutton(visualizationMethods_cbuts, text = vizMethods[4],
                         variable = eval(vizSelect[4])), side = "left")
    tkpack(tklabel(visualizationMethods_cbuts, text = "                 "), side = "left")
    tkpack(tklabel(visualizationMethods_cbuts, text = "Seed"), side = "left")
    tkpack(tkentry(visualizationMethods_cbuts, textvariable = seed, width = 4), side = "left")
    
    ## progressionMethod
    progressionMethod_label <- tklabel(tt, text = "Cellular Progression :")
    progressionMethod_hBut <- tkbutton(tt, image = image2, 
                                     command = progressionMethod_help)
    progressionMethod_rbuts <- tkframe(tt)
    tkpack(tklabel(progressionMethod_rbuts, text = ""), side = "left")
    tkpack(tkradiobutton(progressionMethod_rbuts, text = progressionMethods[1], 
                         variable = progressionMethod, value = progressionMethods[1]), side = "left")
    tkpack(tkradiobutton(progressionMethod_rbuts, text = progressionMethods[2], 
                         variable = progressionMethod, value = progressionMethods[2], command = highCell_warning),
           side = "left")
    tkpack(tkradiobutton(progressionMethod_rbuts, text = progressionMethods[3], 
                         variable = progressionMethod, value = progressionMethods[3]), side = "left")
    
    ## submit / reset / quit
    submit_button <- tkbutton(tt, text = "Submit", command = submit)
    reset_button <- tkbutton(tt, text = "Reset", command = reset)
    quit_button <- tkbutton(tt, text = "Quit", command = quit)
    
    ## display GUI
    tkgrid(rawFCSdir_label, rawFCSdir_hBut, rawFCSdir_entry, rawFCSdir_button, 
        padx = cell_width)
    tkgrid.configure(rawFCSdir_label, rawFCSdir_entry, rawFCSdir_button, 
        sticky = "e")
    tkgrid.configure(rawFCSdir_hBut, sticky = "e")
    
    tkgrid(fcsFile_label, fcsFile_hBut, fcsFile_entry, fcsFile_button, 
        padx = cell_width)
    tkgrid.configure(fcsFile_label, fcsFile_entry, fcsFile_button, 
        sticky = "e")
    tkgrid.configure(fcsFile_hBut, sticky = "e")
    
    tkgrid(markers_label, markers_hBut, markers_entry, markers_button, 
        padx = cell_width)
    tkgrid.configure(markers_label, markers_entry, markers_button, 
        sticky = "e")
    tkgrid.configure(markers_hBut, sticky = "e")
    
    tkgrid(resDir_label, resDir_hBut, resDir_entry, resDir_button, 
        padx = cell_width)
    tkgrid.configure(resDir_label, resDir_entry, resDir_button, 
        sticky = "e")
    tkgrid.configure(resDir_hBut, sticky = "e")
    
    tkgrid(projectName_label, projectName_hBut, projectName_entry, padx = cell_width)
    tkgrid.configure(projectName_label, projectName_entry, sticky = "e")
    tkgrid.configure(projectName_hBut, sticky = "e")
    
    tkgrid(mergeMethod_label, mergeMethod_hBut, merge_method_rbuts, 
        fixedNum_hBut, padx = cell_width)
    tkgrid.configure(mergeMethod_label, sticky = "e")
    tkgrid.configure(mergeMethod_hBut, sticky = "e")
    tkgrid.configure(merge_method_rbuts, sticky = "w")
    tkgrid.configure(fixedNum_hBut, sticky = "w")
    
    tkgrid(transformMethod_label, transformMethod_hBut, transformMethod_rbuts,
        padx = cell_width)
    tkgrid.configure(transformMethod_label, sticky = "e")
    tkgrid.configure(transformMethod_rbuts, sticky = "w")
    tkgrid.configure(transformMethod_hBut, sticky = "e")
    
    tkgrid(cluster_label, cluster_hBut, clusterMethods_cbuts, padx = cell_width)
    tkgrid.configure(cluster_label, sticky = "e")
    tkgrid.configure(clusterMethods_cbuts, sticky = "w")
    tkgrid.configure(cluster_hBut, sticky = "e")
    
    tkgrid(rphenoK_label, rphenoK_hBut, cluster_Param, padx = cell_width)
    tkgrid.configure(rphenoK_label, rphenoK_hBut, sticky = "e")
    tkgrid.configure(cluster_Param, sticky = "w")
    
    tkgrid(visualizationMethods_label, visualizationMethods_hBut, 
        visualizationMethods_cbuts, padx = cell_width)
    tkgrid.configure(visualizationMethods_label, sticky = "e")
    tkgrid.configure(visualizationMethods_cbuts, sticky = "w")
    tkgrid.configure(visualizationMethods_hBut, sticky = "e")
    
    tkgrid(progressionMethod_label, progressionMethod_hBut, progressionMethod_rbuts, 
           padx = cell_width)
    tkgrid.configure(progressionMethod_label, sticky = "e")
    tkgrid.configure(progressionMethod_rbuts, sticky = "w")
    tkgrid.configure(progressionMethod_hBut, sticky = "e")
    
    tkgrid(tklabel(tt, text = "\n"), padx = cell_width)  # leave blank line
    
    tkgrid(reset_button, tklabel(tt, text = ""), submit_button, 
        quit_button, padx = cell_width)
    tkgrid.configure(reset_button, sticky = "e")
    tkgrid.configure(quit_button, sticky = "w")
    
    tkwait.window(tt)
    
    
    ##-------------------##
    ## Return parameters ##
    ##-------------------##
    
    if (tclvalue(ret_var) != "OK") {
        okMessage <- "Analysis is cancelled."
    }else{
        fcsFiles <- strsplit(tclvalue(fcsFile), "}{", fixed = TRUE)[[1]]
        parameters <- strsplit(tclvalue(markers), "}{", fixed = TRUE)[[1]]
        
        clusterCheck <- c()
        i <- 1
        while (i <= length(clusterMethods)) {
            v <- as.numeric(tclvalue(clusterSelect[i])) > 0
            clusterCheck <- c(clusterCheck, v)
            i <- i + 1
        }
        
        vizCheck <- c()
        i <- 1
        while (i <= length(vizMethods)) {
            v <- as.numeric(tclvalue(vizSelect[i])) > 0
            vizCheck <- c(vizCheck, v)
            i <- i + 1
        }
        
        inputs <- list()
        inputs[["fcsFiles"]] <- fcsFiles
        inputs[["markers"]] <- parameters
        inputs[["mergeMethod"]] <- tclvalue(mergeMethod)
        inputs[["fixedNum"]] <- suppressWarnings(as.numeric(tclvalue(fixedNum)))
        inputs[["transformMethod"]] <- tclvalue(transformMethod)
        inputs[["dimReductionMethod"]] <- "tsne"
        inputs[["clusterMethods"]] <- clusterMethods[clusterCheck]
        inputs[["visualizationMethods"]] <- vizMethods[vizCheck]
        inputs[["progressionMethod"]] <- tclvalue(progressionMethod)
        inputs[["Rphenograph_k"]] <- tclvalue(Rphenograph_k)
        inputs[["tsne_perp"]] <- tclvalue(tsne_perp)
        inputs[["tsne_maxIter"]] <- tclvalue(tsne_maxIter)
        inputs[["FlowSOM_k"]] <- tclvalue(FlowSOM_k)
        inputs[["seed"]] <- tclvalue(seed)
        inputs[["projectName"]] <- tclvalue(projectName)
        inputs[["resultDir"]] <- tclvalue(resDir)
        
        inputs[["l_w"]] <- tclvalue(l_w)
        inputs[["l_t"]] <- tclvalue(l_t)
        inputs[["l_m"]] <- tclvalue(l_m)
        inputs[["l_a"]] <- tclvalue(l_a)
        
        
        # pass the parameters and run the cytofkit function
        cytofkit(fcsFiles = inputs[["fcsFiles"]],
                 markers = inputs[["markers"]],
                 projectName = inputs[["projectName"]],
                 mergeMethod = inputs[["mergeMethod"]],
                 fixedNum = inputs[["fixedNum"]],
                 transformMethod = inputs[["transformMethod"]],
                 dimReductionMethod = inputs[["dimReductionMethod"]],
                 clusterMethods = inputs[["clusterMethods"]],
                 visualizationMethods = inputs[["visualizationMethods"]],
                 progressionMethod = inputs[["progressionMethod"]],
                 Rphenograph_k = as.numeric(inputs[["Rphenograph_k"]]),
                 FlowSOM_k = as.numeric(inputs[["FlowSOM_k"]]),
                 seed = as.numeric(inputs[["seed"]]),
                 clusterSampleSize = 500,
                 resultDir = inputs[["resultDir"]],
                 saveResults = TRUE,
                 saveObject = TRUE,
                 l_w = as.numeric(inputs[["l_w"]]), 
                 l_t = as.numeric(inputs[["l_t"]]), 
                 l_m = as.numeric(inputs[["l_m"]]), 
                 l_a = as.numeric(inputs[["l_a"]]))
        
        okMessage <- paste0("Analysis done, results are saved under ",
                            inputs[["resultDir"]])
        RData_path <- paste0(inputs[["resultDir"]], .Platform$file.sep, inputs[["projectName"]], ".RData")
    }
    
    launchShinyAPP_GUI(message = okMessage, dir = inputs[["resultDir"]], obj = RData_path)
}


#' GUI for launching shiny APP
#' 
#' A shiny APP for interactive exploration of analysis results
#' 
#' @param message Message when asking if user wants to open the shiny APP
#' @param dir Result directory.
#' @param obj The RData piped from cytofkit function to the Shiny App
#' 
#' @return Window asking user if they wish to open shinyApp directly
#' @export
#' @examples
#' # launchShinyAPP_GUI()
launchShinyAPP_GUI <- function(message="cytofkit", dir = getwd(), obj = NULL){
    
    if(message == "Analysis is cancelled."){
        message("Analysis is cancelled!")
    }else{
        ifAPP <- tclVar("n")
        ss <- tktoplevel(borderwidth = 10)
        tkwm.title(ss, "cytofkit: Analysis Done")
        
        onYes <- function() {
            tclvalue(ifAPP) <- "y"
            tkdestroy(ss)
        }
        
        onNo <- function() {
            tclvalue(ifAPP) <- "n"
            tkdestroy(ss)
        }
        yesBut <- tkbutton(ss, text = " Yes ", command = onYes)
        noBut <- tkbutton(ss, text = " No ", command = onNo)
        openDirBut <- tkbutton(ss, text = "Open", command = function(){opendir(dir)})
        okBut <- tkbutton(ss, text = "OK", command = function(){tkdestroy(ss)})
        tkgrid(tklabel(ss, text = message))
        
        tkgrid(openDirBut)
        tkgrid(tklabel(ss, text = "\n"))
        tkgrid(tklabel(ss, text = "Launch Shiny APP to check your results:"))
        tkgrid(noBut, tklabel(ss, text = "    "), yesBut)
        tkgrid.configure(noBut, sticky = "e")
        tkgrid.configure(yesBut, sticky = "e")
        tkwait.window(ss)
        
        if(tclvalue(ifAPP) == "y"){
            cytofkitShinyAPP(obj)
        }
    }
}


## function for opening the results directory
opendir <- function(dir = getwd()){
    if (.Platform['OS.type'] == "windows"){
        shell.exec(dir)
    } else {
        system(paste(Sys.getenv("R_BROWSER"), dir))
    }
}


#' GUI for marker selection 
#' 
#' Extract the markers from the fcsfiles
#' 
#' @param fcsFile The name of the FCS file
#' @param rawFCSdir The path of the FCS file
#' @return List of markers for ddimension reduction and clustering
#' @examples 
#' #getParameters_GUI()
getParameters_GUI <- function(fcsFile, rawFCSdir) {
    
    if (missing(fcsFile)) {
        fcsFile <- list.files(path = rawFCSdir, pattern = ".fcs$", full.names = TRUE)
    }
    
    fcs <- suppressWarnings(read.FCS(fcsFile[1]))
    pd <- fcs@parameters@data
    markers <- paste(pd$name, "<", pd$desc, ">", sep = "")
    channels <- paste(pd$name, "<", pd$desc, ">", sep = "")
    
    if (length(markers) == 0) {
        stop("No markers found in the FCS file!")
    }
    
    # GUI
    markerChoice <- tclVar("")
    mm <- tktoplevel()
    tkwm.title(mm, "cytofkit: Marker Selection")
    scr <- tkscrollbar(mm, repeatinterval = 5, command = function(...) tkyview(tl, 
        ...))
    tl <- tklistbox(mm, height = 30, width = 40, selectmode = "multiple", yscrollcommand = function(...) tkset(scr, 
        ...), background = "white")
    OnOK <- function() {
        tclvalue(markerChoice) <- paste(markers[as.numeric(tkcurselection(tl)) + 
            1], collapse = "}{")
        tkdestroy(mm)
    }
    OK.but <- tkbutton(mm, text = " OK ", command = OnOK)
    tkgrid(tklabel(mm, text = "Please select your markers:"))
    tkgrid(tl, scr)
    tkgrid.configure(scr, rowspan = 4, sticky = "nsw")
    for (i in (1:length(markers))) {
        tkinsert(tl, "end", markers[i])
    }
    tkgrid(OK.but)
    tkwait.window(mm)
    
    # return parameters
    paras <- strsplit(tclvalue(markerChoice), "}{", fixed = TRUE)[[1]]
    paras <- channels[match(paras, markers)]
    return(paras)
} 


#' GUI for gettting parameter for logicle transformation
#' 
#' Extract the parameter for fixed logicle transformation
#' 
#' @param fixedLgclParas parameters vector containing w, t, m, a
#' @return Parameters for fixed logicle transformation
#' @examples 
#' #fixedLogicleParameters_GUI
fixedLogicleParameters_GUI <- function(fixedLgclParas=c(0.5, 500000, 4.5, 0)) {
    
    # logicle parameters
    l_w <- tclVar(fixedLgclParas[1])
    l_t <- tclVar(fixedLgclParas[2])
    l_m <- tclVar(fixedLgclParas[3])
    l_a <- tclVar(fixedLgclParas[4])
    
    cell_width <- 3
    box_length <- 10
    
    # GUI
    mm <- tktoplevel(borderwidth = 20)
    tkwm.title(mm, "Parameters for fixed logicle transformation")
    
    w_label <- tklabel(mm, text = "w :")
    w_entry <- tkentry(mm, textvariable = l_w, width = box_length)
    
    t_label <- tklabel(mm, text = "t :")
    t_entry <- tkentry(mm, textvariable = l_t, width = box_length)
    
    m_label <- tklabel(mm, text = "m :")
    m_entry <- tkentry(mm, textvariable = l_m, width = box_length)
    
    a_label <- tklabel(mm, text = "a :")
    a_entry <- tkentry(mm, textvariable = l_a, width = box_length)
    
    OnOK <- function(){
        tkdestroy(mm)
    }
    
    OK.but <- tkbutton(mm, text = " OK ", command = OnOK)
    
    tkgrid(tklabel(mm, text = "Specify your parameters\nfor logical transformation:"), columnspan=2)
    
    tkgrid(tklabel(mm, text = "\n"), padx = cell_width)  # leave blank line
    
    tkgrid(w_label, w_entry, padx = cell_width)
    tkgrid.configure(w_label, sticky = "e")
    tkgrid.configure(w_entry, sticky = "w")
    
    tkgrid(t_label, t_entry, padx = cell_width)
    tkgrid.configure(t_label, sticky = "e")
    tkgrid.configure(t_entry, sticky = "w")
    
    tkgrid(m_label, m_entry, padx = cell_width)
    tkgrid.configure(m_label, sticky = "e")
    tkgrid.configure(m_entry, sticky = "w")
    
    tkgrid(a_label, a_entry, padx = cell_width)
    tkgrid.configure(a_label, sticky = "e")
    tkgrid.configure(a_entry, sticky = "w")

    tkgrid(tklabel(mm, text = "\n"), padx = cell_width)  # leave blank line
    
    tkgrid(tklabel(mm, text = ""), OK.but, padx = cell_width)
    tkgrid.configure(OK.but, sticky = "w")
    tkwait.window(mm)
    
    # return parameters
    paras <- c(tclvalue(l_w), tclvalue(l_t), tclvalue(l_m), tclvalue(l_a))
    paras <- as.numeric(paras)
    return(paras)
} 

Try the cytofkit package in your browser

Any scripts or data that you put into this service are public.

cytofkit documentation built on Nov. 1, 2018, 3:50 a.m.