global.R
In Prostar: Provides a GUI for DAPAR

launchGA <- function(){
  print(paste0("In toto",system('hostname')))
  if (system('hostname')=="prabig-prostar"){
    tags$head(includeScript("www/google-analytics.js"))
  } else {
    #tags$head(includeScript("www/google-analytics-ProstarZeroInstall.js"))
  }
  
}


DAPAR.loc <- DAPARdata.loc <- Prostar.loc <- NULL
#DAPARdata.loc <- DAPAR.loc <- Prostar.loc <- "/home/shiny/Rlibs_test"
library(highcharter)
library(shinyBS)
library(shinyTree)

loadLibraries <- function(){
  
  
  library(shinycssloaders)
  library(shinythemes)
  #library(rclipboard)
  library(DT)
  library(highcharter)
 
  
  library(shinyAce)
  library(shinyWidgets)
  library(vioplot)
  library(ggplot2)
  library(colourpicker)
  library(gplots)
  #library(tidyr)
  #library(dplyr)
  library(data.table)
  library(MSnbase)
  #library(tidyverse)
  library(RColorBrewer)
  #library(webshot)
  library(DAPAR, lib.loc = DAPAR.loc)
  library(R.utils)
  library(rhandsontable)
  library(data.table)
}


library(future)
library(promises)
plan(multiprocess) 


source(file.path(".", "modulesUI.R"),  local = TRUE)$value
source(file.path(".", "moduleProcessUI.R"),  local = TRUE)$value


base_URL <- "http://www.prostar-proteomics.org/md/"

#base_URL <- "https://raw.githubusercontent.com/samWieczorek/Prostar/master/inst/ProstarApp/md/"
URL_FAQ <- paste0(base_URL, "FAQ.md")
URL_links <- paste0(base_URL, "links.md")
URL_ProstarPresentation <- paste0(base_URL, "presentation.md")
URL_formerReleases <-paste0(base_URL, "formerReleases.md")
URL_versionNotes <- paste0(base_URL, "versionNotes.md")



## gestion des couleurs

grey <- "#FFFFFF"
orangeProstar <- "#E97D5E"

# Declaration of global variables


resolution <- 300
pngWidth <- 1200
pngHeight <- 1200
zoomWebshot <- 3


WaitMsgPlot <- "Building plot. Please wait..."
WaitMsgCalc <- "Calculation in progress"


commandLogFile <- "cmdLog.R"
logfilename <- "log.txt"


gAgregateMethod <- list("none" = "none",
                        "sum overall" = "sum overall",
                        "mean" = "mean",
                        "sum on top n" = "sum on top n")

limitHeatmap <- 20000

list_org_db <- data.frame(
                shortName = c("org.Ag.eg.db",
                              "org.At.tair.db",
                              "org.Bt.eg.db",
                                "org.Cf.eg.db",
                                "org.Gg.eg.db",
                                "org.Pt.eg.db",
                                "org.EcK12.eg.db",
                                "org.EcSakai.eg.db",
                                "org.Dm.eg.db",
                                "org.Hs.eg.db",
                                "org.Pf.plasmo.db",
                                "org.Mm.eg.db",
                                "org.Ss.eg.db",
                                "org.Rn.eg.db",
                                "org.Mmu.eg.db",
                                "org.Ce.eg.db",
                                "org.Xl.eg.db",
                                "org.Sc.sgd.db", 
                                "org.Dr.eg.db",
                              "org.hcg110.db"),
                longName = c("Anopheles (org.Ag.eg.db)",
                             "Arabidopsis (org.At.tair.db)",
                             "Bovine (org.Bt.eg.db)",
                             "Canine (org.Cf.eg.db)",
                             "Chicken (org.Gg.eg.db)",
                             "Chimp (org.Pt.eg.db)",
                             "E coli strain K12 (org.EcK12.eg.db)",
                             "E coli strain Sakai (org.EcSakai.eg.db)",
                             "Fly (org.Dm.eg.db)",
                             "Human (org.Hs.eg.db)",
                            "Malaria (org.Pf.plasmo.db)",
                             "Mouse (org.Mm.eg.db)",
                             "Pig (org.Ss.eg.db)",
                             "Rat (org.Rn.eg.db)",
                             "Rhesus (org.Mmu.eg.db)",
                             "Worm (org.Ce.eg.db)",
                             "Xenopus (org.Xl.eg.db)",
                             "Yeast (org.Sc.sgd.db)",
                             "Zebrafish (org.Dr.eg.db)",
                            "Oncorhynchyus mykiss (org.hcg110.db)"),
                stringsAsFactors = FALSE
                 )
rownames(list_org_db) <- list_org_db$shortName


originOfValue <- list()
originOfValue[["Missing"]] <- 0
originOfValue[["Unknown"]] <- 1
originOfValue[["ByMSMS"]] <- 2
originOfValue[["ByAlignment"]] <- 3



gFiltersList <- c("None" = "None",
                  "Empty lines" = "EmptyLines",
                  "Whole matrix" = "WholeMatrix",
                  "For every condition" = "AllCond",
                  "At least one condition" = "AtLeastOneCond")

gFiltersListAnaDiff <- list()
gFiltersListAnaDiff[["None"]] <- "None"
gFiltersListAnaDiff[["Whole matrix"]] <- "WholeMatrix"
gFiltersListAnaDiff[["For every condition"]] <- "AllCond"
gFiltersListAnaDiff[["At least one condition"]] <- "AtLeastOneCond"

group2ColorByDefault <- "Condition"

listBrewerPalettes <- c("Dark2 (qualit.)" = "Dark2",
                        "Accent (qualit.)"="Accent",
                        "Paired (qualit.)" = "Paired",
                        "Pastel1 (qualit.)" = "Pastel1",
                        "Pastel2 (qualit.)" = "Pastel2",
                        "Set1 (qualit.)" = "Set1",
                        "Set2 (qualit.)" = "Set2", 
                        "Set3 (qualit.)" = "Set3",
                        "BrBG (diverging)"="BrBG",
                        "PiYG (diverging)"=  "PiYG",
                        "PRGn (diverging)" ="PRGn",
                        "PuOr (diverging)" ="PuOr",
                        "RdBu (diverging)"="RdBu",
                        "RdGy (diverging)" ="RdGy",
                        "RdYlBu (diverging)" ="RdYlBu",
                        "RdYlGn (diverging)" ="RdYlGn",
                        "Spectral (diverging)"="Spectral")


gDatasets <- list()
gDatasets[["NA"]] <- "none"

gFilterNone <- gFiltersList[["None"]]
gFilterEmptyLines <- gFiltersList[["Empty lines"]]
gFilterWholeMat <- gFiltersList[["Whole matrix"]]
gFilterAllCond <- gFiltersList[["For every condition"]]
gFilterOneCond <- gFiltersList[["At least one condition"]]

# variables for filtering the data
gReplaceAllZeros <- "replaceAllZeros"
gLogTransform <- "Log2 tranformed data"
gFilterTextPrefix <- "Filtered with"

spinnerType <- 4

pData.complete.list <- list("Condition" = "Condition", 
                            "Bio.Rep" = "Bio. rep.",
                            "Tech.Rep" = "Tech. rep.", 
                            "Analyt.Rep" = "An. Rep.")


normMethods <- list("None" = "None",
                    "Global quantile alignment" = "GlobalQuantileAlignment",
                    "Sum by columns" = "SumByColumns",
                    "Quantile Centering" = "QuantileCentering",
                    "Mean Centering" = "MeanCentering",
                    "LOESS" = "LOESS",
                    "vsn" = "vsn"
 )


imputationAlgorithms <- c("None" = "None",
                             "imp4p" = "imp4p",
                             "Basic methods" = "BasicMethods")

basicMethodsImputationAlgos <- c("None" = "None",
                                 "Det. quantile" = "detQuantile",
                                 "KNN" = "KNN",
                                 "MLE" = "MLE"
                                        )

imputationAlgorithmsPeptides_POV <- list("None" = "None",
                                         "imp4p" = "imp4p",
                                         "slsa" = "slsa",
                                         "Det. quantile" = "detQuantile",
                                         "KNN" = "KNN")

imputationAlgorithmsProteins_POV <- list("None" = "None",
                                         "slsa" = "slsa",
                                         "Det quantile" = "detQuantile",
                                         "KNN" = "KNN")

imputationAlgorithmsPeptides_MEC<- list("None" = "None",
                                        "Det quantile" = "detQuantile",
                                        "Fixed value" = "fixedValue")

imputationAlgorithmsProteins_MEC <- list("None" = "None",
                                         "Det quantile" = "detQuantile",
                                         "Fixed value" = "fixedValue")

JSCSSTags <- function() 
{ 
list(
  tags$script(src="////code.highcharts.com/highcharts.js",type="text/javascript"),
  
  tags$script(src="js/jquery.js",type="text/javascript"),
    tags$script(src="js/jquery.dataTables.js",type="text/javascript"),
    tags$link(href='css/jquery.dataTables.css', rel="stylesheet", 
            type="text/css"), 
    tags$link(href='css/dataTables.tableTools.css', rel="stylesheet", 
            type="text/css"), 
    tags$script(src='js/dataTables.tableTools.js'),
    tags$link(rel="stylesheet", type="text/css",href="css/style.css"),
    tags$script(type="text/javascript", src = "busy.js")
)
}

DT_pagelength <- 15



reactiveDataTable <- function(func, ...) 
{
    reactive(function() 
    {
    classNames <- 
        getOption("shiny.table.class", "table table-striped table-bordered")
        classID = getOption("shiny.table.id", "example")
    data <- func()
    if (is.null(data) || is.na(data)) 
        return("")
    return(paste(
        capture.output(
        print(xtable(data, ...), 
        type = "html", 
        html.table.attributes = 
            paste("class=\"", classNames, "\" id=\"", classID, "\"", sep = ""),
            ...)), collapse = "\n"))

})
}


# for layout
resizeComponents <- function(){
tags$head(
    tags$style(type="text/css", "textarea { max-width: 400px; }"),
    tags$style(type='text/css', 
            ".well { max-width: 300px; max-height=300px;}"),
    tags$style(type='text/css', ".span4 { max-width: 300px; }")
)
}


GetFilterText <- function(type, seuil){
return (
    paste(gFilterTextPrefix," ",type , " (threshold = ", seuil, " ).", sep=""))
}


ll_descrStats <- list("boxplot" = "boxplot", 
                      "densityplot" = "densityplot", 
                      "heatmap"="heatmap", 
                      "CVDistr"="CVDistr", 
                      "violinplot"="violinplot", 
                      "corrMatrix"="corrMatrix", 
                      "MV plots"=list( "MVPlot1" = "MVPlot1",
                                       "MVPlot2" = "MVPlot2",
                                       "MVPlot3" = "MVPlot3"),
                      "PCA plots"=list("PCA_Ind"="PCA_Ind", 
                                       "PCA_Var"="PCA_Var", 
                                       "PCA_Eigen"="PCA_Eigen")
)
  

# plots.dataProcessing <- list(
#   Original = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen"),
#   Filtered = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen"),
#   Normalized = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen", "compNorm"),
#   Aggregated = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen"),
#   Imputed.peptide = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen"),
#   Imputed.protein = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen"),
#   HypothesisTest = list("boxplot", "densityplot", "heatmap", "CVDistr", "violinplot", "corrMatrix", "MVPlot1","MVPlot2","MVPlot3", "PCA_Ind", "PCA_Var", "PCA_Eigen","logFCDistr" )
# )




gGraphicsFilenames <- list(
    
    histoMV_Image_DS = "histoMV_Image_DS.png",
    histo_missvalues_per_lines_DS = "histo_missvalues_per_lines_DS.png",
    histo_missvalues_per_lines_per_conditions_DS = "histo_missvalues_per_lines_per_conditions_DS.png",
    
    histoMV_Image_DS_BeforeFiltering = "histoMV_Image_DSBeforeFiltering.png",
    histo_missvalues_per_lines_DS_BeforeFiltering = "histo_missvalues_per_lines_DSBeforeFiltering.png",
    histo_missvalues_per_lines_per_conditions_DS_BeforeFiltering = "histo_missvalues_per_lines_per_conditions_DSBeforeFiltering.png",
    
    
    corrMatrix = "corrMatrix.png",
    heatmap = "heatmap.png",
    boxplot = "boxplot.png",
    violinplot = "violinplot.png",
    varDist = "varDist.png",
    densityPlot = "densityPlot.png",
    densityPlotAfterNorm = "densityPlotAfterNorm.png",
    propContRev = "propContRev.png",
    boxplotAfterNorm = "boxplotAfterNorm.png",
    compareNorm = "compareNorm.png",
    MVtypePlot = "MVtypePlot.png",
    imageNA = "imageNA.png",
    AgregMatUniquePeptides = "AgregMatUniquePeptides.png",
    AgregMatSharedPeptides = "AgregMatSharedPeptides.png",
    logFCDistribution = "logFC_Distribution.png",
   # volcanoPlot_1 = "volcanoPlot_1.png",
    volcanoPlot = "volcanoPlot.png",
    calibrationPlot = "calibrationPlot.png",
    calibrationPlotAll = "calibrationPlotAll.png",
    GOEnrichDotplot = "GOEnrichDotplot.png",
    GOEnrichBarplot = "GOEnrichBarplot.png",
    GOClassificationImg1 = "GOClassification_img1.png",
    GOClassificationImg2 = "GOClassification_img2.png",
    GOClassificationImg3 = "GOClassification_img3.png",
   
   logFCDistr = "logFC_distribution.png"
)

defaultGradientRate <- 0.9




# variables for different extensions files format

# Not used yet 
GetLogFilename <- function(){
return(paste("loG__",Sys.getpid(), ".txt", sep=""))
}

#---------------------------------------------------------
GetChoices <- function(){

choix <- list.dirs(path=dir, recursive=FALSE)
names <- c()
for (i in 1:length(choix)){
    names[i] <-
    unlist(strsplit(choix[i], '/'))[length(unlist(strsplit(choix[i], '/')))]
}
return(setNames(names, names))
}


#--------------------------------------------------------
DeleteFileExtension <- function(name){
return(strsplit(name,'.', fixed=T)[[1]][1])}

#--------------------------------------------------------
GetExtension <- function(name){
    temp <- unlist(strsplit(name,'.', fixed=T))
    return(last(temp))
    }



#' busyIndicator
busyIndicator <- function(text = "Calculation in progress..",
                        img = "images/ajax-loader.gif", wait=1000) {
tagList(
    singleton(tags$head(
    tags$link(rel="stylesheet",
            type="text/css",href="busyIndicator/busyIndicator.css")
    ))
    ,div(class="busy-indicator",p(text),img(src=img))
    ,tags$script(sprintf(
    "	setInterval(function(){
    if ($('html').hasClass('shiny-busy')) {
    setTimeout(function() {
    if ($('html').hasClass('shiny-busy')) {
    $('div.busy-indicator').show()
    }
    }, %d)
    } else {
    $('div.busy-indicator').hide()
    }
},100)
    ",wait)
    )
)
}



initComplete <- function(){
  
  return (JS(
    "function(settings, json) {",
    "$(this.api().table().header()).css({'background-color': 'darkgrey', 'color': 'black'});",
    "}"))
}

########################################################
# FROM :http://stackoverflow.com/questions/35271661/update-shiny-r-custom-progressbar/39265225#39265225
progressBar2 <- function(inputId=NULL, value=0, label=FALSE, color="info", 
                         size=NULL,
                         striped=FALSE, active=FALSE, vertical=FALSE) {
    stopifnot(is.numeric(value))
    if (value < 0 || value > 100)
        stop("'value' should be in the range from 0 to 100", call. = FALSE)
    #if (!(color %in% shinydashboard:::validColors || color %in% shinydashboard:::validStatuses))
    #    stop("'color' should be a valid status or color.", call. = FALSE)
    if (!is.null(size))
        size <- match.arg(size, c("sm", "xs", "xxs"))
    text_value <- paste0(value, "%")
    if (vertical)
        style <- htmltools::css(height = text_value, `min-height` = "2em")
    else
        style <- htmltools::css(width = text_value, `min-width` = "2em")
    htmltools::tags$div(
        class = "progress",
        class = if (!is.null(size)) paste0("progress-", size),
        class = if (vertical) "vertical",
        class = if (active) "active",
        htmltools::tags$div(
            class = "progress-bar",
            class = paste0("progress-bar-", color),
            class = if (striped) "progress-bar-striped",
            id = paste0(inputId),
            role = "progressbar",
            style = style,
            `aria-valuemax` = 100,
            `aria-valuemin` = 0,
            `aria-valuenow` = value,
            htmltools::tags$span(
                id = "text_value",
                class = if (!label) "sr-only", 
                text_value)
        )
    )
}


updatePB <- function(session,inputId=NULL,value=NULL,label=NULL,color=NULL,text_value = NULL,size=NULL,striped=NULL,active=NULL,vertical=NULL) {
    data <- dropNulls(list(id=inputId,value=value,label=label,color=color,text_value=text_value,size=size,striped=striped,active=active,vertical=vertical))
    
    session$sendCustomMessage("updateprogress",data)
}

dropNulls <-function(x) {
    x[!vapply(x,is.null,FUN.VALUE=logical(1))]
}




########################################################

# Author: https://jackolney.github.io/2016/shiny/
progressGroup <- function(text, value, min = 0, max = value, color = "aqua") {
    stopifnot(is.character(text))
    stopifnot(is.numeric(value))
    if (value < min || value > max)
        stop(sprintf("'value' should be in the range from %d to %d.", min, max), call. = FALSE)
    tags$div(
        class = "progress-group",
        tags$span(class = "progress-text", text),
        tags$span(class = "progress-number", sprintf("%d / %d", value, max)),
        prgoressBar(round(value / max * 100), color = color, size = "sm")
    )
}


findSequences <- function(v){
    diff <- v[2:length(v)] - v[1:(length(v)-1)]
    
    if (!all(diff != 1)){
        s <- rle(diff == 1)
        begin <- c(0, cumsum(s$lengths))[which(s$values)] + 1
        end <- cumsum(s$lengths)[which(s$values)] +1

        seq <- "c("
        temp <- NULL
        i <- 1
    
        while(i < begin[1] && i < length(v))
        {
            seq <- paste(seq, v[i], ",", sep="")
            i <- i + 1
        }
    
        for (i in 1:length(begin)){
         seq <- paste(seq, v[begin[i]], ":", v[end[i]], sep="")
            if (i < length(begin)) {seq <- paste(seq, ",", sep="")}
            if (i < length(begin) && ((begin[i+1] - end[i]) > 1)){
                for(j in c((end[i]+1):(begin[i+1]-1))) {
                    seq <- paste(seq, v[j], ",", sep="")
                }
            }
        }
    
        i <- last(end) +1
        if (i <= length(v)) {seq <- paste(seq, ",", sep="")}
        while(i <= length(v))
        {
            seq <- paste(seq, v[i])
            if (i < length(v)) {seq <- paste(seq, ",", sep="")}
            i <- i +1
        }
    
    
        seq <- paste(seq, ")", sep="")
    
        }
    else 
        {
        seq <- paste("c(", paste(diff, collapse=","),")", sep="")
        }
    return(seq)
}



typeProtein <- "protein"
typePeptide <- "peptide"

calibMethod_Choices <- c("Benjamini-Hochberg", 
                         "st.boot", "st.spline", 
                         "langaas","jiang", "histo", 
                         "pounds", "abh","slim", 
                         "numeric value")
names(calibMethod_Choices)<- calibMethod_Choices

anaDiffMethod_Choices <- c("None"="None",
                           "Limma"="Limma", 
                           "t-tests"="ttests")


G_noneStr <- "None"
G_emptyStr <- ""
G_heatmapDistance_Choices <- list("Euclidean" ="euclidean",
                                  "Manhattan"="manhattan",
                                  "Maximum" = "maximum",
                                  "Canberra" = "canberra",
                                  "Binary" = "binary",
                                  "Minkowski" = "minkowski")

G_heatmapLinkage_Choices <- list("Complete" = "complete",
                                 "Average"="average",
                                 "Ward.D"="ward.D",
                                 "Ward.D2"="ward.D2",
                                 "Single" = "single",
                                 "Centroid" = "centroid",
                                 "Mcquitty" = "mcquitty",
                                 "Median" = "median")


G_logFC_Column <- "logFC"
G_pvalue_Column <- "P_Value"

G_sourceOfProtID_Choices <- c("Select a column in dataset" = "colInDataset",
  "Choose a file" = "extFile")

G_ontology_Choices <- c("Molecular Function (MF)"="MF" , 
                        "Biological Process (BP)" = "BP", 
                        "Cellular Component (CC)" = "CC")

G_universe_Choices <- c("Entire organism" = "Entire organism",
  "Entire dataset" = "Entire dataset",
  "Custom" = "Custom")

G_pAdjustMethod_Choices <- c("BH", "fdr", "None")

G_imp4PDistributionType_Choices <- c("uniform" = "unif", "beta" = "beta")

G_ConvertDataID_Choices <- c("Auto ID" = "Auto ID", "Custom ID" = "custom ID")
G_exportFileFormat_Choices <- c( "msnset","Excel", "zip")
gFileFormatExport <- list(msnset = "msnset",excel = "Excel", zip="zip")
gFileExtension <- list(txt = ".txt",
                       tsv = ".tsv",
                       msnset = ".msnset",
                       excel = ".xlsx",
                       zip = ".zip")


bsButtonRight <- function(...) {
    btn <- bsButton(...)
    # Directly inject the style into the shiny element.
    btn$attribs$style <- "float: right;"
    btn
}

actionBtnClass <- "btn-primary"

PrevNextBtnClass <- "btn-info"
optionsBtnClass <- "info"


# Call this function with all the regular navbarPage() parameters, plus a text parameter,
# if you want to add text to the navbar
navbarPageWithText <- function(..., text) {
  navbar <- navbarPage(...)
  textEl <- tags$p(class = "navbar-text", text)
  navbar[[3]][[1]]$children[[1]] <- htmltools::tagAppendChild(
    navbar[[3]][[1]]$children[[1]], textEl)
  navbar
}

# Call this function with an input (such as `textInput("text", NULL, "Search")`) if you
# want to add an input to the navbar
navbarPageWithInputs <- function(..., inputs) {
  navbar <- navbarPage(...)
  form <- tags$form(class = "navbar-form", inputs)
  navbar[[3]][[1]]$children[[1]] <- htmltools::tagAppendChild(
    navbar[[3]][[1]]$children[[1]], form)
  navbar
}



lstDescPlots <- c("intensity", "pca", "varDist", "corrMatrix", "heatmap", "mv", "quantiTable")
MSG_WARNING_SIZE_DT <- "The size of the table is too big to be exported with the buttons below (only the first 154 rows will be exported). It is advised to use the Export tool of Prostar."