Skip to content

Commit

Permalink
Hide main panel options (#371)
Browse files Browse the repository at this point in the history 
* hide by elemtn pre-processing options

* Info box streamline (#370)

* move info box data selection up

* rm show independent of main panel

* rm unnecassray helptext to be streamlined

* moved all boxes and introduced where missing

* fix crash within PCA when low numbers of entities selected; unsure if this was full rank error #357

* add heatmap message; fix bug when only one entitie selected

* add info box to singel gene viz

* adding default info, adressed #355

* Proof of concept, introducing div, to inititall hide and shoe upon button click

* add divs to hide

* PCA div added

* fix bug to show within modules

* seems to work, but EA buggy; need to investigate if show/hide the issue

* bug fix in enrichment analysis, somehow had problem if no enrichment found, but result object created

* finally also see enrichment default message

* also now adjumstent for geneannotation - fixes #353

* Integrated suggested changes

---------

Co-authored-by: PaulJonasJost <[email protected]>
  • Loading branch information
@LeaSeep @PaulJonasJost
LeaSeep and PaulJonasJost authored Nov 7, 2024
1 parent 3501242 commit 464afd6
Show file tree
Hide file tree
Showing 15 changed files with 718 additions and 596 deletions.
20 changes: 15 additions & 5 deletions program/shinyApp/R/data_selection/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -139,12 +139,24 @@ data_selection_sidebar_panel <- sidebarPanel(

data_selection_main_panel <- mainPanel(
id = "mainPanel_DataSelection",
div(
div(id ="InfoBox_DataSelection",
htmlOutput(outputId = "debug", container = pre)
),
# add link to toggle on the div geneAnno_toggle
actionButton(
inputId = "geneAnno_toggle_button",
label = "(show/hide) Further entitie Annotation options",
icon = icon('plus'),
style = "color: #000000; background-color: transparent; border-color: transparent"
),
div(
id = "geneAnno_toggle",
style = "display: none;",
class = "AddGeneSymbols_ui",
uiOutput("AddGeneSymbols_organism_ui"),
uiOutput("AddGeneSymbols_ui")
uiOutput("AddGeneSymbols_ui"),
hr(style = "border-top: 1px solid #858585;")
),
hr(style = "border-top: 1px solid #858585;"),
fluidRow(
column(5,
div(class = "DataSelection",
Expand All @@ -160,15 +172,13 @@ data_selection_main_panel <- mainPanel(
uiOutput("sample_selection_ui")
))
),
hr(style = "border-top: 1px solid #858585;"),
div(
id = "SaveInputAsRDS",
downloadButton(
outputId = "SaveInputAsList",
label = "Save file input to upload later"
) %>% helper(type = "markdown", content = "DataSelection_compilation_help")
),
htmlOutput(outputId = "debug", container = pre),
br(), br(), br(),
hr(style = "border-top: 1px solid #858585;"),
actionButton(
Expand Down
39 changes: 23 additions & 16 deletions program/shinyApp/R/enrichment_analysis/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,23 +19,28 @@ enrichment_analysis_geneset_server <- function(
print(result)
# Enrichment Result Plot
# only plot if the best found adjustment value is significant
if(result@result$p.adjust[1] < 0.05){
showElement(id = "EnrichmentPlot")
showElement(id = "only2Report")
showElement(id = "getR_Code")
showElement(id = "SavePlot")
showElement(id = "file_ext")
showElement(id = "Notes")
showElement(id = "NotesHelper")
hideElement(id = "EnrichmentFailure")
output$EnrichmentPlot <- renderPlot({clusterProfiler::dotplot(result) + CUSTOM_THEME})
if(ea_type == "GeneSetEnrichment"){
ea_scenario <- 15
}else{
ea_scenario <- 14
if(nrow(result@result) > 0){
if(result@result$p.adjust[1] < 0.05){
showElement(id = "EnrichmentPlot")
showElement(id = "only2Report")
showElement(id = "getR_Code")
showElement(id = "SavePlot")
showElement(id = "file_ext")
showElement(id = "Notes")
showElement(id = "NotesHelper")
hideElement(id = "EnrichmentFailure")
output$EnrichmentPlot <- renderPlot({clusterProfiler::dotplot(result) + CUSTOM_THEME})
if(ea_type == "GeneSetEnrichment"){
ea_scenario <- 15
}else{
ea_scenario <- 14
}
}else{ # print that no significant result was found
showElement(id = "EnrichmentFailure")
output$EnrichmentFailure <- renderText("No significant result found. For further details check the table.")
ea_scenario <- 0
}
}
else{ # print that no significant result was found
}else{ # print that no significant result was found
showElement(id = "EnrichmentFailure")
output$EnrichmentFailure <- renderText("No significant result found. For further details check the table.")
ea_scenario <- 0
Expand Down Expand Up @@ -209,6 +214,7 @@ enrichment_analysis_Server <- function(id, data, params, updates){
organism = NULL
)
ns <- session$ns
output$EnrichmentInfo <- renderText({"Press 'Get Enrichment Analysis' to start. Note that this analysis is only meaningful for gene sets at the moment."})
## initialize result as NULL
ea_reactives$enrichment_results <- ENRICHMENT_RESULT_RESET
# TODO: Call this in a loop.
Expand Down Expand Up @@ -494,6 +500,7 @@ enrichment_analysis_Server <- function(id, data, params, updates){
geneSetChoice_tmp
})
observeEvent(input$enrichmentGO,{
shinyjs::showElement(id = "enrichment_div", asis = TRUE)
ea_reactives$ea_info <- "Enrichment is running..."
waiter <- Waiter$new(
html = LOADING_SCREEN,
Expand Down
121 changes: 61 additions & 60 deletions program/shinyApp/R/enrichment_analysis/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,65 +120,67 @@ ea_sidebar <- function(ns){
ea_main <- function(ns){
mainPanel(
textOutput(outputId = ns("EnrichmentInfo"), container = pre),
tabsetPanel(
id = ns("EnrichmentTabs"),
geneset_panel_UI(ns("Hallmarks")),
geneset_panel_UI(ns("C1")),
geneset_panel_UI(ns("C2")),
geneset_panel_UI(ns("CGP")),
geneset_panel_UI(ns("CP")),
geneset_panel_UI(ns("BIOCARTA")),
geneset_panel_UI(ns("KEGG")),
geneset_panel_UI(ns("PID")),
geneset_panel_UI(ns("REACTOME")),
geneset_panel_UI(ns("WIKIPATHWAYS")),
geneset_panel_UI(ns("C3")),
geneset_panel_UI(ns("MIRDB")),
geneset_panel_UI(ns("MIR_Legacy")),
geneset_panel_UI(ns("GTRD")),
geneset_panel_UI(ns("TFT_Legacy")),
geneset_panel_UI(ns("C4")),
geneset_panel_UI(ns("CGN")),
geneset_panel_UI(ns("CM")),
geneset_panel_UI(ns("C5")),
geneset_panel_UI(ns("GO")),
geneset_panel_UI(ns("GO_BP")),
geneset_panel_UI(ns("GO_CC")),
geneset_panel_UI(ns("GO_MF")),
geneset_panel_UI(ns("HPO")),
geneset_panel_UI(ns("C6")),
geneset_panel_UI(ns("C7")),
geneset_panel_UI(ns("IMMUNESIGDB")),
geneset_panel_UI(ns("VAX")),
geneset_panel_UI(ns("C8")),
tabPanel(
title = "KeggPathwayOutput",
helpText("Specificy on the left which pathway (all sig. enriched) to display in picture-format"),
actionButton(
inputId = ns("OverlayOnPathway"),
label = "Show overlay on Pathway"
),
selectInput(
inputId = ns("plotOnTopOption"),
label = "Specifiy the what the colored overlay should indicate",
choices = c("LFC", "presence"),
selected = "presence"
),
uiOutput(outputId = ns("sample_anno_types_KEGG_ui")),
uiOutput(outputId = ns("ComparisonOptionsCRTL_ui")),
uiOutput(outputId = ns("ComparisonOptionsCOMP_ui")),
uiOutput(outputId = ns("psig_KEGG_ui")),
sliderInput(
inputId = ns("imageWidth"),
label = "Adjust Width",
min = 400, max = 1500, step = 20, value = 1000
),
sliderInput(
inputId = ns("imageHeight"),
label = "Adjust Height",
min = 400, max = 1500, step = 20, value = 640
),
imageOutput(outputId = ns("KeggPathwayOutput_img"))
div(id = "enrichment_div",
tabsetPanel(
id = ns("EnrichmentTabs"),
geneset_panel_UI(ns("Hallmarks")),
geneset_panel_UI(ns("C1")),
geneset_panel_UI(ns("C2")),
geneset_panel_UI(ns("CGP")),
geneset_panel_UI(ns("CP")),
geneset_panel_UI(ns("BIOCARTA")),
geneset_panel_UI(ns("KEGG")),
geneset_panel_UI(ns("PID")),
geneset_panel_UI(ns("REACTOME")),
geneset_panel_UI(ns("WIKIPATHWAYS")),
geneset_panel_UI(ns("C3")),
geneset_panel_UI(ns("MIRDB")),
geneset_panel_UI(ns("MIR_Legacy")),
geneset_panel_UI(ns("GTRD")),
geneset_panel_UI(ns("TFT_Legacy")),
geneset_panel_UI(ns("C4")),
geneset_panel_UI(ns("CGN")),
geneset_panel_UI(ns("CM")),
geneset_panel_UI(ns("C5")),
geneset_panel_UI(ns("GO")),
geneset_panel_UI(ns("GO_BP")),
geneset_panel_UI(ns("GO_CC")),
geneset_panel_UI(ns("GO_MF")),
geneset_panel_UI(ns("HPO")),
geneset_panel_UI(ns("C6")),
geneset_panel_UI(ns("C7")),
geneset_panel_UI(ns("IMMUNESIGDB")),
geneset_panel_UI(ns("VAX")),
geneset_panel_UI(ns("C8")),
tabPanel(
title = "KeggPathwayOutput",
helpText("Specificy on the left which pathway (all sig. enriched) to display in picture-format"),
actionButton(
inputId = ns("OverlayOnPathway"),
label = "Show overlay on Pathway"
),
selectInput(
inputId = ns("plotOnTopOption"),
label = "Specifiy the what the colored overlay should indicate",
choices = c("LFC", "presence"),
selected = "presence"
),
uiOutput(outputId = ns("sample_anno_types_KEGG_ui")),
uiOutput(outputId = ns("ComparisonOptionsCRTL_ui")),
uiOutput(outputId = ns("ComparisonOptionsCOMP_ui")),
uiOutput(outputId = ns("psig_KEGG_ui")),
sliderInput(
inputId = ns("imageWidth"),
label = "Adjust Width",
min = 400, max = 1500, step = 20, value = 1000
),
sliderInput(
inputId = ns("imageHeight"),
label = "Adjust Height",
min = 400, max = 1500, step = 20, value = 640
),
imageOutput(outputId = ns("KeggPathwayOutput_img"))
)
)
)
)
Expand All @@ -194,7 +196,6 @@ enrichment_analysis_UI <- function(id){
#########################################
# Enrichment
#########################################
h4("NOTE THAT THIS ONLY MAKES SENSE FOR TRANSCRIPTOMICS DATA AT THE MOMENT!"),
ea_sidebar(ns),
ea_main(ns),
)
Expand Down
33 changes: 32 additions & 1 deletion program/shinyApp/R/heatmap/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -107,6 +107,10 @@ heatmap_server <- function(id, data, params, updates){
)
})
})

output$Heatmap_Info <- renderText({
"Press 'Get Heatmap' to start!"
})

## Do Heatmap
toListen2Heatmap <- reactive({
Expand All @@ -129,6 +133,7 @@ heatmap_server <- function(id, data, params, updates){

observeEvent(toListen2Heatmap(),{
req(input$Do_Heatmap[1]>0)
shinyjs::showElement(id = "Heatmap_div", asis = TRUE)
req(
input$row_selection_options,
input$anno_options,
Expand Down Expand Up @@ -179,7 +184,24 @@ heatmap_server <- function(id, data, params, updates){

proceed_with_heatmap <- reactiveVal(FALSE)
# Check for data rows and show modal if necessary
if (nrow(data2plot) > 100) {
if(nrow(data2plot) < 2){
waiter$hide()
showModal(modalDialog(
title = "Warning",
"The selection results in only one row. Please revise to have at least two. For single gene visualisation check out the tab Single gene visualisation.",
footer = tagList(
actionButton(ns("cancel_heatmap"), "Cancel")
)
))
observeEvent(input$cancel_heatmap, {
output$Heatmap_Info <- renderText({
paste0("The heatmap not calculated due to low number of selected entities to show.")
})
proceed_with_heatmap(FALSE)
removeModal()
})
} else if (nrow(data2plot) > 100) {
waiter$hide()
showModal(modalDialog(
title = "Warning",
"The dataset has more than 100 rows. This may cause a high runtime. Do you want to continue?",
Expand All @@ -191,16 +213,25 @@ heatmap_server <- function(id, data, params, updates){

observeEvent(input$continue_heatmap, {
proceed_with_heatmap(TRUE)
output$Heatmap_Info <- renderText({
paste0("The heatmap is being calculated and displays a matrix with: ", nrow(data2plot), " rows and ", ncol(data2plot), " columns.")
})
removeModal()
})

observeEvent(input$cancel_heatmap, {
waiter$hide()
proceed_with_heatmap(FALSE)
output$Heatmap_Info <- renderText({
paste0("The heatmap not calculated due to user's choice.")
})
removeModal()
})
} else {
proceed_with_heatmap(TRUE)
output$Heatmap_Info <- renderText({
paste0("The heatmap is being calculated and displays a matrix with: ", nrow(data2plot), " rows and ", ncol(data2plot), " columns.")
})
}

observeEvent(proceed_with_heatmap(), {
Expand Down
Loading

0 comments on commit 464afd6

Please sign in to comment.