2021-06-24 22:38:16 +02:00
|
|
|
library(data.table)
|
|
|
|
|
library(DT)
|
2021-10-07 12:18:47 +02:00
|
|
|
library(gprofiler2)
|
|
|
|
|
library(plotly)
|
2021-06-24 22:38:16 +02:00
|
|
|
library(shiny)
|
|
|
|
|
|
2021-09-18 23:10:52 +02:00
|
|
|
source("init.R")
|
2021-06-24 22:38:16 +02:00
|
|
|
source("scatter_plot.R")
|
|
|
|
|
|
2021-10-01 09:50:04 +02:00
|
|
|
#' Java script function to replace gene IDs with Ensembl gene links.
|
|
|
|
|
js_link <- 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>`);
|
|
|
|
|
}")
|
|
|
|
|
|
2021-06-24 22:38:16 +02:00
|
|
|
server <- function(input, output) {
|
2021-09-18 23:33:37 +02:00
|
|
|
#' This reactive expression applies all user defined filters as well as the
|
|
|
|
|
#' desired ranking weights to the results.
|
2021-08-29 13:25:12 +02:00
|
|
|
results <- reactive({
|
2021-09-18 23:33:37 +02:00
|
|
|
# Select the species preset.
|
|
|
|
|
|
2021-08-29 13:25:12 +02:00
|
|
|
results <- if (input$species == "all") {
|
|
|
|
|
results_all
|
|
|
|
|
} else {
|
|
|
|
|
results_replicative
|
|
|
|
|
}
|
|
|
|
|
|
2021-09-18 23:33:37 +02:00
|
|
|
# Compute scoring factors and the weighted score.
|
|
|
|
|
|
2021-09-30 13:25:39 +02:00
|
|
|
clusteriness_weight <- input$clusteriness / 100
|
|
|
|
|
correlation_weight <- input$correlation / 100
|
2021-10-05 18:30:12 +02:00
|
|
|
neural_weight <- input$neural / 100
|
|
|
|
|
total_weight <- clusteriness_weight + correlation_weight + neural_weight
|
2021-09-30 13:25:39 +02:00
|
|
|
clusteriness_factor <- clusteriness_weight / total_weight
|
|
|
|
|
correlation_factor <- correlation_weight / total_weight
|
2021-10-05 18:30:12 +02:00
|
|
|
neural_factor <- neural_weight / total_weight
|
2021-09-30 13:25:39 +02:00
|
|
|
|
|
|
|
|
results[, score := clusteriness_factor * clusteriness +
|
2021-10-05 18:30:12 +02:00
|
|
|
correlation_factor * r_mean + neural_factor * neural]
|
2021-09-30 13:25:39 +02:00
|
|
|
|
|
|
|
|
# Apply the cut-off score.
|
|
|
|
|
|
|
|
|
|
results <- results[score >= input$cutoff / 100]
|
2021-09-18 23:33:37 +02:00
|
|
|
|
|
|
|
|
# Order the results based on their score. The resulting index will be
|
|
|
|
|
# used as the "rank".
|
|
|
|
|
|
2021-09-30 12:54:40 +02:00
|
|
|
setorder(results, -score, na.last = TRUE)
|
2021-08-26 11:20:50 +02:00
|
|
|
})
|
2021-08-25 15:01:18 +02:00
|
|
|
|
2021-06-24 22:38:16 +02:00
|
|
|
output$genes <- renderDT({
|
2021-09-30 13:25:39 +02:00
|
|
|
dt <- datatable(
|
2021-10-01 09:50:04 +02:00
|
|
|
results()[, .(
|
|
|
|
|
.I,
|
|
|
|
|
gene,
|
|
|
|
|
name,
|
|
|
|
|
clusteriness,
|
|
|
|
|
r_mean,
|
2021-10-05 18:30:12 +02:00
|
|
|
neural,
|
2021-10-01 09:50:04 +02:00
|
|
|
score
|
|
|
|
|
)],
|
2021-08-26 12:51:43 +02:00
|
|
|
rownames = FALSE,
|
2021-08-25 15:01:18 +02:00
|
|
|
colnames = c(
|
2021-10-01 09:50:04 +02:00
|
|
|
"",
|
2021-08-25 15:01:18 +02:00
|
|
|
"Gene",
|
2021-10-01 09:50:04 +02:00
|
|
|
"",
|
|
|
|
|
"Clusters",
|
2021-09-30 13:25:39 +02:00
|
|
|
"Correlation",
|
2021-10-05 18:30:12 +02:00
|
|
|
"Neural",
|
2021-09-30 13:25:39 +02:00
|
|
|
"Score"
|
2021-08-25 15:01:18 +02:00
|
|
|
),
|
2021-10-01 09:50:04 +02:00
|
|
|
style = "bootstrap",
|
|
|
|
|
options = list(
|
|
|
|
|
rowCallback = js_link,
|
|
|
|
|
columnDefs = list(list(visible = FALSE, targets = 2))
|
|
|
|
|
)
|
2021-06-24 22:38:16 +02:00
|
|
|
)
|
2021-09-30 13:25:39 +02:00
|
|
|
|
2021-10-05 18:30:12 +02:00
|
|
|
formatPercentage(
|
|
|
|
|
dt,
|
|
|
|
|
c("clusteriness", "r_mean", "neural", "score"),
|
|
|
|
|
digits = 1
|
|
|
|
|
)
|
2021-06-24 22:38:16 +02:00
|
|
|
})
|
|
|
|
|
|
2021-08-29 15:29:34 +02:00
|
|
|
output$synposis <- renderText({
|
|
|
|
|
results <- results()
|
|
|
|
|
|
|
|
|
|
sprintf(
|
|
|
|
|
"Found %i candidates including %i/%i verified and %i/%i suggested \
|
|
|
|
|
TPE-OLD genes.",
|
|
|
|
|
results[, .N],
|
|
|
|
|
results[verified == TRUE, .N],
|
2021-09-16 00:06:54 +02:00
|
|
|
genes[verified == TRUE, .N],
|
2021-08-29 15:29:34 +02:00
|
|
|
results[suggested == TRUE, .N],
|
2021-09-16 00:06:54 +02:00
|
|
|
genes[suggested == TRUE, .N]
|
2021-08-29 15:29:34 +02:00
|
|
|
)
|
|
|
|
|
})
|
|
|
|
|
|
2021-06-24 22:38:16 +02:00
|
|
|
output$scatter <- renderPlot({
|
2021-08-29 13:25:12 +02:00
|
|
|
results <- results()
|
|
|
|
|
|
|
|
|
|
gene_ids <- results[input$genes_rows_selected, gene]
|
2021-09-16 00:06:54 +02:00
|
|
|
genes <- genes[id %chin% gene_ids]
|
2021-08-29 13:25:12 +02:00
|
|
|
|
|
|
|
|
species <- if (input$species == "all") {
|
2021-09-16 00:06:54 +02:00
|
|
|
species
|
2021-08-29 13:25:12 +02:00
|
|
|
} else {
|
2021-09-16 00:06:54 +02:00
|
|
|
species[replicative == TRUE]
|
2021-08-29 13:25:12 +02:00
|
|
|
}
|
|
|
|
|
|
2021-09-16 00:06:54 +02:00
|
|
|
scatter_plot(results, species, genes, distances)
|
2021-06-24 22:38:16 +02:00
|
|
|
})
|
2021-10-07 12:18:47 +02:00
|
|
|
|
|
|
|
|
output$gost <- renderPlotly({
|
2021-10-07 12:42:36 +02:00
|
|
|
if (input$enable_gost) {
|
|
|
|
|
result <- gost(results()[, gene], ordered_query = TRUE)
|
|
|
|
|
gostplot(result, capped = FALSE, interactive = TRUE)
|
|
|
|
|
} else {
|
|
|
|
|
NULL
|
|
|
|
|
}
|
2021-10-07 12:18:47 +02:00
|
|
|
})
|
2021-06-24 22:38:16 +02:00
|
|
|
}
|