mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 11:17:24 +01:00
Move results page to separate module
This commit is contained in:
parent
da6bae70a9
commit
1938b7e0d1
4 changed files with 276 additions and 248 deletions
68
R/app.R
68
R/app.R
|
|
@ -41,3 +41,71 @@ run_app <- function(gene_sets,
|
||||||
port = port
|
port = port
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#' Generate the main UI for the application.
|
||||||
|
#'
|
||||||
|
#' @param options Global options for the application.
|
||||||
|
#'
|
||||||
|
#' @noRd
|
||||||
|
ui <- function(options) {
|
||||||
|
div(
|
||||||
|
custom_css(),
|
||||||
|
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",
|
||||||
|
results_ui("results", options)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Create a server function for the application.
|
||||||
|
#'
|
||||||
|
#' @param options Global application options.
|
||||||
|
#' @noRd
|
||||||
|
server <- function(options) {
|
||||||
|
function(input, output, session) {
|
||||||
|
preset <- input_page_server("input_page", options)
|
||||||
|
|
||||||
|
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())
|
||||||
|
|
||||||
|
results_server("results", options, analysis)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
|
||||||
14
R/details.R
14
R/details.R
|
|
@ -104,7 +104,7 @@ details_server <- function(id, filtered_results) {
|
||||||
rownames = FALSE,
|
rownames = FALSE,
|
||||||
colnames = column_names,
|
colnames = column_names,
|
||||||
options = list(
|
options = list(
|
||||||
rowCallback = js_link,
|
rowCallback = js_link(),
|
||||||
columnDefs = list(list(visible = FALSE, targets = 2)),
|
columnDefs = list(list(visible = FALSE, targets = 2)),
|
||||||
pageLength = 25
|
pageLength = 25
|
||||||
)
|
)
|
||||||
|
|
@ -118,3 +118,15 @@ details_server <- function(id, filtered_results) {
|
||||||
})
|
})
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#' Generate a JavaScript function to replace gene IDs with Ensembl gene links.
|
||||||
|
#' @noRd
|
||||||
|
js_link <- function() {
|
||||||
|
DT::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>`);
|
||||||
|
}")
|
||||||
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,51 +1,186 @@
|
||||||
# Java script function to replace gene IDs with Ensembl gene links.
|
#' Create the UI for the results page.
|
||||||
js_link <- DT::JS("function(row, data) {
|
#'
|
||||||
let id = data[1];
|
#' @param id ID for namespacing.
|
||||||
var name = data[2];
|
#' @param options Global options for the application.
|
||||||
if (!name) name = 'Unknown';
|
#'
|
||||||
let url = `https://www.ensembl.org/Homo_sapiens/Gene/Summary?g=${id}`;
|
#' @return The UI elements.
|
||||||
$('td:eq(1)', row).html(`<a href=\"${url}\" target=\"_blank\">${name}</a>`);
|
|
||||||
}")
|
|
||||||
|
|
||||||
#' Create a server function for the application.
|
|
||||||
#'
|
#'
|
||||||
#' @param options Global application options.
|
|
||||||
#' @noRd
|
#' @noRd
|
||||||
server <- function(options) {
|
results_ui <- function(id, options) {
|
||||||
function(input, output, session) {
|
ranking_choices <- purrr::lmap(geposan::all_methods(), function(method) {
|
||||||
preset <- input_page_server("input_page", options)
|
l <- list()
|
||||||
|
l[[method[[1]]$name]] <- method[[1]]$id
|
||||||
|
l
|
||||||
|
})
|
||||||
|
|
||||||
|
ranking_choices <- c(ranking_choices, "Combined" = "combined")
|
||||||
|
|
||||||
|
sidebarLayout(
|
||||||
|
sidebarPanel(
|
||||||
|
width = 3,
|
||||||
|
comparison_editor_ui(NS(id, "comparison_editor"), options),
|
||||||
|
methods_ui(NS(id, "methods")),
|
||||||
|
filters_ui(NS(id, "filters"))
|
||||||
|
),
|
||||||
|
mainPanel(
|
||||||
|
width = 9,
|
||||||
|
tabsetPanel(
|
||||||
|
type = "pills",
|
||||||
|
tabPanel(
|
||||||
|
title = "Overview",
|
||||||
|
div(
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
plotly::plotlyOutput(
|
||||||
|
NS(id, "rank_plot"),
|
||||||
|
width = "100%",
|
||||||
|
height = "600px"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "Method comparison",
|
||||||
|
div(
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
plotly::plotlyOutput(
|
||||||
|
NS(id, "rankings_plot"),
|
||||||
|
width = "100%",
|
||||||
|
height = "600px"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "Method correlation",
|
||||||
|
div(
|
||||||
|
class = "flow-layout",
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
selectInput(
|
||||||
|
NS(id, "ranking_y"),
|
||||||
|
label = NULL,
|
||||||
|
choices = ranking_choices
|
||||||
|
),
|
||||||
|
span(
|
||||||
|
style = paste0(
|
||||||
|
"display: inline-block;",
|
||||||
|
"margin-right: 12px;",
|
||||||
|
"padding: 0.375rem 0.75rem;"
|
||||||
|
),
|
||||||
|
"~"
|
||||||
|
),
|
||||||
|
selectInput(
|
||||||
|
NS(id, "ranking_x"),
|
||||||
|
label = NULL,
|
||||||
|
choices = ranking_choices,
|
||||||
|
selected = "combined"
|
||||||
|
),
|
||||||
|
div(
|
||||||
|
style = paste0(
|
||||||
|
"display: inline-block;",
|
||||||
|
"padding: 0.375rem 0.75rem;"
|
||||||
|
),
|
||||||
|
checkboxInput(
|
||||||
|
NS(id, "use_ranks"),
|
||||||
|
"Use ranks instead of scores",
|
||||||
|
value = TRUE
|
||||||
|
)
|
||||||
|
),
|
||||||
|
div(
|
||||||
|
style = paste0(
|
||||||
|
"display: inline-block;",
|
||||||
|
"padding: 0.375rem 0.75rem;"
|
||||||
|
),
|
||||||
|
checkboxInput(
|
||||||
|
NS(id, "use_sample"),
|
||||||
|
"Take random sample of genes",
|
||||||
|
value = TRUE
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
plotly::plotlyOutput(
|
||||||
|
NS(id, "ranking_correlation_plot"),
|
||||||
|
width = "100%",
|
||||||
|
height = "600px"
|
||||||
|
)
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "Comparison",
|
||||||
|
div(
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
htmlOutput(NS(id, "comparison_text")),
|
||||||
|
plotly::plotlyOutput(
|
||||||
|
NS(id, "boxplot"),
|
||||||
|
width = "100%",
|
||||||
|
height = "600px"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "Ortholog locations",
|
||||||
|
div(
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
plotly::plotlyOutput(
|
||||||
|
NS(id, "gene_locations_plot"),
|
||||||
|
width = "100%",
|
||||||
|
height = "1200px"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "Scores by position",
|
||||||
|
div(
|
||||||
|
class = "flow-layout",
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
selectInput(
|
||||||
|
NS(id, "positions_plot_chromosome_name"),
|
||||||
|
label = NULL,
|
||||||
|
choices = c(
|
||||||
|
list("All chromosomes" = "all"),
|
||||||
|
chromosome_choices()
|
||||||
|
)
|
||||||
|
),
|
||||||
|
plotly::plotlyOutput(
|
||||||
|
NS(id, "positions_plot"),
|
||||||
|
width = "100%",
|
||||||
|
height = "600px"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "Detailed results",
|
||||||
|
details_ui(NS(id, "results"))
|
||||||
|
),
|
||||||
|
tabPanel(
|
||||||
|
title = "g:Profiler",
|
||||||
|
div(
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
plotly::plotlyOutput("gost_plot"),
|
||||||
|
),
|
||||||
|
div(
|
||||||
|
style = "margin-top: 16px",
|
||||||
|
DT::DTOutput(NS(id, "gost_details"))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Application logic for the results page.
|
||||||
|
#'
|
||||||
|
#' @param id ID for namespacing.
|
||||||
|
#' @param options Global application options.
|
||||||
|
#' @param analysis A reactive containing the analysis that gets visualized.
|
||||||
|
#'
|
||||||
|
#' @noRd
|
||||||
|
results_server <- function(id, options, analysis) {
|
||||||
|
preset <- reactive(analysis()$preset)
|
||||||
|
|
||||||
|
moduleServer(id, function(input, output, session) {
|
||||||
comparison_gene_ids <- comparison_editor_server(
|
comparison_gene_ids <- comparison_editor_server(
|
||||||
"comparison_editor",
|
"comparison_editor",
|
||||||
preset,
|
preset,
|
||||||
options
|
options
|
||||||
)
|
)
|
||||||
|
|
||||||
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())
|
|
||||||
|
|
||||||
# Rank the results.
|
# Rank the results.
|
||||||
ranking <- methods_server("methods", analysis, comparison_gene_ids)
|
ranking <- methods_server("methods", analysis, comparison_gene_ids)
|
||||||
|
|
||||||
|
|
@ -333,5 +468,25 @@ server <- function(options) {
|
||||||
digits = 2
|
digits = 2
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
}
|
})
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Generate a named list for choosing chromosomes.
|
||||||
|
#' @noRd
|
||||||
|
chromosome_choices <- function() {
|
||||||
|
choices <- purrr::lmap(
|
||||||
|
unique(geposan::genes$chromosome),
|
||||||
|
function(name) {
|
||||||
|
choice <- list(name)
|
||||||
|
|
||||||
|
names(choice) <- paste0(
|
||||||
|
"Chromosome ",
|
||||||
|
name
|
||||||
|
)
|
||||||
|
|
||||||
|
choice
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
choices[order(suppressWarnings(sapply(choices, as.integer)))]
|
||||||
}
|
}
|
||||||
207
R/ui.R
207
R/ui.R
|
|
@ -1,207 +0,0 @@
|
||||||
#' Generate the main UI for the application.
|
|
||||||
#'
|
|
||||||
#' @param options Global options for the application.
|
|
||||||
#'
|
|
||||||
#' @noRd
|
|
||||||
ui <- function(options) {
|
|
||||||
ranking_choices <- purrr::lmap(geposan::all_methods(), function(method) {
|
|
||||||
l <- list()
|
|
||||||
l[[method[[1]]$name]] <- method[[1]]$id
|
|
||||||
l
|
|
||||||
})
|
|
||||||
|
|
||||||
ranking_choices <- c(ranking_choices, "Combined" = "combined")
|
|
||||||
|
|
||||||
div(
|
|
||||||
custom_css(),
|
|
||||||
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,
|
|
||||||
comparison_editor_ui("comparison_editor", options),
|
|
||||||
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 = "Method comparison",
|
|
||||||
div(
|
|
||||||
style = "margin-top: 16px",
|
|
||||||
plotly::plotlyOutput(
|
|
||||||
"rankings_plot",
|
|
||||||
width = "100%",
|
|
||||||
height = "600px"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
),
|
|
||||||
tabPanel(
|
|
||||||
title = "Method correlation",
|
|
||||||
div(
|
|
||||||
class = "flow-layout",
|
|
||||||
style = "margin-top: 16px",
|
|
||||||
selectInput(
|
|
||||||
"ranking_y",
|
|
||||||
label = NULL,
|
|
||||||
choices = ranking_choices
|
|
||||||
),
|
|
||||||
span(
|
|
||||||
style = paste0(
|
|
||||||
"display: inline-block;",
|
|
||||||
"margin-right: 12px;",
|
|
||||||
"padding: 0.375rem 0.75rem;"
|
|
||||||
),
|
|
||||||
"~"
|
|
||||||
),
|
|
||||||
selectInput(
|
|
||||||
"ranking_x",
|
|
||||||
label = NULL,
|
|
||||||
choices = ranking_choices,
|
|
||||||
selected = "combined"
|
|
||||||
),
|
|
||||||
div(
|
|
||||||
style = paste0(
|
|
||||||
"display: inline-block;",
|
|
||||||
"padding: 0.375rem 0.75rem;"
|
|
||||||
),
|
|
||||||
checkboxInput(
|
|
||||||
"use_ranks",
|
|
||||||
"Use ranks instead of scores",
|
|
||||||
value = TRUE
|
|
||||||
)
|
|
||||||
),
|
|
||||||
div(
|
|
||||||
style = paste0(
|
|
||||||
"display: inline-block;",
|
|
||||||
"padding: 0.375rem 0.75rem;"
|
|
||||||
),
|
|
||||||
checkboxInput(
|
|
||||||
"use_sample",
|
|
||||||
"Take random sample of genes",
|
|
||||||
value = TRUE
|
|
||||||
)
|
|
||||||
)
|
|
||||||
),
|
|
||||||
plotly::plotlyOutput(
|
|
||||||
"ranking_correlation_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 = "Ortholog locations",
|
|
||||||
div(
|
|
||||||
style = "margin-top: 16px",
|
|
||||||
plotly::plotlyOutput(
|
|
||||||
"gene_locations_plot",
|
|
||||||
width = "100%",
|
|
||||||
height = "1200px"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
),
|
|
||||||
tabPanel(
|
|
||||||
title = "Scores by position",
|
|
||||||
div(
|
|
||||||
class = "flow-layout",
|
|
||||||
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",
|
|
||||||
details_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 = "Publication"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
}
|
|
||||||
|
|
||||||
#' Generate a named list for choosing chromosomes.
|
|
||||||
#' @noRd
|
|
||||||
chromosome_choices <- function() {
|
|
||||||
choices <- purrr::lmap(
|
|
||||||
unique(geposan::genes$chromosome),
|
|
||||||
function(name) {
|
|
||||||
choice <- list(name)
|
|
||||||
|
|
||||||
names(choice) <- paste0(
|
|
||||||
"Chromosome ",
|
|
||||||
name
|
|
||||||
)
|
|
||||||
|
|
||||||
choice
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
||||||
choices[order(suppressWarnings(sapply(choices, as.integer)))]
|
|
||||||
}
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue