mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 03:07:24 +01:00
132 lines
3.8 KiB
R
132 lines
3.8 KiB
R
#' Create a comparison editor.
|
|
#'
|
|
#' @param options Global application options
|
|
#' @noRd
|
|
comparison_editor_ui <- function(id, options) {
|
|
verticalLayout(
|
|
h5("Comparison"),
|
|
popover(
|
|
title = "Comparison genes",
|
|
help = paste0(
|
|
"Select your genes of interest to compare their scores with the ",
|
|
"reference genes. This will not influence the computation of scores, ",
|
|
"but it will update the visualizations and summary statistics. Select ",
|
|
"\"Your genes\" and use the other controls below for selecting or ",
|
|
"pasting the genes. You can also use predefined gene sets for ",
|
|
"comparison."
|
|
),
|
|
div(class = "label", "Comparison genes")
|
|
),
|
|
selectInput(
|
|
NS(id, "comparison_genes"),
|
|
label = NULL,
|
|
choices = c(
|
|
"Your genes",
|
|
"Random genes",
|
|
names(options$comparison_gene_sets)
|
|
)
|
|
),
|
|
conditionalPanel(
|
|
condition = sprintf(
|
|
"input['%s'] == 'Your genes'",
|
|
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"))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
}
|
|
|
|
#' Create a server for the comparison editor.
|
|
#'
|
|
#' @param id ID for namespacing the inputs and outputs.
|
|
#' @param preset A reactive containing the current preset.
|
|
#' @param options Global application options
|
|
#'
|
|
#' @return A reactive containing the comparison gene IDs.
|
|
#'
|
|
#' @noRd
|
|
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 = "<br>"))
|
|
})
|
|
|
|
observe({
|
|
updateTabsetPanel(
|
|
session,
|
|
"warning_panel",
|
|
selected = if (is.null(comparison_warnings())) "hide" else "show"
|
|
)
|
|
})
|
|
|
|
reactive({
|
|
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]
|
|
})
|
|
})
|
|
}
|