mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 19:27:24 +01:00
Compare commits
6 commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 7b0b8bc8c1 | |||
| 7d615f1a9a | |||
| b3b492172a | |||
| e0694b71d0 | |||
| 2464240d99 | |||
| e40b2151fe |
7 changed files with 178 additions and 25 deletions
|
|
@ -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",
|
||||||
|
|
|
||||||
2
R/app.R
2
R/app.R
|
|
@ -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>"
|
||||||
))
|
))
|
||||||
|
|
|
||||||
|
|
@ -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()
|
|
||||||
gene_pool <- preset$gene_ids
|
preset <- preset()
|
||||||
reference_gene_ids <- preset$reference_gene_ids
|
gene_pool <- preset$gene_ids
|
||||||
gene_pool <- gene_pool[!gene_pool %chin% reference_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))]
|
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]
|
||||||
})
|
})
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
|
|
|
||||||
13
R/details.R
13
R/details.R
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
||||||
95
R/results.R
95
R/results.R
|
|
@ -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())
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue