From 11c125465d9364530b72270712e4e023b0d987eb Mon Sep 17 00:00:00 2001 From: Elias Projahn Date: Sun, 23 Jan 2022 19:46:17 +0100 Subject: [PATCH] Refactor input page and handle preset errors --- R/input_page.R | 102 ++++++++++++++++++++++++++++++++++++++++++++++ R/preset_editor.R | 102 ++++++++++++---------------------------------- R/server.R | 21 ++-------- R/ui.R | 16 +------- 4 files changed, 131 insertions(+), 110 deletions(-) create mode 100644 R/input_page.R diff --git a/R/input_page.R b/R/input_page.R new file mode 100644 index 0000000..0563290 --- /dev/null +++ b/R/input_page.R @@ -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 + ) + }) +} diff --git a/R/preset_editor.R b/R/preset_editor.R index 0d98612..5500040 100644 --- a/R/preset_editor.R +++ b/R/preset_editor.R @@ -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 }) } diff --git a/R/server.R b/R/server.R index 06118fa..b0df4f6 100644 --- a/R/server.R +++ b/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) diff --git a/R/ui.R b/R/ui.R index 3712710..d80e34b 100644 --- a/R/ui.R +++ b/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",