server.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)
  target = NULL
  
  
  ## JSON name for masque
  curdir  = getwd()
  json_name = tempfile(pattern = "file", tmpdir = paste(curdir,"www","masque","todo",sep= .Platform$file.sep),  fileext = ".json")
  
  ## Pass for MASQUE
  pass = gsub("file","",basename(file_path_sans_ext(json_name)))
  
  ## Popup messages
  observe(if(input$AddRegScatter) info("By adding the regression line, you will lose interactivity."))
  
  ## Reactive target
  values <- reactiveValues(TargetWorking = target,labeled=NULL,fastq_names_only=NULL,R1fastQ=NULL,R2fastQ=NULL,
                           json_name=json_name,num=0,pass=pass,login_email = NULL,is.valid =NULL,
                           biom_masque = NULL,tree_masque=NULL, masque_key = NULL, count_table_masque = NULL, 
                           rdp_annot_masque = NULL, rdp_thres_masque = NULL,
                           paths_fastq_tmp=NULL,curdir=curdir, error_progress=FALSE)
  
  ## Counts file
  dataInputCounts <-reactive({ 
    
    data = NULL
    inFile <- input$fileCounts
    if (is.null(inFile) && is.null(values$count_table_masque)) return(NULL)
    #if (is.null(inFile)) return(NULL)
    
    if (!is.null(values$count_table_masque) && file.exists(values$count_table_masque)){
      tryCatch(read.csv(values$count_table_masque,sep="\t",header=TRUE,check.names=FALSE)->data,
               error=function(e) sendSweetAlert(messageId="ErrorCounts",
                                                title = "Oops",
                                                text=paste("The count file can not be read in SHAMAN.\n \n",e),type ="error"))
    }
    else{
      tryCatch(read.csv(inFile$datapath,sep=input$sepcount,header=TRUE,check.names=FALSE)->data,
               error=function(e) sendSweetAlert(messageId="ErrorCounts",
                                                title = "Oops",
                                                text=paste("Your file can not be read in SHAMAN.\n \n",e),type ="error"))
    }
    #print(data)
    if(!is.null(data)){
      colnames(data) = gsub("-",".",colnames(data))
      ## Rownames
      if(!TRUE%in%duplicated(data[,1])) rownames(data)=data[,1];data=data[,-1]
      try(round(data, 0)->data, silent=T)
    }
    
    return(as.data.frame(data))
  })
  
  
  
  ## Taxo File
  dataInputTaxo <-reactive({ 
    
    inFile <- input$fileTaxo
    
    if (is.null(inFile) && is.null(values$rdp_annot_masque)) return(NULL)
    #if (is.null(inFile)) return(NULL)
    
    if(input$TypeTaxo=="Table" && !is.null(inFile)) 
    {
      tryCatch(read.csv(inFile$datapath,sep=input$septaxo,header=TRUE)->data,
               error=function(e) sendSweetAlert(messageId="ErrorTaxo",
                                                title = "Oops",
                                                text=paste("Your file can not be read in SHAMAN.\n \n",e),type ="error"))
      
      ## 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" && !is.null(inFile) || !is.null(values$rdp_annot_masque)) 
    {
      if (!is.null(values$rdp_annot_masque) && file.exists(values$rdp_annot_masque)){
        tryCatch(read_rdp(values$rdp_annot_masque,values$rdp_thres_masque)->data,
                 error=function(e) sendSweetAlert(messageId="ErrorRDP",
                                                  title = "Oops",
                                                  text=paste("The annotation file can not be read in SHAMAN.\n \n",e),type ="error"))
      }
      else{
        tryCatch(read_rdp(inFile$datapath,input$RDP_th)->data,
                 error=function(e) sendSweetAlert(messageId="ErrorRDP",
                                                  title = "Oops",
                                                  text=paste("Your file can not be read in SHAMAN.\n \n",e),type ="error"))
      }
      
    }
    
    ## 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) && is.null(values$biom_masque)){
      tryCatch(read_biom(inFile$datapath)->data,
               error=function(e) sendSweetAlert(messageId="ErrorBiom1",
                                                title = "Oops",
                                                text=paste("Your file can not be read in SHAMAN.\n \n",e),type ="error"))
      
    }
    if (!is.null(values$biom_masque) && file.exists(values$biom_masque)){ 
      tryCatch(read_biom(values$biom_masque)->data,
               error=function(e) sendSweetAlert(messageId="ErrorBiom2",
                                                title = "Oops",
                                                text=paste("Your file can not be read in SHAMAN.\n \n",e),type ="error"))
    }
    return(data)
  })
  
  observeEvent(input$fileCounts,{
    values$count_table_masque=NULL;
  })
  observeEvent(input$fileTaxo,{
    values$rdp_annot_masque=NULL;
    values$rdp_thres_masque=NULL;
  })
  observeEvent(input$fileBiom,{
    values$biom_masque=NULL;
  })
  
  
  ## Unifrac File (tree)
  dataInputTree <-reactive({ 
    
    data = NULL
    inFile <- input$fileTree
    
    if (!is.null(inFile) && is.null(values$tree_masque)) {
      try(read.tree(inFile$datapath)->data, silent=T)
      CheckTree = CheckTreeFile(data)
      data = CheckTree$tree
      try(readLines(inFile$datapath)->treeseq, silent=T)
      return(list(data=data, Error=CheckTree$Error, Warning=CheckTree$Warning, treeseq=treeseq))
    }
    
    if (!is.null(values$tree_masque) && file.exists(values$tree_masque)) {
      try(read.tree(values$tree_masque)->data, silent=T)
      CheckTree = CheckTreeFile(data)
      data = CheckTree$tree
      try(readLines(values$tree_masque)->treeseq, silent=T)
      return(list(data=data, Error=CheckTree$Error, Warning=CheckTree$Warning, treeseq=treeseq))
    }
    
  })
  
  
  observeEvent(input$fileTree,{
    values$tree_masque=NULL;
  })
  
  
  # Infobox Tree (Unifrac)
  output$InfoTreePhylo_box <- renderInfoBox({
    input$fileTree
    tree_tmp = isolate(dataInputTree())
    tree = tree_tmp$data
    
    res = infoBox(h6(strong("Phylogenetic tree")), subtitle = h6(strong("Load the phylogenetic tree (optional)")) ,color = "light-blue",width=NULL,fill=TRUE, icon = icon("upload"))
    if(!is.null(tree)){
      if(!is.null(isolate(input$fileTree))){
        res = infoBox(h6(strong("Phylogenetic tree")), subtitle = h6("The phylogenetic has been loaded") ,color = "green",width=NULL,fill=TRUE, icon = icon("thumbs-o-up"))
        if(!is.null(tree_tmp$Warning)){      
          res = infoBox(h6(strong("Phylogenetic tree")), subtitle = h6(tree_tmp$Warning) ,color = "orange",width=NULL,fill=TRUE, icon = icon("warning"))
        }
        if(!is.null(tree_tmp$Error)){      
          res = infoBox(h6(strong("Phylogenetic tree")), subtitle = h6(tree_tmp$Error),color = "red",width=NULL,fill=TRUE, icon = icon("thumbs-o-down"))
        }
      }
    } 
    return(res)
  })
  
  observe({
    val <- input$annotationKingdomthreshold
    # Control the value, min, max, and step.
    # Step size is 2 when input value is even; 1 when value is odd.
    updateSliderInput(session, "annotationPhylumthreshold", value = input$annotationPhylumthreshold,
                      min = val, max = 1, step = 0.005)
  })
  observe({
    val <- input$annotationPhylumthreshold[2]
    # Control the value, min, max, and step.
    # Step size is 2 when input value is even; 1 when value is odd.
    updateSliderInput(session, "annotationClassthreshold", value = input$annotationClassthreshold,
                      min = val, max = 1, step = 0.005)
  })
  observe({
    val <- input$annotationClassthreshold[2]
    # Control the value, min, max, and step.
    # Step size is 2 when input value is even; 1 when value is odd.
    updateSliderInput(session, "annotationOrderthreshold", value = input$annotationOrderthreshold,
                      min = val, max = 1, step = 0.005)
  })
  observe({
    val <- input$annotationOrderthreshold[2]
    # Control the value, min, max, and step.
    # Step size is 2 when input value is even; 1 when value is odd.
    updateSliderInput(session, "annotationFamilythreshold", value = input$annotationFamilythreshold,
                      min = val, max = 1, step = 0.005)
  })
  observe({
    val <- input$annotationFamilythreshold[2]
    # Control the value, min, max, and step.
    # Step size is 2 when input value is even; 1 when value is odd.
    updateSliderInput(session, "annotationGenusthreshold", value = input$annotationGenusthreshold,
                      min = val, max = 1, step = 0.005)
  })
  observe({
    val <- input$annotationGenusthreshold[2]
    # Control the value, min, max, and step.
    # Step size is 2 when input value is even; 1 when value is odd.
    updateSliderInput(session, "annotationSpeciethreshold", value = input$annotationSpeciethreshold,
                      min = val, max = 1, step = 0.005)
  })
  ## Input data
  dataInput <-reactive({ 
    
    data = NULL
    check = NULL
    percent = NULL
    Taxo = NULL
    Counts = NULL
    inputData = 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, ifelse(input$TypeTable=="MGS" && input$FileFormat!="fileBiom", TRUE, FALSE))
        data = list(counts=tmp$counts,taxo=tmp$taxo)
        ## Remove row with only O
        # data[["counts"]] = data[["counts"]][rowSums(data[["counts"]])>1,]
        
        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)
        ## Remove row with only O
        # data[["counts"]] = data[["counts"]][rowSums(data[["counts"]])>1,]
        
        check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent)
        percent = tmp$Percent
      }
    }
    
    
    
    #     if(input$FileFormat=="fileRData")
    #     {
    #       inFile <- input$fileRData
    #       load(inFile)
    #       if(!is.null(inputData)){
    #         data = inputData$data
    #         check = inputData$check
    #         percent = inputData$percent
    #       }
    #     }
    
    return(list(data=data,check=check,percent=percent))
  })
  
  
  ## Size factor file (optional)
  dataSizeFactors <-reactive({ 
    
    inFile <- input$fileSizeFactors
    
    if (is.null(inFile)) return(NULL)
    
    tryCatch(read.csv(inFile$datapath,sep=input$sepsize,header=TRUE)->data,
             error=function(e) sendSweetAlert(messageId="ErrorSizeFactor",
                                              title = "Oops",
                                              text=paste("Your file can not be read in SHAMAN.\n \n",e),type ="error"))
    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
    ChMC = NULL
    data = isolate(dataInput()$data)
    target = isolate(values$TargetWorking)
    labeled= isolate(values$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),target)
        print(design)
        ChTM = CheckTargetModel(input,target,labeled,data$counts)$Error
        if(!is.null(design) && is.null(ChTM))
        {
          tmp = isolate(GetCountsMerge(input,data,taxo,target,design))
          #ChMC = tmp$Error
          #if (!is.null(ChMC))
          #{
            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, Error = ChMC))
    #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 = shinydashboard::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 = shinydashboard::valueBox(paste0(percent, "%"),h6(strong("Annotated features")), color = "red",width=NULL,icon = icon("list"))  
      if(percent!=0) res = shinydashboard::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({
    tree = dataInputTree()$data
    data=dataInput()$data
    res=NULL
    if(!is.null(tree))
    {
      res = 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)),
                   tabPanel("Phylogeny", PhyloTreeMetaROutput('PhyloTreeMetaR'))
      )
      
    }
    else if(is.null(tree))
    {
      res = 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))
      )
      
    }
    return(res)
  })
  
  observe({
    data=dataInput()$data
    if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0)
    {
      showElement("tabboxdata_col",anim=TRUE)
    } else hideElement("tabboxdata_col",anim=TRUE)
    
  })
  
  output$PhyloTreeMetaR <- renderPhyloTreeMetaR({
    PhyloTreeMetaR(dataInputTree()$treeseq,NULL)
  })
  
  output$SummaryView <- renderGvis({
    tmp = dataInput()
    data = tmp$data
    taxo = data$taxo
    counts = data$counts
    check = tmp$check
    cond = (!is.null(data$counts) && nrow(data$counts)>0 && !is.null(data$taxo) && nrow(data$taxo)>0 && is.null(check$CheckTaxo$Error) && is.null(check$CheckCounts$Error))
    
    res = NULL
    if(cond)
    {
      taxo = rbind(taxo,rep(NA,ncol(taxo)))
      #tmpPercent = round(apply(is.na(taxo),2,table)["FALSE",]/(nrow(taxo)-1)*100,2)
      
      tmp = apply(is.na(taxo),2,table)
      
      if (class(tmp) == "list") {
        tmp2 = sapply(tmp, function (x) {if (! "FALSE" %in% names(x)) {x["FALSE"] = 0} ; return(x["FALSE"])})
      }
      else
      {
        tmp2 = tmp["FALSE",]
      }
      
      tmpPercent = round(tmp2/(nrow(taxo)-1)*100,2)
      
      
      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))
      res = gvisGauge(df,options=list(min=0, max=100, greenFrom=80,
                                      greenTo=100, yellowFrom=60, yellowTo=80,
                                      redFrom=0, redTo=60, width=800, height=200))
    }
    return(res)
  })
  
  
  output$SummaryViewBarplot <- renderPlot({
    tmp = dataInput()
    data = tmp$data
    taxo = data$taxo
    counts = data$counts
    check = tmp$check
    cond = (!is.null(data$counts) && nrow(data$counts)>0 && !is.null(data$taxo) && nrow(data$taxo)>0 && is.null(check$CheckTaxo$Error) && is.null(check$CheckCounts$Error))
    
    res = NULL
    if(cond)
    {
      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
  observe({ 
    
    inFile <- input$fileTarget
    counts = dataInput()$data$counts
    labeled = 0
    data = NULL
    
    if (is.null(inFile)) return(NULL)
    
    ## Read the data
    try(read.csv(inFile$datapath,sep=input$septarget,header=TRUE)->data,silent=TRUE)

    if(!is.null(data))
    {
      data = as.data.frame(data)
      names = colnames(data)
      
      ## Change the rownames
      if(!TRUE%in%duplicated(data[,1])) rownames(data)=gsub(pattern = "-",replacement = ".",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])
          #data_tmp =cbind( as.data.frame(as.data.frame(data[,-ind_num])),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 = "."))}
      }
      
      values$TargetWorking = as.data.frame(data)
      #       ind_sel = Target_selection()
      #       if(length(ind))
      # 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))
      values$labeled = length(ind)/length(colnames(counts))*100.0
    }
    
    # return(list(target = target, labeled=labeled))
  })
  
  
  
  
  #############################################################
  ##
  ##                        MASQUE
  ##
  #############################################################
  
  
  
  observeEvent(input$dir,{
    
    inFiles <- input$dir
    
    if (!is.null(inFiles)){
      # values$fastq_names_only = unique(paste(values$fastq_names_only,inFiles$name))
      values$paths_fastq_tmp = rbind(isolate(values$paths_fastq_tmp),inFiles)
      values$fastq_names_only = isolate(unique(values$paths_fastq_tmp[,"name"]))
    }
  })
  
  
  
  ## Create a fasta file containing the contaminant
  CreateFasta <- reactive({
    seq = NULL
    tmp = tempdir()
    fastaName = paste(tmp,paste(basename(file_path_sans_ext(json_name)),"_contaminant.fasta",sep=""),sep = .Platform$file.sep)
    
    if(!file.exists(fastaName)) file.create(fastaName,showWarnings=FALSE)
    if(input$PairedOrNot=="y"){seq =paste("#Seq1\n",input$R1primer,"\n \n","#Seq2\n",input$R2primer,sep="")}
    if(input$PairedOrNot=="n"){seq =input$primerSingle}
    if(!is.null(seq))  write(seq, file=fastaName)
    
  })
  
  
  ## Action with submit button
  MasqueSubmit <- eventReactive(input$submit,{
    #activate check_mail
    CMP = CheckMasque(input, values,check_mail = TRUE)
    Error = CMP$Error
    
    isJSONalreadyExist = file.exists(paste(values$curdir,"www","masque","doing",basename(json_name),sep= .Platform$file.sep))
    
    if(is.null(Error) && !isJSONalreadyExist)
    {
      CreateFasta()
      values$num = 1
      tmp = tempdir()
      # home <- normalizePath("~")
      home <- ""
      # path_glob = file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
      
      
      ## Paired-end
      if(input$PairedOrNot=="y"){
        cmp = 0
        nfiles = length(values$R1fastQ)+length(values$R2fastQ)
        
        withProgress(message = 'Uploading files...', value = 0, {
          pathToR1 = paste(tmp,"Masque_files_R1",sep=.Platform$file.sep)
          pathToR2 = paste(tmp,"Masque_files_R2",sep=.Platform$file.sep)
          
          if(dir.exists(pathToR1)){file.remove(list.files(pathToR1,full.names =TRUE))} else dir.create(pathToR1)
          if(dir.exists(pathToR2)){file.remove(list.files(pathToR2,full.names =TRUE))} else dir.create(pathToR2)
          for(i in values$R1fastQ){
            ind=which(i==values$paths_fastq_tmp[,"name"])[1]
            file.rename(from=values$paths_fastq_tmp[,"datapath"][ind], to=paste(tmp,"Masque_files_R1",i,sep= .Platform$file.sep))
            cmp = cmp +1
            incProgress(cmp/nfiles, detail = "Forward fastq files...")
          }
          for(i in values$R2fastQ){
            ind=which(i==values$paths_fastq_tmp[,"name"])[1]
            file.rename(from=values$paths_fastq_tmp[,"datapath"][ind], to=paste(tmp,"Masque_files_R2",i,sep= .Platform$file.sep))
            cmp = cmp +1
            incProgress(cmp/nfiles, detail = "Reverse fastq files...")
          }
        })
        
      } else{
        
        cmp = 0
        nfiles = length(values$fastq_names_only)
        
        withProgress(message = 'Uploading files...', value = 0, {
          
          pathTo = paste(tmp,"Masque_files",sep=.Platform$file.sep)
          
          if(dir.exists(pathTo)){file.remove(list.files(pathTo,full.names =TRUE))} else dir.create(pathTo)
          
          for(i in values$fastq_names_only){
            ind=which(i==values$paths_fastq_tmp[,"name"])[1]
            file.rename(from=values$paths_fastq_tmp[,"datapath"][ind], to=paste(tmp,"Masque_files",i,sep= .Platform$file.sep));cmp = cmp +1;incProgress(cmp/nfiles)}
        })
      }
      
      ## Create JSON file
      withProgress(message = 'Creating JSON file...',{CreateJSON(input,values)})
      if(file.exists(values$json_name)) values$num = 1
      sendSweetAlert(messageId="SuccessMasque",
                     title = "Success",
                     text = paste("Your data have been submitted. You will receive an e-mail once the computation over. <br /> This can take few hours.
                                  <br /> 
                                  <br /> 
                                  <br /> 
                                  <em> Remind: You can close shaman and use your key to check the progression and get your results: </em>",values$pass),
                     type = "success",
                     html=TRUE
                     )
    }
    
  })
  
  
  observeEvent(input$submit,{  
    
    tryCatch(MasqueSubmit(),
             error=function(e) sendSweetAlert(messageId="ErrorMasque",
                                              title = "Oops",
                                              text=paste("Something wrong when submitting.\n \n",e),type ="error"))
    
    
  },priority = 1)
  
  
  ## FastQ list
  output$FastQList_out <- renderUI({
    res = NULL
    if(!is.null(input$dir)){
      NullBox = h3(strong("0 FastQ file detected"),style="color:red;  text-align: center")
      res = NullBox
      
      if(length(values$fastq_names_only)>0)
      {
        res =list(selectInput("FastQList",label = "List of the fastq files in the selected directory",isolate(values$fastq_names_only),multiple =TRUE,selectize=FALSE,size = 6),
                  actionButton("RemoveFastQbut",'Remove file(s)',icon=icon("remove")))
      } else res = NullBox
    }
    return(res)
  })
  
  
  
  
  ## Remove FastQ function
  RemoveFastQ <-eventReactive(input$RemoveFastQbut,{
    
    if(length(input$FastQList)>0)
    {
      ind = which(values$fastq_names_only%in% input$FastQList)
      values$fastq_names_only = values$fastq_names_only[-ind]
      values$paths_fastq_tmp = values$paths_fastq_tmp[-ind,]
      updateSelectInput(session, "FastQList","List of the fastq files in the selected directory",values$fastq_names_only)
    }
  })
  
  
  
  
  
  ## Remove FastQ
  observeEvent(input$RemoveFastQbut,{  
    
    RemoveFastQ()
    if(input$MatchFiles_button>=1) MatchFiles()
    
  },priority=1)
  
  
  
  ## Update R1 and R2 lists
  MatchFiles <-reactive({
    
    if(length(values$fastq_names_only)>0 && input$PairedOrNot=='y')
    {
      indR1 = grep(input$R1files,values$fastq_names_only)
      indR2 = grep(input$R2files,values$fastq_names_only)
      
      ## If some are R1 and R2, removed from both list
      b12 = intersect(indR1,indR2)
      if(length(b12)>0) {indR1 = indR1[-which(indR1%in%b12)]; indR2 = indR2[-which(indR2%in%b12)]}
      
      
      if(length(indR1)>0 && length(indR2)>0){
        
        values$R1fastQ = values$fastq_names_only[indR1]
        values$R2fastQ = values$fastq_names_only[indR2]
        
        ## If some are only R1 or R2
        tmpR1 = gsub(input$R1files,x=values$R1fastQ,""); tmpR2 = gsub(input$R2files,x=values$R2fastQ,"")
        values$R1fastQ = values$R1fastQ[tmpR1%in%tmpR2];values$R2fastQ = values$R2fastQ[tmpR2%in%tmpR1]
        
        ## Update the files lists
        updateSelectInput(session, "R1filesList","",values$R1fastQ); updateSelectInput(session, "R2filesList","",values$R2fastQ)
      } else{updateSelectInput(session, "R1filesList","","");updateSelectInput(session, "R2filesList","","")}
    } else{updateSelectInput(session, "R1filesList","","");updateSelectInput(session, "R2filesList","","")}
  })
  
  
  observeEvent(input$MatchFiles_button,{  
    
    MatchFiles()
    
  },priority=1)
  
  
  
  ## Remove FastQ function directly from R1, R2
  RemoveFastQ_R1R2 <-eventReactive(input$RemoveFastQbut_R1R2,{
    
    if(length(input$R1filesList)>0)
    {
      ind = which(values$R1fastQ%in% input$R1filesList)
      values$R1fastQ = values$R1fastQ[-ind]
      updateSelectInput(session, "R1filesList","",values$R1fastQ)
    }
    
    if(length(input$R2filesList)>0)
    {
      ind = which(values$R2fastQ%in% input$R2filesList)
      values$R2fastQ = values$R2fastQ[-ind]
      updateSelectInput(session, "R2filesList","",values$R2fastQ)
    }
    
    
  })
  
  
  
  RemoveFastQ_R1R2_all <-eventReactive(input$LoadFiles,{
    
    values$R1fastQ = NULL
    updateSelectInput(session, "R1filesList","","")
    values$R2fastQ = NULL
    updateSelectInput(session, "R2filesList","","")