fix crash within PCA when low numbers of entities selected; unsure if…

… this was full rank error #357
ICB-DCM · Nov 6, 2024 · 91047ab · 91047ab
1 parent 00499bf
commit 91047ab
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 6 deletions.
diff --git a/program/shinyApp/R/pca/server.R b/program/shinyApp/R/pca/server.R
@@ -286,10 +286,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())

diff --git a/program/shinyApp/server.R b/program/shinyApp/server.R
@@ -1040,14 +1040,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)