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)))]
}