diff --git a/R/app.R b/R/app.R index 7cb3ece..4015b66 100644 --- a/R/app.R +++ b/R/app.R @@ -1,15 +1,40 @@ #' Run the application server. #' +#' @param gene_sets A list of predefined gene sets. This should be a named list +#' containing vectors of gene IDs for each set. The names will be used to +#' present the gene set throughout the user interface. You have to provide *at +#' least one gene set* which will be selected as the initial reference gene +#' set. +#' @param species_sets A list of predefined species sets. This should be a named +#' list containing vectors of species IDs for each set. The names will be used +#' to present the species set throughout the user interface. +#' @param locked Whether the application should be locked and prohibit +#' performing custom analyses. If this is set to `TRUE`, only the predefined +#' gene and species sets are available for customizing the analysis. This may +#' be useful to limit resource usage on a publicly available instance. #' @param port The port to serve the application on. #' #' @export -run_app <- function(port = 3464) { - # These function calls make the required java scripts available. +run_app <- function(gene_sets, + species_sets = NULL, + locked = FALSE, + port = 3464) { + stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]])) + # These function calls make the required java scripts available. shinyjs::useShinyjs() rclipboard::rclipboardSetup() - # Actually run the app. + # Bundle of global options to redue broilerplate. + options <- list( + gene_sets = gene_sets, + species_sets = species_sets, + locked = locked + ) - shiny::runApp(shiny::shinyApp(ui, server), port = port) + # Actually run the app. + shiny::runApp( + shiny::shinyApp(ui(options), server(options)), + port = port + ) } diff --git a/R/comparison_editor.R b/R/comparison_editor.R index 1b28bd1..3259cb2 100644 --- a/R/comparison_editor.R +++ b/R/comparison_editor.R @@ -1,22 +1,23 @@ -# Create a comparison editor. -comparison_editor_ui <- function(id) { +#' Create a comparison editor. +#' +#' @param options Global application options +#' @noRd +comparison_editor_ui <- function(id, options) { verticalLayout( h3("Comparison"), selectInput( NS(id, "comparison_genes"), "Comparison genes", - choices = list( - "None" = "none", - "Random genes" = "random", - "Verified or suggested TPE-OLD genes" = "tpeold", - "Only verified TPE-OLD genes" = "verified", - "Only suggested TPE-OLD genes" = "suggested", - "Customize" = "custom" + choices = c( + "None", + "Random genes", + names(options$gene_sets), + "Customize" ) ), conditionalPanel( condition = sprintf( - "input['%s'] == 'custom'", + "input['%s'] == 'Customize'", NS(id, "comparison_genes") ), gene_selector_ui(NS(id, "custom_genes")) @@ -24,33 +25,32 @@ comparison_editor_ui <- function(id) { ) } -# Create a server for the comparison editor. -# -# @param id ID for namespacing the inputs and outputs. -# @param preset A reactive containing the current preset. -# -# @return A reactive containing the comparison gene IDs. -comparison_editor_server <- function(id, preset) { +#' Create a server for the comparison editor. +#' +#' @param id ID for namespacing the inputs and outputs. +#' @param preset A reactive containing the current preset. +#' @param options Global application options +#' +#' @return A reactive containing the comparison gene IDs. +#' +#' @noRd +comparison_editor_server <- function(id, preset, options) { moduleServer(id, function(input, output, session) { custom_gene_ids <- gene_selector_server("custom_genes") reactive({ - if (input$comparison_genes == "none") { + if (input$comparison_genes == "None") { NULL - } else if (input$comparison_genes == "random") { + } else if (input$comparison_genes == "Random genes") { preset <- preset() gene_pool <- preset$gene_ids reference_gene_ids <- preset$reference_gene_ids gene_pool <- gene_pool[!gene_pool %chin% reference_gene_ids] gene_pool[sample(length(gene_pool), length(reference_gene_ids))] - } else if (input$comparison_genes == "tpeold") { - genes[verified | suggested == TRUE, id] - } else if (input$comparison_genes == "verified") { - genes[verified == TRUE, id] - } else if (input$comparison_genes == "suggested") { - genes[suggested == TRUE, id] - } else { + } else if (input$comparison_genes == "Customize") { custom_gene_ids() + } else { + options$gene_sets[[input$comparison_genes]] } }) }) diff --git a/R/data.R b/R/data.R index bdb403d..2305228 100644 --- a/R/data.R +++ b/R/data.R @@ -1,65 +1,3 @@ -# Species IDs of known replicatively aging species. -species_ids_replicative <- c( - "bihybrid", - "btaurus", - "bthybrid", - "cfamiliaris", - "chircus", - "cjacchus", - "clfamiliaris", - "csabaeus", - "ecaballus", - "fcatus", - "ggorilla", - "hsapiens", - "lafricana", - "mfascicularis", - "mmulatta", - "mmurinus", - "mnemestrina", - "nleucogenys", - "oaries", - "pabelii", - "panubis", - "ppaniscus", - "ptroglodytes", - "sscrofa", - "tgelada" -) - -# Gene names of genes for verified TPE-OLD genes. -genes_verified_tpe_old <- c( - "C1S", - "DSP", - "ISG15", - "SORBS2", - "TERT" -) - -# Gene names of genes with a suggested TPE-OLD. -genes_suggested_tpe_old <- c( - "AKAP3", - "ANO2", - "CCND2", - "CD163L1", - "CD9", - "FOXM1", - "GALNT8", - "NDUFA9", - "TEAD4", - "TIGAR", - "TSPAN9" -) - -# Genes from [geposan] and their TPE-OLD status. -genes <- geposan::genes[, .( - id, - name, - chromosome, - suggested = name %chin% genes_suggested_tpe_old, - verified = name %chin% genes_verified_tpe_old -)] - # All available methods from [geposan] and additional information on them. methods <- geposan::all_methods() diff --git a/R/gene_selector.R b/R/gene_selector.R index 1e8e615..8ea8715 100644 --- a/R/gene_selector.R +++ b/R/gene_selector.R @@ -7,7 +7,7 @@ #' #' @noRd gene_selector_ui <- function(id, default_gene_ids = NULL) { - named_genes <- genes[name != ""] + named_genes <- geposan::genes[name != ""] named_genes <- unique(named_genes, by = "name") gene_choices <- named_genes$id names(gene_choices) <- named_genes$name @@ -42,7 +42,10 @@ gene_selector_ui <- function(id, default_gene_ids = NULL) { NS(id, "hgnc_names_raw"), "Enter HGNC symbols", value = paste( - genes[id %chin% default_gene_ids & name != "", name], + geposan::genes[ + id %chin% default_gene_ids & name != "", + name + ], collapse = "\n" ), height = "250px" diff --git a/R/input_page.R b/R/input_page.R index 0563290..c466c67 100644 --- a/R/input_page.R +++ b/R/input_page.R @@ -1,10 +1,13 @@ #' Create the UI for the input page. +#' +#' @param options Global options for the application. +#' #' @noRd -input_page_ui <- function(id) { +input_page_ui <- function(id, options) { sidebarLayout( sidebarPanel( width = 3, - preset_editor_ui(NS(id, "preset_editor")), + preset_editor_ui(NS(id, "preset_editor"), options), tabsetPanel( id = NS(id, "apply_panel"), type = "hidden", @@ -19,7 +22,7 @@ input_page_ui <- function(id) { ) ) ), - comparison_editor_ui(NS(id, "comparison_editor")) + comparison_editor_ui(NS(id, "comparison_editor"), options) ), mainPanel( width = 9, @@ -35,21 +38,21 @@ input_page_ui <- function(id) { #' Application logic for the input page. #' #' @param id ID for namespacing the inputs and outputs. +#' @param options Global options for the application. +#' #' @return A list containing two reactives: the `preset` for the analysis and #' the `comparison_gene_ids`. #' #' @noRd -input_page_server <- function(id) { +input_page_server <- function(id, options) { moduleServer(id, function(input, output, session) { - current_preset <- reactiveVal( - geposan::preset(genes[verified | suggested == TRUE, id]) - ) - - potential_preset <- preset_editor_server("preset_editor") + current_preset <- reactiveVal(geposan::preset(options$gene_sets[[1]])) + potential_preset <- preset_editor_server("preset_editor", options) comparison_gene_ids <- comparison_editor_server( "comparison_editor", - current_preset + current_preset, + options ) output$positions_plot <- plotly::renderPlotly({ diff --git a/R/preset_editor.R b/R/preset_editor.R index 524386c..16c85b7 100644 --- a/R/preset_editor.R +++ b/R/preset_editor.R @@ -1,88 +1,110 @@ #' Create the UI for a preset editor. #' #' @param id ID for namespacing. +#' @param options Global options for the application. +#' #' @return The UI elements. #' #' @noRd -preset_editor_ui <- function(id) { +preset_editor_ui <- function(id, options) { + species_choices <- c("All species", names(options$species_sets)) + gene_choices <- names(options$gene_sets) + + if (!options$locked) { + species_choices <- c(species_choices, "Customize") + gene_choices <- c(gene_choices, "Customize") + } + verticalLayout( h3("Inputs"), selectInput( NS(id, "species"), "Species to include", - choices = list( - "All species" = "all", - "Known replicatively aging species" = "replicative", - "Customize" = "custom" + choices = species_choices + ), + if (!options$locked) { + conditionalPanel( + condition = sprintf( + "input['%s'] == 'Customize'", + NS(id, "species") + ), + selectizeInput( + inputId = NS(id, "custom_species"), + label = "Select input species", + choices = NULL, + multiple = TRUE + ), ) - ), - conditionalPanel( - condition = sprintf("input['%s'] == 'custom'", NS(id, "species")), - selectizeInput( - inputId = NS(id, "custom_species"), - label = "Select input species", - choices = NULL, - multiple = TRUE - ), - ), + }, selectInput( NS(id, "reference_genes"), "Reference genes", - choices = list( - "Verified or suggested TPE-OLD genes" = "tpeold", - "Only verified TPE-OLD genes" = "verified", - "Customize" = "custom" - ) + choices = gene_choices ), - conditionalPanel( - condition = sprintf( - "input['%s'] == 'custom'", - NS(id, "reference_genes") - ), - gene_selector_ui( - NS(id, "custom_genes"), - genes[suggested | verified == TRUE, id] + if (!options$locked) { + conditionalPanel( + condition = sprintf( + "input['%s'] == 'Customize'", + NS(id, "reference_genes") + ), + gene_selector_ui(NS(id, "custom_genes")) ) - ) + }, + if (options$locked) { + HTML( + "This instance prohibits performing custom analyses ", + "to reduce resource usage. Normally, it is possible ", + "to use this web application for analyzing any set of ", + "reference genes to find patterns in their ", + "chromosomal positions. If you would like to apply ", + "this method for your own research, see ", + "this page for more information." + ) + } ) } #' Application logic for the preset editor. #' #' @param id ID for namespacing the inputs and outputs. +#' @param options Global application options. +#' #' @return A reactive containing the preset or `NULL`, if the input data doesn't #' result in a valid one. #' #' @noRd -preset_editor_server <- function(id) { +preset_editor_server <- function(id, options) { moduleServer(id, function(input, output, session) { - species_choices <- geposan::species$id - names(species_choices) <- geposan::species$name + custom_gene_ids <- if (!options$locked) { + species_choices <- geposan::species$id + names(species_choices) <- geposan::species$name - updateSelectizeInput( - session, - "custom_species", - choices = species_choices, - server = TRUE - ) + updateSelectizeInput( + session, + "custom_species", + choices = species_choices, + server = TRUE + ) - custom_gene_ids <- gene_selector_server("custom_genes") + gene_selector_server("custom_genes") + } else { + NULL + } reactive({ - reference_gene_ids <- if (input$reference_genes == "tpeold") { - genes[verified | suggested == TRUE, id] - } else if (input$reference_genes == "verified") { - genes[verified == TRUE, id] - } else { + reference_gene_ids <- if (input$reference_genes == "Customize") { custom_gene_ids() + } else { + options$gene_sets[[input$reference_genes]] } - species_ids <- if (input$species == "replicative") { - species_ids_replicative - } else if (input$species == "all") { + species_ids <- if (input$species == "All species") { geposan::species$id - } else { + } else if (input$species == "Customize") { input$custom_species + } else { + options$species_sets[[input$species]] } tryCatch( diff --git a/R/server.R b/R/server.R index 4107e0a..44532c4 100644 --- a/R/server.R +++ b/R/server.R @@ -7,225 +7,237 @@ js_link <- DT::JS("function(row, data) { $('td:eq(1)', row).html(`${name}`); }") -server <- function(input, output, session) { - input_reactives <- input_page_server("input_page") - preset <- input_reactives$preset - comparison_gene_ids <- input_reactives$comparison_gene_ids +#' Create a server function for the application. +#' +#' @param options Global application options. +#' @noRd +server <- function(options) { + function(input, output, session) { + input_reactives <- input_page_server("input_page", options) + preset <- input_reactives$preset + comparison_gene_ids <- input_reactives$comparison_gene_ids - observe({ - updateNavbarPage( - session, - "main_page", - selected = "Results" - ) - }) |> bindEvent(preset(), ignoreInit = TRUE) - - # Compute the results according to the preset. - analysis <- reactive({ - withProgress( - message = "Analyzing genes", - value = 0.0, - { # nolint - geposan::analyze( - preset(), - progress = function(progress) { - setProgress(progress) - }, - include_results = FALSE - ) - } - ) - }) |> bindCache(preset()) - - # Rank the results. - ranking <- methods_server("methods", analysis, comparison_gene_ids) - - # 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) - - # Server for the detailed results panel. - results_server("results", results_filtered) - - output$rank_plot <- plotly::renderPlotly({ - preset <- preset() - gene_sets <- list("Reference genes" = preset$reference_gene_ids) - comparison_gene_ids <- comparison_gene_ids() - - if (length(comparison_gene_ids) >= 1) { - gene_sets <- c( - gene_sets, - list("Comparison genes" = comparison_gene_ids) + observe({ + updateNavbarPage( + session, + "main_page", + selected = "Results" ) - } + }) |> bindEvent(preset(), ignoreInit = TRUE) - geposan::plot_scores( - ranking(), - gene_sets = gene_sets, - max_rank = results_filtered()[, max(rank)] - ) - }) - - output$rankings_plot <- plotly::renderPlotly({ - preset <- preset() - - rankings <- list() - methods <- preset$methods - all <- ranking() - - for (method in methods) { - weights <- list() - weights[[method$id]] <- 1.0 - rankings[[method$name]] <- geposan::ranking(all, weights) - } - - rankings[["Combined"]] <- all - - gene_sets <- list("Reference genes" = preset$reference_gene_ids) - comparison_gene_ids <- comparison_gene_ids() - - if (length(comparison_gene_ids) >= 1) { - gene_sets <- c( - gene_sets, - list("Comparison genes" = comparison_gene_ids) - ) - } - - geposan::plot_rankings(rankings, gene_sets) - }) - - output$boxplot <- plotly::renderPlotly({ - preset <- preset() - gene_sets <- list("Reference genes" = preset$reference_gene_ids) - comparison_gene_ids <- comparison_gene_ids() - - if (length(comparison_gene_ids) >= 1) { - gene_sets <- c( - gene_sets, - list("Comparison genes" = comparison_gene_ids) - ) - } - - geposan::plot_boxplot(ranking(), gene_sets) - }) - - output$positions_plot <- plotly::renderPlotly({ - preset <- preset() - gene_sets <- list("Reference genes" = preset$reference_gene_ids) - comparison_gene_ids <- comparison_gene_ids() - - if (length(comparison_gene_ids) >= 1) { - gene_sets <- c( - gene_sets, - list("Comparison genes" = comparison_gene_ids) - ) - } - - geposan::plot_scores_by_position( - ranking(), - input$positions_plot_chromosome_name, - gene_sets = gene_sets - ) - }) - - gost <- reactive({ - withProgress( - message = "Querying g:Profiler", - value = 0.0, - { # nolint - setProgress(0.2) - gprofiler2::gost(results_filtered()[, gene]) - } - ) - }) - - output$gost_plot <- plotly::renderPlotly({ - gprofiler2::gostplot( - gost(), - capped = FALSE, - interactive = TRUE - ) - }) - - output$gost_details <- DT::renderDT({ - data <- data.table(gost()$result) - setorder(data, p_value) - - data[, total_ratio := term_size / effective_domain_size] - data[, query_ratio := intersection_size / query_size] - - data <- data[, .(source, term_name, total_ratio, query_ratio, p_value)] - - dt <- DT::datatable( - data, - rownames = FALSE, - colnames = c( - "Source", - "Term", - "Total ratio", - "Query ratio", - "p-value" - ), - style = "bootstrap", - options = list( - pageLength = 25 - ) - ) - - dt <- DT::formatRound(dt, "p_value", digits = 4) - dt <- DT::formatPercentage( - dt, - c("total_ratio", "query_ratio"), - digits = 1 - ) - }) - - output$disgenet <- DT::renderDT({ - withProgress( - message = "Querying DisGeNET", - value = 0.0, - { # nolint - setProgress(0.2) - - gene_names <- results_filtered()[, name] - gene_names <- unique(gene_names[gene_names != ""]) - - diseases <- disgenet2r::disease_enrichment(gene_names) - - data <- data.table(diseases@qresult) - - data <- data[, .(Description, Ratio, BgRatio, pvalue)] - setorder(data, pvalue) - - dt <- DT::datatable( - data, - rownames = FALSE, - colnames = c( - "Disease", - "Query ratio", - "Total ratio", - "p-value" - ), - style = "bootstrap", - options = list( - pageLength = 25 + # Compute the results according to the preset. + analysis <- reactive({ + withProgress( + message = "Analyzing genes", + value = 0.0, + { # nolint + geposan::analyze( + preset(), + progress = function(progress) { + setProgress(progress) + }, + include_results = FALSE ) + } + ) + }) |> bindCache(preset()) + + # Rank the results. + ranking <- methods_server("methods", analysis, comparison_gene_ids) + + # 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) + + # Server for the detailed results panel. + results_server("results", results_filtered) + + output$rank_plot <- plotly::renderPlotly({ + preset <- preset() + gene_sets <- list("Reference genes" = preset$reference_gene_ids) + comparison_gene_ids <- comparison_gene_ids() + + if (length(comparison_gene_ids) >= 1) { + gene_sets <- c( + gene_sets, + list("Comparison genes" = comparison_gene_ids) ) - - dt <- DT::formatRound(dt, "pvalue", digits = 4) - - dt } - ) - }) + + geposan::plot_scores( + ranking(), + gene_sets = gene_sets, + max_rank = results_filtered()[, max(rank)] + ) + }) + + output$rankings_plot <- plotly::renderPlotly({ + preset <- preset() + + rankings <- list() + methods <- preset$methods + all <- ranking() + + for (method in methods) { + weights <- list() + weights[[method$id]] <- 1.0 + rankings[[method$name]] <- geposan::ranking(all, weights) + } + + rankings[["Combined"]] <- all + + gene_sets <- list("Reference genes" = preset$reference_gene_ids) + comparison_gene_ids <- comparison_gene_ids() + + if (length(comparison_gene_ids) >= 1) { + gene_sets <- c( + gene_sets, + list("Comparison genes" = comparison_gene_ids) + ) + } + + geposan::plot_rankings(rankings, gene_sets) + }) + + output$boxplot <- plotly::renderPlotly({ + preset <- preset() + gene_sets <- list("Reference genes" = preset$reference_gene_ids) + comparison_gene_ids <- comparison_gene_ids() + + if (length(comparison_gene_ids) >= 1) { + gene_sets <- c( + gene_sets, + list("Comparison genes" = comparison_gene_ids) + ) + } + + geposan::plot_boxplot(ranking(), gene_sets) + }) + + output$positions_plot <- plotly::renderPlotly({ + preset <- preset() + gene_sets <- list("Reference genes" = preset$reference_gene_ids) + comparison_gene_ids <- comparison_gene_ids() + + if (length(comparison_gene_ids) >= 1) { + gene_sets <- c( + gene_sets, + list("Comparison genes" = comparison_gene_ids) + ) + } + + geposan::plot_scores_by_position( + ranking(), + input$positions_plot_chromosome_name, + gene_sets = gene_sets + ) + }) + + gost <- reactive({ + withProgress( + message = "Querying g:Profiler", + value = 0.0, + { # nolint + setProgress(0.2) + gprofiler2::gost(results_filtered()[, gene]) + } + ) + }) + + output$gost_plot <- plotly::renderPlotly({ + gprofiler2::gostplot( + gost(), + capped = FALSE, + interactive = TRUE + ) + }) + + output$gost_details <- DT::renderDT({ + data <- data.table(gost()$result) + setorder(data, p_value) + + data[, total_ratio := term_size / effective_domain_size] + data[, query_ratio := intersection_size / query_size] + + data <- data[, .( + source, + term_name, + total_ratio, + query_ratio, + p_value + )] + + dt <- DT::datatable( + data, + rownames = FALSE, + colnames = c( + "Source", + "Term", + "Total ratio", + "Query ratio", + "p-value" + ), + style = "bootstrap", + options = list( + pageLength = 25 + ) + ) + + dt <- DT::formatRound(dt, "p_value", digits = 4) + dt <- DT::formatPercentage( + dt, + c("total_ratio", "query_ratio"), + digits = 1 + ) + }) + + output$disgenet <- DT::renderDT({ + withProgress( + message = "Querying DisGeNET", + value = 0.0, + { # nolint + setProgress(0.2) + + gene_names <- results_filtered()[, name] + gene_names <- unique(gene_names[gene_names != ""]) + + diseases <- disgenet2r::disease_enrichment(gene_names) + + data <- data.table(diseases@qresult) + + data <- data[, .(Description, Ratio, BgRatio, pvalue)] + setorder(data, pvalue) + + dt <- DT::datatable( + data, + rownames = FALSE, + colnames = c( + "Disease", + "Query ratio", + "Total ratio", + "p-value" + ), + style = "bootstrap", + options = list( + pageLength = 25 + ) + ) + + dt <- DT::formatRound(dt, "pvalue", digits = 4) + + dt + } + ) + }) + } } diff --git a/R/ui.R b/R/ui.R index bdaabab..f649d2b 100644 --- a/R/ui.R +++ b/R/ui.R @@ -1,6 +1,9 @@ #' Generate the main UI for the application. +#' +#' @param options Global options for the application. +#' #' @noRd -ui <- function() { +ui <- function(options) { div( shinyjs::useShinyjs(), rclipboard::rclipboardSetup(), @@ -15,7 +18,7 @@ ui <- function() { selected = "Results", tabPanel( "Input data", - input_page_ui("input_page") + input_page_ui("input_page", options) ), tabPanel( "Results", diff --git a/man/run_app.Rd b/man/run_app.Rd index c408207..231e0fd 100644 --- a/man/run_app.Rd +++ b/man/run_app.Rd @@ -4,9 +4,24 @@ \alias{run_app} \title{Run the application server.} \usage{ -run_app(port = 3464) +run_app(gene_sets, species_sets = NULL, locked = FALSE, port = 3464) } \arguments{ +\item{gene_sets}{A list of predefined gene sets. This should be a named list +containing vectors of gene IDs for each set. The names will be used to +present the gene set throughout the user interface. You have to provide \emph{at +least one gene set} which will be selected as the initial reference gene +set.} + +\item{species_sets}{A list of predefined species sets. This should be a named +list containing vectors of species IDs for each set. The names will be used +to present the species set throughout the user interface.} + +\item{locked}{Whether the application should be locked and prohibit +performing custom analyses. If this is set to \code{TRUE}, only the predefined +gene and species sets are available for customizing the analysis. This may +be useful to limit resource usage on a publicly available instance.} + \item{port}{The port to serve the application on.} } \description{