filters: Improve user interface

R/filters.R

@@ -2,89 +2,63 @@
 filters_ui <- function(id) {
     verticalLayout(
         h3("Filter criteria"),
-        uiOutput(NS(id, "n_species_slider")),
+        selectInput(
-        checkboxInput(
+            NS(id, "method"),
-            NS(id, "filter_score"),
+            "Filter method",
-            span(
+            choices = list(
-                "Cut-off score",
+                "Cut-off score" = "score",
-                style = "font-weight: bold"
+                "Maximum number of genes" = "rank"
+            )
+        ),
+        tabsetPanel(
+            id = NS(id, "sliders"),
+            type = "hidden",
+            tabPanelBody(
+                value = "score",
+                sliderInput(
+                    NS(id, "score"),
+                    label = "Cut-off score",
+                    post = "%",
+                    min = 0,
+                    max = 100,
+                    step = 1,
+                    value = 60
+                )
             ),
-            value = TRUE
+            tabPanelBody(
-        ),
+                value = "rank",
-        sliderInput(
+                sliderInput(
-            NS(id, "cut_off_score"),
+                    NS(id, "rank"),
-            label = NULL,
+                    label = "Maximum rank",
-            post = "%",
+                    min = 0,
-            min = 0,
+                    max = 5000,
-            max = 100,
+                    step = 50,
-            step = 1,
+                    value = 2500
-            value = 50
+                )
-        ),
+            )
-        checkboxInput(
-            NS(id, "filter_rank"),
-            span(
-                "Maximum number of genes",
-                style = "font-weight: bold"
-            ),
-            value = FALSE
-        ),
-        sliderInput(
-            NS(id, "max_rank"),
-            label = NULL,
-            min = 0,
-            max = 5000,
-            step = 50,
-            value = 2000
         )
     )
 }
 
 # Construct server for the filter editor.
 #
-# @param preset A reactive containing the preset to apply.
+# @param results The results to be filtered.
 #
-# @return A reactive containing the filter values `n_species`, `cut_off_score`
+# @return A reactive containing the filtered results.
-#   and `max_rank` as well as the name of the filter to apply (`filter`).
+filters_server <- function(id, results) {
-filters_server <- function(id, preset) {
     moduleServer(id, function(input, output, session) {
-        output$n_species_slider <- renderUI({
+        observeEvent(input$method, {
-            sliderInput(
+            updateTabsetPanel(session, "sliders", selected = input$method)
-                session$ns("n_species"),
-                "Required number of species per gene",
-                min = 0,
-                max = length(preset()$species_ids),
-                step = 1,
-                value = 10
-            )
-        })
-
-        filter <- reactiveVal("score")
-
-        observeEvent(input$filter_score, {
-            if (input$filter_score) {
-                updateCheckboxInput(session, "filter_rank", value = FALSE)
-                shinyjs::enable("cut_off_score")
-                shinyjs::disable("max_rank")
-                filter("score")
-            }
-        })
-
-        observeEvent(input$filter_rank, {
-            if (input$filter_rank) {
-                updateCheckboxInput(session, "filter_score", value = FALSE)
-                shinyjs::enable("max_rank")
-                shinyjs::disable("cut_off_score")
-                filter("rank")
-            }
         })
 
         reactive({
-            list(
+            results <- results()
-                n_species = input$n_species,
+
-                filter = filter(),
+            if (input$method == "score") {
-                cut_off_score = input$cut_off_score,
+                results[score >= input$score / 100]
-                max_rank = input$max_rank
+            } else if (input$method == "rank") {
-            )
+                results[rank <= input$rank]
+            }
         })
     })
 }

R/server.R

@@ -9,7 +9,17 @@ js_link <- DT::JS("function(row, data) {
 
 server <- function(input, output, session) {
     preset <- preset_editor_server("preset_editor")
-    filters <- filters_server("filters", preset)
+
+    output$n_species_slider <- renderUI({
+        sliderInput(
+            "n_species",
+            "Required number of species per gene",
+            min = 0,
+            max = length(preset()$species_ids),
+            step = 1,
+            value = 10
+        )
+    })
 
     # Compute the results according to the preset.
     analysis <- reactive({
@@ -43,22 +53,14 @@ server <- function(input, output, session) {
         setkey(genes_n_species, gene)
 
         # Exclude genes with too few species.
-        results[genes_n_species[gene, n_species] >= filters()$n_species]
+        results[genes_n_species[gene, n_species] >= input$n_species]
     })
 
     # Rank the results.
     results <- methods_server("methods", analysis)
 
     # Apply the filters.
-    results_filtered <- reactive({
+    results_filtered <- filters_server("filters", results)
-        filters <- filters()
-
-        if (filters$filter == "score") {
-            results()[score >= filters$cut_off_score / 100]
-        } else {
-            results()[rank <= filters$max_rank]
-        }
-    })
 
     output$genes <- DT::renderDT({
         method_ids <- sapply(methods, function(method) method$id)

R/ui.R

@@ -6,6 +6,7 @@ ui <- fluidPage(
         sidebarPanel(
             width = 3,
             preset_editor_ui("preset_editor"),
+            uiOutput("n_species_slider"),
             filters_ui("filters"),
             methods_ui("methods")
         ),