inst/extdata/shinyApp/main/MetEx.single.server.R

In zhengfj1994/MeTEA: Targeted extraction from untargeted metabolomics dataset by using metabolomics database

##############################################################################
shinyjs::hide(id = "result.plot.table")
shinyjs::hide(id = "result.hide.button")
shinyjs::hide(id = "parameter.hide.button")
shinyjs::hide(id = "Advance.parameters")
## observe the button being pressed
observeEvent(input$Advance.parameters.hide.button, {

  if(input$Advance.parameters.hide.button %% 2 == 1){
    shinyjs::show(id = "Advance.parameters")
  }else{
    shinyjs::hide(id = "Advance.parameters")
  }
})

observeEvent(input$result.hide.button, {

  if(input$result.hide.button %% 2 == 1){
    shinyjs::hide(id = "result.plot.table")
  }else{
    shinyjs::show(id = "result.plot.table")
  }
})

observeEvent(input$parameter.hide.button, {

  if(input$parameter.hide.button %% 2 == 1){
    shinyjs::hide(id = "parameters")
  }else{
    shinyjs::show(id = "parameters")
  }
})

observeEvent(input$startMetEx, {
  withCallingHandlers({
    shinyjs::html("text", "")
    if (length(input$db.path$datapath)==0){
      dbFile.MetEx <- system.file("extdata/database", "example_database.xlsx", package = "MetEx")
    }
    else {
      dbFile.MetEx <- input$db.path$datapath
    }

    if (length(input$msRawData$datapath)==0){
      msRawData.MetEx <- system.file("extdata/mzXML", "example.mzXML", package = "MetEx")
    }
    else {
      msRawData.MetEx <- input$msRawData$datapath
    }

    if (length(input$mgfFile$datapath)==0){
      mgfFile.MetEx <- system.file("extdata/mgf", "example.mgf", package = "MetEx")
    }
    else {
      mgfFile.MetEx <- input$mgfFile$datapath
    }
    MetExAnnotationRes <-  MetExAnnotation(dbFile = dbFile.MetEx,
                                           ionMode = input$ionMode,
                                           CE = input$CE,
                                           tRCalibration = input$tRCalibration,
                                           is.tR.file = input$is.tR.file$datapath,
                                           msRawData = msRawData.MetEx,
                                           MS1deltaMZ = input$MS1deltaMZ,
                                           MS1deltaTR = input$MS1deltaTR,
                                           entroThre = input$entroThre,
                                           intThre = input$intThre,
                                           mgfFile = mgfFile.MetEx,
                                           MS1MS2DeltaMZ = input$MS1MS2DeltaMZ,
                                           MS2DeltaMZ = input$MS2DeltaMZ,
                                           MS1MS2DeltaTR = input$MS1MS2DeltaTR,
                                           MS2.sn.threshold = input$MS2.sn.threshold,
                                           MS2.noise.intensity = input$MS2.noise.intensity,
                                           MS2.missing.value.padding = input$MS2.missing.value.padding,
                                           MS2scoreFilter = input$MS2scoreFilter,
                                           parallel.Computing = T,
                                           cores = input$cores)
    # print(MetExAnnotationRes[[input$download.file]])

    observeEvent(input$download.file, {
      if (input$download.file == "all"){
        data = MetExAnnotationRes[["MS1 identified Result"]]

        output$downloadData <- downloadHandler(
          filename = function() {
            paste("result-",Sys.Date(), ".xlsx",sep="")
          },
          content = function(file) {
            openxlsx::write.xlsx(MetExAnnotationRes, file)
          }
        )
      }
      else {
        data = MetExAnnotationRes[[input$download.file]]

        output$downloadData <- downloadHandler(
          filename = function() {
            paste("result-",Sys.Date(), ".csv",sep="")
          },
          content = function(file) {
            write.csv(data, file, row.names = FALSE)
          }
        )
      }

      data$trOfPeak <- round(as.numeric(data$trOfPeak), 2)
      data$`m/z` <- round(data$`m/z`, 4)
      data$peakHeight <- round(data$peakHeight, 0)
      data$entropy <- round(data$entropy, 3)
      data$DP <- round(data$DP, 3)
      data$RDP <- round(data$RDP, 3)
      data$frag.ratio <- round(data$frag.ratio, 3)
      data <- data[which(data$score != "Can't find MS2 in Database"),]
      data$score <- round(as.numeric(data$score), 3)
      pos.data = which(colnames(data) != "Name" &
                         colnames(data) != "tr" &
                         colnames(data) != "`m/z`" &
                         colnames(data) != "ionMode" &
                         colnames(data) != "CE" &
                         colnames(data) != "trOfPeak" &
                         colnames(data) != "peakHeight" &
                         colnames(data) != "peakArea" &
                         colnames(data) != "entropy" &
                         colnames(data) != "DP" &
                         colnames(data) != "RDP" &
                         colnames(data) != "frag.ratio" &
                         colnames(data) != "score")

      output$Plot <- renderPlot({
        ggplot(data, aes(x=trOfPeak,y=`m/z`))+
          geom_point(aes(size=peakHeight,fill=entropy),shape=21,colour="black",alpha=0.8)+
          scale_fill_gradient2(low="#377EB8",high="#E41A1C",midpoint = mean(data$entropy))+
          scale_size_area(max_size=input$size.points)+
          guides(size = guide_legend((title="peakHeight")))+
          theme(
            legend.text=element_text(size=10,face="plain",color="black"),
            axis.title=element_text(size=10,face="plain",color="black"),
            axis.text = element_text(size=10,face="plain",color="black"),
            legend.position = "right"
          )
      })
      dataTableOutput("Data")
      output$Data = renderDataTable(server = FALSE,{
        dt <- datatable(
          cbind(' ' = '&oplus;', data),
          rownames = FALSE,
          escape = -1,
          options = list(
            columnDefs = list(
              list(visible = FALSE, targets = pos.data),
              list(orderable = FALSE, className = 'details-control', targets = 0)
            )
          ),

          callback = JS(paste0("table.column(1).nodes().to$().css({cursor: 'pointer'});var format = function(d){return '<table cellpadding=\"5\" cellspacing=\"0\" border=\"0\" style=\"padding-left:50px;\">'+",
                               paste0("'<tr>'+'<td>",colnames(data)[pos.data],":</td>'+'<td>'+d[",pos.data,"]+'</td>'+'</tr>'+", sep = "", collapse = ""),
                               "'</table>';};table.on('click', 'td.details-control', function() {var td = $(this), row = table.row(td.closest('tr'));if (row.child.isShown()) {row.child.hide();td.html('&oplus;');} else {row.child(format(row.data())).show();td.html('&CircleMinus;');}});"))
        )
      })
    })

    shinyjs::show(id = "result.plot.table")
    shinyjs::show(id = "result.hide.button")
    shinyjs::show(id = "parameter.hide.button")
  },
  message = function(m) {
    shinyjs::html(id = "text", html = m$message, add = F)
  })
})



output$logo <- renderText({
  validate(need(input$startMetEx, "")) #I'm sending an empty string as message.
  input$startMetEx
  URL <- "Finished.png"
  #print(URL)
  Sys.sleep(2)
  c('<center><img src="', URL, '"width="100%" height="100%" align="middle"></center>')})
##############################################################################