mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-25 20:07:23 +02:00
Reindent code to use just two spaces
This commit is contained in:
parent
47b8d7a1f0
commit
13b5efc1e3
10 changed files with 1000 additions and 999 deletions
32
R/app.R
32
R/app.R
|
|
@ -21,23 +21,23 @@ run_app <- function(gene_sets,
|
|||
locked = FALSE,
|
||||
title = "Gene Position Analysis",
|
||||
port = 3464) {
|
||||
stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]]))
|
||||
stopifnot(!is.null(gene_sets) & !is.null(gene_sets[[1]]))
|
||||
|
||||
# These function calls make the required java scripts available.
|
||||
shinyjs::useShinyjs()
|
||||
rclipboard::rclipboardSetup()
|
||||
# These function calls make the required java scripts available.
|
||||
shinyjs::useShinyjs()
|
||||
rclipboard::rclipboardSetup()
|
||||
|
||||
# Bundle of global options to redue broilerplate.
|
||||
options <- list(
|
||||
gene_sets = gene_sets,
|
||||
species_sets = species_sets,
|
||||
locked = locked,
|
||||
title = title
|
||||
)
|
||||
# Bundle of global options to redue broilerplate.
|
||||
options <- list(
|
||||
gene_sets = gene_sets,
|
||||
species_sets = species_sets,
|
||||
locked = locked,
|
||||
title = title
|
||||
)
|
||||
|
||||
# Actually run the app.
|
||||
shiny::runApp(
|
||||
shiny::shinyApp(ui(options), server(options)),
|
||||
port = port
|
||||
)
|
||||
# Actually run the app.
|
||||
shiny::runApp(
|
||||
shiny::shinyApp(ui(options), server(options)),
|
||||
port = port
|
||||
)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,26 +3,26 @@
|
|||
#' @param options Global application options
|
||||
#' @noRd
|
||||
comparison_editor_ui <- function(id, options) {
|
||||
verticalLayout(
|
||||
h3("Comparison"),
|
||||
selectInput(
|
||||
NS(id, "comparison_genes"),
|
||||
"Comparison genes",
|
||||
choices = c(
|
||||
"None",
|
||||
"Random genes",
|
||||
names(options$gene_sets),
|
||||
"Customize"
|
||||
)
|
||||
),
|
||||
conditionalPanel(
|
||||
condition = sprintf(
|
||||
"input['%s'] == 'Customize'",
|
||||
NS(id, "comparison_genes")
|
||||
),
|
||||
gene_selector_ui(NS(id, "custom_genes"))
|
||||
)
|
||||
verticalLayout(
|
||||
h3("Comparison"),
|
||||
selectInput(
|
||||
NS(id, "comparison_genes"),
|
||||
"Comparison genes",
|
||||
choices = c(
|
||||
"None",
|
||||
"Random genes",
|
||||
names(options$gene_sets),
|
||||
"Customize"
|
||||
)
|
||||
),
|
||||
conditionalPanel(
|
||||
condition = sprintf(
|
||||
"input['%s'] == 'Customize'",
|
||||
NS(id, "comparison_genes")
|
||||
),
|
||||
gene_selector_ui(NS(id, "custom_genes"))
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Create a server for the comparison editor.
|
||||
|
|
@ -35,23 +35,23 @@ comparison_editor_ui <- function(id, options) {
|
|||
#'
|
||||
#' @noRd
|
||||
comparison_editor_server <- function(id, preset, options) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
custom_gene_ids <- gene_selector_server("custom_genes")
|
||||
moduleServer(id, function(input, output, session) {
|
||||
custom_gene_ids <- gene_selector_server("custom_genes")
|
||||
|
||||
reactive({
|
||||
if (input$comparison_genes == "None") {
|
||||
NULL
|
||||
} else if (input$comparison_genes == "Random genes") {
|
||||
preset <- preset()
|
||||
gene_pool <- preset$gene_ids
|
||||
reference_gene_ids <- preset$reference_gene_ids
|
||||
gene_pool <- gene_pool[!gene_pool %chin% reference_gene_ids]
|
||||
gene_pool[sample(length(gene_pool), length(reference_gene_ids))]
|
||||
} else if (input$comparison_genes == "Customize") {
|
||||
custom_gene_ids()
|
||||
} else {
|
||||
options$gene_sets[[input$comparison_genes]]
|
||||
}
|
||||
})
|
||||
reactive({
|
||||
if (input$comparison_genes == "None") {
|
||||
NULL
|
||||
} else if (input$comparison_genes == "Random genes") {
|
||||
preset <- preset()
|
||||
gene_pool <- preset$gene_ids
|
||||
reference_gene_ids <- preset$reference_gene_ids
|
||||
gene_pool <- gene_pool[!gene_pool %chin% reference_gene_ids]
|
||||
gene_pool[sample(length(gene_pool), length(reference_gene_ids))]
|
||||
} else if (input$comparison_genes == "Customize") {
|
||||
custom_gene_ids()
|
||||
} else {
|
||||
options$gene_sets[[input$comparison_genes]]
|
||||
}
|
||||
})
|
||||
})
|
||||
}
|
||||
|
|
|
|||
168
R/filters.R
168
R/filters.R
|
|
@ -1,68 +1,68 @@
|
|||
# Construct UI for the filter editor.
|
||||
filters_ui <- function(id) {
|
||||
verticalLayout(
|
||||
h3("Filter criteria"),
|
||||
selectInput(
|
||||
NS(id, "method"),
|
||||
"Filter method",
|
||||
choices = list(
|
||||
"Percentile" = "percentile",
|
||||
"Cut-off score" = "score",
|
||||
"Maximum number of genes" = "rank",
|
||||
"None" = "none"
|
||||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "sliders"),
|
||||
type = "hidden",
|
||||
tabPanelBody(
|
||||
value = "percentile",
|
||||
sliderInput(
|
||||
NS(id, "percentile"),
|
||||
label = "Minimum percentile",
|
||||
post = "%",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 1,
|
||||
value = 95
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
value = "score",
|
||||
sliderInput(
|
||||
NS(id, "score"),
|
||||
label = "Cut-off score",
|
||||
post = "%",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 1,
|
||||
value = 75
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
value = "rank",
|
||||
sliderInput(
|
||||
NS(id, "rank"),
|
||||
label = "Maximum rank",
|
||||
min = 0,
|
||||
max = 2000,
|
||||
step = 10,
|
||||
value = 1000
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
value = "none"
|
||||
)
|
||||
),
|
||||
verticalLayout(
|
||||
h3("Filter criteria"),
|
||||
selectInput(
|
||||
NS(id, "method"),
|
||||
"Filter method",
|
||||
choices = list(
|
||||
"Percentile" = "percentile",
|
||||
"Cut-off score" = "score",
|
||||
"Maximum number of genes" = "rank",
|
||||
"None" = "none"
|
||||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "sliders"),
|
||||
type = "hidden",
|
||||
tabPanelBody(
|
||||
value = "percentile",
|
||||
sliderInput(
|
||||
NS(id, "distance"),
|
||||
label = "Distance to telomeres",
|
||||
post = " Mbp",
|
||||
min = 0,
|
||||
max = 150,
|
||||
value = c(0, 150)
|
||||
NS(id, "percentile"),
|
||||
label = "Minimum percentile",
|
||||
post = "%",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 1,
|
||||
value = 95
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
value = "score",
|
||||
sliderInput(
|
||||
NS(id, "score"),
|
||||
label = "Cut-off score",
|
||||
post = "%",
|
||||
min = 0,
|
||||
max = 100,
|
||||
step = 1,
|
||||
value = 75
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
value = "rank",
|
||||
sliderInput(
|
||||
NS(id, "rank"),
|
||||
label = "Maximum rank",
|
||||
min = 0,
|
||||
max = 2000,
|
||||
step = 10,
|
||||
value = 1000
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
value = "none"
|
||||
)
|
||||
),
|
||||
sliderInput(
|
||||
NS(id, "distance"),
|
||||
label = "Distance to telomeres",
|
||||
post = " Mbp",
|
||||
min = 0,
|
||||
max = 150,
|
||||
value = c(0, 150)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
# Construct server for the filter editor.
|
||||
|
|
@ -71,29 +71,29 @@ filters_ui <- function(id) {
|
|||
#
|
||||
# @return A reactive containing the filtered results.
|
||||
filters_server <- function(id, results) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
observeEvent(input$method, {
|
||||
updateTabsetPanel(session, "sliders", selected = input$method)
|
||||
})
|
||||
|
||||
reactive({
|
||||
results <- results()
|
||||
|
||||
results_prefiltered <- if (input$method == "percentile") {
|
||||
n_ranks <- nrow(results)
|
||||
results[rank <= (1 - (input$percentile / 100)) * n_ranks]
|
||||
} else if (input$method == "score") {
|
||||
results[score >= input$score / 100]
|
||||
} else if (input$method == "rank") {
|
||||
results[rank <= input$rank]
|
||||
} else {
|
||||
results
|
||||
}
|
||||
|
||||
results_prefiltered[
|
||||
distance >= 1000000 * input$distance[1] &
|
||||
distance <= 1000000 * input$distance[2]
|
||||
]
|
||||
})
|
||||
moduleServer(id, function(input, output, session) {
|
||||
observeEvent(input$method, {
|
||||
updateTabsetPanel(session, "sliders", selected = input$method)
|
||||
})
|
||||
|
||||
reactive({
|
||||
results <- results()
|
||||
|
||||
results_prefiltered <- if (input$method == "percentile") {
|
||||
n_ranks <- nrow(results)
|
||||
results[rank <= (1 - (input$percentile / 100)) * n_ranks]
|
||||
} else if (input$method == "score") {
|
||||
results[score >= input$score / 100]
|
||||
} else if (input$method == "rank") {
|
||||
results[rank <= input$rank]
|
||||
} else {
|
||||
results
|
||||
}
|
||||
|
||||
results_prefiltered[
|
||||
distance >= 1000000 * input$distance[1] &
|
||||
distance <= 1000000 * input$distance[2]
|
||||
]
|
||||
})
|
||||
})
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,61 +7,61 @@
|
|||
#'
|
||||
#' @noRd
|
||||
gene_selector_ui <- function(id, default_gene_ids = NULL) {
|
||||
named_genes <- geposan::genes[name != ""]
|
||||
named_genes <- unique(named_genes, by = "name")
|
||||
gene_choices <- named_genes$id
|
||||
names(gene_choices) <- named_genes$name
|
||||
named_genes <- geposan::genes[name != ""]
|
||||
named_genes <- unique(named_genes, by = "name")
|
||||
gene_choices <- named_genes$id
|
||||
names(gene_choices) <- named_genes$name
|
||||
|
||||
verticalLayout(
|
||||
selectInput(
|
||||
NS(id, "identifier_type"),
|
||||
"Gene identifiers",
|
||||
choices = list(
|
||||
"Select from list" = "list",
|
||||
"HGNC symbols" = "hgnc",
|
||||
"Ensembl gene IDs" = "ensembl"
|
||||
)
|
||||
verticalLayout(
|
||||
selectInput(
|
||||
NS(id, "identifier_type"),
|
||||
"Gene identifiers",
|
||||
choices = list(
|
||||
"Select from list" = "list",
|
||||
"HGNC symbols" = "hgnc",
|
||||
"Ensembl gene IDs" = "ensembl"
|
||||
)
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "custom_input"),
|
||||
type = "hidden",
|
||||
tabPanelBody(
|
||||
"list",
|
||||
shinyvs::virtualSelectInput(
|
||||
NS(id, "selected_genes"),
|
||||
label = "Select genes",
|
||||
choices = gene_choices,
|
||||
multiple = TRUE,
|
||||
search = TRUE,
|
||||
selectAllOnlyVisible = TRUE
|
||||
),
|
||||
tabsetPanel(
|
||||
id = NS(id, "custom_input"),
|
||||
type = "hidden",
|
||||
tabPanelBody(
|
||||
"list",
|
||||
shinyvs::virtualSelectInput(
|
||||
NS(id, "selected_genes"),
|
||||
label = "Select genes",
|
||||
choices = gene_choices,
|
||||
multiple = TRUE,
|
||||
search = TRUE,
|
||||
selectAllOnlyVisible = TRUE
|
||||
),
|
||||
),
|
||||
tabPanelBody(
|
||||
"hgnc",
|
||||
textAreaInput(
|
||||
NS(id, "hgnc_names_raw"),
|
||||
"Enter HGNC symbols",
|
||||
value = paste(
|
||||
geposan::genes[
|
||||
id %chin% default_gene_ids & name != "",
|
||||
name
|
||||
],
|
||||
collapse = "\n"
|
||||
),
|
||||
height = "250px"
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
"ensembl",
|
||||
textAreaInput(
|
||||
NS(id, "gene_ids_raw"),
|
||||
"Enter Ensembl gene IDs",
|
||||
value = paste(default_gene_ids, collapse = "\n"),
|
||||
height = "250px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
"hgnc",
|
||||
textAreaInput(
|
||||
NS(id, "hgnc_names_raw"),
|
||||
"Enter HGNC symbols",
|
||||
value = paste(
|
||||
geposan::genes[
|
||||
id %chin% default_gene_ids & name != "",
|
||||
name
|
||||
],
|
||||
collapse = "\n"
|
||||
),
|
||||
height = "250px"
|
||||
)
|
||||
),
|
||||
tabPanelBody(
|
||||
"ensembl",
|
||||
textAreaInput(
|
||||
NS(id, "gene_ids_raw"),
|
||||
"Enter Ensembl gene IDs",
|
||||
value = paste(default_gene_ids, collapse = "\n"),
|
||||
height = "250px"
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Application logic for the gene selector.
|
||||
|
|
@ -72,33 +72,33 @@ gene_selector_ui <- function(id, default_gene_ids = NULL) {
|
|||
#'
|
||||
#' @noRd
|
||||
gene_selector_server <- function(id) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
observe({
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"custom_input",
|
||||
selected = input$identifier_type
|
||||
)
|
||||
})
|
||||
|
||||
reactive({
|
||||
gene_ids <- if (input$identifier_type == "list") {
|
||||
input$selected_genes
|
||||
} else if (input$identifier_type == "hgnc") {
|
||||
inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]])
|
||||
inputs <- inputs[inputs != ""]
|
||||
geposan::genes[name %chin% inputs, id]
|
||||
} else {
|
||||
inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]])
|
||||
inputs <- inputs[inputs != ""]
|
||||
geposan::genes[id %chin% inputs, id]
|
||||
}
|
||||
|
||||
if (length(gene_ids > 100)) {
|
||||
gene_ids[seq_len(100)]
|
||||
} else {
|
||||
gene_ids
|
||||
}
|
||||
})
|
||||
moduleServer(id, function(input, output, session) {
|
||||
observe({
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"custom_input",
|
||||
selected = input$identifier_type
|
||||
)
|
||||
})
|
||||
|
||||
reactive({
|
||||
gene_ids <- if (input$identifier_type == "list") {
|
||||
input$selected_genes
|
||||
} else if (input$identifier_type == "hgnc") {
|
||||
inputs <- unique(strsplit(input$hgnc_names_raw, "\\s+")[[1]])
|
||||
inputs <- inputs[inputs != ""]
|
||||
geposan::genes[name %chin% inputs, id]
|
||||
} else {
|
||||
inputs <- unique(strsplit(input$gene_ids_raw, "\\s+")[[1]])
|
||||
inputs <- inputs[inputs != ""]
|
||||
geposan::genes[id %chin% inputs, id]
|
||||
}
|
||||
|
||||
if (length(gene_ids > 100)) {
|
||||
gene_ids[seq_len(100)]
|
||||
} else {
|
||||
gene_ids
|
||||
}
|
||||
})
|
||||
})
|
||||
}
|
||||
|
|
|
|||
156
R/input_page.R
156
R/input_page.R
|
|
@ -4,35 +4,35 @@
|
|||
#'
|
||||
#' @noRd
|
||||
input_page_ui <- function(id, options) {
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
preset_editor_ui(NS(id, "preset_editor"), options),
|
||||
tabsetPanel(
|
||||
id = NS(id, "apply_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "show",
|
||||
actionButton(
|
||||
NS(id, "apply_button"),
|
||||
"Perform analysis",
|
||||
class = "btn-primary",
|
||||
style = "margin-top: 16px; margin-bottom: 16px"
|
||||
)
|
||||
)
|
||||
),
|
||||
comparison_editor_ui(NS(id, "comparison_editor"), options)
|
||||
),
|
||||
mainPanel(
|
||||
width = 9,
|
||||
plotly::plotlyOutput(
|
||||
NS(id, "positions_plot"),
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
preset_editor_ui(NS(id, "preset_editor"), options),
|
||||
tabsetPanel(
|
||||
id = NS(id, "apply_panel"),
|
||||
type = "hidden",
|
||||
tabPanelBody(value = "hide"),
|
||||
tabPanelBody(
|
||||
value = "show",
|
||||
actionButton(
|
||||
NS(id, "apply_button"),
|
||||
"Perform analysis",
|
||||
class = "btn-primary",
|
||||
style = "margin-top: 16px; margin-bottom: 16px"
|
||||
)
|
||||
)
|
||||
),
|
||||
comparison_editor_ui(NS(id, "comparison_editor"), options)
|
||||
),
|
||||
mainPanel(
|
||||
width = 9,
|
||||
plotly::plotlyOutput(
|
||||
NS(id, "positions_plot"),
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Application logic for the input page.
|
||||
|
|
@ -45,61 +45,61 @@ input_page_ui <- function(id, options) {
|
|||
#'
|
||||
#' @noRd
|
||||
input_page_server <- function(id, options) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
current_preset <- reactiveVal(geposan::preset(options$gene_sets[[1]]))
|
||||
potential_preset <- preset_editor_server("preset_editor", options)
|
||||
moduleServer(id, function(input, output, session) {
|
||||
current_preset <- reactiveVal(geposan::preset(options$gene_sets[[1]]))
|
||||
potential_preset <- preset_editor_server("preset_editor", options)
|
||||
|
||||
comparison_gene_ids <- comparison_editor_server(
|
||||
"comparison_editor",
|
||||
current_preset,
|
||||
options
|
||||
)
|
||||
comparison_gene_ids <- comparison_editor_server(
|
||||
"comparison_editor",
|
||||
current_preset,
|
||||
options
|
||||
)
|
||||
|
||||
output$positions_plot <- plotly::renderPlotly({
|
||||
preset <- potential_preset()
|
||||
output$positions_plot <- plotly::renderPlotly({
|
||||
preset <- potential_preset()
|
||||
|
||||
if (is.null(preset)) {
|
||||
NULL
|
||||
} else {
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
if (is.null(preset)) {
|
||||
NULL
|
||||
} else {
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_positions(preset$species_ids, gene_sets)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
if (is.null(potential_preset()) |
|
||||
rlang::hash(potential_preset()) ==
|
||||
rlang::hash(current_preset())) {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
} else {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "show"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
current_preset(potential_preset())
|
||||
}) |> bindEvent(input$apply_button)
|
||||
|
||||
list(
|
||||
preset = current_preset,
|
||||
comparison_gene_ids = comparison_gene_ids
|
||||
)
|
||||
geposan::plot_positions(preset$species_ids, gene_sets)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
if (is.null(potential_preset()) |
|
||||
rlang::hash(potential_preset()) ==
|
||||
rlang::hash(current_preset())) {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "hide"
|
||||
)
|
||||
} else {
|
||||
updateTabsetPanel(
|
||||
session,
|
||||
"apply_panel",
|
||||
selected = "show"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
current_preset(potential_preset())
|
||||
}) |> bindEvent(input$apply_button)
|
||||
|
||||
list(
|
||||
preset = current_preset,
|
||||
comparison_gene_ids = comparison_gene_ids
|
||||
)
|
||||
})
|
||||
}
|
||||
|
|
|
|||
246
R/methods.R
246
R/methods.R
|
|
@ -1,47 +1,47 @@
|
|||
# Construct UI for the methods editor.
|
||||
methods_ui <- function(id) {
|
||||
verticalLayout(
|
||||
h3("Methods"),
|
||||
selectInput(
|
||||
NS(id, "optimization_genes"),
|
||||
"Genes to optimize for",
|
||||
choices = list(
|
||||
"Reference genes" = "reference",
|
||||
"Comparison genes" = "comparison"
|
||||
)
|
||||
verticalLayout(
|
||||
h3("Methods"),
|
||||
selectInput(
|
||||
NS(id, "optimization_genes"),
|
||||
"Genes to optimize for",
|
||||
choices = list(
|
||||
"Reference genes" = "reference",
|
||||
"Comparison genes" = "comparison"
|
||||
)
|
||||
),
|
||||
selectInput(
|
||||
NS(id, "optimization_target"),
|
||||
"Optimization target",
|
||||
choices = list(
|
||||
"Mean rank" = "mean",
|
||||
"Median rank" = "median",
|
||||
"First rank" = "min",
|
||||
"Last rank" = "max",
|
||||
"Customize weights" = "custom"
|
||||
)
|
||||
),
|
||||
lapply(methods, function(method) {
|
||||
verticalLayout(
|
||||
checkboxInput(
|
||||
NS(id, method$id),
|
||||
span(
|
||||
method$description,
|
||||
class = "control-label"
|
||||
),
|
||||
value = TRUE
|
||||
),
|
||||
selectInput(
|
||||
NS(id, "optimization_target"),
|
||||
"Optimization target",
|
||||
choices = list(
|
||||
"Mean rank" = "mean",
|
||||
"Median rank" = "median",
|
||||
"First rank" = "min",
|
||||
"Last rank" = "max",
|
||||
"Customize weights" = "custom"
|
||||
)
|
||||
),
|
||||
lapply(methods, function(method) {
|
||||
verticalLayout(
|
||||
checkboxInput(
|
||||
NS(id, method$id),
|
||||
span(
|
||||
method$description,
|
||||
class = "control-label"
|
||||
),
|
||||
value = TRUE
|
||||
),
|
||||
sliderInput(
|
||||
NS(id, sprintf("%s_weight", method$id)),
|
||||
NULL,
|
||||
min = -1.0,
|
||||
max = 1.0,
|
||||
step = 0.01,
|
||||
value = 1.0
|
||||
)
|
||||
)
|
||||
})
|
||||
)
|
||||
sliderInput(
|
||||
NS(id, sprintf("%s_weight", method$id)),
|
||||
NULL,
|
||||
min = -1.0,
|
||||
max = 1.0,
|
||||
step = 0.01,
|
||||
value = 1.0
|
||||
)
|
||||
)
|
||||
})
|
||||
)
|
||||
}
|
||||
|
||||
# Construct server for the methods editor.
|
||||
|
|
@ -50,89 +50,89 @@ methods_ui <- function(id) {
|
|||
#
|
||||
# @return A reactive containing the weighted results.
|
||||
methods_server <- function(id, analysis, comparison_gene_ids) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
# Observe each method's enable button and synchronise the slider state.
|
||||
lapply(methods, function(method) {
|
||||
observeEvent(input[[method$id]], {
|
||||
shinyjs::toggleState(
|
||||
sprintf("%s_weight", method$id),
|
||||
condition = input[[method$id]]
|
||||
)
|
||||
})
|
||||
|
||||
shinyjs::onclick(sprintf("%s_weight", method$id), {
|
||||
updateSelectInput(
|
||||
session,
|
||||
"optimization_target",
|
||||
selected = "custom"
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
# This reactive will always contain the currently selected optimization
|
||||
# gene IDs in a normalized form.
|
||||
optimization_gene_ids <- reactive({
|
||||
gene_ids <- if (input$optimization_genes == "comparison") {
|
||||
comparison_gene_ids()
|
||||
} else {
|
||||
analysis()$preset$reference_gene_ids
|
||||
}
|
||||
|
||||
sort(unique(gene_ids))
|
||||
})
|
||||
|
||||
# This reactive will always contain the optimal weights according to
|
||||
# the selected parameters.
|
||||
optimal_weights <- reactive({
|
||||
withProgress(message = "Optimizing weights", {
|
||||
setProgress(0.2)
|
||||
|
||||
included_methods <- NULL
|
||||
|
||||
for (method in methods) {
|
||||
if (input[[method$id]]) {
|
||||
included_methods <- c(included_methods, method$id)
|
||||
}
|
||||
}
|
||||
|
||||
geposan::optimal_weights(
|
||||
analysis(),
|
||||
included_methods,
|
||||
optimization_gene_ids(),
|
||||
target = input$optimization_target
|
||||
)
|
||||
})
|
||||
}) |> bindCache(
|
||||
analysis(),
|
||||
optimization_gene_ids(),
|
||||
sapply(methods, function(method) input[[method$id]]),
|
||||
input$optimization_target
|
||||
moduleServer(id, function(input, output, session) {
|
||||
# Observe each method's enable button and synchronise the slider state.
|
||||
lapply(methods, function(method) {
|
||||
observeEvent(input[[method$id]], {
|
||||
shinyjs::toggleState(
|
||||
sprintf("%s_weight", method$id),
|
||||
condition = input[[method$id]]
|
||||
)
|
||||
})
|
||||
|
||||
reactive({
|
||||
weights <- NULL
|
||||
|
||||
if (length(optimization_gene_ids()) < 1 |
|
||||
input$optimization_target == "custom") {
|
||||
for (method in methods) {
|
||||
if (input[[method$id]]) {
|
||||
weight <- input[[sprintf("%s_weight", method$id)]]
|
||||
weights[[method$id]] <- weight
|
||||
}
|
||||
}
|
||||
} else {
|
||||
weights <- optimal_weights()
|
||||
|
||||
for (method_id in names(weights)) {
|
||||
updateSliderInput(
|
||||
session,
|
||||
sprintf("%s_weight", method_id),
|
||||
value = weights[[method_id]]
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
geposan::ranking(analysis(), weights)
|
||||
})
|
||||
shinyjs::onclick(sprintf("%s_weight", method$id), {
|
||||
updateSelectInput(
|
||||
session,
|
||||
"optimization_target",
|
||||
selected = "custom"
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
# This reactive will always contain the currently selected optimization
|
||||
# gene IDs in a normalized form.
|
||||
optimization_gene_ids <- reactive({
|
||||
gene_ids <- if (input$optimization_genes == "comparison") {
|
||||
comparison_gene_ids()
|
||||
} else {
|
||||
analysis()$preset$reference_gene_ids
|
||||
}
|
||||
|
||||
sort(unique(gene_ids))
|
||||
})
|
||||
|
||||
# This reactive will always contain the optimal weights according to
|
||||
# the selected parameters.
|
||||
optimal_weights <- reactive({
|
||||
withProgress(message = "Optimizing weights", {
|
||||
setProgress(0.2)
|
||||
|
||||
included_methods <- NULL
|
||||
|
||||
for (method in methods) {
|
||||
if (input[[method$id]]) {
|
||||
included_methods <- c(included_methods, method$id)
|
||||
}
|
||||
}
|
||||
|
||||
geposan::optimal_weights(
|
||||
analysis(),
|
||||
included_methods,
|
||||
optimization_gene_ids(),
|
||||
target = input$optimization_target
|
||||
)
|
||||
})
|
||||
}) |> bindCache(
|
||||
analysis(),
|
||||
optimization_gene_ids(),
|
||||
sapply(methods, function(method) input[[method$id]]),
|
||||
input$optimization_target
|
||||
)
|
||||
|
||||
reactive({
|
||||
weights <- NULL
|
||||
|
||||
if (length(optimization_gene_ids()) < 1 |
|
||||
input$optimization_target == "custom") {
|
||||
for (method in methods) {
|
||||
if (input[[method$id]]) {
|
||||
weight <- input[[sprintf("%s_weight", method$id)]]
|
||||
weights[[method$id]] <- weight
|
||||
}
|
||||
}
|
||||
} else {
|
||||
weights <- optimal_weights()
|
||||
|
||||
for (method_id in names(weights)) {
|
||||
updateSliderInput(
|
||||
session,
|
||||
sprintf("%s_weight", method_id),
|
||||
value = weights[[method_id]]
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
geposan::ranking(analysis(), weights)
|
||||
})
|
||||
})
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,63 +7,63 @@
|
|||
#'
|
||||
#' @noRd
|
||||
preset_editor_ui <- function(id, options) {
|
||||
species_choices <- c("All species", names(options$species_sets))
|
||||
gene_choices <- names(options$gene_sets)
|
||||
species_choices <- c("All species", names(options$species_sets))
|
||||
gene_choices <- names(options$gene_sets)
|
||||
|
||||
if (!options$locked) {
|
||||
species_choices <- c(species_choices, "Customize")
|
||||
gene_choices <- c(gene_choices, "Customize")
|
||||
}
|
||||
|
||||
verticalLayout(
|
||||
h3("Inputs"),
|
||||
selectInput(
|
||||
NS(id, "species"),
|
||||
"Species to include",
|
||||
choices = species_choices
|
||||
),
|
||||
if (!options$locked) {
|
||||
species_choices <- c(species_choices, "Customize")
|
||||
gene_choices <- c(gene_choices, "Customize")
|
||||
conditionalPanel(
|
||||
condition = sprintf(
|
||||
"input['%s'] == 'Customize'",
|
||||
NS(id, "species")
|
||||
),
|
||||
selectizeInput(
|
||||
inputId = NS(id, "custom_species"),
|
||||
label = "Select input species",
|
||||
choices = NULL,
|
||||
multiple = TRUE
|
||||
),
|
||||
)
|
||||
},
|
||||
selectInput(
|
||||
NS(id, "reference_genes"),
|
||||
"Reference genes",
|
||||
choices = gene_choices
|
||||
),
|
||||
if (!options$locked) {
|
||||
conditionalPanel(
|
||||
condition = sprintf(
|
||||
"input['%s'] == 'Customize'",
|
||||
NS(id, "reference_genes")
|
||||
),
|
||||
gene_selector_ui(NS(id, "custom_genes"))
|
||||
)
|
||||
},
|
||||
if (options$locked) {
|
||||
HTML(paste0(
|
||||
"This instance prohibits performing custom analyses ",
|
||||
"to reduce resource usage. Normally, it is possible ",
|
||||
"to use this web application for analyzing any set of ",
|
||||
"reference genes to find patterns in their ",
|
||||
"chromosomal positions. If you would like to apply ",
|
||||
"this method for your own research, see ",
|
||||
"<a href=\"https://code.johrpan.de/johrpan/geposanui/src/",
|
||||
"branch/main/README.md\" target=\"_blank\">this page</a> for ",
|
||||
"more information."
|
||||
))
|
||||
}
|
||||
|
||||
verticalLayout(
|
||||
h3("Inputs"),
|
||||
selectInput(
|
||||
NS(id, "species"),
|
||||
"Species to include",
|
||||
choices = species_choices
|
||||
),
|
||||
if (!options$locked) {
|
||||
conditionalPanel(
|
||||
condition = sprintf(
|
||||
"input['%s'] == 'Customize'",
|
||||
NS(id, "species")
|
||||
),
|
||||
selectizeInput(
|
||||
inputId = NS(id, "custom_species"),
|
||||
label = "Select input species",
|
||||
choices = NULL,
|
||||
multiple = TRUE
|
||||
),
|
||||
)
|
||||
},
|
||||
selectInput(
|
||||
NS(id, "reference_genes"),
|
||||
"Reference genes",
|
||||
choices = gene_choices
|
||||
),
|
||||
if (!options$locked) {
|
||||
conditionalPanel(
|
||||
condition = sprintf(
|
||||
"input['%s'] == 'Customize'",
|
||||
NS(id, "reference_genes")
|
||||
),
|
||||
gene_selector_ui(NS(id, "custom_genes"))
|
||||
)
|
||||
},
|
||||
if (options$locked) {
|
||||
HTML(paste0(
|
||||
"This instance prohibits performing custom analyses ",
|
||||
"to reduce resource usage. Normally, it is possible ",
|
||||
"to use this web application for analyzing any set of ",
|
||||
"reference genes to find patterns in their ",
|
||||
"chromosomal positions. If you would like to apply ",
|
||||
"this method for your own research, see ",
|
||||
"<a href=\"https://code.johrpan.de/johrpan/geposanui/src/",
|
||||
"branch/main/README.md\" target=\"_blank\">this page</a> for ",
|
||||
"more information."
|
||||
))
|
||||
}
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Application logic for the preset editor.
|
||||
|
|
@ -76,45 +76,45 @@ preset_editor_ui <- function(id, options) {
|
|||
#'
|
||||
#' @noRd
|
||||
preset_editor_server <- function(id, options) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
custom_gene_ids <- if (!options$locked) {
|
||||
species_choices <- geposan::species$id
|
||||
names(species_choices) <- geposan::species$name
|
||||
moduleServer(id, function(input, output, session) {
|
||||
custom_gene_ids <- if (!options$locked) {
|
||||
species_choices <- geposan::species$id
|
||||
names(species_choices) <- geposan::species$name
|
||||
|
||||
updateSelectizeInput(
|
||||
session,
|
||||
"custom_species",
|
||||
choices = species_choices,
|
||||
server = TRUE
|
||||
)
|
||||
updateSelectizeInput(
|
||||
session,
|
||||
"custom_species",
|
||||
choices = species_choices,
|
||||
server = TRUE
|
||||
)
|
||||
|
||||
gene_selector_server("custom_genes")
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
gene_selector_server("custom_genes")
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
|
||||
reactive({
|
||||
reference_gene_ids <- if (input$reference_genes == "Customize") {
|
||||
custom_gene_ids()
|
||||
} else {
|
||||
options$gene_sets[[input$reference_genes]]
|
||||
}
|
||||
reactive({
|
||||
reference_gene_ids <- if (input$reference_genes == "Customize") {
|
||||
custom_gene_ids()
|
||||
} else {
|
||||
options$gene_sets[[input$reference_genes]]
|
||||
}
|
||||
|
||||
species_ids <- if (input$species == "All species") {
|
||||
geposan::species$id
|
||||
} else if (input$species == "Customize") {
|
||||
input$custom_species
|
||||
} else {
|
||||
options$species_sets[[input$species]]
|
||||
}
|
||||
species_ids <- if (input$species == "All species") {
|
||||
geposan::species$id
|
||||
} else if (input$species == "Customize") {
|
||||
input$custom_species
|
||||
} else {
|
||||
options$species_sets[[input$species]]
|
||||
}
|
||||
|
||||
tryCatch(
|
||||
geposan::preset(
|
||||
reference_gene_ids,
|
||||
species_ids = species_ids
|
||||
),
|
||||
error = function(err) NULL
|
||||
)
|
||||
})
|
||||
tryCatch(
|
||||
geposan::preset(
|
||||
reference_gene_ids,
|
||||
species_ids = species_ids
|
||||
),
|
||||
error = function(err) NULL
|
||||
)
|
||||
})
|
||||
})
|
||||
}
|
||||
|
|
|
|||
193
R/results.R
193
R/results.R
|
|
@ -1,20 +1,20 @@
|
|||
#' Construct UI for the detailed results panel.
|
||||
#' @noRd
|
||||
results_ui <- function(id) {
|
||||
verticalLayout(
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
splitLayout(
|
||||
cellWidths = "auto",
|
||||
uiOutput(NS(id, "copy")),
|
||||
downloadButton(NS(id, "download"), "Download CSV")
|
||||
)
|
||||
),
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DT::DTOutput(NS(id, "genes"))
|
||||
)
|
||||
verticalLayout(
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
splitLayout(
|
||||
cellWidths = "auto",
|
||||
uiOutput(NS(id, "copy")),
|
||||
downloadButton(NS(id, "download"), "Download CSV")
|
||||
)
|
||||
),
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DT::DTOutput(NS(id, "genes"))
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Server for the detailed results panel.
|
||||
|
|
@ -24,92 +24,93 @@ results_ui <- function(id) {
|
|||
#'
|
||||
#' @noRd
|
||||
results_server <- function(id, filtered_results) {
|
||||
moduleServer(id, function(input, output, session) {
|
||||
output$copy <- renderUI({
|
||||
results <- filtered_results()
|
||||
moduleServer(id, function(input, output, session) {
|
||||
output$copy <- renderUI({
|
||||
results <- filtered_results()
|
||||
|
||||
gene_ids <- results[, gene]
|
||||
names <- results[name != "", name]
|
||||
gene_ids <- results[, gene]
|
||||
names <- results[name != "", name]
|
||||
|
||||
genes_text <- paste(gene_ids, collapse = "\n")
|
||||
names_text <- paste(names, collapse = "\n")
|
||||
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")
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
columns <- c(
|
||||
"rank",
|
||||
"gene",
|
||||
"name",
|
||||
"chromosome",
|
||||
"distance",
|
||||
method_ids,
|
||||
"score",
|
||||
"percentile"
|
||||
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")
|
||||
)
|
||||
|
||||
column_names <- c(
|
||||
"",
|
||||
"Gene",
|
||||
"",
|
||||
"Chromosome",
|
||||
"Distance",
|
||||
method_names,
|
||||
"Score",
|
||||
"Percentile"
|
||||
)
|
||||
|
||||
output_data <- reactive({
|
||||
filtered_results()[, ..columns][,
|
||||
distance := paste0(
|
||||
format(
|
||||
round(distance / 1000000, digits = 2),
|
||||
nsmall = 2,
|
||||
),
|
||||
" Mbp"
|
||||
)
|
||||
]
|
||||
})
|
||||
|
||||
output$download <- downloadHandler(
|
||||
filename = "geposan_filtered_results.csv",
|
||||
content = function(file) {
|
||||
fwrite(output_data(), file = file)
|
||||
},
|
||||
contentType = "text/csv"
|
||||
)
|
||||
|
||||
output$genes <- DT::renderDT({
|
||||
dt <- DT::datatable(
|
||||
output_data(),
|
||||
rownames = FALSE,
|
||||
colnames = column_names,
|
||||
options = list(
|
||||
rowCallback = js_link,
|
||||
columnDefs = list(list(visible = FALSE, targets = 2)),
|
||||
pageLength = 25
|
||||
)
|
||||
)
|
||||
|
||||
DT::formatPercentage(
|
||||
dt,
|
||||
c(method_ids, "score", "percentile"),
|
||||
digits = 2
|
||||
)
|
||||
})
|
||||
)
|
||||
})
|
||||
|
||||
columns <- c(
|
||||
"rank",
|
||||
"gene",
|
||||
"name",
|
||||
"chromosome",
|
||||
"distance",
|
||||
method_ids,
|
||||
"score",
|
||||
"percentile"
|
||||
)
|
||||
|
||||
column_names <- c(
|
||||
"",
|
||||
"Gene",
|
||||
"",
|
||||
"Chromosome",
|
||||
"Distance",
|
||||
method_names,
|
||||
"Score",
|
||||
"Percentile"
|
||||
)
|
||||
|
||||
output_data <- reactive({
|
||||
filtered_results()[, ..columns][
|
||||
,
|
||||
distance := paste0(
|
||||
format(
|
||||
round(distance / 1000000, digits = 2),
|
||||
nsmall = 2,
|
||||
),
|
||||
" Mbp"
|
||||
)
|
||||
]
|
||||
})
|
||||
|
||||
output$download <- downloadHandler(
|
||||
filename = "geposan_filtered_results.csv",
|
||||
content = function(file) {
|
||||
fwrite(output_data(), file = file)
|
||||
},
|
||||
contentType = "text/csv"
|
||||
)
|
||||
|
||||
output$genes <- DT::renderDT({
|
||||
dt <- DT::datatable(
|
||||
output_data(),
|
||||
rownames = FALSE,
|
||||
colnames = column_names,
|
||||
options = list(
|
||||
rowCallback = js_link,
|
||||
columnDefs = list(list(visible = FALSE, targets = 2)),
|
||||
pageLength = 25
|
||||
)
|
||||
)
|
||||
|
||||
DT::formatPercentage(
|
||||
dt,
|
||||
c(method_ids, "score", "percentile"),
|
||||
digits = 2
|
||||
)
|
||||
})
|
||||
})
|
||||
}
|
||||
|
|
|
|||
556
R/server.R
556
R/server.R
|
|
@ -12,291 +12,291 @@ js_link <- DT::JS("function(row, data) {
|
|||
#' @param options Global application options.
|
||||
#' @noRd
|
||||
server <- function(options) {
|
||||
function(input, output, session) {
|
||||
input_reactives <- input_page_server("input_page", options)
|
||||
preset <- input_reactives$preset
|
||||
comparison_gene_ids <- input_reactives$comparison_gene_ids
|
||||
function(input, output, session) {
|
||||
input_reactives <- input_page_server("input_page", options)
|
||||
preset <- input_reactives$preset
|
||||
comparison_gene_ids <- input_reactives$comparison_gene_ids
|
||||
|
||||
observe({
|
||||
updateNavbarPage(
|
||||
session,
|
||||
"main_page",
|
||||
selected = "Results"
|
||||
)
|
||||
}) |> bindEvent(preset(), ignoreInit = TRUE)
|
||||
observe({
|
||||
updateNavbarPage(
|
||||
session,
|
||||
"main_page",
|
||||
selected = "Results"
|
||||
)
|
||||
}) |> bindEvent(preset(), ignoreInit = TRUE)
|
||||
|
||||
# Compute the results according to the preset.
|
||||
analysis <- reactive({
|
||||
withProgress(
|
||||
message = "Analyzing genes",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
geposan::analyze(
|
||||
preset(),
|
||||
progress = function(progress) {
|
||||
setProgress(progress)
|
||||
},
|
||||
include_results = FALSE
|
||||
)
|
||||
}
|
||||
)
|
||||
}) |> bindCache(preset())
|
||||
# Compute the results according to the preset.
|
||||
analysis <- reactive({
|
||||
withProgress(
|
||||
message = "Analyzing genes",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
geposan::analyze(
|
||||
preset(),
|
||||
progress = function(progress) {
|
||||
setProgress(progress)
|
||||
},
|
||||
include_results = FALSE
|
||||
)
|
||||
}
|
||||
)
|
||||
}) |> bindCache(preset())
|
||||
|
||||
# Rank the results.
|
||||
ranking <- methods_server("methods", analysis, comparison_gene_ids)
|
||||
# Rank the results.
|
||||
ranking <- methods_server("methods", analysis, comparison_gene_ids)
|
||||
|
||||
genes_with_distances <- merge(
|
||||
geposan::genes,
|
||||
geposan::distances[species == "hsapiens"],
|
||||
by.x = "id",
|
||||
by.y = "gene"
|
||||
genes_with_distances <- merge(
|
||||
geposan::genes,
|
||||
geposan::distances[species == "hsapiens"],
|
||||
by.x = "id",
|
||||
by.y = "gene"
|
||||
)
|
||||
|
||||
# Add gene information to the results.
|
||||
results <- reactive({
|
||||
merge(
|
||||
ranking(),
|
||||
genes_with_distances,
|
||||
by.x = "gene",
|
||||
by.y = "id",
|
||||
sort = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
# Apply the filters.
|
||||
results_filtered <- filters_server("filters", results)
|
||||
|
||||
# Server for the detailed results panel.
|
||||
results_server("results", results_filtered)
|
||||
|
||||
output$rank_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
# Add gene information to the results.
|
||||
results <- reactive({
|
||||
merge(
|
||||
ranking(),
|
||||
genes_with_distances,
|
||||
by.x = "gene",
|
||||
by.y = "id",
|
||||
sort = FALSE
|
||||
geposan::plot_scores(
|
||||
ranking(),
|
||||
gene_sets = gene_sets,
|
||||
max_rank = results_filtered()[, max(rank)]
|
||||
)
|
||||
})
|
||||
|
||||
output$rankings_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
|
||||
rankings <- list()
|
||||
methods <- preset$methods
|
||||
all <- ranking()
|
||||
|
||||
for (method in methods) {
|
||||
weights <- list()
|
||||
weights[[method$id]] <- 1.0
|
||||
rankings[[method$name]] <- geposan::ranking(all, weights)
|
||||
}
|
||||
|
||||
rankings[["Combined"]] <- all
|
||||
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_rankings(rankings, gene_sets)
|
||||
})
|
||||
|
||||
output$comparison_text <- renderUI({
|
||||
reference <- geposan::compare(
|
||||
ranking(),
|
||||
preset()$reference_gene_ids
|
||||
)
|
||||
|
||||
comparison <- if (!is.null(comparison_gene_ids())) {
|
||||
geposan::compare(ranking(), comparison_gene_ids())
|
||||
}
|
||||
|
||||
num <- function(x, digits) {
|
||||
format(
|
||||
round(x, digits = digits),
|
||||
nsmall = digits,
|
||||
scientific = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
comparison_text <- function(name, comparison) {
|
||||
glue::glue(
|
||||
"The {name} have a mean score of ",
|
||||
"<b>{num(comparison$mean_score, 4)}</b> ",
|
||||
"resulting in a mean rank of ",
|
||||
"<b>{num(comparison$mean_rank, 1)}</b>. ",
|
||||
"This corresponds to a percent rank of ",
|
||||
"<b>{num(100 * comparison$mean_percentile, 2)}%</b>. ",
|
||||
"A Wilcoxon rank sum test with the hypothesis of higher ",
|
||||
"than usual scores gives a p-value of ",
|
||||
"<b>{num(comparison$p_value, 4)}</b>."
|
||||
)
|
||||
}
|
||||
|
||||
reference_div <- div(HTML(
|
||||
comparison_text("reference genes", reference)
|
||||
))
|
||||
|
||||
if (!is.null(comparison)) {
|
||||
div(
|
||||
reference_div,
|
||||
div(HTML(comparison_text("comparison genes", comparison)))
|
||||
)
|
||||
} else {
|
||||
reference_div
|
||||
}
|
||||
})
|
||||
|
||||
output$boxplot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_boxplot(ranking(), gene_sets)
|
||||
})
|
||||
|
||||
output$positions_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
chromosome <- if (input$positions_plot_chromosome_name == "all") {
|
||||
NULL
|
||||
} else {
|
||||
input$positions_plot_chromosome_name
|
||||
}
|
||||
|
||||
geposan::plot_scores_by_position(
|
||||
ranking(),
|
||||
chromosome_name = chromosome,
|
||||
gene_sets = gene_sets
|
||||
)
|
||||
})
|
||||
|
||||
gost <- reactive({
|
||||
withProgress(
|
||||
message = "Querying g:Profiler",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
setProgress(0.2)
|
||||
gprofiler2::gost(results_filtered()[, gene])
|
||||
}
|
||||
)
|
||||
})
|
||||
|
||||
output$gost_plot <- plotly::renderPlotly({
|
||||
gprofiler2::gostplot(
|
||||
gost(),
|
||||
capped = FALSE,
|
||||
interactive = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
output$gost_details <- DT::renderDT({
|
||||
data <- data.table(gost()$result)
|
||||
setorder(data, p_value)
|
||||
|
||||
data[, total_ratio := term_size / effective_domain_size]
|
||||
data[, query_ratio := intersection_size / query_size]
|
||||
|
||||
data <- data[, .(
|
||||
source,
|
||||
term_name,
|
||||
total_ratio,
|
||||
query_ratio,
|
||||
p_value
|
||||
)]
|
||||
|
||||
dt <- DT::datatable(
|
||||
data,
|
||||
rownames = FALSE,
|
||||
colnames = c(
|
||||
"Source",
|
||||
"Term",
|
||||
"Total ratio",
|
||||
"Query ratio",
|
||||
"p-value"
|
||||
),
|
||||
options = list(
|
||||
pageLength = 25
|
||||
)
|
||||
)
|
||||
|
||||
dt <- DT::formatRound(dt, "p_value", digits = 4)
|
||||
dt <- DT::formatPercentage(
|
||||
dt,
|
||||
c("total_ratio", "query_ratio"),
|
||||
digits = 1
|
||||
)
|
||||
})
|
||||
|
||||
output$disgenet <- DT::renderDT({
|
||||
withProgress(
|
||||
message = "Querying DisGeNET",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
setProgress(0.2)
|
||||
|
||||
gene_names <- results_filtered()[, name]
|
||||
gene_names <- unique(gene_names[gene_names != ""])
|
||||
|
||||
diseases <- suppressMessages(
|
||||
disgenet2r::disease_enrichment(gene_names)
|
||||
)
|
||||
|
||||
data <- data.table(diseases@qresult)
|
||||
|
||||
data <- data[, .(Description, Ratio, BgRatio, pvalue)]
|
||||
setorder(data, pvalue)
|
||||
|
||||
dt <- DT::datatable(
|
||||
data,
|
||||
rownames = FALSE,
|
||||
colnames = c(
|
||||
"Disease",
|
||||
"Query ratio",
|
||||
"Total ratio",
|
||||
"p-value"
|
||||
),
|
||||
options = list(
|
||||
pageLength = 25
|
||||
)
|
||||
})
|
||||
)
|
||||
|
||||
# Apply the filters.
|
||||
results_filtered <- filters_server("filters", results)
|
||||
dt <- DT::formatRound(dt, "pvalue", digits = 4)
|
||||
|
||||
# Server for the detailed results panel.
|
||||
results_server("results", results_filtered)
|
||||
|
||||
output$rank_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_scores(
|
||||
ranking(),
|
||||
gene_sets = gene_sets,
|
||||
max_rank = results_filtered()[, max(rank)]
|
||||
)
|
||||
})
|
||||
|
||||
output$rankings_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
|
||||
rankings <- list()
|
||||
methods <- preset$methods
|
||||
all <- ranking()
|
||||
|
||||
for (method in methods) {
|
||||
weights <- list()
|
||||
weights[[method$id]] <- 1.0
|
||||
rankings[[method$name]] <- geposan::ranking(all, weights)
|
||||
}
|
||||
|
||||
rankings[["Combined"]] <- all
|
||||
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_rankings(rankings, gene_sets)
|
||||
})
|
||||
|
||||
output$comparison_text <- renderUI({
|
||||
reference <- geposan::compare(
|
||||
ranking(),
|
||||
preset()$reference_gene_ids
|
||||
)
|
||||
|
||||
comparison <- if (!is.null(comparison_gene_ids())) {
|
||||
geposan::compare(ranking(), comparison_gene_ids())
|
||||
}
|
||||
|
||||
num <- function(x, digits) {
|
||||
format(
|
||||
round(x, digits = digits),
|
||||
nsmall = digits,
|
||||
scientific = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
comparison_text <- function(name, comparison) {
|
||||
glue::glue(
|
||||
"The {name} have a mean score of ",
|
||||
"<b>{num(comparison$mean_score, 4)}</b> ",
|
||||
"resulting in a mean rank of ",
|
||||
"<b>{num(comparison$mean_rank, 1)}</b>. ",
|
||||
"This corresponds to a percent rank of ",
|
||||
"<b>{num(100 * comparison$mean_percentile, 2)}%</b>. ",
|
||||
"A Wilcoxon rank sum test with the hypothesis of higher ",
|
||||
"than usual scores gives a p-value of ",
|
||||
"<b>{num(comparison$p_value, 4)}</b>."
|
||||
)
|
||||
}
|
||||
|
||||
reference_div <- div(HTML(
|
||||
comparison_text("reference genes", reference)
|
||||
))
|
||||
|
||||
if (!is.null(comparison)) {
|
||||
div(
|
||||
reference_div,
|
||||
div(HTML(comparison_text("comparison genes", comparison)))
|
||||
)
|
||||
} else {
|
||||
reference_div
|
||||
}
|
||||
})
|
||||
|
||||
output$boxplot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
geposan::plot_boxplot(ranking(), gene_sets)
|
||||
})
|
||||
|
||||
output$positions_plot <- plotly::renderPlotly({
|
||||
preset <- preset()
|
||||
gene_sets <- list("Reference genes" = preset$reference_gene_ids)
|
||||
comparison_gene_ids <- comparison_gene_ids()
|
||||
|
||||
if (length(comparison_gene_ids) >= 1) {
|
||||
gene_sets <- c(
|
||||
gene_sets,
|
||||
list("Comparison genes" = comparison_gene_ids)
|
||||
)
|
||||
}
|
||||
|
||||
chromosome <- if (input$positions_plot_chromosome_name == "all") {
|
||||
NULL
|
||||
} else {
|
||||
input$positions_plot_chromosome_name
|
||||
}
|
||||
|
||||
geposan::plot_scores_by_position(
|
||||
ranking(),
|
||||
chromosome_name = chromosome,
|
||||
gene_sets = gene_sets
|
||||
)
|
||||
})
|
||||
|
||||
gost <- reactive({
|
||||
withProgress(
|
||||
message = "Querying g:Profiler",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
setProgress(0.2)
|
||||
gprofiler2::gost(results_filtered()[, gene])
|
||||
}
|
||||
)
|
||||
})
|
||||
|
||||
output$gost_plot <- plotly::renderPlotly({
|
||||
gprofiler2::gostplot(
|
||||
gost(),
|
||||
capped = FALSE,
|
||||
interactive = TRUE
|
||||
)
|
||||
})
|
||||
|
||||
output$gost_details <- DT::renderDT({
|
||||
data <- data.table(gost()$result)
|
||||
setorder(data, p_value)
|
||||
|
||||
data[, total_ratio := term_size / effective_domain_size]
|
||||
data[, query_ratio := intersection_size / query_size]
|
||||
|
||||
data <- data[, .(
|
||||
source,
|
||||
term_name,
|
||||
total_ratio,
|
||||
query_ratio,
|
||||
p_value
|
||||
)]
|
||||
|
||||
dt <- DT::datatable(
|
||||
data,
|
||||
rownames = FALSE,
|
||||
colnames = c(
|
||||
"Source",
|
||||
"Term",
|
||||
"Total ratio",
|
||||
"Query ratio",
|
||||
"p-value"
|
||||
),
|
||||
options = list(
|
||||
pageLength = 25
|
||||
)
|
||||
)
|
||||
|
||||
dt <- DT::formatRound(dt, "p_value", digits = 4)
|
||||
dt <- DT::formatPercentage(
|
||||
dt,
|
||||
c("total_ratio", "query_ratio"),
|
||||
digits = 1
|
||||
)
|
||||
})
|
||||
|
||||
output$disgenet <- DT::renderDT({
|
||||
withProgress(
|
||||
message = "Querying DisGeNET",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
setProgress(0.2)
|
||||
|
||||
gene_names <- results_filtered()[, name]
|
||||
gene_names <- unique(gene_names[gene_names != ""])
|
||||
|
||||
diseases <- suppressMessages(
|
||||
disgenet2r::disease_enrichment(gene_names)
|
||||
)
|
||||
|
||||
data <- data.table(diseases@qresult)
|
||||
|
||||
data <- data[, .(Description, Ratio, BgRatio, pvalue)]
|
||||
setorder(data, pvalue)
|
||||
|
||||
dt <- DT::datatable(
|
||||
data,
|
||||
rownames = FALSE,
|
||||
colnames = c(
|
||||
"Disease",
|
||||
"Query ratio",
|
||||
"Total ratio",
|
||||
"p-value"
|
||||
),
|
||||
options = list(
|
||||
pageLength = 25
|
||||
)
|
||||
)
|
||||
|
||||
dt <- DT::formatRound(dt, "pvalue", digits = 4)
|
||||
|
||||
dt
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
dt
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
}
|
||||
|
|
|
|||
240
R/ui.R
240
R/ui.R
|
|
@ -4,136 +4,136 @@
|
|||
#'
|
||||
#' @noRd
|
||||
ui <- function(options) {
|
||||
div(
|
||||
shinyjs::useShinyjs(),
|
||||
rclipboard::rclipboardSetup(),
|
||||
navbarPage(
|
||||
id = "main_page",
|
||||
theme = bslib::bs_theme(
|
||||
version = 5,
|
||||
bootswatch = "united",
|
||||
primary = "#1964bf"
|
||||
),
|
||||
title = options$title,
|
||||
selected = "Results",
|
||||
tabPanel(
|
||||
"Input data",
|
||||
input_page_ui("input_page", options)
|
||||
),
|
||||
tabPanel(
|
||||
"Results",
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
methods_ui("methods"),
|
||||
filters_ui("filters")
|
||||
),
|
||||
mainPanel(
|
||||
width = 9,
|
||||
tabsetPanel(
|
||||
type = "pills",
|
||||
tabPanel(
|
||||
title = "Overview",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotly::plotlyOutput(
|
||||
"rank_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Methods & Distribution",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotly::plotlyOutput(
|
||||
"rankings_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Comparison",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
htmlOutput("comparison_text"),
|
||||
plotly::plotlyOutput(
|
||||
"boxplot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Scores by position",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
selectInput(
|
||||
"positions_plot_chromosome_name",
|
||||
label = NULL,
|
||||
choices = c(
|
||||
list("All chromosomes" = "all"),
|
||||
chromosome_choices()
|
||||
)
|
||||
),
|
||||
plotly::plotlyOutput(
|
||||
"positions_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Detailed results",
|
||||
results_ui("results")
|
||||
),
|
||||
tabPanel(
|
||||
title = "g:Profiler",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotly::plotlyOutput("gost_plot"),
|
||||
),
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DT::DTOutput("gost_details")
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "DisGeNET",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DT::DTOutput("disgenet")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
div(
|
||||
shinyjs::useShinyjs(),
|
||||
rclipboard::rclipboardSetup(),
|
||||
navbarPage(
|
||||
id = "main_page",
|
||||
theme = bslib::bs_theme(
|
||||
version = 5,
|
||||
bootswatch = "united",
|
||||
primary = "#1964bf"
|
||||
),
|
||||
title = options$title,
|
||||
selected = "Results",
|
||||
tabPanel(
|
||||
"Input data",
|
||||
input_page_ui("input_page", options)
|
||||
),
|
||||
tabPanel(
|
||||
"Results",
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width = 3,
|
||||
methods_ui("methods"),
|
||||
filters_ui("filters")
|
||||
),
|
||||
mainPanel(
|
||||
width = 9,
|
||||
tabsetPanel(
|
||||
type = "pills",
|
||||
tabPanel(
|
||||
title = "Overview",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotly::plotlyOutput(
|
||||
"rank_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Publication"
|
||||
),
|
||||
tabPanel(
|
||||
title = "Methods & Distribution",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotly::plotlyOutput(
|
||||
"rankings_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Comparison",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
htmlOutput("comparison_text"),
|
||||
plotly::plotlyOutput(
|
||||
"boxplot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Scores by position",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
selectInput(
|
||||
"positions_plot_chromosome_name",
|
||||
label = NULL,
|
||||
choices = c(
|
||||
list("All chromosomes" = "all"),
|
||||
chromosome_choices()
|
||||
)
|
||||
),
|
||||
plotly::plotlyOutput(
|
||||
"positions_plot",
|
||||
width = "100%",
|
||||
height = "600px"
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Detailed results",
|
||||
results_ui("results")
|
||||
),
|
||||
tabPanel(
|
||||
title = "g:Profiler",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
plotly::plotlyOutput("gost_plot"),
|
||||
),
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DT::DTOutput("gost_details")
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "DisGeNET",
|
||||
div(
|
||||
style = "margin-top: 16px",
|
||||
DT::DTOutput("disgenet")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
tabPanel(
|
||||
title = "Publication"
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Generate a named list for choosing chromosomes.
|
||||
#' @noRd
|
||||
chromosome_choices <- function() {
|
||||
choices <- purrr::lmap(
|
||||
unique(geposan::genes$chromosome),
|
||||
function(name) {
|
||||
choice <- list(name)
|
||||
choices <- purrr::lmap(
|
||||
unique(geposan::genes$chromosome),
|
||||
function(name) {
|
||||
choice <- list(name)
|
||||
|
||||
names(choice) <- paste0(
|
||||
"Chromosome ",
|
||||
name
|
||||
)
|
||||
names(choice) <- paste0(
|
||||
"Chromosome ",
|
||||
name
|
||||
)
|
||||
|
||||
choice
|
||||
}
|
||||
)
|
||||
choice
|
||||
}
|
||||
)
|
||||
|
||||
choices[order(suppressWarnings(sapply(choices, as.integer)))]
|
||||
choices[order(suppressWarnings(sapply(choices, as.integer)))]
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue