johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-25 20:07:23 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Move filtering to tabs that use it

Browse source
This commit is contained in:
Elias Projahn 2022-08-18 11:09:22 +02:00
parent 9fb6ca428e
commit 447fdfab4f
4 changed files with 87 additions and 85 deletions
Download patch file Download diff file Expand all files Collapse all files

8
R/details.R
View file

@ -2,6 +2,7 @@
#' @noRd
details_ui <- function(id) {
verticalLayout(
filters_ui(NS(id, "filters")),
div(
style = "margin-top: 16px",
splitLayout(
@ -20,12 +21,13 @@ details_ui <- function(id) {
#' Server for the detailed results panel.
#'
#' @param options Global options for the application.
#' @param filtered_results A reactive containing the prefiltered results to be
#' displayed.
#' @param results A reactive containing the results to be displayed.
#'
#' @noRd
details_server <- function(id, options, filtered_results) {
details_server <- function(id, options, results) {
moduleServer(id, function(input, output, session) {
filtered_results <- filters_server("filters", results)
output$copy <- renderUI({
results <- filtered_results()

133
R/filters.R
View file

@ -1,66 +1,69 @@
# Construct UI for the filter editor.
filters_ui <- function(id) {
verticalLayout(
h3("Filter criteria"),
selectInput(
NS(id, "method"),
"Filter method",
choices = list(
"Percentiles" = "percentile",
"Scores" = "score",
"Ranks" = "rank",
"None" = "none"
div(
class = "well",
style = "margin-top: 24px; margin-bottom: 16px; padding-top: 24px;",
verticalLayout(
radioButtons(
NS(id, "method"),
label = NULL,
choices = list(
"Filter percentiles" = "percentile",
"Filter scores" = "score",
"Filter ranks" = "rank",
"No filtering" = "none"
),
inline = TRUE
),
tabsetPanel(
id = NS(id, "sliders"),
type = "hidden",
tabPanelBody(
value = "percentile",
sliderInput(
NS(id, "percentile"),
label = NULL,
post = "%",
min = 0,
max = 100,
step = 1,
value = c(95, 100)
)
),
tabPanelBody(
value = "score",
sliderInput(
NS(id, "score"),
label = NULL,
min = 0,
max = 1,
step = 0.01,
value = c(0.9, 1.0)
)
),
tabPanelBody(
value = "rank",
sliderInput(
NS(id, "rank"),
label = NULL,
min = 1,
max = 2000,
step = 10,
value = c(1, 1000)
)
),
tabPanelBody(
value = "none"
)
),
sliderInput(
NS(id, "distance"),
label = "Distance to telomeres",
post = " Mbp",
min = 0,
max = 150,
value = c(0, 150)
)
),
tabsetPanel(
id = NS(id, "sliders"),
type = "hidden",
tabPanelBody(
value = "percentile",
sliderInput(
NS(id, "percentile"),
label = "Included percentiles",
post = "%",
min = 0,
max = 100,
step = 1,
value = c(95, 100)
)
),
tabPanelBody(
value = "score",
sliderInput(
NS(id, "score"),
label = "Included scores",
post = "%",
min = 0,
max = 100,
step = 1,
value = c(90, 100)
)
),
tabPanelBody(
value = "rank",
sliderInput(
NS(id, "rank"),
label = "Included ranks",
min = 1,
max = 2000,
step = 10,
value = c(1, 1000)
)
),
tabPanelBody(
value = "none"
)
),
sliderInput(
NS(id, "distance"),
label = "Distance to telomeres",
post = " Mbp",
min = 0,
max = 150,
value = c(0, 150)
)
)
}
@ -90,15 +93,9 @@ filters_server <- function(id, results) {
rank >= (1 - (input$percentile[2] / 100)) * n_ranks
]
} else if (input$method == "score") {
results[
score >= input$score[1] / 100 &
score <= input$score[2] / 100
]
results[score >= input$score[1] & score <= input$score[2]]
} else if (input$method == "rank") {
results[
rank >= input$rank[1] &
rank <= input$rank[2]
]
results[rank >= input$rank[1] & rank <= input$rank[2]]
} else {
results
}

16
R/gsea.R
View file

@ -2,6 +2,12 @@
#' @noRd
gsea_ui <- function(id) {
verticalLayout(
filters_ui(NS(id, "filters")),
actionButton(
NS(id, "gsea_run"),
"Update analysis",
class = "btn-primary"
),
div(
style = "margin-top: 16px",
plotly::plotlyOutput(NS(id, "plot")),
@ -21,6 +27,8 @@ gsea_ui <- function(id) {
#' @noRd
gsea_server <- function(id, ranking) {
moduleServer(id, function(input, output, session) {
ranking_filtered <- filters_server("filters", ranking)
gsea_analysis <- reactive({
withProgress(
message = "Querying g:Profiler",
@ -28,13 +36,15 @@ gsea_server <- function(id, ranking) {
{ # nolint
setProgress(0.2)
gprofiler2::gost(
ranking()[, gene],
custom_bg = NULL, # TODO
ranking_filtered()$gene,
custom_bg = ranking()$gene,
domain_scope = "custom_annotated"
)
}
)
}) |> bindCache(ranking())
}) |>
bindCache(ranking_filtered()) |>
bindEvent(input$gsea_run, ignoreNULL = FALSE)
output$plot <- plotly::renderPlotly({
gprofiler2::gostplot(

15
R/results.R
View file

@ -19,8 +19,7 @@ results_ui <- function(id, options) {
sidebarPanel(
width = 3,
comparison_editor_ui(NS(id, "comparison_editor"), options),
methods_ui(NS(id, "methods"), options),
filters_ui(NS(id, "filters"))
methods_ui(NS(id, "methods"), options)
),
mainPanel(
width = 9,
@ -150,10 +149,7 @@ results_ui <- function(id, options) {
),
tabPanel(
title = "g:Profiler",
div(
style = "margin-top: 16px",
gsea_ui(NS(id, "gsea"))
)
gsea_ui(NS(id, "gsea"))
)
)
)
@ -198,11 +194,8 @@ results_server <- function(id, options, analysis) {
)
})
# Apply the filters.
results_filtered <- filters_server("filters", results)
# Server for the detailed results panel.
details_server("results", options, results_filtered)
details_server("results", options, results)
output$rank_plot <- plotly::renderPlotly({
preset <- preset()
@ -403,7 +396,7 @@ results_server <- function(id, options, analysis) {
)
})
gsea_server("gsea", results_filtered)
gsea_server("gsea", results)
})
}