geposanui/R/server.R

# Java script function to replace gene IDs with Ensembl gene links.
js_link <- DT::JS("function(row, data) {
    let id = data[1];
    var name = data[2];
    if (!name) name = 'Unknown';
    let url = `https://www.ensembl.org/Homo_sapiens/Gene/Summary?g=${id}`;
    $('td:eq(1)', row).html(`<a href=\"${url}\" target=\"_blank\">${name}</a>`);
}")

server <- function(input, output, session) {
    preset <- preset_editor_server("preset_editor")

    observe({
        species_count <- length(preset()$species_ids)
        updateSliderInput(
            session,
            "n_species",
            max = species_count
        )
    })

    # Compute the results according to the preset.
    analysis <- reactive({
        preset <- preset()

        # Perform the analysis cached based on the preset's hash.
        analysis <- withProgress(
            message = "Analyzing genes",
            value = 0.0,
            { # nolint
                geposan::analyze(preset, function(progress) {
                    setProgress(progress)
                })
            }
        )

        analysis
    })

    min_n_species <- reactive(input$n_species)

    # Rank the results.
    ranking <- methods_server("methods", analysis, min_n_species)

    # Add gene information to the results.
    results <- reactive({
        merge(
            ranking(),
            geposan::genes,
            by.x = "gene",
            by.y = "id",
            sort = FALSE
        )
    })

    # Apply the filters.
    results_filtered <- filters_server("filters", results)

    output$genes <- DT::renderDT({
        columns <- c("rank", "gene", "name", "chromosome", method_ids, "score")
        column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")

        dt <- DT::datatable(
            results_filtered()[, ..columns],
            rownames = FALSE,
            colnames = column_names,
            style = "bootstrap",
            fillContainer = TRUE,
            extensions = "Scroller",
            options = list(
                rowCallback = js_link,
                columnDefs = list(list(visible = FALSE, targets = 2)),
                deferRender = TRUE,
                scrollY = 200,
                scroller = TRUE
            )
        )

        DT::formatPercentage(dt, c(method_ids, "score"), digits = 1)
    })

    output$copy <- renderUI({
        results <- results_filtered()

        gene_ids <- results[, gene]
        names <- results[name != "", name]

        genes_text <- paste(gene_ids, collapse = "\n")
        names_text <- paste(names, collapse = "\n")

        splitLayout(
            cellWidths = "auto",
            rclipboard::rclipButton(
                "copy_ids_button",
                "Copy gene IDs",
                genes_text,
                icon = icon("clipboard")
            ),
            rclipboard::rclipButton(
                "copy_names_button",
                "Copy gene names",
                names_text,
                icon = icon("clipboard")
            )
        )
    })

    output$scatter <- plotly::renderPlotly({
        preset <- preset()

        gene_sets <- list(preset$reference_gene_ids)
        labels <- c("Reference genes")

        comparison_gene_ids <- results_filtered()[
            input$genes_rows_selected,
            gene
        ]

        if (length(comparison_gene_ids) >= 1) {
            gene_sets <- c(gene_sets, list(comparison_gene_ids))
            labels <- c(labels, "Comparison genes")
        }

        geposan::plot_positions(
            preset$species_ids,
            gene_sets = gene_sets,
            labels = labels,
            use_positions = input$use_positions
        )
    })

    output$assessment_synopsis <- renderText({
        reference_gene_ids <- preset()$reference_gene_ids

        included_reference_count <- results_filtered()[
            gene %chin% reference_gene_ids,
            .N
        ]

        reference_results <- results()[gene %chin% reference_gene_ids]
        total_reference_count <- nrow(reference_results)

        if (total_reference_count > 0) {
            mean_rank <- as.character(round(
                reference_results[, mean(rank)],
                digits = 1
            ))

            min_rank <- as.character(reference_results[, min(rank)])
            max_rank <- as.character(reference_results[, max(rank)])
        } else {
            mean_rank <- "Unknown"
            min_rank <- "Unknown"
            max_rank <- "Unknown"
        }

        sprintf(
            "Included reference genes: %i/%i<br> \
            Mean rank of reference genes: %s<br> \
            First rank of reference genes: %s<br> \
            Last rank of reference genes: %s",
            included_reference_count,
            total_reference_count,
            mean_rank,
            min_rank,
            max_rank
        )
    })

    output$rank_plot <- plotly::renderPlotly({
        gene_sets <- list(preset()$reference_gene_ids)
        labels <- c("Reference genes")

        comparison_gene_ids <- results_filtered()[
            input$genes_rows_selected,
            gene
        ]

        if (length(comparison_gene_ids) >= 1) {
            gene_sets <- c(gene_sets, list(comparison_gene_ids))
            labels <- c(labels, "Comparison genes")
        }

        geposan::plot_scores(
            ranking(),
            gene_sets = gene_sets,
            labels = labels,
            max_rank = results_filtered()[, max(rank)]
        )
    })

    output$boxplot <- plotly::renderPlotly({
        gene_sets <- list(preset()$reference_gene_ids)
        labels <- c("Reference genes")

        comparison_gene_ids <- results_filtered()[
            input$genes_rows_selected,
            gene
        ]

        if (length(comparison_gene_ids) >= 1) {
            gene_sets <- c(gene_sets, list(comparison_gene_ids))
            labels <- c(labels, "Comparison genes")
        }

        geposan::plot_boxplot(
            ranking(),
            gene_sets = gene_sets,
            labels = labels
        )
    })

    output$gost <- plotly::renderPlotly({
        if (input$enable_gost) {
            result <- gprofiler2::gost(
                results_filtered()[, gene],
                ordered_query = TRUE
            )

            gprofiler2::gostplot(
                result,
                capped = FALSE,
                interactive = TRUE
            )
        } else {
            NULL
        }
    })
}