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")),
-        checkboxInput(
-            NS(id, "filter_score"),
-            span(
-                "Cut-off score",
-                style = "font-weight: bold"
+        selectInput(
+            NS(id, "method"),
+            "Filter method",
+            choices = list(
+                "Cut-off score" = "score",
+                "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
-        ),
-        sliderInput(
-            NS(id, "cut_off_score"),
-            label = NULL,
-            post = "%",
-            min = 0,
-            max = 100,
-            step = 1,
-            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
+            tabPanelBody(
+                value = "rank",
+                sliderInput(
+                    NS(id, "rank"),
+                    label = "Maximum rank",
+                    min = 0,
+                    max = 5000,
+                    step = 50,
+                    value = 2500
+                )
+            )
         )
     )
 }
 
 # 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`
-#   and `max_rank` as well as the name of the filter to apply (`filter`).
-filters_server <- function(id, preset) {
+# @return A reactive containing the filtered results.
+filters_server <- function(id, results) {
     moduleServer(id, function(input, output, session) {
-        output$n_species_slider <- renderUI({
-            sliderInput(
-                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")
-            }
+        observeEvent(input$method, {
+            updateTabsetPanel(session, "sliders", selected = input$method)
         })
 
         reactive({
-            list(
-                n_species = input$n_species,
-                filter = filter(),
-                cut_off_score = input$cut_off_score,
-                max_rank = input$max_rank
-            )
+            results <- results()
+
+            if (input$method == "score") {
+                results[score >= input$score / 100]
+            } else if (input$method == "rank") {
+                results[rank <= input$rank]
+            }
         })
     })
 }