From 1871c3b870f9f7335d09457300b820c90ff8acb3 Mon Sep 17 00:00:00 2001
From: Elias Projahn <elias@johrpan.de>
Date: Mon, 6 Dec 2021 13:54:22 +0100
Subject: [PATCH] Add comparison genes

---
 R/comparison_editor.R | 85 +++++++++++++++++++++++++++++++++++++++++++
 R/server.R            |  2 +
 R/ui.R                |  1 +
 3 files changed, 88 insertions(+)
 create mode 100644 R/comparison_editor.R

diff --git a/R/comparison_editor.R b/R/comparison_editor.R
new file mode 100644
index 0000000..49eb7e4
--- /dev/null
+++ b/R/comparison_editor.R
@@ -0,0 +1,85 @@
+# Create a comparison editor.
+comparison_editor_ui <- function(id) {
+    known_genes <- genes[name != ""]
+    gene_choices <- known_genes$id
+    names(gene_choices) <- known_genes$name
+
+    verticalLayout(
+        h3("Comparison"),
+        selectInput(
+            NS(id, "comparison_genes"),
+            "Comparison genes",
+            choices = list(
+                "None" = "none",
+                "Random genes" = "random",
+                "Verified or suggested TPE-OLD genes" = "tpeold",
+                "Only verified TPE-OLD genes" = "verified",
+                "Only suggested TPE-OLD genes" = "suggested",
+                "Customize" = "custom"
+            )
+        ),
+        tabsetPanel(
+            id = NS(id, "custom_comparison_genes_panel"),
+            type = "hidden",
+            tabPanelBody(value = "hide"),
+            tabPanelBody(
+                value = "show",
+                shinyWidgets::pickerInput(
+                    inputId = NS(id, "custom_comparison_genes"),
+                    choices = gene_choices,
+                    options = list(
+                        "actions-box" = TRUE,
+                        "live-search" = TRUE
+                    ),
+                    multiple = TRUE
+                )
+            )
+        )
+    )
+}
+
+# Create a server for the comparison editor.
+#
+# @param id ID for namespacing the inputs and outputs.
+# @param preset A reactive containing the current preset.
+#
+# @return A reactive containing the comparison gene IDs.
+comparison_editor_server <- function(id, preset) {
+    moduleServer(id, function(input, output, session) {
+        observeEvent(input$comparison_genes, {
+            if (input$comparison_genes == "custom") {
+                updateTabsetPanel(
+                    session,
+                    "custom_comparison_genes_panel",
+                    selected = "show"
+                )
+            } else {
+                updateTabsetPanel(
+                    session,
+                    "custom_comparison_genes_panel",
+                    selected = "hide"
+                )
+            }
+        })
+
+        reactive({
+            if (input$comparison_genes == "none") {
+                NULL
+            } else if (input$comparison_genes == "random") {
+                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_pool[sample(length(gene_pool), length(reference_gene_ids))]
+            } else if (input$comparison_genes == "tpeold") {
+                genes[verified | suggested == TRUE, id]
+            } else if (input$comparison_genes == "verified") {
+                genes[verified == TRUE, id]
+            } else if (input$comparison_genes == "suggested") {
+                genes[suggested == TRUE, id]
+            } else {
+                input$custom_comparison_genes
+            }
+        })
+    })
+}
diff --git a/R/server.R b/R/server.R
index a4b252f..27ce997 100644
--- a/R/server.R
+++ b/R/server.R
@@ -45,6 +45,8 @@ server <- function(input, output, session) {
     # Apply the filters.
     results_filtered <- filters_server("filters", results)
 
+    comparison_gene_ids <- comparison_editor_server("comparison_editor", preset)
+
     output$genes <- DT::renderDT({
         columns <- c("rank", "gene", "name", "chromosome", method_ids, "score")
         column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")
diff --git a/R/ui.R b/R/ui.R
index ec37cbe..58103a8 100644
--- a/R/ui.R
+++ b/R/ui.R
@@ -6,6 +6,7 @@ ui <- fluidPage(
         sidebarPanel(
             width = 3,
             preset_editor_ui("preset_editor"),
+            comparison_editor_ui("comparison_editor"),
             filters_ui("filters"),
             methods_ui("methods")
         ),