Add chromosomal positions plot

This commit is contained in:
Elias Projahn 2022-05-17 21:58:40 +02:00
parent 40164ebf84
commit 6a5e5ed9c6
3 changed files with 131 additions and 83 deletions

View file

@ -21,6 +21,7 @@ Imports:
geposan, geposan,
gprofiler2, gprofiler2,
plotly, plotly,
purrr,
rlang, rlang,
rclipboard, rclipboard,
shiny, shiny,

View file

@ -119,6 +119,13 @@ server <- function(input, output, session) {
geposan::plot_boxplot(ranking(), gene_sets) geposan::plot_boxplot(ranking(), gene_sets)
}) })
output$positions_plot <- plotly::renderPlotly(
geposan::plot_scores_by_position(
ranking(),
input$positions_plot_chromosome_name
)
)
gost <- reactive({ gost <- reactive({
withProgress( withProgress(
message = "Querying g:Profiler", message = "Querying g:Profiler",

206
R/ui.R
View file

@ -1,92 +1,132 @@
ui <- div( #' Generate the main UI for the application.
shinyjs::useShinyjs(), #' @noRd
rclipboard::rclipboardSetup(), ui <- function() {
navbarPage( div(
id = "main_page", shinyjs::useShinyjs(),
theme = bslib::bs_theme( rclipboard::rclipboardSetup(),
version = 5, navbarPage(
bootswatch = "united", id = "main_page",
primary = "#1964bf" theme = bslib::bs_theme(
), version = 5,
title = "TPE-OLD candidates", bootswatch = "united",
selected = "Results", primary = "#1964bf"
tabPanel( ),
"Input data", title = "TPE-OLD candidates",
input_page_ui("input_page") selected = "Results",
), tabPanel(
tabPanel( "Input data",
"Results", input_page_ui("input_page")
sidebarLayout( ),
sidebarPanel( tabPanel(
width = 3, "Results",
methods_ui("methods"), sidebarLayout(
filters_ui("filters") sidebarPanel(
), width = 3,
mainPanel( methods_ui("methods"),
width = 9, filters_ui("filters")
tabsetPanel( ),
type = "pills", mainPanel(
tabPanel( width = 9,
title = "Overview", tabsetPanel(
div( type = "pills",
style = "margin-top: 16px", tabPanel(
plotly::plotlyOutput( title = "Overview",
"rank_plot", div(
width = "100%", style = "margin-top: 16px",
height = "600px" 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",
plotly::plotlyOutput(
"boxplot",
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( tabPanel(
style = "margin-top: 16px", title = "Methods & Distribution",
DT::DTOutput("gost_details") div(
) style = "margin-top: 16px",
), plotly::plotlyOutput(
tabPanel( "rankings_plot",
title = "DisGeNET", width = "100%",
div( height = "600px"
style = "margin-top: 16px", )
DT::DTOutput("disgenet") )
),
tabPanel(
title = "Comparison",
div(
style = "margin-top: 16px",
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 = 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"
) )
),
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)))]
}