From e61546b53c4388ad679b7f50e5ef788772e94249 Mon Sep 17 00:00:00 2001 From: Elias Projahn Date: Wed, 26 Jan 2022 14:48:29 +0100 Subject: [PATCH] Add separate gene selector component --- DESCRIPTION | 3 +- R/comparison_editor.R | 23 ++-------- R/gene_selector.R | 101 ++++++++++++++++++++++++++++++++++++++++++ R/preset_editor.R | 29 +++--------- README.md | 1 + 5 files changed, 114 insertions(+), 43 deletions(-) create mode 100644 R/gene_selector.R diff --git a/DESCRIPTION b/DESCRIPTION index c726dcf..fed04b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,4 +24,5 @@ Imports: rlang, rclipboard, shiny, - shinyjs + shinyjs, + shinyvs diff --git a/R/comparison_editor.R b/R/comparison_editor.R index f7e818c..1b28bd1 100644 --- a/R/comparison_editor.R +++ b/R/comparison_editor.R @@ -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() } }) }) diff --git a/R/gene_selector.R b/R/gene_selector.R new file mode 100644 index 0000000..1e8e615 --- /dev/null +++ b/R/gene_selector.R @@ -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 + } + }) + }) +} diff --git a/R/preset_editor.R b/R/preset_editor.R index 7c36a44..524386c 100644 --- a/R/preset_editor.R +++ b/R/preset_editor.R @@ -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") { diff --git a/README.md b/README.md index 5fb6a58..3f60c73 100644 --- a/README.md +++ b/README.md @@ -9,6 +9,7 @@ You can install the development version of tpeold using: ```r # install.packages("remotes") +remotes::install_github("dreamRs/shinyvs") remotes::install_git("https://code.johrpan.de/johrpan/tpeold.git") ```