Compare commits

..

6 commits
v1.0.1 ... main

7 changed files with 178 additions and 25 deletions

View file

@ -1,6 +1,6 @@
Package: geposanui Package: geposanui
Title: Graphical user interface for geposan Title: Graphical user interface for geposan
Version: 1.0.1 Version: 1.1.0
Authors@R: Authors@R:
person( person(
"Elias", "Elias",

View file

@ -91,7 +91,7 @@ ui <- function(options) {
HTML(glue::glue( HTML(glue::glue(
"<code>geposanui</code> version {packageVersion(\"geposanui\")}<br>", "<code>geposanui</code> version {packageVersion(\"geposanui\")}<br>",
"GitHub: <a href=\"https://github.com/johrpan/geposanui/\" ", "GitHub: <a href=\"https://github.com/johrpan/geposanui/\" ",
"target=\"blank\">johrpan/geposan</a><br>", "target=\"blank\">johrpan/geposanui</a><br>",
"Citation: <a href=\"https://doi.org/10.1093/nargab/lqae037\" ", "Citation: <a href=\"https://doi.org/10.1093/nargab/lqae037\" ",
"target=\"blank\">10.1093/nargab/lqae037</a>" "target=\"blank\">10.1093/nargab/lqae037</a>"
)) ))

View file

@ -32,6 +32,18 @@ comparison_editor_ui <- function(id, options) {
NS(id, "comparison_genes") NS(id, "comparison_genes")
), ),
gene_selector_ui(NS(id, "custom_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) { moduleServer(id, function(input, output, session) {
custom_gene_ids <- gene_selector_server("custom_genes") custom_gene_ids <- gene_selector_server("custom_genes")
comparison_warnings <- reactiveVal(character())
output$warnings <- renderUI({
HTML(paste(comparison_warnings(), collapse = "<br>"))
})
observe({
updateTabsetPanel(
session,
"warning_panel",
selected = if (is.null(comparison_warnings())) "hide" else "show"
)
})
reactive({ reactive({
if (input$comparison_genes == "Random genes") { new_warnings <- character()
preset <- preset() preset <- preset()
gene_pool <- preset$gene_ids gene_pool <- preset$gene_ids
reference_gene_ids <- preset$reference_gene_ids reference_gene_ids <- preset$reference_gene_ids
gene_pool <- gene_pool[!gene_pool %chin% 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))] gene_pool[sample(length(gene_pool), length(reference_gene_ids))]
} else if (input$comparison_genes == "Your genes") { } else if (input$comparison_genes == "Your genes") {
custom_gene_ids() custom_gene_ids()
} else { } else {
options$comparison_gene_sets[[input$comparison_genes]] 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]
}) })
}) })
} }

View file

@ -86,19 +86,6 @@ details_server <- function(id, options, results) {
"Percentile" "Percentile"
) )
output_data <- reactive({
filtered_results()[, ..columns][
,
distance := paste0(
format(
round(distance / 1000000, digits = 2),
nsmall = 2,
),
" Mbp"
)
]
})
output$download <- downloadHandler( output$download <- downloadHandler(
filename = "geposan_filtered_results.csv", filename = "geposan_filtered_results.csv",
content = \(file) fwrite(filtered_results()[, ..columns], file = file), content = \(file) fwrite(filtered_results()[, ..columns], file = file),

View file

@ -102,8 +102,8 @@ preset_editor_ui <- function(id, options) {
"reference genes to find patterns in their ", "reference genes to find patterns in their ",
"chromosomal positions. If you would like to apply ", "chromosomal positions. If you would like to apply ",
"this method for your own research, see ", "this method for your own research, see ",
"<a href=\"https://code.johrpan.de/johrpan/geposanui/src/", "<a href=\"https://github.com/johrpan/geposanui/blob/main/README.md\" ",
"branch/main/README.md\" target=\"_blank\">this page</a> for ", "target=\"_blank\">this page</a> for ",
"more information." "more information."
)) ))
} }
@ -196,7 +196,6 @@ preset_editor_server <- function(id, options) {
), ),
warning = function(w) { warning = function(w) {
new_warnings <<- c(new_warnings, w$message) new_warnings <<- c(new_warnings, w$message)
} }
) )

View file

@ -32,7 +32,31 @@ results_ui <- function(id, options) {
plotly::plotlyOutput( plotly::plotlyOutput(
NS(id, "rank_plot"), NS(id, "rank_plot"),
width = "100%", 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) 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({ output$rankings_plot <- plotly::renderPlotly({
preset <- preset() preset <- preset()
@ -360,7 +451,7 @@ results_server <- function(id, options, analysis) {
preset()$reference_gene_ids preset()$reference_gene_ids
) )
comparison <- if (!is.null(comparison_gene_ids())) { comparison <- if (length(comparison_gene_ids()) > 0) {
geposan::compare(ranking(), comparison_gene_ids()) geposan::compare(ranking(), comparison_gene_ids())
} }

View file

@ -28,6 +28,16 @@ h5 {
font-weight: normal; 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 */ /* Fix slider inputs floating above dropdown menu */
.irs--shiny .irs-bar { .irs--shiny .irs-bar {
z-index: 1; z-index: 1;