2021-10-20 15:34:52 +02:00
|
|
|
# Java script function to replace gene IDs with Ensembl gene links.
|
|
|
|
|
js_link <- DT::JS("function(row, data) {
|
2021-10-01 09:50:04 +02:00
|
|
|
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>`);
|
|
|
|
|
}")
|
|
|
|
|
|
2021-10-16 17:02:39 +02:00
|
|
|
server <- function(input, output, session) {
|
2021-10-21 14:56:19 +02:00
|
|
|
preset <- preset_editor_server("preset_editor")
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
# Show the customized slider for setting the required number of species.
|
2021-10-11 11:08:50 +02:00
|
|
|
output$n_species_slider <- renderUI({
|
|
|
|
|
sliderInput(
|
|
|
|
|
"n_species",
|
|
|
|
|
"Required number of species per gene",
|
|
|
|
|
min = 0,
|
2021-10-21 14:56:19 +02:00
|
|
|
max = length(preset()$species_ids),
|
2021-10-11 11:08:50 +02:00
|
|
|
step = 1,
|
|
|
|
|
value = 10
|
|
|
|
|
)
|
|
|
|
|
})
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
# Compute the results according to the preset.
|
2021-10-19 16:44:29 +02:00
|
|
|
analysis <- reactive({
|
2021-10-21 14:56:19 +02:00
|
|
|
preset <- preset()
|
2021-08-29 13:25:12 +02:00
|
|
|
|
2021-10-19 14:15:28 +02:00
|
|
|
# Perform the analysis cached based on the preset's hash.
|
2021-10-19 15:05:01 +02:00
|
|
|
results <- withProgress(
|
|
|
|
|
message = "Analyzing genes",
|
|
|
|
|
value = 0.0, {
|
2021-10-21 17:26:28 +02:00
|
|
|
geposan::analyze(preset, function(progress) {
|
|
|
|
|
setProgress(progress)
|
|
|
|
|
})
|
2021-10-19 15:05:01 +02:00
|
|
|
}
|
|
|
|
|
)
|
2021-10-19 14:15:28 +02:00
|
|
|
|
|
|
|
|
# Add all gene information to the results.
|
2021-10-16 21:46:59 +02:00
|
|
|
results <- merge(
|
|
|
|
|
results,
|
|
|
|
|
genes,
|
|
|
|
|
by.x = "gene",
|
|
|
|
|
by.y = "id"
|
|
|
|
|
)
|
|
|
|
|
|
2021-10-20 11:20:20 +02:00
|
|
|
# Count included species from the preset per gene.
|
2021-10-20 15:34:52 +02:00
|
|
|
genes_n_species <- geposan::distances[
|
2021-10-20 11:20:20 +02:00
|
|
|
species %chin% preset$species_ids,
|
|
|
|
|
.(n_species = .N),
|
|
|
|
|
by = "gene"
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
setkey(genes_n_species, gene)
|
|
|
|
|
|
2021-10-19 14:15:28 +02:00
|
|
|
# Exclude genes with too few species.
|
2021-10-20 11:20:20 +02:00
|
|
|
results[genes_n_species[gene, n_species] >= input$n_species]
|
2021-08-26 11:20:50 +02:00
|
|
|
})
|
2021-08-25 15:01:18 +02:00
|
|
|
|
2021-10-19 16:44:29 +02:00
|
|
|
# Rank the results.
|
|
|
|
|
results <- methods_server("methods", analysis)
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
# Apply the cut-off score to the ranked results.
|
2021-10-15 15:03:40 +02:00
|
|
|
results_filtered <- reactive({
|
|
|
|
|
results()[score >= input$cutoff / 100]
|
2021-10-15 13:16:51 +02:00
|
|
|
})
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
output$genes <- DT::renderDT({
|
2021-10-15 09:26:57 +02:00
|
|
|
method_ids <- sapply(methods, function(method) method$id)
|
|
|
|
|
method_names <- sapply(methods, function(method) method$name)
|
2021-10-15 11:46:15 +02:00
|
|
|
columns <- c("rank", "gene", "name", "chromosome", method_ids, "score")
|
|
|
|
|
column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")
|
2021-10-15 09:26:57 +02:00
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
dt <- DT::datatable(
|
2021-10-15 15:03:40 +02:00
|
|
|
results_filtered()[, ..columns],
|
2021-08-26 12:51:43 +02:00
|
|
|
rownames = FALSE,
|
2021-10-15 09:26:57 +02:00
|
|
|
colnames = column_names,
|
2021-10-01 09:50:04 +02:00
|
|
|
style = "bootstrap",
|
2021-10-15 13:59:00 +02:00
|
|
|
fillContainer = TRUE,
|
2021-10-15 11:46:15 +02:00
|
|
|
extensions = "Scroller",
|
2021-10-01 09:50:04 +02:00
|
|
|
options = list(
|
|
|
|
|
rowCallback = js_link,
|
2021-10-15 11:46:15 +02:00
|
|
|
columnDefs = list(list(visible = FALSE, targets = 2)),
|
|
|
|
|
deferRender = TRUE,
|
|
|
|
|
scrollY = 200,
|
|
|
|
|
scroller = TRUE
|
2021-10-01 09:50:04 +02:00
|
|
|
)
|
2021-06-24 22:38:16 +02:00
|
|
|
)
|
2021-09-30 13:25:39 +02:00
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
DT::formatPercentage(dt, c(method_ids, "score"), digits = 1)
|
2021-06-24 22:38:16 +02:00
|
|
|
})
|
|
|
|
|
|
2021-10-07 12:59:04 +02:00
|
|
|
output$copy <- renderUI({
|
2021-10-15 15:03:40 +02:00
|
|
|
results <- results_filtered()
|
2021-10-07 12:59:04 +02:00
|
|
|
|
|
|
|
|
gene_ids <- results[, gene]
|
|
|
|
|
names <- results[name != "", name]
|
|
|
|
|
|
|
|
|
|
genes_text <- paste(gene_ids, collapse = "\n")
|
|
|
|
|
names_text <- paste(names, collapse = "\n")
|
|
|
|
|
|
|
|
|
|
splitLayout(
|
2021-10-15 13:59:00 +02:00
|
|
|
cellWidths = "auto",
|
2021-10-20 15:34:52 +02:00
|
|
|
rclipboard::rclipButton(
|
2021-10-07 12:59:04 +02:00
|
|
|
"copy_ids_button",
|
|
|
|
|
"Copy gene IDs",
|
|
|
|
|
genes_text,
|
2021-10-15 13:59:00 +02:00
|
|
|
icon = icon("clipboard")
|
2021-10-07 12:59:04 +02:00
|
|
|
),
|
2021-10-20 15:34:52 +02:00
|
|
|
rclipboard::rclipButton(
|
2021-10-07 12:59:04 +02:00
|
|
|
"copy_names_button",
|
|
|
|
|
"Copy gene names",
|
|
|
|
|
names_text,
|
2021-10-15 13:59:00 +02:00
|
|
|
icon = icon("clipboard")
|
2021-10-07 12:59:04 +02:00
|
|
|
)
|
|
|
|
|
)
|
|
|
|
|
})
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
output$scatter <- plotly::renderPlotly({
|
2021-10-15 15:03:40 +02:00
|
|
|
results <- results_filtered()
|
2021-08-29 13:25:12 +02:00
|
|
|
|
|
|
|
|
gene_ids <- results[input$genes_rows_selected, gene]
|
2021-09-16 00:06:54 +02:00
|
|
|
genes <- genes[id %chin% gene_ids]
|
2021-10-21 14:56:19 +02:00
|
|
|
species <- species[id %chin% preset()$species_ids]
|
2021-08-29 13:25:12 +02:00
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
scatter_plot(results, species, genes)
|
2021-06-24 22:38:16 +02:00
|
|
|
})
|
2021-10-07 12:18:47 +02:00
|
|
|
|
2021-10-15 15:03:40 +02:00
|
|
|
output$assessment_synopsis <- renderText({
|
2021-10-21 14:56:19 +02:00
|
|
|
reference_gene_ids <- preset()$reference_gene_ids
|
2021-10-15 15:03:40 +02:00
|
|
|
|
2021-10-20 11:30:32 +02:00
|
|
|
included_reference_count <- results_filtered()[
|
2021-10-15 15:03:40 +02:00
|
|
|
gene %chin% reference_gene_ids,
|
|
|
|
|
.N
|
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
reference_results <- results()[gene %chin% reference_gene_ids]
|
2021-10-20 11:30:32 +02:00
|
|
|
total_reference_count <- nrow(reference_results)
|
|
|
|
|
|
|
|
|
|
if (total_reference_count > 0) {
|
|
|
|
|
mean_rank <- as.character(round(
|
|
|
|
|
reference_results[, mean(rank)],
|
|
|
|
|
digits = 1
|
|
|
|
|
))
|
|
|
|
|
|
2021-10-21 11:43:34 +02:00
|
|
|
min_rank <- as.character(reference_results[, min(rank)])
|
2021-10-20 11:30:32 +02:00
|
|
|
max_rank <- as.character(reference_results[, max(rank)])
|
|
|
|
|
} else {
|
|
|
|
|
mean_rank <- "Unknown"
|
2021-10-21 11:43:34 +02:00
|
|
|
min_rank <- "Unknown"
|
2021-10-20 11:30:32 +02:00
|
|
|
max_rank <- "Unknown"
|
|
|
|
|
}
|
2021-10-15 15:03:40 +02:00
|
|
|
|
|
|
|
|
sprintf(
|
|
|
|
|
"Included reference genes: %i/%i<br> \
|
2021-10-20 11:30:32 +02:00
|
|
|
Mean rank of reference genes: %s<br> \
|
2021-10-21 11:43:34 +02:00
|
|
|
First rank of reference genes: %s<br> \
|
|
|
|
|
Last rank of reference genes: %s",
|
2021-10-20 11:30:32 +02:00
|
|
|
included_reference_count,
|
|
|
|
|
total_reference_count,
|
|
|
|
|
mean_rank,
|
2021-10-21 11:43:34 +02:00
|
|
|
min_rank,
|
2021-10-20 11:30:32 +02:00
|
|
|
max_rank
|
2021-10-15 15:03:40 +02:00
|
|
|
)
|
|
|
|
|
})
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
output$rank_plot <- plotly::renderPlotly({
|
2021-10-15 15:03:40 +02:00
|
|
|
rank_plot(
|
|
|
|
|
results(),
|
2021-10-21 14:56:19 +02:00
|
|
|
preset()$reference_gene_ids,
|
2021-10-15 15:03:40 +02:00
|
|
|
input$cutoff / 100
|
|
|
|
|
)
|
|
|
|
|
})
|
|
|
|
|
|
2021-10-20 15:34:52 +02:00
|
|
|
output$gost <- plotly::renderPlotly({
|
2021-10-07 12:42:36 +02:00
|
|
|
if (input$enable_gost) {
|
2021-10-20 15:34:52 +02:00
|
|
|
result <- gprofiler2::gost(
|
|
|
|
|
results_filtered()[, gene],
|
|
|
|
|
ordered_query = TRUE
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
gprofiler2::gostplot(
|
|
|
|
|
result,
|
|
|
|
|
capped = FALSE,
|
|
|
|
|
interactive = TRUE
|
|
|
|
|
)
|
2021-10-07 12:42:36 +02:00
|
|
|
} else {
|
|
|
|
|
NULL
|
|
|
|
|
}
|
2021-10-07 12:18:47 +02:00
|
|
|
})
|
2021-10-19 14:15:28 +02:00
|
|
|
}
|