mirror of
https://github.com/johrpan/geposanui.git
synced 2025-10-26 19:27: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
|
||||
)
|
||||
}
|
||||
|
||||
#' 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,
|
||||
colnames = column_names,
|
||||
options = list(
|
||||
rowCallback = js_link,
|
||||
rowCallback = js_link(),
|
||||
columnDefs = list(list(visible = FALSE, targets = 2)),
|
||||
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.
|
||||
js_link <- 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>`);
|
||||
}")
|
||||
|
||||
#' Create a server function for the application.
|
||||
#' Create the UI for the results page.
|
||||
#'
|
||||
#' @param id ID for namespacing.
|
||||
#' @param options Global options for the application.
|
||||
#'
|
||||
#' @return The UI elements.
|
||||
#'
|
||||
#' @param options Global application options.
|
||||
#' @noRd
|
||||
server <- function(options) {
|
||||
function(input, output, session) {
|
||||
preset <- input_page_server("input_page", options)
|
||||
results_ui <- function(id, 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")
|
||||
|
||||
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_editor",
|
||||
preset,
|
||||
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.
|
||||
ranking <- methods_server("methods", analysis, comparison_gene_ids)
|
||||
|
||||
|
|
@ -333,5 +468,25 @@ server <- function(options) {
|
|||
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