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

program/shinyApp/R/data_selection/ui.R

@@ -139,6 +139,9 @@ data_selection_sidebar_panel <- sidebarPanel(
 
 data_selection_main_panel <- mainPanel(
   id = "mainPanel_DataSelection",
+  div(id ="InfoBox_DataSelection",
+      htmlOutput(outputId = "debug", container = pre)
+      ),
   div(
     class = "AddGeneSymbols_ui",
     uiOutput("AddGeneSymbols_organism_ui"),
@@ -160,15 +163,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(

program/shinyApp/R/enrichment_analysis/server.R

@@ -6,6 +6,7 @@ enrichment_analysis_geneset_server <- function(
     function(input,output,session){
       file_path <- paste0("/www/",session$token,"/")
       if(is.null(result)){
+        output$EnrichmentInfo <- renderText("Press 'Get Enrichment Analysis' to start. Note that this analysis is only meaningful for gene sets at the moment.")
         output$EnrichmentFailure <- renderText("Currently there is no result to display.")
         hideElement(id = "EnrichmentPlot")
         hideElement(id = "only2Report")

program/shinyApp/R/enrichment_analysis/ui.R

@@ -6,6 +6,7 @@ geneset_panel_UI <- function(
 
   tabPanel(
     title = id_wo_ns,
+    textOutput(outputId = ns("EnrichmentInfo"), container = pre),
     tabsetPanel(
       tabPanel(
         title = paste(id_wo_ns, " Enrichment"),
@@ -119,7 +120,7 @@ ea_sidebar <- function(ns){
 
 ea_main <- function(ns){
   mainPanel(
-    textOutput(outputId = ns("EnrichmentInfo"), container = pre),
+
     tabsetPanel(
       id = ns("EnrichmentTabs"),
       geneset_panel_UI(ns("Hallmarks")),
@@ -194,7 +195,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),
   )

program/shinyApp/R/heatmap/server.R

@@ -107,6 +107,10 @@ heatmap_server <- function(id, data, params, updates){
           )
         })
       })
+
+      output$Heatmap_Info <- renderText({
+        "Press 'Get Heatmap' to start!"
+      })
 
       ## Do Heatmap
       toListen2Heatmap <- reactive({
@@ -179,7 +183,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?",
@@ -191,16 +212,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(), {

program/shinyApp/R/pca/server.R

@@ -55,6 +55,10 @@ pca_Server <- function(id, data, params, row_select){
             step = 1
           )
         })
+
+        output$PCA_Info <- renderText({
+          "Press 'Get PCA' to start!"
+        })
 
         ## Data Selection UI ---
         observe({
@@ -286,10 +290,21 @@ pca_Server <- function(id, data, params, row_select){
         )
         #LoadingsDF$Loading=scale(LoadingsDF$Loading)
         LoadingsDF <- LoadingsDF[order(LoadingsDF$Loading,decreasing = T),]
-        LoadingsDF <- rbind(
-          LoadingsDF[nrow(LoadingsDF):(nrow(LoadingsDF) - input$bottomSlider),],
-          LoadingsDF[input$topSlider:1,]
-        )
+
+        # need to test if default of slider is below the number of entities
+        if(input$topSlider + input$bottomSlider > nrow(LoadingsDF)){
+          LoadingsDF
+          output$PCA_Info <- renderText({
+            paste0("Within Loadings visualisations:
+the requested number of entities to show is higher than the number of entities in the data.
+Hence, all entities are shown. The total number of entities is: ", length(rownames(pca$rotation)))})
+        }else{
+          LoadingsDF <- rbind(
+            LoadingsDF[nrow(LoadingsDF):(nrow(LoadingsDF) - input$bottomSlider),],
+            LoadingsDF[input$topSlider:1,]
+          )
+        }
+
         LoadingsDF$entitie <- factor(LoadingsDF$entitie,levels = rownames(LoadingsDF))
         if(!is.null(input$EntitieAnno_Loadings)){
           req(data_input_shiny())

program/shinyApp/R/pca/ui.R

@@ -68,12 +68,12 @@ pca_sidebar_panel <- function(ns){
 pca_main_panel <- function(ns){
   mainPanel(
     id = "mainpanel_pca",
+    textOutput(outputId = ns("PCA_Info"), container = pre),
     tabsetPanel(
       id = "plot_panels_pca",
       type = "pills",
       tabPanel(
         title = "PCA_plot",
-        textOutput(outputId = ns("PCA_Info"), container = pre),
         plotlyOutput(outputId = ns("PCA_plot")),
         uiOutput(outputId = ns("PCA_anno_tooltip_ui")),
         splitLayout(

program/shinyApp/R/pre_processing/ui.R

@@ -37,9 +37,9 @@ pre_processing_main_panel <- mainPanel(
   id = "mainpanel_pre_processing",
   # Statistics to the data
   div(
-    id="data_summary",
-    helpText("General statistics to the input data, stuff like dimensions"),
-    htmlOutput(outputId = "Statisitcs_Data"),
+    id = "data_summary",
+    htmlOutput(outputId = "Statisitcs_Data", container = pre)
+    ),
     HTML(text = "<br>"),
     fluidRow(
       column(
@@ -104,7 +104,7 @@ pre_processing_main_panel <- mainPanel(
       NULL
     )
   )
-)
+
 
 
 pre_processing_panel <- tabPanel(

program/shinyApp/R/sample_correlation/server.R

@@ -39,6 +39,11 @@ sample_correlation_server <- function(id, data, params){
         })
       })
 
+      # Add initial text to help boxes
+      output$SampleCorr_Info <- renderText({
+        "Press 'Get Sample Correlation' to start!"
+      })
+
       # Do sample correlation plot 
       toListen2CorrelationPlot <- reactive({list(
         input$Do_SampleCorrelation,

program/shinyApp/R/single_gene_visualisation/server.R

@@ -103,6 +103,9 @@ single_gene_visualisation_server <- function(id, data){
             )
           }
         })
+        output$SingleGene_Info <- renderText({
+          "Press 'Get Single Gene Visualisation' to start!"
+        })
       })
 
       toListen <- reactive({
@@ -168,6 +171,9 @@ single_gene_visualisation_server <- function(id, data){
             GeneData <- GeneData[,ncol(GeneData),drop=F]
             GeneData$rowMedian <- GeneData_medians
             GeneData <- GeneData[,c("rowMedian","anno")]
+            data_note <- "You chose a group rather than a single entitie, the y-axis-values shown are summarized by taking the median."
+          }else{
+            data_note <- ""
           }
           GeneData$anno <- as.factor(GeneData$anno)
 
@@ -186,7 +192,10 @@ single_gene_visualisation_server <- function(id, data){
 
           # check if it is more than 3 points per group, to draw boxplots as well
           if(any(table(GeneData$anno)>3)){
+            boxplot_note <-  "The dotted line represents the mean of the data."
             P_boxplots <- P_boxplots + geom_boxplot(alpha = 0.5) 
+          }else{
+            boxplot_note <- "Note, that you only see boxplots if you have more than 3 samples per group. The dotted line represents the mean of the data."
           }
           testMethod <- "t.test"
           scenario <- 13
@@ -226,6 +235,12 @@ single_gene_visualisation_server <- function(id, data){
             }
           )
           output$SingleGenePlot <- renderPlot(P_boxplots)
+          output$SingleGene_Info <- renderText({
+            paste0(
+              boxplot_note,"\n",
+              data_note
+            )
+          })
         } else {
           output$SingleGenePlot <- renderPlot(ggplot() + theme_void())
         }

program/shinyApp/R/single_gene_visualisation/ui.R

@@ -5,7 +5,6 @@ single_gene_visualisation_sidebar_ui<- function(ns){
     uiOutput(outputId = ns("type_of_visualitsation_ui")),
     uiOutput(outputId = ns("Select_GeneAnno_ui")),
     uiOutput(outputId = ns("Select_Gene_ui")),
-    helpText("Note: if you choose a group rather than a single entitie, the values will be summarized by taking the median"),
 
     actionButton(
       inputId = ns("singleGeneGo"), 
@@ -24,13 +23,14 @@ single_gene_visualisation_sidebar_ui<- function(ns){
 single_gene_visualisation_main_ui <- function(ns){
   mainPanel(
     id = "main_single_gene_visualisation",
+    textOutput(outputId = ns("SingleGene_Info"), container = pre),
     splitLayout(
       style = "border: 1px solid silver:",
       cellWidths = c("50%", "50%"),
       plotOutput(outputId = ns("SingleGenePlot")),
       textOutput(outputId = ns("InfoText"))
     ),
-    h5(HTML("Note, that you only see boxplots if you have more than 3 samples per group")),
+    #h5(HTML("Note, that you only see boxplots if you have more than 3 samples per group")),
     uiOutput(outputId = ns("chooseComparisons_ui")),
     splitLayout(
       style = "border: 1px solid silver:",

program/shinyApp/server.R

@@ -911,6 +911,10 @@ server <- function(input,output,session){
   })
 
 ## Do preprocessing ----  
+  # Add initial text to help boxes
+  output$Statisitcs_Data <- renderText({
+    "Press 'Get-Preprocessing' to start!"
+  })
   selectedData_processed <- eventReactive(input$Do_preprocessing,{
     # only enter this when you actually click data
     req(input$Do_preprocessing > 0)
@@ -1042,14 +1046,22 @@ server <- function(input,output,session){
       shinyjs::click("PCA-refreshUI",asis = T)
       shinyjs::click("sample_correlation-refreshUI",asis = T)
       paste0(
-        addWarning,
         "The data has the dimensions of: ",
         paste0(dim(res_tmp[[session$token]]$data),collapse = ", "),
         "<br>","Be aware that depending on omic-Type, basic pre-processing has been done anyway even when selecting none",
-        "<br","If log10 was chosen, in case of 0's present log10(data+1) is done",
+        "<br","If logX was chosen, in case of 0's present logX(data+1) is done",
         "<br","See help for details",
         "<br>",ifelse(any(as.data.frame(assay(res_tmp[[session$token]]$data)) < 0),"Be aware that processed data has negative values, hence no log fold changes can be calculated",""))
     })
+    # set the warning as toast
+    show_toast(
+      title = "Attention",
+      text = HTML(addWarning),
+      position = "top",
+      timer = 2500,
+      timerProgressBar = T
+    )
+
     output$raw_violin_plot <- renderPlot({
       violin_plot(res_tmp[[session$token]]$data_original[par_tmp[[session$token]][['entities_selected']],par_tmp[[session$token]][['samples_selected']]],
                   color_by = input$violin_color)