mirror of
				https://github.com/johrpan/geposanui.git
				synced 2025-10-26 19:27:24 +01:00 
			
		
		
		
	preset editor: Simplify and add more options
This commit is contained in:
		
							parent
							
								
									b5957262a3
								
							
						
					
					
						commit
						9b9109b389
					
				
					 5 changed files with 124 additions and 59 deletions
				
			
		
							
								
								
									
										23
									
								
								R/data.R
									
										
									
									
									
								
							
							
						
						
									
										23
									
								
								R/data.R
									
										
									
									
									
								
							|  | @ -106,26 +106,3 @@ method_ids <- sapply(methods, function(method) method$id) | ||||||
| 
 | 
 | ||||||
| # Names of methods for geposan. | # Names of methods for geposan. | ||||||
| method_names <- sapply(methods, function(method) method$name) | 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 |  | ||||||
| ) |  | ||||||
|  |  | ||||||
|  | @ -53,6 +53,7 @@ methods_ui <- function(id) { | ||||||
| methods_server <- function(id, analysis, min_n_species) { | methods_server <- function(id, analysis, min_n_species) { | ||||||
|     moduleServer(id, function(input, output, session) { |     moduleServer(id, function(input, output, session) { | ||||||
|         observeEvent(input$optimize_button, { |         observeEvent(input$optimize_button, { | ||||||
|  |             analysis <- analysis() | ||||||
|             method_ids <- NULL |             method_ids <- NULL | ||||||
| 
 | 
 | ||||||
|             # Only include activated methods. |             # Only include activated methods. | ||||||
|  | @ -63,9 +64,9 @@ methods_server <- function(id, analysis, min_n_species) { | ||||||
|             } |             } | ||||||
| 
 | 
 | ||||||
|             weights <- geposan::optimal_weights( |             weights <- geposan::optimal_weights( | ||||||
|                 analysis(), |                 analysis, | ||||||
|                 method_ids, |                 method_ids, | ||||||
|                 genes_tpe_old, |                 analysis$preset$reference_gene_ids, | ||||||
|                 target = input$target, |                 target = input$target, | ||||||
|                 min_n_species = min_n_species() |                 min_n_species = min_n_species() | ||||||
|             ) |             ) | ||||||
|  |  | ||||||
|  | @ -8,10 +8,10 @@ preset_editor_ui <- function(id) { | ||||||
|     names(gene_choices) <- known_genes$name |     names(gene_choices) <- known_genes$name | ||||||
| 
 | 
 | ||||||
|     verticalLayout( |     verticalLayout( | ||||||
|         h3("Preset"), |         h3("Inputs"), | ||||||
|         selectInput( |         selectInput( | ||||||
|             NS(id, "preset"), |             NS(id, "species"), | ||||||
|             "Default presets", |             "Species to include", | ||||||
|             choices = list( |             choices = list( | ||||||
|                 "Replicatively aging species" = "replicative", |                 "Replicatively aging species" = "replicative", | ||||||
|                 "All species" = "all", |                 "All species" = "all", | ||||||
|  | @ -19,33 +19,54 @@ preset_editor_ui <- function(id) { | ||||||
|             ) |             ) | ||||||
|         ), |         ), | ||||||
|         tabsetPanel( |         tabsetPanel( | ||||||
|             id = NS(id, "customization"), |             id = NS(id, "custom_species_panel"), | ||||||
|             type = "hidden", |             type = "hidden", | ||||||
|             tabPanelBody(value = "none"), |             tabPanelBody(value = "hide"), | ||||||
|             tabPanelBody( |             tabPanelBody( | ||||||
|                 value = "custom", |                 value = "show", | ||||||
|                 shinyWidgets::pickerInput( |                 shinyWidgets::pickerInput( | ||||||
|                     inputId = NS(id, "species"), |                     inputId = NS(id, "custom_species"), | ||||||
|                     label = "Included species", |  | ||||||
|                     choices = species_choices, |                     choices = species_choices, | ||||||
|                     selected = species_replicative, |  | ||||||
|                     options = list( |                     options = list( | ||||||
|                         "actions-box" = TRUE, |                         "actions-box" = TRUE, | ||||||
|                         "live-search" = TRUE |                         "live-search" = TRUE | ||||||
|                     ), |                     ), | ||||||
|                     multiple = 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( |                 shinyWidgets::pickerInput( | ||||||
|                     inputId = NS(id, "reference_genes"), |                     inputId = NS(id, "custom_reference_genes"), | ||||||
|                     label = "Reference genes", |  | ||||||
|                     choices = gene_choices, |                     choices = gene_choices, | ||||||
|                     selected = genes_tpe_old, |  | ||||||
|                     options = list( |                     options = list( | ||||||
|                         "actions-box" = TRUE, |                         "actions-box" = TRUE, | ||||||
|                         "live-search" = TRUE |                         "live-search" = TRUE | ||||||
|                     ), |                     ), | ||||||
|                     multiple = TRUE |                     multiple = TRUE | ||||||
|  |                 ) | ||||||
|  |             ) | ||||||
|         ), |         ), | ||||||
|  |         tabsetPanel( | ||||||
|  |             id = NS(id, "apply_panel"), | ||||||
|  |             type = "hidden", | ||||||
|  |             tabPanelBody(value = "hide"), | ||||||
|  |             tabPanelBody( | ||||||
|  |                 value = "show", | ||||||
|                 actionButton( |                 actionButton( | ||||||
|                     NS(id, "apply_button"), |                     NS(id, "apply_button"), | ||||||
|                     "Perform analysis", |                     "Perform analysis", | ||||||
|  | @ -64,31 +85,97 @@ preset_editor_ui <- function(id) { | ||||||
| # @return A reactive containing the preset. | # @return A reactive containing the preset. | ||||||
| preset_editor_server <- function(id) { | preset_editor_server <- function(id) { | ||||||
|     moduleServer(id, function(input, output, session) { |     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, { |         observeEvent(input$species, { | ||||||
|             panel <- if (input$preset == "replicative") { |             if (input$species == "custom") { | ||||||
|                 result(preset_replicative_species) |                 updateTabsetPanel( | ||||||
|                 "none" |                     session, | ||||||
|             } else if (input$preset == "all") { |                     "custom_species_panel", | ||||||
|                 result(preset_all_species) |                     selected = "show" | ||||||
|                 "none" |                 ) | ||||||
|             } else { |             } 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, { |         observeEvent(input$apply_button, { | ||||||
|             result(geposan::preset( |             current_preset(new_preset()) | ||||||
|                 methods = method_ids, |  | ||||||
|                 species_ids = input$species, |  | ||||||
|                 gene_ids = genes$id, |  | ||||||
|                 reference_gene_ids = input$reference_genes |  | ||||||
|             )) |  | ||||||
|         }) |         }) | ||||||
| 
 | 
 | ||||||
|         result |         current_preset | ||||||
|     }) |     }) | ||||||
| } | } | ||||||
|  |  | ||||||
|  | @ -157,7 +157,7 @@ server <- function(input, output, session) { | ||||||
|         geposan::plot_scores( |         geposan::plot_scores( | ||||||
|             ranking(), |             ranking(), | ||||||
|             gene_sets = list(preset()$reference_gene_ids), |             gene_sets = list(preset()$reference_gene_ids), | ||||||
|             labels = "TPE-OLD genes", |             labels = "Reference genes", | ||||||
|             max_rank = results_filtered()[, max(rank)] |             max_rank = results_filtered()[, max(rank)] | ||||||
|         ) |         ) | ||||||
|     }) |     }) | ||||||
|  | @ -166,7 +166,7 @@ server <- function(input, output, session) { | ||||||
|         geposan::plot_boxplot( |         geposan::plot_boxplot( | ||||||
|             ranking(), |             ranking(), | ||||||
|             gene_sets = list(preset()$reference_gene_ids), |             gene_sets = list(preset()$reference_gene_ids), | ||||||
|             labels = "TPE-OLD genes" |             labels = "Reference genes" | ||||||
|         ) |         ) | ||||||
|     }) |     }) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
							
								
								
									
										2
									
								
								R/ui.R
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								R/ui.R
									
										
									
									
									
								
							|  | @ -6,6 +6,7 @@ ui <- fluidPage( | ||||||
|         sidebarPanel( |         sidebarPanel( | ||||||
|             width = 3, |             width = 3, | ||||||
|             preset_editor_ui("preset_editor"), |             preset_editor_ui("preset_editor"), | ||||||
|  |             filters_ui("filters"), | ||||||
|             sliderInput( |             sliderInput( | ||||||
|                 "n_species", |                 "n_species", | ||||||
|                 "Required number of species per gene", |                 "Required number of species per gene", | ||||||
|  | @ -14,7 +15,6 @@ ui <- fluidPage( | ||||||
|                 step = 1, |                 step = 1, | ||||||
|                 value = 10 |                 value = 10 | ||||||
|             ), |             ), | ||||||
|             filters_ui("filters"), |  | ||||||
|             methods_ui("methods") |             methods_ui("methods") | ||||||
|         ), |         ), | ||||||
|         mainPanel( |         mainPanel( | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue