inst/shiny_app/server.R

In shutinet/metabSeek: Search in several databases metabolites masses or spectras

#' @title Shiny app server function
#'
#' @description
#' Server part of the shiny app (see how to build a shiny app)
#' 
#' @param input
#' @param output
#' @param session
#' 
function(input, output, session) {

# charge some global variables
utils::data(adducts_df, package = "metabSeek")

# to stop application when user close internet browser
session$onSessionEnded(shiny::stopApp)

observeEvent(input$polarity, {
    choices <- if (input$polarity) adducts_df[which(adducts_df$Charge < 0), "Name"]
        else adducts_df[which(adducts_df$Charge > 0), "Name"]
    shiny::updateSelectizeInput(session, "adducts", label = "adducts", choices = choices, 
        selected = choices)
})

hits <- reactive({
    try_it({
    mz <- input$mz
    mda <- if (!input$unit) input$tol else 0
    ppm <- if (input$unit) input$tol else 0
    adducts <- input$adducts
    
    adducts <- as.character(adducts)
    db <- DBI::dbConnect(RSQLite::SQLite(), 
        system.file("extdata", "database.sqlite", package = "metabSeek"))
    databases <- DBI::dbListTables(db)
    DBI::dbDisconnect(db)
    
    metabSeek::check_inputs(rep("", 3), c(is.numeric(mz), is.numeric(ppm) & 
            is.numeric(mda), length(adducts) > 0), 
        c("m/z is not numerical", "the mass tolerance is not numerical", 
            "you must provide at least one adduct"))
    metabSeek::check_inputs(rep("", 2), c(mz > 0, mda >= 0 & ppm >= 0), 
        c("m/z is not a valid", "the mass tolerance must be a positive number"))
    metabSeek::do_hit_mzs(mz, mda, ppm, databases, adducts)[[1]]
    }, list(func = "shiny_hit_mzs", params = list(mz = mz, mda = mda, ppm = ppm, adducts = adducts)), 
        as.data.frame(matrix(, ncol = 11, 
        dimnames = list(c(), c("database", "id", "link", "formula", "adduct", 
            "name", "synonyms", "smiles", "inchikey", "m/z deviation mda", 
            "m/z deviation ppm"))))[-1, ])
})

output$hits <- DT::renderDataTable({
    result <- hits()
    # format column id to contain href
    result$id <- sprintf('<a href = "%s" target = "_blank">%s</a>', 
        result$link, result$id)
    result$formula <- as.factor(result$formula)
    result$adduct <- as.factor(result$adduct)
    result[, "m/z deviation"] <- if (input$unit) round(result[, "m/z deviation ppm"], 1)
        else round(result[, "m/z deviation mda"], 2)
    result[order(result[, "m/z deviation"]), c("database", "id", "formula", "adduct", "m/z deviation", 
        "name", "synonyms", "smiles")]
}, escape = FALSE, rownames = FALSE, filter = "top", server = FALSE, selection = "none", 
    extensions = c("FixedColumns", "Scroller", "Select"), options = list(
        deferRender = TRUE, select = "single", scroller = TRUE, scrollX = TRUE, 
        scrollY = "52vh", columnDefs = list(list(visible = FALSE, targets = 7)), 
        initComplete = DT::JS('
            function(settings, json) {
                this.api().row(0).select(0);
                draw_smiles(this.api().cell(0, 7).data());
            }
    ')), callback = DT::JS('
        table.on("select", function(e, dt, type, index) {
            draw_smiles(table.row(index).data()[7]);
        });
'))

output$piechart_databases <- plotly::renderPlotly(plotly::plot_ly(hits(), 
    type = "pie", showlegend = FALSE, labels = ~database, 
    values = ~as.numeric(as.factor(database)), 
    textinfo = "label+percent", hoverinfo = "label+percent"))

output$piechart_adducts <- plotly::renderPlotly(plotly::plot_ly(hits(), 
    type = "pie", showlegend = FALSE, labels = ~adduct, 
    values = ~as.numeric(as.factor(adduct)), 
    textinfo = "label+percent", hoverinfo = "label+percent"))


}