Add preset editor

R/preset_editor.R

@@ -0,0 +1,92 @@
+# Create a preset editor.
+preset_editor_ui <- function(id) {
+    species_choices <- species$id
+    names(species_choices) <- species$name
+
+    species_selected <- species_ids_replicative
+
+    known_genes <- genes[name != ""]
+    gene_choices <- known_genes$id
+    names(gene_choices) <- known_genes$name
+
+    genes_selected <- genes[suggested | verified == TRUE, id]
+
+    verticalLayout(
+        h3("Preset"),
+        selectInput(
+            NS(id, "preset"),
+            "Default presets",
+            choices = list(
+                "Replicatively aging species" = "replicative",
+                "All species" = "all",
+                "Customize" = "custom"
+            )
+        ),
+        conditionalPanel(
+            sprintf("input['%s'] == 'custom'", NS(id, "preset")),
+            shinyWidgets::pickerInput(
+                inputId = NS(id, "species"),
+                label = "Included species",
+                choices = species_choices,
+                selected = species_selected,
+                options = list(
+                    "actions-box" = TRUE,
+                    "live-search" = TRUE
+                ),
+                multiple = TRUE
+            ),
+            shinyWidgets::pickerInput(
+                inputId = NS(id, "reference_genes"),
+                label = "Reference genes",
+                choices = gene_choices,
+                selected = genes_selected,
+                options = list(
+                    "actions-box" = TRUE,
+                    "live-search" = TRUE
+                ),
+                multiple = TRUE
+            ),
+            actionButton(
+                NS(id, "apply_button"),
+                "Perform analysis",
+                class = "btn-primary",
+                style = "margin-top: 16px; margin-bottom: 16px"
+            )
+        )
+    )
+}
+
+# Create a server for the preset editor.
+#
+# @param id ID for namespacing the inputs and outputs.
+#
+# @return A reactive containing the preset.
+preset_editor_server <- function(id) {
+    moduleServer(id, function(input, output, session) {
+        result <- reactiveVal(preset_replicative_species)
+
+        observeEvent(input$preset, {
+            if (input$preset == "replicative") {
+                result(preset_replicative_species)
+            } else if (input$preset == "all") {
+                result(preset_all_species)
+            }
+        })
+
+        observeEvent(input$apply_button, {
+            result(geposan::preset(
+                methods <- c(
+                    "clusteriness",
+                    "correlation",
+                    "proximity",
+                    "neural"
+                ),
+                species = input$species,
+                genes = genes$id,
+                reference_genes = input$reference_genes
+            ))
+        })
+
+        result
+    })
+}

R/server.R

@@ -8,17 +8,15 @@ js_link <- DT::JS("function(row, data) {
 }")
 
 server <- function(input, output, session) {
+    preset <- preset_editor_server("preset_editor")
+
     # Show the customized slider for setting the required number of species.
     output$n_species_slider <- renderUI({
         sliderInput(
             "n_species",
             "Required number of species per gene",
             min = 0,
-            max = if (input$species == "all") {
-                nrow(species)
-            } else {
-                length(species_ids_replicative)
-            },
+            max = length(preset()$species_ids),
             step = 1,
             value = 10
         )
@@ -26,12 +24,7 @@ server <- function(input, output, session) {
 
     # Compute the results according to the preset.
     analysis <- reactive({
-        # Select the preset.
-        preset <- if (input$species == "all") {
-            preset_all_species
-        } else {
-            preset_replicative_species
-        }
+        preset <- preset()
 
         # Perform the analysis cached based on the preset's hash.
         results <- withProgress(
@@ -133,18 +126,13 @@ server <- function(input, output, session) {
 
         gene_ids <- results[input$genes_rows_selected, gene]
         genes <- genes[id %chin% gene_ids]
-
-        species <- if (input$species == "all") {
-            species
-        } else {
-            species[replicative == TRUE]
-        }
+        species <- species[id %chin% preset()$species_ids]
 
         scatter_plot(results, species, genes)
     })
 
     output$assessment_synopsis <- renderText({
-        reference_gene_ids <- genes[suggested | verified == TRUE, id]
+        reference_gene_ids <- preset()$reference_gene_ids
 
         included_reference_count <- results_filtered()[
             gene %chin% reference_gene_ids,
@@ -184,7 +172,7 @@ server <- function(input, output, session) {
     output$rank_plot <- plotly::renderPlotly({
         rank_plot(
             results(),
-            genes[suggested | verified == TRUE, id],
+            preset()$reference_gene_ids,
             input$cutoff / 100
         )
     })

R/ui.R

@@ -5,15 +5,8 @@ ui <- fluidPage(
     sidebarLayout(
         sidebarPanel(
             width = 3,
+            preset_editor_ui("preset_editor"),
             h3("Filter criteria"),
-            selectInput(
-                "species",
-                "Species to include",
-                choices = list(
-                    "Replicatively aging" = "replicative",
-                    "All qualified" = "all"
-                )
-            ),
             uiOutput("n_species_slider"),
             sliderInput(
                 "cutoff",