diff --git a/R/app.R b/R/app.R
index d05b6ad..cd70f57 100644
--- a/R/app.R
+++ b/R/app.R
@@ -41,3 +41,71 @@ run_app <- function(gene_sets,
port = port
)
}
+
+#' Generate the main UI for the application.
+#'
+#' @param options Global options for the application.
+#'
+#' @noRd
+ui <- function(options) {
+ div(
+ custom_css(),
+ 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",
+ results_ui("results", options)
+ )
+ )
+ )
+}
+
+#' Create a server function for the application.
+#'
+#' @param options Global application options.
+#' @noRd
+server <- function(options) {
+ function(input, output, session) {
+ preset <- input_page_server("input_page", options)
+
+ 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())
+
+ results_server("results", options, analysis)
+ }
+}
diff --git a/R/details.R b/R/details.R
index 8c57d97..1872c15 100644
--- a/R/details.R
+++ b/R/details.R
@@ -104,7 +104,7 @@ details_server <- function(id, filtered_results) {
rownames = FALSE,
colnames = column_names,
options = list(
- rowCallback = js_link,
+ rowCallback = js_link(),
columnDefs = list(list(visible = FALSE, targets = 2)),
pageLength = 25
)
@@ -118,3 +118,15 @@ details_server <- function(id, filtered_results) {
})
})
}
+
+#' Generate a JavaScript function to replace gene IDs with Ensembl gene links.
+#' @noRd
+js_link <- function() {
+ DT::JS("function(row, data) {
+ let id = data[1];
+ var name = data[2];
+ if (!name) name = 'Unknown';
+ let url = `https://www.ensembl.org/Homo_sapiens/Gene/Summary?g=${id}`;
+ $('td:eq(1)', row).html(`${name}`);
+ }")
+}
diff --git a/R/server.R b/R/results.R
similarity index 61%
rename from R/server.R
rename to R/results.R
index 60b0833..fb0e190 100644
--- a/R/server.R
+++ b/R/results.R
@@ -1,51 +1,186 @@
-# Java script function to replace gene IDs with Ensembl gene links.
-js_link <- DT::JS("function(row, data) {
- let id = data[1];
- var name = data[2];
- if (!name) name = 'Unknown';
- let url = `https://www.ensembl.org/Homo_sapiens/Gene/Summary?g=${id}`;
- $('td:eq(1)', row).html(`${name}`);
-}")
-
-#' Create a server function for the application.
+#' Create the UI for the results page.
+#'
+#' @param id ID for namespacing.
+#' @param options Global options for the application.
+#'
+#' @return The UI elements.
#'
-#' @param options Global application options.
#' @noRd
-server <- function(options) {
- function(input, output, session) {
- preset <- input_page_server("input_page", options)
+results_ui <- function(id, options) {
+ ranking_choices <- purrr::lmap(geposan::all_methods(), function(method) {
+ l <- list()
+ l[[method[[1]]$name]] <- method[[1]]$id
+ l
+ })
+ ranking_choices <- c(ranking_choices, "Combined" = "combined")
+
+ sidebarLayout(
+ sidebarPanel(
+ width = 3,
+ comparison_editor_ui(NS(id, "comparison_editor"), options),
+ methods_ui(NS(id, "methods")),
+ filters_ui(NS(id, "filters"))
+ ),
+ mainPanel(
+ width = 9,
+ tabsetPanel(
+ type = "pills",
+ tabPanel(
+ title = "Overview",
+ div(
+ style = "margin-top: 16px",
+ plotly::plotlyOutput(
+ NS(id, "rank_plot"),
+ width = "100%",
+ height = "600px"
+ )
+ )
+ ),
+ tabPanel(
+ title = "Method comparison",
+ div(
+ style = "margin-top: 16px",
+ plotly::plotlyOutput(
+ NS(id, "rankings_plot"),
+ width = "100%",
+ height = "600px"
+ )
+ )
+ ),
+ tabPanel(
+ title = "Method correlation",
+ div(
+ class = "flow-layout",
+ style = "margin-top: 16px",
+ selectInput(
+ NS(id, "ranking_y"),
+ label = NULL,
+ choices = ranking_choices
+ ),
+ span(
+ style = paste0(
+ "display: inline-block;",
+ "margin-right: 12px;",
+ "padding: 0.375rem 0.75rem;"
+ ),
+ "~"
+ ),
+ selectInput(
+ NS(id, "ranking_x"),
+ label = NULL,
+ choices = ranking_choices,
+ selected = "combined"
+ ),
+ div(
+ style = paste0(
+ "display: inline-block;",
+ "padding: 0.375rem 0.75rem;"
+ ),
+ checkboxInput(
+ NS(id, "use_ranks"),
+ "Use ranks instead of scores",
+ value = TRUE
+ )
+ ),
+ div(
+ style = paste0(
+ "display: inline-block;",
+ "padding: 0.375rem 0.75rem;"
+ ),
+ checkboxInput(
+ NS(id, "use_sample"),
+ "Take random sample of genes",
+ value = TRUE
+ )
+ )
+ ),
+ plotly::plotlyOutput(
+ NS(id, "ranking_correlation_plot"),
+ width = "100%",
+ height = "600px"
+ )
+ ),
+ tabPanel(
+ title = "Comparison",
+ div(
+ style = "margin-top: 16px",
+ htmlOutput(NS(id, "comparison_text")),
+ plotly::plotlyOutput(
+ NS(id, "boxplot"),
+ width = "100%",
+ height = "600px"
+ )
+ )
+ ),
+ tabPanel(
+ title = "Ortholog locations",
+ div(
+ style = "margin-top: 16px",
+ plotly::plotlyOutput(
+ NS(id, "gene_locations_plot"),
+ width = "100%",
+ height = "1200px"
+ )
+ )
+ ),
+ tabPanel(
+ title = "Scores by position",
+ div(
+ class = "flow-layout",
+ style = "margin-top: 16px",
+ selectInput(
+ NS(id, "positions_plot_chromosome_name"),
+ label = NULL,
+ choices = c(
+ list("All chromosomes" = "all"),
+ chromosome_choices()
+ )
+ ),
+ plotly::plotlyOutput(
+ NS(id, "positions_plot"),
+ width = "100%",
+ height = "600px"
+ )
+ )
+ ),
+ tabPanel(
+ title = "Detailed results",
+ details_ui(NS(id, "results"))
+ ),
+ tabPanel(
+ title = "g:Profiler",
+ div(
+ style = "margin-top: 16px",
+ plotly::plotlyOutput("gost_plot"),
+ ),
+ div(
+ style = "margin-top: 16px",
+ DT::DTOutput(NS(id, "gost_details"))
+ )
+ )
+ )
+ )
+ )
+}
+
+#' Application logic for the results page.
+#'
+#' @param id ID for namespacing.
+#' @param options Global application options.
+#' @param analysis A reactive containing the analysis that gets visualized.
+#'
+#' @noRd
+results_server <- function(id, options, analysis) {
+ preset <- reactive(analysis()$preset)
+
+ moduleServer(id, function(input, output, session) {
comparison_gene_ids <- comparison_editor_server(
"comparison_editor",
preset,
options
)
- 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)
@@ -333,5 +468,25 @@ server <- function(options) {
digits = 2
)
})
- }
+ })
+}
+
+#' Generate a named list for choosing chromosomes.
+#' @noRd
+chromosome_choices <- function() {
+ choices <- purrr::lmap(
+ unique(geposan::genes$chromosome),
+ function(name) {
+ choice <- list(name)
+
+ names(choice) <- paste0(
+ "Chromosome ",
+ name
+ )
+
+ choice
+ }
+ )
+
+ choices[order(suppressWarnings(sapply(choices, as.integer)))]
}
diff --git a/R/ui.R b/R/ui.R
deleted file mode 100644
index 78a42ee..0000000
--- a/R/ui.R
+++ /dev/null
@@ -1,207 +0,0 @@
-#' Generate the main UI for the application.
-#'
-#' @param options Global options for the application.
-#'
-#' @noRd
-ui <- function(options) {
- ranking_choices <- purrr::lmap(geposan::all_methods(), function(method) {
- l <- list()
- l[[method[[1]]$name]] <- method[[1]]$id
- l
- })
-
- ranking_choices <- c(ranking_choices, "Combined" = "combined")
-
- div(
- custom_css(),
- 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,
- comparison_editor_ui("comparison_editor", options),
- 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 = "Method comparison",
- div(
- style = "margin-top: 16px",
- plotly::plotlyOutput(
- "rankings_plot",
- width = "100%",
- height = "600px"
- )
- )
- ),
- tabPanel(
- title = "Method correlation",
- div(
- class = "flow-layout",
- style = "margin-top: 16px",
- selectInput(
- "ranking_y",
- label = NULL,
- choices = ranking_choices
- ),
- span(
- style = paste0(
- "display: inline-block;",
- "margin-right: 12px;",
- "padding: 0.375rem 0.75rem;"
- ),
- "~"
- ),
- selectInput(
- "ranking_x",
- label = NULL,
- choices = ranking_choices,
- selected = "combined"
- ),
- div(
- style = paste0(
- "display: inline-block;",
- "padding: 0.375rem 0.75rem;"
- ),
- checkboxInput(
- "use_ranks",
- "Use ranks instead of scores",
- value = TRUE
- )
- ),
- div(
- style = paste0(
- "display: inline-block;",
- "padding: 0.375rem 0.75rem;"
- ),
- checkboxInput(
- "use_sample",
- "Take random sample of genes",
- value = TRUE
- )
- )
- ),
- plotly::plotlyOutput(
- "ranking_correlation_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 = "Ortholog locations",
- div(
- style = "margin-top: 16px",
- plotly::plotlyOutput(
- "gene_locations_plot",
- width = "100%",
- height = "1200px"
- )
- )
- ),
- tabPanel(
- title = "Scores by position",
- div(
- class = "flow-layout",
- 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",
- details_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 = "Publication"
- )
- )
- )
-}
-
-#' Generate a named list for choosing chromosomes.
-#' @noRd
-chromosome_choices <- function() {
- choices <- purrr::lmap(
- unique(geposan::genes$chromosome),
- function(name) {
- choice <- list(name)
-
- names(choice) <- paste0(
- "Chromosome ",
- name
- )
-
- choice
- }
- )
-
- choices[order(suppressWarnings(sapply(choices, as.integer)))]
-}