johrpan/geposanui
1
0
Fork 0
mirror of https://github.com/johrpan/geposanui.git synced 2025-10-26 11:17:24 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Update UI with navbar and selectize

Browse source
This commit is contained in:
Elias Projahn 2021-12-08 13:46:59 +01:00
parent b6e1bc6603
commit f318cde5e7
5 changed files with 133 additions and 164 deletions
Download patch file Download diff file Expand all files Collapse all files

3
DESCRIPTION
View file

@ -23,5 +23,4 @@ Imports:
rlang, rlang,
rclipboard, rclipboard,
shiny, shiny,
shinyjs, shinyjs
shinyWidgets

1
R/app.R
View file

@ -8,7 +8,6 @@ run_app <- function(port = 3464) {
shinyjs::useShinyjs() shinyjs::useShinyjs()
rclipboard::rclipboardSetup() rclipboard::rclipboardSetup()
shinyWidgets::pickerInput("none", choices = NULL)
# Actually run the app. # Actually run the app.

54
R/comparison_editor.R
View file

@ -1,9 +1,5 @@
# Create a comparison editor. # Create a comparison editor.
comparison_editor_ui <- function(id) { comparison_editor_ui <- function(id) {
known_genes <- genes[name != ""]
gene_choices <- known_genes$id
names(gene_choices) <- known_genes$name
verticalLayout( verticalLayout(
h3("Comparison"), h3("Comparison"),
selectInput( selectInput(
@ -18,21 +14,16 @@ comparison_editor_ui <- function(id) {
"Customize" = "custom" "Customize" = "custom"
) )
), ),
tabsetPanel( conditionalPanel(
id = NS(id, "custom_comparison_genes_panel"), condition = sprintf(
type = "hidden", "input['%s'] == 'custom'",
tabPanelBody(value = "hide"), NS(id, "comparison_genes")
tabPanelBody( ),
value = "show", selectizeInput(
shinyWidgets::pickerInput( inputId = NS(id, "custom_comparison_genes"),
inputId = NS(id, "custom_comparison_genes"), label = "Select comparison genes",
choices = gene_choices, choices = NULL,
options = list( multiple = TRUE
"actions-box" = TRUE,
"live-search" = TRUE
),
multiple = TRUE
)
) )
) )
) )
@ -46,21 +37,16 @@ comparison_editor_ui <- function(id) {
# @return A reactive containing the comparison gene IDs. # @return A reactive containing the comparison gene IDs.
comparison_editor_server <- function(id, preset) { comparison_editor_server <- function(id, preset) {
moduleServer(id, function(input, output, session) { moduleServer(id, function(input, output, session) {
observeEvent(input$comparison_genes, { known_genes <- genes[name != ""]
if (input$comparison_genes == "custom") { gene_choices <- known_genes$id
updateTabsetPanel( names(gene_choices) <- known_genes$name
session,
"custom_comparison_genes_panel", updateSelectizeInput(
selected = "show" session,
) "custom_comparison_genes",
} else { choices = gene_choices,
updateTabsetPanel( server = TRUE
session, )
"custom_comparison_genes_panel",
selected = "hide"
)
}
})
reactive({ reactive({
if (input$comparison_genes == "none") { if (input$comparison_genes == "none") {

109
R/preset_editor.R
View file

@ -1,12 +1,5 @@
# Create a preset editor. # Create a preset editor.
preset_editor_ui <- function(id) { preset_editor_ui <- function(id) {
species_choices <- species$id
names(species_choices) <- species$name
known_genes <- genes[name != ""]
gene_choices <- known_genes$id
names(gene_choices) <- known_genes$name
verticalLayout( verticalLayout(
h3("Inputs"), h3("Inputs"),
selectInput( selectInput(
@ -18,22 +11,14 @@ preset_editor_ui <- function(id) {
"Customize" = "custom" "Customize" = "custom"
) )
), ),
tabsetPanel( conditionalPanel(
id = NS(id, "custom_species_panel"), condition = sprintf("input['%s'] == 'custom'", NS(id, "species")),
type = "hidden", selectizeInput(
tabPanelBody(value = "hide"), inputId = NS(id, "custom_species"),
tabPanelBody( label = "Select input species",
value = "show", choices = NULL,
shinyWidgets::pickerInput( multiple = TRUE
inputId = NS(id, "custom_species"), ),
choices = species_choices,
options = list(
"actions-box" = TRUE,
"live-search" = TRUE
),
multiple = TRUE
)
)
), ),
selectInput( selectInput(
NS(id, "reference_genes"), NS(id, "reference_genes"),
@ -44,21 +29,16 @@ preset_editor_ui <- function(id) {
"Customize" = "custom" "Customize" = "custom"
) )
), ),
tabsetPanel( conditionalPanel(
id = NS(id, "custom_reference_genes_panel"), condition = sprintf(
type = "hidden", "input['%s'] == 'custom'",
tabPanelBody(value = "hide"), NS(id, "reference_genes")
tabPanelBody( ),
value = "show", selectizeInput(
shinyWidgets::pickerInput( inputId = NS(id, "custom_reference_genes"),
inputId = NS(id, "custom_reference_genes"), label = "Select reference genes",
choices = gene_choices, choices = NULL,
options = list( multiple = TRUE
"actions-box" = TRUE,
"live-search" = TRUE
),
multiple = TRUE
)
) )
), ),
selectInput( selectInput(
@ -95,6 +75,27 @@ preset_editor_ui <- function(id) {
# @return A reactive containing the preset. # @return A reactive containing the preset.
preset_editor_server <- function(id) { preset_editor_server <- function(id) {
moduleServer(id, function(input, output, session) { moduleServer(id, function(input, output, session) {
species_choices <- species$id
names(species_choices) <- species$name
known_genes <- genes[name != ""]
gene_choices <- known_genes$id
names(gene_choices) <- known_genes$name
updateSelectizeInput(
session,
"custom_species",
choices = species_choices,
server = TRUE
)
updateSelectizeInput(
session,
"custom_reference_genes",
choices = gene_choices,
server = TRUE
)
current_preset <- reactiveVal(geposan::preset( current_preset <- reactiveVal(geposan::preset(
methods = method_ids, methods = method_ids,
species_ids = species$id, species_ids = species$id,
@ -103,38 +104,6 @@ preset_editor_server <- function(id) {
optimization_target = "mean" optimization_target = "mean"
)) ))
observeEvent(input$species, {
if (input$species == "custom") {
updateTabsetPanel(
session,
"custom_species_panel",
selected = "show"
)
} else {
updateTabsetPanel(
session,
"custom_species_panel",
selected = "hide"
)
}
})
observeEvent(input$reference_genes, {
if (input$reference_genes == "custom") {
updateTabsetPanel(
session,
"custom_reference_genes_panel",
selected = "show"
)
} else {
updateTabsetPanel(
session,
"custom_reference_genes_panel",
selected = "hide"
)
}
})
new_preset <- reactive({ new_preset <- reactive({
species_ids <- if (input$species == "replicative") { species_ids <- if (input$species == "replicative") {
species[replicative == TRUE, id] species[replicative == TRUE, id]

130
R/ui.R
View file

@ -1,38 +1,42 @@
ui <- fluidPage( ui <- div(
shinyjs::useShinyjs(), shinyjs::useShinyjs(),
rclipboard::rclipboardSetup(), rclipboard::rclipboardSetup(),
titlePanel("TPE-OLD candidates"), navbarPage(
sidebarLayout( theme = bslib::bs_theme(
sidebarPanel( version = 3,
width = 3, bootswatch = "united",
preset_editor_ui("preset_editor"), primary = "#1c71d8"
comparison_editor_ui("comparison_editor"),
filters_ui("filters"),
methods_ui("methods")
), ),
mainPanel( title = "TPE-OLD candidates",
tabsetPanel( selected = "Ranking",
type = "pills", tabPanel(
header = div(style = "margin-top: 16px"), "Input data",
tabPanel( sidebarLayout(
"Results", sidebarPanel(
uiOutput("copy"), width = 3,
div( preset_editor_ui("preset_editor"),
style = "margin-top: 16px", comparison_editor_ui("comparison_editor")
DT::DTOutput("genes")
)
), ),
tabPanel( mainPanel(
"Input Data", width = 9,
plotly::plotlyOutput( plotly::plotlyOutput(
"scatter", "scatter",
width = "100%", width = "100%",
height = "600px" height = "600px"
) )
)
),
),
tabPanel(
"Ranking",
sidebarLayout(
sidebarPanel(
width = 3,
methods_ui("methods"),
filters_ui("filters")
), ),
tabPanel( mainPanel(
"Assessment", width = 9,
htmlOutput("assessment_synopsis"),
div( div(
style = "margin-top: 16px", style = "margin-top: 16px",
plotly::plotlyOutput( plotly::plotlyOutput(
@ -49,38 +53,50 @@ ui <- fluidPage(
height = "600px" height = "600px"
) )
), ),
div( )
style = "margin-top: 16px", ),
plotly::plotlyOutput( ),
"boxplot", tabPanel(
width = "100%", "Detailed results",
height = "600px" uiOutput("copy"),
) div(
), style = "margin-top: 16px",
div( DT::DTOutput("genes")
style = "margin-top: 16px", )
plotly::plotlyOutput( ),
"chromosome_plot", tabPanel(
width = "100%", "Assessment",
height = "600px" htmlOutput("assessment_synopsis"),
) div(
), style = "margin-top: 16px",
), plotly::plotlyOutput(
tabPanel( "boxplot",
"Analysis", width = "100%",
checkboxInput( height = "600px"
"enable_gost", )
"Perform a gene set enrichment analysis on the \ ),
filtered result genes." div(
), style = "margin-top: 16px",
conditionalPanel( plotly::plotlyOutput(
"input.enable_gost == true", "chromosome_plot",
plotly::plotlyOutput( width = "100%",
"gost", height = "600px"
width = "100%", )
height = "600px" ),
) ),
) tabPanel(
"Analysis",
checkboxInput(
"enable_gost",
"Perform a gene set enrichment analysis on the \
filtered result genes."
),
conditionalPanel(
"input.enable_gost == true",
plotly::plotlyOutput(
"gost",
width = "100%",
height = "600px"
) )
) )
) )