diff --git a/R/app.R b/R/app.R index bc430b5..3656dfa 100644 --- a/R/app.R +++ b/R/app.R @@ -2,8 +2,19 @@ #' #' @param host The hostname to serve the application on. #' @param port The port to serve the application on. +#' @param custom_dataset This allows to set a custom dataset (return value of +#' [analyze()]) as the default dataset of the UI. #' #' @export -run_app <- function(host = "127.0.0.1", port = 3464) { - runApp(shinyApp(ui, server), host = host, port = port) +run_app <- function(host = "127.0.0.1", + port = 3464, + custom_dataset = NULL) { + runApp( + shinyApp( + ui(custom_dataset = custom_dataset), + server(custom_dataset = custom_dataset) + ), + host = host, + port = port + ) } diff --git a/R/server.R b/R/server.R index bfe51e0..ace9cd6 100644 --- a/R/server.R +++ b/R/server.R @@ -1,184 +1,188 @@ #' Server implementing the main user interface. #' @noRd -server <- function(input, output, session) { - dataset <- reactive({ - analysis <- if (input$dataset == "gtex_tissues") { - ubigen::gtex_tissues - } else if (input$dataset == "hpa_tissues") { - ubigen::hpa_tissues - } else { - ubigen::gtex_all - } - - merge(analysis, ubigen::genes, by = "gene") - }) - - ranked_data <- reactive({ - rank_genes( - data = dataset(), - cross_sample_metric = input$cross_sample_metric, - cross_sample_weight = input$cross_sample_weight, - level_metric = input$level_metric, - level_weight = input$level_weight, - variation_metric = input$variation_metric, - variation_weight = input$variation_weight - ) - }) - - custom_genes <- gene_selector_server("custom_genes") |> debounce(500) - - output$overview_plot <- plotly::renderPlotly(overview_plot( - ranked_data(), - highlighted_genes = custom_genes() - )) - - observeEvent(custom_genes(), - { # nolint - if (length(custom_genes()) > 0) { - updateTabsetPanel(session, "results_panel", selected = "custom_genes") - } else if (input$results_panel == "custom_genes") { - updateTabsetPanel(session, "results_panel", selected = "top_genes") +server <- function(custom_dataset = NULL) { + function(input, output, session) { + dataset <- reactive({ + analysis <- if (input$dataset == "gtex_tissues") { + ubigen::gtex_tissues + } else if (input$dataset == "hpa_tissues") { + ubigen::hpa_tissues + } else if (input$dataset == "gtex_all") { + ubigen::gtex_all + } else { + custom_dataset } - }, - ignoreNULL = FALSE - ) - output$custom_genes_synopsis <- renderText({ - comparison_gene_ids <- custom_genes() - - if (length(comparison_gene_ids) > 1) { - reference <- ranked_data()[!gene %chin% comparison_gene_ids, score] - comparison <- ranked_data()[gene %chin% comparison_gene_ids, score] - - reference_median <- format( - round(stats::median(reference), digits = 3), - nsmall = 3 - ) - - comparison_median <- format( - round(stats::median(comparison), digits = 3), - nsmall = 3 - ) - - test_result <- stats::wilcox.test( - x = comparison, - y = reference, - alternative = "greater", - conf.int = TRUE - ) - - p_value <- format( - round(test_result$p.value, digits = 4), - nsmall = 4, - scientific = FALSE - ) - - lower <- format(round(test_result$conf.int[1], digits = 3), nsmall = 3) - upper <- format(round(test_result$conf.int[2], digits = 3), nsmall = 3) - - HTML(glue::glue( - "The p-value with the alternative hypothesis that your genes have ", - "higher scores than other genes is {p_value}. This value ", - "was computed using a Wilcoxon rank sum test. Based on a 95% ", - "confidence, the difference in scores is between {lower} and ", - "{upper}. The median score of your genes is ", - "{comparison_median} compared to a median score of ", - "{reference_median} of the other genes." - )) - } - }) - - output$custom_genes_boxplot <- plotly::renderPlotly( - box_plot(ranked_data(), custom_genes()) - ) - - genes_table_server("custom_genes", reactive({ - ranked_data()[gene %chin% custom_genes()] - })) - - output$scores_plot <- plotly::renderPlotly(scores_plot( - ranked_data(), - highlighted_genes = custom_genes() - )) - - selected_genes <- reactive({ - selected_points <- plotly::event_data("plotly_selected") - ranked_data()[rank %in% selected_points$x] - }) - - genes_table_server("selected_genes", reactive({ - if (nrow(selected_genes()) > 0) { - selected_genes() - } else { - ranked_data() - } - })) - - gsea_genes <- reactive({ - sort(if (input$gsea_set == "top") { - ranked_data()[rank >= input$gsea_ranks, gene] - } else if (input$gsea_set == "selected") { - selected_genes()[, gene] - } else { - custom_genes() + merge(analysis, ubigen::genes, by = "gene") }) - }) - gsea_result <- reactive({ - withProgress( - message = "Querying g:Profiler", - value = 0.0, + ranked_data <- reactive({ + rank_genes( + data = dataset(), + cross_sample_metric = input$cross_sample_metric, + cross_sample_weight = input$cross_sample_weight, + level_metric = input$level_metric, + level_weight = input$level_weight, + variation_metric = input$variation_metric, + variation_weight = input$variation_weight + ) + }) + + custom_genes <- gene_selector_server("custom_genes") |> debounce(500) + + output$overview_plot <- plotly::renderPlotly(overview_plot( + ranked_data(), + highlighted_genes = custom_genes() + )) + + observeEvent(custom_genes(), { # nolint - setProgress(0.2) - gprofiler2::gost(gsea_genes()) - } + if (length(custom_genes()) > 0) { + updateTabsetPanel(session, "results_panel", selected = "custom_genes") + } else if (input$results_panel == "custom_genes") { + updateTabsetPanel(session, "results_panel", selected = "top_genes") + } + }, + ignoreNULL = FALSE ) - }) |> - bindCache(gsea_genes()) |> - bindEvent(input$gsea_run, ignoreNULL = FALSE) - output$gsea_plot <- plotly::renderPlotly({ - gprofiler2::gostplot(gsea_result(), interactive = TRUE) - }) + output$custom_genes_synopsis <- renderText({ + comparison_gene_ids <- custom_genes() - output$gsea_details <- DT::renderDT({ - data <- data.table(gsea_result()$result) - setorder(data, p_value) + if (length(comparison_gene_ids) > 1) { + reference <- ranked_data()[!gene %chin% comparison_gene_ids, score] + comparison <- ranked_data()[gene %chin% comparison_gene_ids, score] - data[, total_ratio := term_size / effective_domain_size] - data[, query_ratio := intersection_size / query_size] - data[, increase := (query_ratio - total_ratio) / total_ratio] + reference_median <- format( + round(stats::median(reference), digits = 3), + nsmall = 3 + ) - data <- data[, .( - source, - term_name, - total_ratio, - query_ratio, - increase, - p_value - )] + comparison_median <- format( + round(stats::median(comparison), digits = 3), + nsmall = 3 + ) - DT::datatable( - data, - rownames = FALSE, - colnames = c( - "Source", - "Term", - "Total ratio", - "Query ratio", - "Increase", - "p-value" - ), - options = list( - pageLength = 25 + test_result <- stats::wilcox.test( + x = comparison, + y = reference, + alternative = "greater", + conf.int = TRUE + ) + + p_value <- format( + round(test_result$p.value, digits = 4), + nsmall = 4, + scientific = FALSE + ) + + lower <- format(round(test_result$conf.int[1], digits = 3), nsmall = 3) + upper <- format(round(test_result$conf.int[2], digits = 3), nsmall = 3) + + HTML(glue::glue( + "The p-value with the alternative hypothesis that your genes have ", + "higher scores than other genes is {p_value}. This value ", + "was computed using a Wilcoxon rank sum test. Based on a 95% ", + "confidence, the difference in scores is between {lower} and ", + "{upper}. The median score of your genes is ", + "{comparison_median} compared to a median score of ", + "{reference_median} of the other genes." + )) + } + }) + + output$custom_genes_boxplot <- plotly::renderPlotly( + box_plot(ranked_data(), custom_genes()) + ) + + genes_table_server("custom_genes", reactive({ + ranked_data()[gene %chin% custom_genes()] + })) + + output$scores_plot <- plotly::renderPlotly(scores_plot( + ranked_data(), + highlighted_genes = custom_genes() + )) + + selected_genes <- reactive({ + selected_points <- plotly::event_data("plotly_selected") + ranked_data()[rank %in% selected_points$x] + }) + + genes_table_server("selected_genes", reactive({ + if (nrow(selected_genes()) > 0) { + selected_genes() + } else { + ranked_data() + } + })) + + gsea_genes <- reactive({ + sort(if (input$gsea_set == "top") { + ranked_data()[rank >= input$gsea_ranks, gene] + } else if (input$gsea_set == "selected") { + selected_genes()[, gene] + } else { + custom_genes() + }) + }) + + gsea_result <- reactive({ + withProgress( + message = "Querying g:Profiler", + value = 0.0, + { # nolint + setProgress(0.2) + gprofiler2::gost(gsea_genes()) + } ) - ) |> - DT::formatRound("p_value", digits = 4) |> - DT::formatPercentage( - c("total_ratio", "query_ratio", "increase"), - digits = 2 - ) - }) + }) |> + bindCache(gsea_genes()) |> + bindEvent(input$gsea_run, ignoreNULL = FALSE) - output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking) + output$gsea_plot <- plotly::renderPlotly({ + gprofiler2::gostplot(gsea_result(), interactive = TRUE) + }) + + output$gsea_details <- DT::renderDT({ + data <- data.table(gsea_result()$result) + setorder(data, p_value) + + data[, total_ratio := term_size / effective_domain_size] + data[, query_ratio := intersection_size / query_size] + data[, increase := (query_ratio - total_ratio) / total_ratio] + + data <- data[, .( + source, + term_name, + total_ratio, + query_ratio, + increase, + p_value + )] + + DT::datatable( + data, + rownames = FALSE, + colnames = c( + "Source", + "Term", + "Total ratio", + "Query ratio", + "Increase", + "p-value" + ), + options = list( + pageLength = 25 + ) + ) |> + DT::formatRound("p_value", digits = 4) |> + DT::formatPercentage( + c("total_ratio", "query_ratio", "increase"), + digits = 2 + ) + }) + + output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking) + } } diff --git a/R/ui.R b/R/ui.R index 56cafdc..078d3c5 100644 --- a/R/ui.R +++ b/R/ui.R @@ -1,6 +1,6 @@ #' Function for creating the main user interface. #' @noRd -ui <- function() { +ui <- function(custom_dataset = NULL) { div( custom_css(), rclipboard::rclipboardSetup(), @@ -22,11 +22,19 @@ ui <- function() { selectInput( "dataset", label = strong("Expression dataset"), - list( - "GTEx (across tissues and conditions)" = "gtex_all", - "GTEx (across tissues)" = "gtex_tissues", - "Human Protein Atlas (across tissues)" = "hpa_tissues" - ) + { + choices <- list( + "GTEx (across tissues and conditions)" = "gtex_all", + "GTEx (across tissues)" = "gtex_tissues", + "Human Protein Atlas (across tissues)" = "hpa_tissues" + ) + + if (!is.null(custom_dataset)) { + c(list("Custom dataset" = "custom"), choices) + } else { + choices + } + } ), selectInput( "cross_sample_metric", diff --git a/man/run_app.Rd b/man/run_app.Rd index 3de7878..db863e1 100644 --- a/man/run_app.Rd +++ b/man/run_app.Rd @@ -4,12 +4,15 @@ \alias{run_app} \title{Run the application server.} \usage{ -run_app(host = "127.0.0.1", port = 3464) +run_app(host = "127.0.0.1", port = 3464, custom_dataset = NULL) } \arguments{ \item{host}{The hostname to serve the application on.} \item{port}{The port to serve the application on.} + +\item{custom_dataset}{This allows to set a custom dataset (return value of +\code{\link[=analyze]{analyze()}}) as the default dataset of the UI.} } \description{ Run the application server.