geposanui/R/filters.R

65 lines
1.7 KiB
R
Raw Normal View History

2021-11-02 13:41:03 +01:00
# Construct UI for the filter editor.
filters_ui <- function(id) {
verticalLayout(
h3("Filter criteria"),
2021-11-02 14:28:04 +01:00
selectInput(
NS(id, "method"),
"Filter method",
choices = list(
"Cut-off score" = "score",
"Maximum number of genes" = "rank"
)
2021-11-02 13:41:03 +01:00
),
2021-11-02 14:28:04 +01:00
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,
2021-12-08 14:38:38 +01:00
value = 75
2021-11-02 14:28:04 +01:00
)
2021-11-02 13:41:03 +01:00
),
2021-11-02 14:28:04 +01:00
tabPanelBody(
value = "rank",
sliderInput(
NS(id, "rank"),
label = "Maximum rank",
min = 0,
max = 5000,
step = 50,
value = 2500
)
)
2021-11-02 13:41:03 +01:00
)
)
}
# Construct server for the filter editor.
#
2021-11-02 14:28:04 +01:00
# @param results The results to be filtered.
2021-11-02 13:41:03 +01:00
#
2021-11-02 14:28:04 +01:00
# @return A reactive containing the filtered results.
filters_server <- function(id, results) {
2021-11-02 13:41:03 +01:00
moduleServer(id, function(input, output, session) {
2021-11-02 14:28:04 +01:00
observeEvent(input$method, {
updateTabsetPanel(session, "sliders", selected = input$method)
2021-11-02 13:41:03 +01:00
})
2021-11-02 14:28:04 +01:00
reactive({
results <- results()
2021-11-02 13:41:03 +01:00
2021-11-02 14:28:04 +01:00
if (input$method == "score") {
results[score >= input$score / 100]
} else if (input$method == "rank") {
results[rank <= input$rank]
2021-11-02 13:41:03 +01:00
}
})
})
}