johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-26 11:17:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add separate gene selector component

Browse source
This commit is contained in:
Elias Projahn 2022-01-26 14:48:29 +01:00
parent 95efb731bf
commit e61546b53c
5 changed files with 114 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

23
R/comparison_editor.R
View file

@ -19,19 +19,7 @@ comparison_editor_ui <- function(id) {
"input['%s'] == 'custom'",
NS(id, "comparison_genes")
),
selectInput(
NS(id, "identifier_type"),
"Gene identifiers",
choices = list(
"HGNC symbols" = "hgnc",
"Ensembl gene IDs" = "ensembl"
)
),
textAreaInput(
inputId = NS(id, "custom_comparison_genes"),
label = "Enter comparison genes",
height = "250px"
)
gene_selector_ui(NS(id, "custom_genes"))
)
)
}
@ -44,6 +32,8 @@ comparison_editor_ui <- function(id) {
# @return A reactive containing the comparison gene IDs.
comparison_editor_server <- function(id, preset) {
moduleServer(id, function(input, output, session) {
custom_gene_ids <- gene_selector_server("custom_genes")
reactive({
if (input$comparison_genes == "none") {
NULL
@ -60,12 +50,7 @@ comparison_editor_server <- function(id, preset) {
} else if (input$comparison_genes == "suggested") {
genes[suggested == TRUE, id]
} else {
inputs <- strsplit(input$custom_comparison_genes, "\\s+")[[1]]
if (input$identifier_type == "hgnc") {
geposan::genes[name %chin% inputs, id]
} else {
geposan::genes[id %chin% inputs, id]
}
custom_gene_ids()
}
})
})

101
R/gene_selector.R Normal file
View file

@ -0,0 +1,101 @@
#' Create the UI for a gene selector.
#'
#' @param id ID for namespacing.
#' @param default_gene_ids Gene IDs of initially selected genes.
#'
#' @return The user interface
#'
#' @noRd
gene_selector_ui <- function(id, default_gene_ids = NULL) {
named_genes <- genes[name != ""]
named_genes <- unique(named_genes, by = "name")
gene_choices <- named_genes$id
names(gene_choices) <- named_genes$name
verticalLayout(
selectInput(
NS(id, "identifier_type"),
"Gene identifiers",
choices = list(
"Select from list" = "list",
"HGNC symbols" = "hgnc",
"Ensembl gene IDs" = "ensembl"
)
),
tabsetPanel(
id = NS(id, "custom_input"),
type = "hidden",
tabPanelBody(
"list",
shinyvs::virtualSelectInput(
NS(id, "selected_genes"),
label = "Select genes",
choices = gene_choices,
multiple = TRUE,
search = TRUE,
selectAllOnlyVisible = TRUE
),
),
tabPanelBody(
"hgnc",
textAreaInput(
NS(id, "hgnc_names_raw"),
"Enter HGNC symbols",
value = paste(
genes[id %chin% default_gene_ids & name != "", name],
collapse = "\n"
),
height = "250px"
)
),
tabPanelBody(
"ensembl",
textAreaInput(
NS(id, "gene_ids_raw"),
"Enter Ensembl gene IDs",
value = paste(default_gene_ids, collapse = "\n"),
height = "250px"
)
)
)
)
}
#' Application logic for the gene selector.
#'
#' @param id ID for namespacing.
#'
#' @return A reactive containing the selected gene IDs.
#'
#' @noRd
gene_selector_server <- function(id) {
moduleServer(id, function(input, output, session) {
observe({
updateTabsetPanel(
session,
"custom_input",
selected = input$identifier_type
)
})
reactive({
gene_ids <- if (input$identifier_type == "list") {
input$selected_genes
} else if (input$identifier_type == "hgnc") {
inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]])
inputs <- inputs[inputs != ""]
geposan::genes[name %chin% inputs, id]
} else {
inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]])
inputs <- inputs[inputs != ""]
geposan::genes[id %chin% inputs, id]
}
if (length(gene_ids > 100)) {
gene_ids[seq_len(100)]
} else {
gene_ids
}
})
})
}

29
R/preset_editor.R
View file

@ -39,22 +39,9 @@ preset_editor_ui <- function(id) {
"input['%s'] == 'custom'",
NS(id, "reference_genes")
),
selectInput(
NS(id, "identifier_type"),
"Gene identifiers",
choices = list(
"HGNC symbols" = "hgnc",
"Ensembl gene IDs" = "ensembl"
)
),
textAreaInput(
inputId = NS(id, "custom_reference_genes"),
label = "Enter reference genes",
value = paste(
genes[verified | suggested == TRUE, name],
collapse = "\n"
),
height = "250px"
gene_selector_ui(
NS(id, "custom_genes"),
genes[suggested | verified == TRUE, id]
)
)
)
@ -79,19 +66,15 @@ preset_editor_server <- function(id) {
server = TRUE
)
custom_gene_ids <- gene_selector_server("custom_genes")
reactive({
reference_gene_ids <- if (input$reference_genes == "tpeold") {
genes[verified | suggested == TRUE, id]
} else if (input$reference_genes == "verified") {
genes[verified == TRUE, id]
} else {
inputs <- strsplit(input$custom_reference_genes, "\\s+")[[1]]
gene_ids <- if (input$identifier_type == "hgnc") {
geposan::genes[name %chin% inputs, id]
} else {
geposan::genes[id %chin% inputs, id]
}
custom_gene_ids()
}
species_ids <- if (input$species == "replicative") {