diff --git a/R/filters.R b/R/filters.R index 1abae8e..6859583 100644 --- a/R/filters.R +++ b/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] + } }) }) } diff --git a/R/server.R b/R/server.R index d90037e..30302ef 100644 --- a/R/server.R +++ b/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({ - filters <- filters() - - if (filters$filter == "score") { - results()[score >= filters$cut_off_score / 100] - } else { - results()[rank <= filters$max_rank] - } - }) + results_filtered <- filters_server("filters", results) output$genes <- DT::renderDT({ method_ids <- sapply(methods, function(method) method$id) diff --git a/R/ui.R b/R/ui.R index ab9263e..e627705 100644 --- a/R/ui.R +++ b/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") ),