mirror of
https://github.com/johrpan/ubigen.git
synced 2025-10-26 19:57:24 +01:00
Allow setting a custom default dataset
This commit is contained in:
parent
c14208c2b2
commit
995b31646e
4 changed files with 203 additions and 177 deletions
15
R/app.R
15
R/app.R
|
|
@ -2,8 +2,19 @@
|
|||
#'
|
||||
#' @param host The hostname to serve the application on.
|
||||
#' @param port The port to serve the application on.
|
||||
#' @param custom_dataset This allows to set a custom dataset (return value of
|
||||
#' [analyze()]) as the default dataset of the UI.
|
||||
#'
|
||||
#' @export
|
||||
run_app <- function(host = "127.0.0.1", port = 3464) {
|
||||
runApp(shinyApp(ui, server), host = host, port = port)
|
||||
run_app <- function(host = "127.0.0.1",
|
||||
port = 3464,
|
||||
custom_dataset = NULL) {
|
||||
runApp(
|
||||
shinyApp(
|
||||
ui(custom_dataset = custom_dataset),
|
||||
server(custom_dataset = custom_dataset)
|
||||
),
|
||||
host = host,
|
||||
port = port
|
||||
)
|
||||
}
|
||||
|
|
|
|||
340
R/server.R
340
R/server.R
|
|
@ -1,184 +1,188 @@
|
|||
#' Server implementing the main user interface.
|
||||
#' @noRd
|
||||
server <- function(input, output, session) {
|
||||
dataset <- reactive({
|
||||
analysis <- if (input$dataset == "gtex_tissues") {
|
||||
ubigen::gtex_tissues
|
||||
} else if (input$dataset == "hpa_tissues") {
|
||||
ubigen::hpa_tissues
|
||||
} else {
|
||||
ubigen::gtex_all
|
||||
}
|
||||
|
||||
merge(analysis, ubigen::genes, by = "gene")
|
||||
})
|
||||
|
||||
ranked_data <- reactive({
|
||||
rank_genes(
|
||||
data = dataset(),
|
||||
cross_sample_metric = input$cross_sample_metric,
|
||||
cross_sample_weight = input$cross_sample_weight,
|
||||
level_metric = input$level_metric,
|
||||
level_weight = input$level_weight,
|
||||
variation_metric = input$variation_metric,
|
||||
variation_weight = input$variation_weight
|
||||
)
|
||||
})
|
||||
|
||||
custom_genes <- gene_selector_server("custom_genes") |> debounce(500)
|
||||
|
||||
output$overview_plot <- plotly::renderPlotly(overview_plot(
|
||||
ranked_data(),
|
||||
highlighted_genes = custom_genes()
|
||||
))
|
||||
|
||||
observeEvent(custom_genes(),
|
||||
{ # nolint
|
||||
if (length(custom_genes()) > 0) {
|
||||
updateTabsetPanel(session, "results_panel", selected = "custom_genes")
|
||||
} else if (input$results_panel == "custom_genes") {
|
||||
updateTabsetPanel(session, "results_panel", selected = "top_genes")
|
||||
server <- function(custom_dataset = NULL) {
|
||||
function(input, output, session) {
|
||||
dataset <- reactive({
|
||||
analysis <- if (input$dataset == "gtex_tissues") {
|
||||
ubigen::gtex_tissues
|
||||
} else if (input$dataset == "hpa_tissues") {
|
||||
ubigen::hpa_tissues
|
||||
} else if (input$dataset == "gtex_all") {
|
||||
ubigen::gtex_all
|
||||
} else {
|
||||
custom_dataset
|
||||
}
|
||||
},
|
||||
ignoreNULL = FALSE
|
||||
)
|
||||
|
||||
output$custom_genes_synopsis <- renderText({
|
||||
comparison_gene_ids <- custom_genes()
|
||||
|
||||
if (length(comparison_gene_ids) > 1) {
|
||||
reference <- ranked_data()[!gene %chin% comparison_gene_ids, score]
|
||||
comparison <- ranked_data()[gene %chin% comparison_gene_ids, score]
|
||||
|
||||
reference_median <- format(
|
||||
round(stats::median(reference), digits = 3),
|
||||
nsmall = 3
|
||||
)
|
||||
|
||||
comparison_median <- format(
|
||||
round(stats::median(comparison), digits = 3),
|
||||
nsmall = 3
|
||||
)
|
||||
|
||||
test_result <- stats::wilcox.test(
|
||||
x = comparison,
|
||||
y = reference,
|
||||
alternative = "greater",
|
||||
conf.int = TRUE
|
||||
)
|
||||
|
||||
p_value <- format(
|
||||
round(test_result$p.value, digits = 4),
|
||||
nsmall = 4,
|
||||
scientific = FALSE
|
||||
)
|
||||
|
||||
lower <- format(round(test_result$conf.int[1], digits = 3), nsmall = 3)
|
||||
upper <- format(round(test_result$conf.int[2], digits = 3), nsmall = 3)
|
||||
|
||||
HTML(glue::glue(
|
||||
"The p-value with the alternative hypothesis that your genes have ",
|
||||
"higher scores than other genes is <b>{p_value}</b>. This value ",
|
||||
"was computed using a Wilcoxon rank sum test. Based on a 95% ",
|
||||
"confidence, the difference in scores is between <b>{lower}</b> and ",
|
||||
"<b>{upper}</b>. The median score of your genes is ",
|
||||
"<b>{comparison_median}</b> compared to a median score of ",
|
||||
"<b>{reference_median}</b> of the other genes."
|
||||
))
|
||||
}
|
||||
})
|
||||
|
||||
output$custom_genes_boxplot <- plotly::renderPlotly(
|
||||
box_plot(ranked_data(), custom_genes())
|
||||
)
|
||||
|
||||
genes_table_server("custom_genes", reactive({
|
||||
ranked_data()[gene %chin% custom_genes()]
|
||||
}))
|
||||
|
||||
output$scores_plot <- plotly::renderPlotly(scores_plot(
|
||||
ranked_data(),
|
||||
highlighted_genes = custom_genes()
|
||||
))
|
||||
|
||||
selected_genes <- reactive({
|
||||
selected_points <- plotly::event_data("plotly_selected")
|
||||
ranked_data()[rank %in% selected_points$x]
|
||||
})
|
||||
|
||||
genes_table_server("selected_genes", reactive({
|
||||
if (nrow(selected_genes()) > 0) {
|
||||
selected_genes()
|
||||
} else {
|
||||
ranked_data()
|
||||
}
|
||||
}))
|
||||
|
||||
gsea_genes <- reactive({
|
||||
sort(if (input$gsea_set == "top") {
|
||||
ranked_data()[rank >= input$gsea_ranks, gene]
|
||||
} else if (input$gsea_set == "selected") {
|
||||
selected_genes()[, gene]
|
||||
} else {
|
||||
custom_genes()
|
||||
merge(analysis, ubigen::genes, by = "gene")
|
||||
})
|
||||
})
|
||||
|
||||
gsea_result <- reactive({
|
||||
withProgress(
|
||||
message = "Querying g:Profiler",
|
||||
value = 0.0,
|
||||
ranked_data <- reactive({
|
||||
rank_genes(
|
||||
data = dataset(),
|
||||
cross_sample_metric = input$cross_sample_metric,
|
||||
cross_sample_weight = input$cross_sample_weight,
|
||||
level_metric = input$level_metric,
|
||||
level_weight = input$level_weight,
|
||||
variation_metric = input$variation_metric,
|
||||
variation_weight = input$variation_weight
|
||||
)
|
||||
})
|
||||
|
||||
custom_genes <- gene_selector_server("custom_genes") |> debounce(500)
|
||||
|
||||
output$overview_plot <- plotly::renderPlotly(overview_plot(
|
||||
ranked_data(),
|
||||
highlighted_genes = custom_genes()
|
||||
))
|
||||
|
||||
observeEvent(custom_genes(),
|
||||
{ # nolint
|
||||
setProgress(0.2)
|
||||
gprofiler2::gost(gsea_genes())
|
||||
}
|
||||
if (length(custom_genes()) > 0) {
|
||||
updateTabsetPanel(session, "results_panel", selected = "custom_genes")
|
||||
} else if (input$results_panel == "custom_genes") {
|
||||
updateTabsetPanel(session, "results_panel", selected = "top_genes")
|
||||
}
|
||||
},
|
||||
ignoreNULL = FALSE
|
||||
)
|
||||
}) |>
|
||||
bindCache(gsea_genes()) |>
|
||||
bindEvent(input$gsea_run, ignoreNULL = FALSE)
|
||||
|
||||
output$gsea_plot <- plotly::renderPlotly({
|
||||
gprofiler2::gostplot(gsea_result(), interactive = TRUE)
|
||||
})
|
||||
output$custom_genes_synopsis <- renderText({
|
||||
comparison_gene_ids <- custom_genes()
|
||||
|
||||
output$gsea_details <- DT::renderDT({
|
||||
data <- data.table(gsea_result()$result)
|
||||
setorder(data, p_value)
|
||||
if (length(comparison_gene_ids) > 1) {
|
||||
reference <- ranked_data()[!gene %chin% comparison_gene_ids, score]
|
||||
comparison <- ranked_data()[gene %chin% comparison_gene_ids, score]
|
||||
|
||||
data[, total_ratio := term_size / effective_domain_size]
|
||||
data[, query_ratio := intersection_size / query_size]
|
||||
data[, increase := (query_ratio - total_ratio) / total_ratio]
|
||||
reference_median <- format(
|
||||
round(stats::median(reference), digits = 3),
|
||||
nsmall = 3
|
||||
)
|
||||
|
||||
data <- data[, .(
|
||||
source,
|
||||
term_name,
|
||||
total_ratio,
|
||||
query_ratio,
|
||||
increase,
|
||||
p_value
|
||||
)]
|
||||
comparison_median <- format(
|
||||
round(stats::median(comparison), digits = 3),
|
||||
nsmall = 3
|
||||
)
|
||||
|
||||
DT::datatable(
|
||||
data,
|
||||
rownames = FALSE,
|
||||
colnames = c(
|
||||
"Source",
|
||||
"Term",
|
||||
"Total ratio",
|
||||
"Query ratio",
|
||||
"Increase",
|
||||
"p-value"
|
||||
),
|
||||
options = list(
|
||||
pageLength = 25
|
||||
test_result <- stats::wilcox.test(
|
||||
x = comparison,
|
||||
y = reference,
|
||||
alternative = "greater",
|
||||
conf.int = TRUE
|
||||
)
|
||||
|
||||
p_value <- format(
|
||||
round(test_result$p.value, digits = 4),
|
||||
nsmall = 4,
|
||||
scientific = FALSE
|
||||
)
|
||||
|
||||
lower <- format(round(test_result$conf.int[1], digits = 3), nsmall = 3)
|
||||
upper <- format(round(test_result$conf.int[2], digits = 3), nsmall = 3)
|
||||
|
||||
HTML(glue::glue(
|
||||
"The p-value with the alternative hypothesis that your genes have ",
|
||||
"higher scores than other genes is <b>{p_value}</b>. This value ",
|
||||
"was computed using a Wilcoxon rank sum test. Based on a 95% ",
|
||||
"confidence, the difference in scores is between <b>{lower}</b> and ",
|
||||
"<b>{upper}</b>. The median score of your genes is ",
|
||||
"<b>{comparison_median}</b> compared to a median score of ",
|
||||
"<b>{reference_median}</b> of the other genes."
|
||||
))
|
||||
}
|
||||
})
|
||||
|
||||
output$custom_genes_boxplot <- plotly::renderPlotly(
|
||||
box_plot(ranked_data(), custom_genes())
|
||||
)
|
||||
|
||||
genes_table_server("custom_genes", reactive({
|
||||
ranked_data()[gene %chin% custom_genes()]
|
||||
}))
|
||||
|
||||
output$scores_plot <- plotly::renderPlotly(scores_plot(
|
||||
ranked_data(),
|
||||
highlighted_genes = custom_genes()
|
||||
))
|
||||
|
||||
selected_genes <- reactive({
|
||||
selected_points <- plotly::event_data("plotly_selected")
|
||||
ranked_data()[rank %in% selected_points$x]
|
||||
})
|
||||
|
||||
genes_table_server("selected_genes", reactive({
|
||||
if (nrow(selected_genes()) > 0) {
|
||||
selected_genes()
|
||||
} else {
|
||||
ranked_data()
|
||||
}
|
||||
}))
|
||||
|
||||
gsea_genes <- reactive({
|
||||
sort(if (input$gsea_set == "top") {
|
||||
ranked_data()[rank >= input$gsea_ranks, gene]
|
||||
} else if (input$gsea_set == "selected") {
|
||||
selected_genes()[, gene]
|
||||
} else {
|
||||
custom_genes()
|
||||
})
|
||||
})
|
||||
|
||||
gsea_result <- reactive({
|
||||
withProgress(
|
||||
message = "Querying g:Profiler",
|
||||
value = 0.0,
|
||||
{ # nolint
|
||||
setProgress(0.2)
|
||||
gprofiler2::gost(gsea_genes())
|
||||
}
|
||||
)
|
||||
) |>
|
||||
DT::formatRound("p_value", digits = 4) |>
|
||||
DT::formatPercentage(
|
||||
c("total_ratio", "query_ratio", "increase"),
|
||||
digits = 2
|
||||
)
|
||||
})
|
||||
}) |>
|
||||
bindCache(gsea_genes()) |>
|
||||
bindEvent(input$gsea_run, ignoreNULL = FALSE)
|
||||
|
||||
output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking)
|
||||
output$gsea_plot <- plotly::renderPlotly({
|
||||
gprofiler2::gostplot(gsea_result(), interactive = TRUE)
|
||||
})
|
||||
|
||||
output$gsea_details <- DT::renderDT({
|
||||
data <- data.table(gsea_result()$result)
|
||||
setorder(data, p_value)
|
||||
|
||||
data[, total_ratio := term_size / effective_domain_size]
|
||||
data[, query_ratio := intersection_size / query_size]
|
||||
data[, increase := (query_ratio - total_ratio) / total_ratio]
|
||||
|
||||
data <- data[, .(
|
||||
source,
|
||||
term_name,
|
||||
total_ratio,
|
||||
query_ratio,
|
||||
increase,
|
||||
p_value
|
||||
)]
|
||||
|
||||
DT::datatable(
|
||||
data,
|
||||
rownames = FALSE,
|
||||
colnames = c(
|
||||
"Source",
|
||||
"Term",
|
||||
"Total ratio",
|
||||
"Query ratio",
|
||||
"Increase",
|
||||
"p-value"
|
||||
),
|
||||
options = list(
|
||||
pageLength = 25
|
||||
)
|
||||
) |>
|
||||
DT::formatRound("p_value", digits = 4) |>
|
||||
DT::formatPercentage(
|
||||
c("total_ratio", "query_ratio", "increase"),
|
||||
digits = 2
|
||||
)
|
||||
})
|
||||
|
||||
output$gsea_plot_ranking <- plotly::renderPlotly(gsea_plot_ranking)
|
||||
}
|
||||
}
|
||||
|
|
|
|||
20
R/ui.R
20
R/ui.R
|
|
@ -1,6 +1,6 @@
|
|||
#' Function for creating the main user interface.
|
||||
#' @noRd
|
||||
ui <- function() {
|
||||
ui <- function(custom_dataset = NULL) {
|
||||
div(
|
||||
custom_css(),
|
||||
rclipboard::rclipboardSetup(),
|
||||
|
|
@ -22,11 +22,19 @@ ui <- function() {
|
|||
selectInput(
|
||||
"dataset",
|
||||
label = strong("Expression dataset"),
|
||||
list(
|
||||
"GTEx (across tissues and conditions)" = "gtex_all",
|
||||
"GTEx (across tissues)" = "gtex_tissues",
|
||||
"Human Protein Atlas (across tissues)" = "hpa_tissues"
|
||||
)
|
||||
{
|
||||
choices <- list(
|
||||
"GTEx (across tissues and conditions)" = "gtex_all",
|
||||
"GTEx (across tissues)" = "gtex_tissues",
|
||||
"Human Protein Atlas (across tissues)" = "hpa_tissues"
|
||||
)
|
||||
|
||||
if (!is.null(custom_dataset)) {
|
||||
c(list("Custom dataset" = "custom"), choices)
|
||||
} else {
|
||||
choices
|
||||
}
|
||||
}
|
||||
),
|
||||
selectInput(
|
||||
"cross_sample_metric",
|
||||
|
|
|
|||
|
|
@ -4,12 +4,15 @@
|
|||
\alias{run_app}
|
||||
\title{Run the application server.}
|
||||
\usage{
|
||||
run_app(host = "127.0.0.1", port = 3464)
|
||||
run_app(host = "127.0.0.1", port = 3464, custom_dataset = NULL)
|
||||
}
|
||||
\arguments{
|
||||
\item{host}{The hostname to serve the application on.}
|
||||
|
||||
\item{port}{The port to serve the application on.}
|
||||
|
||||
\item{custom_dataset}{This allows to set a custom dataset (return value of
|
||||
\code{\link[=analyze]{analyze()}}) as the default dataset of the UI.}
|
||||
}
|
||||
\description{
|
||||
Run the application server.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue