From 9b9109b38920e1f6e8e6ca18b01da39a9344d6c7 Mon Sep 17 00:00:00 2001 From: Elias Projahn Date: Mon, 15 Nov 2021 10:22:28 +0100 Subject: [PATCH] preset editor: Simplify and add more options --- R/data.R | 23 ------- R/methods.R | 5 +- R/preset_editor.R | 149 ++++++++++++++++++++++++++++++++++++---------- R/server.R | 4 +- R/ui.R | 2 +- 5 files changed, 124 insertions(+), 59 deletions(-) diff --git a/R/data.R b/R/data.R index 0d7e897..67aa4e0 100644 --- a/R/data.R +++ b/R/data.R @@ -106,26 +106,3 @@ method_ids <- sapply(methods, function(method) method$id) # Names of methods for geposan. method_names <- sapply(methods, function(method) method$name) - -# Gene IDs of known or suggested TPE-OLD genes. -genes_tpe_old <- genes[suggested | verified == TRUE, id] - -# Species IDs for replicatively aging species. -species_replicative <- species[replicative == TRUE, id] - -# Preset for [geposan] including all species and TPE-OLD genes for reference. -preset_all_species <- geposan::preset( - methods = method_ids, - species_ids = species$id, - gene_ids = genes$id, - reference_gene_ids = genes_tpe_old -) - -# Preset for [geposan] including only replicatively aging species as well as -# TPE-OLD genes for reference. -preset_replicative_species <- geposan::preset( - methods = method_ids, - species_ids = species_replicative, - gene_ids = genes$id, - reference_gene_ids = genes_tpe_old -) diff --git a/R/methods.R b/R/methods.R index e901230..fedc4d0 100644 --- a/R/methods.R +++ b/R/methods.R @@ -53,6 +53,7 @@ methods_ui <- function(id) { methods_server <- function(id, analysis, min_n_species) { moduleServer(id, function(input, output, session) { observeEvent(input$optimize_button, { + analysis <- analysis() method_ids <- NULL # Only include activated methods. @@ -63,9 +64,9 @@ methods_server <- function(id, analysis, min_n_species) { } weights <- geposan::optimal_weights( - analysis(), + analysis, method_ids, - genes_tpe_old, + analysis$preset$reference_gene_ids, target = input$target, min_n_species = min_n_species() ) diff --git a/R/preset_editor.R b/R/preset_editor.R index 3f0e996..72f2059 100644 --- a/R/preset_editor.R +++ b/R/preset_editor.R @@ -8,10 +8,10 @@ preset_editor_ui <- function(id) { names(gene_choices) <- known_genes$name verticalLayout( - h3("Preset"), + h3("Inputs"), selectInput( - NS(id, "preset"), - "Default presets", + NS(id, "species"), + "Species to include", choices = list( "Replicatively aging species" = "replicative", "All species" = "all", @@ -19,33 +19,54 @@ preset_editor_ui <- function(id) { ) ), tabsetPanel( - id = NS(id, "customization"), + id = NS(id, "custom_species_panel"), type = "hidden", - tabPanelBody(value = "none"), + tabPanelBody(value = "hide"), tabPanelBody( - value = "custom", + value = "show", shinyWidgets::pickerInput( - inputId = NS(id, "species"), - label = "Included species", + inputId = NS(id, "custom_species"), choices = species_choices, - selected = species_replicative, options = list( "actions-box" = TRUE, "live-search" = TRUE ), multiple = TRUE - ), + ) + ) + ), + selectInput( + NS(id, "reference_genes"), + "Reference genes", + choices = list( + "Verified or suggested TPE-OLD genes" = "tpeold", + "Only verified TPE-OLD genes" = "verified", + "Customize" = "custom" + ) + ), + tabsetPanel( + id = NS(id, "custom_reference_genes_panel"), + type = "hidden", + tabPanelBody(value = "hide"), + tabPanelBody( + value = "show", shinyWidgets::pickerInput( - inputId = NS(id, "reference_genes"), - label = "Reference genes", + inputId = NS(id, "custom_reference_genes"), choices = gene_choices, - selected = genes_tpe_old, options = list( "actions-box" = TRUE, "live-search" = TRUE ), multiple = TRUE - ), + ) + ) + ), + tabsetPanel( + id = NS(id, "apply_panel"), + type = "hidden", + tabPanelBody(value = "hide"), + tabPanelBody( + value = "show", actionButton( NS(id, "apply_button"), "Perform analysis", @@ -64,31 +85,97 @@ preset_editor_ui <- function(id) { # @return A reactive containing the preset. preset_editor_server <- function(id) { moduleServer(id, function(input, output, session) { - result <- reactiveVal(preset_replicative_species) + current_preset <- reactiveVal(geposan::preset( + methods = method_ids, + species_ids = species[replicative == TRUE, id], + gene_ids = genes$id, + reference_gene_ids = genes[suggested | verified == TRUE, id] + )) - observeEvent(input$preset, { - panel <- if (input$preset == "replicative") { - result(preset_replicative_species) - "none" - } else if (input$preset == "all") { - result(preset_all_species) - "none" + observeEvent(input$species, { + if (input$species == "custom") { + updateTabsetPanel( + session, + "custom_species_panel", + selected = "show" + ) } else { - "custom" + updateTabsetPanel( + session, + "custom_species_panel", + selected = "hide" + ) + } + }) + + observeEvent(input$reference_genes, { + if (input$reference_genes == "custom") { + updateTabsetPanel( + session, + "custom_reference_genes_panel", + selected = "show" + ) + } else { + updateTabsetPanel( + session, + "custom_reference_genes_panel", + selected = "hide" + ) + } + }) + + new_preset <- reactive({ + species_ids <- if (input$species == "replicative") { + species[replicative == TRUE, id] + } else if (input$species == "all") { + species$id + } else { + input$custom_species } - updateTabsetPanel(session, "customization", selected = panel) + reference_gene_ids <- if (input$reference_genes == "tpeold") { + genes[verified | suggested == TRUE, id] + } else if (input$reference_genes == "verified") { + genes[verified == TRUE, id] + } else { + input$custom_reference_genes + } + + geposan::preset( + methods = method_ids, + species_ids = species_ids, + gene_ids = genes$id, + reference_gene_ids = reference_gene_ids + ) }) + 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, { - result(geposan::preset( - methods = method_ids, - species_ids = input$species, - gene_ids = genes$id, - reference_gene_ids = input$reference_genes - )) + current_preset(new_preset()) }) - result + current_preset }) } diff --git a/R/server.R b/R/server.R index 51d5b97..b1d5228 100644 --- a/R/server.R +++ b/R/server.R @@ -157,7 +157,7 @@ server <- function(input, output, session) { geposan::plot_scores( ranking(), gene_sets = list(preset()$reference_gene_ids), - labels = "TPE-OLD genes", + labels = "Reference genes", max_rank = results_filtered()[, max(rank)] ) }) @@ -166,7 +166,7 @@ server <- function(input, output, session) { geposan::plot_boxplot( ranking(), gene_sets = list(preset()$reference_gene_ids), - labels = "TPE-OLD genes" + labels = "Reference genes" ) }) diff --git a/R/ui.R b/R/ui.R index d637b9e..11a234b 100644 --- a/R/ui.R +++ b/R/ui.R @@ -6,6 +6,7 @@ ui <- fluidPage( sidebarPanel( width = 3, preset_editor_ui("preset_editor"), + filters_ui("filters"), sliderInput( "n_species", "Required number of species per gene", @@ -14,7 +15,6 @@ ui <- fluidPage( step = 1, value = 10 ), - filters_ui("filters"), methods_ui("methods") ), mainPanel(