mirror of
				https://github.com/johrpan/geposanui.git
				synced 2025-10-26 19:27:24 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			214 lines
		
	
	
	
		
			6 KiB
		
	
	
	
		
			R
		
	
	
	
	
	
			
		
		
	
	
			214 lines
		
	
	
	
		
			6 KiB
		
	
	
	
		
			R
		
	
	
	
	
	
| # Java script function to replace gene IDs with Ensembl gene links.
 | |
| js_link <- DT::JS("function(row, data) {
 | |
|     let id = data[1];
 | |
|     var name = data[2];
 | |
|     if (!name) name = 'Unknown';
 | |
|     let url = `https://www.ensembl.org/Homo_sapiens/Gene/Summary?g=${id}`;
 | |
|     $('td:eq(1)', row).html(`<a href=\"${url}\" target=\"_blank\">${name}</a>`);
 | |
| }")
 | |
| 
 | |
| server <- function(input, output, session) {
 | |
|     preset <- preset_editor_server("preset_editor")
 | |
| 
 | |
|     # Compute the results according to the preset.
 | |
|     analysis <- reactive({
 | |
|         preset <- preset()
 | |
| 
 | |
|         # Perform the analysis cached based on the preset's hash.
 | |
|         analysis <- withProgress(
 | |
|             message = "Analyzing genes",
 | |
|             value = 0.0,
 | |
|             { # nolint
 | |
|                 geposan::analyze(preset, function(progress) {
 | |
|                     setProgress(progress)
 | |
|                 })
 | |
|             }
 | |
|         )
 | |
| 
 | |
|         analysis
 | |
|     })
 | |
| 
 | |
|     # Rank the results.
 | |
|     ranking <- methods_server("methods", analysis)
 | |
| 
 | |
|     # Add gene information to the results.
 | |
|     results <- reactive({
 | |
|         merge(
 | |
|             ranking(),
 | |
|             geposan::genes,
 | |
|             by.x = "gene",
 | |
|             by.y = "id",
 | |
|             sort = FALSE
 | |
|         )
 | |
|     })
 | |
| 
 | |
|     # Apply the filters.
 | |
|     results_filtered <- filters_server("filters", results)
 | |
| 
 | |
|     output$genes <- DT::renderDT({
 | |
|         columns <- c("rank", "gene", "name", "chromosome", method_ids, "score")
 | |
|         column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")
 | |
| 
 | |
|         dt <- DT::datatable(
 | |
|             results_filtered()[, ..columns],
 | |
|             rownames = FALSE,
 | |
|             colnames = column_names,
 | |
|             style = "bootstrap",
 | |
|             options = list(
 | |
|                 rowCallback = js_link,
 | |
|                 columnDefs = list(list(visible = FALSE, targets = 2)),
 | |
|                 pageLength = 25
 | |
|             )
 | |
|         )
 | |
| 
 | |
|         DT::formatPercentage(dt, c(method_ids, "score"), digits = 1)
 | |
|     })
 | |
| 
 | |
|     output$copy <- renderUI({
 | |
|         results <- results_filtered()
 | |
| 
 | |
|         gene_ids <- results[, gene]
 | |
|         names <- results[name != "", name]
 | |
| 
 | |
|         genes_text <- paste(gene_ids, collapse = "\n")
 | |
|         names_text <- paste(names, collapse = "\n")
 | |
| 
 | |
|         splitLayout(
 | |
|             cellWidths = "auto",
 | |
|             rclipboard::rclipButton(
 | |
|                 "copy_ids_button",
 | |
|                 "Copy gene IDs",
 | |
|                 genes_text,
 | |
|                 icon = icon("clipboard")
 | |
|             ),
 | |
|             rclipboard::rclipButton(
 | |
|                 "copy_names_button",
 | |
|                 "Copy gene names",
 | |
|                 names_text,
 | |
|                 icon = icon("clipboard")
 | |
|             )
 | |
|         )
 | |
|     })
 | |
| 
 | |
|     output$scatter <- plotly::renderPlotly({
 | |
|         preset <- preset()
 | |
| 
 | |
|         gene_sets <- list(preset$reference_gene_ids)
 | |
|         labels <- c("Reference genes")
 | |
| 
 | |
|         comparison_gene_ids <- results_filtered()[
 | |
|             input$genes_rows_selected,
 | |
|             gene
 | |
|         ]
 | |
| 
 | |
|         if (length(comparison_gene_ids) >= 1) {
 | |
|             gene_sets <- c(gene_sets, list(comparison_gene_ids))
 | |
|             labels <- c(labels, "Comparison genes")
 | |
|         }
 | |
| 
 | |
|         geposan::plot_positions(
 | |
|             preset$species_ids,
 | |
|             gene_sets = gene_sets,
 | |
|             labels = labels,
 | |
|             use_positions = input$use_positions
 | |
|         )
 | |
|     })
 | |
| 
 | |
|     output$assessment_synopsis <- renderText({
 | |
|         reference_gene_ids <- preset()$reference_gene_ids
 | |
| 
 | |
|         included_reference_count <- results_filtered()[
 | |
|             gene %chin% reference_gene_ids,
 | |
|             .N
 | |
|         ]
 | |
| 
 | |
|         reference_results <- results()[gene %chin% reference_gene_ids]
 | |
|         total_reference_count <- nrow(reference_results)
 | |
| 
 | |
|         if (total_reference_count > 0) {
 | |
|             mean_rank <- as.character(round(
 | |
|                 reference_results[, mean(rank)],
 | |
|                 digits = 1
 | |
|             ))
 | |
| 
 | |
|             min_rank <- as.character(reference_results[, min(rank)])
 | |
|             max_rank <- as.character(reference_results[, max(rank)])
 | |
|         } else {
 | |
|             mean_rank <- "Unknown"
 | |
|             min_rank <- "Unknown"
 | |
|             max_rank <- "Unknown"
 | |
|         }
 | |
| 
 | |
|         sprintf(
 | |
|             "Included reference genes: %i/%i<br> \
 | |
|             Mean rank of reference genes: %s<br> \
 | |
|             First rank of reference genes: %s<br> \
 | |
|             Last rank of reference genes: %s",
 | |
|             included_reference_count,
 | |
|             total_reference_count,
 | |
|             mean_rank,
 | |
|             min_rank,
 | |
|             max_rank
 | |
|         )
 | |
|     })
 | |
| 
 | |
|     output$rank_plot <- plotly::renderPlotly({
 | |
|         gene_sets <- list(preset()$reference_gene_ids)
 | |
|         labels <- c("Reference genes")
 | |
| 
 | |
|         comparison_gene_ids <- results_filtered()[
 | |
|             input$genes_rows_selected,
 | |
|             gene
 | |
|         ]
 | |
| 
 | |
|         if (length(comparison_gene_ids) >= 1) {
 | |
|             gene_sets <- c(gene_sets, list(comparison_gene_ids))
 | |
|             labels <- c(labels, "Comparison genes")
 | |
|         }
 | |
| 
 | |
|         geposan::plot_scores(
 | |
|             ranking(),
 | |
|             gene_sets = gene_sets,
 | |
|             labels = labels,
 | |
|             max_rank = results_filtered()[, max(rank)]
 | |
|         )
 | |
|     })
 | |
| 
 | |
|     output$boxplot <- plotly::renderPlotly({
 | |
|         gene_sets <- list(preset()$reference_gene_ids)
 | |
|         labels <- c("Reference genes")
 | |
| 
 | |
|         comparison_gene_ids <- results_filtered()[
 | |
|             input$genes_rows_selected,
 | |
|             gene
 | |
|         ]
 | |
| 
 | |
|         if (length(comparison_gene_ids) >= 1) {
 | |
|             gene_sets <- c(gene_sets, list(comparison_gene_ids))
 | |
|             labels <- c(labels, "Comparison genes")
 | |
|         }
 | |
| 
 | |
|         geposan::plot_boxplot(
 | |
|             ranking(),
 | |
|             gene_sets = gene_sets,
 | |
|             labels = labels
 | |
|         )
 | |
|     })
 | |
| 
 | |
|     output$gost <- plotly::renderPlotly({
 | |
|         if (input$enable_gost) {
 | |
|             result <- gprofiler2::gost(
 | |
|                 results_filtered()[, gene],
 | |
|                 ordered_query = TRUE
 | |
|             )
 | |
| 
 | |
|             gprofiler2::gostplot(
 | |
|                 result,
 | |
|                 capped = FALSE,
 | |
|                 interactive = TRUE
 | |
|             )
 | |
|         } else {
 | |
|             NULL
 | |
|         }
 | |
|     })
 | |
| }
 |