mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 19:27:24 +01:00
Reorganize source files and generalize presets
This commit is contained in:
parent
8104e9bd8a
commit
68354bf808
14 changed files with 119 additions and 147 deletions
7
shiny/main.R
Normal file
7
shiny/main.R
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
library(shiny)
|
||||
|
||||
source("process/process.R")
|
||||
source("shiny/server.R")
|
||||
source("shiny/ui.R")
|
||||
|
||||
runApp(shinyApp(ui, server))
|
||||
230
shiny/server.R
Normal file
230
shiny/server.R
Normal file
|
|
@ -0,0 +1,230 @@
|
|||
library(data.table)
|
||||
library(DT)
|
||||
library(gprofiler2)
|
||||
library(plotly)
|
||||
library(rclipboard)
|
||||
library(shiny)
|
||||
|
||||
source("optimize.R")
|
||||
source("rank_plot.R")
|
||||
source("scatter_plot.R")
|
||||
|
||||
#' 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>`);
|
||||
}")
|
||||
|
||||
server <- function(input, output, session) {
|
||||
#' Show the customized slider for setting the required number of species.
|
||||
output$n_species_slider <- renderUI({
|
||||
sliderInput(
|
||||
"n_species",
|
||||
"Required number of species per gene",
|
||||
min = 0,
|
||||
max = if (input$species == "all") {
|
||||
nrow(species)
|
||||
} else {
|
||||
length(species_ids_replicative)
|
||||
},
|
||||
step = 1,
|
||||
value = 10
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$optimize_button, {
|
||||
results <- isolate(results())
|
||||
method_ids <- NULL
|
||||
|
||||
for (method in methods) {
|
||||
if (isolate(input[[method$id]])) {
|
||||
method_ids <- c(method_ids, method$id)
|
||||
}
|
||||
}
|
||||
|
||||
reference_gene_ids <- genes[suggested | verified == TRUE, id]
|
||||
weights <- optimize_weights(results, method_ids, reference_gene_ids)
|
||||
|
||||
mapply(function(method_id, weight) {
|
||||
updateSliderInput(
|
||||
session,
|
||||
sprintf("%s_weight", method_id),
|
||||
value = weight * 100
|
||||
)
|
||||
}, method_ids, weights)
|
||||
})
|
||||
|
||||
# Observe each method's enable button.
|
||||
lapply(methods, function(method) {
|
||||
observeEvent(input[[method$id]], {
|
||||
shinyjs::toggleState(sprintf("%s_weight", method$id))
|
||||
}, ignoreInit = TRUE)
|
||||
})
|
||||
|
||||
#' Rank the results based on the specified weights. Filter out genes with
|
||||
#' too few species but don't apply the cut-off score.
|
||||
results <- reactive({
|
||||
# Select the species preset.
|
||||
|
||||
results <- if (input$species == "all") {
|
||||
process(preset_all_species)
|
||||
} else {
|
||||
process(preset_replicative_species)
|
||||
}
|
||||
|
||||
results <- merge(
|
||||
results,
|
||||
genes,
|
||||
by.x = "gene",
|
||||
by.y = "id"
|
||||
)
|
||||
|
||||
# Compute scoring factors and the weighted score.
|
||||
|
||||
total_weight <- 0.0
|
||||
results[, score := 0.0]
|
||||
|
||||
for (method in methods) {
|
||||
if (input[[method$id]]) {
|
||||
weight <- input[[sprintf("%s_weight", method$id)]]
|
||||
total_weight <- total_weight + weight
|
||||
column <- method$id
|
||||
weighted <- weight * results[, ..column]
|
||||
results[, score := score + weighted]
|
||||
}
|
||||
}
|
||||
|
||||
results[, score := score / total_weight]
|
||||
|
||||
# Exclude genes with too few species.
|
||||
results <- results[n_species >= input$n_species]
|
||||
|
||||
# Penalize missing species.
|
||||
if (input$penalize) {
|
||||
species_count <- if (input$species == "all") {
|
||||
nrow(species)
|
||||
} else {
|
||||
length(species_ids_replicative)
|
||||
}
|
||||
|
||||
results <- results[, score := score * n_species / species_count]
|
||||
}
|
||||
|
||||
# Order the results based on their score.
|
||||
|
||||
setorder(results, -score, na.last = TRUE)
|
||||
results[, rank := .I]
|
||||
})
|
||||
|
||||
#' Apply the cut-off score to the ranked results.
|
||||
results_filtered <- reactive({
|
||||
results()[score >= input$cutoff / 100]
|
||||
})
|
||||
|
||||
output$genes <- renderDT({
|
||||
method_ids <- sapply(methods, function(method) method$id)
|
||||
method_names <- sapply(methods, function(method) method$name)
|
||||
columns <- c("rank", "gene", "name", "chromosome", method_ids, "score")
|
||||
column_names <- c("", "Gene", "", "Chromosome", method_names, "Score")
|
||||
|
||||
dt <- datatable(
|
||||
results_filtered()[, ..columns],
|
||||
rownames = FALSE,
|
||||
colnames = column_names,
|
||||
style = "bootstrap",
|
||||
fillContainer = TRUE,
|
||||
extensions = "Scroller",
|
||||
options = list(
|
||||
rowCallback = js_link,
|
||||
columnDefs = list(list(visible = FALSE, targets = 2)),
|
||||
deferRender = TRUE,
|
||||
scrollY = 200,
|
||||
scroller = TRUE
|
||||
)
|
||||
)
|
||||
|
||||
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",
|
||||
rclipButton(
|
||||
"copy_ids_button",
|
||||
"Copy gene IDs",
|
||||
genes_text,
|
||||
icon = icon("clipboard")
|
||||
),
|
||||
rclipButton(
|
||||
"copy_names_button",
|
||||
"Copy gene names",
|
||||
names_text,
|
||||
icon = icon("clipboard")
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$scatter <- renderPlotly({
|
||||
results <- results_filtered()
|
||||
|
||||
gene_ids <- results[input$genes_rows_selected, gene]
|
||||
genes <- genes[id %chin% gene_ids]
|
||||
|
||||
species <- if (input$species == "all") {
|
||||
species
|
||||
} else {
|
||||
species[replicative == TRUE]
|
||||
}
|
||||
|
||||
scatter_plot(results, species, genes, distances)
|
||||
})
|
||||
|
||||
output$assessment_synopsis <- renderText({
|
||||
reference_gene_ids <- genes[suggested | verified == TRUE, id]
|
||||
|
||||
reference_count <- results_filtered()[
|
||||
gene %chin% reference_gene_ids,
|
||||
.N
|
||||
]
|
||||
|
||||
reference_results <- results()[gene %chin% reference_gene_ids]
|
||||
|
||||
sprintf(
|
||||
"Included reference genes: %i/%i<br> \
|
||||
Mean rank of reference genes: %.1f<br> \
|
||||
Maximum rank of reference genes: %i",
|
||||
reference_count,
|
||||
length(reference_gene_ids),
|
||||
reference_results[, mean(rank)],
|
||||
reference_results[, max(rank)]
|
||||
)
|
||||
})
|
||||
|
||||
output$rank_plot <- renderPlotly({
|
||||
rank_plot(
|
||||
results(),
|
||||
genes[suggested | verified == TRUE, id],
|
||||
input$cutoff / 100
|
||||
)
|
||||
})
|
||||
|
||||
output$gost <- renderPlotly({
|
||||
if (input$enable_gost) {
|
||||
result <- gost(results_filtered()[, gene], ordered_query = TRUE)
|
||||
gostplot(result, capped = FALSE, interactive = TRUE)
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
})
|
||||
}
|
||||
116
shiny/ui.R
Normal file
116
shiny/ui.R
Normal file
|
|
@ -0,0 +1,116 @@
|
|||
library(DT)
|
||||
library(plotly)
|
||||
library(rclipboard)
|
||||
library(shiny)
|
||||
|
||||
ui <- fluidPage(
|
||||
shinyjs::useShinyjs(),
|
||||
rclipboardSetup(),
|
||||
titlePanel("TPE-OLD candidates"),
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
h3("Filter criteria"),
|
||||
selectInput(
|
||||
"species",
|
||||
"Species to include",
|
||||
choices = list(
|
||||
"Replicatively aging" = "replicative",
|
||||
"All qualified" = "all"
|
||||
)
|
||||
),
|
||||
uiOutput("n_species_slider"),
|
||||
sliderInput(
|
||||
"cutoff",
|
||||
"Cut-off score",
|
||||
post = "%",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 1,
|
||||
value = 50
|
||||
),
|
||||
h3("Methods"),
|
||||
actionButton(
|
||||
"optimize_button",
|
||||
"Find optimal weights",
|
||||
icon = icon("check-double")
|
||||
),
|
||||
div(style = "margin-top: 16px"),
|
||||
lapply(methods, function(method) {
|
||||
verticalLayout(
|
||||
checkboxInput(
|
||||
method$id,
|
||||
span(
|
||||
method$description,
|
||||
style = "font-weight: bold"
|
||||
),
|
||||
value = TRUE
|
||||
),
|
||||
sliderInput(
|
||||
sprintf("%s_weight", method$id),
|
||||
NULL,
|
||||
post = "%",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 1,
|
||||
value = 100
|
||||
)
|
||||
)
|
||||
}),
|
||||
checkboxInput(
|
||||
"penalize",
|
||||
"Penalize missing values"
|
||||
),
|
||||
),
|
||||
mainPanel(
|
||||
tabsetPanel(
|
||||
type = "pills",
|
||||
header = div(style = "margin-top: 16px"),
|
||||
tabPanel(
|
||||
"Results",
|
||||
uiOutput("copy"),
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DTOutput("genes", height = "1000px")
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
"Positions",
|
||||
plotlyOutput(
|
||||
"scatter",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
"Assessment",
|
||||
htmlOutput("assessment_synopsis"),
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotlyOutput(
|
||||
"rank_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
),
|
||||
),
|
||||
tabPanel(
|
||||
"Analysis",
|
||||
checkboxInput(
|
||||
"enable_gost",
|
||||
"Perform a gene set enrichment analysis on the \
|
||||
filtered result genes."
|
||||
),
|
||||
conditionalPanel(
|
||||
"input.enable_gost == true",
|
||||
plotlyOutput(
|
||||
"gost",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
Loading…
Add table
Add a link
Reference in a new issue