server.R

source('LoadPackages.R')

shinyServer(function(input, output,session) {

  hide(id = "loading-content", anim = TRUE, animType = "fade",time=1.5)
  hide(id = "loading-content-bar", anim = TRUE, animType = "fade",time=1.5)
  #####################################################
  ##
  ##                    LOAD FILES
  ##
  #####################################################
  
  ## Create base for contrast
  rand = floor(runif(1,0,1e9))
  namesfile = tempfile(pattern = "BaseContrast", tmpdir = tempdir(), fileext = "")
  file.create(namesfile,showWarnings=FALSE)
  
  ## Popup messages
  observe(if(input$AddRegScatter) info("By adding the regression line, you will lose interactivity."))
  

  ## Counts file
  dataInputCounts <-reactive({ 
    
    data = NULL
    inFile <- input$fileCounts
    
    if (is.null(inFile)) return(NULL)
    
    
    try(read.csv(inFile$datapath,sep=input$sepcount,header=TRUE,check.names=FALSE)->data,silent=T)

    if(!is.null(data)){
      colnames(data) = gsub("-",".",colnames(data))
      ## Rownames
      if(!TRUE%in%duplicated(data[,1])) rownames(data)=data[,1];data=data[,-1]
    }
    return(as.data.frame(data))
  })
  
  
  
  ## Taxo File
  dataInputTaxo <-reactive({ 
    
    inFile <- input$fileTaxo
    
    if (is.null(inFile)) return(NULL)
    
    if(input$TypeTaxo=="Table") 
    {
      try(read.csv(inFile$datapath,sep=input$septaxo,header=TRUE)->data,silent=T)
    
      ## Rownames
      if(!is.null(data))
      {
        if(!TRUE%in%duplicated(data[,1])){ 
          DataNames=data[,1]
          colNames=colnames(data)[-1]
          data=as.matrix(data[,-1])
          rownames(data)=DataNames
          colnames(data) = colNames
        }
      }
    }
    
    if(input$TypeTaxo=="RDP") 
    {
      data = read_rdp(inFile$datapath,input$RDP_th)
    }
    
    ## Add NA
    data=as.matrix(data)
    indNa = which(data=="")
    data[indNa]=NA
    
    return(as.data.frame(data))
  })
  
  
  ## BIOM File
  dataInputBiom <-reactive({ 
    
    data = NULL
    inFile <- input$fileBiom
    
    if (is.null(inFile)) return(NULL)
    try(read_biom(inFile$datapath)->data,silent=T)
    
    return(data)
  })
  
  
  
  ## Input data
  dataInput <-reactive({ 
    
    data = NULL
    check = NULL
    percent = NULL
    Taxo = NULL
    Counts = NULL
    if(input$FileFormat=="fileCounts")
    {
      Counts = dataInputCounts()
      if(!input$NoTaxoFile) Taxo = dataInputTaxo()
      if(!is.null(Counts) && input$NoTaxoFile) {Taxo = data.frame(rownames(Counts),row.names = rownames(Counts));names(Taxo)=NA}
      
      if(!is.null(Counts) && !is.null(Taxo))
      { 
        tmp = GetDataFromCT(Counts,Taxo)
        data = list(counts=tmp$counts,taxo=tmp$taxo)
        check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent)
        percent = tmp$Percent
      }    
    }
    
    if(input$FileFormat=="fileBiom")
    {
      tmpBIOM = dataInputBiom()
      if(!is.null(tmpBIOM))
      {
        tmp = GetDataFromBIOM(tmpBIOM)
        data = list(counts=tmp$counts,taxo=tmp$taxo)
        check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent)
        percent = tmp$Percent
      }
    }
    
    return(list(data=data,check=check,percent=percent))
  })
  
  
  
  
  
  ## Size factor file (optional)
  dataSizeFactors <-reactive({ 
    
    inFile <- input$fileSizeFactors
    
    if (is.null(inFile)) return(NULL)
    
    data = read.csv(inFile$datapath,sep=input$sepsize,header=TRUE)
    return(as.data.frame(data))
  })
  
  
  ## Size factor file (optional)
  SizeFactors_fromFile <-reactive({ 
    
    Error = NULL
    Check = TRUE
    
    data = dataSizeFactors()
    normFactors = dataMergeCounts()$normFactors
    
    if(!is.null(data)){
      ## Check the format
      
      tmp = as.numeric(data)
      names(tmp) = colnames(data)
      
      if(length(tmp)!=length(normFactors)){Error = "The number of samples is not the same than in the target file, size factors will be estimated"; Check = FALSE}
      if(!identical(names(tmp),names(normFactors))){Error = "The names are not the same or in the same order than in the target file, size factors will be estimated"; Check = FALSE}
      
      if(Check) normFactors = tmp
    }
    
    return(list(Check = Check,Error = Error,normFactors=normFactors))
  })
  
  
  
  
  
  
  ## Merge counts data
  dataMergeCounts <-reactive({
    input$RunDESeq
    
    counts = NULL
    CheckTarget = FALSE
    normFactors = NULL
    CT_noNorm = NULL
    CT_Norm = NULL
    ChTM = NULL
    data = isolate(dataInput()$data)
    target = isolate(dataInputTarget()$target)
    labeled= isolate(dataInputTarget()$labeled)
    taxo = isolate(input$TaxoSelect)
    
    withProgress(
    if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0 && !is.null(taxo) && taxo!="..." && !is.null(target)) 
    {
      design = GetDesign(isolate(input))
      ChTM = CheckTargetModel(input,target,labeled,data$counts)$Error
      
      if(!is.null(design) && is.null(ChTM))
      {
        tmp = isolate(GetCountsMerge(input,data,taxo,target,design))
        counts = tmp$counts
        
        ## Filtering the counts
        if(isolate(input$AddFilter) && !is.null(isolate(input$SliderThSamp)) && !is.null(isolate(input$SliderThAb)))
        {
          ind.filter =Filtered_feature(counts,isolate(input$SliderThSamp),isolate(input$SliderThAb))$ind
          counts = counts[-ind.filter,]
        }
        
        CheckTarget = tmp$CheckTarget
        #target = tmp$target
        #labeled = tmp$labeled
        normFactors = tmp$normFactors
        
        ## OTU table, norm and no norm
        CT_noNorm = tmp$CT_noNorm
        CT_Norm = tmp$CT_Norm
      }
    }
    ,message="Merging the counts ...")
    return(list(counts=counts,CheckTarget=CheckTarget,normFactors=normFactors,CT_noNorm=CT_noNorm, CT_Norm=CT_Norm))
    #return(list(counts=counts,target=target,labeled=labeled,normFactors=normFactors,CT_noNorm=CT_noNorm))
  })
  
  
  # Infobox Error counts
  output$InfoErrorCounts <- renderInfoBox({
    
    tmp = dataInput()
    data = tmp$data
    check = tmp$check
    cond = (!is.null(data$counts) && nrow(data$counts)>0)
    res =infoBox(h6(strong("Count table")), subtitle = h6("Load the count table") ,color = "light-blue",width=NULL,fill=TRUE, icon = icon("upload"))
    
    if(cond)
    {
      if(!is.null(check$CheckCounts$Warning)) res = infoBox(h6(strong("Count table")), subtitle = h6(check$CheckCounts$Warning), icon = icon("warning"),color = "orange",width=NULL,fill=TRUE)
      if(!is.null(check$CheckCounts$Error)) res = infoBox(h6(strong("Count table")), subtitle = h6(check$CheckCounts$Error), icon = icon("thumbs-o-down"),color = "red",width=NULL,fill=TRUE)
      if(is.null(check$CheckCounts$Error) && is.null(check$CheckCounts$Warning)) res = infoBox(h6(strong("Count table")), subtitle = h6(paste("Format of the count table seems to be OK")), icon = icon("thumbs-o-up"),color = "green",width=NULL,fill=TRUE)
    }
    
    return(res)
  })
  
  # Infobox Error counts
  output$InfoErrorTaxo <- renderInfoBox({
    
    tmp = dataInput()
    data = tmp$data
    check = tmp$check
    cond = (!is.null(data$taxo) && nrow(data$taxo)>0)
    res = infoBox(h6(strong("Taxonomy table")), subtitle = h6("Load the taxonomy table") ,color = "light-blue",width=NULL,fill=TRUE, icon = icon("upload"))
    
    if(cond)
    {
      if(!is.null(check$CheckTaxo$Warning)) res = infoBox(h6(strong("Taxonomy table")), subtitle = h6(check$CheckTaxo$Warning), icon = icon("warning"),color = "orange",width=NULL,fill=TRUE)
      if(!is.null(check$CheckTaxo$Error)) res = infoBox(h6(strong("Taxonomy table")), subtitle = h6(check$CheckTaxo$Error), icon = icon("thumbs-o-down"),color = "red",width=NULL,fill=TRUE)
      if(is.null(check$CheckTaxo$Error) && is.null(check$CheckTaxo$Warning)) res = infoBox(h6(strong("Taxonomy table")), subtitle = h6(paste("Format of the taxonomy table seems to be OK")), icon = icon("thumbs-o-up"),color = "green",width=NULL,fill=TRUE)
    }
    
    if(input$NoTaxoFile && input$FileFormat=="fileCounts") res = infoBox(h6(strong("Taxonomy table")), subtitle = h6("No taxonomy table has been uploaded, the analysis can only be done at the OTU/gene level"), icon = icon("warning"),color = "orange",width=NULL,fill=TRUE)
    return(res)
  })
  
  
  # Infobox Error counts
  output$valueErrorPercent <- renderInfoBox({
    
    tmp = dataInput()
    data = tmp$data
    check = tmp$check
    cond = (!is.null(data$counts) && nrow(data$counts)>0 && !is.null(data$taxo) && nrow(data$taxo)>0)
    res = valueBox(paste0(0, "%"),h6(strong("Annotated features")), color = "light-blue",width=NULL,icon = icon("list"))

    if(cond)
    {
      percent = round(100*tmp$percent,2)
      if(percent==0) res = valueBox(paste0(percent, "%"),h6(strong("Annotated features")), color = "red",width=NULL,icon = icon("list"))  
      if(percent!=0) res = valueBox(paste0(percent, "%"),h6(strong("Annotated features")), color = "green",width=NULL,icon = icon("list"))  
      
    }
    
    return(res)
  })
  
  
  ####### Filtering the counts (sliders)
  
  output$ThAb <- renderUI({
    input$AddFilter
    
    res = NULL
    counts = isolate(dataMergeCounts()$counts)
    tot = rowSums(counts)
    save(counts,tot,file="testFilter.RData")
    withProgress({tmp = SelectThreshAb(counts,lambda=max(round(sum(counts)/nrow(counts)*0.05),min(tot)+1),graph=FALSE)},message="Loading...")
    
    res = sliderInput("SliderThAb","Threshold on the total abundance (in log)",min=0,max=round(max(log(tot+1)),1),value = log(tmp+1))
    return(res)
  })
  
  
  output$ThSamp <- renderUI({
    input$AddFilter
    
    res = NULL
    counts = isolate(dataMergeCounts()$counts)
    counts.bin = as.matrix(counts)
    counts.bin[which(counts>0)] = 1
    nbSampByFeat = rowSums(counts.bin)
    
    ## Default value
    val = round(max(nbSampByFeat)*0.2)
    
    res = sliderInput("SliderThSamp","Threshold on the minimal number of samples",min=0,max=max(nbSampByFeat),value = val)
    return(res)
  })
  
  
  ## Plot for the filtering step$
  
  # plot_filter(counts,th.samp,th.abund,type="Scatter")
  
  output$Plot_ThAb <- renderPlot({
    counts = dataMergeCounts()$counts
    ## output of plot_filter is ggplot class
    plot_filter(counts,input$SliderThSamp,input$SliderThAb,type="Abundance")
    
  })
    
  output$Plot_ThSamp <- renderPlot({
    counts = dataMergeCounts()$counts
    ## output of plot_filter is ggplot class
    plot_filter(counts,input$SliderThSamp,input$SliderThAb,type="Samples")
  })
  
  output$Plot_Scatter_Filter <- renderScatterD3({
    counts = dataMergeCounts()$counts
    ## output of plot_filter is ggplot class
    plot_filter(counts,input$SliderThSamp,input$SliderThAb,type="Scatter")
  })
  #####################################################
  ##
  ##                DYNAMIC MENU
  ##
  #####################################################
  
  
  
  output$dymMenu <- renderMenu({
    
    tmp = dataInput()
    data = tmp$data
    check = tmp$check
    
    ## Check error in the counts and taxonomy table 
    CheckOK = (is.null(check$CheckCounts$Error) && is.null(check$CheckTaxo$Error)  && is.null(check$CheckPercent))
    if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0 && CheckOK)
    {

      sidebarMenu(id = "side",
        menuItem("Statistical analysis",
                 menuSubItem("Run differential analysis",tabName="RunDiff"),
                 menuSubItem("Diagnostic plots",tabName="DiagPlotTab"),
                 menuSubItem("Tables",tabName="TableDiff"),
                 icon = icon("bar-chart-o"), tabName = "AnaStat"
        ),
        menuItem("Visualization",icon = icon("area-chart"),
                 menuSubItem("Global views",tabName="GlobVisu"),
                 menuSubItem("Comparison plots",tabName="CompPlot"),
                 tabName = "Visu"),
        menuItem("Perspective plots", icon = icon("pie-chart"), tabName = "Krona")
      )
    } else{ sidebarMenu(id = "side",NULL)}

  })
  
  
  
  #####################################################
  ##
  ##                DATA TABLE
  ##
  #####################################################
  
  ## Counts Table
  output$DataCounts <- DT::renderDataTable(
    dataInput()$data$counts, 
    options = list(lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                   pageLength = 10,scrollX=TRUE, processing=FALSE
    ))
  
  ## Counts Table
  output$DataVenn<- DT::renderDataTable(#{
    #SelContrast = input$ContrastList_table_FC
    #resDiff = ResDiffAnal()
    #BaseContrast = read.table(namesfile,header=TRUE)
    GetData_venn(input,input$ContrastList_table_FC,read.table(namesfile,header=TRUE),ResDiffAnal())$df.tot,
  #}
   options = list(lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                    pageLength = 10,scrollX=TRUE, processing=FALSE
  ))
  
  
  ## Taxonomy table
  output$DataTaxo <- DT::renderDataTable(
    dataInput()$data$taxo, 
    options = list(lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                   pageLength = 10,scrollX=TRUE, processing=FALSE
    ))
  
  
  ## Tab box for data visualisation
  output$TabBoxData <- renderUI({
    
    data=dataInput()$data
    
    if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0)
    {
      tabBox(width = NULL, selected = "Count table",
             tabPanel("Count table",DT::dataTableOutput("DataCounts")),
             tabPanel("Taxonomy",DT::dataTableOutput("DataTaxo")),
             tabPanel("Summary",h5(strong("Percentage of annotation")),htmlOutput("SummaryView"),
                      br(),h5(strong("Number of features by level:")),plotOutput("SummaryViewBarplot",width = 1200,height=500))
      )
    }
    
  })
  
  output$SummaryView <- renderGvis({
    data = dataInput()$data
    taxo = data$taxo
    counts = data$counts
    res = NULL
    if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0)
    {
      taxo = rbind(taxo,rep(NA,ncol(taxo)))
      tmpPercent = round(apply(is.na(taxo),2,table)["FALSE",]/(nrow(taxo)-1)*100,2)
      
      #print(tmpPercent)
      df <- data.frame(Label = colnames(taxo),Value = tmpPercent)
      
      res = gvisGauge(df,options=list(min=0, max=100, greenFrom=80,
                                      greenTo=100, yellowFrom=60, yellowTo=80,
                                      redFrom=0, redTo=60, width=1200, height=300))
    }
    return(res)
  })
  
  
  output$SummaryViewBarplot <- renderPlot({
    data = dataInput()$data
    taxo = data$taxo
    counts = data$counts
    res = NULL
    if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0)
    {
      colors=rep(c("#1f77b4","#aec7e8","#ff7f0e","#ffbb78", "#2ca02c","#98df8a","#d62728","#ff9896","#9467bd","#c5b0d5","#8c564b",
                   "#c49c94","#e377c2","#f7b6d2","#7f7f7f", "#c7c7c7","#bcbd22","#dbdb8d","#17becf","#9edae5"),ceiling(ncol(taxo)/20))
      tmp = apply(taxo,2,unique)
      nbfeatures = as.numeric(lapply(tmp,length)) -as.numeric(lapply(lapply(tmp,is.na),any))
      df <- data.frame(Label = colnames(taxo),Count = nbfeatures)
      df$Label = factor(df$Label,levels =colnames(taxo) )
      res = ggplot(df,aes(x=Label,y=Count,fill=Label))+geom_bar(stat="identity")
      res = res + theme_bw() + xlab("Taxonomy") + scale_fill_manual(values=colors) + guides(fill=FALSE)
    }
    return(res)
  })
  
  #####################################################
  ##
  ##                TARGET FILE
  ##
  #####################################################
  
  
  ## Load target file
  dataInputTarget <-reactive({ 
    
    inFile <- input$fileTarget
    counts = dataInput()$data$counts
    
    
    if (is.null(inFile)) return(NULL)
    
    
    data = read.csv(inFile$datapath,sep=input$septarget,header=TRUE)
    data = as.data.frame(data)
    names = colnames(data)
    
    ## Change the rownames
    rownames(data) <- as.character(data[, 1])
    
    ## Keep only the row which are in the count table
    ind = which(rownames(data)%in%colnames(counts))
    data = as.data.frame(data[ind,])
    colnames(data) = names
    ## Replace "-" by "."
    if(ncol(data)>1 && nrow(data)>1){
      ind_num = which(sapply(as.data.frame(data[,-1]),is.numeric)) + 1
      if(length(ind_num)>0){
        data_tmp =cbind( as.data.frame(apply(as.data.frame(data[,-ind_num]),2,gsub,pattern = "-",replacement = ".")),data[,ind_num])
        colnames(data_tmp) = c(colnames(data)[-ind_num],colnames(data)[ind_num])
        data = data_tmp
      }
      if(length(ind_num)==0){data = as.data.frame(apply(data,2,gsub,pattern = "-",replacement = "."))}
    }
    target = as.data.frame(data)
    
    # target = as.data.frame(apply(target,2,gsub,pattern = "-",replacement = "."))
    
    #ord = order(rownames(data))
    #data = data[ord,]
    ### A SUPPRIMER 
    #rownames(data) <- colnames(counts)
    
    # Percent annotated
    #     print(ind)
    #     print(colnames(counts))
    #     print(rownames(data))
    labeled = length(ind)/length(colnames(counts))*100.0
    
    return(list(target = target, labeled=labeled))
  })
  
  
  
  ## Interest Variables
  output$SelectInterestVar <- renderUI({
    
    target=dataInputTarget()$target
    if(!is.null(target)) 
    {
      namesTarget = colnames(target)[2:ncol(target)]
      selectInput("InterestVar",h6(strong("Select the variables")),namesTarget,selected=namesTarget,multiple=TRUE)
    }
    
  })
  
  ## Interactions
  output$SelectInteraction2 <- renderUI({
    
    target = dataInputTarget()$target
    VarInt = input$InterestVar
    res = NULL
    if(!is.null(target) && length(input$InterestVar)>1) 
    {
      Interac = GetInteraction2(target,VarInt)
      res = selectInput("Interaction2",h6(strong("Add interactions")),Interac,selected=NULL,multiple=TRUE)
    }
    if(length(input$InterestVar)==1) res = NULL
    
    return(res)
  })


  ## Var for normalization
  output$SelectVarNorm <- renderUI({
    
    target=dataInputTarget()$target
    res = selectInput("VarNorm",h6(strong("Normalization by:")),NULL,multiple=TRUE)
    if(!is.null(target)) 
    {
      namesTarget = colnames(target)[2:ncol(target)]
      ind = which(apply(as.data.frame(target[,namesTarget]),2,is.numeric))
      if(length(ind)>=1) namesTarget = namesTarget[-ind]
      res = selectInput("VarNorm",h6(strong("Normalization by:")),c(NULL,namesTarget),multiple=TRUE)
    }
    return(res)
    
  })
  
  
  
  ## Reference radio buttons
  output$RefSelect <- renderUI({
    
    target = dataInputTarget()$target
    RB=list()
    if(!is.null(target)) 
    {
      InterVar = input$InterestVar
      if(length(InterVar)>0)
      {
        names = paste0("Ref",InterVar)
        for(i in 1:length(names))
        {
          val = unique(target[,InterVar[i]])
          RB[[i]] = selectInput(names[i],paste("Reference for",InterVar[i]),as.vector(val))
        }
      }
    }
    return(RB)
    
  })
  
  
  # Infobox design
  output$RowTarget <- renderInfoBox({
    #target = dataInputTarget()
    #labeled = dataMergeCounts()$labeled
    labeled = dataInputTarget()$labeled
    if(!is.null(labeled)) 
    {
      #### Ajout fontion check target
      #infoBox(h6(strong("Target file")), subtitle = h6("Your target file is OK"), icon = icon("thumbs-o-up"),color = "green",width=NULL,fill=TRUE)
      labeled = round(labeled,2)
      if(labeled>0) res = valueBox(paste0(labeled, "%"),h6(strong("Labeled features")), color = "green",width=NULL,icon = icon("list"))
      else res = valueBox(paste0(labeled, "%"),h6(strong("Labeled features")), color = "red",width=NULL,icon = icon("list"))  
    }
    #else infoBox(h6(strong("Target file")), subtitle = h6("Label of the target file must correspond to count table column names") ,color = "light-blue",width=NULL,fill=TRUE, icon = icon("warning"))
    else res = valueBox(paste0(0, "%"),h6(strong("Labeled features")), color = "light-blue",width=NULL,icon = icon("list"))
    return(res)
  }
  )
  
  
  
  
  ## target table
  output$DataTarget <- DT::renderDataTable(
    dataInputTarget()$target,
    options = list(lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                   pageLength = 10,scrollX=TRUE, processing=FALSE
    ))
  
  ## Counts table for the selected taxonomy level
  output$CountsMerge <- DT::renderDataTable(
    round(counts(ResDiffAnal()$dds,normalized=TRUE)),
    options = list(lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
                   pageLength = 10,scrollX=TRUE, processing=FALSE
    ))
  
  
  ## Box for merged counts
  output$BoxCountsMerge <- renderUI({
    input$RunDESeq
    counts = isolate(dataMergeCounts()$counts)
    taxo = input$TaxoSelect
    
    if(!is.null(counts) && taxo != "...")
    {
      box(title=paste("Count table (",taxo,")",sep=""),width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = TRUE,
          DT::dataTableOutput("CountsMerge"),
          downloadButton('ExportCounts', 'Export normalised counts'),
          downloadButton('ExportRelative', 'Export relative abundance')
      )  
    }
    
  })
  
  ## Export in .csv
  output$ExportCounts <- downloadHandler(
    filename = function() { 'NormCounts.csv' },
    content = function(file){write.csv(dataMergeCounts()$counts, file)}
  )
  
  ## Export in .csv
  output$ExportRelative <- downloadHandler(
    filename = function() { 'RelativeAb.csv' },
    content = function(file){write.csv(dataMergeCounts()$counts/colSums(dataMergeCounts()$counts), file)}
  )
  
  ## Export size factors
  output$ExportSizeFactor <- downloadHandler(
    filename = function() { if (input$sepsizef == "\t") 'SHAMAN_sizefactors.tsv' else 'SHAMAN_sizefactors.csv' },
    content = function(file){write.table(SizeFactor_table(), file,quote=FALSE,row.names = FALSE,sep=input$sepsizef)}
  )
  
  
  ## Box for target visualisation
  output$BoxTarget <- renderUI({
    
    target = dataInputTarget()$target
    
    if(!is.null(target) &&  nrow(target)>0)
    {
      box(title="Target file overview",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = TRUE,
          DT::dataTableOutput("DataTarget")
      )  
    }
    
  })
  
  
  
  #####################################################
  ##
  ##            DEFINE CONTRAST
  ##
  #####################################################
  
  output$contrastMat <- renderUI({
    
    resDiff = ResDiffAnal()
    dds = resDiff$dds
    names = resultsNames(dds)
    
    Contrast=list()
    
    for(i in 1:length(names)){Contrast[[i]] = numericInput(names[i],names[i],0,step=1,min=-1,max=1)}
    
    return(Contrast)
    
  })
  
  
  output$ContrastOverview <- renderPrint({
    
    resDiff = ResDiffAnal()
    dds = resDiff$dds
    names = resultsNames(dds)
    
    cont = input$ContrastList
    filesize = file.info(namesfile)[,"size"]
    if(is.na(filesize)){filesize=0}
    if(filesize!=0)
    { 
      ContrastBase = read.table(namesfile,header=TRUE)
      ind = which(colnames(ContrastBase)%in%cont)
      div(HTML(PrintContrasts(names,sapply(ContrastBase[,ind],as.numeric),cont)))
    }
  })
  
  
  ## Add contrast function
  AddCont <-eventReactive(input$AddContrast,{
    
    resDiff = ResDiffAnal()
    dds = resDiff$dds
    names = resultsNames(dds)
    
    BaseContrast(input,names,namesfile)
    filesize = file.info(namesfile)[,"size"]
    if(is.na(filesize)){filesize=0}
    if(filesize!=0) tmp = read.table(namesfile,header=TRUE)
    Contrast = colnames(as.matrix(tmp))
    updateSelectInput(session, "ContrastList","Contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table","Contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",Contrast)
  })
  
  ## Add contrast 
  observeEvent(input$AddContrast,{  
    
    AddCont()
    
  },priority=1)
  
  
  ## Add contrast function
  AddContEasy <-eventReactive(input$AddContrastEasy,{
    
    resDiff = ResDiffAnal()
    dds = resDiff$dds
    target = resDiff$target
    names = resultsNames(dds)
    
    BaseContrastEasy(input,names,namesfile,target)
    filesize = file.info(namesfile)[,"size"]
    if(is.na(filesize)){filesize=0}
    if(filesize!=0) tmp = read.table(namesfile,header=TRUE)
    Contrast = colnames(as.matrix(tmp))
    
    updateSelectInput(session, "ContrastList","Contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table","Contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",Contrast)
    updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",Contrast)
  })
  
  ## Add contrast 
  observeEvent(input$AddContrastEasy,{  
    
    AddContEasy()
    
  },priority=1)
  
  
  AddContFromFile <-eventReactive(input$fileContrast,{ 
    
    res = ReadContrastFile()
    createdCont = NULL
    filesize = file.info(namesfile)[,"size"]
    if(is.na(filesize)){filesize=0}
    if(filesize!=0){ createdCont = read.table(namesfile,header=TRUE) }
    
    if(!is.null(res))
    { 
      if(!is.null(createdCont)) res = cbind(res,createdCont)
      updateSelectInput(session, "ContrastList","Contrasts",colnames(res))
      updateSelectInput(session, "ContrastList_table","Contrasts",colnames(res))
      updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",colnames(res))
      updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",colnames(res))
      updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",colnames(res))
      write.table(res,namesfile,row.names=FALSE)
    }
  })
  
  observeEvent(input$fileContrast,{ 
    
    AddContFromFile()
  },priority=1)
  
  
  ## Remove contrast function
  RemoveCont <-eventReactive(input$RemoveContrast,{
    
    ## get the size of the contrast base file
    filesize = file.info(namesfile)[,"size"]
    if(is.na(filesize)){filesize=0}
    if(filesize!=0)
    { 
      tmp = read.table(namesfile,header=TRUE)
      ind = which(colnames(tmp)%in%input$ContrastList)
      matKept = as.matrix(tmp[,-ind])
      ContrastKept = colnames(tmp)[-ind]
      
      if(ncol(matKept)>0) write.table(matKept,namesfile,row.names=FALSE,col.names = ContrastKept)
      else file.create(namesfile,showWarnings=FALSE)
      updateSelectInput(session, "ContrastList","Contrasts",ContrastKept)
      updateSelectInput(session, "ContrastList_table","Contrasts",ContrastKept)
      updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",ContrastKept)
      updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",ContrastKept)
      updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",ContrastKept)
    }
  })
  
  
  
  ## Remove contrast
  observeEvent(input$RemoveContrast,{  
    
    RemoveCont()
    
  },priority=1)
  
  ## Remove all contrasts
  RemoveAllCont <-eventReactive(input$RunDESeq,{
    
    file.create(namesfile,showWarnings=FALSE)
    updateSelectInput(session, "ContrastList","Contrasts",NULL)
    updateSelectInput(session, "ContrastList_table","Contrasts",NULL)
    updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",NULL)
    updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",NULL)
    updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",NULL)
  })
  
  ## Remove all contrast
  observeEvent(input$RunDESeq,{  
    
    RemoveAllCont()
    
  })
  
  # Infobox Contrast
  output$InfoContrast <- renderInfoBox({
    input$RunDESeq
    input$AddContrast
    input$AddContrastEasy
    input$RemoveContrast
    input$fileContrast
    resDiff = ResDiffAnal()
    res=NULL
    if(!is.null(resDiff)){
      
      res = infoBox("Contrasts", subtitle = h6("At least one contrast (non null) must be defined"), icon = icon("warning"),color = "light-blue",width=NULL,fill=TRUE)
      test = FALSE
      filesize = isolate(file.info(namesfile)[,"size"])
      
      if(is.na(filesize)){filesize=0}
      if(filesize!=0) 
      {
        tmp = read.table(namesfile,header=TRUE)
        if(any(as.vector(tmp)!=0)) test = TRUE
      }
      
      if(test) res = infoBox("Contrasts", subtitle = h6("Contrasts OK"), icon = icon("thumbs-o-up"),color = "green",width=NULL,fill=TRUE)
    }
    return(res)
  })
  
  
  
  output$contrastBox <- renderUI({
    
    resDiff = ResDiffAnal()
    int = input$Interaction2
    
    if(!is.null(resDiff))
    { 
      ## Check the R version
      if(as.numeric(R.Version()$major)<=3 && as.numeric(R.Version()$minor) <=1.2){
        box(title="Contrasts (New)",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = FALSE,
            fluidRow(
              column(width=3,selectInput("Select1_contrast","Compare","")),
              column(width=3,selectInput("Select2_contrast","To","")),
              if(length(int)>=1) column(width=3,selectInput("Select3_contrast",label=h6(strong("For")),"")),
              column(width=3,br(),actionButton("AddContrastEasy","Add",icon = icon("plus")))
            )
        )
      }
    }
    
    
    
  })
  
  ModifMod_ContEasy <-eventReactive(input$Select1_contrast,{
    input$RunDESeq
    resDiff = ResDiffAnal()
    int = input$Interaction2
    target = as.data.frame(resDiff$target)
    
    InterVar = input$InterestVar
    
    
    
    ## Get the selected variable from the selected modality
    Sel_Var = InterVar[which(unlist(lapply(as.data.frame(target[,InterVar]),FUN = function(x){input$Select1_contrast%in%x})))]
    
    ModInterestCond = levels(sapply(target[,Sel_Var],as.factor))
    ModInterestCond = ModInterestCond[-which(ModInterestCond==input$Select1_contrast)]
    
    updateSelectInput(session,"Select2_contrast","To",ModInterestCond)
  })
  
  
  observeEvent(input$Select1_contrast,{ 
    
    ModifMod_ContEasy()
  })
  
  
  ModifMod_ContEasyFrom <-eventReactive(input$RunDESeq,{
    
    resDiff = ResDiffAnal()
    int = input$Interaction2
    target = as.data.frame(resDiff$target)
    
    InterVar = input$InterestVar
    
    ## Remove numeric variable
    ind = unlist(lapply(as.data.frame(target[,InterVar]),is.numeric))
    InterVar = InterVar[!ind]
    target_int = lapply(as.data.frame(target[,InterVar]),as.factor)
    ModInterestAll = unique(unlist(lapply(target_int,levels)))