mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 03:07:24 +01:00
Refactor input page and handle preset errors
This commit is contained in:
parent
aa4c655c53
commit
11c125465d
4 changed files with 131 additions and 110 deletions
102
R/input_page.R
Normal file
102
R/input_page.R
Normal file
|
|
@ -0,0 +1,102 @@
|
|||
#' Create the UI for the input page.
|
||||
#' @noRd
|
||||
input_page_ui <- function(id) {
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
preset_editor_ui(NS(id, "preset_editor")),
|
||||
tabsetPanel(
|
||||
id = NS(id, "apply_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "show",
|
||||
actionButton(
|
||||
NS(id, "apply_button"),
|
||||
"Perform analysis",
|
||||
class = "btn-primary",
|
||||
style = "margin-top: 16px; margin-bottom: 16px"
|
||||
)
|
||||
)
|
||||
),
|
||||
comparison_editor_ui(NS(id, "comparison_editor"))
|
||||
),
|
||||
mainPanel(
|
||||
width = 9,
|
||||
plotly::plotlyOutput(
|
||||
NS(id, "positions_plot"),
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Application logic for the input page.
|
||||
#'
|
||||
#' @param id ID for namespacing the inputs and outputs.
|
||||
#' @return A list containing two reactives: the `preset` for the analysis and
|
||||
#' the `comparison_gene_ids`.
|
||||
#'
|
||||
#' @noRd
|
||||
input_page_server <- function(id) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
current_preset <- reactiveVal(
|
||||
geposan::preset(genes[verified | suggested == TRUE, id])
|
||||
)
|
||||
|
||||
potential_preset <- preset_editor_server("preset_editor")
|
||||
|
||||
comparison_gene_ids <- comparison_editor_server(
|
||||
"comparison_editor",
|
||||
current_preset
|
||||
)
|
||||
|
||||
output$positions_plot <- plotly::renderPlotly({
|
||||
preset <- potential_preset()
|
||||
|
||||
if (is.null(preset)) {
|
||||
NULL
|
||||
} else {
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_positions(preset$species_ids, gene_sets)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
if (is.null(potential_preset()) |
|
||||
rlang::hash(potential_preset()) ==
|
||||
rlang::hash(current_preset())) {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
} else {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "show"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
current_preset(potential_preset())
|
||||
}) |> bindEvent(input$apply_button)
|
||||
|
||||
list(
|
||||
preset = current_preset,
|
||||
comparison_gene_ids = comparison_gene_ids
|
||||
)
|
||||
})
|
||||
}
|
||||
|
|
@ -1,4 +1,9 @@
|
|||
# Create a preset editor.
|
||||
#' Create the UI for a preset editor.
|
||||
#'
|
||||
#' @param id ID for namespacing.
|
||||
#' @return The UI elements.
|
||||
#'
|
||||
#' @noRd
|
||||
preset_editor_ui <- function(id) {
|
||||
verticalLayout(
|
||||
h3("Inputs"),
|
||||
|
|
@ -47,29 +52,17 @@ preset_editor_ui <- function(id) {
|
|||
label = "Enter reference genes",
|
||||
height = "250px"
|
||||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "apply_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "show",
|
||||
actionButton(
|
||||
NS(id, "apply_button"),
|
||||
"Perform analysis",
|
||||
class = "btn-primary",
|
||||
style = "margin-top: 16px; margin-bottom: 16px"
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
# Create a server for the preset editor.
|
||||
#
|
||||
# @param id ID for namespacing the inputs and outputs.
|
||||
#
|
||||
# @return A reactive containing the preset.
|
||||
#' Application logic for the preset editor.
|
||||
#'
|
||||
#' @param id ID for namespacing the inputs and outputs.
|
||||
#' @return A reactive containing the preset or `NULL`, if the input data doesn't
|
||||
#' result in a valid one.
|
||||
#'
|
||||
#' @noRd
|
||||
preset_editor_server <- function(id) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
species_choices <- geposan::species$id
|
||||
|
|
@ -82,17 +75,12 @@ preset_editor_server <- function(id) {
|
|||
server = TRUE
|
||||
)
|
||||
|
||||
current_preset <- reactiveVal(geposan::preset(
|
||||
genes[suggested | verified == TRUE, id]
|
||||
))
|
||||
|
||||
# Reactive containing the latest valid set of reference genes.
|
||||
reference_gene_ids <- reactiveVal(
|
||||
genes[verified | suggested == TRUE, id]
|
||||
)
|
||||
|
||||
observeEvent(c(input$reference_genes, input$custom_reference_genes), {
|
||||
if (input$reference_genes == "custom") {
|
||||
reactive({
|
||||
reference_gene_ids <- if (input$reference_genes == "tpeold") {
|
||||
genes[verified | suggested == TRUE, id]
|
||||
} else if (input$reference_genes == "verified") {
|
||||
genes[verified == TRUE, id]
|
||||
} else {
|
||||
inputs <- strsplit(input$custom_reference_genes, "\\s+")[[1]]
|
||||
|
||||
gene_ids <- if (input$identifier_type == "hgnc") {
|
||||
|
|
@ -100,20 +88,8 @@ preset_editor_server <- function(id) {
|
|||
} else {
|
||||
geposan::genes[id %chin% inputs, id]
|
||||
}
|
||||
|
||||
if (length(gene_ids) >= 5) {
|
||||
reference_gene_ids(gene_ids)
|
||||
}
|
||||
} else {
|
||||
reference_gene_ids(if (input$reference_genes == "tpeold") {
|
||||
genes[verified | suggested == TRUE, id]
|
||||
} else if (input$reference_genes == "verified") {
|
||||
genes[verified == TRUE, id]
|
||||
})
|
||||
}
|
||||
})
|
||||
|
||||
new_preset <- reactive({
|
||||
species_ids <- if (input$species == "replicative") {
|
||||
species_ids_replicative
|
||||
} else if (input$species == "all") {
|
||||
|
|
@ -122,41 +98,13 @@ preset_editor_server <- function(id) {
|
|||
input$custom_species
|
||||
}
|
||||
|
||||
geposan::preset(
|
||||
reference_gene_ids(),
|
||||
methods = methods,
|
||||
species_ids = species_ids,
|
||||
gene_ids = genes$id
|
||||
tryCatch(
|
||||
geposan::preset(
|
||||
reference_gene_ids,
|
||||
species_ids = species_ids
|
||||
),
|
||||
error = function(err) NULL
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(
|
||||
{ # nolint
|
||||
current_preset()
|
||||
new_preset()
|
||||
},
|
||||
{ # nolint
|
||||
if (rlang::hash(new_preset()) !=
|
||||
rlang::hash(current_preset())) {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "show"
|
||||
)
|
||||
} else {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
observeEvent(input$apply_button, {
|
||||
current_preset(new_preset())
|
||||
})
|
||||
|
||||
current_preset
|
||||
})
|
||||
}
|
||||
|
|
|
|||
21
R/server.R
21
R/server.R
|
|
@ -8,7 +8,9 @@ js_link <- DT::JS("function(row, data) {
|
|||
}")
|
||||
|
||||
server <- function(input, output, session) {
|
||||
preset <- preset_editor_server("preset_editor")
|
||||
input_reactives <- input_page_server("input_page")
|
||||
preset <- input_reactives$preset
|
||||
comparison_gene_ids <- input_reactives$comparison_gene_ids
|
||||
|
||||
# Compute the results according to the preset.
|
||||
analysis <- reactive({
|
||||
|
|
@ -48,23 +50,6 @@ server <- function(input, output, session) {
|
|||
# Server for the detailed results panel.
|
||||
results_server("results", results_filtered)
|
||||
|
||||
comparison_gene_ids <- comparison_editor_server("comparison_editor", preset)
|
||||
|
||||
output$scatter <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_positions(preset$species_ids, gene_sets)
|
||||
})
|
||||
|
||||
output$rank_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
|
|
|
|||
16
R/ui.R
16
R/ui.R
|
|
@ -11,21 +11,7 @@ ui <- div(
|
|||
selected = "Results",
|
||||
tabPanel(
|
||||
"Input data",
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
preset_editor_ui("preset_editor"),
|
||||
comparison_editor_ui("comparison_editor")
|
||||
),
|
||||
mainPanel(
|
||||
width = 9,
|
||||
plotly::plotlyOutput(
|
||||
"scatter",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
input_page_ui("input_page")
|
||||
),
|
||||
tabPanel(
|
||||
"Results",
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue