R/Module_ShowSiriusModule.R

In mjhelf/Mosaic: Metaboseek platform

#' ShowSiriusModule
#' 
#' A button that triggers retrieval of Sirius results for the selected MS2 scans
#' 
#' @inherit MseekModules
#' 
#' @return Returns nothing
#' 
#' @describeIn ShowSiriusModule Server logic
#' 
#' @export 
ShowSiriusModule <- function(input,output, session, 
                          values = reactiveValues(SiriusModule = NULL,
                                                  GlobalOpts = NULL),
                          reactives = reactive({
                            list(splash = NULL,
                                 ms1splash = NULL,
                                 mz = NULL)
                          })
){
  
  ns <- NS(session$ns(NULL))
  internalValues <- reactiveValues(siriusStatus = NULL)
  
  
  #Don't show any SIRIUS results if the current query is NULL
  #or if the new query is different from the previous selection
  observeEvent(internalValues$query,{# input$getSirius,{#
      if(is.null(internalValues$query)
         || (!is.null(values$SiriusModule$activeSirius) && internalValues$query$hash != values$SiriusModule$activeSirius$hash)
         ){
          values$SiriusModule$activeSirius<- NULL
          
      }
  }, ignoreNULL = FALSE, ignoreInit = TRUE)
  
  #
  observeEvent(internalValues$activeSirius,{# input$getSirius,{#
      if(!is.null(internalValues$activeSirius) && internalValues$query$hash != values$SiriusModule$activeSirius$hash){
          values$SiriusModule$activeSirius<- NULL
          
      }
  }, ignoreNULL = FALSE, ignoreInit = TRUE)
  
 
  ###Show SIRIUS results on demand when clicking the show SIRIUS button
  observeEvent(input$getSirius,{
    if(is.null(internalValues$query)){
      values$SiriusModule$activeSirius<- NULL

    }else{
      tryCatch({
        
        values$SiriusModule$activeSirius <- getSirius(file.path(values$GlobalOpts$siriusFolder, "Metaboseek"),
                                                      hash = internalValues$query$hash, 
                                                      ts = internalValues$query$timestamp)

      }, error = function(e){
        showNotification(paste("A problem occured and SIRIUS results were not found. Maybe they are not ready yet, try again in a minute."), type = "error", duration = 3)
          values$SiriusModule$activeSirius<- NULL
          
      })
}
    values$SiriusModule$activeMF <- NULL
    values$SiriusModule$activeStructure <- NULL
  }, ignoreNULL = FALSE, ignoreInit = TRUE )
  
  
  output$getsiriusbutton <- renderUI({
    
    st <- "color: #000000; background-color: #C41230; border-color: #595959"
    ti <- "SIRIUS results not (yet) available for this spectrum."
    internalValues$query <- NULL
    
    if(is.null(values$SiriusModule$siriusIndex) 
       || is.null(reactives()$splash) 
       || !reactives()$splash %in% values$SiriusModule$siriusIndex$hash){
      print('red')
    }else{
      print('searching')
     

      job = data.frame(ion = values$GlobalOpts$SiriusSelIon,
                        ms1hash = reactives()$ms1splash,
                        charge = if(length(grep("-$",values$GlobalOpts$SiriusSelIon))){-1}else{1},
                        fingerid = values$GlobalOpts$SiriusCheckFinger,
                        moreOpts = " ",
                        Metaboseek_sirius_revision =  3,
                        stringsAsFactors = FALSE)
      
      conf = list(IsotopeSettings.filter = TRUE,
                  FormulaSearchDB = values$GlobalOpts$SiriusDBselected,
                  Timeout.secondsPerTree = 0, 
                  FormulaSettings.enforced = values$GlobalOpts$SiriusElements, 
                  Timeout.secondsPerInstance = 0, 
                  AdductSettings.detectable = if(length(grep("-$",values$GlobalOpts$SiriusSelIon))){"[[M-H]-,[M+Cl]-,[M+Br]-,[M-H2O-H]-]"}else{"[[M+K]+,[M+H3N+H]+,[M+Na]+,[M-H4O2+H]+,[M-H2O+H]+,[M+H]+]"} , 
                  UseHeuristic.mzToUseHeuristicOnly = 650, 
                  AlgorithmProfile = values$GlobalOpts$SiriusSelInstrument, #qtof 
                  IsotopeMs2Settings = "IGNORE", 
                  MS2MassDeviation.allowedMassDeviation = '5.0ppm', 
                  NumberOfCandidatesPerIon = 10, 
                  UseHeuristic.mzToUseHeuristic = 300, 
                  FormulaSettings.detectable = ",", 
                  NumberOfCandidates = 20, 
                  StructureSearchDB = values$GlobalOpts$SiriusDBselected,
                  AdductSettings.fallback = if(length(grep("-$",values$GlobalOpts$SiriusSelIon))){ "[[M-H]-,[M+Cl]-,[M+Br]-]"}else{"[[M+K]+,[M+Na]+,[M+H]+]"}, 
                  RecomputeResults = TRUE)
      
      job <- cbind(job, as.data.frame(lapply(conf,function(x){if(length(x) >1){paste(x, collapse = ",")}else{x}}), stringsAsFactors = FALSE))
      
      searchterm <- apply(job,1,
                          digest, algo = "xxhash64")
          
        
      hits <- which(reactives()$splash == values$SiriusModule$siriusIndex$hash
                    & values$SiriusModule$siriusIndex$settingsHash == searchterm[1])
     
      
     if(length(hits)>0){
       print('len(hits)>0')
       
       internalValues$query <- values$SiriusModule$siriusIndex[hits[length(hits)],]
       st <- "color: #000000; background-color: #9fe055; border-color: #595959"
       ti <- "SIRIUS results are available for this spectrum with the current SIRIUS settings."
       
     }else{
       print('len(hits)<=0')
       
       #retrieve the latest sirius result for the same spectrum regardless of sirius settings
       hits <- which(reactives()$splash == values$SiriusModule$siriusIndex$hash)
       internalValues$query <- values$SiriusModule$siriusIndex[hits[length(hits)],]
       st <- "color: #000000; background-color: #ffd016; border-color: #595959"
       ti <- "SIRIUS results are available for this spectrum, but NOT with the current SIRIUS settings"
       
     }
      
      
      
    }
    
    actionButton(ns("getSirius"), "Show SIRIUS", style = st, title = ti)
    
  })
}

#' @describeIn ShowSiriusModule UI elements
#' @export
ShowSiriusModuleUI <- function(id){
  ns <- NS(id)
  fluidPage(
    htmlOutput(ns("getsiriusbutton"))
  )
  
}