johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-26 11:17:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

filters: Allow filter ranges for percentiles etc

Browse source
This commit is contained in:
Elias Projahn 2022-05-30 14:21:49 +02:00
parent a00d038361
commit c7ccaa657b
1 changed files with 26 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

39
R/filters.R
View file

@ -6,9 +6,9 @@ filters_ui <- function(id) {
NS(id, "method"), NS(id, "method"),
"Filter method", "Filter method",
choices = list( choices = list(
"Percentile" = "percentile", "Percentiles" = "percentile",
"Cut-off score" = "score", "Scores" = "score",
"Maximum number of genes" = "rank", "Ranks" = "rank",
"None" = "none" "None" = "none"
) )
), ),
@ -19,35 +19,35 @@ filters_ui <- function(id) {
value = "percentile", value = "percentile",
sliderInput( sliderInput(
NS(id, "percentile"), NS(id, "percentile"),
label = "Minimum percentile", label = "Included percentiles",
post = "%", post = "%",
min = 0, min = 0,
max = 100, max = 100,
step = 1, step = 1,
value = 95 value = c(95, 100)
) )
), ),
tabPanelBody( tabPanelBody(
value = "score", value = "score",
sliderInput( sliderInput(
NS(id, "score"), NS(id, "score"),
label = "Cut-off score", label = "Included scores",
post = "%", post = "%",
min = 0, min = 0,
max = 100, max = 100,
step = 1, step = 1,
value = 75 value = c(90, 100)
) )
), ),
tabPanelBody( tabPanelBody(
value = "rank", value = "rank",
sliderInput( sliderInput(
NS(id, "rank"), NS(id, "rank"),
label = "Maximum rank", label = "Included ranks",
min = 0, min = 1,
max = 2000, max = 2000,
step = 10, step = 10,
value = 1000 value = c(1, 1000)
) )
), ),
tabPanelBody( tabPanelBody(
@ -76,16 +76,29 @@ filters_server <- function(id, results) {
updateTabsetPanel(session, "sliders", selected = input$method) updateTabsetPanel(session, "sliders", selected = input$method)
}) })
observeEvent(results(), {
updateSliderInput(session, "rank", max = nrow(results()))
})
reactive({ reactive({
results <- results() results <- results()
results_prefiltered <- if (input$method == "percentile") { results_prefiltered <- if (input$method == "percentile") {
n_ranks <- nrow(results) n_ranks <- nrow(results)
results[rank <= (1 - (input$percentile / 100)) * n_ranks] results[
rank <= (1 - (input$percentile[1] / 100)) * n_ranks &
rank >= (1 - (input$percentile[2] / 100)) * n_ranks
]
} else if (input$method == "score") { } else if (input$method == "score") {
results[score >= input$score / 100] results[
score >= input$score[1] / 100 &
score <= input$score[2] / 100
]
} else if (input$method == "rank") { } else if (input$method == "rank") {
results[rank <= input$rank] results[
rank >= input$rank[1] &
rank <= input$rank[2]
]
} else { } else {
results results
} }