Fix2 for Heatmap. Row annotation did not work and left the dataset wi…

…th no data (#246)
ICB-DCM · Jul 7, 2024 · e2467c9 · e2467c9
1 parent 80b4506
commit e2467c9
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 12 deletions.
diff --git a/program/shinyApp/R/heatmap/fun_entitieSelection.R b/program/shinyApp/R/heatmap/fun_entitieSelection.R
@@ -18,7 +18,7 @@ entitieSelection <- function(
     if(any(additionalInput_row_anno_factor=="all")){
       filtered_data <- filtered_data
     } else{
-      filtered_data <- filtered_data[which(data$annotation_rows[, additionalInput_row_anno] %in% additionalInput_row_anno_factor),]
+      filtered_data <- filtered_data[which(rowData(data)[, additionalInput_row_anno] %in% additionalInput_row_anno_factor),]
     }
   }
   if(!(is.na(additionalInput_sample_annotation_types)) & !(is.na(additionalInput_ctrl_idx)) & !(is.na(additionalInput_cmp_idx))){

diff --git a/program/shinyApp/R/heatmap/server.R b/program/shinyApp/R/heatmap/server.R
@@ -308,7 +308,6 @@ heatmap_server <- function(id, data, params, updates){
           print("No entitie selection")
           data2HandOver <- as.data.frame(assay(data$data))
         }else{
-          # entitie selection is a custom function -> wrap it in a tryCatch
           tryCatch({
             data2HandOver <- entitieSelection(
               data$data,
@@ -390,8 +389,6 @@ heatmap_server <- function(id, data, params, updates){
               output$Options_selected_out_3 <- renderText("Choose another preprocessing, as there are negative values!")
 
             }else if(doThis_flag){
-
-              # getLFC is a custom function -> wrap it in a tryCatch
               tryCatch({
                   Data2Plot <- getLFCs(
                   data = as.data.frame(data2HandOver),
@@ -411,10 +408,11 @@ heatmap_server <- function(id, data, params, updates){
                 heatmap_data <- t(Data2Plot[,"LFC",drop=F])
                 # absolute maximum value
                 max_val <- max(abs(heatmap_data), na.rm = T)
-                breakings <- seq(-max_val, max_val, length.out = 101)
-                if (input$rowWiseScaled){
+                if (input$rowWiseScaled | max_val == Inf | max_val == -Inf){
                   max_val <- 1
                   breakings <- NA
+                } else {
+                  breakings <- seq(-max_val, max_val, length.out = 101)
                 }
                 heatmap_plot <- pheatmap(
                   heatmap_data,
@@ -465,10 +463,11 @@ heatmap_server <- function(id, data, params, updates){
               heatmap_data <- as.matrix(data2HandOver)
               # absolute maximum value
               max_val <- max(abs(heatmap_data), na.rm = T)
-              breakings <- seq(-max_val, max_val, length.out = 101)
-              if (input$rowWiseScaled){
+              if (input$rowWiseScaled | max_val == Inf | max_val == -Inf){
                 max_val <- 1
                 breakings <- NA
+              } else {
+                breakings <- seq(-max_val, max_val, length.out = 101)
               }
               heatmap_plot <- pheatmap(
                 heatmap_data,
@@ -500,10 +499,11 @@ heatmap_server <- function(id, data, params, updates){
             heatmap_data <- t(res_tmp[[session$token]]$Heatmap[,"LFC",drop=F])
             # absolute maximum value
             max_val <- max(abs(heatmap_data), na.rm = T)
-            breakings <- seq(-max_val, max_val, length.out = 101)
-            if (input$rowWiseScaled){
+            if (input$rowWiseScaled | max_val == Inf | max_val == -Inf){
               max_val <- 1
               breakings <- NA
+            } else {
+              breakings <- seq(-max_val, max_val, length.out = 101)
             }
             heatmap_plot <- pheatmap(
                 heatmap_data,
@@ -544,10 +544,11 @@ heatmap_server <- function(id, data, params, updates){
             heatmap_data <- as.matrix(res_tmp[[session$token]]$Heatmap)
             # absolute maximum value
             max_val <- max(abs(heatmap_data), na.rm = T)
-            breakings <- seq(-max_val, max_val, length.out = 101)
-            if (input$rowWiseScaled){
+            if (input$rowWiseScaled | max_val == Inf | max_val == -Inf){
               max_val <- 1
               breakings <- NA
+            } else {
+              breakings <- seq(-max_val, max_val, length.out = 101)
             }
             heatmap_plot <- pheatmap(
               heatmap_data,