Add separate gene selector component

DESCRIPTION

@@ -24,4 +24,5 @@ Imports:
     rlang,
     rclipboard,
     shiny,
-    shinyjs
+    shinyjs,
+    shinyvs

R/comparison_editor.R

@@ -19,19 +19,7 @@ comparison_editor_ui <- function(id) {
                 "input['%s'] == 'custom'",
                 NS(id, "comparison_genes")
             ),
-            selectInput(
+            gene_selector_ui(NS(id, "custom_genes"))
-                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"
-            )
         )
     )
 }
@@ -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]]
+                custom_gene_ids()
-                if (input$identifier_type == "hgnc") {
-                    geposan::genes[name %chin% inputs, id]
-                } else {
-                    geposan::genes[id %chin% inputs, id]
-                }
             }
         })
     })

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
+            }
+        })
+    })
+}

R/preset_editor.R

@@ -39,22 +39,9 @@ preset_editor_ui <- function(id) {
                 "input['%s'] == 'custom'",
                 NS(id, "reference_genes")
             ),
-            selectInput(
+            gene_selector_ui(
-                NS(id, "identifier_type"),
+                NS(id, "custom_genes"),
-                "Gene identifiers",
+                genes[suggested | verified == TRUE, id]
-                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"
             )
         )
     )
@@ -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]]
+                custom_gene_ids()
-
-                gene_ids <- if (input$identifier_type == "hgnc") {
-                    geposan::genes[name %chin% inputs, id]
-                } else {
-                    geposan::genes[id %chin% inputs, id]
-                }
             }
 
             species_ids <- if (input$species == "replicative") {

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")
 ```