# Create a preset editor. preset_editor_ui <- function(id) { species_choices <- species$id names(species_choices) <- species$name known_genes <- genes[name != ""] gene_choices <- known_genes$id names(gene_choices) <- known_genes$name verticalLayout( h3("Inputs"), selectInput( NS(id, "species"), "Species to include", choices = list( "Replicatively aging species" = "replicative", "All species" = "all", "Customize" = "custom" ) ), tabsetPanel( id = NS(id, "custom_species_panel"), type = "hidden", tabPanelBody(value = "hide"), tabPanelBody( value = "show", shinyWidgets::pickerInput( inputId = NS(id, "custom_species"), choices = species_choices, options = list( "actions-box" = TRUE, "live-search" = TRUE ), multiple = TRUE ) ) ), sliderInput( NS(id, "n_species"), "Required number of species per gene", min = 0, max = 18, step = 1, value = 10 ), 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, "custom_reference_genes"), choices = gene_choices, 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", 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. preset_editor_server <- function(id) { moduleServer(id, function(input, output, session) { current_preset <- reactiveVal(geposan::preset( methods = method_ids, species_ids = species[replicative == TRUE, id], gene_ids = genes$id, min_n_species = 10, reference_gene_ids = genes[suggested | verified == TRUE, id] )) observeEvent(input$species, { if (input$species == "custom") { updateTabsetPanel( session, "custom_species_panel", selected = "show" ) } else { updateTabsetPanel( session, "custom_species_panel", selected = "hide" ) } }) species_ids <- reactive({ if (input$species == "replicative") { species[replicative == TRUE, id] } else if (input$species == "all") { species$id } else { input$custom_species } }) observeEvent(species_ids(), { updateSliderInput( session, "n_species", max = length(species_ids()) ) }) 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({ 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, min_n_species = input$n_species, 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, { current_preset(new_preset()) }) current_preset }) }