diff --git a/DESCRIPTION b/DESCRIPTION index 815597d..63bd4d5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: geposanui Title: Graphical user interface for geposan -Version: 1.0.1 +Version: 1.1.0 Authors@R: person( "Elias", diff --git a/R/app.R b/R/app.R index 34c9a93..2940d81 100644 --- a/R/app.R +++ b/R/app.R @@ -91,7 +91,7 @@ ui <- function(options) { HTML(glue::glue( "geposanui version {packageVersion(\"geposanui\")}
", "GitHub: johrpan/geposan
", + "target=\"blank\">johrpan/geposanui
", "Citation: 10.1093/nargab/lqae037" )) diff --git a/R/comparison_editor.R b/R/comparison_editor.R index 5dafa0a..21e7b8f 100644 --- a/R/comparison_editor.R +++ b/R/comparison_editor.R @@ -32,6 +32,18 @@ comparison_editor_ui <- function(id, options) { NS(id, "comparison_genes") ), gene_selector_ui(NS(id, "custom_genes")) + ), + tabsetPanel( + id = NS(id, "warning_panel"), + type = "hidden", + tabPanelBody(value = "hide"), + tabPanelBody( + value = "show", + div( + style = "color: orange; margin-bottom: 16px;", + htmlOutput(NS(id, "warnings")) + ) + ) ) ) } @@ -49,18 +61,72 @@ comparison_editor_server <- function(id, preset, options) { moduleServer(id, function(input, output, session) { custom_gene_ids <- gene_selector_server("custom_genes") + comparison_warnings <- reactiveVal(character()) + output$warnings <- renderUI({ + HTML(paste(comparison_warnings(), collapse = "
")) + }) + + observe({ + updateTabsetPanel( + session, + "warning_panel", + selected = if (is.null(comparison_warnings())) "hide" else "show" + ) + }) + reactive({ - 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] + new_warnings <- character() + + 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_ids <- if (input$comparison_genes == "Random genes") { gene_pool[sample(length(gene_pool), length(reference_gene_ids))] } else if (input$comparison_genes == "Your genes") { custom_gene_ids() } else { options$comparison_gene_sets[[input$comparison_genes]] } + + excluded_reference_gene_ids <- + gene_ids[gene_ids %chin% reference_gene_ids] + + if (length(excluded_reference_gene_ids) > 0) { + excluded_reference_genes <- + geposan::genes[id %chin% excluded_reference_gene_ids] + excluded_reference_genes[is.na(name), name := id] + + new_warnings <- c(new_warnings, paste0( + "The following genes have been excluded because they are already ", + "part of the reference genes: ", + paste( + excluded_reference_genes$name, + collapse = ", " + ) + )) + } + + excluded_gene_ids <- gene_ids[!gene_ids %chin% gene_pool] + + if (length(excluded_gene_ids) > 0) { + excluded_genes <- + geposan::genes[id %chin% excluded_gene_ids] + excluded_genes[is.na(name), name := id] + + new_warnings <- c(new_warnings, paste0( + "The following genes are not present in the results: ", + paste( + excluded_genes$name, + collapse = ", " + ) + )) + } + + comparison_warnings(new_warnings) + + gene_ids[!gene_ids %chin% reference_gene_ids & gene_ids %chin% gene_pool] }) }) } diff --git a/R/details.R b/R/details.R index ddd0d87..2d4bc42 100644 --- a/R/details.R +++ b/R/details.R @@ -86,19 +86,6 @@ details_server <- function(id, options, results) { "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 = \(file) fwrite(filtered_results()[, ..columns], file = file), diff --git a/R/preset_editor.R b/R/preset_editor.R index 2ddfdf9..1489118 100644 --- a/R/preset_editor.R +++ b/R/preset_editor.R @@ -102,8 +102,8 @@ preset_editor_ui <- function(id, options) { "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 ", + "this page for ", "more information." )) } @@ -196,7 +196,6 @@ preset_editor_server <- function(id, options) { ), warning = function(w) { new_warnings <<- c(new_warnings, w$message) - } ) diff --git a/R/results.R b/R/results.R index d5d5c01..d6a8d44 100644 --- a/R/results.R +++ b/R/results.R @@ -32,7 +32,31 @@ results_ui <- function(id, options) { plotly::plotlyOutput( NS(id, "rank_plot"), width = "100%", - height = "600px" + height = "500px" + ) + ), + tabsetPanel( + id = NS(id, "comparison_results_panel"), + type = "hidden", + tabPanelBody(value = "hide"), + tabPanelBody( + value = "show", + div( + style = paste0( + "display: flex; gap: 16px; align-items: center; ", + "margin-top: 16px" + ), + div("Detailed results for the selected comparison genes"), + downloadButton( + NS(id, "download_comparison_results"), + "Download CSV", + class = "btn-outline-primary" + ) + ), + div( + style = "margin-top: 16px; margin-bottom: 8px;", + DT::DTOutput(NS(id, "comparison_results")) + ) ) ) ), @@ -245,6 +269,73 @@ results_server <- function(id, options, analysis) { geposan::plot_scores(ranking(), gene_sets = gene_sets) }) + observe({ + updateTabsetPanel( + session, + "comparison_results_panel", + selected = if (length(comparison_gene_ids()) > 0) "show" else "hide" + ) + }) + + methods <- options$methods + method_ids <- sapply(methods, function(method) method$id) + method_names <- sapply(methods, function(method) method$name) + + columns <- c( + "rank", + "gene", + "name", + "chromosome", + "distance", + method_ids, + "score", + "percentile" + ) + + column_names <- c( + "", + "Gene", + "", + "Chr.", + "Distance", + method_names, + "Score", + "Percentile" + ) + + results_filtered_comparison <- reactive({ + results()[gene %chin% comparison_gene_ids()] + }) + + output$download_comparison_results <- downloadHandler( + filename = "geposan_results_custom.csv", + content = \(file) fwrite( + results_filtered_comparison()[, ..columns], + file = file + ), + contentType = "text/csv" + ) + + output$comparison_results <- DT::renderDT({ + data <- results_filtered_comparison()[, ..columns] + data[, distance := glue::glue( + "{format(round(distance / 1000000, digits = 2), nsmall = 2)} Mbp" + )] + + DT::datatable( + data, + rownames = FALSE, + colnames = column_names, + options = list( + rowCallback = js_link(), + columnDefs = list(list(visible = FALSE, targets = 2)), + pageLength = 25 + ) + ) |> + DT::formatRound(c(method_ids, "score"), digits = 4) |> + DT::formatPercentage("percentile", digits = 2) + }) + output$rankings_plot <- plotly::renderPlotly({ preset <- preset() @@ -360,7 +451,7 @@ results_server <- function(id, options, analysis) { preset()$reference_gene_ids ) - comparison <- if (!is.null(comparison_gene_ids())) { + comparison <- if (length(comparison_gene_ids()) > 0) { geposan::compare(ranking(), comparison_gene_ids()) } diff --git a/inst/misc/style.css b/inst/misc/style.css index 01a7613..31a7b55 100644 --- a/inst/misc/style.css +++ b/inst/misc/style.css @@ -28,6 +28,16 @@ h5 { font-weight: normal; } +.navbar[data-bs-theme="light"] { + --bslib-navbar-light-bg: #1964BF; + --bs-navbar-color: rgba(255, 255, 255, 0.65); + --bs-navbar-hover-color: rgba(255, 255, 255, 0.8); + --bs-navbar-disabled-color: rgba(255, 255, 255, 0.3); + --bs-navbar-active-color: #fff; + --bs-navbar-brand-color: #fff; + --bs-navbar-brand-hover-color: #fff; +} + /* Fix slider inputs floating above dropdown menu */ .irs--shiny .irs-bar { z-index: 1;