From 13b5efc1e30b99943d460400b61fbc4278a95ea2 Mon Sep 17 00:00:00 2001 From: Elias Projahn Date: Thu, 26 May 2022 12:44:09 +0200 Subject: [PATCH] Reindent code to use just two spaces --- R/app.R | 32 +-- R/comparison_editor.R | 72 +++--- R/filters.R | 168 ++++++------- R/gene_selector.R | 158 ++++++------ R/input_page.R | 156 ++++++------ R/methods.R | 246 +++++++++---------- R/preset_editor.R | 178 +++++++------- R/results.R | 193 +++++++-------- R/server.R | 556 +++++++++++++++++++++--------------------- R/ui.R | 240 +++++++++--------- 10 files changed, 1000 insertions(+), 999 deletions(-) diff --git a/R/app.R b/R/app.R index 72a2e1f..d05b6ad 100644 --- a/R/app.R +++ b/R/app.R @@ -21,23 +21,23 @@ run_app <- function(gene_sets, locked = FALSE, title = "Gene Position Analysis", port = 3464) { - stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]])) + stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]])) - # These function calls make the required java scripts available. - shinyjs::useShinyjs() - rclipboard::rclipboardSetup() + # These function calls make the required java scripts available. + shinyjs::useShinyjs() + rclipboard::rclipboardSetup() - # Bundle of global options to redue broilerplate. - options <- list( - gene_sets = gene_sets, - species_sets = species_sets, - locked = locked, - title = title - ) + # Bundle of global options to redue broilerplate. + options <- list( + gene_sets = gene_sets, + species_sets = species_sets, + locked = locked, + title = title + ) - # Actually run the app. - shiny::runApp( - shiny::shinyApp(ui(options), server(options)), - 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 3259cb2..8f12d95 100644 --- a/R/comparison_editor.R +++ b/R/comparison_editor.R @@ -3,26 +3,26 @@ #' @param options Global application options #' @noRd comparison_editor_ui <- function(id, options) { - verticalLayout( - h3("Comparison"), - selectInput( - NS(id, "comparison_genes"), - "Comparison genes", - choices = c( - "None", - "Random genes", - names(options$gene_sets), - "Customize" - ) - ), - conditionalPanel( - condition = sprintf( - "input['%s'] == 'Customize'", - NS(id, "comparison_genes") - ), - gene_selector_ui(NS(id, "custom_genes")) - ) + verticalLayout( + h3("Comparison"), + selectInput( + NS(id, "comparison_genes"), + "Comparison genes", + choices = c( + "None", + "Random genes", + names(options$gene_sets), + "Customize" + ) + ), + conditionalPanel( + condition = sprintf( + "input['%s'] == 'Customize'", + NS(id, "comparison_genes") + ), + gene_selector_ui(NS(id, "custom_genes")) ) + ) } #' Create a server for the comparison editor. @@ -35,23 +35,23 @@ comparison_editor_ui <- function(id, options) { #' #' @noRd comparison_editor_server <- function(id, preset, options) { - moduleServer(id, function(input, output, session) { - custom_gene_ids <- gene_selector_server("custom_genes") + moduleServer(id, function(input, output, session) { + custom_gene_ids <- gene_selector_server("custom_genes") - reactive({ - if (input$comparison_genes == "None") { - NULL - } 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 == "Customize") { - custom_gene_ids() - } else { - options$gene_sets[[input$comparison_genes]] - } - }) + reactive({ + if (input$comparison_genes == "None") { + NULL + } 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 == "Customize") { + custom_gene_ids() + } else { + options$gene_sets[[input$comparison_genes]] + } }) + }) } diff --git a/R/filters.R b/R/filters.R index f3d2cf7..8f408fe 100644 --- a/R/filters.R +++ b/R/filters.R @@ -1,68 +1,68 @@ # Construct UI for the filter editor. filters_ui <- function(id) { - verticalLayout( - h3("Filter criteria"), - selectInput( - NS(id, "method"), - "Filter method", - choices = list( - "Percentile" = "percentile", - "Cut-off score" = "score", - "Maximum number of genes" = "rank", - "None" = "none" - ) - ), - tabsetPanel( - id = NS(id, "sliders"), - type = "hidden", - tabPanelBody( - value = "percentile", - sliderInput( - NS(id, "percentile"), - label = "Minimum percentile", - post = "%", - min = 0, - max = 100, - step = 1, - value = 95 - ) - ), - tabPanelBody( - value = "score", - sliderInput( - NS(id, "score"), - label = "Cut-off score", - post = "%", - min = 0, - max = 100, - step = 1, - value = 75 - ) - ), - tabPanelBody( - value = "rank", - sliderInput( - NS(id, "rank"), - label = "Maximum rank", - min = 0, - max = 2000, - step = 10, - value = 1000 - ) - ), - tabPanelBody( - value = "none" - ) - ), + verticalLayout( + h3("Filter criteria"), + selectInput( + NS(id, "method"), + "Filter method", + choices = list( + "Percentile" = "percentile", + "Cut-off score" = "score", + "Maximum number of genes" = "rank", + "None" = "none" + ) + ), + tabsetPanel( + id = NS(id, "sliders"), + type = "hidden", + tabPanelBody( + value = "percentile", sliderInput( - NS(id, "distance"), - label = "Distance to telomeres", - post = " Mbp", - min = 0, - max = 150, - value = c(0, 150) + NS(id, "percentile"), + label = "Minimum percentile", + post = "%", + min = 0, + max = 100, + step = 1, + value = 95 ) + ), + tabPanelBody( + value = "score", + sliderInput( + NS(id, "score"), + label = "Cut-off score", + post = "%", + min = 0, + max = 100, + step = 1, + value = 75 + ) + ), + tabPanelBody( + value = "rank", + sliderInput( + NS(id, "rank"), + label = "Maximum rank", + min = 0, + max = 2000, + step = 10, + value = 1000 + ) + ), + tabPanelBody( + value = "none" + ) + ), + sliderInput( + NS(id, "distance"), + label = "Distance to telomeres", + post = " Mbp", + min = 0, + max = 150, + value = c(0, 150) ) + ) } # Construct server for the filter editor. @@ -71,29 +71,29 @@ filters_ui <- function(id) { # # @return A reactive containing the filtered results. filters_server <- function(id, results) { - moduleServer(id, function(input, output, session) { - observeEvent(input$method, { - updateTabsetPanel(session, "sliders", selected = input$method) - }) - - reactive({ - results <- results() - - results_prefiltered <- if (input$method == "percentile") { - n_ranks <- nrow(results) - results[rank <= (1 - (input$percentile / 100)) * n_ranks] - } else if (input$method == "score") { - results[score >= input$score / 100] - } else if (input$method == "rank") { - results[rank <= input$rank] - } else { - results - } - - results_prefiltered[ - distance >= 1000000 * input$distance[1] & - distance <= 1000000 * input$distance[2] - ] - }) + moduleServer(id, function(input, output, session) { + observeEvent(input$method, { + updateTabsetPanel(session, "sliders", selected = input$method) }) + + reactive({ + results <- results() + + results_prefiltered <- if (input$method == "percentile") { + n_ranks <- nrow(results) + results[rank <= (1 - (input$percentile / 100)) * n_ranks] + } else if (input$method == "score") { + results[score >= input$score / 100] + } else if (input$method == "rank") { + results[rank <= input$rank] + } else { + results + } + + results_prefiltered[ + distance >= 1000000 * input$distance[1] & + distance <= 1000000 * input$distance[2] + ] + }) + }) } diff --git a/R/gene_selector.R b/R/gene_selector.R index 8ea8715..e23694e 100644 --- a/R/gene_selector.R +++ b/R/gene_selector.R @@ -7,61 +7,61 @@ #' #' @noRd gene_selector_ui <- function(id, default_gene_ids = NULL) { - named_genes <- geposan::genes[name != ""] - named_genes <- unique(named_genes, by = "name") - gene_choices <- named_genes$id - names(gene_choices) <- named_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 - verticalLayout( - selectInput( - NS(id, "identifier_type"), - "Gene identifiers", - choices = list( - "Select from list" = "list", - "HGNC symbols" = "hgnc", - "Ensembl gene IDs" = "ensembl" - ) + verticalLayout( + selectInput( + NS(id, "identifier_type"), + "Gene identifiers", + choices = list( + "Select from list" = "list", + "HGNC symbols" = "hgnc", + "Ensembl gene IDs" = "ensembl" + ) + ), + tabsetPanel( + id = NS(id, "custom_input"), + type = "hidden", + tabPanelBody( + "list", + shinyvs::virtualSelectInput( + NS(id, "selected_genes"), + label = "Select genes", + choices = gene_choices, + multiple = TRUE, + search = TRUE, + selectAllOnlyVisible = TRUE ), - tabsetPanel( - id = NS(id, "custom_input"), - type = "hidden", - tabPanelBody( - "list", - shinyvs::virtualSelectInput( - NS(id, "selected_genes"), - label = "Select genes", - choices = gene_choices, - multiple = TRUE, - search = TRUE, - selectAllOnlyVisible = TRUE - ), - ), - tabPanelBody( - "hgnc", - textAreaInput( - NS(id, "hgnc_names_raw"), - "Enter HGNC symbols", - value = paste( - geposan::genes[ - id %chin% default_gene_ids & name != "", - name - ], - collapse = "\n" - ), - height = "250px" - ) - ), - tabPanelBody( - "ensembl", - textAreaInput( - NS(id, "gene_ids_raw"), - "Enter Ensembl gene IDs", - value = paste(default_gene_ids, collapse = "\n"), - height = "250px" - ) - ) + ), + tabPanelBody( + "hgnc", + textAreaInput( + NS(id, "hgnc_names_raw"), + "Enter HGNC symbols", + value = paste( + geposan::genes[ + id %chin% default_gene_ids & name != "", + name + ], + collapse = "\n" + ), + height = "250px" ) + ), + tabPanelBody( + "ensembl", + textAreaInput( + NS(id, "gene_ids_raw"), + "Enter Ensembl gene IDs", + value = paste(default_gene_ids, collapse = "\n"), + height = "250px" + ) + ) ) + ) } #' Application logic for the gene selector. @@ -72,33 +72,33 @@ gene_selector_ui <- function(id, default_gene_ids = NULL) { #' #' @noRd gene_selector_server <- function(id) { - moduleServer(id, function(input, output, session) { - observe({ - updateTabsetPanel( - session, - "custom_input", - selected = input$identifier_type - ) - }) - - reactive({ - gene_ids <- if (input$identifier_type == "list") { - input$selected_genes - } else if (input$identifier_type == "hgnc") { - inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]]) - inputs <- inputs[inputs != ""] - geposan::genes[name %chin% inputs, id] - } else { - inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]]) - inputs <- inputs[inputs != ""] - geposan::genes[id %chin% inputs, id] - } - - if (length(gene_ids > 100)) { - gene_ids[seq_len(100)] - } else { - gene_ids - } - }) + moduleServer(id, function(input, output, session) { + observe({ + updateTabsetPanel( + session, + "custom_input", + selected = input$identifier_type + ) }) + + reactive({ + gene_ids <- if (input$identifier_type == "list") { + input$selected_genes + } else if (input$identifier_type == "hgnc") { + inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]]) + inputs <- inputs[inputs != ""] + geposan::genes[name %chin% inputs, id] + } else { + inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]]) + inputs <- inputs[inputs != ""] + geposan::genes[id %chin% inputs, id] + } + + if (length(gene_ids > 100)) { + gene_ids[seq_len(100)] + } else { + gene_ids + } + }) + }) } diff --git a/R/input_page.R b/R/input_page.R index c466c67..3e093d6 100644 --- a/R/input_page.R +++ b/R/input_page.R @@ -4,35 +4,35 @@ #' #' @noRd input_page_ui <- function(id, options) { - sidebarLayout( - sidebarPanel( - width = 3, - preset_editor_ui(NS(id, "preset_editor"), options), - tabsetPanel( - id = NS(id, "apply_panel"), - type = "hidden", - tabPanelBody(value = "hide"), - tabPanelBody( - value = "show", - actionButton( - NS(id, "apply_button"), - "Perform analysis", - class = "btn-primary", - style = "margin-top: 16px; margin-bottom: 16px" - ) - ) - ), - comparison_editor_ui(NS(id, "comparison_editor"), options) - ), - mainPanel( - width = 9, - plotly::plotlyOutput( - NS(id, "positions_plot"), - width = "100%", - height = "600px" - ) + sidebarLayout( + sidebarPanel( + width = 3, + preset_editor_ui(NS(id, "preset_editor"), options), + tabsetPanel( + id = NS(id, "apply_panel"), + type = "hidden", + tabPanelBody(value = "hide"), + tabPanelBody( + value = "show", + actionButton( + NS(id, "apply_button"), + "Perform analysis", + class = "btn-primary", + style = "margin-top: 16px; margin-bottom: 16px" + ) ) + ), + comparison_editor_ui(NS(id, "comparison_editor"), options) + ), + mainPanel( + width = 9, + plotly::plotlyOutput( + NS(id, "positions_plot"), + width = "100%", + height = "600px" + ) ) + ) } #' Application logic for the input page. @@ -45,61 +45,61 @@ input_page_ui <- function(id, options) { #' #' @noRd input_page_server <- function(id, options) { - moduleServer(id, function(input, output, session) { - current_preset <- reactiveVal(geposan::preset(options$gene_sets[[1]])) - potential_preset <- preset_editor_server("preset_editor", options) + moduleServer(id, function(input, output, session) { + 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, - options - ) + comparison_gene_ids <- comparison_editor_server( + "comparison_editor", + current_preset, + options + ) - output$positions_plot <- plotly::renderPlotly({ - preset <- potential_preset() + output$positions_plot <- plotly::renderPlotly({ + preset <- potential_preset() - if (is.null(preset)) { - NULL - } else { - gene_sets <- list("Reference genes" = preset$reference_gene_ids) - comparison_gene_ids <- comparison_gene_ids() + if (is.null(preset)) { + NULL + } else { + 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) - ) - } + if (length(comparison_gene_ids) >= 1) { + gene_sets <- c( + gene_sets, + list("Comparison genes" = comparison_gene_ids) + ) + } - geposan::plot_positions(preset$species_ids, gene_sets) - } - }) - - observe({ - if (is.null(potential_preset()) | - rlang::hash(potential_preset()) == - rlang::hash(current_preset())) { - updateTabsetPanel( - session, - "apply_panel", - selected = "hide" - ) - } else { - updateTabsetPanel( - session, - "apply_panel", - selected = "show" - ) - } - }) - - observe({ - current_preset(potential_preset()) - }) |> bindEvent(input$apply_button) - - list( - preset = current_preset, - comparison_gene_ids = comparison_gene_ids - ) + geposan::plot_positions(preset$species_ids, gene_sets) + } }) + + observe({ + if (is.null(potential_preset()) | + rlang::hash(potential_preset()) == + rlang::hash(current_preset())) { + updateTabsetPanel( + session, + "apply_panel", + selected = "hide" + ) + } else { + updateTabsetPanel( + session, + "apply_panel", + selected = "show" + ) + } + }) + + observe({ + current_preset(potential_preset()) + }) |> bindEvent(input$apply_button) + + list( + preset = current_preset, + comparison_gene_ids = comparison_gene_ids + ) + }) } diff --git a/R/methods.R b/R/methods.R index 7c589f7..20d2783 100644 --- a/R/methods.R +++ b/R/methods.R @@ -1,47 +1,47 @@ # Construct UI for the methods editor. methods_ui <- function(id) { - verticalLayout( - h3("Methods"), - selectInput( - NS(id, "optimization_genes"), - "Genes to optimize for", - choices = list( - "Reference genes" = "reference", - "Comparison genes" = "comparison" - ) + verticalLayout( + h3("Methods"), + selectInput( + NS(id, "optimization_genes"), + "Genes to optimize for", + choices = list( + "Reference genes" = "reference", + "Comparison genes" = "comparison" + ) + ), + selectInput( + NS(id, "optimization_target"), + "Optimization target", + choices = list( + "Mean rank" = "mean", + "Median rank" = "median", + "First rank" = "min", + "Last rank" = "max", + "Customize weights" = "custom" + ) + ), + lapply(methods, function(method) { + verticalLayout( + checkboxInput( + NS(id, method$id), + span( + method$description, + class = "control-label" + ), + value = TRUE ), - selectInput( - NS(id, "optimization_target"), - "Optimization target", - choices = list( - "Mean rank" = "mean", - "Median rank" = "median", - "First rank" = "min", - "Last rank" = "max", - "Customize weights" = "custom" - ) - ), - lapply(methods, function(method) { - verticalLayout( - checkboxInput( - NS(id, method$id), - span( - method$description, - class = "control-label" - ), - value = TRUE - ), - sliderInput( - NS(id, sprintf("%s_weight", method$id)), - NULL, - min = -1.0, - max = 1.0, - step = 0.01, - value = 1.0 - ) - ) - }) - ) + sliderInput( + NS(id, sprintf("%s_weight", method$id)), + NULL, + min = -1.0, + max = 1.0, + step = 0.01, + value = 1.0 + ) + ) + }) + ) } # Construct server for the methods editor. @@ -50,89 +50,89 @@ methods_ui <- function(id) { # # @return A reactive containing the weighted results. methods_server <- function(id, analysis, comparison_gene_ids) { - moduleServer(id, function(input, output, session) { - # Observe each method's enable button and synchronise the slider state. - lapply(methods, function(method) { - observeEvent(input[[method$id]], { - shinyjs::toggleState( - sprintf("%s_weight", method$id), - condition = input[[method$id]] - ) - }) - - shinyjs::onclick(sprintf("%s_weight", method$id), { - updateSelectInput( - session, - "optimization_target", - selected = "custom" - ) - }) - }) - - # This reactive will always contain the currently selected optimization - # gene IDs in a normalized form. - optimization_gene_ids <- reactive({ - gene_ids <- if (input$optimization_genes == "comparison") { - comparison_gene_ids() - } else { - analysis()$preset$reference_gene_ids - } - - sort(unique(gene_ids)) - }) - - # This reactive will always contain the optimal weights according to - # the selected parameters. - optimal_weights <- reactive({ - withProgress(message = "Optimizing weights", { - setProgress(0.2) - - included_methods <- NULL - - for (method in methods) { - if (input[[method$id]]) { - included_methods <- c(included_methods, method$id) - } - } - - geposan::optimal_weights( - analysis(), - included_methods, - optimization_gene_ids(), - target = input$optimization_target - ) - }) - }) |> bindCache( - analysis(), - optimization_gene_ids(), - sapply(methods, function(method) input[[method$id]]), - input$optimization_target + moduleServer(id, function(input, output, session) { + # Observe each method's enable button and synchronise the slider state. + lapply(methods, function(method) { + observeEvent(input[[method$id]], { + shinyjs::toggleState( + sprintf("%s_weight", method$id), + condition = input[[method$id]] ) + }) - reactive({ - weights <- NULL - - if (length(optimization_gene_ids()) < 1 | - input$optimization_target == "custom") { - for (method in methods) { - if (input[[method$id]]) { - weight <- input[[sprintf("%s_weight", method$id)]] - weights[[method$id]] <- weight - } - } - } else { - weights <- optimal_weights() - - for (method_id in names(weights)) { - updateSliderInput( - session, - sprintf("%s_weight", method_id), - value = weights[[method_id]] - ) - } - } - - geposan::ranking(analysis(), weights) - }) + shinyjs::onclick(sprintf("%s_weight", method$id), { + updateSelectInput( + session, + "optimization_target", + selected = "custom" + ) + }) }) + + # This reactive will always contain the currently selected optimization + # gene IDs in a normalized form. + optimization_gene_ids <- reactive({ + gene_ids <- if (input$optimization_genes == "comparison") { + comparison_gene_ids() + } else { + analysis()$preset$reference_gene_ids + } + + sort(unique(gene_ids)) + }) + + # This reactive will always contain the optimal weights according to + # the selected parameters. + optimal_weights <- reactive({ + withProgress(message = "Optimizing weights", { + setProgress(0.2) + + included_methods <- NULL + + for (method in methods) { + if (input[[method$id]]) { + included_methods <- c(included_methods, method$id) + } + } + + geposan::optimal_weights( + analysis(), + included_methods, + optimization_gene_ids(), + target = input$optimization_target + ) + }) + }) |> bindCache( + analysis(), + optimization_gene_ids(), + sapply(methods, function(method) input[[method$id]]), + input$optimization_target + ) + + reactive({ + weights <- NULL + + if (length(optimization_gene_ids()) < 1 | + input$optimization_target == "custom") { + for (method in methods) { + if (input[[method$id]]) { + weight <- input[[sprintf("%s_weight", method$id)]] + weights[[method$id]] <- weight + } + } + } else { + weights <- optimal_weights() + + for (method_id in names(weights)) { + updateSliderInput( + session, + sprintf("%s_weight", method_id), + value = weights[[method_id]] + ) + } + } + + geposan::ranking(analysis(), weights) + }) + }) } diff --git a/R/preset_editor.R b/R/preset_editor.R index 0c3e7c6..261c92a 100644 --- a/R/preset_editor.R +++ b/R/preset_editor.R @@ -7,63 +7,63 @@ #' #' @noRd preset_editor_ui <- function(id, options) { - species_choices <- c("All species", names(options$species_sets)) - gene_choices <- names(options$gene_sets) + 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 = species_choices + ), if (!options$locked) { - species_choices <- c(species_choices, "Customize") - gene_choices <- c(gene_choices, "Customize") + conditionalPanel( + condition = sprintf( + "input['%s'] == 'Customize'", + 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 = gene_choices + ), + if (!options$locked) { + conditionalPanel( + condition = sprintf( + "input['%s'] == 'Customize'", + NS(id, "reference_genes") + ), + gene_selector_ui(NS(id, "custom_genes")) + ) + }, + if (options$locked) { + HTML(paste0( + "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." + )) } - - verticalLayout( - h3("Inputs"), - selectInput( - NS(id, "species"), - "Species to include", - 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 - ), - ) - }, - selectInput( - NS(id, "reference_genes"), - "Reference genes", - choices = gene_choices - ), - if (!options$locked) { - conditionalPanel( - condition = sprintf( - "input['%s'] == 'Customize'", - NS(id, "reference_genes") - ), - gene_selector_ui(NS(id, "custom_genes")) - ) - }, - if (options$locked) { - HTML(paste0( - "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. @@ -76,45 +76,45 @@ preset_editor_ui <- function(id, options) { #' #' @noRd preset_editor_server <- function(id, options) { - moduleServer(id, function(input, output, session) { - custom_gene_ids <- if (!options$locked) { - species_choices <- geposan::species$id - names(species_choices) <- geposan::species$name + moduleServer(id, function(input, output, session) { + 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 + ) - gene_selector_server("custom_genes") - } else { - NULL - } + gene_selector_server("custom_genes") + } else { + NULL + } - reactive({ - reference_gene_ids <- if (input$reference_genes == "Customize") { - custom_gene_ids() - } else { - options$gene_sets[[input$reference_genes]] - } + reactive({ + reference_gene_ids <- if (input$reference_genes == "Customize") { + custom_gene_ids() + } else { + options$gene_sets[[input$reference_genes]] + } - species_ids <- if (input$species == "All species") { - geposan::species$id - } else if (input$species == "Customize") { - input$custom_species - } else { - options$species_sets[[input$species]] - } + species_ids <- if (input$species == "All species") { + geposan::species$id + } else if (input$species == "Customize") { + input$custom_species + } else { + options$species_sets[[input$species]] + } - tryCatch( - geposan::preset( - reference_gene_ids, - species_ids = species_ids - ), - error = function(err) NULL - ) - }) + tryCatch( + geposan::preset( + reference_gene_ids, + species_ids = species_ids + ), + error = function(err) NULL + ) }) + }) } diff --git a/R/results.R b/R/results.R index 4225c2e..afeb31d 100644 --- a/R/results.R +++ b/R/results.R @@ -1,20 +1,20 @@ #' Construct UI for the detailed results panel. #' @noRd results_ui <- function(id) { - verticalLayout( - div( - style = "margin-top: 16px", - splitLayout( - cellWidths = "auto", - uiOutput(NS(id, "copy")), - downloadButton(NS(id, "download"), "Download CSV") - ) - ), - div( - style = "margin-top: 16px", - DT::DTOutput(NS(id, "genes")) - ) + verticalLayout( + div( + style = "margin-top: 16px", + splitLayout( + cellWidths = "auto", + uiOutput(NS(id, "copy")), + downloadButton(NS(id, "download"), "Download CSV") + ) + ), + div( + style = "margin-top: 16px", + DT::DTOutput(NS(id, "genes")) ) + ) } #' Server for the detailed results panel. @@ -24,92 +24,93 @@ results_ui <- function(id) { #' #' @noRd results_server <- function(id, filtered_results) { - moduleServer(id, function(input, output, session) { - output$copy <- renderUI({ - results <- filtered_results() + moduleServer(id, function(input, output, session) { + output$copy <- renderUI({ + results <- filtered_results() - gene_ids <- results[, gene] - names <- results[name != "", name] + gene_ids <- results[, gene] + names <- results[name != "", name] - genes_text <- paste(gene_ids, collapse = "\n") - names_text <- paste(names, collapse = "\n") + 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") - ) - ) - }) - - columns <- c( - "rank", - "gene", - "name", - "chromosome", - "distance", - method_ids, - "score", - "percentile" + 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") ) - - column_names <- c( - "", - "Gene", - "", - "Chromosome", - "Distance", - method_names, - "Score", - "Percentile" - ) - - output_data <- reactive({ - filtered_results()[, ..columns][, - distance := paste0( - format( - round(distance / 1000000, digits = 2), - nsmall = 2, - ), - " Mbp" - ) - ] - }) - - output$download <- downloadHandler( - filename = "geposan_filtered_results.csv", - content = function(file) { - fwrite(output_data(), file = file) - }, - contentType = "text/csv" - ) - - output$genes <- DT::renderDT({ - dt <- DT::datatable( - output_data(), - rownames = FALSE, - colnames = column_names, - options = list( - rowCallback = js_link, - columnDefs = list(list(visible = FALSE, targets = 2)), - pageLength = 25 - ) - ) - - DT::formatPercentage( - dt, - c(method_ids, "score", "percentile"), - digits = 2 - ) - }) + ) }) + + columns <- c( + "rank", + "gene", + "name", + "chromosome", + "distance", + method_ids, + "score", + "percentile" + ) + + column_names <- c( + "", + "Gene", + "", + "Chromosome", + "Distance", + method_names, + "Score", + "Percentile" + ) + + output_data <- reactive({ + filtered_results()[, ..columns][ + , + distance := paste0( + format( + round(distance / 1000000, digits = 2), + nsmall = 2, + ), + " Mbp" + ) + ] + }) + + output$download <- downloadHandler( + filename = "geposan_filtered_results.csv", + content = function(file) { + fwrite(output_data(), file = file) + }, + contentType = "text/csv" + ) + + output$genes <- DT::renderDT({ + dt <- DT::datatable( + output_data(), + rownames = FALSE, + colnames = column_names, + options = list( + rowCallback = js_link, + columnDefs = list(list(visible = FALSE, targets = 2)), + pageLength = 25 + ) + ) + + DT::formatPercentage( + dt, + c(method_ids, "score", "percentile"), + digits = 2 + ) + }) + }) } diff --git a/R/server.R b/R/server.R index 19fc351..1892c55 100644 --- a/R/server.R +++ b/R/server.R @@ -12,291 +12,291 @@ js_link <- DT::JS("function(row, data) { #' @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 + 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) + 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()) + # 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) + # Rank the results. + ranking <- methods_server("methods", analysis, comparison_gene_ids) - genes_with_distances <- merge( - geposan::genes, - geposan::distances[species == "hsapiens"], - by.x = "id", - by.y = "gene" + genes_with_distances <- merge( + geposan::genes, + geposan::distances[species == "hsapiens"], + by.x = "id", + by.y = "gene" + ) + + # Add gene information to the results. + results <- reactive({ + merge( + ranking(), + genes_with_distances, + 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) ) + } - # Add gene information to the results. - results <- reactive({ - merge( - ranking(), - genes_with_distances, - by.x = "gene", - by.y = "id", - sort = FALSE + 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$comparison_text <- renderUI({ + reference <- geposan::compare( + ranking(), + preset()$reference_gene_ids + ) + + comparison <- if (!is.null(comparison_gene_ids())) { + geposan::compare(ranking(), comparison_gene_ids()) + } + + num <- function(x, digits) { + format( + round(x, digits = digits), + nsmall = digits, + scientific = FALSE + ) + } + + comparison_text <- function(name, comparison) { + glue::glue( + "The {name} have a mean score of ", + "{num(comparison$mean_score, 4)} ", + "resulting in a mean rank of ", + "{num(comparison$mean_rank, 1)}. ", + "This corresponds to a percent rank of ", + "{num(100 * comparison$mean_percentile, 2)}%. ", + "A Wilcoxon rank sum test with the hypothesis of higher ", + "than usual scores gives a p-value of ", + "{num(comparison$p_value, 4)}." + ) + } + + reference_div <- div(HTML( + comparison_text("reference genes", reference) + )) + + if (!is.null(comparison)) { + div( + reference_div, + div(HTML(comparison_text("comparison genes", comparison))) + ) + } else { + reference_div + } + }) + + 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) + ) + } + + chromosome <- if (input$positions_plot_chromosome_name == "all") { + NULL + } else { + input$positions_plot_chromosome_name + } + + geposan::plot_scores_by_position( + ranking(), + chromosome_name = chromosome, + 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" + ), + 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 <- suppressMessages( + 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" + ), + options = list( + pageLength = 25 ) - }) + ) - # Apply the filters. - results_filtered <- filters_server("filters", results) + dt <- DT::formatRound(dt, "pvalue", digits = 4) - # 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) - ) - } - - 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$comparison_text <- renderUI({ - reference <- geposan::compare( - ranking(), - preset()$reference_gene_ids - ) - - comparison <- if (!is.null(comparison_gene_ids())) { - geposan::compare(ranking(), comparison_gene_ids()) - } - - num <- function(x, digits) { - format( - round(x, digits = digits), - nsmall = digits, - scientific = FALSE - ) - } - - comparison_text <- function(name, comparison) { - glue::glue( - "The {name} have a mean score of ", - "{num(comparison$mean_score, 4)} ", - "resulting in a mean rank of ", - "{num(comparison$mean_rank, 1)}. ", - "This corresponds to a percent rank of ", - "{num(100 * comparison$mean_percentile, 2)}%. ", - "A Wilcoxon rank sum test with the hypothesis of higher ", - "than usual scores gives a p-value of ", - "{num(comparison$p_value, 4)}." - ) - } - - reference_div <- div(HTML( - comparison_text("reference genes", reference) - )) - - if (!is.null(comparison)) { - div( - reference_div, - div(HTML(comparison_text("comparison genes", comparison))) - ) - } else { - reference_div - } - }) - - 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) - ) - } - - chromosome <- if (input$positions_plot_chromosome_name == "all") { - NULL - } else { - input$positions_plot_chromosome_name - } - - geposan::plot_scores_by_position( - ranking(), - chromosome_name = chromosome, - 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" - ), - 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 <- suppressMessages( - 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" - ), - options = list( - pageLength = 25 - ) - ) - - dt <- DT::formatRound(dt, "pvalue", digits = 4) - - dt - } - ) - }) - } + dt + } + ) + }) + } } diff --git a/R/ui.R b/R/ui.R index 70dc0e1..ae2f4e4 100644 --- a/R/ui.R +++ b/R/ui.R @@ -4,136 +4,136 @@ #' #' @noRd ui <- function(options) { - div( - shinyjs::useShinyjs(), - rclipboard::rclipboardSetup(), - navbarPage( - id = "main_page", - theme = bslib::bs_theme( - version = 5, - bootswatch = "united", - primary = "#1964bf" - ), - title = options$title, - selected = "Results", - tabPanel( - "Input data", - input_page_ui("input_page", options) - ), - tabPanel( - "Results", - sidebarLayout( - sidebarPanel( - width = 3, - methods_ui("methods"), - filters_ui("filters") - ), - mainPanel( - width = 9, - tabsetPanel( - type = "pills", - tabPanel( - title = "Overview", - div( - style = "margin-top: 16px", - plotly::plotlyOutput( - "rank_plot", - width = "100%", - height = "600px" - ) - ) - ), - tabPanel( - title = "Methods & Distribution", - div( - style = "margin-top: 16px", - plotly::plotlyOutput( - "rankings_plot", - width = "100%", - height = "600px" - ) - ) - ), - tabPanel( - title = "Comparison", - div( - style = "margin-top: 16px", - htmlOutput("comparison_text"), - plotly::plotlyOutput( - "boxplot", - width = "100%", - height = "600px" - ) - ) - ), - tabPanel( - title = "Scores by position", - div( - style = "margin-top: 16px", - selectInput( - "positions_plot_chromosome_name", - label = NULL, - choices = c( - list("All chromosomes" = "all"), - chromosome_choices() - ) - ), - plotly::plotlyOutput( - "positions_plot", - width = "100%", - height = "600px" - ) - ) - ), - tabPanel( - title = "Detailed results", - results_ui("results") - ), - tabPanel( - title = "g:Profiler", - div( - style = "margin-top: 16px", - plotly::plotlyOutput("gost_plot"), - ), - div( - style = "margin-top: 16px", - DT::DTOutput("gost_details") - ) - ), - tabPanel( - title = "DisGeNET", - div( - style = "margin-top: 16px", - DT::DTOutput("disgenet") - ) - ) - ) - ) + div( + shinyjs::useShinyjs(), + rclipboard::rclipboardSetup(), + navbarPage( + id = "main_page", + theme = bslib::bs_theme( + version = 5, + bootswatch = "united", + primary = "#1964bf" + ), + title = options$title, + selected = "Results", + tabPanel( + "Input data", + input_page_ui("input_page", options) + ), + tabPanel( + "Results", + sidebarLayout( + sidebarPanel( + width = 3, + methods_ui("methods"), + filters_ui("filters") + ), + mainPanel( + width = 9, + tabsetPanel( + type = "pills", + tabPanel( + title = "Overview", + div( + style = "margin-top: 16px", + plotly::plotlyOutput( + "rank_plot", + width = "100%", + height = "600px" + ) ) - ), - tabPanel( - title = "Publication" + ), + tabPanel( + title = "Methods & Distribution", + div( + style = "margin-top: 16px", + plotly::plotlyOutput( + "rankings_plot", + width = "100%", + height = "600px" + ) + ) + ), + tabPanel( + title = "Comparison", + div( + style = "margin-top: 16px", + htmlOutput("comparison_text"), + plotly::plotlyOutput( + "boxplot", + width = "100%", + height = "600px" + ) + ) + ), + tabPanel( + title = "Scores by position", + div( + style = "margin-top: 16px", + selectInput( + "positions_plot_chromosome_name", + label = NULL, + choices = c( + list("All chromosomes" = "all"), + chromosome_choices() + ) + ), + plotly::plotlyOutput( + "positions_plot", + width = "100%", + height = "600px" + ) + ) + ), + tabPanel( + title = "Detailed results", + results_ui("results") + ), + tabPanel( + title = "g:Profiler", + div( + style = "margin-top: 16px", + plotly::plotlyOutput("gost_plot"), + ), + div( + style = "margin-top: 16px", + DT::DTOutput("gost_details") + ) + ), + tabPanel( + title = "DisGeNET", + div( + style = "margin-top: 16px", + DT::DTOutput("disgenet") + ) + ) ) + ) ) + ), + tabPanel( + title = "Publication" + ) ) + ) } #' Generate a named list for choosing chromosomes. #' @noRd chromosome_choices <- function() { - choices <- purrr::lmap( - unique(geposan::genes$chromosome), - function(name) { - choice <- list(name) + choices <- purrr::lmap( + unique(geposan::genes$chromosome), + function(name) { + choice <- list(name) - names(choice) <- paste0( - "Chromosome ", - name - ) + names(choice) <- paste0( + "Chromosome ", + name + ) - choice - } - ) + choice + } + ) - choices[order(suppressWarnings(sapply(choices, as.integer)))] + choices[order(suppressWarnings(sapply(choices, as.integer)))] }